Refactor doors
This commit is contained in:
@@ -14,7 +14,6 @@ import Geometry
|
||||
import Picture
|
||||
|
||||
--import Control.Lens
|
||||
import qualified IntMapHelp as IM
|
||||
{- | A passage with a switch that opens forward access while closing backwards access. -}
|
||||
airlock :: RandomGen g => State g Room
|
||||
airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
|
||||
@@ -27,8 +26,8 @@ airlock0 = defaultRoom
|
||||
, _rmPath = foldMap doublePairSet [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
|
||||
, _rmPmnts =
|
||||
[pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> Just $ putDoubleDoorThen DoorObstacle thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
|
||||
$ \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (cond' btid) (V2 0 80) (V2 40 80) 2
|
||||
$ \btid -> Just $ putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2
|
||||
$ \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
|
||||
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
|
||||
,spanLightI (V2 (-2) 30) (V2 (-2) 70)
|
||||
,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
||||
@@ -41,13 +40,12 @@ airlock0 = defaultRoom
|
||||
lnks = [(V2 20 95,0)
|
||||
,(V2 20 5,pi)
|
||||
]
|
||||
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
col = dim $ dim $ bright red
|
||||
|
||||
airlockDoor :: Color -> (World -> Bool) -> [(Point2,Point2)] -> PSType
|
||||
airlockDoor :: Color -> WdBl -> [(Point2,Point2)] -> PSType
|
||||
airlockDoor col = PutDoor col DoorObstacle
|
||||
|
||||
airlockDoubleDoor :: Point2 -> Point2 -> Color -> (World -> Bool) -> [(Point2,Point2)]
|
||||
airlockDoubleDoor :: Point2 -> Point2 -> Color -> WdBl -> [(Point2,Point2)]
|
||||
-> [(Point2,Point2)] -> Maybe Placement
|
||||
airlockDoubleDoor p1 p2 col cond outDoorps inDoorps = jspsJ p1 0 (airlockDoor col cond outDoorps)
|
||||
$ sPS p2 0 (airlockDoor col cond inDoorps)
|
||||
@@ -60,7 +58,7 @@ airlockSimple = defaultRoom
|
||||
, _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks
|
||||
, _rmPmnts =
|
||||
[pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> airlockDoubleDoor 0 (V2 180 0) col (cond btid) outDoorps inDoorps
|
||||
$ \btid -> airlockDoubleDoor 0 (V2 180 0) col (WdBlBtOn btid) outDoorps inDoorps
|
||||
-- jspsJ (V2 0 0) 0 (airlockDoor col (cond btid) outDoorps)
|
||||
-- $ sPS (V2 180 0) 0 (airlockDoor col (cond btid) inDoorps)
|
||||
]
|
||||
@@ -72,7 +70,6 @@ airlockSimple = defaultRoom
|
||||
[(V2 0 30,pi/2)
|
||||
,(V2 180 30,1.5*pi)
|
||||
]
|
||||
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
col = dim $ dim $ bright red
|
||||
outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
|
||||
inDoorps = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 (-55) 0)
|
||||
@@ -87,7 +84,7 @@ airlockZ = defaultRoom
|
||||
-- ]
|
||||
, _rmPmnts =
|
||||
[pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (cond btid) outDoorps inDoorps
|
||||
$ \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
|
||||
-- jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
|
||||
-- $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
|
||||
, sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
|
||||
@@ -97,7 +94,6 @@ airlockZ = defaultRoom
|
||||
[ rectNSWE 120 0 0 180 ]
|
||||
}
|
||||
where
|
||||
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
col = dim $ dim $ bright red
|
||||
outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 0 (-61))
|
||||
inDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
|
||||
@@ -122,7 +118,7 @@ airlock90 = defaultRoom
|
||||
, _rmPath = doublePairSet (V2 0 40,V2 40 0)
|
||||
, _rmPmnts =
|
||||
[ pContID (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> jsps (V2 5 5) 0 $ airlockDoor col (cond btid) pss
|
||||
$ \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) pss
|
||||
, mntLS vShape (V2 35 35) (V3 70 70 50)
|
||||
]
|
||||
, _rmBound =
|
||||
@@ -136,7 +132,6 @@ airlock90 = defaultRoom
|
||||
}
|
||||
where
|
||||
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
|
||||
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
col = dim $ dim $ bright red
|
||||
pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
|
||||
|
||||
@@ -147,7 +142,7 @@ airlockCrystal = defaultRoom
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts =
|
||||
[pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> jsps0 $ airlockDoor col (cond btid) pss
|
||||
$ \btid -> jsps0 $ airlockDoor col (WdBlBtOn btid) pss
|
||||
, crystalLine (V2 0 70) (V2 40 70)
|
||||
, mntLS vShape (V2 150 70) (V3 110 70 70)
|
||||
]
|
||||
@@ -155,7 +150,6 @@ airlockCrystal = defaultRoom
|
||||
}
|
||||
where
|
||||
switchcutout = orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
|
||||
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
col = dim $ dim $ bright red
|
||||
pss :: [(Point2,Point2)]
|
||||
pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
|
||||
|
||||
@@ -10,8 +10,6 @@ import Dodge.Placement.Instance
|
||||
import Color
|
||||
|
||||
import Data.Maybe
|
||||
import qualified IntMapHelp as IM
|
||||
--import Control.Lens
|
||||
|
||||
door :: Room
|
||||
door = defaultRoom
|
||||
@@ -41,4 +39,4 @@ triggerDoorRoom inplid = defaultRoom
|
||||
where
|
||||
f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
|
||||
f _ = error "tried to put a door using an empty placement list"
|
||||
cond pmnt w = _triggers w IM.! fromJust (_plMID pmnt)
|
||||
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
|
||||
|
||||
@@ -28,8 +28,6 @@ import LensHelp
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
--import Data.Tree
|
||||
import qualified IntMapHelp as IM
|
||||
|
||||
twinSlowDoorRoom
|
||||
:: Float -- ^ Half width
|
||||
@@ -67,7 +65,7 @@ twinSlowDoorRoom w h x = defaultRoom
|
||||
]
|
||||
thedoor btid = defaultDoor
|
||||
& drSpeed .~ wlSpeed
|
||||
& drTrigger .~ (\w' -> _btState (_buttons w' IM.! btid) /= BtOff)
|
||||
& drTrigger .~ WdBlBtNotOff btid
|
||||
col = dim $ dim $ bright red
|
||||
|
||||
twinSlowDoorChasers :: RandomGen g => State g Room
|
||||
@@ -113,7 +111,7 @@ addButtonSlowDoor x h rm = do
|
||||
thewall = switchWallCol red
|
||||
butDoor = putLitButOnPos col
|
||||
(rprBool (isUnusedLnkType InLink))
|
||||
$ \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (cond' $ fromJust $ _plMID btplmnt)
|
||||
$ \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (WdBlBtNotOff $ fromJust $ _plMID btplmnt)
|
||||
30 (V2 0 h) (V2 x h) 2
|
||||
$ \dr1 dr2 ->
|
||||
amountedlight dr1 50
|
||||
@@ -122,7 +120,6 @@ addButtonSlowDoor x h rm = do
|
||||
$ amountedlight dr2 (-50)
|
||||
Nothing
|
||||
col = dim $ light red
|
||||
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
|
||||
|
||||
slowDoorRoom :: RandomGen g => State g Room
|
||||
slowDoorRoom = do
|
||||
|
||||
@@ -34,7 +34,6 @@ import Data.Tile
|
||||
import LensHelp
|
||||
|
||||
import qualified Data.Set as S
|
||||
import qualified IntMapHelp as IM
|
||||
--import Control.Lens
|
||||
-- This will need a cleanup, but it might change a bit first
|
||||
{- A simple rectangular room with a light in the center.
|
||||
@@ -272,5 +271,5 @@ centerVaultRoom w h d = return $ defaultRoom
|
||||
]
|
||||
thewall = switchWallCol col
|
||||
thedoor btid = defaultDoor
|
||||
& drTrigger .~ (\w' -> _btState (_buttons w' IM.! btid) == BtOn)
|
||||
& drTrigger .~ WdBlBtOn btid
|
||||
& drSpeed .~ 2
|
||||
|
||||
Reference in New Issue
Block a user