150 lines
4.8 KiB
Haskell
150 lines
4.8 KiB
Haskell
module Main (main) where
|
|
|
|
import Dodge.SoundSelection
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Control.Parallel
|
|
import qualified Data.Map.Strict as M
|
|
import qualified Data.Text as T
|
|
import Dodge.Concurrent
|
|
import Dodge.Config
|
|
import Dodge.Data
|
|
import Dodge.Event
|
|
import Dodge.Initialisation
|
|
import Dodge.LoadSeed
|
|
import Dodge.Render
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.StartNewGame
|
|
import Dodge.TestString
|
|
import Dodge.Update
|
|
import Loop
|
|
import Preload
|
|
import Preload.Render
|
|
import SDL (($=))
|
|
import qualified SDL
|
|
import Sound
|
|
import System.Directory
|
|
|
|
main :: IO ()
|
|
main = do
|
|
-- load the config to get the window size and position
|
|
con <- loadDodgeConfig
|
|
let sizex = _windowX con
|
|
sizey = _windowY con
|
|
posx = _windowPosX con
|
|
posy = _windowPosY con
|
|
setupConLoop'
|
|
20
|
|
(T.pack "Simple Game Loop")
|
|
(winConfig sizex sizey (Just (posx, posy)))
|
|
theCleanup
|
|
(firstWorldLoad con)
|
|
conEffects
|
|
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 5
|
|
, 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 :: Config -> IO Universe
|
|
firstWorldLoad theConfig = do
|
|
SDL.cursorVisible $= False
|
|
pdata <- doPreload >>= applyWorldConfig theConfig
|
|
cancontinue <- doesFileExist "saveSlot/0"
|
|
mseed <- loadSeed
|
|
let u =
|
|
Universe
|
|
{ _uvWorld = splashScreen
|
|
, _uvConfig = theConfig
|
|
, _preloadData = pdata
|
|
, _uvScreenLayers = []
|
|
, _uvIOEffects = return
|
|
, _uvTestString = testStringInit
|
|
, _uvSideEffects = mempty
|
|
, _uvCanContinue = cancontinue
|
|
, _uvMSeed = mseed
|
|
, _uvLastFrameTicks = 0
|
|
, _uvFrameTicks = 0
|
|
, _uvRAMSave = Nothing
|
|
, _uvDebug = mempty
|
|
, _uvDebugFloat1 = 10
|
|
, _uvDebugFloat2 = 0
|
|
, _uvDebugV2_1 = 0
|
|
, _uvDebugV2_2 = 1
|
|
, _uvDebugPut = mempty
|
|
, _uvDebugMessageOffset = 0
|
|
, _uvSoundQueue = mempty
|
|
, _uvDebugPathShowType = PathBetweenDebugV2s
|
|
}
|
|
--return $ u & uvScreenLayers .~ [splashMenu u]
|
|
return $ startNewGameInSlot 0 u
|
|
|
|
theUpdateStep :: SDL.Window -> Universe -> IO Universe
|
|
theUpdateStep win = doSideEffects <=< updateRenderSplit win
|
|
|
|
updateRenderSplit :: SDL.Window -> Universe -> IO Universe
|
|
updateRenderSplit win u = do
|
|
--updateUniverse u `par` void (doDrawing win u)
|
|
updateUniverse u `par` doDrawing win u
|
|
return $! updateUniverse u
|
|
|
|
playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
|
|
playSoundUnlessRewinding u = case w ^. timeFlow of
|
|
NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (newSoundsToPlay u)
|
|
RespawnDelay{} -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (newSoundsToPlay u)
|
|
_ -> stopAllSounds >> return M.empty
|
|
where
|
|
w = _uvWorld u
|
|
|
|
doSideEffects :: Universe -> IO Universe
|
|
doSideEffects u = do
|
|
newPlayingSounds <- playSoundUnlessRewinding u
|
|
playSoundQueue (_soundData $ _preloadData u) (fmap _getSoundID $ u ^. uvSoundQueue)
|
|
u' <- _uvIOEffects u u
|
|
endTicks <- SDL.ticks
|
|
return $
|
|
u'
|
|
& uvLastFrameTicks .~ (u ^. uvFrameTicks)
|
|
& uvFrameTicks .~ endTicks
|
|
& uvWorld . playingSounds .~ newPlayingSounds
|
|
& uvWorld . toPlaySounds .~ M.empty
|
|
& uvIOEffects .~ return
|
|
& uvSoundQueue .~ mempty
|
|
|
|
doPreload :: IO PreloadData
|
|
doPreload = do
|
|
putStrLn "Start Render preload"
|
|
rData <- preloadRender
|
|
putStrLn "Start sound preload"
|
|
lChunks <- loadSounds
|
|
putStrLn "Skip music preload!"
|
|
-- lMusic <- loadMusic
|
|
-- Mix.playMusic Mix.Forever (lMusic IM.! 0)
|
|
putStrLn "Return PreloadData"
|
|
return
|
|
PreloadData
|
|
{ _renderData = rData
|
|
, _soundData = lChunks
|
|
, --, _musicData = MusicData{_loadedMusic = lMusic}
|
|
_musicData = mempty
|
|
}
|