Fix wall bug, refactor placements

This commit is contained in:
2021-09-30 15:35:35 +01:00
parent eb393708c4
commit c88f88004d
17 changed files with 54 additions and 80 deletions
+6 -9
View File
@@ -16,6 +16,7 @@ import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSources.Lamp
import Dodge.Placement
import Picture
import Geometry
@@ -41,16 +42,13 @@ twinSlowDoorRoom drid w h x = defaultRoom
]
, _rmPath = []
, _rmPS =
[ sPS (V2 0 (h/2)) 0 putLamp
, sPS (V2 25 5) 0 putLamp
, sPS (V2 (negate 25) 5) 0 putLamp
, sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1
, Placement (PS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1)
$ \did -> Just $ Placement (PS (V2 0 (h-1)) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0))
$ \lsid -> Just $ sPS (V2 0 (h-1)) 0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) lampHeight
[ sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1
, sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red
(worldState %~ M.insert (DoorNumOpen drid) True )
(worldState %~ M.insert (DoorNumOpen drid) False)
, place0 (PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1)
$ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
]
, _rmBound = ps
, _rmName = "twinSlowDoorRoom"
@@ -68,8 +66,7 @@ twinSlowDoorRoom drid w h x = defaultRoom
,rectNSWE 20 (-h) (negate x) x
]
cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w')
--col = dim $ dim $ bright red
col = V4 0 1 0 1
col = dim $ dim $ bright red
twinSlowDoorChasers
:: RandomGen g