diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 5061ea6ac..a28d2acac 100644 --- a/src/Dodge/DrWdWd.hs +++ b/src/Dodge/DrWdWd.hs @@ -1,5 +1,6 @@ module Dodge.DrWdWd (doDrWdWd) where +import Dodge.Wall.Move import Dodge.ShiftPoint import Linear import Data.IntMap.Merge.Strict @@ -19,14 +20,15 @@ doDrWdWd dww = case dww of doorLerp :: Door -> World -> World doorLerp dr w = case newlerp of Just x -> - w - & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f - (wlposs x) + w' x +-- & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f +-- (wlposs x) & moveUpdate & cWorld . lWorld . doors . ix drid . drLerp .~ x Nothing -> w 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 (yp,ya) = dr^. drOnePos p2a x = (zp + x *^ (yp - zp) , za + x * diffAngles ya za) diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 9c710b092..4ace14a33 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/src/Dodge/Room/Tutorial.hs @@ -43,10 +43,10 @@ tutAnoTree = do foldMTRS [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox , corDoor - --, tToBTree "asdf" . return . cleatOnward <$> airlockZ , 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 , tToBTree "t" . return . cleatOnward <$> slowDoorRoom