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

Make Placement into a product type

Browse Source
This commit is contained in:
justin
2025-09-02 12:31:55 +01:00
parent dc13c61dca
commit f278af0f30
29 changed files with 168 additions and 168 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/GlassLesson.hs
+27 -27
View File
@@ -22,6 +22,33 @@ import Control.Monad
glassLesson :: RandomGen g => State g (Tree Room)
glassLesson = do
l1 <- takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
l2 <- takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
let botplmnts =
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, l1
]
topplmnts =
[ windowLine (V2 100 200) (V2 100 0)
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, l2
]
botRoom =
roomRect 200 200 1 1
& rmPmnts .~ botplmnts
& rmLinks %~ setInLinksByType (OnEdge West)
topRoom =
roomRect 200 200 1 1
& rmPmnts .~ topplmnts
& rmLinks %~ setInLinks (fromWest South 0 . _rlType)
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
i <- takeOne [1, 2, 3]
corridors <- replicateM i $ shuffleLinks corridor
return $
@@ -37,33 +64,6 @@ glassLesson = do
]
where
fromWest edge i s = OnEdge edge `S.member` s && FromEdge West i `S.member` s
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
botRoom =
roomRect 200 200 1 1
& rmPmnts .~ botplmnts
& rmLinks %~ setInLinksByType (OnEdge West)
topRoom =
roomRect 200 200 1 1
& rmPmnts .~ topplmnts
& rmLinks %~ setInLinks (fromWest South 0 . _rlType)
botplmnts =
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, RandomPlacement $
takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
topplmnts =
[ windowLine (V2 100 200) (V2 100 0)
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, RandomPlacement $
takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
glassLessonRunPast :: RandomGen g => State g MTRS
glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f