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

Merge branch 'testing'

Browse Source
This commit is contained in:
jgk
2021-04-07 18:50:03 +02:00
parent 89a6eec561 79673574b9
commit bc8af0ac29
5 changed files with 61 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+17 -14
View File
@@ -22,19 +22,20 @@ import Preload
import Sound.Data
import Music
import Control.Concurrent
import Control.Lens
import Foreign (Word32)
import Control.Concurrent
import Control.Lens
import Foreign (Word32)
import Control.Monad (when,void)
import System.Random
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Graphics.Rendering.OpenGL hiding (color, rotate, scale,
translate)
import qualified SDL
import qualified SDL.Mixer as Mix
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import qualified SDL.Mixer as Mix
doPreload' :: IO (PreloadData a)
doPreload' = do
@@ -55,7 +56,7 @@ main :: IO ()
main = do
(sizex,sizey) <- loadConfig
keyConfig <- loadKeyConfig
setupLoop
setupLoop
(sizex,sizey)
(SDL.cursorVisible $= False >> doPreload' >>= resizeSpareFBO sizex sizey)
(\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
@@ -68,12 +69,14 @@ main = do
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)
)
when (_debugMode w) $ void $ 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 . playingSounds .~ newPlayingSounds
& frameTimer .~ endTicks
)