From 488235009532361d3b10c96d6bf72f905008fef2 Mon Sep 17 00:00:00 2001 From: Astro Date: Thu, 16 Mar 2017 20:12:41 +0100 Subject: [PATCH 1/2] split updateLoop into eventLoop/updateLoop, getTick, getDelta --- examples/example00.hs | 12 ++++++++--- examples/example01.hs | 26 +++++++++++++---------- examples/example02.hs | 47 +++++++++++++++++++++++------------------- examples/example03.hs | 40 ++++++++++++++++++----------------- src/Affection.hs | 26 ++++++++++++++++++++--- src/Affection/Types.hs | 7 +++++-- 6 files changed, 99 insertions(+), 59 deletions(-) diff --git a/examples/example00.hs b/examples/example00.hs index 9d4808f..5e9f7a3 100644 --- a/examples/example00.hs +++ b/examples/example00.hs @@ -29,8 +29,9 @@ main = do , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return () - , drawLoop = draw + , eventLoop = handle , updateLoop = update + , drawLoop = draw , loadState = load , cleanUp = clean } @@ -96,11 +97,16 @@ draw = do liftIO $ SDL.unlockSurface drawSurface liftIO $ SDL.updateWindowSurface drawWindow -update :: Double -> [SDL.Event] -> Affection UserData () -update sec _ = do +handle :: SDL.EventPayload -> Affection UserData () +handle = const $ return () + +update :: Affection UserData () +update = do traceM "updating" ad <- get ud@UserData{..} <- getAffection + + sec <- getTick traceM $ (show $ 1 / sec) ++ " FPS" when (elapsedTime ad > 5) $ put $ ad diff --git a/examples/example01.hs b/examples/example01.hs index 10351d9..398018a 100644 --- a/examples/example01.hs +++ b/examples/example01.hs @@ -29,8 +29,9 @@ main = do , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return () - , drawLoop = draw + , eventLoop = const $ return () , updateLoop = update + , drawLoop = draw , loadState = load , cleanUp = clean } @@ -39,6 +40,7 @@ main = do data UserData = UserData { nodeGraph :: M.Map String G.GeglNode , foreground :: G.GeglBuffer + , lastTick :: Double } load :: SDL.Surface -> IO UserData @@ -80,6 +82,7 @@ load _ = do return $ UserData { nodeGraph = myMap , foreground = buffer + , lastTick = 0 } draw :: Affection UserData () @@ -89,17 +92,18 @@ draw = do drawRect (nodeGraph M.! "nop") (G.RGB 1 0 0) Fill (G.GeglRectangle 10 10 500 500) foreground liftIO $ G.gegl_node_process $ nodeGraph M.! "sink" -update :: Double -> [SDL.Event] -> Affection UserData () -update sec _ = do +update :: Affection UserData () +update = do traceM "updating" - -- liftIO $ delaySec 5 - ad <- get - ud@UserData{..} <- getAffection - traceM $ (show $ 1 / sec) ++ " FPS" - when (elapsedTime ad > 20) $ - put $ ad - { quitEvent = True - } + ud <- getAffection + let last = lastTick ud + tick <- getTick + putAffection $ ud { lastTick = tick } + let dt = tick - last + traceM $ (show $ 1 / dt) ++ " FPS" + + when (tick > 20) $ + quit clean :: UserData -> IO () clean _ = return () diff --git a/examples/example02.hs b/examples/example02.hs index a884b7f..8d29e3f 100644 --- a/examples/example02.hs +++ b/examples/example02.hs @@ -20,8 +20,9 @@ main = do , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return () - , drawLoop = draw + , eventLoop = handle , updateLoop = update + , drawLoop = draw , loadState = load , cleanUp = clean } @@ -31,6 +32,7 @@ data UserData = UserData { nodeGraph :: M.Map String G.GeglNode , foreground :: G.GeglBuffer , coordinates :: Maybe (Int, Int) + , lastTick :: Double } load :: SDL.Surface -> IO UserData @@ -73,6 +75,7 @@ load _ = do { nodeGraph = myMap , foreground = buffer , coordinates = Nothing + , lastTick = 0 } -- drawInit :: Affection UserData () @@ -98,28 +101,30 @@ draw = do ) coordinates liftIO $ G.gegl_node_process $ nodeGraph M.! "sink" -update :: Double -> [SDL.Event] -> Affection UserData () -update sec evs = do +update :: Affection UserData () +update = do traceM "updating" - ad <- get + + tick <- getTick ud <- getAffection - traceM $ (show $ 1 / sec) ++ " FPS" - -- ev <- liftIO $ SDL.pollEvent - mapM_ (\e -> - case SDL.eventPayload e of - SDL.MouseMotionEvent dat -> do - let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat - putAffection $ ud - { coordinates = Just (fromIntegral x, fromIntegral y) - } - SDL.WindowClosedEvent _ -> do - traceM "seeya!" - put $ ad - { quitEvent = True - } - _ -> - return () - ) evs + putAffection $ ud { lastTick = tick } + + let dt = tick - lastTick ud + traceM $ (show $ 1 / dt) ++ " FPS" + +handle (SDL.MouseMotionEvent dat) = do + let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat + ud <- getAffection + putAffection $ ud + { coordinates = Just (fromIntegral x, fromIntegral y) + } + +handle (SDL.WindowClosedEvent _) = do + traceM "seeya!" + quit + +handle _ = + return () clean :: UserData -> IO () clean _ = return () diff --git a/examples/example03.hs b/examples/example03.hs index b6f2b17..ffa4ac4 100644 --- a/examples/example03.hs +++ b/examples/example03.hs @@ -23,8 +23,9 @@ main = do , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = drawInit - , drawLoop = draw + , eventLoop = handle , updateLoop = update + , drawLoop = draw , loadState = load , cleanUp = clean } @@ -104,20 +105,25 @@ draw = do -- (G.GeglRectangle (x - 10) (y - 10) 20 20) -- ) $ coordinates ud -update :: Double -> [SDL.Event] -> Affection UserData () -update sec evs = do +update :: Affection UserData () +update = do traceM "updating" ad <- get ud <- getAffection - -- let newPart = updateParticles sec partUpd $ particles ud + delta <- getDelta + -- let newPart = updateParticles delta partUpd $ particles ud -- putAffection $ ud { particles = newPart } - traceM $ (show $ 1 / sec) ++ " FPS" + traceM $ (show $ 1 / delta) ++ " FPS" -- ev <- liftIO $ SDL.pollEvents - mapM_ (\e -> - case SDL.eventPayload e of - SDL.MouseMotionEvent dat -> + ud2 <- getAffection + !nps <- updateParticleSystem (partsys ud2) delta partUpd partDraw + putAffection $ ud2 { partsys = nps } + +handle (SDL.MouseMotionEvent dat) = if SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat then do + ad <- get + ud <- getAffection let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat vx <- liftIO $ randomRIO (-20, 20) vy <- liftIO $ randomRIO (-20, 20) @@ -165,17 +171,13 @@ update sec evs = do -- (particleStackCont $ head $ psParts $ partsys ud) else return () - SDL.WindowClosedEvent _ -> do - traceM "seeya!" - put $ ad - { quitEvent = True - } - _ -> - return () - ) evs - ud2 <- getAffection - !nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw - putAffection $ ud2 { partsys = nps } + +handle (SDL.WindowClosedEvent _) = do + traceM "seeya!" + quit + +handle _ = + return () clean :: UserData -> IO () clean _ = return () diff --git a/src/Affection.hs b/src/Affection.hs index 7683e76..9ae35b7 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -9,6 +9,9 @@ module Affection , delaySec , get , put + , getTick + , getDelta + , quit , module A ) where @@ -93,6 +96,7 @@ withAffection AffectionConfig{..} = do , drawCPP = cpp , drawStack = [] , elapsedTime = 0 + , dt = 0 }) <$> loadState surface (_, nState) <- runStateT ( A.runState $ do preLoop @@ -116,11 +120,13 @@ withAffection AffectionConfig{..} = do put $ ad { drawStack = [] , elapsedTime = ne + , dt = dt } -- poll events evs <- preHandleEvents =<< liftIO SDL.pollEvents + forM evs $ eventLoop -- execute user defined update loop - updateLoop dt evs + updateLoop -- execute user defined draw loop drawLoop -- handle all new draw requests @@ -154,7 +160,7 @@ getSurfaces window = do return (oldSurf, surface) -- Prehandle SDL events in case any window events occur -preHandleEvents :: [SDL.Event] -> Affection us [SDL.Event] +preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload] preHandleEvents evs = -- mapM handle evs -- where @@ -165,7 +171,7 @@ preHandleEvents evs = -- return e -- _ -> -- return e - return evs + return $ map SDL.eventPayload evs -- | Return the userstate to the user getAffection :: Affection us us @@ -187,3 +193,17 @@ delaySec :: Int -- ^ Number of seconds -> IO () delaySec dur = SDL.delay (fromIntegral $ dur * 1000) + +-- | Get time since start but always the same in the current tick. +getTick :: Affection us Double +getTick = + elapsedTime <$> get + +getDelta :: Affection us Double +getDelta = + dt <$> get + +quit :: Affection us () +quit = do + ad <- get + put $ ad { quitEvent = True } diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index bd0193c..665237a 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -56,10 +56,12 @@ data AffectionConfig us = AffectionConfig -- ^ Window configuration , preLoop :: Affection us () -- ^ Actions to be performed, before loop starts + , eventLoop :: SDL.EventPayload -> Affection us () + -- ^ Main update function. Takes fractions of a second as input. + , updateLoop :: Affection us () + -- ^ Main update function. Takes fractions of a second as input. , drawLoop :: Affection us () -- ^ Function for updating graphics. - , updateLoop :: Double -> [SDL.Event] -> 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. , cleanUp :: us -> IO () @@ -86,6 +88,7 @@ data AffectionData us = AffectionData , drawStride :: Int -- ^ Stride of target buffer , drawCPP :: Int -- ^ Number of components per pixel , elapsedTime :: Double -- ^ Elapsed time in seconds + , dt :: Double -- ^ Elapsed time in seconds since last tick } -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated From a7c33a7413ec0fe136bf4875b9be8e9d248ded55 Mon Sep 17 00:00:00 2001 From: Astro Date: Thu, 16 Mar 2017 20:21:04 +0100 Subject: [PATCH 2/2] clear --- examples/example02.hs | 5 +---- src/Affection/Draw.hs | 10 +++++++++- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/examples/example02.hs b/examples/example02.hs index 8d29e3f..ffa6bde 100644 --- a/examples/example02.hs +++ b/examples/example02.hs @@ -86,11 +86,8 @@ load _ = do draw :: Affection UserData () draw = do traceM "drawing" - ad <- get UserData{..} <- getAffection - SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad - let (w, h) = (fromIntegral rw, fromIntegral rh) - liftIO $ clearArea foreground (GeglRectangle 0 0 w h) + clear foreground maybe (return ()) (\(x, y) -> drawRect (nodeGraph M.! "nop") diff --git a/src/Affection/Draw.hs b/src/Affection/Draw.hs index 7b50933..6c6ffea 100644 --- a/src/Affection/Draw.hs +++ b/src/Affection/Draw.hs @@ -3,7 +3,7 @@ -- | Module for drawing primitives module Affection.Draw ( drawRect - -- , clear + , clear , handleDrawRequest , invalidateDrawRequest , present @@ -186,3 +186,11 @@ clearArea -> G.GeglRectangle -- ^ Area to clear -> IO () clearArea = G.gegl_buffer_clear + +-- | Clear the whole drawing area +clear :: G.GeglBuffer -> Affection us () +clear buffer = do + ad <- get + SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad + let (w, h) = (fromIntegral rw, fromIntegral rh) + liftIO $ clearArea buffer (GeglRectangle 0 0 w h)