Correctly update wall zoning when door moves
This commit is contained in:
+6
-4
@@ -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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user