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/Start.hs
+41 -41
View File
@@ -32,22 +32,22 @@ import Control.Lens
import System.Random
--import qualified Data.IntMap.Strict as IM
minigunfakeout :: RandomGen g => State g (Tree (Either Room Room))
minigunfakeout :: RandomGen g => State g (SubCompTree Room)
minigunfakeout = do
rcol <- rezColor
ncor <- state $ randomR (0,2)
roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
& rmPmnts %~ (plRRpt 0 (PutFlIt miniGun):)
randcors <- replicateM ncor $ (fmap Left . randomiseOutLinks) corridor
return $ ([Left $ rezBox rcol
,Left door
,Left roomwithmini
,Left door
randcors <- replicateM ncor $ (fmap PassDown . randomiseOutLinks) corridor
return $ ([PassDown $ rezBox rcol
,PassDown door
,PassDown roomwithmini
,PassDown door
]
++ randcors
++ [Left $ corridor & rmPmnts %~ ( plRRpt 0 (PutFlIt shrinkGun) :)
,Left keyholeCorridor,Left corridor])
`treeFromPost` Right door
++ [PassDown $ corridor & rmPmnts %~ ( plRRpt 0 (PutFlIt shrinkGun) :)
,PassDown keyholeCorridor,PassDown corridor])
`treeFromPost` UseAll door
centralLasTurret :: Room
centralLasTurret = roomNgon 8 200 & rmPmnts .~
@@ -68,21 +68,21 @@ centralLasTurret = roomNgon 8 200 & rmPmnts .~
upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
| otherwise = w
lasSensorTurretTest :: RandomGen g => Int -> State g (Tree (Either Room Room))
lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
lasSensorTurretTest n = do
cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just n}
let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
return $ treeFromPost [Left door,Left cenroom,Left doorroom] (Right door)
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
rezThenLasTurret :: RandomGen g => State g (SubCompTree Room)
rezThenLasTurret = do
rbox <- rezBoxStart
cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just 0}
let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
contTree = treeFromPost [Left cenroom,Left doorroom] (Right door)
contTree = treeFromPost [PassDown cenroom,PassDown doorroom] (UseAll door)
return $ rbox `appendEitherTree` [contTree]
startRoom :: RandomGen g => Int -> State g (Tree (Either Room Room))
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom i = join $ takeOne
[ minigunfakeout
, rezBoxesWp
@@ -92,16 +92,16 @@ startRoom i = join $ takeOne
, runPastStart i
]
runPastStart :: RandomGen g => Int -> State g (Tree (Either Room Room))
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do
s <- rezBoxStart
rp <- runPastRoom i
return $ s `appendEitherTree` [rp]
rezBoxStart :: RandomGen g => State g (Tree (Either Room Room))
rezBoxStart :: RandomGen g => State g (SubCompTree Room)
rezBoxStart = do
ls <- rezColor
return $ treeFromPost [Left $ rezBox ls] (Right door)
return $ treeFromPost [PassDown $ rezBox ls] (UseAll door)
rezBox :: LightSource -> Room
rezBox ls = roomRect 40 60 1 1
@@ -131,28 +131,28 @@ wpAdd wp = rmPmnts %~ f
g x = x & plIDCont .~ flickerMod
rezBoxesThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
rezBoxesThenWeaponRoom = do
rboxes <- rezBoxes
wroom <- weaponRoom
return $ rboxes `appendEitherTree` [wroom]
rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
rezBoxThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
rezBoxThenWeaponRoom = do
rcol <- rezColor
treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom
treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
rezBoxesWpCrit = do
w <- state $ randomR (200,400)
h <- state $ randomR (40,40)
thecol <- rezColor
theweapon <- randBlockBreakWeapon
let bottomEdgeTest (V2 _ y,_) = y < 1
bottomLeftTest (V2 x y,_) = y < 1 && x < 21
bottomPassDownTest (V2 x y,_) = y < 1 && x < 21
aroom = rezInvBox thecol
centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
(randomiseOutLinks =<< changeLinkTo bottomLeftTest
(randomiseOutLinks =<< changeLinkTo bottomPassDownTest
((roomRectAutoLinks w h) {_rmPmnts = []}))
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
i <- state $ randomR (0,n-3)
@@ -162,15 +162,15 @@ rezBoxesWpCrit = do
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [Left $ rezBox thecol
, Left door
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (Left centralRoom) (rezrooms ++ [onwardtree blcor]))
(Node (PassDown centralRoom) (rezrooms ++ [onwardtree blcor]))
where
adddoor rm = treeFromPost [Left door] (Left rm)
onwardtree blcor = treeFromPost [Left door] (Right blcor)
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
rezBoxesWp :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
rezBoxesWp = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
@@ -185,31 +185,31 @@ rezBoxesWp = do
let rezrooms = map adddoor
$ wpAdd theweapon aroom : replicate (n-2) aroom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [Left $ rezBox thecol
, Left door
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (Left centralRoom') (rezrooms ++ [onwardtree blcor]))
(Node (PassDown centralRoom') (rezrooms ++ [onwardtree blcor]))
where
adddoor rm = treeFromPost [Left door] (Left rm)
onwardtree blcor = treeFromPost [Left door] (Right blcor)
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
rezBoxes :: RandomGen g => State g (Tree (Either Room Room))
rezBoxes :: RandomGen g => State g (SubCompTree Room)
rezBoxes = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
thecol <- rezColor
let bottomEdgeTest (V2 _ y,_) = y < 1
dbox = treeFromPost [Left door] (Left $ rezInvBox thecol)
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [Left $ rezBox thecol
, Left door
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []]))
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
startRoom' :: RandomGen g => State g (Tree (Either Room Room))
startRoom' :: RandomGen g => State g (SubCompTree Room)
startRoom' = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
@@ -224,7 +224,7 @@ startRoom' = do
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
]
thecol <- rezColor
treeFromPost [Left $ rezBox thecol, Left door] . Right
treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll
<$> randomiseOutLinks
(shiftRoomBy (V2 (-20) (-20),0)
( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++)