diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index cc5937f03..0d2a1f327 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/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 diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 4e8b14bdc..5061ea6ac 100644 --- a/src/Dodge/DrWdWd.hs +++ b/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 diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 10950204b..666d09203 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/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 @@ -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] diff --git a/src/Dodge/WdP2f.hs b/src/Dodge/WdP2f.hs index 43d9308a7..72b631585 100644 --- a/src/Dodge/WdP2f.hs +++ b/src/Dodge/WdP2f.hs @@ -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