113 lines
3.2 KiB
Haskell
113 lines
3.2 KiB
Haskell
module Main where
|
|
import Loop
|
|
import Dodge.Data
|
|
import Dodge.Initialisation
|
|
import Dodge.Update
|
|
import Dodge.Event
|
|
import Dodge.Render
|
|
import Dodge.Config.Data
|
|
import Dodge.Config.KeyConfig
|
|
import Dodge.Config.Load
|
|
import Dodge.Config.Update
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Picture
|
|
import Render
|
|
import Preload.Render
|
|
import Sound
|
|
import Preload
|
|
import Sound.Data
|
|
import Music
|
|
import Data.Preload
|
|
import Data.Preload.Render
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import qualified Data.IntMap 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
|
|
con <- loadDodgeConfig
|
|
let sizex = floor $ _windowX con
|
|
sizey = floor $ _windowY con
|
|
posx = _windowPosX con
|
|
posy = _windowPosY con
|
|
setupLoop
|
|
20
|
|
(sizex,sizey)
|
|
(posx,posy)
|
|
theCleanup
|
|
(firstWorldLoad (sizex,sizey))
|
|
theUpdateStep
|
|
(flip handleEvent)
|
|
|
|
theCleanup :: World -> IO ()
|
|
theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
|
|
|
|
firstWorldLoad :: (Int,Int) -> IO World
|
|
firstWorldLoad (sizex,sizey) = do
|
|
SDL.cursorVisible $= False
|
|
theKeyConfig <- loadKeyConfig
|
|
theConfig <- loadDodgeConfig
|
|
pdata <- doPreload >>= applyWorldConfig theConfig
|
|
w <- fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ theConfig)) firstWorld
|
|
return $ w & preloadData .~ pdata
|
|
|
|
theUpdateStep :: World -> IO World
|
|
theUpdateStep = doSideEffects <=< updateRenderSplit
|
|
|
|
updateRenderSplit :: World -> IO World
|
|
updateRenderSplit w = do
|
|
let preData = _preloadData w
|
|
update w `par` void (doDrawing (_renderData preData) w)
|
|
return $ update w
|
|
|
|
doSideEffects :: World -> IO World
|
|
doSideEffects w = do
|
|
let preData = _preloadData w
|
|
newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
|
|
w' <- _sideEffects w w
|
|
|
|
endTicks <- SDL.ticks
|
|
let lastFrameTicks = _frameTimer preData
|
|
|
|
when (_debug_seconds_frame $ _config w) $ void $ renderFoldable
|
|
(_pictureShaders $ _renderData preData)
|
|
(setDepth (-1)
|
|
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
|
|
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
|
|
)
|
|
return $ w' & preloadData . frameTimer .~ endTicks
|
|
& playingSounds .~ newPlayingSounds
|
|
& toPlaySounds .~ M.empty
|
|
& sideEffects .~ return
|
|
|
|
doPreload :: IO PreloadData
|
|
doPreload = do
|
|
lChunks <- loadSounds
|
|
lMusic <- loadMusic
|
|
let sData = SoundData {_loadedChunks = lChunks}
|
|
mData = MusicData {_loadedMusic = lMusic}
|
|
Mix.playMusic Mix.Forever (lMusic IM.! 0)
|
|
rData <- preloadRender
|
|
return $ PreloadData
|
|
{ _renderData = rData
|
|
, _soundData = sData
|
|
, _musicData = mData
|
|
, _frameTimer = 0
|
|
}
|
|
|
|
checkForGlErrors :: IO ()
|
|
checkForGlErrors = do
|
|
errs <- errors
|
|
unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
|
|
|
|
setWindowSize :: Int -> Int -> World -> World
|
|
setWindowSize x y w = w
|
|
& config . windowX .~ fromIntegral x
|
|
& config . windowY .~ fromIntegral y
|