Correctly update wall zoning when door moves

This commit is contained in:
2025-10-22 10:08:23 +01:00
parent 30da635990
commit f8073381ee
2 changed files with 8 additions and 6 deletions
+6 -4
View File
@@ -1,5 +1,6 @@
module Dodge.DrWdWd (doDrWdWd) where module Dodge.DrWdWd (doDrWdWd) where
import Dodge.Wall.Move
import Dodge.ShiftPoint import Dodge.ShiftPoint
import Linear import Linear
import Data.IntMap.Merge.Strict import Data.IntMap.Merge.Strict
@@ -19,14 +20,15 @@ doDrWdWd dww = case dww of
doorLerp :: Door -> World -> World doorLerp :: Door -> World -> World
doorLerp dr w = case newlerp of doorLerp dr w = case newlerp of
Just x -> Just x ->
w w' x
& cWorld . lWorld . walls %~ merge dropMissing preserveMissing f -- & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f
(wlposs x) -- (wlposs x)
& moveUpdate & moveUpdate
& cWorld . lWorld . doors . ix drid . drLerp .~ x & cWorld . lWorld . doors . ix drid . drLerp .~ x
Nothing -> w Nothing -> w
where where
f = zipWithMatched $ \_ l wl -> wl & wlLine .~ l w' = ifoldl' (\i v p -> moveWallID i p v) w . wlposs
-- f = zipWithMatched $ \_ l wl -> wl & wlLine .~ l
(zp,za) = dr^. drZeroPos (zp,za) = dr^. drZeroPos
(yp,ya) = dr^. drOnePos (yp,ya) = dr^. drOnePos
p2a x = (zp + x *^ (yp - zp) , za + x * diffAngles ya za) p2a x = (zp + x *^ (yp - zp) , za + x * diffAngles ya za)
+2 -2
View File
@@ -43,10 +43,10 @@ tutAnoTree = do
foldMTRS foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor , corDoor
--, tToBTree "asdf" . return . cleatOnward <$> airlockZ
, return $ tToBTree "cor" $ return $ cleatOnward corridor , return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor , return $ tToBTree "cor" $ return $ cleatOnward corridor
, return . tToBTree "asdf" . return . cleatOnward $ airlockCrystal , tToBTree "asdf" . return . cleatOnward <$> airlockZ
--, return . tToBTree "asdf" . return . cleatOnward $ airlockCrystal
, return $ tToBTree "cor" $ return $ cleatOnward corridor , return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor , return $ tToBTree "cor" $ return $ cleatOnward corridor
, tToBTree "t" . return . cleatOnward <$> slowDoorRoom , tToBTree "t" . return . cleatOnward <$> slowDoorRoom