Work on crab

src/Dodge/Base/Collide.hs

@@ -179,6 +179,7 @@ crHeight cr = case cr ^. crHP of
         HoverCrit {} -> 10
         ChaseCrit {} -> 25
         Avatar {} -> 25
+        CrabCrit {} -> 25
         _ -> error "Need to define crHeight for this crType"
     CrIsCorpse{} -> Just 5
     CrDestroyed{} -> Nothing

src/Dodge/Creature/Action.hs

@@ -10,6 +10,7 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import RandomHelp
 import Dodge.WorldEvent.ThingsHit
 import Control.Applicative
 import Control.Monad
@@ -45,9 +46,9 @@ performActions cid w =
         iss
   where
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    (iss, mayas) = foldMap (performAction cr w) $ cr ^. crActionPlan . apAction
+    (iss, mayas) = fromMaybe ([],NoAction) $ performAction cr w <$> cr ^? crActionPlan . apAction
 
-type ActionUpdate = ([Impulse], [Action])
+type ActionUpdate = ([Impulse], Action)
 
 {- | Performing an action on a frame creates an ActionUpdate:
   gives impulses and updates/deletes the action itself.
@@ -55,54 +56,61 @@ type ActionUpdate = ([Impulse], [Action])
 performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
     AimAt tcid p -> performAimAt cr w tcid p
-    WaitThen 0 newAc -> ([], [newAc])
+    WaitThen 0 newAc -> ([], newAc)
-    WaitThen t newAc -> ([], [WaitThen (t -1) newAc])
+    WaitThen t newAc -> ([], WaitThen (t -1) newAc)
-    ImpulsesList (xs : xss) -> (xs, [ImpulsesList xss])
+    ImpulsesList (xs : xss) a -> performAction cr w a & _1 <>~ xs
-    ImpulsesList _ -> ([], mempty)
+        & _2 %~ ImpulsesList xss
-    DoImpulses imps -> (imps, mempty)
+    ImpulsesList _ a -> performAction cr w a
-    DoActionThen fsta afta -> case performAction cr w fsta of -- NOTE this only does ONE continuation action
+    DoImpulses imps -> (imps, NoAction)
-        (imps, nxta : _) -> (imps, [DoActionThen nxta afta])
+    DoActionThen fsta afta -> case performAction cr w fsta of
-        (imps, []) -> (imps, [afta])
+        (imps, NoAction) -> (imps, afta)
+        (imps, nxta) -> (imps, DoActionThen nxta afta)
     DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
     DoActionWhilePartial partAc f resetAc
         | doWdCrBl f w cr -> case performAction cr w partAc of
-            (imps, nxta : _) -> (imps, [DoActionWhilePartial nxta f resetAc])
+            (imps, NoAction) -> (imps, DoActionWhilePartial resetAc f resetAc)
-            (imps, []) -> (imps, [DoActionWhilePartial resetAc f resetAc])
+            (imps, nxta ) -> (imps, DoActionWhilePartial nxta f resetAc)
         | otherwise -> performAction cr w partAc
     DoActionIf f ifa
         | doWdCrBl f w cr -> performAction cr w ifa
-        | otherwise -> ([], mempty)
+        | otherwise -> ([], NoAction)
     DoActionIfElse ifa f elsea
         | doWdCrBl f w cr -> performAction cr w ifa
         | otherwise -> performAction cr w elsea
     DoActionWhileInterrupt repa f afta
-        | doWdCrBl f w cr -> (fst $ performAction cr w repa, [DoActionWhileInterrupt repa f afta])
+        | doWdCrBl f w cr -> (fst $ performAction cr w repa, DoActionWhileInterrupt repa f afta)
         | otherwise -> performAction cr w afta
-    DoActions [] -> ([], mempty)
+--    DoActions [] -> ([], NoAction)
-    DoActions acs ->
+--    DoActions acs ->
-        let (imps, newAcs) = foldMap (performAction cr w) acs
+--        let (imps, newAcs) = foldMap (performAction cr w) acs
-         in (imps, newAcs)
+--         in (imps, newAcs)
-    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], mempty)
+    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
     PathTo p a -> performPathTo a cr w p
+    EvadeAim -> tryEvadeSideways cr w
     TurnToPoint p -> performTurnToA cr p
-    LeadTarget p -> fromMaybe ([], mempty) $ do
+    LeadTarget p -> fromMaybe ([], NoAction) $ do
         i <- cr ^? crIntention . targetCr . _Just
         tcr <- w ^? cWorld . lWorld . creatures . ix i
-        return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], mempty)
+        return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
     UseSelf f -> performAction cr w $ doCrAc f cr
     ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
-    DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
+    DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
-        (imp, [nxtac]) -> (sideImp ++ imp, [DoImpulsesAlongside sideImp nxtac])
-        (imp, _) -> (sideImp ++ imp, mempty)
     DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
     DoReplicatePartial _ 0 pac -> performAction cr w pac
     DoReplicatePartial startac t partac -> case performAction cr w partac of
-        (imps, [nextac]) -> (imps, [DoReplicatePartial startac t nextac])
+        (imps, NoAction) -> (imps, DoReplicatePartial startac (t -1) startac)
-        (imps, _) -> (imps, [DoReplicatePartial startac (t -1) startac])
+        (imps, nextac) -> (imps, DoReplicatePartial startac t nextac)
-    NoAction -> ([], mempty)
+    NoAction -> ([], NoAction)
+
+tryEvadeSideways :: Creature -> World -> ActionUpdate
+tryEvadeSideways _ w = jumpleft -- (mv,mempty)
+  where
+    jumpleft = (mv,DoReplicate 5 (DoImpulses mv))
+    mv = [Walk (V2 0 d)]
+    d = evalState (takeOne [3,-3]) (w ^. randGen)
 
 performAimAt :: Creature -> World -> Int -> Point2 -> ActionUpdate
-performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
+performAimAt cr w tcid p = ([TurnToward tpos aimSp], AimAt tcid tpos)
   where
     cdir = _crDir cr
     cpos = cr ^. crPos . _xy
@@ -121,20 +129,20 @@ crPathing cr = case cr ^. crStance . carriage of
 
 performPathTo :: Action -> Creature -> World -> Point2 -> ActionUpdate
 performPathTo a cr w p
-    | dist cpos p <= crRad (cr ^. crType) = mempty
+    | dist cpos p <= crRad (cr ^. crType) = (mempty,NoAction)
     | fst (crPathing cr) cpos p w = gotowards p
     | otherwise = case uncurry pointTowardsImpulse' (crPathing cr) cpos p w of
         Just q -> gotowards q
-        _ -> ([], [a])
+        _ -> ([], a)
   where
-    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p a])
+    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , PathTo p a)
     cpos = cr ^. crPos . _xy
     jit = _mvTurnJit $ crMvType cr
 
 performTurnToA :: Creature -> Point2 -> ActionUpdate
 performTurnToA cr p
-    | angleVV cdirv dirv < 0.1 = mempty
+    | angleVV cdirv dirv < 0.1 = (mempty,NoAction)
-    | otherwise = ([MvTurnToward p, RandomTurn jit], [TurnToPoint p])
+    | otherwise = ([MvTurnToward p, RandomTurn jit], TurnToPoint p)
   where
     cpos = cr ^. crPos . _xy
     cdirv = unitVectorAtAngle (_crDir cr)

src/Dodge/Creature/ArmourChase.hs

@@ -22,7 +22,7 @@ flockArmourChaseCrit =
 --                ]
         , _crActionPlan =
             ActionPlan
-                { _apAction = []
+                { _apAction = NoAction
                 , _apStrategy = FollowImpulses
                 , _apGoal = [Kill 0]
                 }

src/Dodge/Creature/ChaseCrit.hs

@@ -1,11 +1,13 @@
 module Dodge.Creature.ChaseCrit (
     smallChaseCrit,
     invisibleChaseCrit,
+    crabCrit,
     chaseCrit,
     hoverCrit,
 ) where
 
 --import Dodge.Data.Equipment.Misc
+import Dodge.Data.FloatFunction
 import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
@@ -32,6 +34,20 @@ chaseCrit =
         & crHP .~ HP 150
         & crFaction .~ ColorFaction green
 
+crabCrit :: Creature
+crabCrit = defaultCreature
+        & crName .~ "chaseCrit"
+        & crHP .~ HP 350
+        & crType .~ CrabCrit
+            { _meleeCooldownL = 0
+            , _meleeCooldownR = 0
+            , _footForward = LeftForward
+            , _strideAmount = 0
+            , _dodgeCooldown = 0
+            }
+        & crFaction .~ ColorFaction red
+        & crPerception . cpVision . viFOV .~ FloatFOV pi
+
 hoverCrit :: Creature
 hoverCrit =
     defaultCreature

src/Dodge/Creature/Impulse.hs

@@ -31,6 +31,7 @@ followImpulse cid w = \case
         soundStart (CrMouth cid) cpos sid Nothing $
             w & clens %~ resetCrVocCoolDown w
     Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
+    Walk p -> crup $ crWalk p (w ^. cWorld . lWorld)
     MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
     MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
     Turn a -> crup $ crDir +~ a

src/Dodge/Creature/Impulse/Movement.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.Impulse.Movement (
     creatureTurnTowardDir,
     crMvAbsolute,
     crMvBy,
+    crWalk,
     crMvByNoStride,
     crMvForward,
     creatureTurnTo,
@@ -27,6 +28,14 @@ crMvBy ::
     Creature
 crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
 
+crWalk ::
+    -- | Movement translation vector, will be made relative to creature direction
+    Point2 ->
+    LWorld ->
+    Creature ->
+    Creature
+crWalk p lw cr = crWalkAbsolute lw (rotateV (_crDir cr) p) cr
+
 crMvByNoStride ::
     -- | Movement translation vector, will be made relative to creature direction
     Point2 ->
@@ -43,6 +52,15 @@ crMvAbsolute lw p' cr =
   where
     p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
 
+crWalkAbsolute :: LWorld -> Point2 -> Creature -> Creature
+crWalkAbsolute lw p' cr 
+    | Walking <- cr ^. crStance . carriage = cr
+        & crPos . _xy +~ p
+        & crMvDir .~ argV (p + cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy)
+    | otherwise = cr
+  where
+    p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
+
 crMvAbsoluteNoStride :: LWorld -> Point2 -> Creature -> Creature
 crMvAbsoluteNoStride lw p' cr = cr & crPos . _xy +~ p
   where

src/Dodge/Creature/Mass.hs

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

src/Dodge/Creature/Material.hs

@@ -9,6 +9,7 @@ crMaterial :: CreatureType -> Material
 crMaterial = \case
     Avatar{_avatarMaterial = mt} -> mt
     ChaseCrit {} -> Flesh
+    CrabCrit {} -> Flesh
     HoverCrit {} -> Metal
     SwarmCrit -> Flesh
     AutoCrit -> Flesh

src/Dodge/Creature/MaxHP.hs

@@ -7,6 +7,7 @@ crMaxHP :: CreatureType -> Int
 crMaxHP = \case
     Avatar {} -> 15000
     ChaseCrit {} -> 150
+    CrabCrit {} -> 350
     HoverCrit {} -> 100
     SwarmCrit -> 50
     AutoCrit -> 100

src/Dodge/Creature/MoveType.hs

@@ -7,8 +7,9 @@ import Control.Lens
 crMvType :: Creature -> CrMvType
 crMvType cr = case _crType cr of
     Avatar {} -> MvWalking 1.5
-    ChaseCrit {} -> defaultChaseMvType
+    ChaseCrit {} -> defaultChaseMvType & mvSpeed .~ 1.8
-    HoverCrit {} -> defaultChaseMvType & mvSpeed .~ 0.15
+    CrabCrit {} -> defaultChaseMvType & mvSpeed .~ 0.5
+    HoverCrit {} -> defaultChaseMvType & mvSpeed .~ 0.16
     SwarmCrit -> defaultChaseMvType
     AutoCrit -> defaultAimMvType
     BarrelCrit {} -> defaultAimMvType

src/Dodge/Creature/Perception.hs

@@ -21,12 +21,8 @@ import Linear
 import RandomHelp
 import Sound.Data
 
-perceptionUpdate ::
+-- | The [Int] is a list of creature ids that may direct attention and awareness
-    -- | List of creature ids that may direct attention and awareness
+perceptionUpdate :: [Int] -> World -> Creature -> Creature
-    [Int] ->
-    World ->
-    Creature ->
-    Creature
 perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate w . basicAttentionUpdate is w
 
 {- | Update a creatures awareness based upon the creatures' current direction
@@ -55,9 +51,9 @@ basicAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
             return $
                 (crActionPlan . apStrategy .~ WarningCry) . 
                 (crActionPlan . apAction
-                    .~ [ImpulsesList (crImpulsesOnCognizant w cr)
+                    .~ ImpulsesList (crImpulsesOnCognizant w cr)
-                        , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
+                        (AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy))
-                        ])
+                )
 
 crImpulsesOnCognizant :: World -> Creature -> [[Impulse]]
 crImpulsesOnCognizant w cr = case cr ^. crType of
@@ -65,6 +61,7 @@ crImpulsesOnCognizant w cr = case cr ^. crType of
         <> [[ChangeStrategy $ CloseToMelee 0]]
     HoverCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]:
           [[ChangeStrategy $ CloseToMelee 0]]
+    CrabCrit {} -> [[ChangeStrategy $ CloseToMelee 0]]
     _ | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 1]
     _ -> replicate 5 [RandomImpulse $ RandImpulseCircMove 3]
 

src/Dodge/Creature/Picture.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
     deadFeet,
     drawChaseCrit,
     drawHoverCrit,
+    drawCrabCrit,
 ) where
 
 import Dodge.Base.Collide
@@ -65,6 +66,14 @@ drawHoverCrit cr = colorSH (_skinHead cskin)
     f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
     tpq = (V3 0 0 0, Q.qid)
 
+drawCrabCrit :: World -> Creature -> Shape
+drawCrabCrit w cr = mconcat 
+    [ crabUpperBody w cr
+    , colorSH (_skinLower cskin) $ crabFeet cr
+    ]
+  where
+    cskin = crShape $ _crType cr
+
 drawChaseCrit :: World -> Creature -> Shape
 drawChaseCrit w cr = mconcat 
     [ chaseUpperBody w cr
@@ -74,6 +83,16 @@ drawChaseCrit w cr = mconcat
     cskin = crShape $ _crType cr
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
+crabUpperBody :: World -> Creature -> Shape
+crabUpperBody _ cr =  colorSH (_skinUpper cskin)
+    (overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 12 
+        & each . _x *~ 0.6) 
+    )
+  where
+    torsoq = (V3 0 0 10,Q.qid)
+    cskin = crShape $ _crType cr
+    
+
 chaseUpperBody :: World -> Creature -> Shape
 chaseUpperBody w cr =  colorSH (_skinUpper cskin)
     (overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI tz $ polyCirc 3 12 
@@ -126,6 +145,20 @@ feet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
 --    f i = 8 * (sLen - 2*i) / sLen
     f i = 8 * oneSmooth ((sLen - 2*i) / sLen)
 
+crabFeet :: Creature -> Shape
+{-# INLINE crabFeet #-}
+crabFeet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
+    (Just sa,Just LeftForward) -> sh (f sa)
+    (Just sa,Just RightForward) -> sh (-f sa)
+    _ -> sh 0
+  where
+    sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
+    aFoot = upperPrismPolyST 10 $ polyCirc 3 2
+    off = 10
+    sLen = strideLength cr
+--    f i = 8 * (sLen - 2*i) / sLen
+    f i = 8 * oneSmooth ((sLen - 2*i) / sLen)
+
 deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
 deadFeet = feet

src/Dodge/Creature/Radius.hs

@@ -9,6 +9,7 @@ crRad :: CreatureType -> Float
 crRad = \case
     Avatar {} -> 10
     ChaseCrit {} -> 10
+    CrabCrit {} -> 10
     HoverCrit {} -> 8
     SwarmCrit -> 2
     AutoCrit -> 10

src/Dodge/Creature/ReaderUpdate.hs

@@ -1,6 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.ReaderUpdate (
     doStrategyActions,
-    setTargetMv,
     targetYouWhenCognizant,
     overrideMeleeCloseTarget,
     watchUpdateStrat,
@@ -9,11 +9,13 @@ module Dodge.Creature.ReaderUpdate (
 --    goToTarget,
     flockACC,
     chaseCritMv,
-    setMvPos,
+    crabCritMv,
+    setMvPosToTargetCr,
     setViewPos,
     hoverCritMv,
 ) where
 
+import Dodge.WorldEvent.ThingsHit
 import Control.Applicative
 import Control.Monad
 import Data.Bifunctor
@@ -45,19 +47,18 @@ tryMeleeAttack cr tcr
         && dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
         && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
         cr & crActionPlan . apAction
-                .~ [ DoImpulses [Melee $ _crID tcr] `DoActionThen`
+                .~ DoImpulses [Melee $ _crID tcr] `DoActionThen`
                         DoReplicate 10 NoAction
-                        `DoActionThen` DoImpulses
+--                        `DoActionThen` DoImpulses
-                            [ChangeStrategy (CloseToMelee $ _crID tcr)]
+--                            [ChangeStrategy (CloseToMelee $ _crID tcr)]
-                   ]
+--            & crActionPlan . apStrategy .~ MeleeStrike
-            & crActionPlan . apStrategy .~ MeleeStrike
     | otherwise = cr
   where
     cpos = cr ^. crPos . _xy
     tpos = tcr ^. crPos . _xy
 
-setMvPos :: World -> Creature -> Creature
+setMvPosToTargetCr :: World -> Creature -> Creature
-setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
+setMvPosToTargetCr w cr = cr & crIntention . mvToPoint .~ mpos
   where
     int = _crIntention cr
     mtpos = do
@@ -81,17 +82,17 @@ attentionViewPoint w cr = do
     guard $ visionCheck cr (tcr ^. crPos . _xy) > 0
     tcr ^? crPos . _xy
 
-setTargetMv ::
+--setTargetMv ::
-    -- | Function for determining target
+--    -- | Function for determining target
-    (World -> Creature -> Maybe Creature) ->
+--    (World -> Creature -> Maybe Creature) ->
-    World ->
+--    World ->
-    Creature ->
+--    Creature ->
-    Creature
+--    Creature
-setTargetMv targFunc w cr =
+--setTargetMv targFunc w cr =
-    maybe
+--    maybe
-        cr
+--        cr
-        (\ctarg -> cr & crIntention . mvToPoint ?~ (ctarg ^. crPos . _xy))
+--        (\ctarg -> cr & crIntention . mvToPoint ?~ (ctarg ^. crPos . _xy))
-        (targFunc w cr)
+--        (targFunc w cr)
 
 -- ugly
 flockACC :: World -> Creature -> Creature
@@ -120,48 +121,109 @@ flockACC w cr = fromMaybe cr $ do
                             else negate r *.* horDir
                  in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
 
+crabCritMv :: World -> Creature -> Creature
+crabCritMv w cr = case _apStrategy (_crActionPlan cr) of
+    _ | Just tid <- melee -> cr & crActionPlan . apAction 
+                .~ DoImpulses [Melee tid] `DoActionThen`
+                        DoReplicate 10 NoAction
+        & crType . meleeCooldownL .~ 20
+    WarningCry -> cr
+    CloseToMelee tid | aimi tid -> cr & crActionPlan . apAction .~ EvadeAim
+        & crType . dodgeCooldown .~ dc
+    CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> cr
+    Wander | Just tid <- cr ^? crIntention . targetCr . _Just
+        , canSee tid (cr ^. crID) w -> cr & crActionPlan . apStrategy .~ CloseToMelee tid
+    _ -> 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 .~ Search
+                    & crIntention . mvToPoint .~ Nothing
+        _ -> viewTarget w cr
+  where
+    melee = do
+        tid <- cr ^? crIntention . targetCr . _Just
+        tcr <- w ^? cWorld . lWorld . creatures . ix tid
+        let cpos = cr ^. crPos . _xy
+            tpos = tcr ^. crPos . _xy
+        guard $ _meleeCooldownL (_crType cr) == 0
+            && Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
+            && dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4
+        return tid
+    dc = fst $ randomR (15,25) (w ^. randGen)
+    notpath = \case
+        Just NoAction -> False
+        Just PathTo {} -> False
+        Just AimAt {} -> False
+        _ -> True
+    aimi tid = fromMaybe False $ do
+        tcr <- w ^? cWorld . lWorld . creatures . ix tid
+        Aiming <- tcr ^? crStance . posture
+        let txy = tcr ^. crPos . _xy
+            cxy = cr ^. crPos . _xy
+        0 <- cr ^? crType . dodgeCooldown
+        return $ hasLOS cxy txy w
+            && abs (nearZeroAngle (tcr^.crDir - argV (cxy - txy))) < 0.3
+            && isWalkable txy cxy w  
+            && diffAngles (cr ^. crDir) (argV (txy - cxy)) < 0.1
+
 chaseCritMv :: World -> Creature -> Creature
 chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
     WarningCry -> cr
-    MeleeStrike -> cr
     CloseToMelee cid
         | VocReady == (cr ^. crVocalization) ->
             cr
                 & crActionPlan . apAction
-                    .:~ ImpulsesList
+                    .~ ImpulsesList
                         ( [Bark soundid] :
                           replicate numjits [RandomImpulse thejitter]
                             ++ [[ChangeStrategy (CloseToMelee cid)]]
-                        )
+                        ) NoAction
                 & resetCrVocCoolDown w
                 & crActionPlan . apStrategy .~ WarningCry
       where
         thejitter = RandImpulseCircMove 3
         soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
         numjits = fst $ randomR (15, 25) (_randGen w)
+    CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> 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])]
+                cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
             | otherwise ->
-                cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
+                cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
                     & crActionPlan . apStrategy .~ WatchAndWait
                     & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
+  where
+    notpath = \case
+        Just NoAction -> False
+        Just PathTo {} -> False
+        Just AimAt {} -> False
+        _ -> True
 
 hoverCritMv :: World -> Creature -> Creature
 hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
     WarningCry -> cr
-    MeleeStrike -> cr
+    CloseToMelee _ | ma <- cr ^? crActionPlan . apAction , notpath ma -> 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])]
+                cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
             | otherwise ->
-                cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
+                cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
                     & crActionPlan . apStrategy .~ WatchAndWait
                     & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
+  where
+    notpath = \case
+        Just NoAction -> False
+        Just PathTo {} -> False
+        Just AimAt {} -> False
+        _ -> True
 
 --goToTarget :: World -> Creature -> Creature
 --goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of
@@ -173,23 +235,25 @@ viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
     Just p
         | hasLOSIndirect p (cr ^. crPos . _xy) w ->
             cr
-                & crActionPlan . apAction .~ [TurnToPoint p]
+                & crActionPlan . apAction .~ TurnToPoint p
                 & crIntention . viewPoint .~ Nothing
                 & crActionPlan . apStrategy .~ Investigate
         | otherwise ->
-            cr & crActionPlan . apAction %~ replaceNullWith (PathTo p (DoImpulses [ChangeStrategy Wander]))
+--            cr & crActionPlan . apAction %~ replaceNullWith (PathTo p (DoImpulses [ChangeStrategy Wander]))
+            cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
                 & crActionPlan . apStrategy .~ Investigate
     Nothing -> cr
 
-replaceNullWith :: a -> [a] -> [a]
+--replaceNullWith :: a -> [a] -> [a]
-replaceNullWith x [] = [x]
+--replaceNullWith x [] = [x]
-replaceNullWith _ xs = xs
+--replaceNullWith _ xs = xs
 
 doStrategyActions :: Creature -> Creature
 doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
     Just (StrategyActions strat acs) ->
         cr
-            & crActionPlan . apAction .~ acs
+--            & crActionPlan . apAction .~ acs
+            & crActionPlan . apAction .~ head acs
             & crActionPlan . apStrategy .~ strat
     _ -> cr
 

src/Dodge/Creature/Shape.hs

@@ -9,6 +9,7 @@ crShape :: CreatureType -> CreatureShape
 crShape = \case
     Avatar{} -> Humanoid (greyN 0.9) (lightx4 black) (greyN 0.3)
     ChaseCrit {} -> Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3)
+    CrabCrit {} -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3)
     HoverCrit {} -> Humanoid (greyN 0.9) (light blue) (greyN 0.3)
     SwarmCrit -> Humanoid (greyN 0.9) (lightx4 yellow) (greyN 0.3)
     AutoCrit -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3)

src/Dodge/Creature/Statistics.hs

@@ -25,6 +25,7 @@ crDexterity cr = case cr ^. crType of
     AutoCrit -> 46
     BarrelCrit {} -> 0
     LampCrit {} -> 0
+    _ -> 46
 
 crStrength :: Creature -> Int
 crStrength cr = case cr ^. crType of
@@ -35,11 +36,13 @@ crStrength cr = case cr ^. crType of
     AutoCrit -> 46
     BarrelCrit {} -> 0
     LampCrit {} -> 0
+    _ -> 46
 
 crIntelligence :: Creature -> Int
 crIntelligence  cr = case cr ^. crType of
     Avatar { _avIntelligence = x } -> x
     ChaseCrit {} -> 20
+    CrabCrit {} -> 20
     HoverCrit {} -> 20
     SwarmCrit -> 20
     AutoCrit -> 20

src/Dodge/Creature/Update.hs

@@ -54,6 +54,9 @@ updateLivingCreature cr =
         ChaseCrit{} -> \w ->
             crUpdate cid . performActions cid $
                 over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
+        CrabCrit{} -> \w ->
+            crUpdate cid . performActions cid $
+                over (cWorld . lWorld . creatures . ix cid) (crabCritInternal w) w
         AutoCrit {} -> crUpdate cid
         SwarmCrit {} -> crUpdate cid
         HoverCrit {} -> \w ->

src/Dodge/Creature/Vocalization.hs

@@ -26,6 +26,7 @@ crWarningSounds cr = case cr ^. crType of
         , seagullCry1S
         , seagullCry2S
         ]
+    CrabCrit {} -> mempty
     HoverCrit {} -> mempty
     SwarmCrit -> mempty
     AutoCrit -> mempty
@@ -36,6 +37,7 @@ crDeathSounds :: Creature -> DeathType -> [SoundID]
 crDeathSounds cr dt = case cr ^. crType of
     Avatar{} -> mempty
     ChaseCrit{} -> defaultDeathSounds dt
+    CrabCrit{} -> defaultDeathSounds dt
     HoverCrit{} -> hoverDeathSounds dt
     SwarmCrit -> mempty
     AutoCrit -> mempty

src/Dodge/Creature/Volition.hs

@@ -34,5 +34,5 @@ shootFirstMiss :: Action
 shootFirstMiss =
     LeadTarget (V2 30 50)
         `DoActionThen` DoImpulses [UseItem]
-        `DoActionThen` (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0), DoImpulses [UseItem]])
+--        `DoActionThen` (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0), DoImpulses [UseItem]])
         `DoActionThen` 20 `WaitThen` holsterWeapon

src/Dodge/Data/ActionPlan.hs

@@ -15,7 +15,7 @@ data ActionPlan
     = Inanimate
     | ActionPlan
         { -- _apImpulse :: [Impulse] -- done per frame
-         _apAction :: [Action] -- updated per frame, likely persist across frames
+         _apAction :: Action -- updated per frame, likely persist across frames
         , _apStrategy :: Strategy -- current strategy
         , _apGoal :: [Goal] -- particular ordered goals
         }
@@ -24,6 +24,7 @@ data ActionPlan
 
 data Impulse
     = Move Point2
+    | Walk Point2
     | MoveForward Float
     | MoveNoStride Point2
     | Turn Float
@@ -68,8 +69,9 @@ data Action
         , _targetSeenAt :: Point2
         }
     | PathTo { _pathToPoint :: Point2, _pathFailAction :: Action }
+    | EvadeAim
     | TurnToPoint { _turnToPoint :: Point2 }
-    | ImpulsesList { _impulsesListList :: [[Impulse]] }
+    | ImpulsesList { _impulsesListList :: [[Impulse]], _acAction :: Action }
     | DoImpulses { _doImpulsesList :: [Impulse] }
     | WaitThen
         { _waitThenTimer :: Int
@@ -98,7 +100,7 @@ data Action
         , _doActionWhileThenCondition :: WdCrBl
         , _doActionWhileThenThen :: Action
         }
-    | DoActions { _doActionsList :: [Action] }
+--    | DoActions { _doActionsList :: [Action] }
     | DoActionThen
         { _doActionThenFirst :: Action
         , _doActionThenSecond :: Action
@@ -140,9 +142,9 @@ data Strategy
     | CloseToMelee {_meleeTarget :: Int}
     | StrategyActions Strategy [Action]
     | GetTo Point2
-    | Reload
+--    | Reload
     | Flee
-    | MeleeStrike
+--    | MeleeStrike
     | Search
     deriving (Eq, Ord, Show) --Generic, Flat)
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/Creature/Misc.hs

@@ -58,6 +58,13 @@ data CreatureType
         , _footForward :: FootForward
         , _strideAmount :: Float
         }
+    | CrabCrit 
+        { _meleeCooldownL :: Int
+        , _meleeCooldownR :: Int
+        , _footForward :: FootForward
+        , _strideAmount :: Float
+        , _dodgeCooldown :: Int
+        }
     | HoverCrit {_meleeCooldown :: Int}
     | SwarmCrit
     | AutoCrit

src/Dodge/Data/Input.hs

@@ -14,8 +14,7 @@ data MouseContext
     = NoMouseContext
     | MouseAiming
     | MouseInGame
-    | MouseMenuClick {_mcoMenuClick :: Int}
+    | MouseMenu {_mcoMenuClick :: Maybe Int}
-    | MouseMenuCursor
     | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
     | OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}

src/Dodge/Default/Creature.hs

@@ -43,7 +43,7 @@ defaultCreature =
                 , _posture = AtEase
                 }
         , _crVocalization = VocReady
-        , _crActionPlan = ActionPlan [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
+        , _crActionPlan = ActionPlan NoAction (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
         , _crPerception = defaultPerceptionState
         , _crMemory = defaultCreatureMemory
         , _crFaction = NoFaction

src/Dodge/Humanoid.hs

@@ -1,5 +1,6 @@
 module Dodge.Humanoid (
     chaseCritInternal,
+    crabCritInternal,
     hoverCritInternal,
 ) where
 
@@ -16,7 +17,7 @@ chaseCritInternal w cr =
         [ const doStrategyActions
         , overrideMeleeCloseTarget
         , setViewPos
-        , setMvPos
+        , setMvPosToTargetCr
         , chaseCritMv
         , perceptionUpdate [0]
         , targetYouWhenCognizant
@@ -25,6 +26,21 @@ chaseCritInternal w cr =
         , const (crVocalization %~ updateVocTimer)
         ]
 
+crabCritInternal :: World -> Creature -> Creature
+crabCritInternal w =
+    (crVocalization %~ updateVocTimer)
+        . (crType . meleeCooldownL %~ max 0 . subtract 1)
+        . (crType . meleeCooldownR %~ max 0 . subtract 1)
+        . (crType . dodgeCooldown %~ max 0 . subtract 1)
+        . searchIfDamaged
+        . targetYouWhenCognizant w
+        . perceptionUpdate [0] w
+        . crabCritMv w
+        . setMvPosToTargetCr w
+        . setViewPos w
+--        . overrideMeleeCloseTarget w
+        . doStrategyActions
+
 hoverCritInternal :: World -> Creature -> Creature
 hoverCritInternal w cr =
     foldl'
@@ -33,7 +49,7 @@ hoverCritInternal w cr =
         [ const doStrategyActions
         , overrideMeleeCloseTarget
         , setViewPos
-        , setMvPos
+        , setMvPosToTargetCr
         , hoverCritMv
         , perceptionUpdate [0]
         , targetYouWhenCognizant

src/Dodge/ListDisplayParams.hs

@@ -48,7 +48,7 @@ secondColumnLDP = defaultLDP & ldpPos . spPixelOff .~ V2 subInvX (-20)
 terminalLDP :: LDParams
 terminalLDP = secondColumnLDP & ldpSize ?~ V2 50 16
     & ldpPos . spScreenOff .~ V2 0.5 0.5
-    & ldpPos . spPixelOff .~ V2 (-250) (-40)
+    & ldpPos . spPixelOff .~ V2 (-250) 200
 
 subInvX :: Float
 subInvX = 10 * fromIntegral topInvW + 170

src/Dodge/Placement/Instance/Creature.hs

@@ -1,10 +1,10 @@
 module Dodge.Placement.Instance.Creature where
 
-import Dodge.Creature.ArmourChase
+--import Dodge.Creature.ArmourChase
 import Dodge.Creature.ChaseCrit
 import Dodge.Data.GenWorld
 import RandomHelp
 
 randC1 :: PSType
-randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 hoverCrit
+randC1 = RandPS $ takeOne $ map PutCrit [hoverCrit,chaseCrit]
 --randC1 = RandPS $ takeOne $ map PutCrit [hoverCrit]

src/Dodge/Render/HUD.hs

@@ -372,10 +372,16 @@ drawTerminalDisplay w cfig tid = fold $ do
             TerminalLineRead -> (++ [(spincurs, termTextColor)])
             TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
             TerminalPressTo s -> (++ [(s, white)])
-    return $
+    return . (each . vxPos . _z -~ 0.05) $
+        drawTerminalCursorLink w cfig tm
+            <> (
         drawSelectionList (w ^. tmLDP) cfig f
-            <> drawTerminalCursorLink w cfig tm
+            <> (hackInvertText black white ("TERMINAL-" ++ show tid) 
+                & each . vxPos *~ 0.1
+                & each . vxPos . _xy +~ rp)  
+                & each . vxPos . _z -~ 0.05)
   where
+    rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
     --        <> invHead cfig ("TERMINAL-" ++ show tid)
     --        <> color
     --            (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
@@ -391,7 +397,7 @@ drawTerminalCursorLink :: World -> Config -> Terminal -> Picture
 drawTerminalCursorLink w cfig tm = fold $ do
     j <- elemIndex (tm ^. tmButtonID) $ w ^. hud . closeButtons
     lp <- selNumPos cfig invDP (w ^. hud . diSections) 5 j
-    let rp = screenPosAbs cfig (secondColumnLDP ^. ldpPos) - V2 5 10
+    let rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
     lcol <- selSecSelCol 5 j (w ^. hud . diSections)
     return $
         translateScreenPos
@@ -403,7 +409,8 @@ drawTerminalCursorLink w cfig tm = fold $ do
                 (w ^. hud . diSections)
                 (Sel 5 j mempty)
             )
-            <> lConnectCol (lp + V2 155 0) rp lcol white white
+            <> 
+            lConnectCol (lp + V2 155 0) rp lcol white white
 
 lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f

src/Dodge/Render/List.hs

@@ -40,7 +40,7 @@ drawSelectionList ldps cfig sl =
         (drawListYgapScaleYoff ygap sf 0 (makeSelectionListPictures sl))
         <> foldMap (g . f) (ldpRect cfig ldps)
   where
-    g xs = color white (polygonWire xs) <> setDepth 0.5 (polygon xs)
+    g xs = color white (polygonWire xs) <> setDepth 0.05 (polygon xs)
     ygap = ldps ^. ldpVerticalGap
     sf = ldps ^. ldpScale
     f (V2 xmin ymax, V2 xmax ymin) = rectNSWE ymax ymin xmin xmax

src/Dodge/Render/Picture.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Render.Picture (fixedCoordPictures) where
 
+import Linear hiding (rotate)
 import qualified SDL
 import Control.Lens
 import qualified Data.Map.Strict as M
@@ -14,7 +15,6 @@ import Dodge.Render.List
 import Dodge.Render.MenuScreen
 import Geometry
 import HelpNum
-import Linear (_xy)
 import Picture
 
 fixedCoordPictures :: Universe -> Picture
@@ -67,7 +67,7 @@ fpsText x = scale 0.2 0.2 . color col . text $ "ms/frame " ++ show x
 drawMenuOrHUD :: Config -> Universe -> Picture
 drawMenuOrHUD cf u = case u ^. uvScreenLayers of
     [] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
-    (x : _) -> drawMenuScreen (u ^? uvWorld . input . mouseContext . mcoMenuClick) x cf
+    (x : _) -> drawMenuScreen (u ^? uvWorld . input . mouseContext . mcoMenuClick . _Just) x cf
 
 drawConcurrentMessage :: Universe -> Picture
 drawConcurrentMessage u =
@@ -83,16 +83,17 @@ drawConcurrentMessage u =
 drawMouseCursor :: Universe -> Picture
 drawMouseCursor u =
     uncurryV translate (u ^. uvWorld . input . mousePos)
-        . color white
+        . (each . vxCol . _xyz +~ 1)
-        . setDepth (-1)
+        . (each . vxPos . _z -~ 1)
         $ mouseCursorType u
 
 mouseCursorType :: Universe -> Picture
 mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     NoMouseContext -> drawEmptySet 5
     MouseAiming -> rotate a (drawPlus 5)
-    MouseMenuClick{} -> drawMenuClick 5
+    MouseMenu Nothing -> drawMenuCursor 5
-    MouseMenuCursor -> drawMenuCursor 5
+    MouseMenu{} -> drawMenuClick 5
+--    MouseMenuCursor -> drawMenuCursor 5
     MouseInGame -> drawPlus 5
     OverInvDrag 0 (Just (3, _)) -> drawDragDrop 5
     OverInvDrag 0 Nothing -> drawDragDrop 5
@@ -194,7 +195,11 @@ drawJumpDown x =
     rotate (0.25 * pi) $ line [V2 x 0, V2 0 0, V2 0 x]
 
 drawDragSelect :: Float -> Picture
-drawDragSelect x = polygonWire $ rectWH (0.5 * x) x
+drawDragSelect x = polygonWire (rectWH (0.5 * x) x)
+    <> (polygon (rectWH (0.5*x) x)
+        & each . vxCol . _xyz -~ 1
+        & each . vxPos . _z +~ 0.05
+        )
 
 drawDrag :: Float -> Picture
 drawDrag x =

src/Dodge/Render/ShapePicture.hs

@@ -119,6 +119,7 @@ drawCreature w m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
         Avatar {} -> basicCrPict m cr
         SwarmCrit -> basicCrPict m cr
         AutoCrit -> basicCrPict m cr
+        CrabCrit {} -> noPic $ drawCrabCrit w cr
         HoverCrit{} -> noPic $ drawHoverCrit cr
 
 barrelShape :: SPic

src/Dodge/Room/Tutorial.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Room.Tutorial where
 
+import Dodge.Item.Held.Stick
 import Dodge.Creature.ChaseCrit
 import Control.Monad
 import Data.Foldable
@@ -57,7 +58,10 @@ tutAnoTree = do
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
         , chasmSpitTerminal
---        , loadAmmoTut
+        , corDoor
+        , loadAmmoTut
+        , corDoor
+        , chasmSpitTerminal
 --b        , corDoor
 --b        , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
 --b        , corDoor
@@ -339,10 +343,10 @@ chasmSpitTerminal = do
         tToBTree "chasmTerm" $
             Node
                 (addDoorToggleTerminal' i1 (PS 150 0) y')
-                [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
+                [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit crabCrit)]
                 --[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
                 --[ treePost [triggerDoorRoom i1, deadEndRoom]
-                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
+                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit crabCrit)]
                 , return $ cleatOnward $ triggerDoorRoom i1
                 ]
   where
@@ -426,6 +430,10 @@ tutLight = do
                         )
             _ -> Nothing
 
+crabRoom :: State LayoutVars Room
+crabRoom = (putSingleLight =<< roomNgon 6 150)
+    <&> rmPmnts .:~ psPtPl (PS 100 0) (PutCrit crabCrit)
+
 loadAmmoTut :: State LayoutVars (MetaTree Room String)
 loadAmmoTut = do
     i <- nextLayoutInt
@@ -444,8 +452,8 @@ loadAmmoTut = do
             =<< 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 <- crabRoom
-    croom <- roomCCrits ncrits
+    wep <- takeOne [burstRifle,smg]
     return $
         tToBTree "loadAmmoTest" $
             treePost 
@@ -453,7 +461,7 @@ loadAmmoTut = do
                 , door
                 , amrm & rmPmnts .:~ sps (PS 50 0) (PutFlIt (drumMag & itConsumables ?~ 90))
                 , triggerDoorRoom i
-                , wprm & rmPmnts .:~ sps (PS 50 0) (PutFlIt burstRifle)
+                , wprm & rmPmnts .:~ sps (PS 50 0) (PutFlIt wep)
                 , triggerDoorRoom j
                 , droom
                 , door
@@ -479,11 +487,13 @@ putSingleLight rm = do
                     , (V2 0 y', V2 x y')
                     ]
             return $ rmPmnts .:~ uncurry spanLightI ps
-        RoomNgon{_rmngonSize = x} -> do
+        RoomNgon{} -> do
-            y <- takeOne [21, -21]
+            let p = rm ^?! rmPolys . ix 0 . ix 0
-            return $ rmPmnts .:~ spanLightI (V2 (-x) y) (V2 x y)
+            return $ rmPmnts .:~ spanLightI p (-p)
     return . f $ removeLights rm
 
+
+
 tutHub :: State LayoutVars (MetaTree Room String)
 tutHub = do
     (is, wbp) <- setTreeInts =<< critsRoom 1

src/Dodge/SelectionSections.hs

@@ -190,16 +190,24 @@ inverseSelSecYint yint sss
                 return $ NonInf (i, j)
 
 inverseSelSecYintXPosCheck ::
-    Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int, Int)
+    Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (XInfinity (Int, Int))
 inverseSelSecYintXPosCheck cfig ldp x yint sss = do
-    (i, j) <- inverseSelSecYint yint sss ^? nonInf
+    let sel = inverseSelSecYint yint sss
+    (i,j) <- case sel of
+        NonInf v -> Just v
+        NegInf -> do 
+            (i',j',_) <- ssLookupMin sss
+            return (i',j')
+        PosInf -> do
+            (i',j',_) <- ssLookupMax sss
+            return (i',j')
     let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
     sindent <- sss ^? ix i . ssIndent
     itindent <- sss ^? ix i . ssItems . ix j . siOffX
     let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
     guard $ x - x1 < 160 && x > x1
-    return (i, j)
+    return sel
 
-inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (Int, Int)
+inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (XInfinity (Int, Int))
 inverseSelNumPos cfig ldp (V2 x y) =
     inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)

src/Dodge/TestString.hs

@@ -41,9 +41,8 @@ tocrs :: (IM.IntMap Creature
 tocrs = uvWorld . cWorld . lWorld . creatures
 
 testStringInit :: Universe -> [String]
-testStringInit u = u ^.. tocrs . each . crStance . carriage . to show
+testStringInit u = u ^.. tocrs . ix 1 . crActionPlan . apStrategy . to show
-    <> u ^.. tocrs . each . crPos . _z . to show
+    <> u ^.. tocrs . ix 1 . crActionPlan . apAction . to show
-
 --  where
 --    tocr = uvWorld . cWorld . lWorld . creatures . ix 0
 --    f = fromMaybe 0

src/Dodge/Update.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Update (updateUniverse) where
 
+import Dodge.Data.CardinalPoint
 import Dodge.Data.ScreenPos
 import Bound
 import Color
@@ -409,7 +410,7 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
 
 updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
 updateMouseContextGame cfig u = \case
-    OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
+    OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
     x@OverInvDragSelect{} -> x
     MouseGameRotate x
         | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
@@ -424,7 +425,7 @@ updateMouseContextGame cfig u = \case
     mpos = w ^. input . mousePos
     disss = w ^. hud . diSections
     overinv = do
-        selpos@(i, j) <- inverseSelNumPos cfig invDP mpos disss
+        selpos@(i, j) <- inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf
         case w ^? hud . subInventory . ciSelection of
             Just _ | i == 0 -> return $ OverCombFiltInv selpos
             Just _ -> Nothing
@@ -436,7 +437,7 @@ updateMouseContextGame cfig u = \case
         sss <- w ^? hud . subInventory . ciSections
         Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
         let msel = (xl, xr)
-        let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss
+        let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss ^? _Just . nonInf
         return $ case mpossel of
             Nothing -> OverCombEscape
             Just (-1, i) | (-1, i) == msel -> OverCombFilter
@@ -471,10 +472,10 @@ getDebugMouseOver u = fromMaybe MouseInGame $ do
 getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
 getMenuMouseContext screen u = case screen ^. scOptions of
     [] -> NoMouseContext
-    _ -> fromMaybe MouseMenuCursor $ do
+    _ -> fromMaybe (MouseMenu Nothing) $ do
         yi <- ldpSelection (u ^. uvConfig) menuLDP (u ^. uvWorld . input . mousePos)
         t <- screen ^? scSelectionList . ix yi . siIsSelectable
-        return $ if t then MouseMenuClick yi else NoMouseContext
+        return $ if t then MouseMenu (Just yi) else NoMouseContext
 
 updateWheelEvents :: World -> World
 updateWheelEvents w = case w ^. input . scrollAmount of

src/Dodge/Update/Input/InGame.hs

@@ -104,13 +104,18 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
             w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
     OverInvDragSelect (Just sstart) _ ->
         let sss = w ^. hud . diSections
-            msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
+         in case inverseSelNumPos cfig invDP (w ^. input . mousePos) sss of
-         in case msel of
                 Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
-                Just (i, j)
+                Just (NonInf (i, j))
                     | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
                     | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
-                    | otherwise ->
+                    | otherwise -> w 
+                        & input . mouseContext . mcoSelEnd
+                            .~ fmap
+                                fst
+                                (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
+                Just NegInf -> w & input . mouseContext . mcoSelEnd ?~ 0
+                Just PosInf -> 
                         w & input . mouseContext . mcoSelEnd
                             .~ fmap
                                 fst
@@ -136,21 +141,16 @@ setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
     w = fromIntegral $ cfig ^. windowX
     x' = min (w - (w*a + 1+10*ldp ^?! ldpSize . _Just . _x . to fromIntegral)) 
         $ max (1 - w * a) x
-    y' = min (h-(h*b + 40)) 
+    y' = min (h-(h*b + 20)) 
         $ max (1+20*(ldp^.ldpVerticalGap + ldp^?!ldpSize._Just._y.to fromIntegral)-h*b) y
     V2 a b = ldp ^. ldpPos . spScreenOff
 
---leftHeldPosShift :: World -> Point2
---leftHeldPosShift w = fromMaybe 0 $ do
---    p <- w ^? input . heldPos . ix SDL.ButtonLeft
---    return $ w ^. input . mousePos - p
-
 doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
 doDrag cfig n k mmouseover w = fromMaybe w $ do
     guard (n /= 0)
     ss <- w ^? hud . diSections . ix k . ssItems
     x <- mmouseover
-    is <- w ^? hud . diSelection . _Just . slSet
+    is <- selectionSet w
     return $
         if concurrentIS is
             then shiftInvItems cfig n k x is ss w
@@ -160,26 +160,40 @@ tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
 tryDropSelected mpos w = do
     guard $ maybe True (\(i, _) -> i == 3) mpos
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    Sel 0 _ xs <- w ^? hud . diSelection . _Just
+    0 <- w ^? hud . diSelection . _Just . slSec
-    return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
+    j <- w ^? hud . diSelection . _Just . slInt
+    xs <- selectionSet w
+    let xmin = IS.findMin xs
+    return 
+        . (hud . diSelection ?~ Sel 3 (j-xmin) (IS.fromDistinctAscList [0..IS.size xs - 1]))
+        . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
+
+selectionSet :: World -> Maybe IS.IntSet
+selectionSet w = case w ^? hud . diSelection . _Just . slSet of
+        Just is' | not $ IS.null is' -> Just is'
+        _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
+
 
 tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
 tryPickupSelected k mpos w = do
     guard $ k == 3
     guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    xs <- w ^? hud . diSelection . _Just . slSet
+    xs <- selectionSet w
+    sli <- w ^? hud . diSelection . _Just . slInt
+    let xmin = IS.findMin xs
+        joff = sli - xmin
     let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
         itmstopickup = mapMaybe g $ IS.toList xs
         slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
         ispickup = map (_unNInt . _itID) itmstopickup
     guard $ nfreeslots >= slotsneeded
     return $ case mpos of
-        Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs
+        Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j joff xs
-        _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
+        _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
   where
-    newdisel j xs =
+    newdisel j joff xs =
-        hud . diSelection ?~ Sel 0 j (IS.fromDistinctAscList [j .. j + IS.size xs -1])
+        hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
     g i = do
         NInt j <- w ^? hud . closeItems . ix i
         w ^? cWorld . lWorld . items . ix j
@@ -305,7 +319,8 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
 startDrag :: (Int, Int) -> World -> World
 startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
     Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
-    _ -> invSetSelection (Sel a b (IS.singleton b)) w
+--    _ -> invSetSelection (Sel a b (IS.singleton b)) w
+    _ -> invSetSelection (Sel a b mempty) w
   where
     setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
 

src/Dodge/Update/Input/ScreenLayer.hs

@@ -69,17 +69,13 @@ optionScreenDefaultEffect u = fromMaybe u $ do
 -- ouch this is not good
 mouseClickOptionsList :: Universe -> Universe
 mouseClickOptionsList u = fromMaybe u $ do
-    sl <- u ^? uvScreenLayers . ix 0 . scSelectionList
+    l <- case u ^. uvWorld . input . mouseButtons of
-    case u ^. uvWorld . input . mouseButtons of
+        mbs | mbs ^. at ButtonLeft == Just 0 -> Just _1
-        mbs | mbs ^. at ButtonLeft == Just 0 -> do
+        mbs | mbs ^. at ButtonRight == Just 0 -> Just _2
-            i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
-            f <- sl ^? ix i . siPayload . _Just . _1
-            return $ f u & uvSoundQueue .:~ click1S
-        mbs | mbs ^. at ButtonRight == Just 0 -> do
-            i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
-            f <- sl ^? ix i . siPayload . _Just . _2
-            return $ f u & uvSoundQueue .:~ click1S
         _ -> Nothing
+    i <- u ^? uvWorld . input . mouseContext . mcoMenuClick . _Just
+    f <- u ^? uvScreenLayers . ix 0 . scSelectionList . ix i . siPayload . _Just . l
+    return $ f u & uvSoundQueue .:~ click1S
 
 ldpSelection :: Config -> LDParams -> Point2 -> Maybe Int
 ldpSelection cfig ldp (V2 _ y)

src/Picture/Base.hs

@@ -42,7 +42,7 @@ module Picture.Base (
     color,
     zeroZ,
     setDepth,
-    addDepth,
+--    addDepth,
     setLayer,
     mirroryz,
     mirrorxz,
@@ -122,10 +122,10 @@ setDepth :: Float -> Picture -> Picture
 --setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
 setDepth d = fmap $ overPos (\(V3 x y _) -> V3 x y d)
 
-addDepth :: Float -> Picture -> Picture
+--addDepth :: Float -> Picture -> Picture
-{-# INLINE addDepth #-}
+--{-# INLINE addDepth #-}
---addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
+----addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
-addDepth d = fmap $ overPos (\(V3 x y z) -> V3 x y (z + d))
+--addDepth d = fmap $ overPos (\(V3 x y z) -> V3 x y (z + d))
 
 -- TODO change the Int here to a dedicated type
 setLayer :: Layer -> Picture -> Picture