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

Some cleanup, sidetracked from inter-room placements

Browse Source
This commit is contained in:
justin
2021-11-12 14:16:16 +00:00
parent 1d5b2ea765
commit 67e164c830
13 changed files with 160 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Data.hs
+5 -3
View File
@@ -19,6 +19,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
| PutPressPlate PressPlate
| PutBlock [Int] Color [Point2]
| PutCoordinate Point2
| PutTrigger (World -> Bool)
| PutLineBlock Wall Float Float Point2 Point2
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
| PutSlideDoor Bool Color (World -> Bool) Point2 Point2 Float
@@ -72,9 +73,10 @@ ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst (const $ Just plmnt)
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl (PlacementUsingPos p f) = PlacementUsingPos p (fmap (addPlmnt pl) f)
addPlmnt pl (RandomPlacement rp) = RandomPlacement $ fmap (addPlmnt pl) rp
addPlmnt pl (Placement ps pt f) = Placement ps pt (fmap g f)
addPlmnt pl pl2 = case pl2 of
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement ps pt f) -> Placement ps pt (fmap g f)
where
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'