Files
loop/app/Main.hs
T
2021-03-25 14:23:45 +01:00

85 lines
2.8 KiB
Haskell

module Main where
import Loop
import Shader
import Shapes
import LoadConfig
import Dodge.Prototypes
import Dodge.Data
import Dodge.Initialisation
import Dodge.Rooms
import Dodge.Layout
import Dodge.LoadSound
import Dodge.Update
import Dodge.Event
import Dodge.Rendering
import Dodge.Menu
import Dodge.Floor
import Picture
import Picture.Render
import Picture.Preload
import Sound
import Preload
import Control.Concurrent
import Control.Lens
import Control.Monad (when)
import System.Random
import qualified SDL as SDL
import qualified SDL.Mixer as Mix
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
main :: IO ()
main = do
(sizex,sizey) <- loadConfig
setupLoop
(sizex,sizey)
(doPreload >>= resizeSpareFBO sizex sizey)
cleanUpPreload
(fmap (setWindowSize sizex sizey) firstWorld)
( \preData w -> do
startTicks <- SDL.ticks
clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w)
(_cameraPos w)
(_windowX w,_windowY w)
(wallsPointsAndCols w)
(wallsWindows w)
(lightsForGloom' w)
(_cameraCenter 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 (-0.8) . scale 0.0005 0.0005
. text $ show (endTicks - lastFrameTicks))
return $ preData & soundData .~ newSoundData
& frameTimer .~ endTicks
)
(flip $ menuEvents $ handleEvent)
(\w -> Just $ update w)
Mix.closeAudio
checkForGlErrors :: IO ()
checkForGlErrors = do
errs <- errors
when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
setWindowSize :: Int -> Int -> World -> World
setWindowSize x y w = w & windowX .~ fromIntegral x
& windowY .~ fromIntegral y