justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow for parameters to be changed by io actions

Browse Source
This commit is contained in:
justin
2021-02-23 14:54:05 +01:00
parent 058873af50
commit 62a1a57913
2 changed files with 7 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+2 -1
View File
@@ -51,12 +51,14 @@ main = do
(initializeWorld $ generateFromTree lev1 $ initWorld) (initializeWorld $ generateFromTree lev1 $ initWorld)
(-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade (-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
\preData w -> --do render setparams w egFade \preData w -> --do render setparams w egFade
do
renderPicture' preData (_cameraRot w) (_cameraZoom w) renderPicture' preData (_cameraRot w) (_cameraZoom w)
(_cameraPos w) (_cameraPos w)
(_windowX w,_windowY w) (_windowX w,_windowY w)
(wallsForGloom' w) (wallsForGloom' w)
(lightsForGloom' w) (lightsForGloom' w)
(draw blank w) (draw blank w)
return preData
--renderPicture' preData (_windowX w,_windowY w) (Circle 5) --renderPicture' preData (_windowX w,_windowY w) (Circle 5)
-- renderPicture' preData -- renderPicture' preData
-- (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)] -- (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]
@@ -65,7 +67,6 @@ main = do
-- ] -- ]
-- ) -- )
) )
(\_ _ -> return)
(flip $ menuEvents $ flip handleEvent) (flip $ menuEvents $ flip handleEvent)
(\w -> Just $ update w) (\w -> Just $ update w)
Mix.closeAudio Mix.closeAudio
src/Loop.hs
+5 -7
View File
@@ -28,13 +28,12 @@ setupLoop :: String
-> IO setupParams -> IO setupParams
-> (setupParams -> IO ()) -> (setupParams -> IO ())
-> world -> world
-> (setupParams -> world -> IO ()) -> (setupParams -> world -> IO setupParams)
-> (setupParams -> world -> storableSideEffects -> IO storableSideEffects)
-> (world -> Event -> Maybe world) -> (world -> Event -> Maybe world)
-> (world -> Maybe world) -> (world -> Maybe world)
-> IO () -> IO ()
setupLoop wName xSize ySize setupLoop wName xSize ySize
customInit initCleanup startWorld sideEffects storableFn eventFn worldFn = do customInit initCleanup startWorld sideEffects eventFn worldFn = do
initializeAll initializeAll
bracket (createWindow (T.pack wName) (winConfig xSize ySize)) destroyWindow bracket (createWindow (T.pack wName) (winConfig xSize ySize)) destroyWindow
(\window -> (\window ->
@@ -48,7 +47,7 @@ setupLoop wName xSize ySize
GL.clearColor $= GL.Color4 0 0.5 0 1 GL.clearColor $= GL.Color4 0 0.5 0 1
GL.clearDepth $= (200) GL.clearDepth $= (200)
doLoop setup window startWorld doLoop setup window startWorld
sideEffects storableFn eventFn worldFn sideEffects eventFn worldFn
) )
) )
@@ -60,12 +59,11 @@ setupLoop wName xSize ySize
-- -> IO () -- -> IO ()
doLoop setup window startWorld doLoop setup window startWorld
worldSideEffects worldSideEffects
storableFn
eventFn eventFn
worldUpdate worldUpdate
= do = do
GL.clear [GL.ColorBuffer,GL.DepthBuffer] GL.clear [GL.ColorBuffer,GL.DepthBuffer]
worldSideEffects setup startWorld newParams <- worldSideEffects setup startWorld
glSwapWindow window glSwapWindow window
--worldSideEffects setup updatedWorld --worldSideEffects setup updatedWorld
startLoopTicks <- ticks startLoopTicks <- ticks
@@ -83,7 +81,7 @@ doLoop setup window startWorld
endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic) endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks) let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
threadDelay (delay * 1000) threadDelay (delay * 1000)
doLoop setup window updatedWorld worldSideEffects storableFn eventFn worldUpdate doLoop newParams window updatedWorld worldSideEffects eventFn worldUpdate
Nothing -> return () Nothing -> return ()
applyEvents :: (world0 -> Event -> Maybe world0) applyEvents :: (world0 -> Event -> Maybe world0)