module Main where import Loop import Shader import LoadConfig import Dodge.Default import Dodge.Data import Dodge.Initialisation import Dodge.Rooms import Dodge.Layout import Dodge.Update import Dodge.Event import Dodge.Render import Dodge.Menu import Dodge.Floor import Dodge.LoadConfig import Dodge.LoadSound import Picture import Picture.Render import Picture.Preload import Sound import Preload import Sound.Preload 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 SDL import qualified SDL.Mixer as Mix import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) 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 void $ doDrawing (_renderData preData) 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 ) (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