Fix new game resize bug

This commit is contained in:
2021-04-22 10:11:26 +02:00
parent 50e957818f
commit 60b2327909
6 changed files with 32 additions and 9 deletions
+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