module Main ( main ) where import Loop import Dodge.TestString import Dodge.Data import Dodge.StartNewGame import Dodge.Initialisation import Dodge.Concurrent --import Dodge.LevelGen import Dodge.Update import Dodge.Event import Dodge.Render import Dodge.Config.Load import Dodge.Config.Update import Dodge.SoundLogic.LoadSound import Picture import Render import Preload.Render import Sound import Preload import Music import Data.Preload.Render import Control.Lens import Control.Monad --import Control.Monad.Parallel import qualified Data.Text as T import qualified IntMapHelp as IM import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate) import qualified SDL import qualified SDL.Mixer as Mix import Control.Parallel import qualified Data.Map.Strict as M main :: IO () main = do -- load the config to get the window size and position con <- loadDodgeConfig let sizex = floor $ _windowX con sizey = floor $ _windowY con posx = _windowPosX con posy = _windowPosY con setupConLoop 20 (T.pack "Simple Game Loop") (winConfig sizex sizey (Just (posx,posy))) theCleanup (firstWorldLoad con) conTest theUpdateStep (flip handleEvent) -- | Create an OpenGL SDL window configuration with a given x and y size. winConfig :: Int -> Int -> Maybe (Int, Int) -> SDL.WindowConfig winConfig x y winpos = SDL.defaultWindow { SDL.windowGraphicsContext = SDL.OpenGLContext $ SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 4 3 , SDL.glColorPrecision = SDL.V4 8 8 8 8 } , SDL.windowPosition = theWinPos , SDL.windowInitialSize = SDL.V2 (fromIntegral x) (fromIntegral y) , SDL.windowResizable = True } where theWinPos = case winpos of Just (px,py) -> SDL.Absolute (SDL.P (SDL.V2 (fromIntegral px) (fromIntegral py))) Nothing -> SDL.Wherever theCleanup :: Universe -> IO () theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv) firstWorldLoad :: Configuration -> IO Universe firstWorldLoad theConfig = do SDL.cursorVisible $= False pdata <- doPreload >>= applyWorldConfig theConfig return $ startNewGame $ Universe {_uvWorld = initialWorld ,_uvConfig = theConfig ,_preloadData = pdata ,_menuLayers = [] , _uvIOEffects = return , _uvTestString = testStringInit , _uvConcMessage = "" , _quickSave = Nothing , _uvConcEffects = Nothing } theUpdateStep :: Universe -> IO Universe theUpdateStep = doSideEffects <=< updateRenderSplit updateRenderSplit :: Universe -> IO Universe updateRenderSplit u = do let preData = _preloadData u updateUniverse u `par` void (doDrawing (_renderData preData) u) return (updateUniverse u) playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) playSoundUnlessRewinding u | _timeFlow w == RewindingNow = return M.empty | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w) where w = _uvWorld u doSideEffects :: Universe -> IO Universe doSideEffects u = do let preData = _preloadData u newPlayingSounds <- playSoundUnlessRewinding u u' <- _uvIOEffects u u endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData when (debugOn Show_ms_frame $ _uvConfig u) $ void $ renderFoldable (_pictureShaders $ _renderData preData) (setDepth (-1) . translate (-0.5) (-0.8) . scale 0.0005 0.0005 $ fpsText (endTicks - lastFrameTicks) ) return $ u' & preloadData . frameTimer .~ endTicks & uvWorld . playingSounds .~ newPlayingSounds & uvWorld . toPlaySounds .~ M.empty & uvIOEffects .~ return fpsText :: (Show a, Ord a, Num a) => a -> Picture fpsText x = color col $ text $ "ms/frame " ++ show x where col | x < 22 = blue | x < 30 = green | x < 40 = yellow | x < 50 = orange | otherwise = red doPreload :: IO PreloadData doPreload = do rData <- preloadRender lChunks <- loadSounds lMusic <- loadMusic Mix.playMusic Mix.Forever (lMusic IM.! 0) return PreloadData { _renderData = rData , _soundData = SoundData {_loadedChunks = lChunks} , _musicData = MusicData {_loadedMusic = lMusic} , _frameTimer = 0 } --checkForGlErrors :: IO () --checkForGlErrors = do -- errs <- errors -- unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)