Fix wall bug, refactor placements
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user