make it work!

examples/example03.hs

@@ -171,21 +171,28 @@ update sec = do
 clean :: UserData -> IO ()
 clean _ = return ()
 
-partUpd :: Double -> Particle -> Particle
-partUpd sec p@Particle{..} =
-  p
+partUpd :: Double -> Particle -> Affection UserData Particle
+partUpd sec p@Particle{..} = do
+  let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
+      newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
+  liftIO $ G.gegl_node_set (particleNodeGraph M.! "rect") $ G.Operation "gegl:rectangle"
+    [ G.Property "x" $ G.PropertyDouble $ newX - 10
+    , G.Property "y" $ G.PropertyDouble $ newY - 10
+    ]
+  return p
     { particlePosition = (newX, newY)
     }
-  where
-    newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
-    newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
 
 partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData ()
 partDraw buf node Particle{..} = do
-  ud <- getAffection
-  drawRect'
-    particleDrawFlange
-    (G.RGBA 1 0 0 0.5)
-    (Fill)
-    (G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
+  present
+    (G.GeglRectangle (floor $ fst particlePosition - 10) (floor $ snd particlePosition - 10) 20 20)
     buf
+    False
+  -- ud <- getAffection
+  -- drawRect'
+  --   particleDrawFlange
+  --   (G.RGBA 1 0 0 0.5)
+  --   (Fill)
+  --   (G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
+  --   buf

src/Affection/Draw.hs

@@ -8,7 +8,7 @@ module Affection.Draw
   -- , clear
   , handleDrawRequest
   , invalidateDrawRequest
-  -- , present
+  , present
   , clearArea
   ) where
 
@@ -89,7 +89,20 @@ drawRect' node color Fill rect@GeglRectangle{..} buf = do
   diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
   unless diw $ error "Affection.Draw.drawRect': connect failed"
   put $ ad
-    { drawStack = (DrawRequest rect buf (Kill tempRoot)) : drawStack ad
+    { drawStack = (DrawRequest rect buf (Kill (Just tempRoot))) : drawStack ad
+    }
+
+-- | Force update of a specific region on screen
+present
+  :: G.GeglRectangle -- ^ Area to be updated
+  -> G.GeglBuffer    -- ^ Target buffer
+  -> Bool            -- ^ Shall the 'DrawRequest' persist?
+  -> Affection us ()
+present rect buf kill = do
+  ad <- get
+  let k = if not kill then Kill Nothing else Yes
+  put ad
+    { drawStack = (DrawRequest rect buf k) : drawStack ad
     }
 
 -- -- | force a blit of a specified area. Do not use often as it slows down the program
@@ -168,8 +181,11 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
     stride
     G.GeglAbyssNone
   liftIO $ SDL.unlockSurface surf
-  let Kill victim = requestPersist
-  liftIO $ G.gegl_node_drop victim
+  case requestPersist of
+    Kill (Just victim) ->
+      liftIO $ G.gegl_node_drop victim
+    _ ->
+      return ()
   -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
 
 -- | compute color for a single pixel

src/Affection/Particle.hs

@@ -19,19 +19,23 @@ import qualified GEGL as G
 -- and death is being handled by 'updateParticles' itself and does not need to
 -- bother you.
 updateParticle
-  :: Double                           -- ^ Elapsed time in seconds
-  -> (Double -> Particle -> Particle) -- ^ Update function for a single 'Particle'
-                                      -- This Function should take the elapsed time
-                                      -- in seconds and the initial particle as arguments.
-  -> Particle                         -- ^ 'Particle' to be processed
-  -> IO (Maybe Particle)              -- ^ resulting 'Particle'
+  :: Double
+    -- ^ Elapsed time in seconds
+  -> (Double -> Particle -> Affection us Particle) 
+    -- ^ Update function for a single 'Particle'
+    -- This Function should take the elapsed time
+    -- in seconds and the initial particle as arguments.
+  -> Particle
+    -- ^ 'Particle' to be processed
+  -> Affection us (Maybe Particle)
+    -- ^ resulting 'Particle'
 updateParticle time funct pa =
   if particleLife pa - time < 0
   then do
-    G.gegl_node_drop $ particleRootNode pa
+    liftIO $ G.gegl_node_drop $ particleRootNode pa
     return $ Nothing
   else
-    return $ Just $ funct time $ pa { particleLife = particleLife pa - time }
+    Just <$> funct time pa { particleLife = particleLife pa - time }
 -- updateParticle time funct acc@[p] pa =
 --   if particleLife pa - time < 0
 --   then do
@@ -56,13 +60,13 @@ drawParticles = mapM_
 updateParticleSystem
   :: ParticleSystem
   -> Double
-  -> (Double -> Particle -> Particle)
+  -> (Double -> Particle -> Affection us Particle)
   -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
   -> Affection us ParticleSystem
 updateParticleSystem sys sec upd draw = do
   -- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
   -- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
-  x <- liftIO $ catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
+  x <- catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
   liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode sys]
   mapM_ (draw (psBuffer sys) (psNode sys)) x
   return $ sys

src/Affection/Types.hs

@@ -88,7 +88,7 @@ data DrawRequest = DrawRequest
 
 data RequestPersist
   = Yes
-  | Kill G.GeglNode
+  | Kill (Maybe G.GeglNode)
 
 -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
 data DrawAsset = DrawAsset