State.hs

{-# LANGUAGE ForeignFunctionInterface, TemplateHaskell, QuasiQuotes #-}

module GEGL.FFI.Node.State
  ( c_gegl_node_get_consumers
  , c_gegl_node_get_producer
  , c_gegl_node_get_bounding_box
  ) where

import GEGL.FFI.Node
import GEGL.FFI.Tuple
import GEGL.FFI.Rectangle

import Data.Monoid ((<>))

import Language.C.Types
import Language.C.Inline as C

import Foreign.Marshal.Array
import Foreign.Marshal.Alloc (free)
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable (peek)

C.context (C.baseCtx <> tupleCtx)

C.include "<gegl.h>"
C.include "../Tuple.h"

-- | Interface to the @gegl_node_get_consumers@ function in C.
c_gegl_node_get_consumers
  :: Ptr ()                 -- ^ Node to get consumers of
  -> CString                -- ^ Name of output pad
  -> IO [(Ptr (), CString)] -- ^ List of consuming nodes
c_gegl_node_get_consumers node name = do
  tupPtr <- [C.block| nodeWithPad * {
    static nodeWithPad tuple;
    static GeglNode ** nodes;
    const static char ** pads;
    int len = gegl_node_get_consumers(
        $(void * node)
      , $(char * name)
      , &nodes
      , &pads
      );
    tuple.length = len;
    tuple.data = nodes;
    tuple.names = (char **)pads;
    return &tuple;
    }|]
  tup <- peek tupPtr
  let clength = nwpLength tup
      dptr    = nwpData tup
      dlength (CInt c) = fromIntegral c
      length  = dlength clength
  nodes <- peekArray length dptr
  names <- peekArray length $ nwpNames tup
  free dptr
  free $ nwpNames tup
  return $ zip nodes names

-- | Interface to the @egl_node_get_producer@ function in C.
c_gegl_node_get_producer
  :: Ptr ()  -- ^ Node to get Producer of
  -> CString -- ^ Name of the input pad
  -> IO (Maybe (Ptr (), CString))
c_gegl_node_get_producer node name = do
  nwpPtr <- [C.block| producer * {
    static producer nwp;
    static GeglNode * node;
    static char * pad_name;
    node = gegl_node_get_producer(
        $(void * node)
      , $(char * name)
      , &pad_name
      );
    nwp.node = node;
    nwp.pad  = pad_name;
    return &nwp;
    }|]
  nwp <- peek nwpPtr
  if prodNode nwp == nullPtr
  then return Nothing
  else return $ Just $ (prodNode nwp, prodPad nwp)

-- | Interface to the @gegl_node_get_bounding_box@ function in C.
c_gegl_node_get_bounding_box
  :: Ptr ()                 -- ^ A 'GeglNode'
  -> IO (Ptr GeglRectangle) -- ^ The bounding box of the node
c_gegl_node_get_bounding_box node = do
  rectPtr <- [C.block| void * {
    static GeglRectangle a;
    static void * b;
    a = gegl_node_get_bounding_box($(void * node));
    b = (void *)&a;
    return b;
    }|]
  return $ castPtr rectPtr