Fix new game resize bug

This commit is contained in:
jgk
2021-04-22 10:11:26 +02:00
parent 50e957818f
commit 60b2327909
6 changed files with 32 additions and 9 deletions
Binary file not shown.
+8 -6
View File
@@ -7,6 +7,7 @@ import Dodge.Initialisation
import Dodge.SoundLogic
import Dodge.Config.Data
import Dodge.Config.Update
import Dodge.Layout
import Data.Maybe
import qualified Data.Set as S
@@ -23,17 +24,14 @@ handlePressedKeyInMenu mState scode w = case mState of
PauseMenu -> case scode of
ScancodeEscape -> Nothing
ScancodeR -> return $ fromMaybe w $ _storedLevel w
ScancodeN -> Just $ putSound $ generateLevel 1
$ initialWorld {_randGen = _randGen w}
ScancodeN -> startNewGame
ScancodeO -> goToOptionMenu w
ScancodeC -> goToControls w
_ -> unpause w
GameOverMenu -> case scode of
ScancodeEscape -> Nothing
ScancodeR -> Just $ fromMaybe w $ _storedLevel w
ScancodeN -> Just $ putSound $ generateLevel 1
$ initialWorld
{_randGen = _randGen w}
ScancodeN -> startNewGame
ScancodeO -> goToOptionMenu w
ScancodeC -> goToControls w
_ -> Just w
@@ -52,12 +50,16 @@ handlePressedKeyInMenu mState scode w = case mState of
unpause w' = Just . resumeSound $
w' {_menuLayers = []}
startLevel = unpause . storeLevel
putSound = id -- set loadedSounds (_loadedSounds w)
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
goToOptionMenu w = Just $ w & menuLayers %~ (OptionMenu :)
goToControls w = Just $ w & menuLayers %~ (ControlList :)
sw = w & sideEffects %~ (setVol (_config w) : )
startNewGame = Just $ generateFromList levx
$ initialWorld
& randGen .~ _randGen w
& windowX .~ _windowX w
& windowY .~ _windowY w
storeLevel :: World -> World
storeLevel w = case _storedLevel w of
+1 -1
View File
@@ -454,7 +454,7 @@ ltAutoGun = defaultAutoGun
, _wpReloadState = 0
, _wpFireRate = 4
, _wpFireState = 0
, _wpFire = shootWithSound 0 . withRandomDir 0.3
, _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect'
, _wpSpread = 0.5
, _wpRange = 20
+8 -1
View File
@@ -5,6 +5,7 @@ module Dodge.Layout.Tree.Annotate
where
import Dodge.RandomHelp
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Room.Procedural
import Dodge.Room.Link
import Dodge.Room.Data
@@ -38,7 +39,13 @@ randomPadCorridors (Node x xs) = do
annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room))
annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor
annoToRoomTree [FirstWeapon] = weaponRoom
annoToRoomTree [FirstWeapon] = do
--firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom]
branchWP <- branchRectWith weaponRoom
blockedC <- blockedCorridor
firstWeapon <- takeOne $ [return $ appendEitherTree branchWP [blockedC]] ++ replicate 5 weaponRoom
--firstWeapon <- takeOne $ replicate 5 weaponRoom
firstWeapon
annoToRoomTree _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
+11
View File
@@ -3,6 +3,7 @@ Combining and composing trees with 'Either' nodes.
-}
module Dodge.Layout.Tree.Either
( expandTreeBy
, appendEitherTree
, connectRoom
, deadRoom
) where
@@ -20,6 +21,16 @@ expandTreeBy f (Node x xs) = appendAndRemove $ f x
appendAndRemove (Node (Left y) ys) = Node y (map appendAndRemove ys)
appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
-- | Appends a second either forest at the 'Right' elements of a first either
-- tree.
-- Makes such 'Right' elements into 'Left's.
appendEitherTree
:: Tree (Either a a) -- ^ The first tree
-> [Tree (Either a a)] -- ^ The forest to append
-> Tree (Either a a)
appendEitherTree (Node (Left x) ts) ts' = Node (Left x) $ map (flip appendEitherTree ts') ts
appendEitherTree (Node (Right x) ts) ts' = Node (Left x) ts'
removeEither (Left y) = y
removeEither (Right y) = y
+4 -1
View File
@@ -392,6 +392,7 @@ blockedCorridor = do
n <- state $ randomR (0,3)
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 $ putLamp
]
sequence $ treePost (replicate n $ fmap Left $ randomiseOutLinks corridor)
$ fmap Right $ return $ set rmPS plmnts corridor
@@ -430,7 +431,9 @@ deadEndRoom = Room
where lnks = [((0,30) ,0)
]
{-
A random Either tree with a weapon and melee monster challenge.
-}
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponRoom = do
x <- takeOne [ weaponEmptyRoom