diff --git a/examples/example02.hs b/examples/example02.hs index 7d22021..4176d35 100644 --- a/examples/example02.hs +++ b/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" diff --git a/src/Affection.hs b/src/Affection.hs index d08e4d9..f776384 100644 --- a/src/Affection.hs +++ b/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) diff --git a/src/Affection/Draw.hs b/src/Affection/Draw.hs index e2a8931..63abfa6 100644 --- a/src/Affection/Draw.hs +++ b/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 diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index b58f75c..28c34c9 100644 --- a/src/Affection/Types.hs +++ b/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 + { 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.