Make displayed terminal text screen dragable

The problem was not updating the strategy to WarningCry.
The whole procedure needs more work.

.ghci

@@ -1 +1,2 @@
 :set prompt ">"
+:load test/Spec.hs

.ghcid

@@ -1 +1 @@
---command "stack ghci --main-is loop:exe:dodge"
+--command "stack ghci --test --main-is loop:test:loop-test --ghci-options=-fobject-code"

.gitignore

@@ -6,5 +6,7 @@ loop.cabal
 keys.json
 log/*
 generated/*
+UntrackedMisc/*
 tags
 ghcidOutput
+.ghcid.bak

.hlint.yaml

@@ -61,6 +61,7 @@
 # - ignore: {name: Use let}
 # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
 
+- ignore: {name: Functor law}
 
 # Define some custom infix operators
 # - fixity: infixr 3 ~^#^~

src/Data/Tile.hs

@@ -17,11 +17,12 @@ data Tile = Tile
     { _tilePoly :: [Point2]
     , -- | point in the world where tile texture is 0,0
       _tileZero :: Point2
-    , -- | world position one along in the X direction, note this also set the scale of the
+    , -- | world position one along in the X direction
-      -- texture
+      -- note this also sets the scale of the texture
       -- this has to be a position because it is shifted
       _tileTangentPos :: Point2
     , _tileArrayZ :: Float
+    , _tileZeroShift :: Maybe Point2A
     }
     deriving (Eq, Ord, Show)
 

src/Dodge/Barreloid.hs

@@ -31,7 +31,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of
     HP _ ->
         w
             & makeExplosionAt ((cr ^. crPos) & _z +~ 20) 0
-            & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
+            & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed
     _ -> w
   where
     f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos . _xy) (argV p) w'
@@ -44,7 +44,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of
 updateBarrel :: Creature -> World -> World
 updateBarrel cr = case cr ^. crHP of
     HP x | x > 0 -> doDamage (cr ^. crID)
-    HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
+    HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed
     _ -> id
 
 damsToExpBarrel :: [Damage] -> Creature -> Creature

src/Dodge/Base/CardinalPoint.hs

@@ -7,8 +7,15 @@ import Geometry
 cardList :: [CardinalPoint]
 cardList = [North, East, South, West]
 
+cardReverse :: CardinalPoint -> CardinalPoint
+cardReverse = \case
+    North -> South
+    South -> North
+    East -> West
+    West -> East
+
 cardVec :: CardinalPoint -> Point2
-cardVec cp = case cp of
+cardVec = \case
     North -> V2 0 1
     South -> V2 0 (-1)
     East -> V2 1 0

src/Dodge/Base/Collide.hs

@@ -32,6 +32,7 @@ module Dodge.Base.Collide (
     anythingHitCirc,
     collide3WallsFloor,
     collide3,
+    crHeight,
 ) where
 
 import Data.Foldable
@@ -174,10 +175,13 @@ collide3Creature sp cr (ep, m) = fromMaybe (ep, m) $ do
 
 crHeight :: Creature -> Maybe Float
 crHeight cr = case cr ^. crHP of
-    HP{} -> Just 25
+    HP{} -> Just $ case cr ^. crType of
+        HoverCrit {} -> 10
+        ChaseCrit {} -> 25
+        Avatar {} -> 25
+        _ -> error "Need to define crHeight for this crType"
     CrIsCorpse{} -> Just 5
-    CrIsGibs -> Nothing
+    CrDestroyed{} -> Nothing
-    CrIsPitted -> Nothing
 
 wallToSurface :: Wall -> (Point3, Point3, [(Point3, Point3)])
 wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y))])

src/Dodge/Base/You.hs

@@ -3,8 +3,12 @@ module Dodge.Base.You
     , yourInv
     , yourSelectedItem
     , yourRootItem
+    , yourRootItemDT
     )where
 
+import Dodge.Item.Grammar
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
 import NewInt
 import Dodge.Data.World
 --import qualified IntMapHelp as IM
@@ -25,6 +29,11 @@ yourRootItem w = do
     j <- _crInv (you w) ^? ix i
     w ^? cWorld . lWorld . items . ix j
 
+yourRootItemDT :: World -> Maybe (DTree OItem)
+yourRootItemDT w = do
+    i <- you w ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix i
+
 yourInv :: World -> NewIntMap InvInt Item
 yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
 

src/Dodge/Block/Debris.hs

@@ -5,14 +5,17 @@ module Dodge.Block.Debris (
     makeBlockDebris,
     makeDebris,
     makeDebrisDirected,
+    makeMachineDebris,
 ) where
 
+import Control.Monad
+import Dodge.Machine.Draw
+import Color
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Data.World
-import Dodge.Material.Color
 import Dodge.Material.Sound
 import Dodge.ShiftPoint
 import Dodge.WorldEvent.Sound
@@ -23,8 +26,20 @@ import qualified Quaternion as Q
 import RandomHelp
 import Shape
 
+makeMachineDebris :: Machine -> World -> World
+makeMachineDebris mc w = foldl' (flip $ makeDebrisZ 20 (MetalDebris $ mcColor mc) mt) w ps
+  where
+    pa = (mc ^. mcPos, mc ^. mcDir)
+    dsize = debrisSize mt
+    ps = fmap (shiftPointBy pa) 
+        . gridInPolygon dsize 
+        . shrinkPolyOnEdges dsize 
+        $ reverse (fst <$> mc ^.. mcFootPrint . each)
+    mt = mc ^. mcSkin
+
+
 makeDoorDebris :: Door -> World -> World
-makeDoorDebris dr w = w & makeDebris mt p
+makeDoorDebris dr w = w & makeDebris (BlockDebris drcol) mt p
   where
     p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
     p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
@@ -32,34 +47,62 @@ makeDoorDebris dr w = w & makeDebris mt p
         wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
         ((wlid, _), _) <- IM.minViewWithKey wlids
         w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
+    drcol = case dr ^. drTrigger of
+        WdBlCrFilterNearPoint {} -> yellow
+        _ -> red
+
+blColor :: Block -> Color
+blColor _ = orange
 
 makeBlockDebris :: Block -> World -> World
-makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
+makeBlockDebris bl w = foldl' (flip $ makeDebris (blockDebrisType mwl bl) mt) w ps
   where
     dsize = debrisSize mt
     ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
-    mt = fromMaybe Stone $ do
+    mt = fromMaybe Stone $ mwl ^? _Just . wlMaterial
+    mwl = do
         wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
         (wlid, _) <- IS.minView wlids
-        wl <- w ^? cWorld . lWorld . walls . ix wlid
+        w ^? cWorld . lWorld . walls . ix wlid
-        return $ _wlMaterial wl
+
+blockDebrisType :: Maybe Wall -> Block -> DebrisType
+blockDebrisType wl bl = case wl ^? _Just . wlMaterial of
+    Just Glass -> GlassDebris
+    Just Metal -> MetalDebris red
+    _ -> BlockDebris $ blColor bl
 
 -- makeDebris :: Material -> Color -> Point2 -> World -> World
-makeDebris :: Material -> Point2 -> World -> World
+makeDebris :: DebrisType -> Material -> Point2 -> World -> World
 makeDebris = makeDebrisDirected (2 * pi) 0
 
-makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
+makeDebrisZ :: Float -> DebrisType -> Material -> Point2 -> World -> World
--- makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
+makeDebrisZ = makeDebrisDirectedZ (2 * pi) 0
--- makeDebrisDirected arcrad dir bm col p w =
+
-makeDebrisDirected arcrad dir bm p w =
+makeDebrisDirectedZ :: Float -> Float -> Float -> DebrisType -> Material -> Point2 -> World -> World
+makeDebrisDirectedZ arcrad dir z dt bm p w =
     w
-        --        & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
+        & cWorld . lWorld . debris <>~ thedebris
-        & cWorld
+        & randGen .~ newg
-        . lWorld
+        & soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
-        . debris
+  where
-        <>~ thedebris
+    (thedebris, newg) = replicateM 4 f & runState $ _randGen w
-        & randGen
+    f = do
-        .~ newg
+        v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
+        spinspeed <- randomR (-0.2, -0.1) & state
+        return $
+            DebrisChunk
+                { _dbPos = p `v2z` z
+                , _dbType = dt
+                , _dbVel = v `v2z` 0
+                , _dbRot = Q.qid
+                , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
+                }
+
+makeDebrisDirected :: Float -> Float -> DebrisType -> Material -> Point2 -> World -> World
+makeDebrisDirected arcrad dir dt bm p w =
+    w
+        & cWorld . lWorld . debris <>~ thedebris
+        & randGen .~ newg
         & soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
   where
     (thedebris, newg) = mapM f [35, 55, 75, 95] & runState $ _randGen w
@@ -70,10 +113,9 @@ makeDebrisDirected arcrad dir bm p w =
         return $
             DebrisChunk
                 { _dbPos = p `v2z` h
-                , --            , _dbType = BlockDebris col
+                , _dbType = dt
-                  _dbType = BlockDebris (materialColor bm)
                 , _dbVel = v `v2z` 0
-                , _dbRot = Q.qID
+                , _dbRot = Q.qid
                 , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
                 }
 
@@ -82,7 +124,7 @@ makeDebrisDirected arcrad dir bm p w =
 --                & prPos .~ p
 --                & prVel .~ v
 --                & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
---                & prQuat .~ Q.qID
+--                & prQuat .~ Q.qid
 --                & prVelZ .~ 0
 --                & prPosZ .~ h
 

src/Dodge/Bullet.hs

@@ -172,7 +172,8 @@ hitEffFromBul w bu = case _buEffect bu of
 
 getBulHitDams :: Bullet -> Point2 -> [Damage]
 getBulHitDams bu p = case _buPayload bu of
-    BulPlain x -> [Piercing x p v]
+    BulPlain x -> [Piercing x p v
+        ,Inertial 0 p v]
     _ -> []
   where
     v = _buVel bu

src/Dodge/Corpse/Make.hs

@@ -1,5 +1,7 @@
 module Dodge.Corpse.Make (makeCorpse) where
 
+import qualified Quaternion as Q
+import Linear
 import Control.Lens
 import Dodge.Creature.Picture
 import Dodge.Creature.Radius
@@ -11,15 +13,35 @@ import Shape
 import ShapePicture
 
 makeCorpse :: Creature -> SPic
-makeCorpse cr =
+makeCorpse cr = case cr ^. crType of
-    noPic
+    HoverCrit{} -> noPic $ drawHoverCrit cr
-        . scaleSH (V3 crsize crsize crsize)
+    ChaseCrit{} -> noPic $ chaseCorpse cr
-        $ mconcat
+    _ ->
-            [ colorSH (_skinHead cskin) $ deadScalp cr
+        noPic
-            , colorSH (_skinUpper cskin) $ deadUpperBody cr
+            . scaleSH (V3 crsize crsize crsize)
-            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+            $ mconcat
-            ]
+                [ colorSH (_skinHead cskin) $ deadScalp cr
+                , colorSH (_skinUpper cskin) $ deadUpperBody cr
+                , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+                ]
   where
     cskin = crShape $ _crType cr -- this should be fixed
     crsize = 0.1 * crRad (cr ^. crType)
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+
+chaseCorpse :: Creature -> Shape
+chaseCorpse cr = mconcat
+            [colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $ polyCirc 3 12 
+                & each %~ vNormal
+                & each . _y *~ 0.6
+            , colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $ 
+                upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+    , colorSH (_skinHead cskin)
+        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+        ]
+  where
+    neckq = (V3 6 0 0, Q.qid)
+    cskin = crShape $ _crType cr -- this should be fixed
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+    headq = neckq `Q.comp` (V3 16 0 0, Q.qid )

src/Dodge/Creature.hs

@@ -99,7 +99,7 @@ startCr =
         & crInv .~ mempty
         & crFaction .~ PlayerFaction
 --        & crMvType .~ MvWalking yourDefaultSpeed
-        & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
+        & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 AvPosture LeftForward 0
 
 -- | Items you start with.
 startInvList :: [Item]

src/Dodge/Creature/Action.hs

@@ -33,6 +33,7 @@ import qualified IntMapHelp as IM
 import LensHelp
 import Linear
 import NewInt
+import qualified Data.Set as S
 
 -- it is desirable to be able to determine when an action is finished,
 -- so that DoActionThen and the like are easy to define
@@ -82,7 +83,7 @@ performAction cr w ac = case ac of
         let (imps, newAcs) = foldMap (performAction cr w) acs
          in (imps, newAcs)
     StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], mempty)
-    PathTo p -> performPathTo cr w p
+    PathTo p a -> performPathTo a cr w p
     TurnToPoint p -> performTurnToA cr p
     LeadTarget p -> fromMaybe ([], mempty) $ do
         i <- cr ^? crIntention . targetCr . _Just
@@ -113,15 +114,20 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
         | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
         | otherwise = p
 
-performPathTo :: Creature -> World -> Point2 -> ActionUpdate
+crPathing :: Creature -> (Point2 -> Point2 -> World -> Bool,S.Set EdgeObstacle -> Bool)
-performPathTo cr w p
+crPathing cr = case cr ^. crStance . carriage of
+    Flying {} -> (isFlyable, not . S.member (WallObstacle WallNotAutoOpen))
+    _ -> (isWalkable, not . pathEdgeObstructed)
+
+performPathTo :: Action -> Creature -> World -> Point2 -> ActionUpdate
+performPathTo a cr w p
     | dist cpos p <= crRad (cr ^. crType) = mempty
-    | isWalkable cpos p w = gotowards p
+    | fst (crPathing cr) cpos p w = gotowards p
-    | otherwise = case pointTowardsImpulse cpos p w of
+    | otherwise = case uncurry pointTowardsImpulse' (crPathing cr) cpos p w of
         Just q -> gotowards q
-        _ -> ([ChangeStrategy Flee], [])
+        _ -> ([], [a])
   where
-    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p])
+    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p a])
     cpos = cr ^. crPos . _xy
     jit = _mvTurnJit $ crMvType cr
 

src/Dodge/Creature/ChaseCrit.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.ChaseCrit (
     smallChaseCrit,
     invisibleChaseCrit,
     chaseCrit,
+    hoverCrit,
 ) where
 
 --import Dodge.Data.Equipment.Misc
@@ -30,8 +31,12 @@ chaseCrit =
         & crName .~ "chaseCrit"
         & crHP .~ HP 150
         & crFaction .~ ColorFaction green
-        & crVocalization .~ chaseCritVocalization
-        & crStance . strideLength .~ 30
 
-chaseCritVocalization :: Vocalization
+hoverCrit :: Creature
-chaseCritVocalization = Vocalization (50, 200) 0
+hoverCrit =
+    defaultCreature
+        & crName .~ "hoverCrit"
+        & crHP .~ HP 150
+        & crType .~ HoverCrit 0
+        & crFaction .~ ColorFaction blue
+        & crStance . carriage .~ Flying 15 0.975

src/Dodge/Creature/Damage.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature.Damage (applyCreatureDamage) where
 
---import Linear
+import Dodge.Creature.Mass
+import Linear
 import Dodge.Material.Damage
 import Data.List
 --import Dodge.Creature.Mass
@@ -15,6 +16,8 @@ applyCreatureDamage :: [Damage] -> Creature -> World -> World
 applyCreatureDamage dms cr w = foldl' (applyIndividualDamage cr) w dms
 
 applyIndividualDamage :: Creature -> World -> Damage -> World
+applyIndividualDamage cr w (Inertial _ _ v) = w 
+    & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ fmap (/ crMass (cr ^. crType)) v
 applyIndividualDamage cr w dm = 
     let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w
     in w' & damageHP cr i

src/Dodge/Creature/HandPos.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Creature.HandPos (
     equipSitePQ,
     translatePointToLeftHand,
@@ -11,18 +12,23 @@ module Dodge.Creature.HandPos (
     headPQ,
     translateToES,
     rightHandPQ,
+    leftHandPQ,
+    strideLength,
 ) where
 
-import Dodge.Data.Equipment.Misc
+import Control.Monad
-import qualified Quaternion as Q
+import qualified Data.IntMap.Strict as IM
+import Linear
 import Control.Lens
 import Dodge.Creature.Test
 import Dodge.Data.Creature
+import Dodge.Data.Equipment.Misc
 import Geometry
+import qualified Quaternion as Q
 import ShapePicture
 
 translateToES :: Creature -> EquipSite -> Point3 -> Point3
-translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
+translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p, Q.qid))
 
 equipSitePQ :: EquipSite -> Creature -> Point3Q
 equipSitePQ = \case
@@ -31,107 +37,148 @@ equipSitePQ = \case
     OnHead -> headPQ
     OnChest -> chestPQ
     OnBack -> backPQ
-    OnLeftLeg -> leftLegPQ
+    OnLeftLeg -> legPQ LeftForward
-    OnRightLeg -> rightLegPQ
+    OnRightLeg -> legPQ RightForward
 
 translatePointToRightHand :: Creature -> Point3 -> Point3
-translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
+translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p, Q.qid))
+
+strideLength :: Creature -> Float
+strideLength cr = case cr ^. crType of
+    Avatar{} -> 35
+    _ -> 30
+
+handWalkingPos :: FootForward -> Float -> Creature -> Point3
+handWalkingPos b off cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
+    (Just sa,Just ff) ->
+        let slen = strideLength cr
+            f i
+                | ff == b = 8 * zeroOneSmooth ((slen - i) / slen)
+                | otherwise = 8 * zeroOneSmooth (i / slen)
+         in V3 (f sa) off 12
+    _ -> V3 0 off 12
+
+zeroOneSmooth :: Float -> Float
+zeroOneSmooth x = (1 - cos (pi * x)) / 2
 
 rightHandPQ :: Creature -> Point3Q
 rightHandPQ cr
-    | oneH cr = (V3 11 (-3) 20, Q.qID)
+    | oneH cr = (V3 11 (-3) 20, Q.qid)
-    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1)
-    | twoFlat cr = (V3 4 (-8) 10, Q.qID)
+    | twoFlat cr = (V3 8 (-8) 12, Q.qid)
-    | otherwise = case cr ^? crStance . carriage of
+    | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
-        Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
+        = (V3 6 (-6) 10, Q.qid)
-        Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
+    | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
-        Just (Falling sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
+        = (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid)
-        Just (Falling sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
+    | Just p <- crRightHandWall cr = (20 & _xy .~ p, Q.qid)
-        _ -> (V3 0 (- off) 10, Q.qID)
+    | otherwise = (handWalkingPos LeftForward (-8) cr, Q.qid)
+
+crRightHandWall :: Creature -> Maybe Point2
+crRightHandWall cr = do
+    (_,p) <- IM.lookupMin (cr ^. crWallTouch)
+    let wp = p - cr ^. crPos . _xy 
+        dp = argV wp
+        ang = nearZeroAngle (cd - dp)
+        cdp = unitVectorAtAngle cd
+        x   | ang < 0 = 0.8 - (0.5 * ang / (pi / 4))
+            | otherwise =  0.8* dotV cdp (signorm wp)
+        y   | ang < 0 = 2 - (5 * ang / (pi / 4))
+            | otherwise = 2
+        ep = wp - y *^ signorm wp + x *^ vNormal wp
+    guard $ ang > negate (pi / 8)
+    return $ ep & _xy %~ rot
   where
-    off = 8
+    cd = cr ^. crDir
-    sLen = _strideLength $ _crStance cr
+    rot = rotateV (negate cd)
-    f i = negate 2 + negate 6 * (sLen - i) / sLen
+
-    g i = negate 2 + negate 6 * i / sLen
+crLeftHandWall :: Creature -> Maybe Point2
+crLeftHandWall cr = do
+    (_,p) <- IM.lookupMin (cr ^. crWallTouch)
+    let wp = p - cr ^. crPos . _xy 
+        dp = argV wp
+        ang = nearZeroAngle (cd - dp)
+        cdp = unitVectorAtAngle cd
+        x   | ang > 0 = 0.8 + (0.5 * ang / (pi / 4))
+            | otherwise =  0.8* dotV cdp (signorm wp)
+        y   | ang > 0 = 2 + (5 * ang / (pi / 4))
+            | otherwise = 2
+        ep = wp - y *^ signorm wp - x *^ vNormal wp
+    guard $ ang < (pi / 8)
+    return $ ep & _xy %~ rot
+  where
+    cd = cr ^. crDir
+    rot = rotateV (negate cd)
 
 translateToRightHand :: Creature -> SPic -> SPic
 translateToRightHand = overPosSP . translatePointToRightHand
 
 rightWristPQ :: Creature -> Point3Q
-rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
+rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qid)
 
 leftHandPQ :: Creature -> Point3Q
 leftHandPQ cr
-    | oneH cr = (V3 0 off 10, Q.qz 0.4)
     | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
-    | twoFlat cr = (V3 4 8 10, Q.qID)
+    | twoFlat cr = (V3 8 8 12, Q.qid)
-    | otherwise = case cr ^? crStance . carriage of
+    | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance
-        Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
+        = (V3 (10 + twoHandOffY cr) 6 20, Q.qid)
-        Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
+    | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance
-        Just (Falling sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
+        = (V3 (8 + twoHandOffY cr) 6 12, Q.qid)
-        Just (Falling sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
+    | Just p <- crLeftHandWall cr = (20 & _xy .~ p, Q.qid)
-        _ -> (V3 0 off 10, Q.qID)
+    | oneH cr = (V3 0 8 10, Q.qz 0.4)
-  where
+    | otherwise = (handWalkingPos RightForward 8 cr, Q.qid)
-    off = 8
+
-    sLen = _strideLength $ _crStance cr
+twoHandOffY :: Creature -> Float
-    f i = negate 2 + negate 6 * (sLen - i) / sLen
+twoHandOffY cr = zeroOneSmooth $ case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
-    g i = negate 2 + negate 6 * i / sLen
+    (Just sa,Just ff) ->
+        let slen = strideLength cr
+            f i
+                | ff == RightForward = (slen - i) / slen
+                | otherwise = i / slen
+         in f sa
+    _ -> 0
 
 translatePointToLeftHand :: Creature -> Point3 -> Point3
-translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
+translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p, Q.qid))
 
 translateToLeftHand :: Creature -> SPic -> SPic
 translateToLeftHand = overPosSP . translatePointToLeftHand
 
 leftWristPQ :: Creature -> Point3Q
-leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
+leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qid)
-
-leftLegPQ :: Creature -> Point3Q
-leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
-    (V3 x off 0,Q.qID)
-  where
-    x = case cr ^? crStance . carriage of
-        Just (Walking sa LeftForward) -> f sa
-        Just (Walking sa RightForward) -> - f sa
-        Just (Falling sa LeftForward) -> f sa
-        Just (Falling sa RightForward) -> - f sa
-        _ -> 0
-    off = 5
-    sLen = _strideLength $ _crStance cr
-    f i = 8 * (sLen - i) / sLen
-    
 
 translateToLeftLeg :: Creature -> SPic -> SPic
-translateToLeftLeg cr = overPosSP (\p -> fst (leftLegPQ cr `Q.comp` (p,Q.qID)))
+translateToLeftLeg cr = overPosSP (\p -> fst (legPQ LeftForward cr `Q.comp` (p, Q.qid)))
 
-rightLegPQ :: Creature -> Point3Q
+legPQ :: FootForward -> Creature -> Point3Q
-rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
+legPQ ff = case ff of
-    (V3 x off 0,Q.qID)
+    LeftForward -> legPQ' id
+    RightForward -> legPQ' negate
+
+legPQ' :: (Float -> Float) -> Creature -> Point3Q
+legPQ' g cr =
+    Q.comp
+        (0, Q.qz (_crMvDir cr - _crDir cr))
+        (V3 x (g off) 0, Q.qid)
   where
-    x = case cr ^? crStance . carriage of
+    x = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
-        Just (Walking sa LeftForward) -> -f sa
+        (Just sa,Just LeftForward) -> -f sa
-        Just (Walking sa RightForward) -> f sa
+        (Just sa,Just RightForward) -> f sa
-        Just (Falling sa LeftForward) -> -f sa
-        Just (Falling sa RightForward) -> f sa
         _ -> 0
     off = -5
-    sLen = _strideLength $ _crStance cr
+    sLen = strideLength cr
-    f i = 8 * (sLen - i) / sLen
+    f i = g 8 * (sLen - i) / sLen
 
 translateToRightLeg :: Creature -> SPic -> SPic
-translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
+translateToRightLeg cr = overPosSP (\p -> fst (legPQ RightForward cr `Q.comp` (p, Q.qid)))
 
 headPQ :: Creature -> Point3Q
 headPQ cr
     | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
     | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
-    | otherwise = (V3 2.5 0 20, Q.qID)
+    | otherwise = (V3 2.5 0 20, Q.qid)
-
---translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
---translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
 
 chestPQ :: Creature -> Point3Q
-chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
+chestPQ cr = backPQ cr `Q.comp` (0, Q.qz pi)
 
 backPQ :: Creature -> Point3Q
 backPQ cr

src/Dodge/Creature/Impulse.hs

@@ -18,7 +18,6 @@ import Dodge.SoundLogic
 import Geometry
 import LensHelp
 import Linear
-import NewInt
 import System.Random
 
 -- note SwitchToItem doesn't necessarily update the root item correctly
@@ -39,7 +38,7 @@ followImpulse cid w = \case
     TurnTo p -> crup $ creatureTurnTo p
     ChangePosture post -> crup $ crStance . posture .~ post
     UseItem -> undefined
-    SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
+--    SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
     Melee cid' ->
         hitCr cid' $
             crup

src/Dodge/Creature/Impulse/Movement.hs

@@ -39,7 +39,7 @@ crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
 crMvAbsolute lw p' cr =
       cr
         & crPos . _xy +~ p
-        & crMvDir .~ argV p
+        & crMvDir .~ argV (p + cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy)
   where
     p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
 

src/Dodge/Creature/Mass.hs

@@ -5,8 +5,8 @@ import Dodge.Data.Creature.Misc
 crMass :: CreatureType -> Float
 crMass = \case
     Avatar {} -> 10
-    AvatarDead -> 10
+    ChaseCrit {} -> 12
-    ChaseCrit {} -> 10
+    HoverCrit {} -> 5
     SwarmCrit -> 2
     AutoCrit -> 10
     BarrelCrit{} -> 10

src/Dodge/Creature/Material.hs

@@ -8,8 +8,8 @@ import Dodge.Data.Material
 crMaterial :: CreatureType -> Material
 crMaterial = \case
     Avatar{_avatarMaterial = mt} -> mt
-    AvatarDead -> Flesh
     ChaseCrit {} -> Flesh
+    HoverCrit {} -> Metal
     SwarmCrit -> Flesh
     AutoCrit -> Flesh
     BarrelCrit{} -> Metal

src/Dodge/Creature/MaxHP.hs

@@ -6,8 +6,8 @@ import Dodge.Data.Creature.Misc
 crMaxHP :: CreatureType -> Int
 crMaxHP = \case
     Avatar {} -> 15000
-    AvatarDead -> 0
     ChaseCrit {} -> 150
+    HoverCrit {} -> 100
     SwarmCrit -> 50
     AutoCrit -> 100
     BarrelCrit{} -> 100

src/Dodge/Creature/MoveType.hs

@@ -2,12 +2,13 @@ module Dodge.Creature.MoveType (crMvType) where
 
 import Dodge.Data.FloatFunction
 import Dodge.Data.Creature
+import Control.Lens
 
 crMvType :: Creature -> CrMvType
 crMvType cr = case _crType cr of
-    Avatar {_avMoveSpeed = s} -> MvWalking s
+    Avatar {} -> MvWalking 1.5
-    AvatarDead -> defaultAimMvType
     ChaseCrit {} -> defaultChaseMvType
+    HoverCrit {} -> defaultChaseMvType & mvSpeed .~ 0.15
     SwarmCrit -> defaultChaseMvType
     AutoCrit -> defaultAimMvType
     BarrelCrit {} -> defaultAimMvType
@@ -27,6 +28,7 @@ defaultChaseMvType =
     CrMvType
         { _mvSpeed = 2
         , _mvTurnRad = FloatAbsCheckGreaterLess (pi / 4) 0.2 0.05
-        , _mvTurnJit = 0.2
+        --, _mvTurnJit = 0.3
+        , _mvTurnJit = 0.05
         , _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01
         }

src/Dodge/Creature/Perception.hs

@@ -1,17 +1,17 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Creature.Perception (
     perceptionUpdate,
-    chaseCritPerceptionUpdate,
     visionCheck,
 ) where
 
+import Dodge.SoundLogic.ExternallyGeneratedSounds
+import Dodge.Creature.Vocalization
 import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Creature.Radius
-import Dodge.Creature.Vocalization
 import Dodge.Data.World
 import Dodge.FloatFunction
 import Geometry.Data
@@ -27,17 +27,13 @@ perceptionUpdate ::
     World ->
     Creature ->
     Creature
-perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
+perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate w . basicAttentionUpdate is w
-
-chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
-chaseCritPerceptionUpdate is w =
-    rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
 
 {- | Update a creatures awareness based upon the creatures' current direction
  of attention
 -} -- TODO delete?
-basicAwarenessUpdate :: Creature -> Creature
+basicAwarenessUpdate :: World -> Creature -> Creature
-basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
+basicAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
     Fixated i ->
         cr & crPerception . cpAwareness
             %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
@@ -45,7 +41,7 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
         cr
             & crPerception . cpAwareness
                 %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
-            & maybeBark
+            & maybeBecomeCognizant
       where
         oldAwareness = _cpAwareness $ _crPerception cr
         newAwareness =
@@ -53,50 +49,67 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
                 oldAwareness
         becomesCognizant =
             any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
-        thejitter = [RandomImpulse $ RandImpulseCircMove 1]
+        maybeBecomeCognizant = fromMaybe id $ do
-        maybeBark = fromMaybe id $ do
             guard becomesCognizant
-            sid <- vocalizationTest cr
+--            guard $ cr ^. crVocalization == VocReady
             return $
-                crActionPlan . apAction
+                (crActionPlan . apStrategy .~ WarningCry) . 
-                    .~ [ImpulsesList ([Bark sid] : replicate 5 thejitter)]
+                (crActionPlan . apAction
+                    .~ [ImpulsesList (crImpulsesOnCognizant w cr)
+                        , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
+                        ])
+
+crImpulsesOnCognizant :: World -> Creature -> [[Impulse]]
+crImpulsesOnCognizant w cr = case cr ^. crType of
+    ChaseCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 3] 
+        <> [[ChangeStrategy $ CloseToMelee 0]]
+    HoverCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]:
+          [[ChangeStrategy $ CloseToMelee 0]]
+    _ | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 1]
+    _ -> replicate 5 [RandomImpulse $ RandImpulseCircMove 3]
+
+cognizantVoc :: World -> Creature -> Maybe SoundID
+cognizantVoc w cr = case cr ^. crType of
+    ChaseCrit {} -> Just (evalState (takeOne (crWarningSounds cr)) (_randGen w))
+    HoverCrit {} -> Just beep3QuickS
+    _ -> Nothing
 
 -- TODO fold in randgen update, requires that this is a world to world function
-chaseCritAwarenessUpdate :: World -> Creature -> Creature
+--chaseCritAwarenessUpdate :: World -> Creature -> Creature
-chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
+--chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
-    Fixated i ->
+--    Fixated i ->
-        cr & crPerception . cpAwareness
+--        cr & crPerception . cpAwareness
-            %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
+--            %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
-    AttentiveTo is ->
+--    AttentiveTo is ->
-        cr
+--        cr
-            & crPerception . cpAwareness
+--            & crPerception . cpAwareness
-                %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
+--                %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
-            & maybeBark
+--            & maybeBark
-      where
+--      where
-        oldAwareness = _cpAwareness $ _crPerception cr
+--        oldAwareness = _cpAwareness $ _crPerception cr
-        newAwareness =
+--        newAwareness =
-            (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
+--            (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
-                oldAwareness
+--                oldAwareness
-        becomesCognizant =
+--        becomesCognizant =
-            any isCognizant $
+--            any isCognizant $
-                IM.unionWith cogRaised oldAwareness newAwareness
+--                IM.unionWith cogRaised oldAwareness newAwareness
-        thejitter = [RandomImpulse $ RandImpulseCircMove 3]
+--        thejitter = [RandomImpulse $ RandImpulseCircMove 3]
-        maybeBark = fromMaybe id $ do
+--        maybeBark = fromMaybe id $ do
-            guard becomesCognizant
+--            guard becomesCognizant
-            guard $ cr ^? crVocalization . vcCoolDown == Just 0
+--            guard $ cr ^. crVocalization == VocReady
-            let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
+--            let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
-                numjits = fst $ randomR (15, 25) (_randGen w)
+--                numjits = fst $ randomR (15, 25) (_randGen w)
-            return $
+--            return $
-                (crActionPlan . apStrategy .~ WarningCry)
+--                (crActionPlan . apStrategy .~ WarningCry)
-                    . ( crActionPlan . apAction
+--                    . ( crActionPlan . apAction
-                            .~ [ ImpulsesList
+--                            .~ [ ImpulsesList
-                                    ( [Bark soundid] :
+--                                    ( [Bark soundid] :
-                                      replicate numjits thejitter
+--                                      replicate numjits thejitter
-                                        ++ [[ChangeStrategy $ CloseToMelee 0]]
+--                                        ++ [[ChangeStrategy $ CloseToMelee 0]]
-                                    )
+--                                    )
-                               , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
+--                               , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
-                               ]
+--                               ]
-                      )
+--                      )
 
 cogRaised :: Awareness -> Awareness -> Awareness
 cogRaised Suspicious{} Cognizant{} = Cognizant 100

src/Dodge/Creature/Picture.hs

@@ -7,8 +7,15 @@ module Dodge.Creature.Picture (
     deadScalp,
     deadUpperBody,
     deadFeet,
+    drawChaseCrit,
+    drawHoverCrit,
 ) where
 
+import Dodge.Base.Collide
+import Control.Monad
+import Data.Maybe
+import Dodge.Data.World
+import Linear
 import Dodge.Data.Equipment.Misc
 import Dodge.Creature.HandPos
 import qualified Data.IntMap.Strict as IM
@@ -17,7 +24,7 @@ import Dodge.Creature.Radius
 import Dodge.Creature.Shape
 --import Dodge.Creature.Test
 import Dodge.Damage
-import Dodge.Data.Creature
+--import Dodge.Data.Creature
 import Dodge.Item.Draw
 import Dodge.Item.Grammar
 import Geometry
@@ -48,22 +55,76 @@ basicCrShape cr
     crsize = 0.1 * crRad (cr ^. crType)
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
+drawHoverCrit :: Creature -> Shape
+drawHoverCrit cr = colorSH (_skinHead cskin) 
+    (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
+    <> colorSH (_skinUpper cskin)
+    (mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0,pi/2,pi,1.5*pi]])
+  where
+    cskin = crShape $ _crType cr
+    f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
+    tpq = (V3 0 0 0, Q.qid)
+
+drawChaseCrit :: World -> Creature -> Shape
+drawChaseCrit w cr = mconcat 
+    [ chaseUpperBody w cr
+    , rotmdir $ colorSH (_skinLower cskin) $ feet cr
+    ]
+  where
+    cskin = crShape $ _crType cr
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+
+chaseUpperBody :: World -> Creature -> Shape
+chaseUpperBody w cr =  colorSH (_skinUpper cskin)
+    (overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI tz $ polyCirc 3 12 
+        & each %~ vNormal
+        & each . _y *~ 0.6) 
+    <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+    )
+    <> colorSH (_skinHead cskin)
+        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+  where
+--    time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
+    tz = 4
+    cskin = crShape $ _crType cr
+    torsoq = (V3 0 0 (10 + tz + tbob),Q.qid)
+    mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
+    neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8*mcool))
+    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2*mcool+vocaltilt) * Q.qz aimrot )
+    vocaltilt = case cr ^? crVocalization . vcTime of
+        Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
+        _ -> 0
+    sLen = strideLength cr
+    tbob = 5 * (1 - oneSmooth (abs llegpos))
+    llegpos = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
+        (Just sa, Just LeftForward) -> f sa
+        (Just sa, Just RightForward) -> -f sa
+        _ -> 0
+    --tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
+    f i = (sLen - 2*i) / sLen
+    cxy = cr ^. crPos . _xy
+    aimrot = fromMaybe pi $ do
+        i <- cr ^. crIntention . targetCr
+        tcxy <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
+        guard $ hasLOSIndirect cxy tcxy w
+        return . (0.5*) . nearZeroAngle $  argV (tcxy - cxy) - cr ^. crDir
+
+oneSmooth :: Float -> Float
+oneSmooth x = sin (pi * x * 0.5)
+
 feet :: Creature -> Shape
 {-# INLINE feet #-}
-feet cr = case cr ^? crStance . carriage of
+feet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
-    Just (Walking sa LeftForward) ->
+    (Just sa,Just LeftForward) -> sh (f sa)
-        translateSHxy (f sa) off aFoot
+    (Just sa,Just RightForward) -> sh (-f sa)
-            <> translateSHxy (- f sa) (- off) aFoot
+    _ -> sh 0
-    Just (Walking sa RightForward) ->
-        translateSHxy (- f sa) off aFoot
-            <> translateSHxy (f sa) (- off) aFoot
-    _ -> translateSHxy 0 off aFoot <> translateSHxy 0 (- off) aFoot
   where
+    sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
     aFoot = upperPrismPolyST 10 $ polyCirc 3 4
     off = 5
-    sLen = _strideLength $ _crStance cr
+    sLen = strideLength cr
-    --f i = 6 * (sLen - i) / sLen
+--    f i = 8 * (sLen - 2*i) / sLen
-    f i = 8 * (sLen - 2*i) / sLen
+    f i = 8 * oneSmooth ((sLen - 2*i) / sLen)
 
 deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
@@ -76,7 +137,7 @@ arms cr =
         translateToRightHand cr aHand
             <> translateToLeftHand cr aHand
   where
-    aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
+    aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
 
 deadScalp :: Creature -> Shape
 --deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
@@ -101,26 +162,20 @@ torso :: Creature -> Shape
 {-# INLINE torso #-}
 torso cr = overPosSH (translateToES cr OnBack) tsh
   where
-    tsh = 
+    tsh = ashoulder 3 (-0.2) <> ashoulder (-3) 0.2
-        mconcat
+    ashoulder y a = translateSHxy 0 y . rotateSH a $ scaleSH (V3 10 10 1) baseShoulder
-            [ translateSHxy 0 3 . rotateSH (negate 0.2) $ aShoulder
-            , translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
-            ]
-    aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
 deadUpperBody :: Creature -> Shape
 deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
-baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
+--baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
+baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 
 upperBody :: Creature -> Shape
 {-# INLINE upperBody #-}
-upperBody cr = arms cr <> shoulderSH (torso cr)
+upperBody cr = arms cr <> torso cr
-
-shoulderSH :: Shape -> Shape
-shoulderSH = translateSHz 20
 
 drawEquipment :: IM.IntMap Item -> Creature -> SPic
 {-# INLINE drawEquipment #-}

src/Dodge/Creature/Radius.hs

@@ -8,8 +8,8 @@ crRad :: CreatureType -> Float
 {-# INLINE crRad #-}
 crRad = \case
     Avatar {} -> 10
-    AvatarDead -> 10
     ChaseCrit {} -> 10
+    HoverCrit {} -> 8
     SwarmCrit -> 2
     AutoCrit -> 10
     BarrelCrit{} -> 10

src/Dodge/Creature/ReaderUpdate.hs

@@ -6,11 +6,12 @@ module Dodge.Creature.ReaderUpdate (
     watchUpdateStrat,
     overrideInternal,
     searchIfDamaged,
-    goToTarget,
+--    goToTarget,
     flockACC,
     chaseCritMv,
     setMvPos,
     setViewPos,
+    hoverCritMv,
 ) where
 
 import Control.Applicative
@@ -124,7 +125,7 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
     WarningCry -> cr
     MeleeStrike -> cr
     CloseToMelee cid
-        | Just 0 == (cr ^? crVocalization . vcCoolDown) ->
+        | VocReady == (cr ^. crVocalization) ->
             cr
                 & crActionPlan . apAction
                     .:~ ImpulsesList
@@ -132,7 +133,7 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
                           replicate numjits [RandomImpulse thejitter]
                             ++ [[ChangeStrategy (CloseToMelee cid)]]
                         )
-                & crVocalization . vcCoolDown .~ 10
+                & resetCrVocCoolDown w
                 & crActionPlan . apStrategy .~ WarningCry
       where
         thejitter = RandImpulseCircMove 3
@@ -141,17 +142,31 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
     _ -> case cr ^? crIntention . mvToPoint . _Just of
         Just p
             | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
-                cr & crActionPlan . apAction .~ [PathTo p]
+                cr & crActionPlan . apAction .~ [PathTo p (DoImpulses [ChangeStrategy Wander])]
             | otherwise ->
                 cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
                     & crActionPlan . apStrategy .~ WatchAndWait
                     & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
 
-goToTarget :: World -> Creature -> Creature
+hoverCritMv :: World -> Creature -> Creature
-goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
+hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
-    Just p -> cr & crActionPlan . apAction .~ [PathTo p]
+    WarningCry -> cr
-    _ -> viewTarget w cr
+    MeleeStrike -> cr
+    _ -> case cr ^? crIntention . mvToPoint . _Just of
+        Just p
+            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
+                cr & crActionPlan . apAction .~ [PathTo p (DoImpulses [ChangeStrategy Wander])]
+            | otherwise ->
+                cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
+                    & crActionPlan . apStrategy .~ WatchAndWait
+                    & crIntention . mvToPoint .~ Nothing
+        _ -> viewTarget w cr
+
+--goToTarget :: World -> Creature -> Creature
+--goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
+--    Just p -> cr & crActionPlan . apAction .~ [PathTo p]
+--    _ -> viewTarget w cr
 
 viewTarget :: World -> Creature -> Creature
 viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
@@ -162,7 +177,7 @@ viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
                 & crIntention . viewPoint .~ Nothing
                 & crActionPlan . apStrategy .~ Investigate
         | otherwise ->
-            cr & crActionPlan . apAction %~ replaceNullWith (PathTo p)
+            cr & crActionPlan . apAction %~ replaceNullWith (PathTo p (DoImpulses [ChangeStrategy Wander]))
                 & crActionPlan . apStrategy .~ Investigate
     Nothing -> cr
 

src/Dodge/Creature/Shape.hs

@@ -7,10 +7,10 @@ import Dodge.Data.Creature.Misc
 
 crShape :: CreatureType -> CreatureShape
 crShape = \case
-    Avatar{} -> Humanoid (greyN 0.9) (lightx4 black) (greyN 0.3) InanimateAI
+    Avatar{} -> Humanoid (greyN 0.9) (lightx4 black) (greyN 0.3)
-    ChaseCrit {} -> Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) ChaseAI
+    ChaseCrit {} -> Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3)
-    SwarmCrit -> Humanoid (greyN 0.9) (lightx4 yellow) (greyN 0.3) SwarmAI
+    HoverCrit {} -> Humanoid (greyN 0.9) (light blue) (greyN 0.3)
-    AutoCrit -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3) AutoAI
+    SwarmCrit -> Humanoid (greyN 0.9) (lightx4 yellow) (greyN 0.3)
-    AvatarDead -> Humanoid (greyN 0.9) (lightx4 black) (greyN 0.3) InanimateAI
+    AutoCrit -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3)
     BarrelCrit {} -> Barreloid
     LampCrit {} -> NonDrawnCreature

src/Dodge/Creature/State.hs

@@ -48,6 +48,11 @@ doDamage cid w = fromMaybe w $ do
 -- TODO generalise shake to arbitrary damage amounts
 applyPastDamages :: Creature -> World -> World
 applyPastDamages cr w
+    | HoverCrit {} <- cr ^. crType 
+    , _crPain cr > 50 = w
+                & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50
+                & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1
+    | HoverCrit {} <- cr ^. crType  = w
     | _crPain cr > 200 = dojitter 3 100
     | _crPain cr > 20 = dojitter 2 10
     | _crPain cr > 0 = dojitter 1 1
@@ -55,7 +60,7 @@ applyPastDamages cr w
   where
     dojitter x y =
         let (p, g) = runState (randInCirc x) (_randGen w)
-         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
+         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvByNoStride p (w ^. cWorld . lWorld)
                 & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
                 & randGen .~ g
 
@@ -224,7 +229,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
   where
     o = locOrient loc cr
     itmtree = loc ^. locDT
-    (p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
+    (p, q) = o `Q.comp` (V3 5 0 0, Q.qid)
     x = 1
     isammolink AmmoMagSF{} = True
     isammolink _ = False

src/Dodge/Creature/State/WalkCycle.hs

@@ -1,31 +1,141 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Creature.State.WalkCycle (updateWalkCycle) where
+module Dodge.Creature.State.WalkCycle (updateCarriage) where
 
+import Dodge.Creature.Radius
+import Geometry
+import Dodge.Update.Camera.Rotate
+import qualified SDL
+import Dodge.WorldEvent.ThingsHit
+import Data.Maybe
+import Dodge.Creature.HandPos
 import Linear
 import Control.Lens
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Sound.Data
 
-updateWalkCycle :: Int -> World -> World
+updateCarriage :: Int -> World -> World
-updateWalkCycle cid w
+updateCarriage cid w = fromMaybe w $ do
-    | Just cr <- w ^? cWorld . lWorld . creatures . ix cid
+    cr <- w ^? cWorld . lWorld . creatures . ix cid
-      , Walking x ff <- cr ^. crStance . carriage
+    return $ updateCarriage' cid cr w (cr ^. crStance . carriage)
-      , x >= cr ^. crStance . strideLength =
-        w
-            & soundMultiFrom
-                [FootstepSound i | i <- [0 .. 10]]
-                (cr ^. crPos . _xy)
-                (chooseFootSound ff)
-                Nothing
-            & over (cWorld . lWorld . creatures . ix cid . crStance . carriage) resetStride
-    | otherwise = w
 
-resetStride :: Carriage -> Carriage
+updateCarriage' :: Int -> Creature -> World -> Carriage -> World
-resetStride = \case
+updateCarriage' cid cr w = \case
-    Walking _ ff -> Walking 0 (normalGait ff)
+    Walking -> maybeTakeStep cid cr w 
-    x -> x
+        & tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
+        & chasmTestCliffPush walkCliffPush cr
+    Floating -> w
+    Flying {_zSpeed = dz, _flyInertia = x} ->
+          w & tocr . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
+            & tocr . crPos . _z +~ dz
+            & 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 {} -> 
+        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
+            else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep
+    OnGround {} -> w
+        & tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy)
+        & chasmTestCliffPush groundCliffPush cr
+  where
+    tocr = cWorld . lWorld . creatures . ix cid
+    oop = cr ^. crOldOldPos
+    f v | norm v > 10 = 10 *^ signorm v
+        | otherwise = v
+
+pushAgainst :: Point2 -> Point2 -> Point2
+pushAgainst x y
+    | a > norm y = 0
+    | a > 0 = y - project y x
+    | otherwise = y
+  where
+    -- project y x is the projection of x onto y
+    a = dotV (normalize y) (project y x)
+
+walkCliffPush :: Creature -> [(Point2,Point2)] -> Point2
+walkCliffPush cr xs = pushAgainst (cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy) (-h xs)
+  where
+    cxy = cr ^. crPos . _xy
+    h = circSegsInside cxy (cr ^. crType . to crRad)
+
+groundCliffPush :: Creature -> [(Point2,Point2)] -> Point2
+groundCliffPush cr xs = x *^ circSegsInside cxy r xs
+  where
+    x = max 0 $ 0.25 * (1 - dist cxy p / (2*r)) ** 2
+    cxy = cr ^. crPos . _xy
+    r = cr ^. crType . to crRad
+    p = circSegsInside' cxy r xs
+
+circSegsInside' :: Point2 -> Float -> [(Point2,Point2)] -> Point2
+circSegsInside' p r = \case
+    [x,y] -> fromJust (uncurry (uncurry intersectLineLine (f x)) (f y))
+    ((x,y):_) -> closestPointOnLine x y p + r *^ normalizeV (vNormal (x-y))
+    _ -> error "circSegsInside"
+  where
+    r' = r+0.5
+    f (x,y) = (x+r'*^n,y+r'*^n)
+      where
+        n = normalizeV (vNormal (x-y))
+
+circSegsInside :: Point2 -> Float -> [(Point2,Point2)] -> Point2
+circSegsInside p r = \case
+    [x,y] -> normalize $ fromJust (uncurry (uncurry intersectLineLine (f x)) (f y)) - p
+    ((x,y):_) -> normalizeV (vNormal (x-y))
+    _ -> error "circSegsInside"
+  where
+    r' = r+0.5
+    f (x,y) = (x+r'*^n,y+r'*^n)
+      where
+        n = normalizeV (vNormal (x-y))
+
+--circTwoLineCorner :: Float -> Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+--circTwoLineCorner r x y a b = intersectLineLine x y a b
+
+chasmTestCliffPush :: (Creature -> [(Point2,Point2)] -> Point2) -> Creature -> World -> World
+chasmTestCliffPush f' cr w
+    | (xy:xys) <- filter g (w ^. cWorld . cliffs) =
+        w
+            & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
+            & tocr . crPos . _xy +~ f' cr (xy:xys) -- (f cr (xy:xys)) *^ h xy xys
+            & chasmRotate cr (uncurry (-) xy)
+    | any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage .~ Falling -- %~ startFalling
+    | otherwise = w
+  where
+    cxy = cr ^. crPos . _xy
+    tocr = cWorld . lWorld . creatures . ix (_crID cr)
+    g = uncurry $ crOnSeg cr
+    f = pointInPoly cxy
+
+chasmRotate :: Creature -> Point2 -> World -> World
+chasmRotate cr v w
+    | t = rotateTo8 (argV v) w
+    | otherwise = w
+  where
+    t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
+
+maybeTakeStep :: Int -> Creature -> World -> World
+maybeTakeStep cid cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
+    (Just x,Just ff) | x >= strideLength cr ->
+        soundMultiFrom
+            [FootstepSound i | i <- [0 .. 10]]
+            (cr ^. crPos . _xy)
+            (chooseFootSound ff)
+            Nothing
+        . over (cWorld . lWorld . creatures . ix cid . crType) resetStride
+    _ -> id
+
+
+resetStride :: CreatureType -> CreatureType
+resetStride ct = case ct ^? footForward of
+    Just _ -> ct & strideAmount .~ 0 & footForward %~ normalGait
+    _ -> ct
 
 normalGait :: FootForward -> FootForward
 normalGait = \case

src/Dodge/Creature/Statistics.hs

@@ -19,8 +19,8 @@ import qualified Data.IntSet as IS
 crDexterity :: Creature -> Int
 crDexterity cr = case cr ^. crType of
     Avatar { _avDexterity = x } -> x
-    AvatarDead -> 0
     ChaseCrit {} -> 46
+    HoverCrit {} -> 46
     SwarmCrit -> 46
     AutoCrit -> 46
     BarrelCrit {} -> 0
@@ -29,8 +29,8 @@ crDexterity cr = case cr ^. crType of
 crStrength :: Creature -> Int
 crStrength cr = case cr ^. crType of
     Avatar { _avStrength = x } -> x
-    AvatarDead -> 0
     ChaseCrit {} -> 46
+    HoverCrit {} -> 46
     SwarmCrit -> 40
     AutoCrit -> 46
     BarrelCrit {} -> 0
@@ -39,8 +39,8 @@ crStrength cr = case cr ^. crType of
 crIntelligence :: Creature -> Int
 crIntelligence  cr = case cr ^. crType of
     Avatar { _avIntelligence = x } -> x
-    AvatarDead -> 0
     ChaseCrit {} -> 20
+    HoverCrit {} -> 20
     SwarmCrit -> 20
     AutoCrit -> 20
     BarrelCrit {} -> 0

src/Dodge/Creature/Strategy.hs

@@ -14,7 +14,7 @@ goToPostStrat cr = case find sentinelGoal $ _apGoal $ _crActionPlan cr of
             (GetTo p)
             [ DoActionThen (WaitThen 150 holsterIfAiming) $
                 DoActionThen
-                    (PathTo p)
+                    (PathTo p NoAction)
                     NoAction
                     --     $ DoImpulses [ChangeStrategy WatchAndWait]
             ]

src/Dodge/Creature/Test.hs

@@ -7,16 +7,13 @@ in fact a creature with that id need not exist.
 -}
 module Dodge.Creature.Test (
     crIsAiming,
---    crIsReloading,
     crIsArmouredFrom,
     oneH,
     twists,
     twoFlat,
---    crWeaponReady,
     crInAimStance,
     crNearPoint,
     isAnimate,
---    crCanShoot,
     crHasTargetLOS,
     crAwayFromPost,
     crHasTarget,
@@ -92,7 +89,8 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
     sentinelGoal _ = False
 
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as
+crInAimStance as cr = cr ^? crStance . posture == Just Aiming
+    && cr ^? crManipulation . manObject . imAimStance == Just as
 
 oneH :: Creature -> Bool
 oneH = crInAimStance OneHand
@@ -101,7 +99,7 @@ twoFlat :: Creature -> Bool
 twoFlat = crInAimStance TwoHandFlat
 
 twists :: Creature -> Bool
-twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
+twists = crInAimStance TwoHandTwist
 
 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
@@ -119,8 +117,7 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
     -- even though angleVV can generate NaN, the comparison seems to deal with it
     frontarmdirection
         | crInAimStance OneHand cr = 0.5
-        | crInAimStance TwoHandUnder cr = negate 1
+        | crInAimStance TwoHandTwist cr = negate 1
-        | crInAimStance TwoHandOver cr = negate 1
         | otherwise = 0
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool
@@ -142,6 +139,5 @@ hasAutoDoorBody :: Creature -> Bool
 hasAutoDoorBody cr = case cr ^. crHP of
     HP {} -> True
     CrIsCorpse {} -> True
-    CrIsGibs -> False
+    CrDestroyed {} -> False
-    CrIsPitted -> False
     

src/Dodge/Creature/Update.hs

@@ -1,14 +1,15 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.Update (updateCreature) where
 
+import Dodge.Base.You
+import Control.Monad
 import Color
 import qualified Data.IntMap.Strict as IM
-import qualified Data.List as List
 import Data.Maybe
 import Dodge.Barreloid
 -- import Dodge.Base.NewID
 import Dodge.Corpse.Make
 import Dodge.Creature.Action
-import Dodge.Creature.Radius
 import Dodge.Creature.State
 import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.Vocalization
@@ -21,14 +22,12 @@ import Dodge.Inventory
 import Dodge.Lampoid
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
-import Dodge.Update.Camera.Rotate
 import FoldableHelp
 import Geometry
 import LensHelp
 import Linear
 import NewInt
 import RandomHelp
-import SDL (MouseButton (..))
 import Shape
 import ShapePicture.Data
 
@@ -36,31 +35,49 @@ import ShapePicture.Data
 -- allow for knockbacks etc to be determined as well as intended movements
 updateCreature :: Creature -> World -> World
 updateCreature cr
-    | cr ^. crPos . _z < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
+    | cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr
-    | CrIsCorpse _ <- cr ^. crHP = chasmTestCorpse cr
+    | CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr)
     | null (cr ^? crHP . _HP) = id
-    | cr ^. crPos . _z < 0 = (tocr . crZVel -~ 0.5) . (tocr . crPos . _z +~ _crZVel cr)
     | otherwise = updateLivingCreature cr
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
 
 updateLivingCreature :: Creature -> World -> World
 updateLivingCreature cr =
-    chasmTestLiving cr . case _crType cr of
+    case _crType cr of
         Avatar{} ->
             (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
                 . crUpdate cid
-                . yourControl cr
+                . yourControl
         LampCrit{} -> updateLampoid cr
         BarrelCrit bt -> updateBarreloid bt cr
-        AvatarDead -> id
         ChaseCrit{} -> \w ->
             crUpdate cid . performActions cid $
                 over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
-        _ -> crUpdate cid
+        AutoCrit {} -> crUpdate cid
+        SwarmCrit {} -> crUpdate cid
+        HoverCrit {} -> \w ->
+            crUpdate cid . performActions cid . hoverCritHoverSound cr $
+                over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
   where
     cid = cr ^. crID
 
+hoverCritHoverSound :: Creature -> World -> World
+hoverCritHoverSound cr w = fromMaybe w $ do
+    guard $ d < 100
+    return $
+        soundContinueVol
+            (0.5 * (1 - 0.01 * d))
+            (CrSound cid)
+            cxy
+            buzz1S
+            (Just 2)
+            w
+  where
+    cxy = cr ^. crPos . _xy
+    d = max 0 (dist (you w ^. crPos . _xy) cxy - 100)
+    cid = cr ^. crID
+
 {- | this seems to work, but I am not sure about the ordering:
  previously, the movement was updated before the ai in order to correctly set the oldpos.
  This should be made more sensible: should the movement side effects apply to
@@ -73,7 +90,7 @@ crUpdate cid =
     checkDeath cid
         . doDamage cid
         . invItemEffs cid
-        . updateWalkCycle cid  -- stride appears to be updated elsewhere as well
+        . updateCarriage cid  -- stride appears to be updated elsewhere as well
 
 checkDeath :: Int -> World -> World
 checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
@@ -81,19 +98,36 @@ checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix c
 checkDeath' :: Creature -> World -> World
 checkDeath' cr w = case cr ^. crHP of
     HP x | x > 0 -> w & tocr . crDamage .~ []
-    HP x | x > -200 && _crDeathTimer cr > 0 ->
+    HP x | x > -200 && null (cr ^. crDeathTimer)
+        -> w & tocr %~ startDeathTimer
+    HP x | x > -200 
+        ,Just y <- cr ^. crDeathTimer
+        , y > 0 ->
             w
                 & tocr . crDamage .~ []
-                & tocr . crDeathTimer -~ 1
+                & tocr . crDeathTimer . _Just -~ 1
     HP _ ->
         w
             & dropAll cr -- the order of these is possibly important
             & stopSoundFrom (CrWeaponSound (_crID cr) 0)
             & corpseOrGib cr
+            & tocr . crStance . carriage %~ toDeathCarriage
     _ -> w
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
 
+startDeathTimer :: Creature -> Creature
+startDeathTimer cr = cr
+    & crDeathTimer ?~ case cr ^. crType of
+        HoverCrit {} -> 0
+        _ -> 5
+
+toDeathCarriage :: Carriage -> Carriage
+toDeathCarriage = \case
+    Flying {} -> Falling
+    Walking -> OnGround
+    _ -> Falling
+
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World
 corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
@@ -104,9 +138,9 @@ corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
         sethp (CrIsCorpse $ poisonSPic thecorpse)
             . dodeathsound PoisonDeath
     Just PhysicalDamage
-        | _crPain cr > 200 ->
+        | _crPain cr > 300 ->
-            addCrGibs cr
+            makeCrGibs cr
-                . sethp CrIsGibs
+                . sethp (CrDestroyed Gibbed)
                 . dodeathsound GibsDeath
     _ ->
         sethp (CrIsCorpse thecorpse)
@@ -134,53 +168,10 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 dropAll :: Creature -> World -> World
 dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
 
-chasmTestLiving :: Creature -> World -> World
+--startFalling :: Creature -> Creature
-chasmTestLiving cr w
+--startFalling cr = case cr ^. crStance . carriage of
-    | Falling {} <- cr ^. crStance . carriage =
+--    Walking -> cr & crStance . carriage .~ Falling
-        w
+--    _ -> cr & crStance . carriage .~ Falling
-            & tocr . crZVel -~ 0.5
-            & tocr . crPos . _z +~ _crZVel cr
-    | Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
-        w
-            & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
-            & tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
-            & chasmRotate cr (x - y)
-    | any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
-    | otherwise = w
-  where
-    tocr = cWorld . lWorld . creatures . ix (_crID cr)
-    g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = pointInPoly (cr ^. crPos . _xy)
-
-startFalling :: Creature -> Creature
-startFalling cr = case cr ^. crStance . carriage of
-    Walking a b -> cr & crZVel -~ 0.5
-        & crStance . carriage .~ Falling a b
-    _ -> cr
-
-chasmTestCorpse :: Creature -> World -> World
-chasmTestCorpse cr w
-    | _crZVel cr < 0 =
-        w
-            & tocr . crZVel -~ 0.5
-            & tocr . crPos . _z +~ _crZVel cr
-    | Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
-        w
-            & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
-            & tocr . crPos . _xy +~ normalizeV (vNormal (x - y))
-    | any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
-    | otherwise = w
-  where
-    tocr = cWorld . lWorld . creatures . ix (_crID cr)
-    g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = pointInPoly (cr ^. crPos . _xy)
-
-chasmRotate :: Creature -> Point2 -> World -> World
-chasmRotate cr v w
-    | t = rotateTo8 (argV v) w
-    | otherwise = w
-  where
-    t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
 
 updatePulse :: Pulse -> Pulse
 updatePulse p

src/Dodge/Creature/Vocalization.hs

@@ -3,30 +3,19 @@
 module Dodge.Creature.Vocalization (
     crWarningSounds,
     crDeathSounds,
-    vocalizationTest,
     resetCrVocCoolDown,
 ) where
 
+import Dodge.Material.Sound
 import Control.Lens
 import Dodge.Data.World
 import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Sound.Data
 import System.Random
 
-crVocalizationSound :: Creature -> Maybe SoundID
-crVocalizationSound cr = case cr ^. crType of
-    Avatar{} -> Nothing
-    AvatarDead -> Nothing
-    ChaseCrit{} -> Just seagullChatterS
-    SwarmCrit -> Nothing
-    AutoCrit -> Nothing
-    BarrelCrit{} -> Nothing
-    LampCrit{} -> Nothing
-
 crWarningSounds :: Creature -> [SoundID]
 crWarningSounds cr = case cr ^. crType of
     Avatar{} -> mempty
-    AvatarDead -> mempty
     ChaseCrit{} ->
         [ seagullBarkS
         , seagullChatterS
@@ -37,6 +26,7 @@ crWarningSounds cr = case cr ^. crType of
         , seagullCry1S
         , seagullCry2S
         ]
+    HoverCrit {} -> mempty
     SwarmCrit -> mempty
     AutoCrit -> mempty
     BarrelCrit{} -> mempty
@@ -45,8 +35,8 @@ crWarningSounds cr = case cr ^. crType of
 crDeathSounds :: Creature -> DeathType -> [SoundID]
 crDeathSounds cr dt = case cr ^. crType of
     Avatar{} -> mempty
-    AvatarDead -> mempty
     ChaseCrit{} -> defaultDeathSounds dt
+    HoverCrit{} -> hoverDeathSounds dt
     SwarmCrit -> mempty
     AutoCrit -> mempty
     BarrelCrit{} -> mempty
@@ -59,14 +49,16 @@ defaultDeathSounds = \case
     PlainDeath -> mempty
     GibsDeath -> [gut1S, gut2S, gut3S, gut4S, gut5S, gut6S]
 
-vocalizationTest :: Creature -> Maybe SoundID
+hoverDeathSounds :: DeathType -> [SoundID]
-vocalizationTest cr = case cr ^? crVocalization . vcCoolDown of
+hoverDeathSounds = \case
-    Just 0 -> crVocalizationSound cr
+    CookDeath -> mempty
-    _ -> Nothing
+    PoisonDeath -> mempty
+    PlainDeath -> [clangS]
+    GibsDeath -> destroyMatS Electronics
 
+crVocalResetTime :: Creature -> StdGen -> Int
+crVocalResetTime _ = fst . randomR (50,100)
+
+-- this should update the randgen as well
 resetCrVocCoolDown :: World -> Creature -> Creature
-resetCrVocCoolDown w cr = case cr ^? crVocalization . vcMaxCoolDown of
+resetCrVocCoolDown w cr = cr & crVocalization .~ VocTimer 0 (crVocalResetTime cr (w ^. randGen))
-    Just (i, j) -> cr & crVocalization . vcCoolDown .~ x
-      where
-        x = fst $ randomR (i, j) (_randGen w)
-    Nothing -> cr

src/Dodge/Creature/Volition.hs

@@ -6,7 +6,6 @@ module Dodge.Creature.Volition (
     shootFirstMiss,
 ) where
 
-import Dodge.Data.AimStance
 import Dodge.Data.Creature
 import Dodge.Data.CreatureEffect
 import Dodge.SoundLogic.LoadSound
@@ -14,7 +13,7 @@ import Geometry
 
 holsterWeapon, drawWeapon :: Action
 holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
-drawWeapon = DoImpulses [ChangePosture $ Aiming OneHand, MakeSound whiteNoiseFadeInS]
+drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
 
 shootTillEmpty :: Action
 --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])

src/Dodge/Creature/YourControl.hs

@@ -2,9 +2,7 @@
 
 module Dodge.Creature.YourControl (yourControl) where
 
-import Linear
 import Control.Monad
-import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.AssignHotkey
@@ -16,63 +14,45 @@ import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
 import Dodge.InputFocus
 import Dodge.Inventory
-import Dodge.Item.AimStance
 import Dodge.SelectedClose
 import Dodge.WASD
 import Geometry
 import LensHelp
+import Linear
 import NewInt
 import qualified SDL
 
 -- | The AI equivalent for your control.
-yourControl :: Creature -> World -> World
+yourControl :: World -> World
-yourControl _ w
+yourControl w
     | inTextInputFocus w = w
-    | Just x <- w ^? hud . subInventory
+    | NoSubInventory <- w ^. hud . subInventory =
-      , f x =
         w
             & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
-            & tryClickUse pkeys
+            & tryClickUse (w ^. input . mouseButtons)
             & handleHotkeys
     | otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
-  where
-    f = \case
-        NoSubInventory -> True
-        ExamineInventory -> True
-        _ -> False
-    pkeys = w ^. input . mouseButtons
 
 -- the following only works because modifier keys are ordered after scancode "hotkeys"
 handleHotkeys :: World -> World
 handleHotkeys w
     | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
-      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
+    , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
-      , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
+    , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
+    , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
         w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
     | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
-      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
+    , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
-      , Just itid <- lw ^? hotkeys . ix hk . unNInt
+    , Just itid <- lw ^? hotkeys . ix hk . unNInt
-      , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
+    , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
         w & invSetSelectionPos 0 (_unNInt invid)
-    | otherwise =
+    | otherwise = M.foldl' useHotkey w pressedhotkeys
-        M.foldl'
-            useHotkey
-            w
-            (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
   where
     pkeys = w ^. input . pressedKeys
     ispressed k = k `M.member` _pressedKeys (_input w)
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
     lw = w ^. cWorld . lWorld
-
+    pressedhotkeys = M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys)
---modifierKeys :: S.Set SDL.Scancode
---modifierKeys = S.fromList 
---    [ SDL.ScancodeLShift
---    , SDL.ScancodeRShift
---    , SDL.ScancodeRCtrl
---    , SDL.ScancodeLCtrl
---    ]
 
 useHotkey :: World -> (NewInt ItmInt, Int) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
@@ -124,7 +104,10 @@ scancodeToHotkey = \case
  within wasdMovement should probably be done first
 -}
 wasdWithAiming :: World -> Creature -> Creature
-wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
+wasdWithAiming w cr 
+    | Walking <- cr ^. crStance . carriage 
+        = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
+    | otherwise = cr
   where
     speed = _mvSpeed $ crMvType cr
     inp = w ^. input
@@ -132,51 +115,39 @@ wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp ca
 
 wasdAim :: Input -> World -> Creature -> Creature
 wasdAim inp w cr
-    | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
+    | SDL.ButtonRight `M.member` _mouseButtons inp
-      , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
+    , AtEase <- cr ^. crStance . posture =
-        setAimPosture (w ^. cWorld . lWorld . items) cr
+        setposture Aiming (-twoHandTwistAmount)
-    | SDL.ButtonRight `M.member` _mouseButtons inp =
+    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) mousedir cr
-        aimTurn (w ^. cWorld . lWorld) mousedir cr
+    | Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount
-    | Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
+--    | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
-    | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
+    | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr
   where
+    setposture x r =
+        cr
+            & crStance . posture .~ x
+            & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
 
-setAimPosture :: IM.IntMap Item -> Creature -> Creature
+doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
-setAimPosture m cr = fromMaybe cr $ do
-    invid <- cr ^? crManipulation . manObject . imRootSelectedItem
-    itid <- cr ^? crInv . ix invid
-    as <- fmap itemBaseStance $ m ^? ix itid
-    return $ cr
-        & crStance . posture .~ Aiming as
-        & doAimTwist as (- twoHandTwistAmount)
-
-doAimTwist :: AimStance -> Float -> Creature -> Creature
 doAimTwist as x
-    | as == TwoHandOver || as == TwoHandUnder = crDir +~ x
+    | as == Just TwoHandTwist = crDir +~ x
     | otherwise = id
 
-removeAimPosture :: Creature -> Creature
-removeAimPosture cr = fromMaybe cr $ do
-    as <- cr ^? crStance . posture . aimStance
-    return $ cr
-        & crStance . posture .~ AtEase
-        & doAimTwist as twoHandTwistAmount
-
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi
 
 wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
-wasdMovement lw inp cam speed = theMovement . setMvAim
+wasdMovement lw inp cam speed = theMovement -- . setMvAim
   where
-    setMvAim = fromMaybe id $ do
+--    setMvAim = fromMaybe id $ do
-        dir <- safeArgV movDir
+--        dir <- safeArgV movDir
-        return $ crMvAim .~ (cam ^. camRot + dir)
+--        return $ crMvAim .~ (cam ^. camRot + dir)
     movDir = wasdDir inp
     movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
     theMovement
         | movDir == V2 0 0 = id
-        | otherwise = crMvAbsolute lw (speed *.* movAbs)
+        | otherwise = crMvAbsolute lw (speed *^ movAbs)
 
 aimTurn :: LWorld -> Float -> Creature -> Creature
 aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
@@ -239,10 +210,13 @@ tryClickUse pkeys w = fromMaybe w $ do
     rtime <- pkeys ^? ix SDL.ButtonRight
     guard $ ltime <= rtime
     case w
-        ^? cWorld . lWorld . creatures . ix 0
+        ^? cWorld
-            . crManipulation
+        . lWorld
-            . manObject
+        . creatures
-            . imSelectedItem
+        . ix 0
-            . unNInt of
+        . crManipulation
+        . manObject
+        . imSelectedItem
+        . unNInt of
         Just invid -> useItem invid ltime w
         Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w

src/Dodge/CreatureEffect.hs

@@ -55,30 +55,30 @@ doCrWdAc cw = case cw of
 --            $
 --            DoReplicate t $
 --                foldr DoActionThen NoAction as
-    ChooseMovementSpreadGun -> chooseMovementSpreadGun
+--    ChooseMovementSpreadGun -> chooseMovementSpreadGun
     ChooseMovementLtAuto -> chooseMovementLtAuto
 
-chooseMovementSpreadGun :: Creature -> World -> Action
+--chooseMovementSpreadGun :: Creature -> World -> Action
-chooseMovementSpreadGun cr w
+--chooseMovementSpreadGun cr w
-    | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi =
+--    | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi =
-        DoImpulses [UseItem, MoveForward (-3)]
+--        DoImpulses [UseItem, MoveForward (-3)]
-    | d < 30 = DoImpulses [UseItem, TurnToward p 0.06]
+--    | d < 30 = DoImpulses [UseItem, TurnToward p 0.06]
-    | d < 60 = DoImpulses [UseItem, TurnToward p 0.06, MoveForward 3]
+--    | d < 60 = DoImpulses [UseItem, TurnToward p 0.06, MoveForward 3]
-    | d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3]
+--    | d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3]
-    | d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 * (d -100)), MoveForward 3]
+--    | d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 * (d -100)), MoveForward 3]
-    | otherwise =
+--    | otherwise =
-        DoImpulses [TurnToward p 0.26, MoveForward 3]
+--        DoImpulses [TurnToward p 0.26, MoveForward 3]
-  where
+--  where
-    d = dist cpos p
+--    d = dist cpos p
-    cpos = cr ^. crPos . _xy
+--    cpos = cr ^. crPos . _xy
-    --tcr = _creatures (_cWorld w) IM.! 0
+--    --tcr = _creatures (_cWorld w) IM.! 0
-    tcr = w ^?! cWorld . lWorld . creatures . ix 0
+--    tcr = w ^?! cWorld . lWorld . creatures . ix 0
-    p = tcr ^. crPos . _xy
+--    p = tcr ^. crPos . _xy
 
 chooseMovementLtAuto :: Creature -> World -> Action
 chooseMovementLtAuto cr w
-    | dist cpos p > 200 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward 3]
+--    | dist cpos p > 200 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward 3]
-    | dist cpos p < 80 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward (-3)]
+--    | dist cpos p < 80 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward (-3)]
     | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 =
         DoImpulses [UseItem, TurnToward p' 0.01, Move (V2 0 3)]
     | otherwise =
@@ -90,9 +90,9 @@ chooseMovementLtAuto cr w
     v = vNormal $ p -.- cpos
     p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
 
-fleeFrom :: Creature -> Maybe Creature -> Action
+--fleeFrom :: Creature -> Maybe Creature -> Action
-fleeFrom cr mtcr = case mtcr of
+--fleeFrom cr mtcr = case mtcr of
-    Just tcr -> DoImpulses 
+--    Just tcr -> DoImpulses 
-        [MoveForward 3
+--        [MoveForward 3
-        , TurnToward ((2 *.* (cr ^. crPos ._xy)) -.- (tcr ^. crPos . _xy)) (pi / 4)]
+--        , TurnToward ((2 *.* (cr ^. crPos ._xy)) -.- (tcr ^. crPos . _xy)) (pi / 4)]
-    Nothing -> NoAction
+--    Nothing -> NoAction

src/Dodge/Damage.hs

@@ -49,6 +49,7 @@ dmType = \case
     Explosive{} -> PhysicalDamage
     Poison{} -> PoisonDamage
     Enterrement{} -> PhysicalDamage
+    Inertial {} -> PhysicalDamage
 
 collectDamageTypes :: [Damage] -> M.Map DamageType Int
 collectDamageTypes = foldl' (flip f) M.empty

src/Dodge/Data/ActionPlan.hs

@@ -34,7 +34,7 @@ data Impulse
     | MvForward
     | TurnTo Point2
     | UseItem
-    | SwitchToItem Int
+--    | SwitchToItem Int
     | DropItem
     | Bark SoundID -- placeholder for various communication types
     | Melee Int
@@ -67,7 +67,7 @@ data Action
         { _targetID :: Int
         , _targetSeenAt :: Point2
         }
-    | PathTo { _pathToPoint :: Point2 }
+    | PathTo { _pathToPoint :: Point2, _pathFailAction :: Action }
     | TurnToPoint { _turnToPoint :: Point2 }
     | ImpulsesList { _impulsesListList :: [[Impulse]] }
     | DoImpulses { _doImpulsesList :: [Impulse] }
@@ -136,6 +136,7 @@ data Strategy
     | Investigate
     | WarningCry
     | LookAround
+    | Wander
     | CloseToMelee {_meleeTarget :: Int}
     | StrategyActions Strategy [Action]
     | GetTo Point2

src/Dodge/Data/AimStance.hs

@@ -8,8 +8,7 @@ import Data.Aeson
 import Data.Aeson.TH
 
 data AimStance
-    = TwoHandUnder
+    = TwoHandTwist
-    | TwoHandOver
     | TwoHandFlat
     | OneHand
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/Creature.hs

@@ -22,6 +22,7 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Map.Strict as M
+import qualified Data.IntMap.Strict as IM
 import Dodge.Data.ActionPlan
 import Dodge.Data.Creature.Misc
 import Dodge.Data.Creature.Perception
@@ -30,16 +31,13 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
-import qualified Data.IntSet as IS
---import qualified IntMapHelp as IM
 
 data Creature = Creature
     { _crPos :: Point3
     , _crOldPos :: Point3
-    , _crZVel :: Float
+    , _crOldOldPos :: Point3
     , _crDir :: Float
     , _crMvDir :: Float
-    , _crMvAim :: Float
     , _crType :: CreatureType
     , _crID :: Int
     , _crHP :: CrHP
@@ -57,15 +55,17 @@ data Creature = Creature
     , _crGroup :: CrGroup
     , _crIntention :: Intention
     , _crName :: String
-    , _crDeathTimer :: Int
+    , _crDeathTimer :: Maybe Int
-    , _crWallTouch :: IS.IntSet
+    , _crWallTouch :: IM.IntMap Point2
     }
 
+-- Prisms, not lenses
 data CrHP
     = HP Int
     | CrIsCorpse SPic
-    | CrIsGibs
+    | CrDestroyed CrDestructionType
-    | CrIsPitted
+
+data CrDestructionType = Gibbed | Pitted
 
 data DeathType = CookDeath | PoisonDeath | PlainDeath | GibsDeath
 
@@ -95,4 +95,5 @@ concat
         [ ''Creature
         , ''Intention
         , ''CrHP
+        , ''CrDestructionType
         ]

src/Dodge/Data/Creature/Misc.hs

@@ -6,6 +6,7 @@ module Dodge.Data.Creature.Misc (
     module Dodge.Data.CamouflageStatus,
 ) where
 
+import Dodge.Data.Creature.Stance
 import Color
 import Control.Lens
 import Data.Aeson
@@ -16,37 +17,24 @@ import Dodge.Data.Material
 import Geometry.Data
 
 data Vocalization
-    = Mute
+    = VocTimer {_vcTime :: Int ,_vcMaxTime :: Int }
-    | Vocalization
+    | VocReady
-        { _vcMaxCoolDown :: (Int, Int)
-        , _vcCoolDown :: Int
-        }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CrMvType
     = NoMvType
-    | MvWalking {_mvSpeed :: Float}
+    | MvWalking {_mvSpeed :: Float} -- note this may interact with a friction element
+    -- so currently 26.04.03 the actual max speed when walking is twice this
     | CrMvType
         { _mvSpeed :: Float
         , _mvTurnRad :: FloatFloat
         , _mvTurnJit :: Float
         , _mvAimSpeed :: FloatFloat
         }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--    | CrAccMv
-
+--        { _mvAcc :: Float
-data HumanoidAI
+--        , _mvTopSpeed :: Float
-    = ChaseAI
+--        }
-    | InanimateAI
-    | SpreadGunAI
-    | PistolAI
-    | LtAutoAI
-    | LauncherAI
-    | SwarmAI
-    | AutoAI
-    | FlockArmourChaseAI
-    | MiniGunAI
-    | LongAI
-    | MultGunAI
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Pulse = PulseStatus
@@ -62,21 +50,27 @@ data CreatureType
         , _avStrength :: Int
         , _avDexterity :: Int
         , _avIntelligence :: Int
-        , _avMoveSpeed :: Float
+        , _avPosture :: AvatarPosture
+        , _footForward :: FootForward
+        , _strideAmount :: Float
         }
-    | AvatarDead
+    | ChaseCrit {_meleeCooldown :: Int
-    | ChaseCrit {_meleeCooldown :: Int}
+        , _footForward :: FootForward
+        , _strideAmount :: Float
+        }
+    | HoverCrit {_meleeCooldown :: Int}
     | SwarmCrit
     | AutoCrit
     | BarrelCrit {_barrelType :: BarrelType}
     | LampCrit {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
 
+data AvatarPosture = AvPosture
+
 data CreatureShape
     = Humanoid
         { _skinHead :: Color
         , _skinUpper :: Color
         , _skinLower :: Color
-        , _humanoidAI :: HumanoidAI
         }
     | Barreloid
     | NonDrawnCreature
@@ -89,17 +83,12 @@ data BarrelType
 
 makeLenses ''Pulse
 makeLenses ''BarrelType
-
---makeLenses ''CreatureStatistics
 makeLenses ''Vocalization
 makeLenses ''CrMvType
 makeLenses ''CreatureType
+makeLenses ''CreatureShape
 deriveJSON defaultOptions ''Pulse
-
---deriveJSON defaultOptions ''CreatureStatistics
 deriveJSON defaultOptions ''Vocalization
-
---deriveJSON defaultOptions ''CrMvType
-deriveJSON defaultOptions ''HumanoidAI
 deriveJSON defaultOptions ''BarrelType
+deriveJSON defaultOptions ''AvatarPosture
 deriveJSON defaultOptions ''CreatureType

src/Dodge/Data/Creature/Stance.hs

@@ -15,24 +15,22 @@ import Geometry.Data
 data Stance = Stance
     { _carriage :: Carriage
     , _posture :: Posture
-    , _strideLength :: Float
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Carriage
-    = Walking {_strideAmount :: Float, _currentFoot :: FootForward}
+    = Walking 
     | Floating
-    | Flying
+    | Flying {_zSpeed :: Float, _flyInertia :: Float}
     | Boosting Point2
-    | Falling {_fallFlail :: Float, _fallFoot :: FootForward}
+    | Falling 
+    | OnGround
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data FootForward = LeftForward | RightForward
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data Posture
+data Posture = Aiming | AtEase
-    = Aiming {_aimStance :: AimStance}
-    | AtEase
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Stance

src/Dodge/Data/CreatureEffect.hs

@@ -26,7 +26,7 @@ data CrAc = CrTurnAround
 
 data CrWdAc
     = CrWdBFSThenReturn Int
-    | ChooseMovementSpreadGun
+--    | ChooseMovementSpreadGun
     | ChooseMovementLtAuto
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Damage.hs

@@ -25,6 +25,7 @@ data Damage
     | Explosive {_dmAmount :: Int, _dmCenter :: Point2}
     | Poison {_dmAmount :: Int}
     | Enterrement {_dmAmount :: Int}
+    | Inertial {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Damage

src/Dodge/Data/Door.hs

@@ -33,6 +33,7 @@ data Door = Door
     , _drZeroPos :: (Point2,Float)
     , _drOnePos :: (Point2,Float)
     , _drLerp :: Float
+    , _drOldLerp :: Float
     , _drFootPrint :: IM.IntMap (Point2,Point2)
     , _drHP :: Int
     , _drPushedBy :: PushSource

src/Dodge/Data/GenWorld.hs

@@ -32,11 +32,10 @@ data GenWorld = GenWorld
 data PSType
     = PutCrit {_unPutCrit :: Creature}
     | PutMachine
-        { _putMachinePoly :: [Point2]
+        { _putMachineMachine :: Machine
-        , _putMachineMachine :: Machine
         , _putMachineMaybeItem :: Maybe Item
         }
-    | PutLS LightSource
+    | PutLS {_putLS :: LightSource}
     | PutButton {_putButton :: Button}
     | PutProp Prop
     | PutTerminal {_unputTerminal :: Terminal}

src/Dodge/Data/Input.hs

@@ -25,13 +25,14 @@ data MouseContext
     | OverCombFilter
     | OverCombEscape
     | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
+    | OverTerminalBar {_mcoBarOffset :: Point2}
     | OutsideTerminal
     | MouseGameRotate {_mcoRotateDist :: Float}  -- TODO warp mouse to this distance
     | OverDebug {_mcoDBBool :: DebugBool, _mcoDBInt :: Int}
     deriving (Show)
 
 data Input = Input
-    { _mousePos :: Point2 -- in pixels, from the center of the screen
+    { _mousePos :: Point2 -- in pixels, from the center of the screen, +ve up and right (I believe)
     , _mouseContext :: MouseContext
     , _mouseMoving :: Bool
     , _pressedKeys :: M.Map Scancode Int

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Item.Use.Consumption.LoadAction where
 
+import Dodge.Data.AimStance
 import Dodge.Data.Item.Location
 import NewInt
 import qualified Data.IntSet as IS
@@ -21,6 +22,7 @@ data ManipulatedObject
     | SelectedItem
         { _imSelectedItem :: NewInt InvInt
         , _imRootSelectedItem :: NewInt InvInt
+        , _imAimStance :: AimStance
         , _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
         }    
     | SelNothing

src/Dodge/Data/Machine.hs

@@ -17,7 +17,6 @@ import Dodge.Data.AmmoType
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import qualified Data.IntSet as IS
 import qualified Data.Map.Strict as M
 import Dodge.Data.Damage
 import Dodge.Data.GenParams
@@ -26,11 +25,14 @@ import Dodge.Data.Machine.Sensor
 import Dodge.Data.Material
 import Dodge.Data.ObjectType
 import Geometry.Data
+import qualified Data.IntMap.Strict as IM
 
 data Machine = Machine
     { _mcID :: Int
-    , _mcWallIDs :: IS.IntSet
+--    , _mcWallIDs :: IS.IntSet
     , _mcMaterial :: Material
+    , _mcSkin :: Material
+    , _mcFootPrint :: IM.IntMap (Point2,Point2)
     , _mcPos :: Point2
     , _mcDir :: Float
     , _mcHP :: Int
@@ -40,8 +42,7 @@ data Machine = Machine
     }
 
 data MachineType
-    = McStatic
+    = McTerminal
-    | McTerminal
     | McDamSensor DamageSensor
     | McProxSensor ProximitySensor
     | McTurret {_mctTurret :: Turret, _mctTurretStun :: Int}
@@ -52,7 +53,6 @@ data MachineType
 
 instance ShortShow MachineType where
     shortShow = \case
-        McStatic -> "McStatic"
         McTerminal -> "McTerm"
         McDamSensor {} -> "McDamSen"
         McProxSensor {} -> "McProxSen"

src/Dodge/Data/MountedObject.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Dodge.Data.MountedObject where
 
+import Control.Lens
 import ShapePicture.Data
 import Geometry.Data
 import Data.Aeson
@@ -13,4 +15,9 @@ data MountedObject
     | MountedSPic SPic
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+moPos :: ASetter' MountedObject Point3
+moPos f = \case
+    MountedLight p r c -> Identity $ MountedLight (runIdentity $ f p) r c
+    MountedSPic sp -> Identity . MountedSPic $ sp & spPos %~ (runIdentity . f)
+
 deriveJSON defaultOptions ''MountedObject

src/Dodge/Data/Prop.hs

@@ -21,6 +21,8 @@ data Prop = ShapeProp
 data DebrisType
     = Gib { _gibSize :: Float , _gibColor :: Color }
     | BlockDebris {_bdColor :: Color}
+    | MetalDebris {_bdColor :: Color}
+    | GlassDebris
 
 data Debris = DebrisChunk
     { _dbPos :: Point3

src/Dodge/Data/Room.hs

@@ -31,8 +31,8 @@ data RoomLink = RoomLink
 data RoomType
     = DefaultRoomType
     | RectRoomType
-        { _numLinkEW :: Int
+        { _numLinkEW :: Int  -- note this is ONE LESS than might be expected
-        , _numLinkNS :: Int
+        , _numLinkNS :: Int  -- note this is ONE LESS than might be expected
         , _linkGapEW :: Float
         , _linkGapNS :: Float
         , _rmWidth :: Float

src/Dodge/Data/Wall/Structure.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Wall.Structure where
 
+--import Geometry.Data
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH

src/Dodge/Data/World.hs

@@ -10,6 +10,7 @@ module Dodge.Data.World (
     module Dodge.Data.Input,
 ) where
 
+import Dodge.Data.SelectionList
 import Color.Data
 import qualified Data.IntMap.Strict as IM
 import NewInt
@@ -58,6 +59,7 @@ data World = World
     , _wCam :: Camera
     , _unpauseClock :: Int
     , _coordinates :: IM.IntMap Point2 -- temporary coordinates for world generation/placement
+    , _tmLDP :: LDParams
     }
 
 data TimeFlowStatus

src/Dodge/Debug/Terminal.hs

@@ -89,7 +89,7 @@ applySetTerminalString var = case key' of
 --    "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
 --    "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
 --    "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
-    "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
+--    "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
     _ -> showTerminalError ("set " ++ var)
   where
     (key, val) = getSplitString var

src/Dodge/Default.hs

@@ -31,13 +31,14 @@ defaultMachine :: Machine
 defaultMachine =
     Machine
         { _mcID = 0
-        , _mcWallIDs = mempty
         , _mcPos = V2 0 0
         , _mcDir = 0
         , _mcHP = 1000
         , _mcMaterial = Electronics
+        , _mcSkin = Metal
+        , _mcFootPrint = mempty
         , _mcDamage = []
-        , _mcType = McStatic
+        , _mcType = McTerminal
         , _mcMounts = mempty
         }
 

src/Dodge/Default/Creature.hs

@@ -14,14 +14,15 @@ defaultCreature =
     Creature
         { _crPos = V3 0 0 0
         , _crOldPos = V3 0 0 0
+        , _crOldOldPos = V3 0 0 0
 --        , _crZ = 0
-        , _crZVel = 0
+--        , _crZVel = 0
         , _crDir = 0
         , _crMvDir = 0
-        , _crMvAim = 0
+--        , _crMvAim = 0
 --        , _crTwist = 0
         , _crID = 1
-        , _crType = ChaseCrit {_meleeCooldown = 0}
+        , _crType = ChaseCrit 0 LeftForward 0
 --        , _crRad = 10
         , _crHP = HP 100
 --        , _crMaxHP = 150
@@ -38,11 +39,10 @@ defaultCreature =
 --        , _crHotkeys = M.empty
         , _crStance =
             Stance
-                { _carriage = Walking 0 LeftForward
+                { _carriage = Walking
                 , _posture = AtEase
-                , _strideLength = yourDefaultStrideLength
                 }
-        , _crVocalization = Mute
+        , _crVocalization = VocReady
         , _crActionPlan = ActionPlan [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
         , _crPerception = defaultPerceptionState
         , _crMemory = defaultCreatureMemory
@@ -53,8 +53,7 @@ defaultCreature =
 --        , _crHammerPosition = HammerUp
         , _crName = "DEFAULTCRNAME"
 --        , _crStatistics = CreatureStatistics 50 50 50
-        , _crDeathTimer = 5  -- how long a creature remains standing 
+        , _crDeathTimer = Nothing
-                             -- after a killing blow has been dealt
         , _crWallTouch = mempty
         }
 

src/Dodge/Default/Door.hs

@@ -11,6 +11,7 @@ defaultDoor =
         , _drZeroPos = (0, 0)
         , _drOnePos = (0, 0)
         , _drLerp = 0
+        , _drOldLerp = 0
         , _drFootPrint = mempty
         , _drHP = 10000
         , _drPushedBy = PushesItself

src/Dodge/Default/World.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.World (defaultWorld) where
 
 --import Data.Graph.Inductive.Graph hiding ((&))
+import Dodge.ListDisplayParams
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Dodge.Data.World
@@ -58,6 +59,7 @@ defaultWorld =
         , _unpauseClock = 0
         , _coordinates = mempty
         , _wSoundFilter = FilterBySoundOrigin $ S.singleton SpawnSound
+        , _tmLDP = terminalLDP
         }
 
 defaultCWGen :: CWGen

src/Dodge/Door.hs

@@ -28,6 +28,7 @@ updateDoor dr w = case dr ^. drUpdate of
         , foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
         )
 
+-- could filter these HERE rather than later?
 doDoorMount :: Point2A -> World -> MountedObject -> World
 doDoorMount pa w = \case
     MountedLight p r c ->
@@ -38,8 +39,9 @@ doDoorMount pa w = \case
                     & _2 . each . vxPos . _xy %~ shiftPointBy pa
                 )
 
+-- do the mounts need to be done if there is no lerping?
 doorLerp :: Float -> Door -> World -> (S.Set Int2, World)
-doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
+doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) $ setOldLerp w) $ do
     x <- newlerp
     let ps = wlposs x
         ps' = wlposs (dr ^. drLerp)
@@ -52,8 +54,10 @@ doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
             f x
                 & playSound x
                 & cWorld . lWorld . doors . ix drid . drLerp .~ x
+                & setOldLerp
         )
   where
+    setOldLerp = cWorld . lWorld . doors . ix drid . drOldLerp .~ (dr ^. drLerp)
     domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
     f = ifoldl' (flip . moveWallID) w . wlposs
     wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)

src/Dodge/Humanoid.hs

@@ -1,4 +1,7 @@
-module Dodge.Humanoid (chaseCritInternal) where
+module Dodge.Humanoid (
+    chaseCritInternal,
+    hoverCritInternal,
+) where
 
 import Data.Foldable
 import Dodge.Creature
@@ -15,13 +18,34 @@ chaseCritInternal w cr =
         , setViewPos
         , setMvPos
         , chaseCritMv
-        , chaseCritPerceptionUpdate [0]
+        , perceptionUpdate [0]
         , targetYouWhenCognizant
         , const searchIfDamaged
         , const (crType . meleeCooldown %~ max 0 . subtract 1)
-        , const (crVocalization . vcCoolDown %~ max 0 . subtract 1)
+        , const (crVocalization %~ updateVocTimer)
         ]
 
+hoverCritInternal :: World -> Creature -> Creature
+hoverCritInternal w cr =
+    foldl'
+        (\c f -> f w c)
+        cr
+        [ const doStrategyActions
+        , overrideMeleeCloseTarget
+        , setViewPos
+        , setMvPos
+        , hoverCritMv
+        , perceptionUpdate [0]
+        , targetYouWhenCognizant
+        , const searchIfDamaged
+        , const (crType . meleeCooldown %~ max 0 . subtract 1)
+        , const (crVocalization %~ updateVocTimer)
+        ]
+
+updateVocTimer :: Vocalization -> Vocalization
+updateVocTimer VocTimer{_vcTime = x, _vcMaxTime = y} | x < y = VocTimer (x + 1) y
+updateVocTimer _ = VocReady
+
 --    SpreadGunAI ->
 --        defaultImpulsive
 --            [ performActions
@@ -173,13 +197,13 @@ chaseCritInternal w cr =
 --        , WaitThen 1 $  (DoImpulses [ChangeStrategy WatchAndWait])
 --        ]
 
---chooseMovementPistol :: Creature -> World -> Action
+-- chooseMovementPistol :: Creature -> World -> Action
---chooseMovementPistol cr w =
+-- chooseMovementPistol cr w =
 --    chooseMovementPistol' cr w
 --        `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
 --
---chooseMovementPistol' :: Creature -> World -> Action
+-- chooseMovementPistol' :: Creature -> World -> Action
---chooseMovementPistol' cr w =
+-- chooseMovementPistol' cr w =
 --    takeOneWeighted
 --        [chargeProb, retreatProb, strafeProb, strafeProb]
 --        [ chargeActions
@@ -219,8 +243,8 @@ chaseCritInternal w cr =
 --    yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos)
 --    yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos)
 --
---retreatActionsPistol :: Creature -> Creature -> Action
+-- retreatActionsPistol :: Creature -> Creature -> Action
---retreatActionsPistol tcr cr =
+-- retreatActionsPistol tcr cr =
 --    [TurnToward retreatOffset 0.2]
 --        `DoImpulsesAlongside` 3
 --        `DoReplicate` ImpulsesList (replicate 9 [Move (V2 (-3) 0)] ++ [[UseItem]])
@@ -240,8 +264,8 @@ chaseCritInternal w cr =
 --                    tpos
 --                    (tpos +.+ vNormal (cpos -.- tpos))
 --
---retreatFireLauncher :: Action
+-- retreatFireLauncher :: Action
---retreatFireLauncher =
+-- retreatFireLauncher =
 --    ImpulsesList ([UseItem] : replicate 20 [Turn 0.16])
 --        `DoActionThen` holsterWeapon
 --        `DoActionThen` ImpulsesList (replicate 30 [MoveForward 3])

src/Dodge/Inventory/Location.hs

@@ -4,6 +4,7 @@ module Dodge.Inventory.Location (
     setInvPosFromSS,
 ) where
 
+import Dodge.Item.AimStance
 import Control.Lens
 import Data.Foldable
 --import Data.IntMap.Merge.Strict
@@ -104,10 +105,13 @@ setInvPosFromSS w = w
                         ( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
                             you w ^. crInv
                         )
+                dt <- invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix rootid
+                -- there is redundancy above
                 return
                     SelectedItem
                         { _imSelectedItem = NInt j
                         , _imRootSelectedItem = NInt rootid
+                        , _imAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt)
                         , _imAttachedItems = aset
                         }
             1 -> Just SelNothing

src/Dodge/Item/AimStance.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Item.AimStance (itemAimStance,itemBaseStance) where
+--module Dodge.Item.AimStance (itemAimStance) where
 
 import Dodge.Data.Item
 import Dodge.Data.ComposedItem
@@ -33,33 +34,33 @@ heldAimStance = \case
     PISTOL -> OneHand
     MACHINEPISTOL -> OneHand
     AUTOPISTOL -> OneHand
-    SMG -> TwoHandUnder
+    SMG -> TwoHandTwist
     BANGCONE -> OneHand
-    BLUNDERBUSS -> TwoHandUnder
+    BLUNDERBUSS -> TwoHandTwist
-    GRAPECANNON{} -> TwoHandUnder
+    GRAPECANNON{} -> TwoHandTwist
-    MINIGUNX{} -> TwoHandUnder
+    MINIGUNX{} -> TwoHandTwist
     VOLLEYGUN{} -> TwoHandFlat
-    RIFLE -> TwoHandUnder
+    RIFLE -> TwoHandTwist
-    ALTERIFLE -> TwoHandUnder
+    ALTERIFLE -> TwoHandTwist
-    AUTORIFLE -> TwoHandUnder
+    AUTORIFLE -> TwoHandTwist
-    BURSTRIFLE -> TwoHandUnder
+    BURSTRIFLE -> TwoHandTwist
-    BANGROD -> TwoHandUnder
+    BANGROD -> TwoHandTwist
-    ELEPHANTGUN -> TwoHandUnder
+    ELEPHANTGUN -> TwoHandTwist
-    AMR -> TwoHandUnder
+    AMR -> TwoHandTwist
-    AUTOAMR -> TwoHandUnder
+    AUTOAMR -> TwoHandTwist
-    SNIPERRIFLE -> TwoHandUnder
+    SNIPERRIFLE -> TwoHandTwist
     FLAMESPITTER -> OneHand
-    FLAMETHROWER -> TwoHandUnder
+    FLAMETHROWER -> TwoHandTwist
-    FLAMETORRENT -> TwoHandUnder
+    FLAMETORRENT -> TwoHandTwist
-    FLAMEWALL -> TwoHandUnder
+    FLAMEWALL -> TwoHandTwist
-    BLOWTORCH -> TwoHandUnder
+    BLOWTORCH -> TwoHandTwist
     TESLACOIL -> TwoHandFlat
-    TRACTORGUN -> TwoHandUnder
+    TRACTORGUN -> TwoHandTwist
-    RLAUNCHER -> TwoHandOver
+    RLAUNCHER -> TwoHandTwist
-    RLAUNCHERX{} -> TwoHandOver
+    RLAUNCHERX{} -> TwoHandTwist
-    GLAUNCHER -> TwoHandUnder
+    GLAUNCHER -> TwoHandTwist
-    POISONSPRAYER -> TwoHandUnder
+    POISONSPRAYER -> TwoHandTwist
-    SHATTERGUN -> TwoHandUnder
+    SHATTERGUN -> TwoHandTwist
     LED -> OneHand
     FLATSHIELD -> TwoHandFlat
     KEYCARD {} -> OneHand

src/Dodge/Item/Draw.hs

@@ -21,7 +21,7 @@ itemEquipPict cr itmtree
       , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
         equipPosition esite cr attachpos (itemSPic itm)
     | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
-        overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
+        overPosSP (Q.apply $ handHandleOrient loc cr) (itemTreeSPic itmtree)
     | otherwise = mempty
   where
     itm = itmtree ^. dtValue . _1
@@ -29,13 +29,13 @@ itemEquipPict cr itmtree
 
 equipAttachPos :: EquipItemType -> Point3Q
 equipAttachPos = \case
-    BATTERYPACK -> (V3 (-8) 0 10, Q.qID)
+    BATTERYPACK -> (V3 (-8) 0 10, Q.qid)
-    FUELPACK -> (V3 (-9) 0 10, Q.qID)
+    FUELPACK -> (V3 (-9) 0 10, Q.qid)
-    BULLETBELTPACK -> (V3 (-9) 0 10, Q.qID)
+    BULLETBELTPACK -> (V3 (-9) 0 10, Q.qid)
-    BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qID)
+    BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qid)
-    _ -> (0, Q.qID)
+    _ -> (0, Q.qid)
 
 equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
 equipPosition es cr q =
     overPosSP
-        (\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qID))
+        (\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qid))

src/Dodge/Item/Draw/SPic.hs

@@ -376,9 +376,11 @@ miniGunXPict :: Int -> Float -> SPic
 miniGunXPict i spin =
     noPic .
         colorSH red $ rotateSHx a barrels
-            <> xCylinderST 3 40
+--            <> xCylinderST 3 40
+            <> xCylinderST 3 16
   where
-    aBarrel = translateSH (V3 15 4 2.5) $ xCylinderST 2 25
+    --aBarrel = translateSH (V3 15 4 2.5) $ xCylinderST 2 25
+    aBarrel = translateSH (V3 15 0 2) $ xCylinderST 2 25
     barrels = foldMap (\an -> aBarrel & rotateSHx (2 * pi * fromIntegral an / fromIntegral i)) [1 .. i]
     a = 2 * pi * spin / 25
 

src/Dodge/Item/Grammar.hs

@@ -102,7 +102,7 @@ extraWeaponLinks itm = case itm ^. itType of
 
 extraWeaponLinksBelow :: Item -> [ItemSF]
 extraWeaponLinksBelow itm
-    | TwoHandUnder <- itemBaseStance itm = [UnderBarrelSlotSF]
+    | TwoHandTwist <- itemBaseStance itm = [UnderBarrelSlotSF]
     | otherwise = []
 
 getAmmoLinks :: Item -> [ItemSF]

src/Dodge/Item/HeldOffset.hs

@@ -8,6 +8,7 @@ module Dodge.Item.HeldOffset (
 ) where
 
 import Dodge.Creature.HandPos
+import Linear
 import Dodge.Data.AimStance
 import Dodge.Data.ComposedItem
 import Dodge.Data.Creature
@@ -26,29 +27,41 @@ turretItemOffset it tu mc =
         . transToHandle it
 
 transToHandle :: Item -> Point3 -> Point3
-transToHandle itm = (-.-.- V3 x y 0)
+transToHandle itm = (-.-.- (0 & _xy .~ handlePos itm))
-  where
-    V2 x y = handlePos itm
 
 handleOrient :: LocationDT CItem -> Point3Q
 handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
-    HELD FLAMETHROWER -> (V3 (-1) 0 0, Q.qID)
+    HELD FLAMETHROWER -> (V3 (-1) 0 0, Q.qid)
-    _ -> (V3 (-3) 0 0, Q.qID)
+    _ -> (V3 (-3) 0 0, Q.qid)
+
+---- note this is relative to the creature
+---- the aimstance here should match any aimstance in Aiming
+--handOrient :: Creature -> AimStance -> Point3Q
+--handOrient cr = case cr ^. crStance . posture of
+--    Aiming {} -> \case
+--        TwoHandUnder -> (V3 (-3) 0 shoulderHeight, Q.qid)
+--        TwoHandOver -> (V3 0 0 shoulderHeight, Q.qid)
+--        OneHand -> (V3 13 (-2) shoulderHeight, Q.qid)
+--        TwoHandFlat -> (V3 13 0 shoulderHeight, Q.qid)
+--    AtEase -> \case
+--        OneHand -> rightHandPQ cr
+--        TwoHandFlat -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) $ twoFlatHRot cr)
+--        TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
+--        TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
 
--- note this is relative to the creature
--- the aimstance here should match any aimstance in Aiming
 handOrient :: Creature -> AimStance -> Point3Q
-handOrient cr = case cr ^. crStance . posture of
+handOrient cr = \case
-    Aiming {} -> \case
+    TwoHandTwist -> 
-        TwoHandUnder -> (V3 (-3) 0 shoulderHeight, Q.qID)
+        let (rp,_) = rightHandPQ cr
-        TwoHandOver -> (V3 0 0 shoulderHeight, Q.qID)
+            (lp,_) = leftHandPQ cr
-        OneHand -> (V3 13 (-2) shoulderHeight, Q.qID)
+--        in (rp,Q.qz (argV $ (lp - rp) ^. _xy))
-        TwoHandFlat -> (V3 13 0 shoulderHeight, Q.qID)
+        in (rp,Q.qNoRoll (lp - rp))
-    AtEase -> \case
+    OneHand -> rightHandPQ cr
-        OneHand -> rightHandPQ cr
+    TwoHandFlat -> 
-        TwoHandFlat -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) $ twoFlatHRot cr)
+        let (rp,_) = rightHandPQ cr
-        TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
+            (lp,_) = leftHandPQ cr
-        TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
+        in (0.5 *^ (rp + lp),Q.qz (argV (vNormal ((lp - rp) ^. _xy))))
+
 
 locOrient :: LocationDT OItem -> Creature -> Point3Q
 locOrient loc cr =
@@ -65,13 +78,13 @@ shoulderHeight :: Float
 shoulderHeight = 18
 
 strideRot :: Creature -> Float
-strideRot cr = case cr ^? crStance . carriage of
+strideRot cr = case  (cr ^? crType . strideAmount,cr ^? crType . footForward) of
-    Just (Walking x LeftForward) -> f x
+    (Just x, Just LeftForward) -> f x
-    Just (Walking x RightForward) -> - f x
+    (Just x, Just RightForward) -> - f x
     _ -> 0
   where
     f i = 0.1 * (sLen - i) / sLen
-    sLen = _strideLength $ _crStance cr
+    sLen = strideLength cr
 
 twoFlatHRot :: Creature -> Float
 twoFlatHRot = (2 *) . strideRot

src/Dodge/Item/Info.hs

@@ -242,8 +242,7 @@ heldPositionInfo = aimStanceInfo . itemBaseStance
 
 aimStanceInfo :: AimStance -> String
 aimStanceInfo as = case as of
-    TwoHandUnder -> "It is held using two hands, tucked under the shoulder."
+    TwoHandTwist -> "It is held using two hands alongside the body."
-    TwoHandOver -> "It is held using two hands, resting over the shoulder."
     TwoHandFlat -> "It is held using two hands in front of the body."
     OneHand -> "It is held in one hand."
 

src/Dodge/Item/MagAmmoType.hs

@@ -1,9 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Item.MagAmmoType (
+module Dodge.Item.MagAmmoType (magAmmoType) where
-    magAmmoType,
-    magMax,
-) where
 
 import Control.Lens
 import Dodge.Data.AmmoType
@@ -25,6 +22,3 @@ mAT = \case
     SHELLMAG -> LauncherAmmo
     BATTERY -> ElectricalAmmo
     CHEMFUELPOUCH -> GasAmmo
-
-magMax :: Item -> Maybe Int
-magMax _ = Just 100

src/Dodge/Item/Orientation.hs

@@ -18,31 +18,31 @@ import qualified Quaternion as Q
 
 orientChild :: Item -> Point3Q
 orientChild itm = case _itType itm of
-    --HELD LED -> (V3 0 5 0, Q.qID)
+    --HELD LED -> (V3 0 5 0, Q.qid)
-    HELD LED -> (V3 (-x) 0 0, Q.qID)
+    HELD LED -> (V3 (-x) 0 0, Q.qid)
-    AMMOMAG BATTERY -> (V3 0 0 1, Q.qID)
+    AMMOMAG BATTERY -> (V3 0 0 1, Q.qid)
-    AMMOMAG {} -> (V3 0 (2-itemShapeMax _y itm) 0, Q.qID)
+    AMMOMAG {} -> (V3 0 (2-itemShapeMax _y itm) 0, Q.qid)
-    --HELD LASER -> (V3 15 (-5) 0, Q.qID)
+    --HELD LASER -> (V3 15 (-5) 0, Q.qid)
-    LASER -> (V3 15 (-5) 0, Q.qID)
+    LASER -> (V3 15 (-5) 0, Q.qid)
     ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, r)
-    _ -> (0, Q.qID)
+    _ -> (0, Q.qid)
   where
     --r = Q.axisAngle (V3 0 0 1) (-pi/4)
-    r = Q.qID
+    r = Q.qid
 --    y = itemShapeMin _y itm
     x = itemShapeMaxX itm
 
 orientByParentChSF :: Item -> ItemSF -> Point3Q
 orientByParentChSF itm lt = case (_itType itm, lt) of
-    (HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qID)
+    (HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qid)
     (HELD (VOLLEYGUN n), AmmoMagSF i _) 
         -> (V3 2 (2.5 + fromIntegral i * 5 - (0.5 * 5 * fromIntegral n)) 3, Q.qz (pi/2))
     (HELD ALTERIFLE, AmmoMagSF i _) -> alteRifleAmmoOrient itm i
-    (HELD _, AmmoMagSF{_amsfType = ElectricalAmmo}) -> (V3 0 0 z, Q.qID)
+    (HELD _, AmmoMagSF{_amsfType = ElectricalAmmo}) -> (V3 0 0 z, Q.qid)
-    (HELD _, AmmoMagSF{}) -> (V3 7 (itemShapeMin _y itm) 0, Q.qID)
+    (HELD _, AmmoMagSF{}) -> (V3 7 (itemShapeMin _y itm) 0, Q.qid)
-    (HELD _, WeaponScopeSF) -> (V3 5 0 5, Q.qID)
+    (HELD _, WeaponScopeSF) -> (V3 5 0 5, Q.qid)
-    (HELD _, TorchSF) -> (V3 x y 0, Q.qID)
+    (HELD _, TorchSF) -> (V3 x y 0, Q.qid)
-    _ -> (0, Q.qID)
+    _ -> (0, Q.qid)
   where
     x = itemShapeMaxX itm
     y = itemShapeMaxY itm
@@ -50,7 +50,7 @@ orientByParentChSF itm lt = case (_itType itm, lt) of
 
 alteRifleAmmoOrient :: Item -> Int -> Point3Q
 alteRifleAmmoOrient itm = \case
-    1 -> (V3 18 (itemShapeMin _y itm + s + 1) 0, Q.qID)
+    1 -> (V3 18 (itemShapeMin _y itm + s + 1) 0, Q.qid)
     _ -> (V3 18 (itemShapeMax _y itm + s - 1) 0, Q.qz pi)
   where
     s | itm ^? itParams . alteRifleSwitch == Just 0 = 1
@@ -79,9 +79,9 @@ itemShapeMin g = f . (^. _1) . itemSPic
 
 orientAttachment :: Item -> CItem -> Point3Q
 orientAttachment par (ch,chsf) = case (_itType par, chsf) of
-    (ATTACH UNDERBARRELSLOT, _) -> (V3 (-5) (-8) 0, Q.qID)
+    (ATTACH UNDERBARRELSLOT, _) -> (V3 (-5) (-8) 0, Q.qid)
-    (_,LaserWeaponXSF {}) -> (V3 2 8 0, Q.qID)
+    (_,LaserWeaponXSF {}) -> (V3 2 8 0, Q.qid)
---    (_,TorchSF) -> (V3 2 8 0, Q.qID)
+--    (_,TorchSF) -> (V3 2 8 0, Q.qid)
     --    (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
     --    (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
     _ -> (t1 + Q.rotate q1 t2, q1 * q2)
@@ -92,5 +92,5 @@ orientAttachment par (ch,chsf) = case (_itType par, chsf) of
 propagateOrientation :: DTree CItem -> DTree OItem
 propagateOrientation = dtStartPropagate g f
   where
-    g (x,y) = (x,y,(V3 0 0 0,Q.qID))
+    g (x,y) = (x,y,(V3 0 0 0,Q.qid))
     f (x,_,pq) (y,y1) = (y,y1,Q.comp pq $ orientAttachment x (y,y1))

src/Dodge/Layout.hs

@@ -6,6 +6,7 @@ module Dodge.Layout (
     shuffleRoomPos,
 ) where
 
+import Control.Monad
 -- import Dodge.Path.Translate
 import qualified Control.Foldl as L
 import Control.Lens
@@ -67,15 +68,26 @@ randomCompass w =
 setTiles :: GenWorld -> GenWorld
 setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms gw
 
+roomTileZeroShift :: Room -> Point2A
+roomTileZeroShift rm = fromMaybe (rm ^. rmShift) 
+    $ rm ^? rmFloor . tiles . ix 0 . tileZeroShift . _Just
+
 setTile :: Room -> GenWorld -> GenWorld
 setTile r gw = case _rmFloor r of
-    Tiled{} -> gw
+    Tiled xs -> fromMaybe gw $ do
+        pid <- r ^. rmMParent
+        rm <- gw ^? genRooms . ix pid
+        guard $ rm ^? rmFloor . tiles . ix 0 . tileArrayZ == xs ^? ix 0 . tileArrayZ
+        return $ gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor . tiles . ix 0 . tileZeroShift 
+            ?~ roomTileZeroShift rm
     InheritFloor ->
         gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
   where
-    t = case _rmMParent r of
+    t = fromMaybe (Tile poly (V2 0 0) (V2 1 0) 16 Nothing) $ do
-        Nothing -> Tile poly (V2 0 0) (V2 1 0) 16
+            pid <- r ^. rmMParent
-        Just pid -> head $ _tiles $ _rmFloor $ _genRooms gw IM.! pid
+            rm <- gw ^? genRooms . ix pid
+            (rm ^? rmFloor . tiles . ix 0)
+                <&> tileZeroShift ?~ roomTileZeroShift rm
     poly =
         orderPolygon
             . convexHullSafe

src/Dodge/Machine/Destroy.hs

@@ -1,6 +1,7 @@
-module Dodge.Machine.Destroy where
+module Dodge.Machine.Destroy (destroyMachine) where
 
-import Geometry.Vector3D
+import Linear
+import Dodge.Block.Debris
 import Dodge.FloorItem
 import Data.Maybe
 import Dodge.Data.World
@@ -13,12 +14,16 @@ import LensHelp
 destroyMachine :: Machine -> World -> World
 destroyMachine mc =
     (cWorld . lWorld . machines %~ IM.delete (_mcID mc))
-        . deleteWallIDs (_mcWallIDs mc)
+        . deleteWallIDs (IM.keysSet $ _mcFootPrint mc)
-        . makeExplosionAt (_mcPos mc `v2z` 20) 0
+        . makeMachineDebris mc
+        . makeSmallExplosionAt (20 & _xy .~ _mcPos mc) 0
         . mcKillTerm mc
         . mcKillBut mc
         . destroyMcType (mc ^. mcType) mc
 
+--explodeMachine :: Machine -> MachineType -> World -> World
+--explodeMachine mc = \case
+
 destroyMcType :: MachineType -> Machine -> World -> World
 destroyMcType mt mc w = case mt of
     McTurret tu _ -> fromMaybe w $ do

src/Dodge/Machine/Draw.hs

@@ -1,4 +1,4 @@
-module Dodge.Machine.Draw (drawMachine) where
+module Dodge.Machine.Draw (drawMachine,mcColor) where
 
 import Control.Lens
 import qualified Data.Map.Strict as M
@@ -16,7 +16,6 @@ import ShapePicture
 
 drawMachine :: CWorld -> Machine -> SPic
 drawMachine cw mc = case _mcType mc of
-    McStatic -> mempty
     McTerminal -> terminalSPic lw mc
     McTurret tu _ -> drawBaseMachine 20 mc <> drawTurret lw tu mc
     McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se
@@ -82,7 +81,6 @@ drawBaseMachine h mc =
 
 mcColor :: Machine -> Color
 mcColor mc = case mc ^. mcType of
-    McStatic -> blue
     McTerminal -> dark magenta
     McDamSensor{} -> yellow
     McProxSensor{} -> aquamarine

src/Dodge/Machine/Update.hs

@@ -31,7 +31,6 @@ updateMachine mc = mcPlaySound mc . mcTypeUpdate mc (_mcType mc)
 
 mcTypeUpdate :: Machine -> MachineType -> World -> World
 mcTypeUpdate mc = \case
-    McStatic -> id
     McTerminal -> terminalScreenGlow mc
     McTurret tu _ -> updateTurret (_tuTurnSpeed tu) mc
     McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc
@@ -152,7 +151,6 @@ mcPlaySound mc w = fromMaybe w $ do
 
 mcBackgroundSound :: Machine -> Maybe (SoundID,Float)
 mcBackgroundSound mc = case mc ^. mcType of
-    McStatic -> Nothing
     McTerminal -> Just (fridgeHumS,1)
     McTurret{} -> Just (fridgeHumS,1)
     McDamSensor{} -> Just (fridgeHumS,1)

src/Dodge/Material/Damage.hs

@@ -56,6 +56,7 @@ damageStone dm ecw w = case dm of
         Poison{} -> f 0  id
         Enterrement{} -> f 0  id
         Flashing{} -> f 0  id
+        Inertial{} -> f 0 id
   where
     f x g = (x, g w)
     dmam = dm ^. dmAmount
@@ -105,7 +106,8 @@ damagePhotovoltaic dm ecw w = case dm of
         Electrical{} -> f 0  id
         Poison{} -> f 0  id
         Enterrement{} -> f 0  id
-        Flashing{} -> f 0  id
+        Flashing{} -> f (10*dmam)  id
+        Inertial{} -> f 0 id
   where
     f x g = (x, g w)
     dmam = dm ^. dmAmount
@@ -138,6 +140,7 @@ damageMetal dm ecw w = case dm of
         Poison{} -> f 0  id
         Enterrement{} -> f 0  id
         Flashing{} -> f 0  id
+        Inertial{} -> f 0 id
   where
     f x g = (x, g w)
     dmam = dm ^. dmAmount
@@ -178,6 +181,7 @@ damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
     Poison{} -> id
     Enterrement{} -> id
     Flashing{} -> id
+    Inertial{} -> id
   where
     randsound p xs =
         let (x, g) = runState (takeOne xs) $ _randGen w
@@ -204,6 +208,7 @@ damageDirt dm _ w =
         Poison{} -> id
         Enterrement{} -> id
         Flashing{} -> id
+        Inertial{} -> id
   where
     randsound p xs =
         let (x, g) = runState (takeOne xs) $ _randGen w
@@ -231,6 +236,7 @@ damageGlass dm ecw w = case dm of
         Poison{} -> f 0  id
         Enterrement{} -> f 0  id
         Flashing{} -> f 0  id
+        Inertial{} -> f 0  id
   where
     f x g = (x, g w)
     dmam = dm ^. dmAmount
@@ -295,6 +301,7 @@ damageCrystal dm ecw w = case dm of
         Poison{} -> f   id
         Enterrement{} -> f   id
         Flashing{} -> f   id
+        Inertial{} -> f id
   where
     f g = (0, g w)
     rdir p t = argV $ reflectIn v t

src/Dodge/Path.hs

@@ -2,6 +2,7 @@
 module Dodge.Path (
     nodesNear,
     pointTowardsImpulse,
+    pointTowardsImpulse',
     makePathBetween,
     makePathBetweenPs,
     obstructPathsCrossing,
@@ -10,6 +11,7 @@ module Dodge.Path (
     snapToGrid,
     pairsToIncGraph,
     getEdgesCrossing,
+    pathEdgeObstructed,
 ) where
 
 import Dodge.WorldEvent.ThingsHit
@@ -60,15 +62,38 @@ makePathUsing t s e w = do
         . IM.filter (^. seObstacles . to t) $ w ^?! cWorld . incGraph . ix i
     getn i = w ^?! cWorld . incNode . ix i
 
+makePathUsing' :: (Point2 -> Point2 -> World -> Bool) 
+    -> (Set.Set EdgeObstacle -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
+makePathUsing' t1 t2 s e w = do
+    na <- nodeNear t1 w s
+    nb <- nodeNear t1 w e
+    let h i = distance (getn nb) (getn i)
+    (na :) . snd <$> AS.aStarAssoc getes h (== nb) na
+  where
+    getes i = IM.toList 
+        . IM.map (^. seDist)
+        . IM.filter (^. seObstacles . to t2) $ w ^?! cWorld . incGraph . ix i
+    getn i = w ^?! cWorld . incNode . ix i
+
+
+
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween = makePathUsing $ not . pathEdgeObstructed
 
+makePathBetween' :: (Point2 -> Point2 -> World -> Bool) -> (Set.Set EdgeObstacle -> Bool)
+    -> Point2 -> Point2 -> World -> Maybe [Int]
+makePathBetween' = makePathUsing'
+
 pathEdgeObstructed :: Set.Set EdgeObstacle -> Bool
 pathEdgeObstructed pe = any (`Set.member` pe) [WallObstacle WallNotAutoOpen, ChasmObstacle]
 
 walkableNodeNear :: World -> Point2 -> Maybe Int
 {-# INLINE walkableNodeNear #-}
 walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear w p
+
+nodeNear :: (Point2 -> Point2 -> World -> Bool) -> World -> Point2 -> Maybe Int
+{-# INLINE nodeNear #-}
+nodeNear t w p = fmap fst . find (flip (t p) w . snd) $ nodesNear w p
 --  where
 --    nodesNear = zonesExtract (w ^. incNodeZoning) . snailAround $ zoneOfPoint pnZoneSize p
 
@@ -87,10 +112,18 @@ smallSnailInt2 =
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
 makePathBetweenPs a b w = fmap (`getNodePos` w) <$> makePathBetween a b w
 
+makePathBetweenPs' :: (Point2 -> Point2 -> World -> Bool) -> (Set.Set EdgeObstacle -> Bool)
+  ->Point2 -> Point2 -> World -> Maybe [Point2]
+makePathBetweenPs' t1 t2 a b w = fmap (`getNodePos` w) <$> makePathBetween' t1 t2 a b w
+
 -- assumes that pathfinding is symmetric
 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
 pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs b a w
 
+pointTowardsImpulse' ::  (Point2 -> Point2 -> World -> Bool) -> (Set.Set EdgeObstacle -> Bool)
+    -> Point2 -> Point2 -> World -> Maybe Point2
+pointTowardsImpulse' t1 t2 a b w = find (flip (t1 a) w) =<< makePathBetweenPs' t1 t2 b a w
+
 pairsToIncGraph ::
     Set.Set (Point2, Point2) ->
     ( UV.Vector Point2

src/Dodge/Placement/Instance/Button.hs

@@ -119,7 +119,7 @@ putLitButOnPosExtTrig' col thePS cnt =
                             <&> plSpot
                                 .~ _plSpot plmnt
   where
-    buteff i j = SetTriggerAndSetLSCol True i (V3 0 0.5 0) j
+    buteff i = SetTriggerAndSetLSCol True i (V3 0 0.5 0)
     shp = fmap (fmap $ colorSH col) aShape
     trigid tp = fromJust $ _plMID tp
     ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50

src/Dodge/Placement/Instance/Creature.hs

@@ -6,4 +6,5 @@ import Dodge.Data.GenWorld
 import RandomHelp
 
 randC1 :: PSType
-randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit
+randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 hoverCrit
+--randC1 = RandPS $ takeOne $ map PutCrit [hoverCrit]

src/Dodge/Placement/Instance/LightSource.hs

@@ -14,9 +14,11 @@ module Dodge.Placement.Instance.LightSource (
     spanColLightBlackI,
     spanLightI,
     spanLightY,
+    spanLightL,
     mntLightLnkCond',
     spanLS,
     mntLightLnkShape,
+    spanColLightI,
 ) where
 
 import Color
@@ -178,6 +180,15 @@ spanLightY l x y z =
     f p = putShape $ thinHighBar h p (l + normalize (l-p))
     h = 95
 
+spanLightL :: Point2 -> Point2 -> Point2 -> Placement
+spanLightL l x y = 
+    ps0j (PutLS $ lsColPos 0.75 (addZ (h -5) l)) $
+        ps0j (f x) $
+        sps0 (f y)
+  where
+    f p = putShape $ thinHighBar h p (l + normalize (l-p))
+    h = 95
+
 --extendAway :: Point2 -> Point2 -> Point2
 --extendAway p x = p +.+ squashNormalizeV (p -.- x)
 

src/Dodge/Placement/Instance/Sensor.hs

@@ -9,15 +9,16 @@ import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LightSource
 import Geometry
+import qualified Data.IntMap.Strict as IM
 
 damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
     \lsid ->
         psPtJpl ps $
             PutMachine
-                (reverse $ square wdth)
                 ( defaultMachine
-                    & mcMaterial .~ mattype
+                    & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square wdth)
+                    & mcSkin .~ mattype
                     & mcMounts . at OTTrigger .~ mtrid
                     & mcMounts . at OTLightSource ?~ lsid
                     & mcType .~ McDamSensor (DamSensor 0 dt)

src/Dodge/Placement/Instance/Terminal.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Terminal (
     putTerminal,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Data.GenWorld
 import Dodge.Default
@@ -29,9 +30,9 @@ putTerminalFull f mc tm =
                 \btpl -> Just $
                     pt0
                         ( PutMachine
-                            (reverse $ square 10)
                             ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                 & mcMounts . at OTTerminal .~ _plMID tmpl
+                                & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
                             )
                             Nothing
                         )

src/Dodge/Placement/Instance/Turret.hs

@@ -1,5 +1,4 @@
-module Dodge.Placement.Instance.Turret 
+module Dodge.Placement.Instance.Turret (putLasTurret) where
-    (putLasTurret) where
 
 import Dodge.Item.Held.BatteryGuns
 import Dodge.Data.GenWorld
@@ -7,6 +6,7 @@ import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
 import Geometry
 import LensHelp
+import qualified Data.IntMap.Strict as IM
 
 --putTurret :: Item -> Float -> Placement
 --putTurret itm rotSpeed =
@@ -24,8 +24,8 @@ putLasTurret :: Float -> Placement
 putLasTurret rotSpeed =
     sps0 $
         PutMachine
-            (reverse $ square 10)
             ( defaultMachine
+                    & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
 --                & mcColor .~ blue
                 & mcType .~ (lasTurret & mctTurret . tuTurnSpeed .~ rotSpeed)
                 & mcHP .~ 1500

src/Dodge/Placement/PlaceSpot.hs

@@ -10,7 +10,6 @@ module Dodge.Placement.PlaceSpot (placeSpot) where
 import Control.Monad.Trans.State.Lazy
 import Data.Bifunctor
 import Data.Foldable
-import qualified Data.IntSet as IS
 import Data.Maybe
 import qualified Data.Set as S
 import Dodge.Base.NewID
@@ -111,23 +110,13 @@ placeSpotID rid ps pt w = case pt of
         let i = IM.newKey (w ^. gwWorld . cWorld . lWorld . items)
          in ( i
             , w
-                & gwWorld
+                & gwWorld . cWorld . lWorld . floorItems . at i ?~ FlIt p rot
-                . cWorld
+                & gwWorld . cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor)
-                . lWorld
-                . floorItems
-                . at i
-                ?~ FlIt p rot
-                & gwWorld
-                . cWorld
-                . lWorld
-                . items
-                . at i
-                ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor)
             )
     PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs ->
         (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
-    PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
+    PutMachine mc mitm -> plMachine (mc & mcPos .~ p & mcDir .~ rot) mitm w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" -- evaluateRandPS rid rgn ps w
     PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
@@ -162,7 +151,6 @@ placeChasm rid ps shiftps cfs =
         . (genRooms . ix rid . rmPos %~ filter (\rp -> not $ any (pointInPoly (_rpPos rp)) ps))
         . (gwWorld %~ f)
   where
-    -- f w = foldl' g w (loopPairs shiftps)
     f w = foldl' g w cfs
     g w (x, y) = obstructPathsCrossing (S.singleton ChasmObstacle) x y w
 
@@ -188,32 +176,35 @@ mvCr p rot = (crPos . _xy .~ p) . (crOldPos . _xy .~ p) . (crDir .~ rot)
 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +) . rotateV a))
 
-plMachine ::
+plMachine :: Machine -> Maybe Item -> GenWorld -> (Int, GenWorld)
-    [Point2] ->
+plMachine mc mitm gw =
-    Machine ->
-    Maybe Item ->
-    Point2 ->
-    Float ->
-    GenWorld ->
-    (Int, GenWorld)
-plMachine wallpoly mc mitm p rot gw =
     ( mcid
     , gw
-        & tolw
+        & tolw . machines . at mcid ?~ themc
-        . machines
+        & tolw %~ maybe id placeturretitm mitm
-        . at mcid
+        & gwWorld %~ addwalls
-        ?~ themc
-        & gwWorld
-        %~ placeMachineWalls (_mcMaterial mc) wallpoly mcid wlid
-        & tolw
-        %~ maybe id placeturretitm mitm
     )
   where
+    p = mc ^. mcPos
+    rot = mc ^. mcDir
+    addwalls =
+        insertStructureWalls
+            MachinePart
+            wl
+            (map fst pps & each %~ shiftPointBy (p,rot))
+            mcid
+            wlid
+    pps = IM.elems $ mc ^. mcFootPrint
+    wl = 
+        defaultMachineWall
+            & wlStructure . wsMachine .~ mcid
+            & wlMaterial .~ (mc ^. mcSkin)
     tolw = gwWorld . cWorld . lWorld
     mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
     wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
-    wlids = IS.fromList $ take (length wallpoly) [wlid ..]
+    themc = mc
-    themc = mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
+        & mcID .~ mcid
+        & mcFootPrint .~ IM.fromDistinctAscList (zip [wlid..] pps)
     placeturretitm itm =
         (items . at itid ?~ itm')
             . (machines . ix mcid . mcType . mctTurret . tuWeapon .~ itid)
@@ -221,16 +212,5 @@ plMachine wallpoly mc mitm p rot gw =
         itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
         itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
 
-placeMachineWalls :: Material -> [Point2] -> Int -> Int -> World -> World
-placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly mcid
-  where
-    baseWall =
-        defaultMachineWall
-            & wlStructure
-            . wsMachine
-            .~ mcid
-            & wlMaterial
-            .~ mat
-
 mvLS :: Point2 -> Float -> LightSource -> LightSource
 mvLS x rot = lsParam . lsPos . _xy %~ ((+ x) . rotateV rot)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -9,11 +9,7 @@ import Dodge.ShiftPoint
 import qualified IntMapHelp as IM
 import LensHelp
 
-plDoor ::
+plDoor :: Door -> Wall -> GenWorld -> (Int, GenWorld)
-    Door ->
-    Wall ->
-    GenWorld ->
-    (Int, GenWorld)
 plDoor dr wl gw = 
     ( drid
     , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ newdr

src/Dodge/Prop/Draw.hs

@@ -12,12 +12,17 @@ import Picture
 import qualified Quaternion as Q
 import Shape
 import ShapePicture
+import Linear
 
 debrisSPic :: Debris -> SPic
-debrisSPic db = translateSP (_dbPos db) . overPosSP (Q.rotate (_dbRot db)) $
+debrisSPic db = translateSP (_dbPos db & _z +~ 1) . overPosSP (Q.rotate (_dbRot db)) $
     case db ^. dbType of
         Gib x col -> noPic $ drawGib x col
         BlockDebris m -> noPic . colorSH m $ cubeShape 4
+        MetalDebris c -> noPic . colorSH c $ upperBox Small Undesired 1 jagshape
+        GlassDebris -> noPic . colorSH azure $ upperPrismPoly Small Undesired 1 jagshape
+  where
+    jagshape = [0, V2 8 0, V2 6 3] & each -~ V2 4 1.5
 
 propSPic :: Prop -> SPic
 propSPic pr =

src/Dodge/Prop/Gib.hs

@@ -1,5 +1,7 @@
-module Dodge.Prop.Gib (addCrGibs) where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Prop.Gib (makeCrGibs) where
 
+import Dodge.Creature.Material
 import Linear
 import Color
 import Control.Monad
@@ -14,32 +16,33 @@ import LensHelp
 import qualified Quaternion as Q
 import RandomHelp
 
-addCrGibs :: Creature -> World -> World
+makeCrGibs :: Creature -> World -> World
-addCrGibs cr = case damageDirection $ _crDamage cr of
+makeCrGibs cr = case damageDirection $ _crDamage cr of
     Nothing ->
-        addGibAt (_skinHead skin) (cpos & _z +~ 25)
+        addGibAt mat (_skinHead skin) (cpos & _z +~ 25)
-            . addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
+            . addGibsAtDir mat pi 0 3 7 (_skinLower skin) cpos
-            . addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
+            . addGibsAtDir mat pi 0 13 20 (_skinUpper skin) cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
     Just d ->
-        addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos
+        addGibsAtDir mat (pi / 4) d 3 7 (_skinLower skin) cpos
-            . addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos
+            . addGibsAtDir mat (pi / 4) d 13 20 (_skinUpper skin) cpos
-            . addGibAtDir d (_skinHead skin) (cpos & _z +~ 25)
+            . addGibAtDir mat d (_skinHead skin) (cpos & _z +~ 25)
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
-            . makeDustAt Flesh 50 cpos
+            . makeDustAt mat 50 cpos
   where
+    mat = crMaterial $ cr ^. crType
     skin = crShape $ _crType cr -- this should be cleaned up
     cpos = _crPos cr
 
 -- this is ugly because it is mostly copy-paste from addGibsAt
-addGibsAtDir :: Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World
+addGibsAtDir :: Material -> Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World
-addGibsAtDir spread dir minh maxh col p w =
+addGibsAtDir m spread dir minh maxh col p w =
-    foldl' (flip $ addGib4 p col) w (zip4 vels zspeeds quats hs)
+    foldl' (flip $ addGib4 m p col) w (zip4 vels zspeeds quats hs)
         & randGen .~ newg
   where
     (speeds, newg) = replicateM 4 (state (randomR (1, 4))) & runState $ _randGen w
@@ -49,26 +52,27 @@ addGibsAtDir spread dir minh maxh col p w =
     zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w
     quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
 
-addGib4 :: Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
+-- this should be unified with addGibAtDir
-addGib4 p col (v, zs, q, h) =
+addGib4 :: Material -> Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
+addGib4 m p col (v, zs, q, h) =
     cWorld . lWorld . debris
         .:~ DebrisChunk
             { _dbPos = p & _z +~ h
-            , _dbType = Gib 3 col
+            , _dbType = materialGib m col
             , _dbVel = v `v2z` zs
             , _dbRot = q
             , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
             }
 
-addGibAt :: Color -> Point3 -> World -> World
+addGibAt :: Material -> Color -> Point3 -> World -> World
 --addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg)
-addGibAt col p w = addGibAtDir d col p (w & randGen .~ newg)
+addGibAt m col p w = addGibAtDir m d col p (w & randGen .~ newg)
   where
     (d, newg) = randomR (0, 2 * pi) $ _randGen w
 
-addGibAtDir :: Float -> Color -> Point3 -> World -> World
+addGibAtDir :: Material -> Float -> Color -> Point3 -> World -> World
 --addGibAtDir dir h col p w =
-addGibAtDir dir col p w =
+addGibAtDir m dir col p w =
     w
         & cWorld . lWorld . debris .:~ gib
         & randGen .~ newg
@@ -82,8 +86,14 @@ addGibAtDir dir col p w =
         return $
             DebrisChunk
                 { _dbPos = p
-                , _dbType = Gib 3 col
+                , _dbType = materialGib m col
                 , _dbVel = v `v2z` zs
                 , _dbRot = q
                 , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
                 }
+
+materialGib :: Material -> Color -> DebrisType
+materialGib = \case
+    Flesh -> Gib 3
+    Metal -> MetalDebris
+    _ -> BlockDebris

src/Dodge/Render/HUD.hs

@@ -239,7 +239,7 @@ floorItemPickupInfo n itm
 -- it is probably desirable for this to crash hard for now
 yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
 yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
-    Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
+    Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
     Just (SelCloseItem i) -> fromMaybe x $ do
         j <- w ^? hud . closeItems . ix i . unNInt
         flit <- w ^? cWorld . lWorld . items . ix j
@@ -373,11 +373,9 @@ drawTerminalDisplay w cfig tid = fold $ do
             TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
             TerminalPressTo s -> (++ [(s, white)])
     return $
-        drawSelectionList terminalLDP cfig f
+        drawSelectionList (w ^. tmLDP) cfig f
             <> drawTerminalCursorLink w cfig tm
   where
-    --        <> tm ^. tmButtonID
-
     --        <> invHead cfig ("TERMINAL-" ++ show tid)
     --        <> color
     --            (withAlpha 0.5 green) -- consider integrating termScreenColor somehow

src/Dodge/Render/List.hs

@@ -49,8 +49,8 @@ ldpRect :: Config -> LDParams -> Maybe (Point2, Point2) -- (NW, SE)
 ldpRect cfig ldp = do
     (x, y) <- ldp ^? ldpBorder . _Just
     return $
-        ( V2 (-5) 5
+        ( V2 0 0
-        , V2 (10 * sf * fromIntegral x) (negate $ (20 * sf + ygap) * fromIntegral y + 5)
+        , V2 (10 * sf * fromIntegral x) (negate $ (20 * sf + ygap) * fromIntegral y)
         )
             & each +~ screenPosAbs cfig (ldp ^. ldpPos)
   where

src/Dodge/Render/Picture.hs

@@ -114,6 +114,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     OverCombCombine{} -> drawGapPlus 5
     OverCombEscape -> rotate (pi / 4) $ drawPlus 5
     OverTerminal _ ts -> drawCursorByTerminalStatus ts
+    OverTerminalBar _ -> drawDragSelect 5
     OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
     MouseGameRotate {} -> rotate a (drawVerticalDoubleArrow 5)
     OverDebug {} -> drawPlus 5 <> rotate (pi/4) (drawPlus 5)

src/Dodge/Render/ShapePicture.hs

@@ -29,7 +29,7 @@ worldSPic cfig u =
         <> foldMap' drawPlasmaBall (filtOn' _pbPos _plasmaBalls)
         <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
         <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
-        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
+        <> foldup (drawCreature w (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
         <> foldup
             (Prelude.uncurry floorItemSPic)
             ( IM.intersectionWith
@@ -108,14 +108,18 @@ drawPlasmaBall pb =
         . setLayer BloomLayer
         $ circleSolidCol green white 5
 
-drawCreature :: IM.IntMap Item -> Creature -> SPic
+drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
-drawCreature m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
+drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
     case cr ^. crType of
         _ | CrIsCorpse sp <- cr ^. crHP -> sp
         _ | null (cr ^? crHP . _HP) -> mempty
         BarrelCrit{} -> barrelShape
         LampCrit{_lampHeight = h} -> lampCrSPic h
-        _ -> basicCrPict m cr
+        ChaseCrit {} -> noPic $ drawChaseCrit w cr
+        Avatar {} -> basicCrPict m cr
+        SwarmCrit -> basicCrPict m cr
+        AutoCrit -> basicCrPict m cr
+        HoverCrit{} -> noPic $ drawHoverCrit cr
 
 barrelShape :: SPic
 barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)

src/Dodge/Room/LasTurret.hs

@@ -17,6 +17,7 @@ module Dodge.Room.LasTurret (
     storeRoomID,
 ) where
 
+import Dodge.Room.Warning
 import Dodge.Room.Modify
 import Color
 import Control.Monad
@@ -118,11 +119,9 @@ analyserByNthLink n proxreq i =
                 ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)
             )
         )
-        (atNthLnkOutShiftBy n sensorshift)
+        (byNthLink n)
         & plExternalID
         ?~ i
-  where
-    sensorshift (p, a) = ((p +.+ rotateV a (V2 (-30) (-10)), a), S.singleton UsedPosLow)
 
 analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
 analyserByDoor pr i = rmPmnts .:~ analyserByNthLink 0 pr i
@@ -400,7 +399,7 @@ lasCenRunClose1 = do
     -- (alinks,blinks) <- shufflePair (bllinks,brlinks)
     -- (alinks,blinks) <- shufflePair (bllinks,tmllink)
     lnks <- shuffle [bllinks, brlinks, tmllink, tmrlink]
-    let alinks = lnks !! 0
+    let alinks = head lnks
         blinks = lnks !! 1
     outwall <-
         takeOne

src/Dodge/Room/Link.hs

@@ -21,6 +21,7 @@ import Dodge.RoomLink
 import Dodge.ShiftPoint
 import Geometry
 import RandomHelp
+import Data.Maybe
 
 restrictRMInLinksPD :: ((Point2, Float) -> Bool) -> Room -> Room
 restrictRMInLinksPD f = rmLinks %~ restrictLinkType InLink f
@@ -37,18 +38,21 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 shiftRoomBy :: (Point2, Float) -> Room -> Room
 shiftRoomBy shift r =
     r
-        & rmPolys %~ fmap (map (shiftPointBy shift))
+        & rmPolys . each . each %~ shiftPointBy shift
-        & rmLinks %~ fmap (shiftLinkBy shift)
+        & rmLinks . each %~ shiftLinkBy shift
         & rmPath %~ S.map (shiftPathBy shift)
-        & rmBound %~ fmap (map (shiftPointBy shift))
+        & rmBound . each . each %~ shiftPointBy shift
         & rmShift %~ shiftPosDirBy shift
-        & rmFloor . tiles
+        & rmFloor . tiles . each %~ shiftTile shift
-            %~ map
+        & rmViewpoints . each %~ shiftPointBy shift
-                ( (tilePoly %~ map (shiftPointBy shift))
+
-                    . (tileZero %~ shiftPointBy shift)
+shiftTile :: Point2A -> Tile -> Tile
-                    . (tileTangentPos %~ shiftPointBy shift)
+shiftTile shift tl = tl
-                )
+    & tilePoly . each %~ shiftPointBy shift
-        & rmViewpoints %~ map (shiftPointBy shift)
+    & tileZero %~ shiftPointBy s
+    & tileTangentPos %~ shiftPointBy s
+  where
+    s = fromMaybe shift $ tl ^. tileZeroShift 
 
 moveRoomBy :: (Point2, Float) -> Room -> Room
 moveRoomBy shift r =
@@ -70,10 +74,8 @@ moveRoomBy shift r =
 shiftRoomShiftToLink :: (Point2, Float) -> (Point2, Float) -> Room -> Room
 shiftRoomShiftToLink l inlink r =
     shiftRoomShiftBy l
-        . shiftRoomShiftBy (V2 0 0, pi - a)
+        . shiftRoomShiftBy (0, pi - a)
-        $ shiftRoomShiftBy
+        $ shiftRoomShiftBy (- p, 0) r
-            (V2 0 0 -.- p, 0)
-            r
   where
     (p, a) = inlink
 

src/Dodge/Room/LongDoor.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- | Rooms containing long doors, probably with a big reveal behind them.
 module Dodge.Room.LongDoor where
 
+import Dodge.Placement.Instance.Block
 import Dodge.Base.CardinalPoint
 import Dodge.Room.Modify
 import qualified Data.IntMap.Strict as IM
@@ -95,6 +97,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
@@ -144,68 +147,163 @@ makeDumbSwitch i = defaultButton & btEvent .~ ButtonDumbSwitch i
 
 slowCrushRoom :: RandomGen g => State g Room
 slowCrushRoom = do
-    rm <- shuffleLinks =<< roomRectAutoLights 200 100
+    rm <- shuffleLinks =<< roomRectAutoLights 220 100
     let rm' = removeLights rm
             & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
-                , spanLightI (V2 200 60) (V2 165 100)
+                , spanLightI (V2 220 60) (V2 185 100)
                 ]
+    crs <- takeOne [[]
+        , [sPS (V2 200 10) (0.8* pi) randC1]
+        , [sPS (V2 200 10) (0.8* pi) randC1 , sPS (V2 210 20) (0.8* pi) randC1]
+        , [sPS (V2 200 80) pi randC1]
+        , [sPS (V2 200 80) pi randC1 , sPS (V2 210 90) pi randC1]
+        ]
     return $ rm'
-        & rmLinks %~ setOutLinks (\rl -> blcorner $ rl ^. rlType)
+        & rmBound .:~ rectNSWE 0 (-50) 0 220
-        & rmLinks %~ setInLinksByType (OnEdge West)
+        & rmLinks %~ setOutLinks (\rl -> onside East $ rl ^. rlType)
-        & rmPmnts .:~
+        & rmLinks %~ setInLinks (\rl -> onside West $ rl ^. rlType)
-         (ps0 (PutTrigger False) $ \i -> Just $
+        & rmPmnts <>~
-            pContID (apos West 5) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+         [ps0 (PutTrigger False) $ \i -> Just $
-            pContID (apos East (-5)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (apos West) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (apos East) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
         sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
         sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
-        )
+        ] <> crs
-        
   where
-    blcorner s = (OnEdge East `S.member` s && FromEdge South 0 `S.member` s)
+    onside x s = (OnEdge x `S.member` s)
-        || (OnEdge South `S.member` s && FromEdge East 0 `S.member` s)
+        || (OnEdge South `S.member` s && FromEdge x 0 `S.member` s)
+        || (OnEdge North `S.member` s && FromEdge x 0 `S.member` s)
     dr = defaultDoor
         & drUpdate .~ DoorLerp 0.01
-        & drZeroPos .~ (V2 65 (-40), 0)
+        & drZeroPos .~ (V2 75 (-40), 0)
-        & drOnePos .~ (V2 65 50, 0)
+        & drOnePos .~ (V2 75 50, 0)
-        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 35 50))
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 34 50))
     dr1 = dr
-        & drOnePos .~ (V2 135 (-40), 0)
+        & drOnePos .~ (V2 145 (-40), 0)
-        & drZeroPos .~ (V2 135 50, 0)
+        & drZeroPos .~ (V2 145 50, 0)
-    apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ V2 x 0))
+    apos edge = rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ f
+    f ps = case ps of
+        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
+        _ -> ps
     t edge rp _ = case _rpType rp of
-        UnusedLink s -> OnEdge edge `S.member` s
+        UnusedLink s -> onside edge s
         _ -> False
 
-slowCrushRoom' :: RandomGen g => State g Room
+pushCaverns :: RandomGen g => State g Room
-slowCrushRoom' = do
+pushCaverns = do
-    rm <- shuffleLinks =<< roomRectAutoLights 200 100
+    rm <- shuffleLinks . removeLights =<< roomRectAutoLights 250 100
+    iside <- takeOne [North,South]
+    oside <- takeOne [North,South]
+    crs <- takeOne [[] ]
+    l <- takeOne 
+            [ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
+            , [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
+            , [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
+            , [MountedLight (V3 20 45 50) 200 0.5 
+                , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 60 45])
+                , MountedSPic (noPic $ aBar 55 [V2 10 (-45),V2 60 (-45)])]
+            ]
+    let lts = [spanColLightI (V3 0.5 0 0) 40 (V2 5 (g iside)) (V2 10 (g iside - dorot' iside 10))
+                & plType . putLS . lsParam . lsRad .~ 30
+            ,spanColLightI (V3 0.5 0 0) 40 (V2 245 (g oside)) (V2 240 (g oside - dorot' oside 10))
+                & plType . putLS . lsParam . lsRad .~ 30]
+    return $ rm
+        & rmPolys <>~ [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside) 
+            ,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
+        & rmBound .~ 
+            rectNSWE 100 0 (-10) 260:
+            [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside) 
+            ,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
+        & rmLinks %~ setInLinks (\rl -> slinks West iside $ rl ^. rlType)
+        & rmLinks %~ setOutLinks (\rl -> slinks East oside $ rl ^. rlType)
+        & rmPmnts <>~
+         [ps0 (PutTrigger False) $ \i -> Just $
+            pContID (spos (slinks West $ cardReverse iside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (spos (slinks East $ cardReverse oside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        sps0 (PutDoor (dr & drTrigger .~ WdTrig i
+                        & drMounts .~ l) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i
+                    & drMounts .~ (l & each . moPos . _xy %~ rotateV pi)) defaultDoorWall)
+        , psPtPl (spos (slinks West $ cardReverse iside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
+        , psPtPl (spos (slinks East $ cardReverse oside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
+        ] 
+        <> lts
+        <> crs
+  where
+    dorot = \case
+        North -> id
+        _ -> fmap negate
+    dorot' = \case
+        North -> id
+        _ -> negate
+    slinks x y s = (FromEdge x 0 `S.member` s) && OnEdge y `S.member` s
+    dr = defaultDoor
+        & drUpdate .~ DoorLerp 0.005
+        & drZeroPos .~ (V2 (-5) 50, 0)
+        & drOnePos .~ (V2 145 50, 0)
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 47))
+    dr1 = dr
+        & drOnePos .~ (V2 255 50, 0)
+        & drZeroPos .~ (V2 105 50, 0)
+    f ps = case ps of
+        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 5)
+        _ -> ps
+    f' ps = case ps of
+        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 10)
+        _ -> ps
+    spos h f'' = rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f''
+    t' h rp _ = case _rpType rp of
+        UnusedLink s -> h s
+        _ -> False
+    g = \case
+        North -> 0
+        _ -> 100
+
+
+slowCrush90 :: RandomGen g => State g Room
+slowCrush90 = do
+    rm <- shuffleLinks =<< roomRectAutoLights 170 100
+    (ilinks, olinks) <- shufflePair (cornlinks,onside West)
     let rm' = removeLights rm
             & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
-                , spanLightI (V2 200 60) (V2 165 100)
+                , spanLightL (V2 120 39) (V2 170 39) (V2 120 0)
                 ]
+    crs <- takeOne [[] ]
     return $ rm'
-        & rmLinks %~ setOutLinksByType (OnEdge East)
+        & rmBound <>~ [rectNSWE 0 (-55) 0 110
-        & rmLinks %~ setInLinksByType (OnEdge West)
+            , rectNSWE 100 40 170 220
-        & rmPmnts .:~
+            ]
-         (ps0 (PutTrigger False) $ \i -> Just $
+        & rmLinks %~ setOutLinks (\rl -> olinks $ rl ^. rlType)
-            pContID (apos West 5) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        & rmLinks %~ setInLinks (\rl -> ilinks $ rl ^. rlType)
-            pContID (apos East (-5)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        & rmPmnts <>~
+         [ps0 (PutTrigger False) $ \i -> Just $
+            pContID (spos ilinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (spos olinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
         sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
         sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
-        )
+        ] <> crs
-        
   where
+    onside x s = (OnEdge x `S.member` s)
+        || (OnEdge South `S.member` s && FromEdge x 0 `S.member` s)
+        || (OnEdge North `S.member` s && FromEdge x 0 `S.member` s)
+    cornlinks s = 
+        (OnEdge South `S.member` s && FromEdge East 0 `S.member` s)
+        || (OnEdge East `S.member` s && FromEdge South 0 `S.member` s)
     dr = defaultDoor
         & drUpdate .~ DoorLerp 0.01
-        & drZeroPos .~ (V2 65 (-40), 0)
+        & drZeroPos .~ (V2 75 (-5), 0)
-        & drOnePos .~ (V2 65 50, 0)
+        & drOnePos .~ (V2 75 50, 0)
-        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 35 50))
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 34 50))
     dr1 = dr
-        & drOnePos .~ (V2 135 (-40), 0)
+        & drOnePos .~ (V2 190 70, 0)
-        & drZeroPos .~ (V2 135 50, 0)
+        & drZeroPos .~ (V2 140 70, 0)
-    apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ 5 *^ cardVec edge))
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 30 29))
-    t edge rp _ = case _rpType rp of
+    f ps = case ps of
-        UnusedLink s -> OnEdge edge `S.member` s
+        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
 
 slowDoorRoom :: RandomGen g => State g Room

src/Dodge/Room/Procedural.hs

@@ -56,6 +56,7 @@ roomRect x y xn yn =
                     , _tileZero = 0
                     , _tileTangentPos = V2 baseFloorTileSize 0
                     , _tileArrayZ = 16
+                    , _tileZeroShift = Nothing
                     }
                 ]
         , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)]

src/Dodge/Room/Room.hs

@@ -13,8 +13,11 @@ module Dodge.Room.Room (
     critsRoom,
     distributerRoom,
     critDeadEnd,
+    deadEndPSType,
+    deadEndRoom,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Linear
 import Color
@@ -258,6 +261,9 @@ critInDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) 0 randC1]
 critDeadEnd :: Room
 critDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) (pi/2) randC1]
 
+deadEndPSType :: PSType -> Room
+deadEndPSType x = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) (pi/2) x]
+
 deadEndRoom :: Room
 deadEndRoom =
     defaultRoom
@@ -435,11 +441,13 @@ distributerRoom atype aamount = do
     let mcstore = defaultMachine
             & mcMaterial .~ Metal
             & mcType .~ McStorage atype aamount
+            & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ polyCirc 4 20)
         mcdist mj = defaultMachine
             & mcMaterial .~ Metal
             & mcType .~ McDistributer mj
         store = sps (unusedOffPathAwayFromLink 50) 
-            (PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
+            --(PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
+            (PutMachine mcstore Nothing) & plExternalID ?~ i
         dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just
             in  putTerminal (mcdist mj) (defaultTerminal & tmBootLines .~ tmDistributeLines
                         & tmRebootOnAccess .~ True

src/Dodge/Room/Tutorial.hs

@@ -2,9 +2,9 @@
 
 module Dodge.Room.Tutorial where
 
-import Dodge.Room.Foreground
+import Dodge.Creature.ChaseCrit
-import Data.Foldable
 import Control.Monad
+import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Data.Maybe
@@ -26,6 +26,7 @@ import Dodge.Room.Airlock
 import Dodge.Room.Boss
 import Dodge.Room.Corridor
 import Dodge.Room.Door
+import Dodge.Room.Foreground
 import Dodge.Room.LasTurret
 import Dodge.Room.Link
 import Dodge.Room.LongDoor
@@ -55,33 +56,36 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , tToBTree "slowCrush" . return . cleatOnward <$> slowCrushRoom
-        , corDoor
         , chasmSpitTerminal
---a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--        , loadAmmoTut
---a        , corDoor
+--b        , corDoor
---a        , tToBTree "sdr" . return . cleatOnward
+--b        , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
---a            <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000)
+--b        , corDoor
---a        , --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        , chasmSpitTerminal
---a          --        --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
+--b        -- a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a          ----        , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
+--b        -- a        , corDoor
---a          --        , return $ tToBTree "door" $ return $ cleatOnward door
+--b        -- a        , tToBTree "sdr" . return . cleatOnward
---a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a            <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000)
---a          --        , tToBTree "sdr" . return . cleatOnward <$>
+--b        -- a        , --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a          --            (shuffleLinks =<< tanksPipesRoom)
+--b        -- a          --        --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
---a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a          ----        , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
---a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a          --        , return $ tToBTree "door" $ return $ cleatOnward door
---a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a          return $ tToBTree "door" $ return $ cleatOnward door
+--b        -- a          --        , tToBTree "sdr" . return . cleatOnward <$>
---a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a          --            (shuffleLinks =<< tanksPipesRoom)
---a        , tutHub
+--b        -- a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a        , chasmSpitTerminal
+--b        -- a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a          --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a        , tutLight
+--b        -- a          return $ tToBTree "door" $ return $ cleatOnward door
---a        , tutDrop
+--b        -- a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a        , tutHub
---a        ----        , AnTree $ pickupTut
+--b        -- a        , chasmSpitTerminal
---a        ----        , AnTree $ weaponTut
+--b        -- a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a        , tutLight
+--b        -- a        , tutDrop
+--b        -- a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+--b        -- a        ----        , AnTree $ pickupTut
+--b        -- a        ----        , AnTree $ weaponTut
         ]
 
 foldMTRS ::
@@ -240,8 +244,8 @@ sqPlatformChasm b a =
 sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
 sqSpitChasm b a =
     ( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
---    ( earClip clfs
+    , --    ( earClip clfs
-    , [clfs]
+      [clfs]
     )
   where
     clfs = [ibr, obr, otr, otl, obl, ibl, itl, itr]
@@ -253,6 +257,7 @@ sqSpitChasm b a =
     ibl = V2 (-b) (-a)
     itl = V2 (-b) b
     itr = V2 b b
+
 --  otl---------otr
 --  |   itl-itr   |
 --  obr-ibl ibr-obl
@@ -272,15 +277,19 @@ midChasmSpit = do
                 isMidEdgeLink r North rl
                     || isMidEdgeLink r East rl
                     || isMidEdgeLink r West rl
-            , \rl -> OnEdge North `S.member` (rl ^. rlType)
+            , \rl ->
-                && not (FromEdge East 0 `S.member` (rl ^. rlType))
+                OnEdge North `S.member` (rl ^. rlType)
-                && not (FromEdge West 0 `S.member` (rl ^. rlType))
+                    && not (FromEdge East 0 `S.member` (rl ^. rlType))
+                    && not (FromEdge West 0 `S.member` (rl ^. rlType))
             ]
     shuffleLinks $
         r
-            & rmLinks %~ setOutLinks foutlnks
+            & rmLinks
-            & rmLinks %~ setInLinks (isMidEdgeLink r South)
+            %~ setOutLinks foutlnks
-            & rmPmnts .~ cs
+            & rmLinks
+            %~ setInLinks (isMidEdgeLink r South)
+            & rmPmnts
+            .~ cs
   where
     censquare x y = do
         z <- state $ randomR (40, 60)
@@ -304,34 +313,42 @@ chasmSpitTerminal = do
         l2 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp North West
         l3 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East North
         l4 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East South
-    ls <- takeOne [[l1,l2],[l3,l4]
+    ls <-
---          ,[spanLightI (V2 120 0) (V2 120 300)]
+        takeOne
---         , [spanLightI (V2 0 128) (V2 300 128)]
+            [ [l1, l2]
---         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
+            , [l3, l4]
-        ]
+            --          ,[spanLightI (V2 120 0) (V2 120 300)]
-    gh <- takeOne [55,75,97]
+            --         , [spanLightI (V2 0 128) (V2 300 128)]
-    gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
+            --         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
-    dec <- takeOne $  replicate 3 [] <> 
-            [[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)]
-            ,[sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
-            ,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300),sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
-            ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
-            ,[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
-            ,[sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
-            ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20),sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
             ]
+    gh <- takeOne [55, 75, 97]
+    gird <- takeOne [girderZ gh 30 10, girder gh 30 10, girderV gh 30 10]
+    dec <-
+        takeOne $
+            replicate 3 []
+                <> [ [sps0 $ putShape $ gird (V2 30 0) (V2 30 300)]
+                   , [sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
+                   , [sps0 $ putShape $ gird (V2 30 0) (V2 30 300), sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
+                   , [sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
+                   , [sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
+                   , [sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
+                   , [sps0 $ putShape $ gird (V2 0 20) (V2 300 20), sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
+                   ]
     let y' = y & rmPmnts <>~ ls <> dec
     return $
         tToBTree "chasmTerm" $
             Node
                 (addDoorToggleTerminal' i1 (PS 150 0) y')
-                [ treePost [triggerDoorRoom i1, critDeadEnd]
+                [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
-                , treePost [triggerDoorRoom i1, critDeadEnd]
+                --[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
+                --[ treePost [triggerDoorRoom i1, deadEndRoom]
+                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
                 , return $ cleatOnward $ triggerDoorRoom i1
                 ]
   where
-    f rp a b = FromEdge a 2 `S.member` fold (rp ^? rpType . rplsType)
+    f rp a b =
-        && OnEdge b `S.member` fold (rp ^? rpType . rplsType)
+        FromEdge a 2 `S.member` fold (rp ^? rpType . rplsType)
+            && OnEdge b `S.member` fold (rp ^? rpType . rplsType)
 
 polyChasm :: Int -> Float -> State LayoutVars Room
 polyChasm n x =
@@ -409,6 +426,64 @@ tutLight = do
                         )
             _ -> Nothing
 
+loadAmmoTut :: State LayoutVars (MetaTree Room String)
+loadAmmoTut = do
+    i <- nextLayoutInt
+    amrm <-
+        putSingleLight
+            . analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
+            =<< shuffleLinks
+            =<< join (takeOne [roomNgon 6 80, roomRectAutoLights 100 100])
+--            =<< join (takeOne [roomNgon 6 80])
+    j <- nextLayoutInt
+    wprm <-
+        putSingleLight
+            . addDoorAtNthLinkToggleInterrupt 0 ["DOOR LOCKDOWN ACTIVE"] j
+            =<< shuffleLinks
+--            =<< roomRectAutoLights 100 100
+            =<< join (takeOne [roomNgon 6 80, roomRectAutoLights 100 100])
+--            =<< join (takeOne [roomNgon 6 80])
+    droom <- distributerRoom BulletAmmo (10 ^ (4::Int))
+    ncrits <- takeOne [1,1,2,2,2,3]
+    croom <- roomCCrits ncrits
+    return $
+        tToBTree "loadAmmoTest" $
+            treePost 
+                [ croom
+                , door
+                , amrm & rmPmnts .:~ sps (PS 50 0) (PutFlIt (drumMag & itConsumables ?~ 90))
+                , triggerDoorRoom i
+                , wprm & rmPmnts .:~ sps (PS 50 0) (PutFlIt burstRifle)
+                , triggerDoorRoom j
+                , droom
+                , door
+                , croom
+                ]
+
+putSingleLight :: Room -> State LayoutVars Room
+putSingleLight rm = do
+    f <- case rm ^. rmType of
+        DefaultRoomType -> pure id
+        RectRoomType{_rmWidth = x, _rmHeight = y, _numLinkEW = nx, _numLinkNS = ny} -> do
+            x' <-
+                if odd nx
+                    then pure $ x / 2
+                    else takeOne [x / 2 + 21, x / 2 - 21]
+            y' <-
+                if odd ny
+                    then pure $ y / 2
+                    else takeOne [y / 2 + 21, y / 2 - 21]
+            ps <-
+                takeOne
+                    [ (V2 x' 0, V2 x' y)
+                    , (V2 0 y', V2 x y')
+                    ]
+            return $ rmPmnts .:~ uncurry spanLightI ps
+        RoomNgon{_rmngonSize = x} -> do
+            y <- takeOne [21, -21]
+            return $ rmPmnts .:~ spanLightI (V2 (-x) y) (V2 x y)
+    return . f $ removeLights rm
+
 tutHub :: State LayoutVars (MetaTree Room String)
 tutHub = do
     (is, wbp) <- setTreeInts =<< critsRoom 1