159 lines
4.5 KiB
Haskell
159 lines
4.5 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
{-
|
|
Rooms that contain two doors and a switch alternating both. -}
|
|
module Dodge.Room.Airlock
|
|
where
|
|
import Dodge.Room.Data
|
|
import Dodge.Room.Placement
|
|
import Dodge.Default.Room
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.LevelGen.Switch
|
|
import Dodge.RandomHelp
|
|
import Geometry
|
|
import Picture
|
|
|
|
import qualified Data.Map as M
|
|
import System.Random
|
|
import Control.Monad.State
|
|
import Control.Lens
|
|
|
|
airlockOneWay :: Int -> Room
|
|
airlockOneWay n = defaultRoom
|
|
{ _rmPolys = [rectNSWE 90 0 0 40]
|
|
, _rmLinks = lnks
|
|
, _rmPath = []
|
|
, _rmPS = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40) 2
|
|
,sPS (V2 0 75) 0 $ PutDoubleDoor col cond (V2 0 0) (V2 0 40) 2
|
|
,sPS (V2 35 45) (pi/2) $ PutButton $ makeButton col (over worldState
|
|
(M.insert (DoorNumOpen n) True))
|
|
]
|
|
--, _rmBound = rectNSWE 90 30 (-30) 30
|
|
, _rmBound = [rectNSWE 75 15 0 40]
|
|
}
|
|
where lnks = [(V2 0 85,0)
|
|
,(V2 0 5,pi)
|
|
]
|
|
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
|
|
col = dim $ dim $ bright red
|
|
|
|
{- |
|
|
A passage with a switch that opens forward access while closing backwards access. -}
|
|
airlock
|
|
:: RandomGen g
|
|
=> Int -- ^ Door id
|
|
-> State g Room
|
|
airlock n = takeOne [airlock0 n,airlock90 n,airlockCrystal n]
|
|
|
|
{- |
|
|
Straight airlock -}
|
|
airlock0
|
|
:: Int -- ^ Door id
|
|
-> Room
|
|
airlock0 n = defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 100 0 0 40
|
|
, rectNSWE 65 35 (-40) 20
|
|
]
|
|
, _rmLinks = lnks
|
|
, _rmPath = [(V2 20 95,V2 20 45)
|
|
,(V2 20 45,V2 20 5)
|
|
]
|
|
, _rmPS =
|
|
[sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) 2
|
|
,sPS (V2 0 80) 0 $ PutDoubleDoor col cond (V2 1 0) (V2 39 0) 2
|
|
,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col
|
|
(over worldState (M.insert (DoorNumOpen n) True))
|
|
(over worldState (M.insert (DoorNumOpen n) False))
|
|
,sPS (V2 (-25) 50) 0 putLamp
|
|
]
|
|
, _rmBound = [rectNSWE 75 15 0 40]
|
|
}
|
|
where
|
|
lnks = [(V2 20 95,0)
|
|
,(V2 20 5,pi)
|
|
]
|
|
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
|
|
col = dim $ dim $ bright red
|
|
|
|
airlock90
|
|
:: Int -- ^ Door id
|
|
-> Room
|
|
airlock90 n = 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 =
|
|
[(V2 0 40,pi/2)
|
|
,(V2 40 0,pi)
|
|
]
|
|
, _rmPath =
|
|
[(V2 0 40,V2 40 0)
|
|
,(V2 40 0,V2 0 40)
|
|
]
|
|
, _rmPS =
|
|
[sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss
|
|
,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col
|
|
(over worldState (M.insert (DoorNumOpen n) True))
|
|
(over worldState (M.insert (DoorNumOpen n) False))
|
|
,sPS (V2 60 60) 0 putLamp
|
|
]
|
|
, _rmBound =
|
|
[map toV2 [ (10,10)
|
|
, (10,100)
|
|
, (100,150)
|
|
, (150,100)
|
|
, (100,10)
|
|
]]
|
|
}
|
|
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)
|
|
|
|
airlockCrystal
|
|
:: Int -- ^ Door id
|
|
-> Room
|
|
airlockCrystal n = defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 140 0 0 40
|
|
, orderPolygon $ map toV2
|
|
[(39,20)
|
|
,(150,60)
|
|
,(150,80)
|
|
,(39,120)
|
|
]
|
|
]
|
|
, _rmLinks =
|
|
[(V2 20 130,0)
|
|
,(V2 20 0 ,pi)
|
|
]
|
|
, _rmPath =
|
|
[
|
|
]
|
|
, _rmPS =
|
|
[sPS (V2 0 0) 0 $ PutDoor col (not . cond) pss
|
|
,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col
|
|
(over worldState (M.insert (DoorNumOpen n) True))
|
|
(over worldState (M.insert (DoorNumOpen n) False))
|
|
,crystalLine (V2 0 70) (V2 40 70)
|
|
,sPS (V2 20 40) 0 putLamp
|
|
,sPS (V2 20 100) 0 putLamp
|
|
]
|
|
, _rmBound =
|
|
[ ]
|
|
}
|
|
where
|
|
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
|
|
col = dim $ dim $ bright red
|
|
pss :: [(Point2,Point2)]
|
|
pss = reverse $ fmap ( (\x -> (V2 50 x,V2 50 (x+50)) ) . fromIntegral)
|
|
[20::Int,22..70]
|