Refactor item drawing

src/Dodge/Room/Airlock.hs

@@ -4,7 +4,9 @@ Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock
     where
 import Dodge.Room.Data
+import Dodge.LightSources.Fitting
 import Dodge.Room.Placement
+import Dodge.Room.Foreground
 import Dodge.Default.Room
 import Dodge.Data
 import Dodge.LevelGen.Data
@@ -13,7 +15,8 @@ import Dodge.RandomHelp
 import Geometry
 import Picture
 
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
+import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Monad.State
 import Control.Lens
@@ -39,18 +42,14 @@ airlockOneWay n = defaultRoom
 
 {- |
 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]
+airlock :: RandomGen g => State g Room
+--airlock = takeOne [airlock0,airlock90,airlockCrystal]
+airlock = takeOne [airlock0]
 
 {- |
 Straight airlock -}
-airlock0 
-    :: Int -- ^ Door id
-    -> Room
-airlock0 n = defaultRoom
+airlock0 :: Room
+airlock0 = defaultRoom
     { _rmPolys =
         [ rectNSWE 100 0 0 40
         , rectNSWE 65 35 (-40) 20
@@ -60,12 +59,11 @@ airlock0 n = defaultRoom
                  ,(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 red
-                           (over worldState (M.insert (DoorNumOpen n) True))
-                           (over worldState (M.insert (DoorNumOpen n) False))
-        ,sPS (V2 (-25) 50) 0 putLamp
+        [Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
+            $ \btid -> jspsJ (V2 0 20) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 0) (V2 39 0) 2)
+            $ sPS (V2 0 80) 0 $ PutDoubleDoor col (cond' btid) (V2 1 0) (V2 39 0) 2
+        ,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70)
+        ,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
         ]
     , _rmBound = [rectNSWE 75 15 0 40]
     }
@@ -73,13 +71,12 @@ airlock0 n = defaultRoom
     lnks = [(V2 20 95,0)
            ,(V2 20  5,pi)
            ]
-    cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
+    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
     col = dim $ dim $ bright red
 
 airlock90 
-    :: Int -- ^ Door id
-    -> Room
-airlock90 n = defaultRoom
+    :: Room
+airlock90 = defaultRoom
     { _rmPolys =
         [ rectNSWE 100 10 10 100
         , rectNSWE 20  0  20 60
@@ -99,11 +96,9 @@ airlock90 n = defaultRoom
          ,(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 red
-            (over worldState (M.insert (DoorNumOpen n) True))
-            (over worldState (M.insert (DoorNumOpen n) False))
-        ,sPS (V2 60  60) 0 putLamp
+        [ Placement (PS (V2 120 120) (3 * pi/4) (PutButton $ makeSwitch col red id id))
+            $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
+        ,mountedLightV (V2 20 20) (V3 70 70 50)
         ]
     , _rmBound = 
         [map toV2 [ (10,10)
@@ -114,45 +109,34 @@ airlock90 n = defaultRoom
         ]]
     }
   where 
-    cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
+    --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
+    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
     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
+    :: Room
+airlockCrystal = defaultRoom
     { _rmPolys =
         [ rectNSWE 140 0 0 40
-        , orderPolygon $ map toV2
-            [(39,20)
-            ,(150,60)
-            ,(150,80)
-            ,(39,120)
-            ]
+        , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
         ]
-    , _rmLinks =
-         [(V2 20 130,0)
-         ,(V2 20  0 ,pi)
-         ]
-    , _rmPath  = 
-         [
-         ]
+    , _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 red
-            (over worldState (M.insert (DoorNumOpen n) False))
-            (over worldState (M.insert (DoorNumOpen n) True))
-        ,crystalLine (V2 0 70) (V2 40 70)
-        --,sPS (V2 20  40) 0 putLamp
-        --,sPS (V2 20  100) 0 putLamp
+        [ Placement (PS (V2 145 70) (pi/2) (PutButton $ makeSwitch col red id id))
+            $ \btid -> jsps0 $ PutDoor col (cond btid) pss
+        , crystalLine (V2 0 70) (V2 40 70)
+        , mountedLightV (V2 150 70) (V3 110 70 70)
         ]
     , _rmBound = 
         [         ]
     }
   where 
-    cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
+    --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
+    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
     col = dim $ dim $ bright red
     pss :: [(Point2,Point2)]
-    pss = reverse $ fmap ( (\x -> (V2 50 x,V2 50 (x+50)) ) . fromIntegral)
+    pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
             [20::Int,22..70]
+