Node.hs

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

-- | FFI module for handling GEGL nodes
module GEGL.FFI.Node
  ( GeglNode(..)
  , GeglNodeDummy
  , c_gegl_node_new
  , c_gegl_node_new_child
  , gegl_node_set_single_int
  , gegl_node_set_single_string
  , gegl_node_set_single_double
  , gegl_node_set_single_ptr
  , gegl_node_get_single_int
  , gegl_node_get_single_string
  , gegl_node_get_single_double
  , gegl_node_get_single_ptr
  ) where

import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal (free)

import System.Random
import qualified Language.Haskell.TH as TH

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

-- internal imports

import GEGL.Operation (Operation(..), PropertyValue(..))
import GEGL.Color (gegl_color_new)
import GEGL.FFI.Color (GeglColorDummy, GeglColor(..))
import GEGL.FFI.Buffer (GeglBufferDummy, GeglBuffer(..))

import BABL.Format (babl_format)
import qualified BABL.FFI.Format as B (BablFormatDummy)
import BABL.FFI.Format (BablFormatPtr(..))

C.context C.baseCtx
C.include "<gegl.h>"

-- THIS IS HACKY!!!
-- Since a node only gets passed around as a pointer,
-- it doesn't matter what kind of pointer it is on this side.
-- | Mainly exposed representation of a GEGL node. Do not peek or poke the underlying pointer.
newtype GeglNode = GeglNode GeglNodeDummy
  deriving (Eq)
-- | The dummy datatype for a node
type GeglNodeDummy = ForeignPtr ()

-- | Interface to the @gegl_node_new@ function in C.
foreign import ccall unsafe "gegl.h gegl_node_new"
  c_gegl_node_new
    :: IO (Ptr ()) -- ^ Pointer to the newly created node.

-- | Interface to the @gegl_node_new_child@ function in C.
foreign import ccall unsafe "gegl.h gegl_node_new_child"
  c_gegl_node_new_child
    :: Ptr ()      -- ^ Pointer to the parent node.
    -> CString     -- ^ The first property name. Usually "operation".
    -> CString     -- ^ Value of the first property. Usually the internal operation name.
    -> Ptr a       -- ^ This has to be 'nullPtr'.
    -> IO (Ptr ()) -- ^ Pointer to the newly created node.

-- | Set a single 'CInt' setting of a node.
gegl_node_set_single_int
  :: Ptr ()  -- ^ Node to be set
  -> CString -- ^ Name of propety to be set
  -> CInt    -- ^ Setting value
  -> IO ()
gegl_node_set_single_int node cname cval =
  [C.exp| void {
    gegl_node_set($(void * node)
      , $(char * cname)
      , $(int cval)
      , NULL)}
  |]

-- | Set a single 'CString' setting of a node.
gegl_node_set_single_string
  :: Ptr ()  -- ^ Node to be set
  -> CString -- ^ Name of property to be set
  -> CString -- ^ Setting value
  -> IO ()
gegl_node_set_single_string node cname cval =
  [C.exp| void {
    gegl_node_set($(void * node)
      , $(char * cname)
      , $(char * cval)
      , NULL)}
  |]

-- | Set a single 'CDouble' setting of a node.
gegl_node_set_single_double
  :: Ptr ()  -- ^ Node to be set
  -> CString -- ^ Name of property to be set
  -> CDouble -- ^ Setting value
  -> IO ()
gegl_node_set_single_double node cname cval =
  [C.exp| void {
    gegl_node_set($(void * node)
      , $(char * cname)
      , $(double cval)
      , NULL
      )}
  |]

-- | Set a single 'Ptr' setting of a node.
gegl_node_set_single_ptr
  :: Ptr ()  -- ^ Node to be set
  -> CString -- ^ Name of property to be set
  -> Ptr ()  -- ^ Setting value
  -> IO ()
gegl_node_set_single_ptr node cname cval =
  [C.exp| void {
    gegl_node_set($(void * node)
      , $(char * cname)
      , $(void * cval)
      , NULL)}
  |]

-- | get a single 'CInt' setting of a node-
gegl_node_get_single_int
  :: Ptr ()  -- ^ Node to get Setting from
  -> CString -- ^ Name of property to get
  -> IO CInt
gegl_node_get_single_int node cname =
  [C.block| int {
    static int val;
    gegl_node_get($(void * node)
      , $(char * cname)
      , &val
      , NULL);
    return val;
    }
  |]

-- | get a single 'CString' setting of a node-
gegl_node_get_single_string
  :: Ptr ()     -- ^ Node to get Setting from
  -> CString    -- ^ Name of property to get
  -> IO CString
gegl_node_get_single_string node cname =
  [C.block| char * {
    static char * val;
    gegl_node_get($(void * node)
      , $(char * cname)
      , &val
      , NULL);
    return val;
    }
  |]

-- | get a single 'CDouble' setting of a node-
gegl_node_get_single_double
  :: Ptr ()     -- ^ Node to get Setting from
  -> CString    -- ^ Name of property to get
  -> IO CDouble
gegl_node_get_single_double node cname =
  [C.block| double {
    static double val;
    gegl_node_get($(void * node)
      , $(char * cname)
      , &val
      , NULL);
    return val;
    }
  |]

-- | get a single 'Ptr' setting of a node-
gegl_node_get_single_ptr
  :: Ptr ()  -- ^ Node to get Setting from
  -> CString -- ^ Name of property to get
  -> IO (Ptr ())
gegl_node_get_single_ptr node cname =
  [C.block| void * {
    static void * val;
    gegl_node_get($(void * node)
      , $(char * cname)
      , &val
      , NULL);
    return val;
    }
  |]