split updateLoop into eventLoop/updateLoop, getTick, getDelta
This commit is contained in:
parent
5d8c5d807c
commit
4882350095
6 changed files with 99 additions and 59 deletions
|
@ -29,8 +29,9 @@ main = do
|
||||||
, windowTitle = "Affection: example00"
|
, windowTitle = "Affection: example00"
|
||||||
, windowConfig = SDL.defaultWindow
|
, windowConfig = SDL.defaultWindow
|
||||||
, preLoop = return ()
|
, preLoop = return ()
|
||||||
, drawLoop = draw
|
, eventLoop = handle
|
||||||
, updateLoop = update
|
, updateLoop = update
|
||||||
|
, drawLoop = draw
|
||||||
, loadState = load
|
, loadState = load
|
||||||
, cleanUp = clean
|
, cleanUp = clean
|
||||||
}
|
}
|
||||||
|
@ -96,11 +97,16 @@ draw = do
|
||||||
liftIO $ SDL.unlockSurface drawSurface
|
liftIO $ SDL.unlockSurface drawSurface
|
||||||
liftIO $ SDL.updateWindowSurface drawWindow
|
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"
|
traceM "updating"
|
||||||
ad <- get
|
ad <- get
|
||||||
ud@UserData{..} <- getAffection
|
ud@UserData{..} <- getAffection
|
||||||
|
|
||||||
|
sec <- getTick
|
||||||
traceM $ (show $ 1 / sec) ++ " FPS"
|
traceM $ (show $ 1 / sec) ++ " FPS"
|
||||||
when (elapsedTime ad > 5) $
|
when (elapsedTime ad > 5) $
|
||||||
put $ ad
|
put $ ad
|
||||||
|
|
|
@ -29,8 +29,9 @@ main = do
|
||||||
, windowTitle = "Affection: example00"
|
, windowTitle = "Affection: example00"
|
||||||
, windowConfig = SDL.defaultWindow
|
, windowConfig = SDL.defaultWindow
|
||||||
, preLoop = return ()
|
, preLoop = return ()
|
||||||
, drawLoop = draw
|
, eventLoop = const $ return ()
|
||||||
, updateLoop = update
|
, updateLoop = update
|
||||||
|
, drawLoop = draw
|
||||||
, loadState = load
|
, loadState = load
|
||||||
, cleanUp = clean
|
, cleanUp = clean
|
||||||
}
|
}
|
||||||
|
@ -39,6 +40,7 @@ main = do
|
||||||
data UserData = UserData
|
data UserData = UserData
|
||||||
{ nodeGraph :: M.Map String G.GeglNode
|
{ nodeGraph :: M.Map String G.GeglNode
|
||||||
, foreground :: G.GeglBuffer
|
, foreground :: G.GeglBuffer
|
||||||
|
, lastTick :: Double
|
||||||
}
|
}
|
||||||
|
|
||||||
load :: SDL.Surface -> IO UserData
|
load :: SDL.Surface -> IO UserData
|
||||||
|
@ -80,6 +82,7 @@ load _ = do
|
||||||
return $ UserData
|
return $ UserData
|
||||||
{ nodeGraph = myMap
|
{ nodeGraph = myMap
|
||||||
, foreground = buffer
|
, foreground = buffer
|
||||||
|
, lastTick = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
draw :: Affection UserData ()
|
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
|
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"
|
liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
|
||||||
|
|
||||||
update :: Double -> [SDL.Event] -> Affection UserData ()
|
update :: Affection UserData ()
|
||||||
update sec _ = do
|
update = do
|
||||||
traceM "updating"
|
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 :: UserData -> IO ()
|
||||||
clean _ = return ()
|
clean _ = return ()
|
||||||
|
|
|
@ -20,8 +20,9 @@ main = do
|
||||||
, windowTitle = "Affection: example00"
|
, windowTitle = "Affection: example00"
|
||||||
, windowConfig = SDL.defaultWindow
|
, windowConfig = SDL.defaultWindow
|
||||||
, preLoop = return ()
|
, preLoop = return ()
|
||||||
, drawLoop = draw
|
, eventLoop = handle
|
||||||
, updateLoop = update
|
, updateLoop = update
|
||||||
|
, drawLoop = draw
|
||||||
, loadState = load
|
, loadState = load
|
||||||
, cleanUp = clean
|
, cleanUp = clean
|
||||||
}
|
}
|
||||||
|
@ -31,6 +32,7 @@ data UserData = UserData
|
||||||
{ nodeGraph :: M.Map String G.GeglNode
|
{ nodeGraph :: M.Map String G.GeglNode
|
||||||
, foreground :: G.GeglBuffer
|
, foreground :: G.GeglBuffer
|
||||||
, coordinates :: Maybe (Int, Int)
|
, coordinates :: Maybe (Int, Int)
|
||||||
|
, lastTick :: Double
|
||||||
}
|
}
|
||||||
|
|
||||||
load :: SDL.Surface -> IO UserData
|
load :: SDL.Surface -> IO UserData
|
||||||
|
@ -73,6 +75,7 @@ load _ = do
|
||||||
{ nodeGraph = myMap
|
{ nodeGraph = myMap
|
||||||
, foreground = buffer
|
, foreground = buffer
|
||||||
, coordinates = Nothing
|
, coordinates = Nothing
|
||||||
|
, lastTick = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
-- drawInit :: Affection UserData ()
|
-- drawInit :: Affection UserData ()
|
||||||
|
@ -98,28 +101,30 @@ draw = do
|
||||||
) coordinates
|
) coordinates
|
||||||
liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"
|
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"
|
traceM "updating"
|
||||||
ad <- get
|
|
||||||
|
tick <- getTick
|
||||||
ud <- getAffection
|
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
|
let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
|
||||||
|
ud <- getAffection
|
||||||
putAffection $ ud
|
putAffection $ ud
|
||||||
{ coordinates = Just (fromIntegral x, fromIntegral y)
|
{ coordinates = Just (fromIntegral x, fromIntegral y)
|
||||||
}
|
}
|
||||||
SDL.WindowClosedEvent _ -> do
|
|
||||||
|
handle (SDL.WindowClosedEvent _) = do
|
||||||
traceM "seeya!"
|
traceM "seeya!"
|
||||||
put $ ad
|
quit
|
||||||
{ quitEvent = True
|
|
||||||
}
|
handle _ =
|
||||||
_ ->
|
|
||||||
return ()
|
return ()
|
||||||
) evs
|
|
||||||
|
|
||||||
clean :: UserData -> IO ()
|
clean :: UserData -> IO ()
|
||||||
clean _ = return ()
|
clean _ = return ()
|
||||||
|
|
|
@ -23,8 +23,9 @@ main = do
|
||||||
, windowTitle = "Affection: example00"
|
, windowTitle = "Affection: example00"
|
||||||
, windowConfig = SDL.defaultWindow
|
, windowConfig = SDL.defaultWindow
|
||||||
, preLoop = drawInit
|
, preLoop = drawInit
|
||||||
, drawLoop = draw
|
, eventLoop = handle
|
||||||
, updateLoop = update
|
, updateLoop = update
|
||||||
|
, drawLoop = draw
|
||||||
, loadState = load
|
, loadState = load
|
||||||
, cleanUp = clean
|
, cleanUp = clean
|
||||||
}
|
}
|
||||||
|
@ -104,20 +105,25 @@ draw = do
|
||||||
-- (G.GeglRectangle (x - 10) (y - 10) 20 20)
|
-- (G.GeglRectangle (x - 10) (y - 10) 20 20)
|
||||||
-- ) $ coordinates ud
|
-- ) $ coordinates ud
|
||||||
|
|
||||||
update :: Double -> [SDL.Event] -> Affection UserData ()
|
update :: Affection UserData ()
|
||||||
update sec evs = do
|
update = do
|
||||||
traceM "updating"
|
traceM "updating"
|
||||||
ad <- get
|
ad <- get
|
||||||
ud <- getAffection
|
ud <- getAffection
|
||||||
-- let newPart = updateParticles sec partUpd $ particles ud
|
delta <- getDelta
|
||||||
|
-- let newPart = updateParticles delta partUpd $ particles ud
|
||||||
-- putAffection $ ud { particles = newPart }
|
-- putAffection $ ud { particles = newPart }
|
||||||
traceM $ (show $ 1 / sec) ++ " FPS"
|
traceM $ (show $ 1 / delta) ++ " FPS"
|
||||||
-- ev <- liftIO $ SDL.pollEvents
|
-- 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
|
if SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat
|
||||||
then do
|
then do
|
||||||
|
ad <- get
|
||||||
|
ud <- getAffection
|
||||||
let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
|
let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
|
||||||
vx <- liftIO $ randomRIO (-20, 20)
|
vx <- liftIO $ randomRIO (-20, 20)
|
||||||
vy <- liftIO $ randomRIO (-20, 20)
|
vy <- liftIO $ randomRIO (-20, 20)
|
||||||
|
@ -165,17 +171,13 @@ update sec evs = do
|
||||||
-- (particleStackCont $ head $ psParts $ partsys ud)
|
-- (particleStackCont $ head $ psParts $ partsys ud)
|
||||||
else
|
else
|
||||||
return ()
|
return ()
|
||||||
SDL.WindowClosedEvent _ -> do
|
|
||||||
|
handle (SDL.WindowClosedEvent _) = do
|
||||||
traceM "seeya!"
|
traceM "seeya!"
|
||||||
put $ ad
|
quit
|
||||||
{ quitEvent = True
|
|
||||||
}
|
handle _ =
|
||||||
_ ->
|
|
||||||
return ()
|
return ()
|
||||||
) evs
|
|
||||||
ud2 <- getAffection
|
|
||||||
!nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw
|
|
||||||
putAffection $ ud2 { partsys = nps }
|
|
||||||
|
|
||||||
clean :: UserData -> IO ()
|
clean :: UserData -> IO ()
|
||||||
clean _ = return ()
|
clean _ = return ()
|
||||||
|
|
|
@ -9,6 +9,9 @@ module Affection
|
||||||
, delaySec
|
, delaySec
|
||||||
, get
|
, get
|
||||||
, put
|
, put
|
||||||
|
, getTick
|
||||||
|
, getDelta
|
||||||
|
, quit
|
||||||
, module A
|
, module A
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -93,6 +96,7 @@ withAffection AffectionConfig{..} = do
|
||||||
, drawCPP = cpp
|
, drawCPP = cpp
|
||||||
, drawStack = []
|
, drawStack = []
|
||||||
, elapsedTime = 0
|
, elapsedTime = 0
|
||||||
|
, dt = 0
|
||||||
}) <$> loadState surface
|
}) <$> loadState surface
|
||||||
(_, nState) <- runStateT ( A.runState $ do
|
(_, nState) <- runStateT ( A.runState $ do
|
||||||
preLoop
|
preLoop
|
||||||
|
@ -116,11 +120,13 @@ withAffection AffectionConfig{..} = do
|
||||||
put $ ad
|
put $ ad
|
||||||
{ drawStack = []
|
{ drawStack = []
|
||||||
, elapsedTime = ne
|
, elapsedTime = ne
|
||||||
|
, dt = dt
|
||||||
}
|
}
|
||||||
-- poll events
|
-- poll events
|
||||||
evs <- preHandleEvents =<< liftIO SDL.pollEvents
|
evs <- preHandleEvents =<< liftIO SDL.pollEvents
|
||||||
|
forM evs $ eventLoop
|
||||||
-- execute user defined update loop
|
-- execute user defined update loop
|
||||||
updateLoop dt evs
|
updateLoop
|
||||||
-- execute user defined draw loop
|
-- execute user defined draw loop
|
||||||
drawLoop
|
drawLoop
|
||||||
-- handle all new draw requests
|
-- handle all new draw requests
|
||||||
|
@ -154,7 +160,7 @@ getSurfaces window = do
|
||||||
return (oldSurf, surface)
|
return (oldSurf, surface)
|
||||||
|
|
||||||
-- Prehandle SDL events in case any window events occur
|
-- 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 =
|
preHandleEvents evs =
|
||||||
-- mapM handle evs
|
-- mapM handle evs
|
||||||
-- where
|
-- where
|
||||||
|
@ -165,7 +171,7 @@ preHandleEvents evs =
|
||||||
-- return e
|
-- return e
|
||||||
-- _ ->
|
-- _ ->
|
||||||
-- return e
|
-- return e
|
||||||
return evs
|
return $ map SDL.eventPayload evs
|
||||||
|
|
||||||
-- | Return the userstate to the user
|
-- | Return the userstate to the user
|
||||||
getAffection :: Affection us us
|
getAffection :: Affection us us
|
||||||
|
@ -187,3 +193,17 @@ delaySec
|
||||||
:: Int -- ^ Number of seconds
|
:: Int -- ^ Number of seconds
|
||||||
-> IO ()
|
-> IO ()
|
||||||
delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
|
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 }
|
||||||
|
|
|
@ -56,10 +56,12 @@ data AffectionConfig us = AffectionConfig
|
||||||
-- ^ Window configuration
|
-- ^ Window configuration
|
||||||
, preLoop :: Affection us ()
|
, preLoop :: Affection us ()
|
||||||
-- ^ Actions to be performed, before loop starts
|
-- ^ 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 ()
|
, drawLoop :: Affection us ()
|
||||||
-- ^ Function for updating graphics.
|
-- ^ 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
|
, loadState :: SDL.Surface -> IO us
|
||||||
-- ^ Provide your own load function to create this data.
|
-- ^ Provide your own load function to create this data.
|
||||||
, cleanUp :: us -> IO ()
|
, cleanUp :: us -> IO ()
|
||||||
|
@ -86,6 +88,7 @@ data AffectionData us = AffectionData
|
||||||
, drawStride :: Int -- ^ Stride of target buffer
|
, drawStride :: Int -- ^ Stride of target buffer
|
||||||
, drawCPP :: Int -- ^ Number of components per pixel
|
, drawCPP :: Int -- ^ Number of components per pixel
|
||||||
, elapsedTime :: Double -- ^ Elapsed time in seconds
|
, 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
|
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
|
||||||
|
|
Loading…
Reference in a new issue