Cleanup

2025-10-22 09:30:19 +01:00
parent 2f06c56185
commit 30da635990
4 changed files with 75 additions and 116 deletions
@@ -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
@@ -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
@@ -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
@@ -40,17 +40,21 @@ decontamRoom i =
               , spanLightI (V2 (-20) 30) (V2 (-20) 70)
               , analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
               ]
--        & rmOutPmnt . at i ?~ 
--               analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
-        & rmInPmnt .~ [(0,f)]
+        --        & rmOutPmnt . at i ?~
+        --               analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
+        & rmInPmnt .~ [(0, f)]
        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
  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) 
-            (V2 (-10) 35) 
-            (V2 (-10) 65) 
-            2
+        return $
+            putDoubleDoor
+                DoorObstacle
+                (switchWallCol red)
+                (cond pmnt)
+                (V2 (-10) 35)
+                (V2 (-10) 65)
+                2
    cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
    mcpos = V2 70 50
    cutps = [rectNSWE 100 0 0 40, switchcut]
@@ -99,8 +103,12 @@ airlockDoubleDoor ::
    Point2 ->
    Color ->
    WdBl ->
-    Float -> Point2A -> Point2A ->
-    Float -> Point2A -> Point2A ->
+    Float ->
+    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,10 +123,19 @@ 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) 
-                    l1 x1 y1
-                    l2 x2 y2
--                    outDoorps inDoorps
+                \btid ->
+                    airlockDoubleDoor
+                        0
+                        (V2 180 0)
+                        col
+                        (WdBlBtOn btid)
+                        l1
+                        x1
+                        y1
+                        l2
+                        x2
+                        y2
+                        --                    outDoorps inDoorps
            ]
        , _rmBound =
            [rectNSWE 120 0 0 180]
@@ -131,10 +148,11 @@ airlockSimple =
    col = dim $ dim $ bright red
    l1 = 55
    l2 = 55
-    x1 = (0,pi/2)
+    x1 = (0, pi / 2)
    y1 = (0, 0)
-    y2 = (0,pi/2)
+    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) 
-                        l1 x1 y1 l2 x2 y2
-                   -- outDoorps inDoorps
-                , sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
+                    \btid ->
+                        airlockDoubleDoor
+                            (V2 0 60)
+                            (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 =
@@ -169,10 +197,11 @@ airlockZ = do
    col = dim $ dim $ bright red
    l1 = 61
    l2 = 61
-    x1 = (0, -pi/2)
-    y1 = (0,0)
-    x2 = (0,-pi)
-    y2 = (0, -pi/2)
+    x1 = (0, - pi / 2)
+    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) $
-                \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
+            [ pContID
+                (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 =
@@ -214,8 +245,9 @@ airlock90 =
    --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
    col = dim $ dim $ bright red
    l1 = 55
-    y1 = (0,0)
-    x1 = (0,pi/2)
+    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) $
-                \btid -> jsps (V2 40 70) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
+            [ pContID
+                (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)
            ]
@@ -236,11 +270,12 @@ airlockCrystal =
    switchcutout = orderPolygon $ map toV2 [(39, 20), (150, 60), (150, 80), (39, 120)]
    col = dim $ dim $ bright red
    l1 = 55
-    x1 = (0,pi/2)
-    y1 = (V2 0 (-55),pi/2)
-    --pss :: [(Point2, Point2)]
-    --pss =
-    --    reverse $
-    --        fmap
-    --            ((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral)
-    --            [20 :: Int, 22 .. 70]
+    x1 = (0, pi / 2)
+    y1 = (V2 0 (-55), pi / 2)
+
+--pss :: [(Point2, Point2)]
+--pss =
+--    reverse $
+--        fmap
+--            ((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral)
+--            [20 :: Int, 22 .. 70]
@@ -1,7 +1,5 @@
 {-# OPTIONS -Wno-incomplete-uni-patterns #-}
-module Dodge.WdP2f 
-    ( doWdP2f
-    ) where
+module Dodge.WdP2f (doWdP2f) where

 import Control.Lens
 import Dodge.Data.World