Node.hs

-- | Module for handling Nodes
module GEGL.Node
  ( FFI.GeglNode(..)
  , gegl_node_new
  , gegl_node_new_child
  , gegl_node_set
  , gegl_node_drop
  -- , gegl_node_set_all -- ^ on its way to deprecation
  ) where

import Foreign.C.String (newCString)
import Foreign.C.Types
import Foreign.Ptr (nullPtr)
import Foreign.Marshal (free)
import Foreign.ForeignPtr

import System.Glib.GObject (objectUnref)

import GEGL.Operation
import GEGL.Color
import qualified GEGL.FFI.Node   as FFI
import qualified GEGL.FFI.Buffer as FFI
import qualified GEGL.FFI.Color  as FFI

import qualified BABL.Format     as B
import qualified BABL.FFI.Format as B

-- | Creates a new GEGL node graph that can contain further processing nodes.
gegl_node_new :: IO FFI.GeglNode -- ^ A new top level 'FFI.GeglNode'
-- gegl_node_new = FFI.GeglNode <$> (newForeignPtr objectUnref =<< FFI.c_gegl_node_new)
gegl_node_new = FFI.GeglNode <$> (newForeignPtr_ =<< FFI.c_gegl_node_new)

-- | Creates a new processing node that performs the specified operation.
gegl_node_new_child
  :: FFI.GeglNode    -- ^ Parent node
  -> Operation       -- ^ 'Operation' to be performed by the new node
  -> IO FFI.GeglNode -- ^ Newly created 'FFI.GeglNode'
gegl_node_new_child (FFI.GeglNode fparent) operation = do
  op <- newCString "operation"
  opname <- newCString $ operationName operation
  -- node <- FFI.GeglNode <$> (newForeignPtr objectUnref =<<
  node <- FFI.GeglNode <$> (newForeignPtr_ =<<
    withForeignPtr fparent
      (\parent -> FFI.c_gegl_node_new_child parent op opname nullPtr))
  gegl_node_set node operation
  mapM_ free [op, opname]
  return node

gegl_node_set
  :: FFI.GeglNode
  -> Operation
  -> IO ()
gegl_node_set (FFI.GeglNode fnode) op =
  mapM_ (\(Property name val) -> do
    -- prefix <- return . take 5 . randomRs ('a', 'Z') =<< newStdGen
    cname <- newCString name
    -- tval <- return $ cType val ++ " conval"
    withForeignPtr fnode (\node ->
      case val of
        PropertyInt i -> do
          let conval = CInt $ fromIntegral i
          FFI.gegl_node_set_single_int node cname conval
        PropertyString s -> do
          conval <- newCString s
          FFI.gegl_node_set_single_string node cname conval
          free conval
        PropertyDouble d -> do
          let conval = CDouble d
          FFI.gegl_node_set_single_double node cname conval
        PropertyColor c -> do
          (FFI.GeglColor conval) <- gegl_color_new c
          FFI.gegl_node_set_single_ptr node cname conval
        PropertyFormat f -> do
          (B.BablFormatPtr ptr) <- B.babl_format f
          FFI.gegl_node_set_single_ptr node cname ptr
        PropertyBuffer (FFI.GeglBuffer ptr) ->
          FFI.gegl_node_set_single_ptr node cname ptr
        PropertyPointer ptr ->
          FFI.gegl_node_set_single_ptr node cname ptr
        _ ->
          error "not yet implemented in gegl_node_set"
        )
    free cname
    )
  $ operationParams op

gegl_node_drop
  :: FFI.GeglNode
  -> IO ()
gegl_node_drop (FFI.GeglNode node) = do
  addForeignPtrFinalizer objectUnref node
  finalizeForeignPtr node