62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
module Dodge.StartNewGame (
|
|
startNewGameInSlot,
|
|
startSeedGame,
|
|
) where
|
|
|
|
import Dodge.Concurrent
|
|
import Dodge.Data.Universe
|
|
import Dodge.LevelGen
|
|
import Dodge.Save
|
|
import Dodge.WorldLoad
|
|
import Justify
|
|
import LensHelp
|
|
import System.Directory
|
|
import System.Random
|
|
|
|
startNewGameInSlot :: Int -> Universe -> Universe
|
|
startNewGameInSlot slot u = startSeedGame slot i u
|
|
where
|
|
i = fst $ randomR (0, maxBound) (_randGen (_uvWorld u))
|
|
|
|
startSeedGame :: Int -> Int -> Universe -> Universe
|
|
startSeedGame _ i u =
|
|
blockingLoad
|
|
startPara
|
|
("GENERATING FROM SEED " ++ show i)
|
|
(startSeedGameConc i $ u ^. preloadData)
|
|
u
|
|
|
|
startPara :: [String]
|
|
startPara =
|
|
[ "Something has gone wrong."
|
|
, ""
|
|
, ""
|
|
, ""
|
|
]
|
|
<> makeParagraph
|
|
55
|
|
( "My last memory is the pre-duplication scan. "
|
|
<> "Though experimental, this techology allows for the creation of perfect copies. "
|
|
<> "At least in theory; "
|
|
<> "it hasn't been tested on humans: "
|
|
<> "I'd only be duplicated if my original body was... non-functional."
|
|
)
|
|
<> ["", "","", "Hopefully I can take better care of this one."]
|
|
|
|
startSeedGameConc :: Int -> PreloadData -> IO (Universe -> Maybe Universe)
|
|
startSeedGameConc seed pdata = do
|
|
w <- generateWorldFromSeed (pdata ^?! renderData) seed
|
|
createDirectoryIfMissing True "generated/saveSlot"
|
|
writeFile "generated/saveSlot/seed" $ show seed
|
|
return $
|
|
Just
|
|
. saveWorldInSlot (LevelStartSlot 0)
|
|
. maybeClearLoadingScreen
|
|
. (uvWorld .~ w)
|
|
. postUniverseLoadSideEffect
|
|
|
|
maybeClearLoadingScreen :: Universe -> Universe
|
|
maybeClearLoadingScreen u = case u ^? uvScreenLayers . ix 0 . scBlockStatus of
|
|
Just LoadWaitingClicked -> u & uvScreenLayers .~ []
|
|
_ -> u & uvScreenLayers . ix 0 . scBlockStatus .~ LoadReady
|