Improve creature stride

src/Dodge/Room/LongDoor.hs

@@ -94,6 +94,7 @@ addSouthPillars x h r = do
     pillars <- takeOne [pillarsa, pillarsb, pillarsc]
     return $ r & rmPmnts .++~ pillars
 
+-- should just be able to attach the mounts to the door directly
 addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
 addButtonSlowDoor x h =
     shuffleLinks
@@ -185,6 +186,46 @@ slowCrushRoom = do
         UnusedLink s -> onside edge s
         _ -> False
 
+pushCaverns :: RandomGen g => State g Room
+pushCaverns = do
+    rm <- shuffleLinks =<< removeLights <$> roomRectAutoLights 250 100
+    crs <- takeOne [[] ]
+    return $ rm
+        & rmBound <>~ [
+            ]
+        & rmLinks %~ setInLinks (\rl -> slinks West $ rl ^. rlType)
+        & rmLinks %~ setOutLinks (\rl -> slinks East $ rl ^. rlType)
+        & rmPmnts <>~
+         [ps0 (PutTrigger False) $ \i -> Just $
+            pContID (spos (slinks West)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (spos (slinks East)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
+        ] <> crs
+  where
+    slinks x s = (FromEdge x 0 `S.member` s)
+    dr = defaultDoor
+        & drUpdate .~ DoorLerp 0.005
+        & drZeroPos .~ (V2 (-5) 50, 0)
+        & drOnePos .~ (V2 150 50, 0)
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 49))
+        & drMounts .~ [MountedLight (V3 30 0 50) 200 0.5
+            , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 32 0])]
+    dr1 = dr
+        & drOnePos .~ (V2 255 50, 0)
+        & drZeroPos .~ (V2 100 50, 0)
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 49))
+        & drMounts .~ [MountedLight (V3 (-30) 0 50) 200 0.5
+            , MountedSPic (noPic $ aBar 55 [V2 (-10) 0,V2 (-32) 0])]
+    f ps = case ps of
+        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
+        _ -> ps
+    spos h = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f)
+    t' h rp _ = case _rpType rp of
+        UnusedLink s -> h s
+        _ -> False
+
+
 slowCrush90 :: RandomGen g => State g Room
 slowCrush90 = do
     rm <- shuffleLinks =<< roomRectAutoLights 170 100

src/Dodge/Room/Tutorial.hs

@@ -55,7 +55,7 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , tToBTree "slowCrush" . return . cleatOnward <$> slowCrush90
+        , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
         , corDoor
         , chasmSpitTerminal
 --a        , return $ tToBTree "cor" $ return $ cleatOnward corridor

src/Dodge/Update.hs

@@ -374,7 +374,8 @@ updateCreatureStride :: Creature -> Creature
 updateCreatureStride cr = cr & crStance . carriage . strideAmount +~ d
   where
     s = fromMaybe 0 $ crMvType cr ^? mvSpeed
-    d = min s . norm $ cr ^. crPos - cr ^. crOldPos
+--    d = min s . norm $ cr ^. crPos - cr ^. crOldPos
+    d = max 0 . min s $ dotV (cr ^. crPos . _xy - cr ^. crOldPos . _xy) (unitVectorAtAngle (cr ^. crMvDir))
 
 updateAimPos :: Universe -> Universe
 updateAimPos u =