justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fold in new composing room datatype

Browse Source
This commit is contained in:
justin
2021-11-22 12:46:32 +00:00
parent e185caf157
commit 09e774d009
9 changed files with 166 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Room.hs
+38 -38
View File
@@ -63,21 +63,21 @@ roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
f a x b y = putBlockRect a x b y
g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
branchWith :: Room -> [Tree Room] -> SubCompTree Room
branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts
manyDoors :: Int -> Tree (Either Room Room)
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
manyDoors :: Int -> SubCompTree Room
manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door
-- TODO: partially combine a room tree into a room
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
glassLesson :: RandomGen g => State g (SubCompTree Room)
glassLesson = do
i <- takeOne [1,2,3]
corridors <- replicateM i $ Left <$> randomiseOutLinks corridor
return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor
return $ Node (PassDown botRoom) [singleUseNone door,uppers, treeFromPost (PassDown door : corridors) $ UseAll door]
where
uppers = Node (Left door) [deadRoom topRoom]
uppers = Node (PassDown door) [deadRoom topRoom]
botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1
topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
botplmnts =
@@ -136,13 +136,13 @@ glassSwitchBackCrits = glassSwitchBack
, spNoID (PSRoomRand 1) randC1
] ++)
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 = glassSwitchBackCrits
>>= randomiseOutLinks
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
@@ -178,17 +178,17 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
[return $ connectRoom door
,join $ takeOne [miniTree2,glassLesson]
]
$ connectRoom <$> randomiseOutLinks corridor
where
f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
g (Node (Right x) []) = Node (Right x) []
g (Node (Right x) xs) = Node (Left x) $ map g xs
f (Node (UseAll x) xs) = Node (UseAll (UseAll x)) $ map f xs
f (Node (PassDown x) xs) = Node (PassDown (PassDown x)) $ map f xs
g (Node (UseAll x) []) = Node (UseAll x) []
g (Node (UseAll x) xs) = Node (PassDown x) $ map g xs
g (Node y ys) = Node y $ map g ys
roomCenterPillar :: RandomGen g => State g Room
@@ -260,7 +260,7 @@ randFirstWeapon = do
++ [launcher]
weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponEmptyRoom :: RandomGen g => State g (SubCompTree Room)
weaponEmptyRoom = do
w <- state $ randomR (220,300)
h <- state $ randomR (220,300)
@@ -271,12 +271,12 @@ weaponEmptyRoom = do
--,sPS (V2 (w/2) (h/2)) 0 putLamp
,mntLightLnkCond unusedLnkToPS
]
treeFromTrunk [Left corridor]
treeFromTrunk [PassDown corridor]
<$> ((fmap connectRoom . randomiseOutLinks) =<<
changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
)
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits :: RandomGen g => State g (SubCompTree Room)
weaponUnderCrits = do
let plmnts =
[sPS (V2 20 0) 0 $ RandPS randFirstWeapon
@@ -284,18 +284,18 @@ weaponUnderCrits = do
,sPS (V2 20 20) (negate $ pi/2) randC1
]
let continuationRoom = treeFromTrunk
[Left corridorN,Left corridorN]
[PassDown corridorN,PassDown corridorN]
(connectRoom (set rmPmnts plmnts corridorN))
rcp <- roomCenterPillar
deadEndRoom' <- takeOne [roomPillars,rcp]
junctionRoom <- takeOne [Left tEast,Left tWest]
return $ treeFromTrunk [Left corridorN,Left corridorN]
junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
return $ treeFromTrunk [PassDown corridorN,PassDown corridorN]
$ Node junctionRoom
[continuationRoom
,deadRoom deadEndRoom'
]
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
weaponBehindPillar = do
wpa <- state $ randomR (0,pi)
wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
@@ -307,12 +307,12 @@ weaponBehindPillar = do
]
rcp <- roomCenterPillar
return $ treeFromTrunk
[Left corridor
,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
[PassDown corridor
,PassDown $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
]
(connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
weaponBetweenPillars = do
wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
(ps,_) <- takeNMore 2 ([], [V2 x y | x <- [20,220], y <- [20,120,220]])
@@ -328,7 +328,7 @@ weaponBetweenPillars = do
where
f (_,a) = a == 0
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
weaponLongCorridor = do
root <- takeOne [tEast, tWest]
connectingRoom <- takeOne
@@ -336,9 +336,9 @@ weaponLongCorridor = do
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2]
let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (deadRoom $ putWp corridor)
return $ Node (PassDown root) [branch1,branch2]
where
putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
@@ -358,7 +358,7 @@ deadEndRoom = defaultRoom
where
lnks = [(V2 0 30 ,0) ]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponRoom :: RandomGen g => State g (SubCompTree Room)
weaponRoom = join $ takeOne
[ weaponEmptyRoom
, weaponUnderCrits
@@ -487,7 +487,7 @@ pistolerRoom = pillarGrid
]
++)
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
shootingRange :: RandomGen g => State g (SubCompTree Room)
shootingRange = do
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
@@ -496,20 +496,20 @@ shootingRange = do
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
>>= changeLinkFrom (\(_,r) -> r == 0)
return $ treeFromPost
[Left rm1
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
[PassDown rm1
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
,Left rm2
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
,PassDown rm2
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(Right rm3)
(UseAll rm3)
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
spawnerRoom :: RandomGen g => State g (SubCompTree Room)
spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&>
rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
aRoom <- airlock
return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ connectRoom roomWithSpawner