42 lines
1.3 KiB
Haskell
42 lines
1.3 KiB
Haskell
module Dodge.StartNewGame (
|
|
startNewGameInSlot,
|
|
startSeedGame,
|
|
) where
|
|
|
|
import Data.Preload.Render
|
|
import Shader.Data
|
|
import Shader.Poke -- it would be very nice to remove/rework the poking dependencies
|
|
import Dodge.Menu.Loading
|
|
import Dodge.Concurrent
|
|
--import Dodge.Menu.Option
|
|
import LensHelp
|
|
import Dodge.Data.Universe
|
|
import Dodge.LevelGen
|
|
import Dodge.Save
|
|
import System.Random
|
|
|
|
startNewGameInSlot :: Int -> Universe -> Universe
|
|
startNewGameInSlot slot u = startSeedGame slot i u
|
|
where
|
|
i = fst $ randomR (0, maxBound) (_randGen (_uvWorld u))
|
|
|
|
|
|
blockingLoad :: String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
|
|
blockingLoad str f u = u & uvScreenLayers .:~ loadingScreen str
|
|
& addSideEffect f str
|
|
|
|
startSeedGame :: Int -> Int -> Universe -> Universe
|
|
startSeedGame _ i u = blockingLoad "LOADING" (startSeedGameConc i $ u ^. preloadData) u
|
|
|
|
startSeedGameConc :: Int -> PreloadData -> IO (Universe -> Maybe Universe)
|
|
startSeedGameConc seed pdata = do
|
|
w' <- generateWorldFromSeed seed
|
|
nfloorvxs <- pokeFloors (pdata ^?! renderData . textureArrayShader . _2 . vboPtr)
|
|
(w' ^. cWorld . floorTiles)
|
|
let w = w' & numberFloorVerxs .~ nfloorvxs
|
|
writeFile "saveSlot/seed" $ show seed
|
|
return $ Just
|
|
. saveWorldInSlot (LevelStartSlot 0)
|
|
. (uvScreenLayers .~ [])
|
|
. (uvWorld .~ w)
|