diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/example00.hs b/examples/example00.hs new file mode 100644 --- /dev/null +++ b/examples/example00.hs @@ -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" diff --git a/examples/example01.hs b/examples/example01.hs new file mode 100644 --- /dev/null +++ b/examples/example01.hs @@ -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) diff --git a/examples/example02.hs b/examples/example02.hs new file mode 100644 --- /dev/null +++ b/examples/example02.hs @@ -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) diff --git a/gegl.cabal b/gegl.cabal new file mode 100644 --- /dev/null +++ b/gegl.cabal @@ -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 diff --git a/src/GEGL.hs b/src/GEGL.hs new file mode 100644 --- /dev/null +++ b/src/GEGL.hs @@ -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 diff --git a/src/GEGL/Buffer.hs b/src/GEGL/Buffer.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Buffer.hs @@ -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 diff --git a/src/GEGL/Buffer/BufferIterator.hs b/src/GEGL/Buffer/BufferIterator.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Buffer/BufferIterator.hs @@ -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] diff --git a/src/GEGL/Color.hs b/src/GEGL/Color.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Color.hs @@ -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) diff --git a/src/GEGL/Connection.hs b/src/GEGL/Connection.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Connection.hs @@ -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 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 diff --git a/src/GEGL/Enums.hs b/src/GEGL/Enums.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Enums.hs @@ -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) diff --git a/src/GEGL/FFI.hs b/src/GEGL/FFI.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI.hs @@ -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 () diff --git a/src/GEGL/FFI/Buffer.hs b/src/GEGL/FFI/Buffer.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Buffer.hs @@ -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 () diff --git a/src/GEGL/FFI/Buffer/BufferIterator.c b/src/GEGL/FFI/Buffer/BufferIterator.c new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Buffer/BufferIterator.c @@ -0,0 +1,65 @@ + +#include + +#include + +#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; + +} + diff --git a/src/GEGL/FFI/Buffer/BufferIterator.hs b/src/GEGL/FFI/Buffer/BufferIterator.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Buffer/BufferIterator.hs @@ -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 "" + +-- /DEBUGGING + +C.include "" +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" diff --git a/src/GEGL/FFI/Color.hs b/src/GEGL/FFI/Color.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Color.hs @@ -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 () diff --git a/src/GEGL/FFI/Connection.hs b/src/GEGL/FFI/Connection.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Connection.hs @@ -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 diff --git a/src/GEGL/FFI/Node.c b/src/GEGL/FFI/Node.c new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Node.c @@ -0,0 +1,87 @@ + +#include + +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; + +} + diff --git a/src/GEGL/FFI/Node.hs b/src/GEGL/FFI/Node.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Node.hs @@ -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 "" + +-- 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; + } + |] diff --git a/src/GEGL/FFI/Node/State.c b/src/GEGL/FFI/Node/State.c new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Node/State.c @@ -0,0 +1,51 @@ + +#include + +#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; + +} + diff --git a/src/GEGL/FFI/Node/State.hs b/src/GEGL/FFI/Node/State.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Node/State.hs @@ -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 "" +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 diff --git a/src/GEGL/FFI/Process.hs b/src/GEGL/FFI/Process.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Process.hs @@ -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 () diff --git a/src/GEGL/FFI/Rectangle.hsc b/src/GEGL/FFI/Rectangle.hsc new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Rectangle.hsc @@ -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 + +-- | 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 diff --git a/src/GEGL/FFI/Reparent.hs b/src/GEGL/FFI/Reparent.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Reparent.hs @@ -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 diff --git a/src/GEGL/FFI/Tuple.hsc b/src/GEGL/FFI/Tuple.hsc new file mode 100644 --- /dev/null +++ b/src/GEGL/FFI/Tuple.hsc @@ -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|]) + ] diff --git a/src/GEGL/Node.hs b/src/GEGL/Node.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Node.hs @@ -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 diff --git a/src/GEGL/Node/State.hs b/src/GEGL/Node/State.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Node/State.hs @@ -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 diff --git a/src/GEGL/Operation.hs b/src/GEGL/Operation.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Operation.hs @@ -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 diff --git a/src/GEGL/Process.hs b/src/GEGL/Process.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Process.hs @@ -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 diff --git a/src/GEGL/Rectangle.hs b/src/GEGL/Rectangle.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Rectangle.hs @@ -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 diff --git a/src/GEGL/Reparent.hs b/src/GEGL/Reparent.hs new file mode 100644 --- /dev/null +++ b/src/GEGL/Reparent.hs @@ -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