Files
loop/app/Main.hs
T
2021-04-02 09:59:25 +01:00

86 lines
2.8 KiB
Haskell

module Main where
import Dodge.Data
import Dodge.Default
import Dodge.Event
import Dodge.Floor
import Dodge.Initialisation
import Dodge.Layout
import Dodge.LoadConfig
import Dodge.LoadSound
import Dodge.Menu
import Dodge.Render
import Dodge.Rooms
import Dodge.Update
import LoadConfig
import Loop
import Picture
import Picture.Preload
import Picture.Render
import Preload
import Shader
import Sound
import Sound.Preload
import Control.Concurrent
import Control.Lens
import Foreign (Word32)
import Control.Monad (void, when)
import System.Random
import qualified Data.Map as M
import Graphics.Rendering.OpenGL hiding (color, rotate, scale,
translate)
import qualified SDL
import qualified SDL.Mixer as Mix
doPreload' :: IO (PreloadData a)
doPreload' = do
lChunks <- loadSounds
let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty}
rData <- preloadRender
return $ PreloadData rData sData 0
main :: IO ()
main = do
(sizex,sizey) <- loadConfig
keyConfig <- loadKeyConfig
setupLoop
(sizex,sizey)
(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
doDrawing (_renderData preData) w
playSoundQueue (_soundData preData) (_soundQueue w)
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
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 .~ newSoundData
& frameTimer .~ endTicks
)
(flip $ menuEvents handleEvent)
(Just . update)
Mix.closeAudio
checkForGlErrors :: IO ()
checkForGlErrors = do
errs <- errors
when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World
setWindowSize x y z w = w & windowX .~ fromIntegral x
& windowY .~ fromIntegral y
& keyConfig .~ z