commit
cb16e5ef09
7 changed files with 109 additions and 64 deletions
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
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")
|
||||
|
@ -98,28 +98,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
|
||||
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)
|
||||
}
|
||||
SDL.WindowClosedEvent _ -> do
|
||||
|
||||
handle (SDL.WindowClosedEvent _) = do
|
||||
traceM "seeya!"
|
||||
put $ ad
|
||||
{ quitEvent = True
|
||||
}
|
||||
_ ->
|
||||
quit
|
||||
|
||||
handle _ =
|
||||
return ()
|
||||
) evs
|
||||
|
||||
clean :: UserData -> IO ()
|
||||
clean _ = return ()
|
||||
|
|
|
@ -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
|
||||
|
||||
handle (SDL.WindowClosedEvent _) = do
|
||||
traceM "seeya!"
|
||||
put $ ad
|
||||
{ quitEvent = True
|
||||
}
|
||||
_ ->
|
||||
quit
|
||||
|
||||
handle _ =
|
||||
return ()
|
||||
) evs
|
||||
ud2 <- getAffection
|
||||
!nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw
|
||||
putAffection $ ud2 { partsys = nps }
|
||||
|
||||
clean :: UserData -> IO ()
|
||||
clean _ = return ()
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue