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

Modularise your control

Browse Source
This commit is contained in:
justin
2021-03-27 00:13:11 +01:00
parent 62b5ffbfaa
commit e6a57653b3
6 changed files with 132 additions and 113 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+27 -30
View File
@@ -36,45 +36,42 @@ import qualified SDL
import qualified SDL.Mixer as Mix
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import LoadConfig
cursorVis :: Bool -> IO ()
cursorVis b = SDL.cursorVisible $= b
main :: IO ()
main = do
(sizex,sizey) <- loadConfig
keyConfig <- loadKeyConfig
setupLoop
(sizex,sizey)
(cursorVis False >> doPreload >>= resizeSpareFBO sizex sizey)
(\x -> cursorVis True >> cleanUpPreload x)
(SDL.cursorVisible $= False >> doPreload >>= resizeSpareFBO sizex sizey)
(\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
(fmap (setWindowSize sizex sizey keyConfig) firstWorld)
( \preData w -> do
startTicks <- SDL.ticks
clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w)
(_cameraCenter w)
(_windowX w,_windowY w)
(wallsPointsAndCols w)
(wallsWindows w)
(lightsForGloom' w)
(_cameraViewFrom w)
(worldPictures w)
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
playSoundQueue (_soundData preData) (_soundQueue w)
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
startTicks <- SDL.ticks
clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w)
(_cameraCenter w)
(_windowX w,_windowY w)
(wallsPointsAndCols w)
(wallsWindows w)
(lightsForGloom' w)
(_cameraViewFrom w)
(worldPictures w)
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
playSoundQueue (_soundData preData) (_soundQueue w)
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
renderFoldable (_renderData preData)
(picToLTree Nothing . setLayer 1 . setDepth (-1)
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks))
return $ preData & soundData .~ newSoundData
& frameTimer .~ endTicks
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
renderFoldable
(_renderData preData)
(picToLTree Nothing . setLayer 1 . setDepth (-1)
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
)
return $ preData & soundData .~ newSoundData
& frameTimer .~ endTicks
)
(flip $ menuEvents handleEvent)
(Just . update)