Files
loop/src/Dodge/Room/Airlock.hs
T

158 lines
4.3 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.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 = Room
{ _rmPolys = [rectNSWE 90 0 0 40]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [sPS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40)
,sPS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40)
,sPS (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 = [((0,85),0)
,((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 = Room
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
]
, _rmLinks = lnks
, _rmPath = [((20,95),(20,45))
,((20,45),(20, 5))
]
, _rmPS =
[sPS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0)
,sPS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0)
,sPS (35,50) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (-25, 50) 0 putLamp
]
, _rmBound = [rectNSWE 75 15 0 40]
}
where
lnks = [((20,95),0)
,((20, 5),pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
airlock90
:: Int -- ^ Door id
-> Room
airlock90 n = Room
{ _rmPolys =
[ rectNSWE 100 10 10 100
, rectNSWE 20 0 20 60
, rectNSWE 20 60 20 0
, [ (10,100)
, (100,150)
, (150,100)
, (100,10)
]
]
, _rmLinks =
[((0,40),pi/2)
,((40, 0),pi)
]
, _rmPath =
[((0,40),(40,0))
,((40,0),(0,40))
]
, _rmPS =
[sPS (5,5) 0 $ PutDoor col (not . cond) pss
,sPS (120,120) (3* pi/4) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (60, 60) 0 putLamp
]
, _rmBound =
[[ (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 = ((0,0) ,) <$> arcStepwise 3 (negate $ pi/2) (0,0) (0,55)
airlockCrystal
:: Int -- ^ Door id
-> Room
airlockCrystal n = Room
{ _rmPolys =
[ rectNSWE 140 0 0 40
, orderPolygon
[(39,20)
,(150,60)
,(150,80)
,(39,120)
]
]
, _rmLinks =
[((20,130),0)
,((20, 0),pi)
]
, _rmPath =
[
]
, _rmPS =
[sPS (0,0) 0 $ PutDoor col (not . cond) pss
,sPS (145,70) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,crystalLine (0,70) (40,70)
,sPS (20, 40) 0 putLamp
,sPS (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 -> ((50,x),(50,x+50)) ) . fromIntegral)
[20,22..70]