Merge pull request #1 from nek0/shtuff

Stuff that I think is better
This commit is contained in:
rys ostrovid 2017-03-16 20:25:20 +01:00 committed by GitHub
commit cb16e5ef09
7 changed files with 109 additions and 64 deletions

View file

@ -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

View file

@ -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 ()

View file

@ -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 ()

View file

@ -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 ()

View file

@ -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 }

View file

@ -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)

View file

@ -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