Fix placement movement bug

src/Dodge/Floor.hs

@@ -74,7 +74,7 @@ initialRoomTree = do
             ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
             ,[Corridor]
             ,[DoorAno]
-            ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
+            ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
             ,[SpecificRoom blockedCorridor]
             ,[OrAno [[DoorAno]
                     ,[Corridor]

src/Dodge/Placement.hs

@@ -9,8 +9,11 @@ jsps0 pst = Just $ sPS (V2 0 0) 0 pst
 sps0 :: PSType -> Placement
 sps0 pst = sPS (V2 0 0) 0 pst
 
-jspsJ :: PSType -> Placement -> Maybe Placement
+jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
-jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
+jspsJ p a pst plm = Just $ Placement (PS p a pst) $ \_ -> Just plm
+
+jsps0J :: PSType -> Placement -> Maybe Placement
+jsps0J 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)

src/Dodge/Room/Link.hs

@@ -91,6 +91,7 @@ shiftPSBy
 shiftPSBy (pos,rot) ps = ps
     & placementSpot . psPos %~ shiftPointBy (pos,rot)
     & placementSpot . psRot %~ (+ rot)
+    & idPlacement %~ fmap (fmap $ shiftPSBy (pos,rot))
 
 shiftPathPointBy  
     :: (Point2,Float) 

src/Dodge/Room/LongDoor.hs

@@ -41,7 +41,7 @@ twinSlowDoorRoom w h x = defaultRoom
     , _rmPath   = []
     , _rmPS     = 
         [ 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)
+            $ \btid -> jsps0J (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

src/Dodge/Room/NoNeedWeapon.hs

@@ -25,9 +25,8 @@ To solve this, here we delete unwanted links.
 -}
 centerVaultExplosiveExit
     :: RandomGen g 
-    => Int      -- ^ Door id
+    => State g Room
-    -> State g Room
+centerVaultExplosiveExit = do
-centerVaultExplosiveExit drid = do
     cr <- takeOne [miniGunCrit, autoCrit]
     let extraPS = 
             [sPS (V2 0 175) 0 $ PutCrit explosiveBarrel
@@ -36,5 +35,5 @@ centerVaultExplosiveExit drid = do
             ,sPS (V2 (-4) 195) 0 $ PutCrit explosiveBarrel
             ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
             ]
-    r <- centerVaultRoom drid 200 200 50 <&> rmPS %~ (extraPS ++)
+    r <- centerVaultRoom 200 200 50 <&> rmPS %~ (extraPS ++)
     randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2

src/Dodge/Room/Procedural.hs

@@ -34,7 +34,8 @@ import Data.Tile
 --import Data.List
 --import Data.Function (on)
 --import qualified Data.Tuple.Extra as Tup
-import qualified Data.Map as M
+--import qualified Data.Map.Strict as M
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 import Control.Monad.State
@@ -215,19 +216,12 @@ randomFourCornerRoom = do
 {- | Creates room with a central vault with doors around it.
 -}
 centerVaultRoom
-    :: Int      -- ^ Door id
+    :: Float    -- ^ Width
-    -> Float    -- ^ Width
     -> Float    -- ^ Height
     -> Float    -- ^ Vault dimensions
     -> State g Room
-centerVaultRoom n w h d = do
+centerVaultRoom w h d = do
-    let northPoly = rectNSWE h d (-w) w
-        nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
-        weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) 
-        centerPoly = rectWdthHght (d - 20) (d - 20)
-        --polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
     return $ defaultRoom
-        --{ _rmPolys  = polys
         { _rmPolys  = [rectNSWE h (-h) (-w) w]
         , _rmLinks  = 
             [(V2 0    h  , 0   )
@@ -247,17 +241,17 @@ centerVaultRoom n w h d = do
             ,mountedLight (V2   w  (h/2-20)) (V3 (w-20) (h/2-20) 70)
             ,mountedLightV (V2 0  (d-20)) (V3 0 0 70)
             ]
-            ++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i) 
+            ++ concat (map (\r -> map (shiftPSBy (V2 0 0,r)) $ theDoor) 
-                        [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
+                        [0,pi/2,pi,3*pi/2])
         , _rmBound  = [rectNSWE h (-h) (-w) w]
         }
   where
     col = dim $ dim $ bright red
-    theDoor i = 
+    theDoor = 
-        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-21) 0) (V2 21 0) 2
+        [ Placement (PS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red id id)
-        , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red
+            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
-                           (over worldState (M.insert (DoorNumOpen i) True))
+            $          sPS (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2   21  0) (V2 0 0) 2)
-                           (over worldState (M.insert (DoorNumOpen i) False))
         ]
-    cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w')
+    --cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w')
+    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn