Fix terminal shape

src/Dodge/Creature/Picture.hs

@@ -187,7 +187,7 @@ crabFeet _ cr =
     f p q = q + 2 *^ (p - q)
     cdir = -cr ^. crDir
     cxy = cr ^. crPos . _xy
-    afoot = upperPrismPolyST 10 $ polyCirc 3 2
+    afoot = upperPrismPolyHalfST 10 $ polyCirc 3 2
     (r1,r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
     rpos' = f (V2 0 10) rpos
     (r1',r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)

src/Dodge/Creature/State/WalkCycle.hs

@@ -33,16 +33,16 @@ updateCarriage' cid cr w = \case
             & tocr . crStance . carriage . zSpeed 
                 %~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001
     Boosting {} -> w
-    Falling {_fallRot = q} -> 
+    Falling {_fallRot = q, _carDir = q'} -> 
         let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
             ep = cr ^. crPos + v
         in if ep ^. _z < 0 && cr ^. crOldPos . _z >= 0 &&
                 (not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
                     || any (uncurry $ crOnSeg cr) (w ^. cWorld . cliffs))
             then w & tocr . crPos .~ (ep & _z .~ 0)
-                    & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround
+                    & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround q'
             else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep
-                    & cWorld . lWorld . creatures . ix cid . crStance . carriage . fallDir *~ q
+                    & cWorld . lWorld . creatures . ix cid . crStance . carriage . carDir *~ q
                         
     OnGround {} -> w
         & tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy)

src/Dodge/Creature/Update.hs

@@ -55,9 +55,8 @@ updateLivingCreature cr =
         ChaseCrit{} -> \w ->
             crUpdate cid . performActions cid $
                 over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
-        CrabCrit{} -> \w ->
-            crUpdate cid . performActions cid $
-                crabCritInternal cid w
+        CrabCrit{} -> 
+            crUpdate cid . performActions cid . crabCritInternal cid
         AutoCrit {} -> crUpdate cid
         SwarmCrit {} -> crUpdate cid
         HoverCrit {} -> \w ->
@@ -129,7 +128,7 @@ startDeathTimer cr = cr
 toDeathCarriage :: Carriage -> Carriage
 toDeathCarriage = \case
     Flying {} -> Falling Q.qid Q.qid
-    Walking -> OnGround
+    Walking -> OnGround Q.qid
     _ -> Falling Q.qid Q.qid
 
 -- could look at the amount of damage here (given by maxDamage) too

src/Dodge/Data/Creature/Stance.hs

@@ -25,8 +25,8 @@ data Carriage
     | Floating
     | Flying {_zSpeed :: Float, _flyInertia :: Float}
     | Boosting Point2
-    | Falling {_fallRot :: Quaternion Float, _fallDir :: Quaternion Float}
-    | OnGround
+    | Falling {_fallRot :: Quaternion Float, _carDir :: Quaternion Float}
+    | OnGround {_carDir :: Quaternion Float}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data FootForward = LeftForward | RightForward

src/Dodge/Machine/Draw.hs

@@ -1,5 +1,6 @@
 module Dodge.Machine.Draw (drawMachine,mcColor) where
 
+import Linear
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -56,11 +57,12 @@ terminalShape lw mc = fromMaybe mempty $ do
             ( prismBox
                 Medium
                 Typical
-                [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
-                (addZ 0 `map` rectWH 10 10)
+                tps
+                (tps & each . _z .~ 0)
             )
             <> screenbackground (getcol term)
   where
+    tps = [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
     getcol term = fromMaybe black $ termScreenColor term
     screenbackground col =
         colorSH

src/Dodge/Render/ShapePicture.hs

@@ -123,8 +123,8 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
         CrabCrit {} -> noPic $ drawCrabCrit w cr
         HoverCrit{} -> noPic $ drawHoverCrit cr
   where
-    fallrot = case cr ^. crStance . carriage of
-        Falling {_fallDir = q} -> _1 . each . sfVs . each %~ Q.rotate q
+    fallrot = case cr ^? crStance . carriage . carDir of
+        Just q -> _1 . each . sfVs . each %~ Q.rotate q
         _ -> id
 
 barrelShape :: SPic

src/Dodge/Room/Tutorial.hs

@@ -339,14 +339,13 @@ chasmSpitTerminal = do
                    , [sps0 $ putShape $ gird (V2 0 20) (V2 300 20), sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
                    ]
     let y' = y & rmPmnts <>~ ls <> dec
+        cr = PutCrit chaseCrit
     return $
         tToBTree "chasmTerm" $
             Node
                 (addDoorToggleTerminal' i1 (PS 150 0) y')
-                [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit crabCrit)]
-                --[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
-                --[ treePost [triggerDoorRoom i1, deadEndRoom]
-                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit crabCrit)]
+                [ treePost [triggerDoorRoom i1, deadEndPSType cr]
+                , treePost [triggerDoorRoom i1, deadEndPSType cr]
                 , return $ cleatOnward $ triggerDoorRoom i1
                 ]
   where

src/Shape.hs

@@ -17,6 +17,7 @@ module Shape (
     upperPrismPolyHalf,
     upperPrismPolyHalfMI,
     upperPrismPolyHalfST,
+    upperPrismPolyScale,
     xCylinderST,
     prismPoly,
     prismBox,
@@ -57,12 +58,7 @@ polyCircx n = map (vNormaly . addZ 0) . polyCirc n
 -- points should be correctly ordered so that
 -- polys form a prism-like object with quad faces between them
 -- each layer of points must be arranged anticlockwise
-prismPoly ::
-    Size ->
-    Importance ->
-    [Point3] ->
-    [Point3] ->
-    Shape
+prismPoly :: Size -> Importance -> [Point3] -> [Point3] -> Shape
 {-# INLINE prismPoly #-}
 prismPoly size shads upps downps = [Surface (RoundedFaces n) (cp : cp : f upps downps) white shads size]
   where
@@ -201,13 +197,7 @@ upperPrismPolyHalfMI = upperPrismPolyHalf Medium Important
 upperPrismPolyHalfST :: Float -> [Point2] -> Shape
 upperPrismPolyHalfST = upperPrismPolyHalf Small Typical
 
-upperPrismPolyHalf ::
-    -- | height, expected to be strictly positive
-    Size ->
-    Importance ->
-    Float ->
-    [Point2] ->
-    Shape
+upperPrismPolyHalf :: Size -> Importance -> Float -> [Point2] -> Shape
 {-# INLINE upperPrismPolyHalf #-}
 upperPrismPolyHalf size shad h ps = prismPoly size shad upps downps
   where
@@ -216,6 +206,21 @@ upperPrismPolyHalf size shad h ps = prismPoly size shad upps downps
     f (V2 x y) = V3 (0.5 * x) (0.5 * y) h
     g (V2 x y) = V3 x y 0
 
+upperPrismPolyScale ::
+    Float ->
+    Size ->
+    Importance ->
+    Float ->
+    [Point2] ->
+    Shape
+{-# INLINE upperPrismPolyScale #-}
+upperPrismPolyScale s size shad h ps = prismPoly size shad upps downps
+  where
+    upps = map f ps
+    downps = map g ps
+    f (V2 x y) = V3 (s * x) (s * y) h
+    g (V2 x y) = V3 x y 0
+
 upperBoxHalf ::
     -- | height, expected to be strictly positive
     Size ->