make previous examples work again

affection.cabal

@@ -64,39 +64,39 @@ library
                      , glib
                      -- , sdl2-image
 
--- executable example00
+executable example00
---   hs-source-dirs:    examples
+  hs-source-dirs:    examples
---   main-is:           example00.hs
+  main-is:           example00.hs
---   ghc-options:       -threaded -Wall
+  ghc-options:       -threaded -Wall
---   default-language:  Haskell2010
+  default-language:  Haskell2010
---   default-extensions: OverloadedStrings
+  default-extensions: OverloadedStrings
---   if flag(examples)
+  if flag(examples)
---     build-depends:     base
+    build-depends:     base
---                      , affection
+                     , affection
---                      , sdl2
+                     , sdl2
---                      , gegl
+                     , gegl
---                      , babl
+                     , babl
---                      , containers
+                     , containers
---                      , mtl
+                     , mtl
---   else
+  else
---     buildable:       False
+    buildable:       False
 
--- executable example01
+executable example01
---   hs-source-dirs:    examples
+  hs-source-dirs:    examples
---   main-is:           example01.hs
+  main-is:           example01.hs
---   ghc-options:       -threaded -Wall
+  ghc-options:       -threaded -Wall
---   default-language:  Haskell2010
+  default-language:  Haskell2010
---   default-extensions: OverloadedStrings
+  default-extensions: OverloadedStrings
---   if flag(examples)
+  if flag(examples)
---     build-depends:     base
+    build-depends:     base
---                      , affection
+                     , affection
---                      , sdl2
+                     , sdl2
---                      , gegl
+                     , gegl
---                      , babl
+                     , babl
---                      , containers
+                     , containers
---                      , mtl
+                     , mtl
---   else
+  else
---     buildable:       False
+    buildable:       False
 
 executable example02
   hs-source-dirs:    examples

examples/example00.hs

@@ -7,6 +7,8 @@ import qualified GEGL as G
 import qualified BABL as B
 import qualified Data.Map.Strict as M
 
+import Control.Monad (when)
+
 import Foreign.Storable (peek)
 import Foreign.C.Types  (CInt(..))
 
@@ -36,7 +38,6 @@ main = do
 
 data UserData = UserData
   { nodeGraph   :: M.Map String G.GeglNode
-  , elapsedTime :: Double
   }
 
 load :: SDL.Surface -> IO UserData
@@ -69,7 +70,6 @@ load _ = do
   traceM "loading complete"
   return $ UserData
     { nodeGraph = myMap
-    , elapsedTime = 0
     }
 
 draw :: Affection UserData ()
@@ -99,18 +99,10 @@ draw = do
 update :: Double -> Affection UserData ()
 update sec = do
   traceM "updating"
-  -- liftIO $ delaySec 5
+  ad <- get
-  ad@AffectionData{..} <- get
+  ud@UserData{..} <- getAffection
-  let ud@UserData{..} = userState
+  traceM $ (show $ 1 / sec) ++ " FPS"
-  traceM $ show elapsedTime
+  when (elapsedTime ad > 5) $
-  if elapsedTime < 5
-  then
-    put $ ad
-      { userState = ud
-        { elapsedTime = elapsedTime + sec
-        }
-      }
-  else
     put $ ad
       { quitEvent = True
       }

examples/example01.hs

@@ -7,6 +7,8 @@ import qualified GEGL as G
 import qualified BABL as B
 import qualified Data.Map.Strict as M
 
+import Control.Monad (when)
+
 import Foreign.Storable (peek)
 import Foreign.C.Types
 
@@ -37,7 +39,6 @@ main = do
 data UserData = UserData
   { nodeGraph   :: M.Map String G.GeglNode
   , foreground  :: G.GeglBuffer
-  , elapsedTime :: Double
   }
 
 load :: SDL.Surface -> IO UserData
@@ -54,111 +55,48 @@ load _ = do
   traceM "over"
   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
+  sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer"
     [ G.Property "buffer" $ G.PropertyBuffer buffer
     ]
   traceM "buffer-source"
-  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"
+  crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
+    [ G.Property "width" $ G.PropertyDouble 800
+    , G.Property "height" $ G.PropertyDouble 600
+    ]
+  G.gegl_node_link_many [checkerboard, over, crop, 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)
     ]
   let roi = G.GeglRectangle 0 0 20 20
-  -- G.iterateOver
-  --   buffer
-  --   roi
-  --   (B.PixelFormat B.RGBA B.CFfloat)
-  --   G.GeglAccessReadWrite
-  --   G.GeglAbyssNone
-  --   (\(G.Pixel px py pc) ->
-  --     let dsqr = (((10 - px) ^ 2) + ((10 - py) ^ 2))
-  --         (G.CVfloat (CFloat pr), G.CVfloat (CFloat pg), G.CVfloat (CFloat pb), G.CVfloat (CFloat pa)) = pc
-  --         dist = (sqrt (fromIntegral dsqr :: Float))
-  --     in if dsqr < 100
-  --       then
-  --         if dist < fromIntegral 9
-  --           then
-  --             G.Pixel px py
-  --               ( G.CVfloat $ CFloat 0
-  --               , G.CVfloat $ CFloat 0
-  --               , G.CVfloat $ CFloat 0
-  --               , G.CVfloat $ CFloat $ if pa < 1 then 1 else pa
-  --               )
-  --           else
-  --             let alpha = fromIntegral 10 - 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
-  --               G.Pixel px py
-  --                 ( G.CVfloat $ CFloat $ red / a
-  --                 , G.CVfloat $ CFloat $ gre / a
-  --                 , G.CVfloat $ CFloat $ blu / a
-  --                 , G.CVfloat $ CFloat $ if pa < alpha then alpha else pa
-  --                 )
-  --     else
-  --       G.Pixel px py pc
-  --   )
   traceM "loading complete"
   return $ UserData
     { nodeGraph = myMap
     , foreground = buffer
-    , elapsedTime = 0
     }
 
 draw :: Affection UserData ()
 draw = do
   traceM "drawing"
   UserData{..} <- getAffection
-  -- AffectionData{..} <- get
+  drawRect' (nodeGraph M.! "nop") (G.RGB 1 0 0) Fill (G.GeglRectangle 10 10 500 500) foreground
-  -- let UserData{..} = userState
+  liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
-  -- -- liftIO $ SDL.lockSurface drawSurface
-  -- pixels <- liftIO $ SDL.surfacePixels drawSurface
-  -- let SDL.Surface rawSurfacePtr _ = drawSurface
-  -- rawSurface <- liftIO $ peek rawSurfacePtr
-  -- pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface
-  -- format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8)
-  -- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
-  -- let (w, h) = (fromIntegral rw, fromIntegral rh)
-  drawRect foreground (nodeGraph M.! "over") (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 10 10 500 500)
-  -- liftIO $ G.gegl_node_blit
-  --   (nodeGraph M.! "over" :: G.GeglNode)
-  --   1
-  --   (G.GeglRectangle 0 0 w h)
-  --   format
-  --   pixels
-  --   (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
-  --   [G.GeglBlitDefault]
-  -- liftIO $ SDL.unlockSurface drawSurface
-  -- liftIO $ SDL.updateWindowSurface drawWindow
 
 update :: Double -> AffectionState (AffectionData UserData) IO ()
 update sec = do
   traceM "updating"
   -- liftIO $ delaySec 5
-  ad@AffectionData{..} <- get
+  ad <- get
-  let ud@UserData{..} = userState
+  ud@UserData{..} <- getAffection
   traceM $ (show $ 1 / sec) ++ " FPS"
-  if elapsedTime < 20
+  when (elapsedTime ad > 20) $
-  then do
-    fg <- liftIO $ G.gegl_buffer_get_extent foreground
-    _ <- liftIO $ G.gegl_buffer_set_extent foreground $ fg
-      { G.rectangleX = G.rectangleX fg + 1
-      , G.rectangleY = G.rectangleY fg + 1
-      }
-    put $ ad
-      { userState = ud
-        { elapsedTime = elapsedTime + sec
-        }
-      }
-  else
     put $ ad
       { quitEvent = True
       }

examples/example03.hs

@@ -53,7 +53,7 @@ load _ = do
     [G.Property "buffer" $ G.PropertyBuffer buffer
     ]
   traceM "buffer-sink"
-  nop <- G.gegl_node_new_child root $ G.Operation "nop" []
+  nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []
   traceM "nop"
   crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
     [ G.Property "width" $ G.PropertyDouble 800