*vomiting sounds*

affection.cabal

@@ -130,3 +130,21 @@ executable example03
                      , random
   else
     buildable:       False
+
+executable example04
+  hs-source-dirs:    examples
+  main-is:           example04.hs
+  ghc-options:       -threaded -Wall -auto-all -caf-all -rtsopts
+  default-language:  Haskell2010
+  default-extensions: OverloadedStrings
+  if flag(examples)
+    build-depends:     base
+                     , affection
+                     , sdl2
+                     , gegl
+                     , babl
+                     , containers
+                     , mtl
+                     , random
+  else
+    buildable:       False

examples/example01.hs

@@ -52,7 +52,7 @@ load _ = do
   traceM "checkerboard"
   over <- G.gegl_node_new_child root G.defaultOverOperation
   traceM "over"
-  buffer <- G.gegl_buffer_new (G.GeglRectangle 0 0 800 600) =<<
+  buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<
     B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
   bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation
     [ G.Property "buffer" $ G.PropertyBuffer buffer

examples/example02.hs

@@ -3,10 +3,13 @@
 import Affection
 import qualified SDL
 import qualified GEGL as G
+import qualified GEGL.FFI.Buffer as G
 import qualified BABL as B
 import qualified Data.Map.Strict as M
 
 import Foreign.C.Types
+import Foreign.Marshal.Utils (new)
+import Foreign.Ptr (castPtr)
 
 import Debug.Trace
 
@@ -16,7 +19,7 @@ main = do
     { initComponents = All
     , windowTitle    = "Affection: example00"
     , windowConfig   = SDL.defaultWindow
-    , preLoop        = drawInit
+    , preLoop        = return ()
     , drawLoop       = draw
     , updateLoop     = update
     , loadState      = load
@@ -42,20 +45,24 @@ load _ = do
   traceM "checkerboard"
   over <- G.gegl_node_new_child root G.defaultOverOperation
   traceM "over"
-  buffer <- G.gegl_buffer_new (G.GeglRectangle 0 0 800 600) =<<
+  buffer@(G.GeglBuffer b) <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<
     B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
-  bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation
+  bufPtr <- new b
-    [ G.Property "buffer" $ G.PropertyBuffer buffer
+  sink <- G.gegl_node_new_child root $ G.Operation "gegl:buffer-sink"
+    [ G.Property "buffer" $ G.PropertyPointer $ castPtr bufPtr
     ]
-  traceM "buffer-source"
+  traceM "buffer-sink"
-  G.gegl_node_link checkerboard over
+  nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []
-  G.gegl_node_connect_to bufsrc "output" over "aux"
+  traceM "nop"
+  G.gegl_node_link_many [checkerboard, over, sink]
+  G.gegl_node_connect_to nop "output" over "aux"
   traceM "connections made"
   myMap <- return $ M.fromList
     [ ("root"        , root)
     , ("over"        , over)
     , ("background"  , checkerboard)
-    , ("foreground"  , bufsrc)
+    , ("sink"        , sink)
+    , ("nop"         , nop)
     ]
   traceM "loading complete"
   return $ UserData
@@ -64,10 +71,10 @@ load _ = do
     , coordinates = Nothing
     }
 
-drawInit :: Affection UserData ()
+-- drawInit :: Affection UserData ()
-drawInit = do
+-- drawInit = do
-  UserData{..} <- getAffection
+--   UserData{..} <- getAffection
-  present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True
+--   present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True
 
 draw :: Affection UserData ()
 draw = do
@@ -78,12 +85,12 @@ draw = do
   let (w, h) = (fromIntegral rw, fromIntegral rh)
   liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
   maybe (return ()) (\(x, y) ->
-    drawRect
+    drawRect'
-      foreground
+      (nodeGraph M.! "nop")
-      (nodeGraph M.! "over")
       (G.RGBA 1 0 0 0.5)
-      (Line 7)
+      (Fill)
       (G.GeglRectangle (x - 10) (y - 10) 20 20)
+      foreground
     ) coordinates
 
 update :: Double -> AffectionState (AffectionData UserData) IO ()

examples/example03.hs

@@ -45,7 +45,7 @@ load _ = do
   traceM "checkerboard"
   over <- G.gegl_node_new_child root G.defaultOverOperation
   traceM "over"
-  buffer <- G.gegl_buffer_new (G.GeglRectangle 0 0 800 600) =<<
+  buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<
     B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
   bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation
     [ G.Property "buffer" $ G.PropertyBuffer buffer

src/Affection.hs

@@ -63,6 +63,7 @@ withAffection AffectionConfig{..} = do
     , userState       = x
     , drawWindow      = window
     , drawSurface     = surface
+    , drawFormat      = format
     , drawStack       = []
     }) <$> loadState surface
   (_, nState) <- runStateT ( A.runState $ do
@@ -79,7 +80,7 @@ withAffection AffectionConfig{..} = do
         -- get state
         ad <- get
         -- clean draw requests from last run
-        mapM_ (invalidateDrawRequest pixels format stride cpp) $ drawStack ad
+        mapM_ (invalidateDrawRequest pixels stride cpp) $ drawStack ad
         put $ ad
           { drawStack = [] }
         -- execute user defined draw loop
@@ -89,7 +90,7 @@ withAffection AffectionConfig{..} = do
           (fromIntegral 10 ^ 9)
         -- handle all new draw requests
         ad2 <- get
-        clear <- catMaybes <$> mapM (handleDrawRequest pixels format stride cpp) (drawStack ad2)
+        clear <- catMaybes <$> mapM (handleDrawRequest pixels stride cpp) (drawStack ad2)
         -- save all draw requests to clear in next run
         put $ ad2
           { drawStack = clear }

src/Affection/Draw.hs

@@ -3,10 +3,11 @@
 -- | Module for drawing primitives
 module Affection.Draw
   ( drawRect
+  , drawRect'
   -- , clear
   , handleDrawRequest
   , invalidateDrawRequest
-  , present
+  -- , present
   , clearArea
   ) where
 
@@ -16,7 +17,7 @@ import Foreign.Ptr (Ptr, plusPtr, nullPtr)
 import Foreign.C.Types
 
 import Control.Monad.State (get, put)
-import Control.Monad (when)
+import Control.Monad (when, unless)
 
 import qualified SDL
 
@@ -43,7 +44,7 @@ drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do
     )
   ad@AffectionData{..} <- get
   put $ ad
-    { drawStack = (DrawRequest node rect buf False) : drawStack
+    { drawStack = (DrawRequest rect buf False) : drawStack
     }
 drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do
   liftIO $ G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
@@ -58,60 +59,80 @@ drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do
     )
   ad@AffectionData{..} <- get
   put $ ad
-    { drawStack = (DrawRequest node rect buf False) : drawStack
+    { drawStack = (DrawRequest rect buf False) : drawStack
     }
   -- drawRect buf node color Fill (G.GeglRectangle rectangleX rectangleY rectangleWidth size)
   -- drawRect buf node color Fill (G.GeglRectangle rectangleX rectangleY size rectangleHeight)
   -- drawRect buf node color Fill (G.GeglRectangle (rectangleX + rectangleWidth - size) rectangleY size rectangleHeight)
   -- drawRect buf node color Fill (G.GeglRectangle rectangleX (rectangleY + rectangleHeight - size) rectangleWidth size)
 
--- | force a blit of a specified area. Do not use often as it slows down the program
+drawRect'
-present
+  :: G.GeglNode      -- ^ Target Node
-  :: G.GeglNode      -- ^ Node to blit
+  -> G.Color         -- ^ Color to draw in
-  -> G.GeglBuffer    -- ^ BUffer to draw
+  -> DrawType        -- ^ Draw type
-  -> G.GeglRectangle -- ^ Area to blit
+  -> G.GeglRectangle -- ^ Dimensions of Rectangle
-  -> Bool            -- ^ Shall the drawing be cleared in the next run?
+  -> G.GeglBuffer    -- ^ Final Buffer
   -> Affection us ()
-present node buf rect pers = do
+drawRect' node color Fill rect@GeglRectangle{..} buf = do
   ad <- get
+  opNode <- liftIO $ G.gegl_node_new_child node $ G.Operation "gegl:rectangle"
+    [ G.Property "x"      $ G.PropertyDouble $ fromIntegral rectangleX
+    , G.Property "y"      $ G.PropertyDouble $ fromIntegral rectangleY
+    , G.Property "width"  $ G.PropertyDouble $ fromIntegral rectangleWidth
+    , G.Property "height" $ G.PropertyDouble $ fromIntegral rectangleHeight
+    , G.Property "color"  $ G.PropertyColor color
+    ]
+  diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
+  unless diw $ error "Affection.Draw.drawRect': connect failed"
   put $ ad
-    { drawStack = (DrawRequest node rect buf pers) : drawStack ad
+    { drawStack = (DrawRequest rect buf False) : drawStack ad
     }
-  ad <- get
+
-  format <- liftIO $ B.babl_format $ B.PixelFormat B.RGBA B.CFu8
+-- -- | force a blit of a specified area. Do not use often as it slows down the program
-  liftIO $ SDL.lockSurface $ drawSurface ad
+-- present
-  liftIO $ G.gegl_node_blit
+--   :: G.GeglNode      -- ^ Node to blit
-    node
+--   -> G.GeglBuffer    -- ^ BUffer to draw
-    1
+--   -> G.GeglRectangle -- ^ Area to blit
-    rect
+--   -> Bool            -- ^ Shall the drawing be cleared in the next run?
-    format
+--   -> Affection us ()
-    nullPtr
+-- present node buf rect pers = do
-    0
+--   ad <- get
-    [G.GeglBlitDefault]
+--   put $ ad
-  liftIO $ SDL.unlockSurface $ drawSurface ad
+--     { drawStack = (DrawRequest rect buf pers) : drawStack ad
-  liftIO $ SDL.updateWindowSurface $ drawWindow ad
+--     }
+--   ad <- get
+--   format <- liftIO $ B.babl_format $ B.PixelFormat B.RGBA B.CFu8
+--   liftIO $ SDL.lockSurface $ drawSurface ad
+--   liftIO $ G.gegl_node_blit
+--     rect
+--     format
+--     nullPtr
+--     0
+--     [G.GeglBlitDefault]
+--   liftIO $ SDL.unlockSurface $ drawSurface ad
+--   liftIO $ SDL.updateWindowSurface $ drawWindow ad
 
 -- | function for handling 'DrawRequest's and updating the output
 handleDrawRequest
   :: Ptr a           -- ^ Pixel buffer to blit to
-  -> B.BablFormatPtr -- ^ format to blit in
+  -- -> B.BablFormatPtr -- ^ format to blit in
   -> Int             -- ^ Stride
   -> Int             -- ^ Components per Pixel
   -> DrawRequest     -- ^ 'DrawRequest' to handle
   -> Affection us (Maybe DrawRequest)
-handleDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
+handleDrawRequest pixels stride cpp dr@DrawRequest{..} = do
   ad <- get
   let surf = drawSurface ad
   liftIO $ SDL.lockSurface surf
-  liftIO $ G.gegl_node_blit
+  liftIO $ G.gegl_buffer_get
-    requestNode
+    requestBuffer
+    (Just requestArea)
     1
-    requestArea
+    (Just $ drawFormat ad)
-    format
     (pixels `plusPtr`
       (rectangleX requestArea * cpp + rectangleY requestArea * stride))
     stride
-    [G.GeglBlitDefault]
+    G.GeglAbyssNone
   liftIO $ SDL.unlockSurface surf
   -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
   if requestPersist
@@ -123,25 +144,25 @@ handleDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
 -- | clear a previously drawn area
 invalidateDrawRequest
   :: Ptr a           -- ^ Pixel buffer to blit to
-  -> B.BablFormatPtr -- ^ format to blit in
+  -- -> B.BablFormatPtr -- ^ format to blit in
   -> Int             -- ^ Stride
   -> Int             -- ^ Components per Pixel
   -> DrawRequest  -- ^ Drawrequest to invalidate
   -> Affection us ()
-invalidateDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
+invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
   ad <- get
   let !surf = drawSurface ad
   liftIO $ clearArea requestBuffer requestArea
   liftIO $ SDL.lockSurface surf
-  liftIO $ G.gegl_node_blit
+  liftIO $ G.gegl_buffer_get
-    requestNode
+    requestBuffer
+    (Just requestArea)
     1
-    requestArea
+    (Just $ drawFormat ad)
-    format
     (pixels `plusPtr`
       (rectangleX requestArea * cpp + rectangleY requestArea * stride))
     stride
-    [G.GeglBlitDefault]
+    G.GeglAbyssNone
   liftIO $ SDL.unlockSurface surf
   -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
 

src/Affection/Types.hs

@@ -30,7 +30,9 @@ module Affection.Types
 import qualified SDL.Init as SDL
 import qualified SDL.Video as SDL
 import qualified Data.Text as T
+
 import qualified GEGL as G
+import qualified BABL as B
 
 import Control.Monad.IO.Class
 import Control.Monad.State
@@ -58,6 +60,11 @@ data AffectionConfig us = AffectionConfig
       -- ^ Provide your own finisher function to clean your data.
   }
 
+-- | Components to initialize in SDL.
+data InitComponents
+  = All
+  | Only [SDL.InitFlag]
+
 -- | Main type for defining the look, feel and action of the whole application.
 data AffectionData us = AffectionData
   -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
@@ -65,22 +72,20 @@ data AffectionData us = AffectionData
   , userState       :: us                 -- ^ State data provided by user
   , drawWindow      :: SDL.Window         -- ^ SDL window
   , drawSurface     :: SDL.Surface        -- ^ SDL surface
+  , drawFormat      :: B.BablFormatPtr    -- ^ Target format
   , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
   , clearStack      :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be invalidated
   }
 
 -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
 data DrawRequest = DrawRequest
-  { requestNode     :: G.GeglNode      -- ^ The 'G.GeglNode' to blit
+  { requestArea     :: G.GeglRectangle -- ^ The area to update
-  , requestArea     :: G.GeglRectangle -- ^ The area to update
   , requestBuffer   :: G.GeglBuffer    -- ^ Buffer to draw
   , requestPersist  :: Bool            -- ^ Shall the drawRequest persist
   }
 
--- | Components to initialize in SDL.
+-- | A type for storing 'DrawRequest' results to be executed frequently. TODO
-data InitComponents
+data DrawAsset = DrawAsset
-  = All
-  | Only [SDL.InitFlag]
 
 -- | Inner 'StateT' monad for the update state
 -- type AffectionStateInner us m a = StateT (AffectionData us) m a