Merge pull request #1 from nek0/shtuff

Stuff that I think is better

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 ()
+handle :: SDL.EventPayload -> Affection UserData ()
-update sec _ = do
+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

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 :: Affection UserData ()
-update sec _ = do
+update = do
   traceM "updating"
-  -- liftIO $ delaySec 5
+  ud <- getAffection
-  ad <- get
+  let last = lastTick ud
-  ud@UserData{..} <- getAffection
+  tick <- getTick
-  traceM $ (show $ 1 / sec) ++ " FPS"
+  putAffection $ ud { lastTick = tick }
-  when (elapsedTime ad > 20) $
+  let dt = tick - last
-    put $ ad
+  traceM $ (show $ 1 / dt) ++ " FPS"
-      { quitEvent = True
+
-      }
+  when (tick > 20) $
+    quit
 
 clean :: UserData -> IO ()
 clean _ = return ()

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 ()
@@ -83,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
+  clear foreground
-  let (w, h) = (fromIntegral rw, fromIntegral rh)
-  liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
   maybe (return ()) (\(x, y) ->
     drawRect
       (nodeGraph M.! "nop")
@@ -98,28 +98,30 @@ draw = do
     ) coordinates
   liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
 
-update :: Double -> [SDL.Event] -> Affection UserData ()
+update :: Affection UserData ()
-update sec evs = do
+update = do
   traceM "updating"
-  ad <- get
+
+  tick <- getTick
   ud <- getAffection
-  traceM $ (show $ 1 / sec) ++ " FPS"
+  putAffection $ ud { lastTick = tick }
-  -- ev <- liftIO $ SDL.pollEvent
+
-  mapM_ (\e ->
+  let dt = tick - lastTick ud
-    case SDL.eventPayload e of
+  traceM $ (show $ 1 / dt) ++ " FPS"
-      SDL.MouseMotionEvent dat -> do
+
+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)
     }
-      SDL.WindowClosedEvent _ -> do
+
+handle (SDL.WindowClosedEvent _) = do
   traceM "seeya!"
-        put $ ad
+  quit
-          { quitEvent = True
+
-          }
+handle _ =
-      _ ->
   return ()
-    ) evs
 
 clean :: UserData -> IO ()
 clean _ = return ()

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 :: Affection UserData ()
-update sec evs = do
+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 ->
+  ud2 <- getAffection
-    case SDL.eventPayload e of
+  !nps <- updateParticleSystem (partsys ud2) delta partUpd partDraw
-      SDL.MouseMotionEvent dat ->
+  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
+
+handle (SDL.WindowClosedEvent _) = do
   traceM "seeya!"
-        put $ ad
+  quit
-          { quitEvent = True
+
-          }
+handle _ =
-      _ ->
   return ()
-    ) evs
-  ud2 <- getAffection
-  !nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw
-  putAffection $ ud2 { partsys = nps }
 
 clean :: UserData -> IO ()
 clean _ = return ()

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 }

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)

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