Cleanup

src/Dodge/Data/WorldEffect.hs

@@ -55,23 +55,15 @@ data WdBl
     | WdBlCrFilterNearPoint Float Point2 CrBl
     | WdBlBtOn Int
 --    | WdBlBtNotOff Int
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data WdP2f
     = WdP2f0
     | WdP2fDoorPosition Int
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data DrWdWd
     = DrWdId
     | DrWdMakeDoorDebris
-    | DrWdMechanismStepwise Int [Int] [(Point2, Point2)]
-    | DoorMechanism
     | DoorLerp
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-    --deriving (Eq, Show, Read) --, Generic)
-    --h--deriving (Eq, Show, Read) --Generic, Flat)
 
 deriveJSON defaultOptions ''ItCrWdWd
 deriveJSON defaultOptions ''WdWd

src/Dodge/DrWdWd.hs

@@ -1,18 +1,12 @@
-module Dodge.DrWdWd where
+module Dodge.DrWdWd (doDrWdWd) where
 
 import Dodge.ShiftPoint
 import Linear
 import Data.IntMap.Merge.Strict
 import Control.Lens
-import Data.Foldable
-import qualified Data.IntSet as IS
-import Dodge.Base
 import Dodge.Block.Debris
 import Dodge.Data.World
-import Dodge.LevelGen.DoorPane
---import Dodge.Placement.PlaceSpot.TriggerDoor
 import Dodge.SoundLogic
-import Dodge.Wall.Move
 import Dodge.WorldBool
 import Geometry
 
@@ -20,41 +14,8 @@ doDrWdWd :: DrWdWd -> Door -> World -> World
 doDrWdWd dww = case dww of
     DrWdId -> const id
     DrWdMakeDoorDebris -> makeDoorDebris
-    DrWdMechanismStepwise nsteps wlids pss -> doorMechanismStepwise nsteps wlids pss
-    DoorMechanism -> doorMechanism
     DoorLerp -> doorLerp
 
--- TODO sort out why DoorClosed status does not update correctly 22/06/23
-doorMechanism :: Door -> World -> World
-doorMechanism dr w = case mvDir of
-    Just d ->
-        w
-            & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
-            & moveUpdate
-            & cWorld . lWorld . doors . ix drid . drPos . each %~ (+.+ d)
---            & updateDoorEdges (_drObstacleType dr) (_drObstructs dr)
-    Nothing -> w
-  where
-    toOpen = doWdBl (_drTrigger dr) w
-    mvDir
-        | toOpen && _drStatus dr == DoorOpen = Nothing -- Not sure why necessary
-        | toOpen && dist dpos dop > 0.5 = Just $ vecBetweenSpeed speed dpos dop
-        | dist dpos dcp > 0.5 = Just $ vecBetweenSpeed speed dpos dcp
-        | otherwise = Nothing
-    speed = _drSpeed dr
-    drid = _drID dr
-    moveUpdate = playSound . setStatus
-    playSound
-        | _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
-        | otherwise = id
-    dpos = snd $ _drPos dr
-    dop = snd $ _drOpenPos dr
-    dcp = snd $ _drClosePos dr
-    setStatus
-        | dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
-        | dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
-        | otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
-
 doorLerp :: Door -> World -> World
 doorLerp dr w = case newlerp of
     Just x ->
@@ -94,30 +55,3 @@ doorLerp dr w = case newlerp of
         | dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
         | dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
         | otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
-
--- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
--- TODO update _drPos
--- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
--- perhaps only store intermediate door pos pairs, calculate all wall positions
--- on the fly
-doorMechanismStepwise :: Int -> [Int] -> [(Point2, Point2)] -> Door -> World -> World
-doorMechanismStepwise nsteps wlids pss dr w
-    | toOpen = case _drStatus dr of
-        DoorInt x | x == nsteps -> w
-        DoorInt x -> setWalls (x + 1)
-        _ -> w
-    | otherwise = case _drStatus dr of
-        DoorInt 0 -> w
-        DoorInt x -> setWalls (x -1)
-        _ -> w
-  where
-    drid = _drID dr
-    playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
-    toOpen = doWdBl (_drTrigger dr) w
-    setWalls n =
-        playSound (foldl' (&) w (zipWith moveWallID wlids newps))
-            & cWorld . lWorld . doors . ix drid . drStatus .~ DoorInt n
-      where
-        newps = uncurry (rectanglePairs 9) (pss !! n)
-
--- it is not at all clear that the zoning selects the correct walls

src/Dodge/Room/Airlock.hs

@@ -3,9 +3,9 @@
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where
 
-import Data.Maybe
 import Control.Lens
 import Control.Monad
+import Data.Maybe
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
@@ -47,7 +47,11 @@ decontamRoom i =
   where
     f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
         pmnt <- gw ^? genPmnt . ix i
-        return $ putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) 
+        return $
+            putDoubleDoor
+                DoorObstacle
+                (switchWallCol red)
+                (cond pmnt)
                 (V2 (-10) 35)
                 (V2 (-10) 65)
                 2
@@ -99,8 +103,12 @@ airlockDoubleDoor ::
     Point2 ->
     Color ->
     WdBl ->
-    Float -> Point2A -> Point2A ->
+    Float ->
-    Float -> Point2A -> Point2A ->
+    Point2A ->
+    Point2A ->
+    Float ->
+    Point2A ->
+    Point2A ->
     Maybe Placement
 airlockDoubleDoor p1 p2 col cond l1 x1 y1 l2 x2 y2 =
     jspsJ p1 0 (airlockDoor col cond l1 x1 y1) $
@@ -115,9 +123,18 @@ airlockSimple =
         , _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks
         , _rmPmnts =
             [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                \btid -> airlockDoubleDoor 0 (V2 180 0) col (WdBlBtOn btid) 
+                \btid ->
-                    l1 x1 y1
+                    airlockDoubleDoor
-                    l2 x2 y2
+                        0
+                        (V2 180 0)
+                        col
+                        (WdBlBtOn btid)
+                        l1
+                        x1
+                        y1
+                        l2
+                        x2
+                        y2
                         --                    outDoorps inDoorps
             ]
         , _rmBound =
@@ -135,6 +152,7 @@ airlockSimple =
     y1 = (0, 0)
     y2 = (0, pi / 2)
     x2 = (0, pi)
+
 --    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)
 
@@ -156,10 +174,20 @@ airlockZ = do
               --         ]
               _rmPmnts =
                 [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                    \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) 
+                    \btid ->
-                        l1 x1 y1 l2 x2 y2
+                        airlockDoubleDoor
-                   -- outDoorps inDoorps
+                            (V2 0 60)
-                , sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
+                            (V2 180 60)
+                            col
+                            (WdBlBtOn btid)
+                            l1
+                            x1
+                            y1
+                            l2
+                            x2
+                            y2
+                , -- outDoorps inDoorps
+                  sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
                 , lighting
                 ]
             , _rmBound =
@@ -173,6 +201,7 @@ airlockZ = do
     y1 = (0, 0)
     x2 = (0, - pi)
     y2 = (0, - pi / 2)
+
 --    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)
 
@@ -194,8 +223,10 @@ airlock90 =
         , _rmLinks = muout [(V2 0 40, pi / 2)] ++ muin [(V2 40 0, pi)]
         , _rmPath = doublePairSet (V2 0 40, V2 40 0)
         , _rmPmnts =
-            [ pContID (PS (V2 120 120) (3 * pi / 4)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+            [ pContID
-                \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
+                (PS (V2 120 120) (3 * pi / 4))
+                (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
+                $ \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
             , mntLS vShape (V2 35 35) (V3 70 70 50)
             ]
         , _rmBound =
@@ -216,6 +247,7 @@ airlock90 =
     l1 = 55
     y1 = (0, 0)
     x1 = (0, pi / 2)
+
 --    pss = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
 
 airlockCrystal :: Room
@@ -225,8 +257,10 @@ airlockCrystal =
         , _rmLinks = muout [(V2 20 130, 0)] ++ muin [(V2 20 0, pi)]
         , _rmPath = mempty
         , _rmPmnts =
-            [ pContID (PS (V2 145 70) (pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+            [ pContID
-                \btid -> jsps (V2 40 70) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
+                (PS (V2 145 70) (pi / 2))
+                (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
+                $ \btid -> jsps (V2 40 70) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
             , crystalLine (V2 0 70) (V2 40 70)
             , mntLS vShape (V2 150 70) (V3 110 70 70)
             ]
@@ -238,6 +272,7 @@ airlockCrystal =
     l1 = 55
     x1 = (0, pi / 2)
     y1 = (V2 0 (-55), pi / 2)
+
 --pss :: [(Point2, Point2)]
 --pss =
 --    reverse $

src/Dodge/WdP2f.hs

@@ -1,7 +1,5 @@
 {-# OPTIONS -Wno-incomplete-uni-patterns #-}
-module Dodge.WdP2f 
+module Dodge.WdP2f (doWdP2f) where
-    ( doWdP2f
-    ) where
 
 import Control.Lens
 import Dodge.Data.World