Add airlocks

src/Dodge/Room.hs

@@ -27,6 +27,7 @@ import Dodge.Room.Corridor
 import Dodge.Room.Link
 import Dodge.Room.Branch
 import Dodge.Room.Door
+import Dodge.Room.Airlock
 import Geometry
 import Picture
 
@@ -47,53 +48,6 @@ import Data.Graph.Inductive.NodeMap
 import qualified Data.Map as M
 import qualified Data.IntMap.Strict as IM
 
-airlockOneWay :: Int -> Room
-airlockOneWay n = Room
-    { _rmPolys = [rectNSWE 90 0 0 40]
-    , _rmLinks = lnks
-    , _rmPath  = []
-    , _rmPS    = [PS (0,15) 0 $ PutTriggerDoor col (not . cond) (0,0) (0,40)
-                 ,PS (0,75) 0 $ PutTriggerDoor 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
-
-airlock 
-    :: Int  -- ^ Door id
-    -> Room
-airlock n = Room
-    { _rmPolys =
-        [ rectNSWE 100 0 0 40
-        , rectNSWE 65 35 (-40) 20
-        ]
-    , _rmLinks = lnks
-    , _rmPath  = [((20,85),(20,45))
-                 ,((20,45),(20, 5))
-                 ]
-    , _rmPS    = 
-        [PS (0,20) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0)
-        ,PS (0,80) 0 $ PutTriggerDoor 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,85),0)
-           ,((20, 5),pi)
-           ]
-    cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
-    col = dim $ dim $ bright red
 
 roomC :: Float -> Float -> Room
 roomC x y = Room
@@ -633,4 +587,5 @@ spawnerRoom = do
                  ]
     let f ((lx,_),_) = lx < x/2-5 
     roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2) 
-    return $ treeFromTrunk [Left (airlock 0)] roomWithSpawner
+    aRoom <- airlock 0
+    return $ treeFromTrunk [Left aRoom] roomWithSpawner