Generalise pathing, usable with flying creatures

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
@@ -113,11 +114,17 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
         | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
         | otherwise = p
 
+crPathing :: Creature -> (Point2 -> Point2 -> World -> Bool,S.Set EdgeObstacle -> Bool)
+crPathing cr = case cr ^. crStance . carriage of
+    Flying {} -> (isFlyable, not . S.member (WallObstacle WallNotAutoOpen))
+    _ -> (isWalkable, not . pathEdgeObstructed)
+
 performPathTo :: Creature -> World -> Point2 -> ActionUpdate
 performPathTo cr w p
     | dist cpos p <= crRad (cr ^. crType) = mempty
-    | isWalkable cpos p w = gotowards p
-    | otherwise = case pointTowardsImpulse cpos p w of
+--    | isWalkable cpos p w = gotowards p
+    | fst (crPathing cr) cpos p w = gotowards p
+    | otherwise = case uncurry pointTowardsImpulse' (crPathing cr) cpos p w of
         Just q -> gotowards q
         _ -> ([ChangeStrategy Flee], [])
   where

src/Dodge/Creature/ChaseCrit.hs

@@ -37,5 +37,6 @@ hoverCrit =
     defaultCreature
         & crName .~ "hoverCrit"
         & crHP .~ HP 100
+        & crType .~ HoverCrit 0
         & crFaction .~ ColorFaction blue
-        & crStance . carriage .~ Flying
+        & crStance . carriage .~ Flying 15

src/Dodge/Creature/HandPos.hs

@@ -63,7 +63,7 @@ handWalkingPos b off cr = case cr ^. crStance . carriage of
                 | otherwise = 8 * zeroOneSmooth (i / slen)
          in V3 (f sa) off 20
     Floating -> V3 0 off 12
-    Flying -> V3 0 off 12
+    Flying {} -> V3 0 off 12
     Boosting _ -> V3 0 off 12
 
 zeroOneSmooth :: Float -> Float

src/Dodge/Creature/Picture.hs

@@ -8,6 +8,7 @@ module Dodge.Creature.Picture (
     deadUpperBody,
     deadFeet,
     drawChaseCrit,
+    drawHoverCrit,
 ) where
 
 import Linear
@@ -50,6 +51,14 @@ basicCrShape cr
     crsize = 0.1 * crRad (cr ^. crType)
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
+drawHoverCrit :: Creature -> Shape
+drawHoverCrit cr = colorSH (_skinUpper cskin) 
+    (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 2 $ square 5)
+  where
+    cskin = crShape $ _crType cr
+    z = cr ^?! crStance . carriage . flyHeight
+    tpq = (V3 0 0 z, Q.qid)
+
 drawChaseCrit :: Creature -> Shape
 drawChaseCrit cr = mconcat 
     [ chaseUpperBody cr

src/Dodge/Creature/ReaderUpdate.hs

@@ -11,6 +11,7 @@ module Dodge.Creature.ReaderUpdate (
     chaseCritMv,
     setMvPos,
     setViewPos,
+    hoverCritMv,
 ) where
 
 import Control.Applicative
@@ -148,6 +149,20 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
                     & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
 
+hoverCritMv :: World -> Creature -> Creature
+hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
+    WarningCry -> cr
+    MeleeStrike -> cr
+    _ -> case cr ^? crIntention . mvToPoint . _Just of
+        Just p
+            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
+                cr & crActionPlan . apAction .~ [PathTo p]
+            | 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]

src/Dodge/Creature/Shape.hs

@@ -9,7 +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)
-    HoverCrit {} -> Humanoid (greyN 0.9) (lightx4 blue) (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)
     BarrelCrit {} -> Barreloid

src/Dodge/Creature/Update.hs

@@ -56,7 +56,11 @@ updateLivingCreature cr =
         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 $
+                over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
   where
     cid = cr ^. crID
 
@@ -135,6 +139,7 @@ dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $
 
 chasmTestLiving :: Creature -> World -> World
 chasmTestLiving cr w
+    | Flying {} <- cr ^. crStance . carriage = w
     | Falling {} <- cr ^. crStance . carriage =
         w
             & tocr . crZVel -~ 0.5