Fix one bug in door wall movement, add airlock, cleanup

appDodge/Main.hs

@@ -73,10 +73,8 @@ doSideEffects w = do
     let preData = _preloadData w
     newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
     w' <- _sideEffects w w
-    
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
-    
     when (_debug_seconds_frame $ _config w) $ void $ renderFoldable
         (_pictureShaders $ _renderData preData)
         (setDepth (-1)

src/Dodge/Floor.hs

@@ -35,6 +35,7 @@ initialRoomTree = do
         t = treeFromTrunk 
             [[StartRoom]
             ,[Corridor]
+            ,[AirlockAno]
             ,[Corridor]
             ,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
             ,[Corridor]

src/Dodge/LevelGen/TriggerDoor.hs

@@ -8,6 +8,7 @@ import Dodge.Data
 --import Dodge.Base
 --import Dodge.Zone
 import Dodge.Default.Wall
+import Dodge.Wall.Move
 --import Dodge.LevelGen.Switch
 --import Dodge.LevelGen.Pathing
 import Dodge.LevelGen.MoveDoor
@@ -69,13 +70,14 @@ doorMechanismStepwise nsteps drid wlids pss dr w
   where
     playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
     toOpen = _drTrigger dr w
-    cpss = uncurry (rectanglePairs 9) (head pss)
-    setWalls n = playSound (foldl' setWall w (zip3 wlids newps cpss))
+    --cpss = uncurry (rectanglePairs 9) (head pss)
+    setWalls n = playSound (foldl' setWall w (zip wlids newps))
         & doors . ix drid . drStatus .~ DoorInt n
       where
         newps = uncurry (rectanglePairs 9) (pss !! n)
-    setWall w' (wlid,ps,cps) = w' & walls . ix wlid . wlLine .~ ps
-        & (\w'' -> foldr (changeZonedWall (wlLine .~ ps) wlid) w'' (zoneps cps)) 
+    setWall w' (wlid,ps) = w' & moveWallID wlid ps
+--    setWall w' (wlid,ps,cps) = w' & walls . ix wlid . wlLine .~ ps
+--        & (\w'' -> foldr (changeZonedWall (wlLine .~ ps) wlid) w'' (zoneps cps)) 
 -- it is not at all clear that the zoning selects the correct walls
 
 -- TODO think about wall zoning, simplify!

src/Dodge/Placements/Turret.hs

@@ -1,5 +1,4 @@
-module Dodge.Placements.Turret
-    where
+module Dodge.Placements.Turret where
 import Color
 import Dodge.Data
 import Dodge.LevelGen.Data
@@ -25,7 +24,7 @@ putLasTurret = sps0 $ PutMachine blue (reverse $ square wdth) defaultMachine
     { _mcDraw = drawTurret
     , _mcUpdate = updateTurret
     , _mcType = lasTurret
-    , _mcHP = 100000
+    , _mcHP = 50000
     }
 lasTurret :: MachineType
 lasTurret = Turret
@@ -52,7 +51,6 @@ updateTurret mc w
         | _tuFireTime (_mcType mc) > 0
             = ( particles %~ (makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir :) )
             . soundContinue (MachineSound mcid) mcpos tone440sawtoothS (Just 1)
-              
         | otherwise = id
     mcid = _mcID mc
     ypos = _crPos $ you w
@@ -91,6 +89,3 @@ drawTurret mc = (rotateSH (-_mcDir mc) . colorSH blue $ upperPrismPoly 20 (squar
 
 wdth :: Float
 wdth = 10
-
-
-

src/Dodge/Room/Airlock.hs

@@ -5,6 +5,7 @@ import Dodge.Room.Data
 import Dodge.Placements
 import Dodge.Room.Foreground
 import Dodge.Default.Room
+import Dodge.Default.Wall
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.LevelGen.Switch
@@ -17,7 +18,8 @@ import System.Random
 import Control.Monad.State
 {- | A passage with a switch that opens forward access while closing backwards access. -}
 airlock :: RandomGen g => State g Room
-airlock = takeOne [airlock0,airlock90,airlockCrystal]
+--airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
+airlock = takeOne [airlockZ]
 {- | Straight airlock -}
 airlock0 :: Room
 airlock0 = defaultRoom
@@ -40,6 +42,58 @@ airlock0 = defaultRoom
     cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
     col = dim $ dim $ bright red
 
+airlockSimple :: Room
+airlockSimple = defaultRoom
+    { _rmPolys =
+        [ rectNSWE 120 0 0 180 ]
+    , _rmLinks = lnks
+    , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
+    , _rmPS = 
+        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
+            $ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps)
+            $ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps)
+        ]
+    , _rmBound = 
+        [ rectNSWE 120 0 0 180 ]
+    }
+  where 
+    lnks = 
+         [(V2 0 30,pi/2)
+         ,(V2 180 30,1.5*pi)
+         ]
+    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
+    col = dim $ dim $ bright red
+    outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
+    inDoorps  = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 (-55) 0)
+airlockZ :: Room
+airlockZ = defaultRoom
+    { _rmPolys =
+        [ rectNSWE 120 0 0 180 ]
+    , _rmLinks =
+         [(V2 0 30,pi/2)
+         ,(V2 180 30,1.5*pi)
+         ]
+    , _rmPath  = []
+--         [(V2 0 40,V2 40 0)
+--         ,(V2 40 0,V2 0 40)
+--         ]
+    , _rmPS = 
+        [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
+            $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
+            $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
+        , sps0 $ PutWall (rectNSEW 70 50 120 60) defaultWall
+        , mountLightV (V2 90 60) (V3 90 40 50)
+        , mountLightV (V2 90 60) (V3 90 80 50)
+        ]
+    , _rmBound = 
+        [ rectNSWE 120 0 0 180 ]
+    }
+  where 
+    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
+    col = dim $ dim $ bright red
+    outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 0 (-61))
+    inDoorps  = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
+
 airlock90 :: Room
 airlock90 = defaultRoom
     { _rmPolys =