packages feed

gegl (empty) → 0.0.0.1

raw patch · 32 files changed

+2864/−0 lines, 32 filesdep +SDLdep +babldep +basesetup-changed

Dependencies added: SDL, babl, base, containers, gegl, glib, inline-c, linear, monad-loops, random, sdl2, split, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions.++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version.++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/example00.hs view
@@ -0,0 +1,36 @@+-- This is a simple hello world propgram, which renders "hello world" as text++import GEGL+import qualified System.Environment as E++main :: IO ()+main = do+  args <- E.getArgs+  str <- if null args+    then+      return "woo!"+    else+      return $ unwords args+  gegl_init+  putStrLn str+  gegl <- gegl_node_new+  putStrLn "new root node"+  display <- gegl_node_new_child gegl (pngSaveOperation+    [Property "path" (PropertyString "examples/example00.png")])+  putStrLn "first child"+  over <- gegl_node_new_child gegl defaultOverOperation+  putStrLn "over node"+  text <- gegl_node_new_child gegl (textOperation+    [ Property "string" $ PropertyString str+    , Property "color" $ PropertyColor $ RGB 1 0 0+    , Property "size"   $ PropertyDouble 40+    ])+  putStrLn "text node"+  gegl_node_link_many [over, display]+  putStrLn "link over and display"+  gegl_node_connect_to text "output" over "aux"+  putStrLn "connect text to over"+  gegl_node_process display+  putStrLn "process display"+  gegl_exit+  putStrLn "good night"
+ examples/example01.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE RecordWildCards #-}++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.SDL.Types as SDL+import qualified BABL as B+import GEGL++import Control.Monad+import Control.Monad.Loops+import Control.Concurrent.MVar++import Foreign.C.Types+import Foreign.Ptr++import Data.Maybe (fromMaybe)++import Debug.Trace++main :: IO ()+main = do+  SDL.init [SDL.InitVideo, SDL.InitTimer]+  traceIO "SDL init"+  surface <- SDL.setVideoMode 800 600 24 [SDL.SWSurface]+  SDL.setCaption "GEGL example01: SDL" "example01"+  gegl_init+  traceIO "GEGL init"+  sdl_format <- B.babl_format $ B.PixelFormat B.R'G'B' B.CFu8+  root <- gegl_node_new+  buffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 0 0) =<<+    B.babl_format (B.PixelFormat B.RGBA B.CFfloat)+  background <- gegl_node_new_child root $ checkerboardOperation+    [ Property "color1" $ PropertyColor $ RGBA 0.4 0.4 0.4 1+    , Property "color2" $ PropertyColor $ RGBA 0.6 0.6 0.6 1+    ]+  over <- gegl_node_new_child root defaultOverOperation+  buffer_src <- gegl_node_new_child root $ bufferSourceOperation+    [ Property "buffer" $ PropertyBuffer buffer+    ]+  gegl_node_link background over+  gegl_node_connect_to buffer_src "output" over "aux"+  traceIO "Nodes constructed"+  let w = SDL.surfaceGetWidth surface+      h = SDL.surfaceGetHeight surface+  _ <- gegl_buffer_set_extent buffer $ GeglRectangle 0 0 w h+  pixels <- SDL.surfaceGetPixels surface+  ld <- return $ LoopData+    surface+    (w, h)+    (fromIntegral $ SDL.surfaceGetPitch surface)+    buffer+    over+    sdl_format+  traceIO "initial blit"+  updateSurface (GeglRectangle 0 0 w h, ld)+  go <- newMVar True+  butDown <- newMVar False+  traceIO "begin iteration"+  whileM_ (fromMaybe False <$> tryReadMVar go) (loop ld butDown go)+  gegl_exit+  SDL.quit+  traceIO "bye bye"++data LoopData = LoopData+  { ldSurface :: SDL.Surface+  , ldSurfDim :: (Int, Int)+  , ldPitch   :: Int+  -- , ldPixels  :: SDL.Pixels+  , ldBuffer  :: GeglBuffer+  , ldNode    :: GeglNode+  , ldFormat  :: B.BablFormatPtr+  }++type UpdateData = (GeglRectangle, LoopData)++-- | Window update loop+loop :: LoopData -> MVar Bool -> MVar Bool -> IO ()+loop ld down g = do+  e <- SDL.waitEvent+  case e of+    SDL.MouseButtonDown x y SDL.ButtonLeft -> do+      _ <- swapMVar down True+      drawCircle ld (fromIntegral x) (fromIntegral y)+    SDL.MouseMotion x y _ _ -> do+      isDown <- readMVar down+      when isDown $+        drawCircle ld (fromIntegral x) (fromIntegral y)+    SDL.MouseButtonUp _ _ SDL.ButtonLeft -> do+      _ <- swapMVar down False+      return ()+    SDL.Quit -> do+      putStrLn "seeya!"+      _ <- swapMVar g False+      return ()+    _                        -> return ()++updateSurface :: UpdateData -> IO ()+updateSurface (roi, LoopData{..}) = do+  SDL.lockSurface ldSurface+  pixels <- SDL.surfaceGetPixels ldSurface+  let output = uncurry (GeglRectangle 0 0) ldSurfDim+  sroi@(GeglRectangle ix iy iw ih) <- fromMaybe output <$>+    gegl_rectangle_intersect output roi+  let origin = pixels `plusPtr` (ix * 3 + iy * ldPitch)+  gegl_node_blit+    ldNode+    1+    sroi+    ldFormat+    origin+    ldPitch+    [GeglBlitDefault]+  SDL.unlockSurface ldSurface+  SDL.updateRect ldSurface $ SDL.Rect ix iy iw ih++drawCircle :: LoopData -> Int -> Int -> IO ()+drawCircle ld@LoopData{..} x y = do+  let r = 20+      roi = GeglRectangle (x - r) (y - r) (2 * r) (2 * r)+  pixelMap ldBuffer roi (B.PixelFormat B.RGBA B.CFfloat) GeglAccessReadWrite GeglAbyssNone+      (\(Pixel px py pc) ->+        let dsqr = ((x - px) ^ 2) + ((y - py) ^ 2)+            (CVfloat (CFloat pr), CVfloat (CFloat pg), CVfloat (CFloat pb), CVfloat (CFloat pa)) = pc+            dist = (sqrt (fromIntegral dsqr :: Float))+        in if dsqr < (r ^ 2)+          then+            if dist < fromIntegral (r - 1)+              then+                Pixel px py+                  ( CVfloat $ CFloat 0+                  , CVfloat $ CFloat 0+                  , CVfloat $ CFloat 0+                  , CVfloat $ CFloat $ if pa < 1 then 1 else pa+                  )+              else+                let alpha = (fromIntegral r - dist)+                    dst_a = pa+                    a = alpha + dst_a * (1 - alpha)+                    a_term = dst_a * (1 - alpha)+                    red = 0 * alpha + pr * a_term+                    gre = 0 * alpha + pg * a_term+                    blu = 0 * alpha + pb * a_term+                in Pixel px py+                  ( CVfloat $ CFloat $ red/a+                  , CVfloat $ CFloat $ gre/a+                  , CVfloat $ CFloat $ blu/a+                  , CVfloat $ CFloat $ if pa < alpha then alpha else pa+                  )+          else+            Pixel px py pc+      )+  updateSurface (roi, ld)
+ examples/example02.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE RecordWildCards #-}++import GEGL+import qualified BABL as B+import qualified SDL+import qualified SDL.Raw as Raw++import Foreign.C.Types+import Foreign.Ptr+import Foreign.Storable++import Control.Concurrent+import Control.Monad+import Control.Monad.Loops++import Data.Maybe (fromMaybe)++import Debug.Trace++main :: IO ()+main = do+  SDL.initialize [SDL.InitVideo, SDL.InitTimer]+  traceIO "SDL init"+  window <- SDL.createWindow "GEGL example02: SDL2" SDL.defaultWindow+  surface <- SDL.getWindowSurface window+  gegl_init+  traceIO "GEGL init"+  let sdl_raw_format = B.PixelFormat B.RGBA B.CFu8+  sdl_format <- B.babl_format sdl_raw_format+  root <- gegl_node_new+  buffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 0 0) =<<+    B.babl_format (B.PixelFormat B.RGBA B.CFfloat)+  background <- gegl_node_new_child root $ checkerboardOperation+    [ Property "color1" $ PropertyColor $ RGBA 0.4 0.4 0.4 1+    , Property "color2" $ PropertyColor $ RGBA 0.6 0.6 0.6 1+    ]+  over <- gegl_node_new_child root defaultOverOperation+  buffer_src <- gegl_node_new_child root $ bufferSourceOperation+    [ Property "buffer" $ PropertyBuffer buffer+    ]+  gegl_node_link background over+  gegl_node_connect_to buffer_src "output" over "aux"+  traceIO "Nodes constructed"+  SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions surface+  let (w, h) = (fromIntegral rw, fromIntegral rh)+  _ <- gegl_buffer_set_extent buffer $ GeglRectangle 0 0 w h+  pixels <- SDL.surfacePixels surface+  let SDL.Surface rawSurfacePtr _ = surface+  rawSurface <- peek rawSurfacePtr+  pixelFormat <- peek $ Raw.surfaceFormat rawSurface+  let pitch = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w :: Int+  traceIO $ "pitch is: " ++ show pitch+  ld <- return $ LoopData+    surface+    window+    (w, h)+    pitch+    pixels+    buffer+    over+    root+    sdl_format+    sdl_raw_format+  traceIO "first update"+  updateSurface (GeglRectangle 0 0 w h, ld)+  go <- newMVar True+  butDown <- newMVar False+  traceIO "begin iteration"+  whileM_ (fromMaybe False <$> tryReadMVar go) (loop ld butDown go)+  mapM_ gegl_node_drop [root, background, over]+  gegl_exit+  SDL.quit+  traceIO "bye bye"++data LoopData = LoopData+  { ldSurface    :: SDL.Surface+  , ldWindow     :: SDL.Window+  , ldSurfDim    :: (Int, Int)+  , ldPitch      :: Int+  , ldPixels     :: Ptr ()+  , ldBuffer     :: GeglBuffer+  , ldNode       :: GeglNode+  , ldGraph      :: GeglNode+  , ldFormat     :: B.BablFormatPtr+  , ldBablFormat :: B.PixelFormat+  }++type UpdateData = (GeglRectangle, LoopData)++updateSurface :: UpdateData -> IO ()+updateSurface (roi, LoopData{..}) = do+  -- traceIO "locking surface"+  SDL.lockSurface ldSurface+  let surfaceRect = uncurry (GeglRectangle 0 0) ldSurfDim+  sroi@(GeglRectangle ix iy iw ih) <- fromMaybe surfaceRect <$>+    gegl_rectangle_intersect surfaceRect roi+  let origin = ldPixels `plusPtr` (ix * B.babl_components_per_pixel ldBablFormat + iy * ldPitch)+  -- traceIO "blit"+  gegl_node_blit+    ldNode+    1+    sroi+    ldFormat+    origin+    ldPitch+    [GeglBlitDefault]+  -- traceIO "unlocking surface"+  SDL.unlockSurface ldSurface+  -- traceIO "update window"+  SDL.updateWindowSurface ldWindow++-- | Window update loop+loop :: LoopData -> MVar Bool -> MVar Bool -> IO ()+loop ld down go = do+  e <- SDL.waitEvent+  case SDL.eventPayload e of+    SDL.MouseButtonEvent dat ->+      when (SDL.mouseButtonEventButton dat == SDL.ButtonLeft) $+        if (SDL.mouseButtonEventMotion dat == SDL.Pressed)+          then do+            _ <- swapMVar down True+            let (SDL.P (SDL.V2 x y)) = SDL.mouseButtonEventPos dat+            drawCircle ld (fromIntegral x) (fromIntegral y)+          else do+            _ <- swapMVar down False+            return ()+    SDL.MouseMotionEvent dat -> do+      isDown <- readMVar down+      when isDown $ do+        let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat+        drawCircle ld (fromIntegral x) (fromIntegral y)+    SDL.WindowClosedEvent _ -> do+      traceIO "seeya!"+      _ <- swapMVar go False+      return ()+    _ ->+      return ()++drawCircle :: LoopData -> Int -> Int -> IO ()+drawCircle ld@LoopData{..} x y = do+  let r = 20+      roi = GeglRectangle (x - r) (y - r) (2 * r) (2 * r)+  pixelMap ldBuffer roi (B.PixelFormat B.RGBA B.CFfloat) GeglAccessReadWrite GeglAbyssNone+    (\(Pixel px py pc) ->+      let dsqr = ((x - px) ^ 2) + ((y - py) ^ 2)+          (CVfloat (CFloat pr), CVfloat (CFloat pg), CVfloat (CFloat pb), CVfloat (CFloat pa)) = pc+          dist = (sqrt (fromIntegral dsqr :: Float))+      in if dsqr < r ^ 2+        then+          if dist < fromIntegral (r - 1)+            then+              Pixel px py+                ( CVfloat $ CFloat 0+                , CVfloat $ CFloat 0+                , CVfloat $ CFloat 0+                , CVfloat $ CFloat $ if pa < 1 then 1 else pa+                )+            else+              let alpha = fromIntegral r - dist+                  dst_a = pa+                  a = alpha + dst_a * (1 - alpha)+                  a_term = dst_a * (1 - alpha)+                  red = 0 * alpha + pr * a_term+                  gre = 0 * alpha + pg * a_term+                  blu = 0 * alpha + pb * a_term+              in+                Pixel px py+                  ( CVfloat $ CFloat $ red / a+                  , CVfloat $ CFloat $ gre / a+                  , CVfloat $ CFloat $ blu / a+                  , CVfloat $ CFloat $ if pa < alpha then alpha else pa+                  )+        else+          Pixel px py pc+      )+  updateSurface (roi, ld)
+ gegl.cabal view
@@ -0,0 +1,115 @@+-- Initial gegl.cabal generated by cabal init.  For further documentation, +-- see http://haskell.org/cabal/users-guide/++name:                gegl+version:             0.0.0.1+synopsis:            Haskell bindings to GEGL library+description:         see homepage for description.+homepage:            https://github.com/nek0/gegl#readme+license:             LGPL-3+license-file:        LICENSE+author:              nek0+maintainer:          nek0@nek0.eu+-- copyright:           +category:            Graphics+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:              git+  location:          https://github.com/nek0/gegl.git++flag examples+  description:       Build example programs+  default:           False++library+  exposed-modules:     GEGL+                     , GEGL.Buffer+                     , GEGL.Buffer.BufferIterator+                     , GEGL.Color+                     , GEGL.Connection+                     , GEGL.Enums+                     , GEGL.Node+                     , GEGL.Node.State+                     , GEGL.Operation+                     , GEGL.Process+                     , GEGL.Rectangle+                     , GEGL.Reparent+                     , GEGL.FFI+                     , GEGL.FFI.Buffer+                     , GEGL.FFI.Buffer.BufferIterator+                     , GEGL.FFI.Color+                     , GEGL.FFI.Connection+                     , GEGL.FFI.Node+                     , GEGL.FFI.Node.State+                     , GEGL.FFI.Process+                     , GEGL.FFI.Rectangle+                     , GEGL.FFI.Reparent+                     , GEGL.FFI.Tuple+  -- other-modules:       +  other-extensions:    ForeignFunctionInterface+  hs-source-dirs:      src+  c-sources:           src/GEGL/FFI/Buffer/BufferIterator.c+                     , src/GEGL/FFI/Node.c+                     , src/GEGL/FFI/Node/State.c+  cc-options:          -Wall+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+  extra-libraries:     gegl-0.3+  includes:            gegl.h+                     , src/GEGL/FFI/Tuple.h+  pkgconfig-depends:   gegl-0.3 >= 0.3.10+  build-depends:       base == 4.*+                     , inline-c+                     , containers+                     , random+                     , template-haskell+                     , split+                     , monad-loops+                     , glib+                     , babl++executable example00+  hs-source-dirs:      examples+  main-is:             example00.hs+  ghc-options:         -threaded -Wall+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+  if flag(examples)+    build-depends:       base+                       , gegl+  else+    buildable: False++executable example01+  hs-source-dirs:      examples+  main-is:             example01.hs+  ghc-options:         -threaded -Wall+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+  if flag(examples)+    build-depends:       base+                       , SDL+                       , gegl+                       , babl+                       , linear+                       , monad-loops+  else+    buildable: False++executable example02+  hs-source-dirs:      examples+  main-is:             example02.hs+  ghc-options:         -threaded -Wall -auto-all -caf-all -rtsopts+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+  if flag(examples)+    build-depends:       base+                       , sdl2+                       , gegl+                       , babl+                       , monad-loops+  else+    buildable: False
+ src/GEGL.hs view
@@ -0,0 +1,35 @@+-- | Central hub module of this library. reexports all necessary submodules+module GEGL+  ( gegl_init+  , gegl_exit+  , module Export+  ) where++import Foreign.Ptr (nullPtr)++import GEGL.Buffer as Export+import GEGL.Buffer.BufferIterator as Export+import GEGL.Color as Export+import GEGL.Connection as Export+import GEGL.Enums as Export+import GEGL.Node as Export+import GEGL.Node.State as Export+import GEGL.Operation as Export+import GEGL.Process as Export+import GEGL.Rectangle as Export+import GEGL.Reparent as Export++import qualified GEGL.FFI as FFI++-- relrod: Pretty straightforward here.++-- | Initialize the GEGL evnironment.+-- This function must be called before any other GEGL calls.+-- It does not pass any @argc@ or @argv@ values to 'FFI.c_gegl_init'+gegl_init :: IO ()+gegl_init = FFI.c_gegl_init nullPtr nullPtr++-- | Exit and clean up after GEGL has been used.+-- Must be called at the end of the program+gegl_exit :: IO ()+gegl_exit = FFI.c_gegl_exit
+ src/GEGL/Buffer.hs view
@@ -0,0 +1,279 @@+{-|+Module      : Gegl.Buffer+Description : Functions for Buffer manipulation+Copyright   : (c) Amedeo Molnár, 2015-2016+License     : LGPL-3+Maintainer  : nek0@nek0.eu+Stability   : experimental+Portability : POSIX++This module contains all functions necessary for manipulate 'GeglBuffer's.+Contents is roughly comparable to the functions provided by @gegl-buffer.h@ in+gegl-0.3.8.+-}+{-# LANGUAGE RecordWildCards #-}+module GEGL.Buffer+  ( FFI.GeglBuffer(..)+  , gegl_buffer_new+  , gegl_buffer_default_new+  , gegl_buffer_save+  , gegl_buffer_load+  , gegl_buffer_flush+  , gegl_buffer_create_sub_buffer+  , gegl_buffer_get_extent+  , gegl_buffer_set_extent+  -- | Some convenience functions that operate on the basis of+  -- 'gegl_buffer_get_extent'.+  , gegl_buffer_get_x+  , gegl_buffer_get_y+  , gegl_buffer_get_height+  , gegl_buffer_get_width+  , gegl_buffer_get_pixel_count+  -- | Returning to main functions+  , gegl_buffer_set_color+  , gegl_buffer_set_pattern+  -- , gegl_buffer_iterator_new+  , gegl_buffer_clear+  , gegl_buffer_get+  ) where++import qualified GEGL.FFI.Buffer as FFI+import qualified GEGL.FFI.Rectangle as FFI (GeglRectangle(..))+import qualified GEGL.FFI.Color as FFI (GeglColor(..))++import GEGL.Enums (GeglAccessMode, GeglAbyssPolicy)++import BABL.Format (PixelFormat, babl_format)+import BABL.FFI.Format (BablFormatPtr(..))++import Foreign.Storable (peek)+import Foreign.C.String+import Foreign.C.Types (CDouble(..), CInt(..))+import Foreign.Ptr (nullPtr, Ptr(..))+import Foreign.Marshal (free)+import Foreign.Marshal.Utils (new)+import Foreign.Marshal.Alloc (malloc)++-- | Create a new 'GeglBuffer'.+gegl_buffer_new+  :: Maybe FFI.GeglRectangle -- ^ Geometry of the buffer. If 'Nothing' is passed+                             -- , the buffer is created empty+  -> BablFormatPtr           -- ^ Pixel format of the buffer+  -> IO FFI.GeglBuffer+gegl_buffer_new mrect (BablFormatPtr format) = do+  ptr <- case mrect of+    Just rect -> new rect+    Nothing   -> return nullPtr+  val <- FFI.GeglBuffer <$> FFI.c_gegl_buffer_new ptr format+  free ptr+  return val++-- | Creates a new 'GeglBuffer', which defaults to an empty buffer with the 'RGBAfloat' format.+gegl_buffer_default_new :: IO FFI.GeglBuffer+gegl_buffer_default_new = FFI.GeglBuffer <$> FFI.c_gegl_buffer_new nullPtr nullPtr++-- | Create a new 'GeglBuffer' from a backend. If @Nothing@ is passed as geometry,+--   The extent will be inherited from the backend+gegl_buffer_new_for_backend+  :: Maybe FFI.GeglRectangle -- ^ Geometry+  -> Ptr a                   -- ^ Backend+  -> IO FFI.GeglBuffer       -- ^ New buffer+gegl_buffer_new_for_backend mext backend = do+  rectPtr <- case mext of+    Just ext -> new ext+    Nothing  -> return nullPtr+  buf <- FFI.GeglBuffer <$> FFI.c_gegl_buffer_new_for_backend rectPtr backend+  free rectPtr+  return buf++-- | Open an existing on-disk 'GeglBuffer'. The buffer is opened in a monitored+--   state so multiple instances of gegl can share the same buffer. Sets on one+--   buffer are reflected in th eother.+gegl_buffer_open+  :: FilePath          -- ^ Path to buffer+  -> IO FFI.GeglBuffer -- ^ The buffer+gegl_buffer_open fp = do+  cfp <- newCString fp+  ret <- FFI.GeglBuffer <$> FFI.c_gegl_buffer_open cfp+  free cfp+  return ret++-- | Write a 'GeglBuffer' to a file.+gegl_buffer_save+  :: FFI.GeglBuffer     -- Buffer to save+  -> FilePath           -- Path where to save+  -> FFI.GeglRectangle  -- Region of interest to write+  -> IO ()+gegl_buffer_save (FFI.GeglBuffer buf) fp roi = do+  croi <- new roi+  cfp  <- newCString fp+  FFI.c_gegl_buffer_save buf cfp croi+  free croi+  free cfp++-- | Load an existing buffer from disk.+gegl_buffer_load+  :: FilePath          -- File path to saved buffer+  -> IO FFI.GeglBuffer -- Resulting buffer+gegl_buffer_load path = do+  cpath <- newCString path+  ret <- FFI.GeglBuffer <$> FFI.c_gegl_buffer_load cpath+  free cpath+  return ret++-- | Flush all unsaved data to disk. This is not necessary for shared 'GeglBuffer's+--   opened with "gegl_buffer_open" since they auto-sync on writes.+gegl_buffer_flush+  :: FFI.GeglBuffer -- ^ Buffer to flush+  -> IO ()+gegl_buffer_flush (FFI.GeglBuffer buf) =+  FFI.c_gegl_buffer_flush buf++-- | Create a new sub 'GeglBuffer', that is a view on a larger buffer.+gegl_buffer_create_sub_buffer+  :: FFI.GeglBuffer    -- ^ Parent buffer+  -> FFI.GeglRectangle -- ^ Coordinates of new buffer+  -> IO FFI.GeglBuffer -- ^ Child buffer+gegl_buffer_create_sub_buffer (FFI.GeglBuffer buf) rect = do+  crect <- new rect+  ret <- FFI.GeglBuffer <$> FFI.c_gegl_buffer_create_sub_buffer buf crect+  free crect+  return ret++-- | Retrieve position and size of the area considered active in a buffer.+gegl_buffer_get_extent+  :: FFI.GeglBuffer       -- ^ The buffer+  -> IO FFI.GeglRectangle -- ^ active area+gegl_buffer_get_extent (FFI.GeglBuffer buffer) = do+  rectPtr <- FFI.c_gegl_buffer_get_extent buffer+  rect <- peek rectPtr+  -- free rectPtr+  return rect++-- | Change postition and size of the area considered active in a buffer.+gegl_buffer_set_extent+  :: FFI.GeglBuffer    -- ^ The buffer+  -> FFI.GeglRectangle -- ^ New extent of the buffer+  -> IO Bool           -- ^ Returns 'True' on success, otherwise 'False'+gegl_buffer_set_extent (FFI.GeglBuffer buffer) rect = do+  ptr <- new rect+  val <- FFI.c_gegl_buffer_set_extent buffer ptr+  free ptr+  return val++-- | get X coordinate of the upper left corner of a buffer+gegl_buffer_get_x+  :: FFI.GeglBuffer -- ^ The buffer+  -> IO Int+gegl_buffer_get_x buffer = do+  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer+  return rectangleX++-- | get Y coordinate of the upper left corner of a buffer+gegl_buffer_get_y+  :: FFI.GeglBuffer -- ^ The buffer+  -> IO Int+gegl_buffer_get_y buffer = do+  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer+  return rectangleY++-- | get height of a buffer+gegl_buffer_get_height+  :: FFI.GeglBuffer -- ^ The buffer+  -> IO Int+gegl_buffer_get_height buffer = do+  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer+  return rectangleHeight++-- | get width of a buffer+gegl_buffer_get_width+  :: FFI.GeglBuffer -- ^ The buffer+  -> IO Int+gegl_buffer_get_width buffer = do+  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer+  return rectangleWidth++-- | get pixel count of a buffer+gegl_buffer_get_pixel_count+  :: FFI.GeglBuffer -- ^ The buffer+  -> IO Int+gegl_buffer_get_pixel_count buffer = do+  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer+  return $ rectangleWidth * rectangleHeight++-- | Sets a region covered by a 'GeglRectangle' to a specified colour.+gegl_buffer_set_color+  :: FFI.GeglBuffer    -- ^ The buffer+  -> FFI.GeglRectangle -- ^ Area of the buffer to fill+  -> FFI.GeglColor     -- ^ The colour to fill with+  -> IO ()+gegl_buffer_set_color (FFI.GeglBuffer buffer) rect (FFI.GeglColor color) = do+  rectPtr <- new rect+  FFI.c_gegl_buffer_set_color buffer rectPtr color+  free rectPtr++-- | Fill a region with a repeating pattern.+gegl_buffer_set_pattern+  :: FFI.GeglBuffer    -- ^ Target buffer+  -> FFI.GeglRectangle -- ^ Area of target buffer to fill+  -> FFI.GeglBuffer    -- ^ A buffer to be repeated as pattern+  -> Double            -- ^ X offset+  -> Double            -- ^ Y offset+  -> IO ()+gegl_buffer_set_pattern+  (FFI.GeglBuffer buffer)+  rect+  (FFI.GeglBuffer pattern)+  xoff+  yoff+  = do+    rectPtr <- new rect+    let (cx, cy) = (CDouble xoff, CDouble yoff)+    FFI.c_gegl_buffer_set_pattern+      buffer+      rectPtr+      pattern+      cx+      cy+    free rectPtr++-- | Clear a provided rectangular region by setting all associated memory to 0.+gegl_buffer_clear+  :: FFI.GeglBuffer    -- ^ Target buffer+  -> FFI.GeglRectangle -- ^ Area to clear+  -> IO ()+gegl_buffer_clear (FFI.GeglBuffer buf) rect = do+  rectPtr <- new rect+  FFI.c_gegl_buffer_clear buf rectPtr+  free rectPtr++-- | Fetch a rectangular linear buffer of pixel data from the 'GeglBuffer',+-- convert it if neccessary and push it into a memory location.+gegl_buffer_get+  :: FFI.GeglBuffer          -- ^ Buffer to retrieve data from+  -> Maybe FFI.GeglRectangle -- ^ Coordinates to retrieve data from. If set to+                             -- 'Nothing' the whole buffer is taken.+  -> Double                  -- ^ Sampling scale+  -> Maybe BablFormatPtr     -- ^ Format to convert the data to. If set to 'Nothing'+                             -- no conversion is performed.+  -> Ptr a                   -- The memory destination to write the data to.+  -> Int                     -- Rowstride in bytes or @0@ to compute it+                             -- automatically from format+  -> GeglAbyssPolicy         -- Abyss policy+  -> IO ()+gegl_buffer_get (FFI.GeglBuffer buf) mrect scale mformat dest stride ap = do+  rect <- case mrect of+    Just r -> new r+    Nothing -> return nullPtr+  let format = case mformat of+        Just (BablFormatPtr ptr) -> ptr+        Nothing -> nullPtr+  FFI.c_gegl_buffer_get+    buf+    rect+    (CDouble scale)+    format+    dest+    (CInt $ fromIntegral stride)+    (CInt $ fromIntegral $ fromEnum ap)+  free rect
+ src/GEGL/Buffer/BufferIterator.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE BangPatterns, RecordWildCards #-}+-- | Module for iterating over buffers+module GEGL.Buffer.BufferIterator+  ( FFI.GeglBufferIterator(..)+  , gegl_buffer_iterator_new+  , gegl_buffer_iterator_next+  , Pixel(..)+  , FFI.ComponentValue(..)+  , pixelMap+  , pixelPoke+  ) where++import qualified GEGL.FFI.Buffer.BufferIterator as FFI++import GEGL.FFI.Buffer (GeglBuffer(..))+import GEGL.FFI.Rectangle++import GEGL.Enums+import GEGL.Color++import qualified BABL.Format as BF+import BABL.FFI.Format (BablFormatPtr(..))++import Foreign.Marshal.Utils (new)+import Foreign.Ptr+import Foreign.C.Types+import Foreign.Storable (peek, poke)++import Data.List.Split+import Data.Maybe (fromMaybe)+import Control.Monad.Loops (whileM_)++-- DEBUGGING++import Debug.Trace++-- | Data type to represent Pixels in iteration.+data Pixel = Pixel+  { pixelX     :: Int   -- ^ X coordinate+  , pixelY     :: Int   -- ^ Y coordinate+  , pixelData  ::+      ( FFI.ComponentValue+      , FFI.ComponentValue+      , FFI.ComponentValue+      , FFI.ComponentValue+      ) -- ^ Colour data+  }++-- | Create a new iterator over a specified area on a buffer.+gegl_buffer_iterator_new+  :: GeglBuffer      -- ^ Buffer to draw data from+  -> GeglRectangle   -- ^ Rectangle to iterate over+  -> BF.PixelFormat  -- ^ Format to process pixel data in+  -> GeglAccessMode  -- ^ Access mode to pixel data+  -> GeglAbyssPolicy -- ^ Abyss policy for pixel data+  -> IO FFI.GeglBufferIterator+gegl_buffer_iterator_new (GeglBuffer buf) roi format am ap = do+  roiPtr <- new roi+  (BablFormatPtr formatPtr) <- BF.babl_format format+  FFI.GeglBufferIterator <$> FFI.c_gegl_buffer_iterator_new+    buf+    roiPtr+    (CInt 0)+    formatPtr+    (marshal am)+    (marshal ap)++-- | This function fills the 'FFI.GeglBufferIterator' with its appropriate data+--   and returns 'True' as long as there is something to iterate over. Upon+--   returning 'False' the iterator is invalidated.+gegl_buffer_iterator_next+  :: FFI.GeglBufferIterator -- ^ Iterator to fill with data+  -> IO Bool+gegl_buffer_iterator_next (FFI.GeglBufferIterator ptr) =+  FFI.c_gegl_buffer_iterator_next ptr++-- | marshal an 'Enum' to a 'CInt'+marshal :: Enum e => e -> CInt+marshal = CInt . fromIntegral . fromEnum++-- | Simple iteration over a rectangle section of a buffer. Generates its own+--   iterator.+pixelPoke+  :: GeglBuffer               -- ^ Terget buffer+  -> GeglRectangle            -- ^ Rectangle to iterate over+  -> BF.PixelFormat           -- ^ Pixel format+  -> GeglAccessMode           -- ^ Access mode to pixel data+  -> GeglAbyssPolicy          -- ^ Abbyss policy for pixel data+  -> ((Int, Int) -> Pixel)    -- ^ Function to apply to each pixel+  -> IO ()+pixelPoke buf rect form am ap func = do+  (FFI.GeglBufferIterator iterPtr) <- gegl_buffer_iterator_new buf rect form am ap+  whileM_ (gegl_buffer_iterator_next (FFI.GeglBufferIterator iterPtr))+    (do+      roi <- FFI.c_gegl_peek_roi iterPtr+      let idx = [1..(rectangleWidth roi * rectangleHeight roi)]+          !newList = concatMap (pToC $ BF.babl_components_per_pixel form) $ map func $ map (flip iToCoord roi) idx+      FFI.c_gegl_poke_data iterPtr newList form+      )++-- | Simple iteration over a rectangle section of a buffer. Generates its own+--   iterator.+pixelMap+  :: GeglBuffer               -- ^ Terget buffer+  -> GeglRectangle            -- ^ Rectangle to iterate over+  -> BF.PixelFormat           -- ^ Pixel format+  -> GeglAccessMode           -- ^ Access mode to pixel data+  -> GeglAbyssPolicy          -- ^ Abbyss policy for pixel data+  -> (Pixel -> Pixel)         -- ^ Function to apply to each pixel+  -> IO ()+pixelMap buf rect form am ap func = do+  (FFI.GeglBufferIterator iterPtr) <- gegl_buffer_iterator_new buf rect form am ap+  whileM_ (gegl_buffer_iterator_next (FFI.GeglBufferIterator iterPtr))+    (do+      values <- FFI.c_gegl_peek_data iterPtr form+      roi <- FFI.c_gegl_peek_roi iterPtr+      let newList = mapPixel values form roi func+      FFI.c_gegl_poke_data iterPtr newList form+      )++-- | Function to map over all Pixel data and return them back altered+mapPixel+  :: [FFI.ComponentValue] -- ^ Input pixel data+  -> BF.PixelFormat       -- ^ PixelFormat of target buffer+  -> GeglRectangle        -- ^ Rectangle of Interest+  -> (Pixel -> Pixel)     -- ^ Function to apply on all Pixels+  -> [FFI.ComponentValue] -- ^ Resulting pixel data+mapPixel input format rect@GeglRectangle{..} funct =+  concatMap (pToC cpp) $ map funct $ map (cToP rect cpp) chunks+  where+    !cpp = BF.babl_components_per_pixel format+    chunks = zip [0..] $ chunksOf cpp input++iToCoord i GeglRectangle{..} =+  ( (rectangleX + ((i - 1) `mod` (rectangleWidth)))+  , (rectangleY + ((i - 1) `div` (rectangleWidth)))+  )++cToP rect cpp (i, pd) = Pixel (fst tup) (snd tup) $ toPixel cpp pd+  where+    tup = (iToCoord i rect)++pToC cpp (Pixel _ _ col) = toList cpp col++-- | Function to fill a Pixel with its colour data+toPixel+  :: Int                  -- Components per Pixel+  -> [FFI.ComponentValue] -- Color Data+  -> (FFI.ComponentValue, FFI.ComponentValue, FFI.ComponentValue, FFI.ComponentValue) -- ^ Pixel data+toPixel cpp d = case cpp of+  1 -> (head d, nullc , nullc , nullc)+  2 -> (head d, d !! 1, nullc , nullc)+  3 -> (head d, d !! 1, d !! 2, nullc)+  4 -> (head d, d !! 1, d !! 2, d !! 3)+  where+    !nullc = FFI.CVu32 0++-- | Function to turn Pixel data back to a list+toList+  :: Int -- ^ Components per Pixel+  -> (FFI.ComponentValue, FFI.ComponentValue, FFI.ComponentValue, FFI.ComponentValue) -- ^ Pixel data+  -> [FFI.ComponentValue] -- ^ Color Data+toList cpp (a, b ,c ,d) =+  case cpp of+   1 -> [a]+   2 -> [a, b]+   3 -> [a, b, c]+   4 -> [a, b, c, d]
+ src/GEGL/Color.hs view
@@ -0,0 +1,36 @@+module GEGL.Color+  ( FFI.GeglColor+  , Color(..)+  , gegl_color_new+  , gegl_color_set_rgba+  ) where++import Foreign.C.Types (CInt, CDouble(..))+import Foreign.C.String (withCString)+import Foreign.Ptr (Ptr)++import qualified GEGL.FFI.Color as FFI++-- ANOTHER HACKY POINTER!!+-- type GeglColorDummy = CInt+-- newtype GeglColor = GeglColor (Ptr GeglColorDummy)++data Color = RGB Double Double Double+  | RGBA Double Double Double Double++instance Show Color where+  show (RGB r g b)    = "rgb(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ ")"+  show (RGBA r g b a) = "rgba(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")"++-- | Create a new 'GeglColor'+gegl_color_new :: Color -> IO FFI.GeglColor+gegl_color_new (RGB r g b) = FFI.GeglColor <$> withCString+  (show $ RGB r g b) FFI.c_gegl_color_new+gegl_color_new (RGBA r g b a) = FFI.GeglColor <$> withCString+  (show $ RGBA r g b a) FFI.c_gegl_color_new+-- gegl_color_new _ = error "Colors other than RGB are not yet implemented"++-- | Set the color of a 'GeglColor'+gegl_color_set_rgba :: FFI.GeglColor -> Color -> IO ()+gegl_color_set_rgba (FFI.GeglColor col) (RGBA r g b a) =+  FFI.c_gegl_color_set_rgba col (CDouble r) (CDouble g) (CDouble b) (CDouble a)
+ src/GEGL/Connection.hs view
@@ -0,0 +1,87 @@+-- | This module contains functions for managing connections between nodes+module GEGL.Connection+  ( gegl_node_link+  , gegl_node_link_many+  , gegl_node_connect_to+  , gegl_node_connect_from+  , gegl_node_disconnect+  ) where++import Foreign.C.String (newCString)+import Foreign.Marshal.Alloc (free)+import Foreign.ForeignPtr (withForeignPtr)++import qualified GEGL.FFI.Connection as FFI+import GEGL.FFI.Node (GeglNode(..))++-- | Simple function to connect the @output@ pad of the source to the @input@ pad of the sink.+gegl_node_link+  :: GeglNode -- ^ Source node+  -> GeglNode -- ^ Sink node+  -> IO ()+gegl_node_link (GeglNode fsource) (GeglNode fsink) =+  withForeignPtr fsource (\source -> withForeignPtr fsink (\sink ->+    FFI.c_gegl_node_link source sink))++-- | Function to link together a chain of nodes+gegl_node_link_many+  :: [GeglNode] -- ^ List of nodes to connect ordered from first source to last sink.+  -> IO ()+gegl_node_link_many []    = return ()+gegl_node_link_many ([n]) = return ()+gegl_node_link_many (n:ns) = do+  gegl_node_link n (head ns)+  gegl_node_link_many ns++-- | Make connections between specific pads of nodes+gegl_node_connect_to+  :: GeglNode -- ^ Source node+  -> String   -- ^ Name <of the output pad from the source node+  -> GeglNode -- ^ Sink node+  -> String   -- ^ Name of the input pad to the sink node+  -> IO Bool+gegl_node_connect_to (GeglNode fsource) outpad (GeglNode fsink) inpad = do+  coutpad <- newCString outpad+  cinpad  <- newCString inpad+  cout <-+    withForeignPtr fsource (\source ->+      withForeignPtr fsink (\sink ->+        FFI.c_gegl_node_connect_to source coutpad sink cinpad))+  free coutpad+  free cinpad+  if cout == 0+    then return False+    else return True++-- | Make connections between specific pads of nodes.+--   Order of nodes and pads is reversed to the order in 'gegl_node_connect_to'.+gegl_node_connect_from+  :: GeglNode -- ^ Sink node+  -> String   -- ^ Nam of the input pad to the sink node+  -> GeglNode -- ^ Sink node+  -> String   -- ^ Name of the input pad to the sink node+  -> IO Bool+gegl_node_connect_from (GeglNode fsink) inpad (GeglNode fsource) outpad = do+  cinpad  <- newCString inpad+  coutpad <- newCString outpad+  cout <- withForeignPtr fsink (\sink ->+    withForeignPtr fsource (\source ->+      FFI.c_gegl_node_connect_from sink cinpad source coutpad))+  free cinpad+  free coutpad+  if cout == 0+    then return False+    else return True++-- | Disconnect a node connected to specified input pad+gegl_node_disconnect+  :: GeglNode -- Node to disconnect from+  -> String   -- Name of pad to e disconnected+  -> IO Bool  -- returns @True@ if a node was disconnected, otherwise @False@+gegl_node_disconnect (GeglNode fnode) pad = do+  cpad <- newCString pad+  cout <- withForeignPtr fnode $ flip FFI.c_gegl_node_disconnect cpad+  free cpad+  if cout == 0+    then return False+    else return True
+ src/GEGL/Enums.hs view
@@ -0,0 +1,102 @@+-- | Module containing enums from GEGL+module GEGL.Enums+  ( GeglAccessMode(..)+  , GeglAbyssPolicy(..)+  , GeglOrientation(..)+  , GeglSamplerType(..)+  , GeglBlitFlag(..)+  ) where++-- | Access mode to buffers+data GeglAccessMode+  = GeglAccessRead+  | GeglAccessWrite+  | GeglAccessReadWrite+  deriving (Eq, Show)++instance Enum GeglAccessMode where+  fromEnum GeglAccessRead      = 1+  fromEnum GeglAccessWrite     = 2+  fromEnum GeglAccessReadWrite = 3++  toEnum 1 = GeglAccessRead+  toEnum 2 = GeglAccessWrite+  toEnum 3 = GeglAccessReadWrite+  toEnum unmatched = error ("GeglAccessMode.toEnum: Cannot match " ++ show unmatched)++-- | I don't know+data GeglAbyssPolicy+  = GeglAbyssNone+  | GeglAbyssClamp+  | GeglAbyssLoop+  | GeglAbyssBlack+  | GeglAbyssWhite+  deriving (Eq, Show)++instance Enum GeglAbyssPolicy where+  fromEnum GeglAbyssNone  = 0+  fromEnum GeglAbyssClamp = 1+  fromEnum GeglAbyssLoop  = 2+  fromEnum GeglAbyssBlack = 3+  fromEnum GeglAbyssWhite = 4++  toEnum 0 = GeglAbyssNone+  toEnum 1 = GeglAbyssClamp+  toEnum 2 = GeglAbyssLoop+  toEnum 3 = GeglAbyssBlack+  toEnum 4 = GeglAbyssWhite+  toEnum unmatched = error ("GeglAbyssPolicy.toEnum: cannot match " ++ show unmatched)++-- | Orientation of a buffer+data GeglOrientation+  = GeglOrientationHorizontal+  | GeglOrientationVertical+  deriving (Eq, Show)++instance Enum GeglOrientation where+  fromEnum GeglOrientationHorizontal = 0+  fromEnum GeglOrientationVertical   = 1++  toEnum 0 = GeglOrientationHorizontal+  toEnum 1 = GeglOrientationVertical+  toEnum unmatched = error ("GeglOrientation.toEnum: cannot match " ++ show unmatched)++data GeglSamplerType+  = GeglSamplerNearest+  | GeglSamplerLinear+  | GeglSamplerCubic+  | GeglSamplerNohalo+  | GeglSamplerLohalo+  deriving (Eq, Show)++instance Enum GeglSamplerType where+  fromEnum GeglSamplerNearest = 0+  fromEnum GeglSamplerLinear  = 1+  fromEnum GeglSamplerCubic   = 2+  fromEnum GeglSamplerNohalo  = 3+  fromEnum GeglSamplerLohalo  = 4++  toEnum 0 = GeglSamplerNearest+  toEnum 1 = GeglSamplerLinear+  toEnum 2 = GeglSamplerCubic+  toEnum 3 = GeglSamplerNohalo+  toEnum 4 = GeglSamplerLohalo+  toEnum unmatched = error ("GeglSamplerType.toEnum: cannot match " ++ show unmatched)++-- | enum type for blit flags+data GeglBlitFlag+  = GeglBlitDefault -- ^ Default blitting. nothing special and sufficient in+                    --   most cases+  | GeglBlitCache   -- ^ Set up a cache for any subsequent requests of image+                    --   data from this node.+  | GeglBlitDirty   -- ^ Return the latest rendered results in cache without+                    --   regard to wether the regions had been rendered or not.++instance Enum GeglBlitFlag where+  fromEnum GeglBlitDefault = 0+  fromEnum GeglBlitCache   = 1+  fromEnum GeglBlitDirty   = 2+  toEnum 0 = GeglBlitDefault+  toEnum 1 = GeglBlitCache+  toEnum 2 = GeglBlitDirty+  toEnum u = error ("GeglBlitFlag.toEnum: cannot match " ++ show u)
+ src/GEGL/FFI.hs view
@@ -0,0 +1,21 @@+-- | FFI module fir initiation and exiting of GEGL+module GEGL.FFI+  ( c_gegl_init+  , c_gegl_exit+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String (CString)++-- | Interface to the @gegl_init@ function in C+foreign import ccall unsafe "gegl.h gegl_init"+  c_gegl_init+    :: Ptr CInt    -- ^Pointer to @argc@+    -> Ptr CString -- ^@argv@ list+    -> IO ()++-- | Interface to the @gegl_exit@ function in C+foreign import ccall unsafe "gegl.h gegl_exit"+  c_gegl_exit :: IO ()
+ src/GEGL/FFI/Buffer.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | FFI moule for managing and manipulating buffers+module GEGL.FFI.Buffer+  ( GeglBuffer(..)+  , GeglBufferDummy+  , c_gegl_buffer_new+  , c_gegl_buffer_new_for_backend+  , c_gegl_buffer_open+  , c_gegl_buffer_save+  , c_gegl_buffer_load+  , c_gegl_buffer_flush+  , c_gegl_buffer_create_sub_buffer+  , c_gegl_buffer_get_extent+  , c_gegl_buffer_set_extent+  , c_gegl_buffer_set_color+  , c_gegl_buffer_set_pattern+  , c_gegl_buffer_clear+  , c_gegl_buffer_get+  ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Foreign.Ptr++import GEGL.FFI.Rectangle (GeglRectangle)+import GEGL.FFI.Color     (GeglColorDummy)++import BABL.FFI.Format (BablFormatDummy)++-- | Pointer holding a buffer. Never peek or poke it.+type GeglBufferDummy = Ptr ()+-- | Outward representation of the buffer.+data GeglBuffer = GeglBuffer GeglBufferDummy++-- | Interface to the @gegl_buffer_new@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_new"+  c_gegl_buffer_new+    :: Ptr GeglRectangle  -- ^ Buffer geometry+    -> BablFormatDummy  -- ^ Color format+    -> IO GeglBufferDummy -- ^ New buffer++-- | Interface to the @gegl_buffer_new_for_backend@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_new_for_backend"+  c_gegl_buffer_new_for_backend+    :: Ptr GeglRectangle  -- ^ Buffer geometry+    -> Ptr a              -- ^ The backend+    -> IO GeglBufferDummy -- ^ New buffer++-- | Interace to the @gegl_buffer_open@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_open"+  c_gegl_buffer_open+    :: CString            -- Path to buffer on disc+    -> IO GeglBufferDummy -- The buffer++-- | Interface to the @gegl_buffer_save@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_save"+  c_gegl_buffer_save+    :: GeglBufferDummy+    -> CString+    -> Ptr GeglRectangle+    -> IO ()++-- | Interface to the @gegl_buffer_load@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_load"+  c_gegl_buffer_load+    :: CString+    -> IO GeglBufferDummy++-- | Interface to the @gegl_buffer_flush@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_flush"+  c_gegl_buffer_flush+    :: GeglBufferDummy+    -> IO ()++-- | Interface to the @gegl_buffer_create_sub_buffer@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_create_sub_buffer"+  c_gegl_buffer_create_sub_buffer+    :: GeglBufferDummy+    -> Ptr GeglRectangle+    -> IO GeglBufferDummy++-- | Interface to the @gegl_buffer_get_extent@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_get_extent"+  c_gegl_buffer_get_extent+    :: GeglBufferDummy+    -> IO (Ptr GeglRectangle)++-- | Interface to the @gegl_buffer_set_extent@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_set_extent"+  c_gegl_buffer_set_extent+    :: GeglBufferDummy   -- ^ A buffer+    -> Ptr GeglRectangle -- ^ Geometry+    -> IO Bool           -- ^ Returns True on success++-- | Interface to the @gegl_buffer_set_color@ funciton in C.+foreign import ccall unsafe "gegl.h gegl_buffer_set_color"+  c_gegl_buffer_set_color+    :: GeglBufferDummy   -- ^ The buffer+    -> Ptr GeglRectangle -- ^ Rectangular region to fill+    -> GeglColorDummy    -- ^ The colour to fill with.+    -> IO ()++-- | Interface to the @gegl_bufer_set_pattern@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_set_pattern"+  c_gegl_buffer_set_pattern+    :: GeglBufferDummy   -- ^ The target buffer+    -> Ptr GeglRectangle -- ^ rectangular region to fill+    -> GeglBufferDummy   -- ^ A buffer to be repeated as pattern+    -> CDouble           -- ^ X offset+    -> CDouble           -- ^ Y offset+    -> IO ()++-- | Interface to the @gegl_buffer_clear@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_clear"+  c_gegl_buffer_clear+    :: GeglBufferDummy   -- ^ The target buffer+    -> Ptr GeglRectangle -- ^ Region to clear+    -> IO ()++-- | Interface to the @gegl_bufer_get@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_get"+  c_gegl_buffer_get+    :: GeglBufferDummy   -- ^ Buffer to retrieve data from+    -> Ptr GeglRectangle -- ^ Coordinates to retrieve from+    -> CDouble           -- ^ Sampling scale+    -> BablFormatDummy   -- ^ 'BablFormat' to store the data in+    -> Ptr a             -- ^ Memory destination+    -> CInt              -- ^ Rowstride in bytes or 0 to compute it from format+    -> CInt              -- ^ Repeat mode+    -> IO ()
+ src/GEGL/FFI/Buffer/BufferIterator.c view
@@ -0,0 +1,65 @@++#include <assert.h>++#include <gegl.h>++#include "../Tuple.h"++tupleFloat * inline_c_GEGL_FFI_Buffer_BufferIterator_0_1831a23e0118f482df02956ef1eb02a84f0e671c(void * ptr_inline_c_0) {++        static GeglBufferIterator * cptr = NULL;+        static tupleFloat tuple;+        cptr = (GeglBufferIterator *)ptr_inline_c_0;+        tuple.length = cptr->length;+        tuple.data = (float *)cptr->data[0];+        return &tuple;+        +}+++tupleDouble * inline_c_GEGL_FFI_Buffer_BufferIterator_1_51c054c6c978ae9f3fc5630022a381571c7a1524(void * ptr_inline_c_0) {++        static GeglBufferIterator * cptr = NULL;+        static tupleDouble tuple;+        cptr = (GeglBufferIterator *)ptr_inline_c_0;+        tuple.length = cptr->length;+        tuple.data = (double *)cptr->data[0];+        return &tuple;+        +}+++void * inline_c_GEGL_FFI_Buffer_BufferIterator_2_de0f7acc11c61b183ca1277d40ca649aafa35892(void * ptr_inline_c_0) {++    static void * a = NULL;+    static GeglBufferIterator * cptr = NULL;+    cptr = (GeglBufferIterator *)ptr_inline_c_0;+    a = (void *)&cptr->roi[0];+    return a;+    +}+++float * inline_c_GEGL_FFI_Buffer_BufferIterator_3_dcef8b82035075438589ca8d9e20bdf2fad70d9a(void * ptr_inline_c_0) {++        static GeglBufferIterator * cptr = NULL;+        static float * a = NULL;+        cptr = ptr_inline_c_0;+        a = (float *) cptr->data[0];+        assert(a != NULL);+        return a;+      +}+++double * inline_c_GEGL_FFI_Buffer_BufferIterator_4_efe11e65b31123ebafbebed88dbd7fc0fc1d84ac(void * ptr_inline_c_0) {++        static GeglBufferIterator * cptr;+        static double * a;+        cptr = ptr_inline_c_0;+        a = (double *) cptr->data[0];+        assert(a != NULL);+        return a;+      +}+
+ src/GEGL/FFI/Buffer/BufferIterator.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE BangPatterns #-}++-- | FFI module for Buffer iterators+module GEGL.FFI.Buffer.BufferIterator+  ( GeglBufferIterator(..)+  , GeglBufferIteratorDummy+  , c_gegl_buffer_iterator_new+  , c_gegl_buffer_iterator_next+  , ComponentValue(..)+  , c_gegl_peek_data+  , c_gegl_peek_roi+  , c_gegl_poke_data+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types+import Foreign.Marshal.Array++import GEGL.FFI.Rectangle (GeglRectangle(..))+import GEGL.FFI.Buffer    (GeglBufferDummy)+import GEGL.FFI.Tuple++import BABL.FFI.Format    (BablFormatDummy)+import BABL.Format++import Data.Monoid ((<>))++import qualified Language.C.Inline as C+import qualified Language.C.Types as C+import qualified Language.C.Inline.Context as C++import Debug.Trace++C.context (C.baseCtx <> tupleCtx)++-- DEBUGGING++C.include "<assert.h>"++-- /DEBUGGING++C.include "<gegl.h>"+C.include "../Tuple.h"++newtype GeglBufferIterator = GeglBufferIterator GeglBufferIteratorDummy++type GeglBufferIteratorDummy = Ptr ()++-- | Interface the the @gegl_buffer_iterator_new@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_iterator_new"+  c_gegl_buffer_iterator_new+    :: GeglBufferDummy   -- ^ Buffer to draw data from+    -> Ptr GeglRectangle -- ^ Rectangle to iterate over+    -> CInt              -- ^ Representation of level+    -> BablFormatDummy   -- ^ Format to process the buffer data in+    -> CInt              -- ^ Representation of set 'GeglAccessMode'+    -> CInt              -- ^ Representation of set 'GeglAbyssPolicy'+    -> IO GeglBufferIteratorDummy++-- | Interface to the @gegl_buffer_iterator_next@ function in C.+foreign import ccall unsafe "gegl.h gegl_buffer_iterator_next"+  c_gegl_buffer_iterator_next+    :: GeglBufferIteratorDummy -- ^ Iterator to manipulate+    -> IO Bool++-- | Container type for component values+data ComponentValue+  = CVhalf CUShort+  | CVfloat CFloat+  | CVdouble CDouble+  | CVu8 CUChar+  | CVu15 CUShort+  | CVu16 CUShort+  | CVu32 CUInt+  | CVa8 CUChar+  | CVrgb24 CUChar+  | CVrgba32 CUChar++-- | Get the list of pixel data out of a 'GeglBufferIterator'.+c_gegl_peek_data+  :: GeglBufferIteratorDummy -- ^ Iterator to take data from+  -> PixelFormat             -- ^ Pixel format of iterator+  -> IO [ComponentValue]+c_gegl_peek_data ptr form = do+  let pitch = babl_components_per_pixel form+  case pfType form of+    CFfloat -> do+      tupPtr <- [C.block| tupleFloat * {+        static GeglBufferIterator * cptr = NULL;+        static tupleFloat tuple;+        cptr = (GeglBufferIterator *)$(void * ptr);+        tuple.length = cptr->length;+        tuple.data = (float *)cptr->data[0];+        return &tuple;+        }|]+      tup <- peek tupPtr+      let clength = tupleFloatLength tup+          fptr    = tupleFloatData tup+          flength (CInt c) = fromIntegral c :: Int+          length = flength clength+      arr <- peekArray (length * pitch) fptr+      return $ map CVfloat arr+    CFdouble -> do+      tupPtr <- [C.block| tupleDouble * {+        static GeglBufferIterator * cptr = NULL;+        static tupleDouble tuple;+        cptr = (GeglBufferIterator *)$(void * ptr);+        tuple.length = cptr->length;+        tuple.data = (double *)cptr->data[0];+        return &tuple;+        }|]+      tup <- peek tupPtr+      let clength = tupleDoubleLength tup+          dptr    = tupleDoubleData tup+          dlength (CInt c) = fromIntegral c :: Int+          length = dlength clength+      arr <- peekArray (length * pitch) dptr+      return $ map CVdouble arr+    _ ->+      error "not yet implemented!"++-- | Returns the current roi Rectangle+c_gegl_peek_roi+  :: GeglBufferIteratorDummy -- ^ Iterator to peek data from+  -> IO GeglRectangle        -- ^ Rectangle of interest+c_gegl_peek_roi ptr = do+  roiptr <- [C.block| void * {+    static void * a = NULL;+    static GeglBufferIterator * cptr = NULL;+    cptr = (GeglBufferIterator *)$(void * ptr);+    a = (void *)&cptr->roi[0];+    return a;+    }|]+  peek (castPtr roiptr :: Ptr GeglRectangle)++-- | Return a list of pixel data to a 'GeglBufferIterator'+c_gegl_poke_data+  :: GeglBufferIteratorDummy -- ^ Iterator to return data to+  -> [ComponentValue]                -- ^ Pixel data+  -> PixelFormat             -- ^ Format the data are in+  -> IO ()+c_gegl_poke_data ptr vs form =+  case pfType form of+    CFfloat -> do+      let rfs = map (\(CVfloat f) -> f) vs+      rptr <- [C.block| float * {+        static GeglBufferIterator * cptr = NULL;+        static float * a = NULL;+        cptr = $(void * ptr);+        a = (float *) cptr->data[0];+        assert(a != NULL);+        return a;+      }|]+      pokeArray rptr rfs+    CFdouble -> do+      let rfs = map (\(CVdouble d) -> d) vs+      rptr <- [C.block| double * {+        static GeglBufferIterator * cptr;+        static double * a;+        cptr = $(void * ptr);+        a = (double *) cptr->data[0];+        assert(a != NULL);+        return a;+      }|]+      pokeArray rptr rfs+    _ -> error "not yet implemented"
+ src/GEGL/FFI/Color.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module GEGL.FFI.Color+  ( GeglColor(..)+  , GeglColorDummy+  , c_gegl_color_new+  , c_gegl_color_set_rgba+  ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String (CString)++-- import GEGL.Color++-- ANOTHER HACKY POINTER!!!+type GeglColorDummy = Ptr ()+newtype GeglColor = GeglColor GeglColorDummy++foreign import ccall unsafe "gegl.h gegl_color_new"+  c_gegl_color_new :: CString -> IO GeglColorDummy++foreign import ccall unsafe "gegl.h gegl_color_set_rgba"+  c_gegl_color_set_rgba :: GeglColorDummy -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()
+ src/GEGL/FFI/Connection.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | FFI module for handling connections between nodes+module GEGL.FFI.Connection+  ( c_gegl_node_connect_from+  , c_gegl_node_connect_to+  , c_gegl_node_link+  , c_gegl_node_disconnect+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String (CString)++-- | Interface to the @gegl_node_link@ function in C+foreign import ccall unsafe "gegl.h gegl_node_link"+  c_gegl_node_link+    :: Ptr () -- ^ Source node representation+    -> Ptr () -- ^ Sink node representation+    -> IO ()++-- | Interface to the @gegl_node_connect_to@ function in C+foreign import ccall unsafe "gegl.h gegl_node_connect_to"+  c_gegl_node_connect_to+    :: Ptr () -- ^ Source node representation+    -> CString       -- ^ Name of the output pad at the source node+    -> Ptr () -- ^ Sink node representation+    -> CString       -- ^ Name of input pad at the sink node+    -> IO CInt++-- | Interface to the @gegl_node_connect_from@ function in C+foreign import ccall unsafe "gegl.h gegl_node_connect_from"+  c_gegl_node_connect_from+    :: Ptr () -- ^ Sink node representation+    -> CString       -- ^ Name of the input pad at the sink node+    -> Ptr () -- ^ Source node representation+    -> CString       -- ^ Name of the output pad at the source node+    -> IO CInt++foreign import ccall unsafe "gegl.h gegl_node_disconnect"+  c_gegl_node_disconnect+    :: Ptr ()+    -> CString+    -> IO CInt
+ src/GEGL/FFI/Node.c view
@@ -0,0 +1,87 @@++#include <gegl.h>++void inline_c_GEGL_FFI_Node_0_d903ae14d4850d134dc0081c916a920b5e7ae9b3(void * node_inline_c_0, char * cname_inline_c_1, int cval_inline_c_2) {++    gegl_node_set(node_inline_c_0+      , cname_inline_c_1+      , cval_inline_c_2+      , NULL);+}+++void inline_c_GEGL_FFI_Node_1_e72af6b472926894da513b376a3f0c626551a195(void * node_inline_c_0, char * cname_inline_c_1, char * cval_inline_c_2) {++    gegl_node_set(node_inline_c_0+      , cname_inline_c_1+      , cval_inline_c_2+      , NULL);+}+++void inline_c_GEGL_FFI_Node_2_7ae77fff57b71e56dd9d852a497ce47055761ed7(void * node_inline_c_0, char * cname_inline_c_1, double cval_inline_c_2) {++    gegl_node_set(node_inline_c_0+      , cname_inline_c_1+      , cval_inline_c_2+      , NULL+      );+}+++void inline_c_GEGL_FFI_Node_3_90cf3b6c58e5180e5fb738fbb7d973252c1d5241(void * node_inline_c_0, char * cname_inline_c_1, void * cval_inline_c_2) {++    gegl_node_set(node_inline_c_0+      , cname_inline_c_1+      , cval_inline_c_2+      , NULL);+}+++int inline_c_GEGL_FFI_Node_4_f8fd583ef904a21f5dd0955081e9e0efad39fad6(void * node_inline_c_0, char * cname_inline_c_1) {++    static int val;+    gegl_node_get(node_inline_c_0+      , cname_inline_c_1+      , &val+      , NULL);+    return val;+    +}+++char * inline_c_GEGL_FFI_Node_5_82f809d1a40cb21d19002715969403183d48543f(void * node_inline_c_0, char * cname_inline_c_1) {++    static char * val;+    gegl_node_get(node_inline_c_0+      , cname_inline_c_1+      , &val+      , NULL);+    return val;+    +}+++double inline_c_GEGL_FFI_Node_6_a165958fc607db5fbe0970371a663096a309a3eb(void * node_inline_c_0, char * cname_inline_c_1) {++    static double val;+    gegl_node_get(node_inline_c_0+      , cname_inline_c_1+      , &val+      , NULL);+    return val;+    +}+++void * inline_c_GEGL_FFI_Node_7_f3a7fc11e8eb45f16328ac011c780265c190c831(void * node_inline_c_0, char * cname_inline_c_1) {++    static void * val;+    gegl_node_get(node_inline_c_0+      , cname_inline_c_1+      , &val+      , NULL);+    return val;+    +}+
+ src/GEGL/FFI/Node.hs view
@@ -0,0 +1,190 @@+{-# 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;+    }+  |]
+ src/GEGL/FFI/Node/State.c view
@@ -0,0 +1,51 @@++#include <gegl.h>++#include "../Tuple.h"++nodeWithPad * inline_c_GEGL_FFI_Node_State_0_ac9208765d95bf704545ae6b0fd1df07ad75e808(void * node_inline_c_0, char * name_inline_c_1) {++    static nodeWithPad tuple;+    static GeglNode ** nodes;+    const static char ** pads;+    int len = gegl_node_get_consumers(+        node_inline_c_0+      , name_inline_c_1+      , &nodes+      , &pads+      );+    tuple.length = len;+    tuple.data = nodes;+    tuple.names = (char **)pads;+    return &tuple;+    +}+++producer * inline_c_GEGL_FFI_Node_State_1_67ef4472ccc467f2afeb6952810b83997fe47255(void * node_inline_c_0, char * name_inline_c_1) {++    static producer nwp;+    static GeglNode * node;+    static char * pad_name;+    node = gegl_node_get_producer(+        node_inline_c_0+      , name_inline_c_1+      , &pad_name+      );+    nwp.node = node;+    nwp.pad  = pad_name;+    return &nwp;+    +}+++void * inline_c_GEGL_FFI_Node_State_2_71af5ced9335e4ad354613012a9fce9e090c8fd6(void * node_inline_c_0) {++    static GeglRectangle a;+    static void * b;+    a = gegl_node_get_bounding_box(node_inline_c_0);+    b = (void *)&a;+    return b;+    +}+
+ src/GEGL/FFI/Node/State.hs view
@@ -0,0 +1,97 @@+{-# 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
+ src/GEGL/FFI/Process.hs view
@@ -0,0 +1,31 @@+-- | Module for handling node processing+module GEGL.FFI.Process+  ( c_gegl_node_process+  , c_gegl_node_blit+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types (CDouble(..), CInt(..))++import GEGL.FFI.Rectangle (GeglRectangle)++import BABL.FFI.Format (BablFormatDummy)++-- | Interface to the function @gegl_node_process@ in C.+foreign import ccall unsafe "gegl.h gegl_node_process"+  c_gegl_node_process+    :: Ptr () -- ^ A GEGL node representation+    -> IO ()++-- | Interface to the function @gegl_node_blit@ in C.+foreign import ccall unsafe "gegl.h gegl_node_blit"+  c_gegl_node_blit+    :: Ptr ()       -- ^ A GEGL node representation+    -> CDouble             -- ^ Scale+    -> Ptr GeglRectangle   -- ^ Area of interest+    -> BablFormatDummy     -- ^ Pixel format+    -> Ptr a               -- ^ Pointer to destination buffer+    -> CInt                -- ^ Row stride in bytes+    -> CInt                -- ^ OR'ed GEGL blit flags+    -> IO ()
+ src/GEGL/FFI/Rectangle.hsc view
@@ -0,0 +1,55 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | FFI module for defining and using rectangles+module GEGL.FFI.Rectangle+  ( GeglRectangle(..)+  , c_gegl_rectangle_intersect+  -- , c_gegl_rectangle_infinite_plane+  ) where++import Foreign+import Foreign.Ptr+import Foreign.C.Types++#include <gegl.h>++-- | A standard GEGL rectangle+data GeglRectangle = GeglRectangle+  { rectangleX      :: Int -- ^ X coordinate of upper left corner+  , rectangleY      :: Int -- ^ Y coordinate of upper left corner+  , rectangleWidth  :: Int -- ^ Width in pixels+  , rectangleHeight :: Int -- ^ Height in picels+  } deriving (Show)++instance Storable GeglRectangle where+  sizeOf _    = (#size GeglRectangle)+  alignment _ = alignment (undefined :: CDouble)+  peek ptr = do+    x      <- (#peek GeglRectangle, x) ptr :: IO CInt+    y      <- (#peek GeglRectangle, y) ptr :: IO CInt+    width  <- (#peek GeglRectangle, width) ptr :: IO CInt+    height <- (#peek GeglRectangle, height) ptr :: IO CInt+    return GeglRectangle+      { rectangleX      = fromIntegral x+      , rectangleY      = fromIntegral y+      , rectangleWidth  = fromIntegral width+      , rectangleHeight = fromIntegral height+      }+  poke ptr (GeglRectangle x y w h) = do+    (#poke GeglRectangle, x)      ptr (CInt $ fromIntegral x)+    (#poke GeglRectangle, y)      ptr (CInt $ fromIntegral y)+    (#poke GeglRectangle, width)  ptr (CInt $ fromIntegral w)+    (#poke GeglRectangle, height) ptr (CInt $ fromIntegral h)++-- | Interface to @gegl_rectangle_intersect@ function in C.+foreign import ccall unsafe "gegl.h gegl_rectangle_intersect"+  c_gegl_rectangle_intersect+    :: Ptr GeglRectangle -- ^ destination rectangle+    -> Ptr GeglRectangle -- ^ A Rectangle+    -> Ptr GeglRectangle -- ^ A rectangle+    -> IO Bool           -- ^ Returns @True@ if rectangles intersect++-- -- | Interface to the @gegl_rectangle_infinite_plane@ function in C.+-- foreign import ccall unsafe "gegl.h gegl_rectangle_infinite_plane"+--   c_gegl_rectangle_infinite_plane+--     :: GeglRectangle
+ src/GEGL/FFI/Reparent.hs view
@@ -0,0 +1,29 @@+-- | FFI module for reparenting nodes+module GEGL.FFI.Reparent+  ( c_gegl_node_add_child+  , c_gegl_node_remove_child+  , c_gegl_node_get_parent+  )+where++import Foreign++-- | Interface to the @gegl_node_add_child@ function in C.+foreign import ccall unsafe "gegl.h gegl_node_add_child"+  c_gegl_node_add_child+    :: Ptr ()    -- ^ Graph node+    -> Ptr ()    -- ^ Child node+    -> IO (Ptr ()) -- ^ The child++-- | Interface to the @gegl_node_remove_child@ function in C.+foreign import ccall unsafe "gegl.h gegl_node_remove_child"+  c_gegl_node_remove_child+    :: Ptr ()    -- ^ Graph node+    -> Ptr ()    -- ^ Child node+    -> IO (Ptr ()) -- ^ The child++-- | Interface to the @gegl_node_get_parent@ function in C.+foreign import ccall unsafe "gegl.h gegl_node_get_parent"+  c_gegl_node_get_parent+    :: Ptr ()    -- ^ A node+    -> IO (Ptr ()) -- ^ The parent of the node or NULL
+ src/GEGL/FFI/Tuple.hsc view
@@ -0,0 +1,107 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ForeignFunctionInterface #-}+module GEGL.FFI.Tuple where++import qualified Language.C.Inline as C+import qualified Language.C.Types as C+import qualified Language.C.Inline.Context as C++import qualified Data.Map as Map++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Foreign.Ptr+import GHC.Ptr as G++import qualified Language.Haskell.TH as TH++#def typedef struct {void * node; char * pad;} producer;+#def typedef struct {int length; void * data; char ** names;} nodeWithPad;+#def typedef struct {int length; float * data;} tupleFloat;+#def typedef struct {int length; double * data;} tupleDouble;++C.include "Tuple.h"++data Producer = Producer+  { prodNode :: Ptr ()+  , prodPad  :: CString+  }++instance Storable Producer where+  sizeOf    (Producer _ _) = (#size producer)+  alignment (Producer _ _) = alignment (undefined :: CDouble)+  peek ptr = do+    node <- (#peek producer, node) ptr+    pad  <- (#peek producer, pad) ptr+    return $ Producer node pad+  poke _ = error "poke undefined for Produer"++data NodeWithPad =+  NodeWithPad+    { nwpLength :: CInt+    , nwpData   :: Ptr (Ptr ())+    , nwpNames  :: Ptr CString+    }++instance Storable NodeWithPad where+  sizeOf    (NodeWithPad _ _ _) = (#size tupleFloat)+  alignment (NodeWithPad _ _ _) = alignment (undefined :: CDouble)+  peek ptr = do+    length <- (#peek nodeWithPad, length) ptr+    tdata  <- (#peek nodeWithPad, data) ptr+    names  <- (#peek nodeWithPad, names) ptr+    return $ NodeWithPad length tdata names+  poke ptr (NodeWithPad{..}) = do+    (#poke nodeWithPad, length) ptr nwpLength+    (#poke nodeWithPad, data)   ptr nwpData+    (#poke nodeWithPad, names)  ptr nwpNames++data TupleFloat =+  TupleFloat+    { tupleFloatLength :: CInt+    , tupleFloatData   :: Ptr CFloat+    }++instance Storable TupleFloat where+  sizeOf    (TupleFloat _ _) = (#size tupleFloat)+  alignment (TupleFloat _ _) = alignment (undefined :: CDouble)+  peek ptr = do+    length <- (#peek tupleFloat, length) ptr+    tdata  <- (#peek tupleFloat, data) ptr+    return $ TupleFloat length tdata+  poke ptr (TupleFloat{..}) = do+    (#poke tupleFloat, length) ptr tupleFloatLength+    (#poke tupleFloat, data)   ptr tupleFloatData++data TupleDouble =+  TupleDouble+    { tupleDoubleLength :: CInt+    , tupleDoubleData   :: Ptr CDouble+    }++instance Storable TupleDouble where+  sizeOf    (TupleDouble _ _) = (#size tupleDouble)+  alignment (TupleDouble _ _) = alignment (undefined :: CDouble)+  peek ptr = do+    length <- (#peek tupleDouble, length) ptr+    tdata  <- (#peek tupleDouble, data) ptr+    return $ TupleDouble length tdata+  poke ptr (TupleDouble{..}) = do+    (#poke tupleDouble, length) ptr tupleDoubleLength+    (#poke tupleDouble, data)   ptr tupleDoubleData++tupleCtx :: C.Context+tupleCtx = mempty+  { C.ctxTypesTable = tupleTypes+  }++tupleTypes :: Map.Map C.TypeSpecifier TH.TypeQ+tupleTypes = Map.fromList+  [ (C.TypeName "tupleFloat",  [t|TupleFloat|])+  , (C.TypeName "tupleDouble", [t|TupleDouble|])+  , (C.TypeName "nodeWithPad",   [t|NodeWithPad|])+  , (C.TypeName "producer",   [t|Producer|])+  ]
+ src/GEGL/Node.hs view
@@ -0,0 +1,92 @@+-- | 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
+ src/GEGL/Node/State.hs view
@@ -0,0 +1,54 @@+-- | In this module you will find methods to retrieve various sates from 'GeglNode's+module GEGL.Node.State+  ( gegl_node_get_consumers+  , gegl_node_get_producer+  , gegl_node_get_bounding_box+  ) where++import qualified GEGL.FFI.Node.State as FFI+import qualified GEGL.FFI.Node as FFI+import qualified GEGL.FFI.Rectangle as FFI++import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc (free)+import Foreign.Storable (peek)++-- | Retrieve which pads on which nodes are connected to a named output pad.+gegl_node_get_consumers+  :: FFI.GeglNode                -- ^ 'GeglNode' to retrieve from+  -> String                      -- ^ Name of the output pad+  -> IO [(FFI.GeglNode, String)] -- ^ List of consuming nodes+gegl_node_get_consumers (FFI.GeglNode node) name = do+  cname <- newCString name+  ptrs  <- withForeignPtr node $ \ptr -> FFI.c_gegl_node_get_consumers ptr cname+  nodes <- mapM (\nodePtr -> FFI.GeglNode <$> newForeignPtr_ (fst nodePtr)) ptrs+  names <- mapM (\nodePtr -> peekCString $ snd nodePtr) ptrs+  free cname+  return $ zip nodes names++gegl_node_get_producer+  :: FFI.GeglNode+  -> String+  -> IO (Maybe (FFI.GeglNode, String))+gegl_node_get_producer (FFI.GeglNode fnode) name = do+  cname <- newCString name+  mtup <- withForeignPtr fnode $ \node -> FFI.c_gegl_node_get_producer node cname+  free cname+  case mtup of+    Just (pnode, pcname) -> do+      pfnode <- FFI.GeglNode <$> newForeignPtr_ pnode+      pname  <- peekCString pcname+      return $ Just $ (pfnode, pname)+    Nothing ->+      return Nothing++-- | Get the bounding box of a 'GeglNode'+gegl_node_get_bounding_box+  :: FFI.GeglNode         -- ^ The 'GeglNode'+  -> IO FFI.GeglRectangle -- ^ resulting bounding box+gegl_node_get_bounding_box (FFI.GeglNode fnode) = do+  ptr <- withForeignPtr fnode $ \node -> FFI.c_gegl_node_get_bounding_box node+  rect <- peek ptr+  free ptr+  return rect
+ src/GEGL/Operation.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE ExistentialQuantification, RankNTypes #-}++-- | This module contains the image manipulation primitives of GEGL, called Operations.+-- Some of these have defaults, which can be invoked by calling 'Data.Default.def'.+-- Those operations with no defaults are marked accordingly.+module GEGL.Operation+  ( Operation(..)+  , Property(..)+  , PropertyValue(..)+  , loadOperation+  , cropOperation+  , defaultCropOperation+  , textOperation+  , defaultTextOperation+  -- , defaultFractalExplorerOperation+  , pngSaveOperation+  , defaultPNGSaveOperation+  , checkerboardOperation+  , defaultCheckerboardOperation+  , overOperation+  , defaultOverOperation+  , bufferSourceOperation+  , translateOperation+  , FractalType(..)+  , FractalMode(..)+  ) where++import Foreign.C.Types+import Foreign.C.String+import Foreign.Storable(Storable(..))+import Foreign.Ptr (Ptr)++import GEGL.FFI.Color (GeglColor(..))+import GEGL.FFI.Buffer (GeglBuffer(..))+import GEGL.Color (Color(..))++import BABL.Format (PixelFormat)++data Property = Property+  { propertyName :: String+  , propertyValue :: PropertyValue+  }++data PropertyValue+  = PropertyInt Int+  | PropertyString String+  | PropertyDouble Double+  | PropertyColor Color+  | PropertyFormat PixelFormat+  | PropertyBuffer GeglBuffer+  | PropertyPointer (Ptr ())++data Operation = Operation+  { operationName :: String+  , operationParams :: [Property]+  }++-- | Simple Operation to load image files. Is agnostic to image format.+-- This operation has no default.+loadOperation :: [Property] -> Operation+loadOperation = Operation "gegl:load"++-- | Operation for cropping a buffer.+cropOperation :: [Property] -> Operation+cropOperation = Operation "gegl:crop"++defaultCropOperation :: Operation+defaultCropOperation = cropOperation []++-- | A PNG image saving operation.+pngSaveOperation :: [Property] -> Operation+pngSaveOperation = Operation "gegl:png-save"++defaultPNGSaveOperation :: Operation+defaultPNGSaveOperation = pngSaveOperation []++-- | Operation for rendering strings of text.+textOperation :: [Property] -> Operation+textOperation = Operation "gegl:text"++defaultTextOperation :: Operation+defaultTextOperation = textOperation []++-- | Layover operation.+overOperation :: [Property] -> Operation+overOperation = Operation "gegl:over"++defaultOverOperation :: Operation+defaultOverOperation = overOperation []++-- | Create a checkerboard pattern.+checkerboardOperation :: [Property] -> Operation+checkerboardOperation = Operation "gegl:checkerboard"++defaultCheckerboardOperation :: Operation+defaultCheckerboardOperation = checkerboardOperation []++-- | Use an existing 'GeglBuffer' as image source.+--   This operation has no default.+bufferSourceOperation :: [Property] -> Operation+bufferSourceOperation = Operation "gegl:buffer-source"++-- | Translate an existing buffer+translateOperation :: [Property] -> Operation+translateOperation = Operation "gegl:translate"++-- | Type for defining the fractal type in 'FractalExplorerOperation'.+data FractalType+  = Mandelbrot+  | Julia+  | Barnsley1+  | Barnsley2+  | Barnsley3+  | Spider+  | ManOWar+  | Lambda+  | Sierpinsky++-- | Type for defining the color mode in 'FractalExplorerOperation'.+data FractalMode+  = Sine+  | Cosine+  | None
+ src/GEGL/Process.hs view
@@ -0,0 +1,50 @@+-- | Module for handling processing with GEGL+module GEGL.Process+  ( gegl_node_process+  , gegl_node_blit+  ) where++import Data.Bits++import Foreign.Marshal (free)+import Foreign.Marshal.Utils (new)+import Foreign.Ptr (Ptr)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.C.Types (CInt(..), CDouble(..))++import GEGL.Enums (GeglBlitFlag)++import qualified GEGL.FFI.Process as FFI+import GEGL.FFI.Node (GeglNode(..))+import GEGL.FFI.Rectangle (GeglRectangle)++import BABL.FFI.Format (BablFormatPtr(..))++-- | Render a composition as a blocking operation.+--   See 'gegl_processor_work' for a non-blocking operation.+gegl_node_process+  :: GeglNode -- ^ A node without outputs+  -> IO ()+gegl_node_process (GeglNode fnode) = withForeignPtr fnode (\node ->+  FFI.c_gegl_node_process node)++-- | Render a rectangular region of a node+gegl_node_blit+  :: GeglNode       -- ^ Node to blit+  -> Double         -- ^ Scale+  -> GeglRectangle  -- ^ Area of Interest+  -> BablFormatPtr  -- ^ Pixel format+  -> Ptr a          -- ^ Pointer to destination buffer+  -> Int            -- ^ Row stride in bytes. If set to '0', stride will be+                    -- computed automatically from width and color format.+  -> [GeglBlitFlag] -- ^ GEGL blit flags+  -> IO ()+gegl_node_blit (GeglNode fnode) scale rect (BablFormatPtr babl) buf stride flags = do+  crect <- new rect+  let cscale  = CDouble scale+      cstride = CInt (fromIntegral stride)+      cflags  = CInt $ fromIntegral $+        foldl (\acc arg -> acc .|. fromEnum arg) 0 flags+  withForeignPtr fnode (\node ->+    FFI.c_gegl_node_blit node cscale crect babl buf cstride cflags)+  free crect
+ src/GEGL/Rectangle.hs view
@@ -0,0 +1,40 @@+-- | Rectangles from this module are used to specify areas for operations.+module GEGL.Rectangle+  ( FFI.GeglRectangle(..)+  , gegl_rectangle_intersect+  -- , gegl_rectangle_infinite_plane+  ) where++import Foreign.Marshal.Utils (new)+import Foreign.Marshal.Alloc (free)+import Foreign.Storable (peek)++import qualified GEGL.FFI.Rectangle as FFI++-- | Calculates the intersection of two rectangles.+gegl_rectangle_intersect+  :: FFI.GeglRectangle            -- ^ A rectangle+  -> FFI.GeglRectangle            -- ^ A rectnagle+  -> IO (Maybe FFI.GeglRectangle) -- ^ Returns a 'FFI.GeglRectangle' if+                                  --   rectangles intersect, otherwise 'Nothing'+gegl_rectangle_intersect a b = do+  pa <- new a+  pb <- new b+  res <- FFI.c_gegl_rectangle_intersect pa pa pb+  ret <- if res+    then do+      iret <- peek pa+      return $ Just iret+    else+      return Nothing+  free pa+  free pb+  return ret++-- -- | returns a 'GeglRectangle' representing an inifinite plane+-- gegl_rectangle_infinite_plane+--   :: IO FFI.GeglRectangle -- ^ The infinite plane+-- gegl_rectangle_infinite_plane = do+--   rectPtr <- FFI.c_gegl_rectangle_infinite_plane+--   rect <- peek rectPtr+--   free rectPtr
+ src/GEGL/Reparent.hs view
@@ -0,0 +1,48 @@+-- | Sometimes it is useful to be able to move nodes between graphs or even+-- handle orphaned nodes that are not part of a graph.+module GEGL.Reparent+  ( gegl_node_add_child+  , gegl_node_remove_child+  , gegl_node_get_parent+  )+where++import qualified GEGL.FFI.Reparent as FFI+import qualified GEGL.FFI.Node     as FFI++import System.Glib.GObject (objectUnref)++import Foreign.Ptr (nullPtr)+import Foreign.ForeignPtr (newForeignPtr, withForeignPtr)++-- | Make the Graph node take reference on the child node.+gegl_node_add_child+  :: FFI.GeglNode    -- ^ Graph node+  -> FFI.GeglNode    -- ^ Child node+  -> IO FFI.GeglNode -- ^ The child+gegl_node_add_child (FFI.GeglNode fgraph) (FFI.GeglNode fchild) =+  FFI.GeglNode <$> (newForeignPtr objectUnref =<<+    withForeignPtr fgraph (\graph ->+      withForeignPtr fchild (\child ->+        FFI.c_gegl_node_add_child graph child)))++-- | Removes a child form a 'FFI.GeglNode'.+gegl_node_remove_child+  :: FFI.GeglNode    -- ^ Graph node+  -> FFI.GeglNode    -- ^ Child node+  -> IO FFI.GeglNode -- ^ The child+gegl_node_remove_child (FFI.GeglNode fgraph) (FFI.GeglNode fchild) =+  FFI.GeglNode <$> (newForeignPtr objectUnref =<<+   withForeignPtr fgraph (\graph ->+     withForeignPtr fchild (\child ->+       FFI.c_gegl_node_remove_child graph child)))++-- | Gets parent of specified node. Returns 'Nothing' if node has no parent.+gegl_node_get_parent+  :: FFI.GeglNode            -- ^ A node+  -> IO (Maybe FFI.GeglNode) -- The parent node (if any)+gegl_node_get_parent (FFI.GeglNode fnode) = do+  ptr <- withForeignPtr fnode (\node -> FFI.c_gegl_node_get_parent node)+  if ptr == nullPtr+    then return Nothing+    else Just <$> FFI.GeglNode <$> newForeignPtr objectUnref ptr