Make Placement into a product type
This commit is contained in:
+48
-43
@@ -3,7 +3,8 @@
|
||||
{- Rooms that contain two doors and a switch alternating both. -}
|
||||
module Dodge.Room.Airlock where
|
||||
|
||||
import Dodge.Placement.Instance.Analyser
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Dodge.Annotation.Data
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Door
|
||||
@@ -11,34 +12,37 @@ import Dodge.Default.Room
|
||||
import Dodge.LevelGen.PlacementHelper
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Instance.Analyser
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.RoomLink
|
||||
import Geometry
|
||||
import Picture
|
||||
import RandomHelp
|
||||
import Control.Lens
|
||||
|
||||
-- | 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]
|
||||
airlock =
|
||||
join $
|
||||
takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]
|
||||
|
||||
--airlock = takeOne [airlockCrystal]
|
||||
decontamRoom :: State LayoutVars Room
|
||||
decontamRoom = do
|
||||
return $ defaultRoom
|
||||
& rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
|
||||
& rmLinks .~ muout lnks ++ muin [last lnks]
|
||||
& 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 (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)
|
||||
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
|
||||
]
|
||||
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
|
||||
return $
|
||||
defaultRoom
|
||||
& rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
|
||||
& rmLinks .~ muout lnks ++ muin [last lnks]
|
||||
& 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 (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)
|
||||
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
|
||||
]
|
||||
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
|
||||
where
|
||||
thewall = switchWallCol col
|
||||
switchcut = rectNSWE 65 35 (-40) 80
|
||||
@@ -115,36 +119,37 @@ airlockSimple =
|
||||
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)
|
||||
|
||||
airlockZ :: Room
|
||||
airlockZ =
|
||||
defaultRoom
|
||||
{ _rmPolys =
|
||||
[rectNSWE 120 0 0 180]
|
||||
, _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
|
||||
, _rmPath = mempty
|
||||
, -- [(V2 0 40,V2 40 0)
|
||||
-- ,(V2 40 0,V2 0 40)
|
||||
-- ]
|
||||
_rmPmnts =
|
||||
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
|
||||
\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
|
||||
, lighting
|
||||
]
|
||||
, _rmBound =
|
||||
[rectNSWE 120 0 0 180]
|
||||
}
|
||||
airlockZ :: RandomGen g => State g Room
|
||||
airlockZ = do
|
||||
let cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
|
||||
cornlight =
|
||||
mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
|
||||
`addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
|
||||
lighting <- takeOne [cenlight, cornlight]
|
||||
return
|
||||
defaultRoom
|
||||
{ _rmPolys =
|
||||
[rectNSWE 120 0 0 180]
|
||||
, _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
|
||||
, _rmPath = mempty
|
||||
, -- [(V2 0 40,V2 40 0)
|
||||
-- ,(V2 40 0,V2 0 40)
|
||||
-- ]
|
||||
_rmPmnts =
|
||||
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
|
||||
\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
|
||||
, lighting
|
||||
]
|
||||
, _rmBound =
|
||||
[rectNSWE 120 0 0 180]
|
||||
}
|
||||
where
|
||||
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)
|
||||
cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
|
||||
cornlight =
|
||||
mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
|
||||
`addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
|
||||
lighting = RandomPlacement $ takeOne [cenlight, cornlight]
|
||||
|
||||
airlock90 :: Room
|
||||
airlock90 =
|
||||
|
||||
Reference in New Issue
Block a user