Add airlocks
This commit is contained in:
@@ -0,0 +1,157 @@
|
||||
{-# 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 = [PS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40)
|
||||
,PS (0,75) 0 $ PutDoubleDoor col (cond) (0,0) (0,40)
|
||||
,PS (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 =
|
||||
[PS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0)
|
||||
,PS (0,80) 0 $ PutDoubleDoor col (cond) (1,0) (39,0)
|
||||
,PS (35,50) (pi/2) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,PS (-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 =
|
||||
[PS (5,5) 0 $ PutDoor col (not . cond) pss
|
||||
,PS (120,120) (3* pi/4) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,PS (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 =
|
||||
[PS (0,0) 0 $ PutDoor col (not . cond) pss
|
||||
,PS (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)
|
||||
,PS (20, 40) 0 putLamp
|
||||
,PS (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]
|
||||
@@ -22,3 +22,5 @@ door = Room
|
||||
where lnks = [((20,35),0)
|
||||
,((20, 5),pi)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@@ -30,6 +30,15 @@ randomiseAllLinks r = do
|
||||
newLinks <- shuffle $ _rmLinks r
|
||||
return $ r {_rmLinks = newLinks}
|
||||
|
||||
randomiseLinksBy
|
||||
:: RandomGen g
|
||||
=> ( [(Point2,Float)] -> State g [(Point2,Float)] )
|
||||
-> Room
|
||||
-> State g Room
|
||||
randomiseLinksBy f r = do
|
||||
newLinks <- f $ _rmLinks r
|
||||
return $ r {_rmLinks = newLinks}
|
||||
|
||||
filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
|
||||
filterLinks cond r = do
|
||||
newLinks <- shuffle $ filter cond $ init $ _rmLinks r
|
||||
|
||||
@@ -260,6 +260,10 @@ centerVaultRoom n w h d = do
|
||||
,PS (w-5,5-h) 0 putLamp
|
||||
,PS (5-w,h-5) 0 putLamp
|
||||
,PS (5-w,5-h) 0 putLamp
|
||||
,PS (0,h-5) 0 $ PutCrit explosiveBarrel
|
||||
,PS (5,h-5) 0 $ PutCrit explosiveBarrel
|
||||
,PS (0,h) 0 $ PutCrit explosiveBarrel
|
||||
,PS (-4,h-5) 0 $ PutCrit explosiveBarrel
|
||||
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
|
||||
]
|
||||
++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i)
|
||||
@@ -269,7 +273,7 @@ centerVaultRoom n w h d = do
|
||||
where
|
||||
col = dim $ dim $ bright red
|
||||
theDoor i =
|
||||
[ PS (0,d-10) 0 $ PutTriggerDoor col (cond i) (-19,0) (19,0)
|
||||
[ PS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0)
|
||||
, PS (35,d+4) 0 $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen i) True))
|
||||
(over worldState (M.insert (DoorNumOpen i) False))
|
||||
|
||||
@@ -4,6 +4,7 @@ Specification of rooms that teleport (between levels).
|
||||
module Dodge.Room.Teleport
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.World.Trigger.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Procedural
|
||||
|
||||
Reference in New Issue
Block a user