From cb23960bd79509f7c4f1946c70e9e0b0f7bfe131 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Thu, 30 Sep 2021 15:52:01 +0100
Subject: [PATCH] Remove requirement for external door ids

---
 src/Dodge/Floor.hs         |  4 ++--
 src/Dodge/Placement.hs     |  3 +++
 src/Dodge/Room/LongDoor.hs | 24 ++++++++++--------------
 3 files changed, 15 insertions(+), 16 deletions(-)

diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index 316a803ba..12af22b46 100644
--- a/src/Dodge/Floor.hs
+++ b/src/Dodge/Floor.hs
@@ -70,8 +70,8 @@ initialRoomTree = do
 ----             ]
 ----            ,[Corridor]
 ----            ,[Corridor]
---            --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30]
-            ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 30 80 200 40)]
+--            --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
+            ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
             ,[Corridor]
             ,[DoorAno]
             ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
diff --git a/src/Dodge/Placement.hs b/src/Dodge/Placement.hs
index 88446487f..f7967a26a 100644
--- a/src/Dodge/Placement.hs
+++ b/src/Dodge/Placement.hs
@@ -6,5 +6,8 @@ import Dodge.LevelGen.Data
 jsps0 :: PSType -> Maybe Placement
 jsps0 pst = Just $ sPS (V2 0 0) 0 pst
 
+jspsJ :: PSType -> Placement -> Maybe Placement
+jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
+
 place0 :: PSType -> (Int -> Maybe Placement) -> Placement
 place0 pst = Placement (PS (V2 0 0) 0 pst)
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index 20668ebdc..2382d6227 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -24,16 +24,14 @@ import System.Random
 import Control.Lens
 import Control.Monad.State
 import Data.Tree
-import qualified Data.Map as M
 import qualified Data.IntMap as IM
 
 twinSlowDoorRoom 
-    :: Int      -- ^ Door id
-    -> Float    -- ^ Half width
+    :: Float    -- ^ Half width
     -> Float    -- ^ Half height
     -> Float    -- ^ Inner width
     -> Room
-twinSlowDoorRoom drid w h x = defaultRoom
+twinSlowDoorRoom w h x = defaultRoom
     { _rmPolys  = ps
     , _rmLinks  =
         [ (V2 w (h/2) , negate $ pi/2)
@@ -42,11 +40,9 @@ twinSlowDoorRoom drid w h x = defaultRoom
         ]
     , _rmPath   = []
     , _rmPS     = 
-        [ sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1
-        , sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red
-            (worldState %~ M.insert (DoorNumOpen drid) True )
-            (worldState %~ M.insert (DoorNumOpen drid) False)
-        , place0 (PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1)
+        [ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red id id)
+            $ \btid -> jspsJ (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
+            $ place0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
             $ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
             $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
         ]
@@ -54,6 +50,7 @@ twinSlowDoorRoom drid w h x = defaultRoom
     , _rmName   = "twinSlowDoorRoom"
     }
   where
+    wlSpeed = 0.5
     addColorChange lsid drid' = over pjUpdate $ chain $ const f
       where
         f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway 
@@ -65,19 +62,18 @@ twinSlowDoorRoom drid w h x = defaultRoom
         [rectNSWE h    0 (-w) w
         ,rectNSWE 20 (-h) (negate x) x
         ]
-    cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w')
+    cond' btid w' = (_btState $ _buttons w' IM.! btid) == BtOn
     col = dim $ dim $ bright red
 
 twinSlowDoorChasers 
     :: RandomGen g 
-    => Int  -- ^ Door id
-    -> State g Room
-twinSlowDoorChasers drid = do
+    => State g Room
+twinSlowDoorChasers = do
     let lps = V2 (-65) <$> [20,40 .. 180]
         rps = V2 65 <$> [20,40 .. 180]
     ps <- takeN 4 $ lps ++ rps
     let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
-    return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
+    return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++)
 
 slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
 slowDoorRoom = do