Refactor, try to limit dependencies
This commit is contained in:
+152
-126
@@ -1,157 +1,183 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
{- Rooms that contain two doors and a switch alternating both. -}
|
||||
module Dodge.Room.Airlock where
|
||||
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Door
|
||||
import Dodge.Default.Room
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Default.Door
|
||||
import Dodge.Data
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import RandomHelp
|
||||
import Geometry
|
||||
import Picture
|
||||
import RandomHelp
|
||||
|
||||
--import Control.Lens
|
||||
{- | A passage with a switch that opens forward access while closing backwards access. -}
|
||||
-- | 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 = takeOne [airlock0, airlock90, airlockCrystal, airlockZ]
|
||||
|
||||
--airlock = takeOne [airlockCrystal]
|
||||
{- | Straight airlock -}
|
||||
|
||||
-- | Straight airlock
|
||||
airlock0 :: Room
|
||||
airlock0 = 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)
|
||||
,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
||||
]
|
||||
, _rmBound = [rectNSWE 75 15 0 40,switchcut]
|
||||
}
|
||||
where
|
||||
airlock0 =
|
||||
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)
|
||||
, sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
||||
]
|
||||
, _rmBound = [rectNSWE 75 15 0 40, switchcut]
|
||||
}
|
||||
where
|
||||
thewall = switchWallCol col
|
||||
switchcut = rectNSWE 65 35 (-40) 20
|
||||
lnks = [(V2 20 95,0)
|
||||
,(V2 20 5,pi)
|
||||
]
|
||||
switchcut = rectNSWE 65 35 (-40) 20
|
||||
lnks =
|
||||
[ (V2 20 95, 0)
|
||||
, (V2 20 5, pi)
|
||||
]
|
||||
col = dim $ dim $ bright red
|
||||
|
||||
airlockDoor :: Color -> WdBl -> [(Point2,Point2)] -> PSType
|
||||
airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
|
||||
airlockDoor col = PutDoor col DoorObstacle
|
||||
|
||||
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)
|
||||
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)
|
||||
|
||||
airlockSimple :: Room
|
||||
airlockSimple = defaultRoom
|
||||
{ _rmPolys =
|
||||
[ rectNSWE 120 0 0 180 ]
|
||||
, _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
|
||||
, _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 (WdBlBtOn btid) outDoorps inDoorps
|
||||
-- jspsJ (V2 0 0) 0 (airlockDoor col (cond btid) outDoorps)
|
||||
-- $ sPS (V2 180 0) 0 (airlockDoor col (cond btid) inDoorps)
|
||||
airlockSimple =
|
||||
defaultRoom
|
||||
{ _rmPolys =
|
||||
[rectNSWE 120 0 0 180]
|
||||
, _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
|
||||
, _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 (WdBlBtOn btid) outDoorps inDoorps
|
||||
-- jspsJ (V2 0 0) 0 (airlockDoor col (cond btid) outDoorps)
|
||||
-- $ sPS (V2 180 0) 0 (airlockDoor col (cond btid) inDoorps)
|
||||
]
|
||||
, _rmBound =
|
||||
[rectNSWE 120 0 0 180]
|
||||
}
|
||||
where
|
||||
lnks =
|
||||
[ (V2 0 30, pi / 2)
|
||||
, (V2 180 30, 1.5 * pi)
|
||||
]
|
||||
, _rmBound =
|
||||
[ rectNSWE 120 0 0 180 ]
|
||||
}
|
||||
where
|
||||
lnks =
|
||||
[(V2 0 30,pi/2)
|
||||
,(V2 180 30,1.5*pi)
|
||||
]
|
||||
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)
|
||||
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 ]
|
||||
}
|
||||
where
|
||||
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]
|
||||
}
|
||||
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]
|
||||
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 = defaultRoom
|
||||
{ _rmPolys =
|
||||
[ rectNSWE 100 10 10 100
|
||||
, rectNSWE 20 0 20 60
|
||||
, rectNSWE 20 60 20 0
|
||||
, map toV2 [ (10,100)
|
||||
, (100,150)
|
||||
, (150,100)
|
||||
, (100,10)
|
||||
airlock90 =
|
||||
defaultRoom
|
||||
{ _rmPolys =
|
||||
[ rectNSWE 100 10 10 100
|
||||
, rectNSWE 20 0 20 60
|
||||
, rectNSWE 20 60 20 0
|
||||
, map
|
||||
toV2
|
||||
[ (10, 100)
|
||||
, (100, 150)
|
||||
, (150, 100)
|
||||
, (100, 10)
|
||||
]
|
||||
]
|
||||
]
|
||||
, _rmLinks = muout[(V2 0 40,pi/2)] ++ muin[(V2 40 0,pi) ]
|
||||
, _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 (WdBlBtOn btid) pss
|
||||
, mntLS vShape (V2 35 35) (V3 70 70 50)
|
||||
]
|
||||
, _rmBound =
|
||||
[map toV2 [ (10,10)
|
||||
, (10,100)
|
||||
, (100,150)
|
||||
, (150,100)
|
||||
, (100,10)
|
||||
]]
|
||||
, _rmName = "airlock90"
|
||||
}
|
||||
where
|
||||
, _rmLinks = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)]
|
||||
, _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 (WdBlBtOn btid) pss
|
||||
, mntLS vShape (V2 35 35) (V3 70 70 50)
|
||||
]
|
||||
, _rmBound =
|
||||
[ map
|
||||
toV2
|
||||
[ (10, 10)
|
||||
, (10, 100)
|
||||
, (100, 150)
|
||||
, (150, 100)
|
||||
, (100, 10)
|
||||
]
|
||||
]
|
||||
, _rmName = "airlock90"
|
||||
}
|
||||
where
|
||||
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
|
||||
col = dim $ dim $ bright red
|
||||
pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
|
||||
pss = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
|
||||
|
||||
airlockCrystal :: Room
|
||||
airlockCrystal = defaultRoom
|
||||
{ _rmPolys = [ rectNSWE 140 0 0 40 , switchcutout ]
|
||||
, _rmLinks = muout[(V2 20 130,0) ] ++ muin[(V2 20 0 ,pi) ]
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts =
|
||||
[pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
|
||||
$ \btid -> jsps0 $ airlockDoor col (WdBlBtOn btid) pss
|
||||
, crystalLine (V2 0 70) (V2 40 70)
|
||||
, mntLS vShape (V2 150 70) (V3 110 70 70)
|
||||
]
|
||||
, _rmBound = [ rectNSWE 120 20 0 40 , switchcutout ]
|
||||
}
|
||||
where
|
||||
switchcutout = orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
|
||||
airlockCrystal =
|
||||
defaultRoom
|
||||
{ _rmPolys = [rectNSWE 140 0 0 40, switchcutout]
|
||||
, _rmLinks = muout [(V2 20 130, 0)] ++ muin [(V2 20 0, pi)]
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts =
|
||||
[ pContID (PS (V2 145 70) (pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
|
||||
\btid -> jsps0 $ airlockDoor col (WdBlBtOn btid) pss
|
||||
, crystalLine (V2 0 70) (V2 40 70)
|
||||
, mntLS vShape (V2 150 70) (V3 110 70 70)
|
||||
]
|
||||
, _rmBound = [rectNSWE 120 20 0 40, switchcutout]
|
||||
}
|
||||
where
|
||||
switchcutout = orderPolygon $ map toV2 [(39, 20), (150, 60), (150, 80), (39, 120)]
|
||||
col = dim $ dim $ bright red
|
||||
pss :: [(Point2,Point2)]
|
||||
pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
|
||||
[20::Int,22..70]
|
||||
|
||||
pss :: [(Point2, Point2)]
|
||||
pss =
|
||||
reverse $
|
||||
fmap
|
||||
((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral)
|
||||
[20 :: Int, 22 .. 70]
|
||||
|
||||
Reference in New Issue
Block a user