now works and cleans and everything \o/

examples/example02.hs

@@ -19,6 +19,7 @@ main = do
     { initComponents = All
     , windowTitle    = "Affection: example00"
     , windowConfig   = SDL.defaultWindow
+    , preLoop        = drawInit
     , drawLoop       = draw
     , updateLoop     = update
     , loadState      = load
@@ -77,6 +78,12 @@ load surface = do
     , coordinates = Nothing
     }
 
+drawInit :: Affection UserData ()
+drawInit = do
+  AffectionData{..} <- get
+  let UserData{..} = userState
+  present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True
+
 draw :: Affection UserData ()
 draw = do
   traceM "drawing"
@@ -95,8 +102,8 @@ draw = do
     drawRect
       foreground
       (nodeGraph M.! "over")
-      (G.RGB 1 0 0)
-      (Line 2)
+      (G.RGBA 1 0 0 0.5)
+      (Line 7)
       (G.GeglRectangle (x - 10) (y - 10) 20 20)
     ) coordinates
   -- liftIO $ G.gegl_node_process $ nodeGraph M.! "display"
@@ -114,7 +121,6 @@ draw = do
 update :: Double -> AffectionState (AffectionData UserData) IO ()
 update sec = do
   traceM "updating"
-  -- liftIO $ delaySec 5
   ad@AffectionData{..} <- get
   let ud@UserData{..} = userState
   traceM $ (show $ 1 / sec) ++ " FPS"

src/Affection.hs

@@ -63,6 +63,7 @@ withAffection AffectionConfig{..} = do
     , drawStack       = []
     }) =<< loadState surface
   (_, nState) <- runStateT ( A.runState $ do
+    preLoop
     whileM_ (do
         current <- get
         return $ not $ A.quitEvent current
@@ -70,11 +71,15 @@ withAffection AffectionConfig{..} = do
       (do
         now      <- liftIO $ getTime Monotonic
         lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
-        drawLoop
         ad <- get
-        mapM_ (handleDrawRequest pixels format stride cpp) $ drawStack ad
+        mapM_ (invalidateDrawRequest pixels format stride cpp) $ drawStack ad
         put $ ad
           { drawStack = [] }
+        drawLoop
+        ad <- get
+        clear <- return . catMaybes =<< mapM (handleDrawRequest pixels format stride cpp) (drawStack ad)
+        put $ ad
+          { drawStack = clear }
         liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing
         updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
           (fromIntegral 10 ^ 9)

src/Affection/Draw.hs

@@ -5,6 +5,7 @@ module Affection.Draw
   ( drawRect
   -- , clear
   , handleDrawRequest
+  , invalidateDrawRequest
   , present
   , clearArea
   ) where
@@ -15,6 +16,7 @@ import Foreign.Ptr (Ptr, plusPtr)
 import Foreign.C.Types
 
 import Control.Monad.State (get, put)
+import Control.Monad (when)
 
 import qualified SDL
 
@@ -22,6 +24,8 @@ import qualified BABL as B
 
 import qualified GEGL as G
 
+import Debug.Trace
+
 -- | Draw a rectangle on target buffer
 drawRect
   :: G.GeglBuffer  -- ^ Target buffer
@@ -39,27 +43,29 @@ drawRect buf node color (Fill) rect@G.GeglRectangle{..} = do
     )
   ad@AffectionData{..} <- get
   put $ ad
-    { drawStack = (DrawRequest node rect) : drawStack
+    { drawStack = (DrawRequest node rect buf False) : drawStack
     }
 drawRect buf node color (Line size) rect@G.GeglRectangle{..} = do
   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)
-  ad@AffectionData{..} <- get
-  put $ ad
-    { drawStack = (DrawRequest node rect) : drawStack
-    }
+  -- ad@AffectionData{..} <- get
+  -- put $ ad
+  --   { drawStack = (DrawRequest node rect) : drawStack
+  --   }
 
 -- | force a blit of a specified area
 present
   :: G.GeglNode      -- ^ Node to blit
+  -> G.GeglBuffer    -- ^ BUffer to draw
   -> G.GeglRectangle -- ^ Area to blit
+  -> Bool            -- ^ Shall the drawing be cleared in the next run?
   -> Affection us ()
-present node rect = do
+present node buf rect pers = do
   ad@AffectionData{..} <- get
   put $ ad
-    { drawStack = (DrawRequest node rect) : drawStack
+    { drawStack = (DrawRequest node rect buf pers) : drawStack
     }
 
 -- | function for handling 'DrawRequest's and updating the output
@@ -69,8 +75,8 @@ handleDrawRequest
   -> Int             -- ^ Stride
   -> Int             -- ^ Components per Pixel
   -> DrawRequest     -- ^ 'DrawRequest' to handle
-  -> Affection us ()
-handleDrawRequest pixels format stride cpp DrawRequest{..} = do
+  -> Affection us (Maybe DrawRequest)
+handleDrawRequest pixels format stride cpp dr@DrawRequest{..} = do
   ad <- get
   liftIO $ SDL.lockSurface $ drawSurface ad
   liftIO $ G.gegl_node_blit
@@ -84,6 +90,35 @@ handleDrawRequest pixels format stride cpp DrawRequest{..} = do
     [G.GeglBlitDefault]
   liftIO $ SDL.unlockSurface $ drawSurface ad
   liftIO $ SDL.updateWindowSurface $ drawWindow ad
+  if requestPersist
+  then
+    return Nothing
+  else
+    return $ Just dr
+
+-- | clear a previously drawn area
+invalidateDrawRequest
+  :: Ptr a           -- ^ Pixel buffer to blit to
+  -> 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
+  ad <- get
+  liftIO $ clearArea requestBuffer requestArea
+  liftIO $ SDL.lockSurface $ drawSurface ad
+  liftIO $ G.gegl_node_blit
+    requestNode
+    1
+    requestArea
+    format
+    (pixels `plusPtr`
+      (rectangleX requestArea * cpp + rectangleY requestArea * stride))
+    stride
+    [G.GeglBlitDefault]
+  liftIO $ SDL.unlockSurface $ drawSurface ad
+  liftIO $ SDL.updateWindowSurface $ drawWindow ad
 
 -- | compute color for a single pixel
 colorize

src/Affection/Types.hs

@@ -41,9 +41,11 @@ data AffectionConfig us = AffectionConfig
       -- ^ Window title
   , windowConfig   :: SDL.WindowConfig
       -- ^ Window configuration
-  , drawLoop       :: AffectionState (AffectionData us) IO ()
+  , preLoop        :: Affection us ()
+      -- ^ Actions to be performed, before loop starts
+  , drawLoop       :: Affection us ()
       -- ^ Function for updating graphics.
-  , updateLoop     :: Double -> AffectionState (AffectionData us) IO ()
+  , updateLoop     :: Double -> Affection us ()
       -- ^ Main update function. Takes fractions of a second as input.
   , loadState      :: SDL.Surface -> IO us
       -- ^ Provide your own load function to create this data.
@@ -58,13 +60,16 @@ data AffectionData us = AffectionData
   , userState       :: us                 -- ^ State data provided by user
   , drawWindow      :: SDL.Window         -- ^ SDL window
   , drawSurface     :: SDL.Surface        -- ^ SDL surface
-  , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequests's to be processed
+  , 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
+  , requestBuffer   :: G.GeglBuffer    -- ^ Buffer to draw
+  , requestPersist  :: Bool            -- ^ Shall the drawRequest persist
   }
 
 -- | Components to initialize in SDL.