Work on chase crit animations, eating dead bees

src/AesonHelp.hs

@@ -6,7 +6,8 @@ import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Maybe
 
 getPretty :: ToJSON a => a -> [String]
-getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
+--getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
+getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) mempty AEP.Generic False)
 
 prettyShort :: ToJSON a => a -> [String]
 prettyShort = mapMaybe cullPretty . getPretty

src/Dodge/Base/Collide.hs

@@ -34,6 +34,7 @@ module Dodge.Base.Collide (
     collide3WallsFloor,
     collide3,
     crHeight,
+    crMid,
 ) where
 
 import AesonHelp
@@ -194,6 +195,22 @@ crHeight cr = case cr ^. crHP of
     CrIsCorpse{} -> 5
     AvatarDestroyed{} -> 0
 
+crMid :: Creature -> Float
+crMid cr = case cr ^. crHP of
+    HP{} -> case cr ^. crType of
+        HoverCrit {} -> 2
+        ChaseCrit {} -> 20
+        Avatar {} -> 20
+        CrabCrit {} -> 20
+        SlinkCrit {} -> 20
+        SlimeCrit {_slimeSlime = r} -> max 3 . min 20 $ 2 * slimeToRad r - 5
+        BeeCrit {} -> 2
+        HiveCrit {} -> 20
+        BarrelCrit{} -> 20
+        _ -> error $ "Need to define crHeight for this crType:\n" <> unlines (prettyShort (cr ^. crType))
+    CrIsCorpse{} -> 2
+    AvatarDestroyed{} -> 0
+
 wallToSurface :: Wall -> (Point3, Point3, [(Point3, Point3)])
 wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y))])
   where

src/Dodge/Creature/Action.hs

@@ -60,7 +60,9 @@ type ActionUpdate = ([Impulse], Action)
 -}
 performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
-    Eat {} -> ([],NoAction)
+    Eat i x -> ([],Eat i x)
+--    Eat i x | x <= 0 -> ([],NoAction)
+--    Eat i x -> ([],Eat i (x-1))
     AimAt tcid p -> performAimAt cr w tcid p
     WaitThen 0 newAc -> ([], newAc)
     WaitThen t newAc -> ([], WaitThen (t -1) newAc)

src/Dodge/Creature/ArmourChase.hs

@@ -20,12 +20,12 @@ flockArmourChaseCrit =
 --            IM.fromList
 --                [ --(0, frontArmour)
 --                ]
-        , _crActionPlan =
+--        , _crActionPlan =
-            ActionPlan
+--            ActionPlan
-                { _apAction = NoAction
+--                { _apAction = NoAction
-                , _apStrategy = FollowImpulses
+----                , _apStrategy = FollowImpulses
-                , _apGoal = Kill 0
+--                , _apGoal = Kill 0
-                }
+--                }
         , _crGroup = ShieldGroup
 --        , _crMvType = defaultChaseMvType
         }

src/Dodge/Creature/Picture.hs

@@ -180,8 +180,8 @@ crabUpperBody _ cr =
 
 chaseUpperBody :: World -> Creature -> Shape
 chaseUpperBody w cr =
-    colorSH
+--    colorSH
-        (_skinUpper cskin)
+--        (_skinUpper cskin)
         ( overPosSH
             (Q.apply torsoq)
             ( upperPrismPolyHalfMI tz $
@@ -189,19 +189,36 @@ chaseUpperBody w cr =
                     & each %~ vNormal
                     & each . _y *~ 0.6
             )
-            <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+           <> overPosSH (Q.apply neckq) lneckshape
+        <> overPosSH (Q.apply neckq2) uneckshape
         )
         <> colorSH
-            (_skinHead cskin)
+--            (_skinHead cskin)
-            (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+            yellow headshape
   where
     --    time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
     tz = 4
     cskin = crShape $ _crType cr
-    torsoq = (V3 0 0 (10 + tz + tbob), Q.qid)
+    torsoq = (V3 0 0 (10 + tz + tbob), Q.qy (-cr ^?! crType . chaseqy0))
     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))
+--    (qy1,qy2,qy3)  
-    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2 * mcool + vocaltilt) * Q.qz aimrot)
+----        | CloseToMelee i <- cr ^?!crActionPlan.apStrategy
+----            = (0,0,0)
+--        | otherwise = (pi/3,-2*pi/3,pi/3)
+--        | otherwise = (pi * w^.cWorld.cClock.to ((*0.01).fromIntegral),0,0)
+--        | otherwise = (-1.8 * mcool , 0, 2 * mcool + vocaltilt)
+    qy1 = cr ^?! crType . chaseqy1
+    qy2 = cr ^?! crType . chaseqy2
+    qy3 = cr ^?! crType . chaseqy3
+    lneckshape = colorSH red $ upperPrismPolyHalfMI 4 (vNormal <$> trapTBH 2 5 (nlen/4))
+        & each . sfVs . each +~ V3 (nlen/4) 0 (-2)
+    uneckshape = colorSH green $ upperPrismPolyHalfMI 3 (vNormal <$> trapTBH 3 2 (nlen/4))
+        & each . sfVs . each +~ V3 (nlen/4) 0 (-1.5)
+    headshape = overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4])
+    neckq = torsoq `Q.comp` (V3 8 0 4, Q.qz aimrot * Q.qy (pi + qy1))
+    neckq2 = neckq `Q.comp` (V3 (nlen/2) 0 0, Q.qy qy2)
+    headq = neckq2 `Q.comp` (V3 (nlen/2) 0 0, Q.qy (pi + qy3) * Q.qz aimrot)
+    nlen = 16
     vocaltilt = case cr ^? crVocalization . vcTime of
         Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
         _ -> 0
@@ -220,6 +237,29 @@ chaseUpperBody w cr =
         guard $ hasLOSIndirect cxy tcxy w
         return . (0.5 *) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
 
+{- NECK ARTICULATION   
+Viewed from side, all hinges, torso/lower neck also hinges in Q.qz (not shown)
+    na1 na2 na3    <- angles, in diagram all == 0, in Q.qy
+     |   |   |
+  ---.---.---.---       z
+   |   |   |   |        ^>x                           
+ torso | u.neck|                                   
+     l.neck   head                  
+Rough examples
+Flat aim:           Resting:
+                        .\\
+                        \  \\
+      .                  .
+     / \                /
+ ---.   .---        ---.
+a1 = 60             a1 = 60
+a2 = -120           a2 = 60
+a3 = 60             a3 = -160
+-}
+
+--ikTwoArms :: Point3 -> Point3 -> Point3 -> Point3 -> (QFloat,QFloat)
+--ikTwoArms 
+
 oneSmooth :: Float -> Float
 oneSmooth x = sin (pi * x * 0.5)
 

src/Dodge/Creature/Update.hs

@@ -66,7 +66,7 @@ updateLivingCreature cr = case cr ^. crType of
             . yourControl
     LampCrit{} -> updateLampoid cr
     BarrelCrit bt -> updateBarreloid bt cr
-    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid cr
+    ChaseCrit{} -> crUpdate cid . performActions cid . setChaseCritKinematics cid . updateChaseCrit cid cr
     CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
     AutoCrit{} -> crUpdate cid
     SwarmCrit{} -> crUpdate cid
@@ -368,6 +368,66 @@ slinkCritUpdate cid w =
         . _2
         *~ Q.axisAngle (V3 0 1 0) (pi / 1000)
 
+setChaseCritKinematics :: Int -> World -> World
+setChaseCritKinematics cid w = w
+    & cWorld . lWorld . creatures . ix cid %~ setChaseCritKinematics' w
+
+ccAngles :: World -> Creature -> (Float,Float,Float,Float)
+ccAngles w cr
+    | Eat i _ <- cr^?!crActionPlan.apAction = fromMaybe (0,0,0,0) $ do
+        tcr <- w ^? cWorld . lWorld . creatures . ix i
+        let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
+            (np,_) = (cr ^. crPos, Q.qz (cr ^. crDir)) 
+                `Q.comp` (V3 8 0 14, Q.qid)
+            v = tp - np
+            a = angleVV3 v (v & _z .~ 0)
+        return $ f (-a) 0 0
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy = fromMaybe (0,0,0,0) $ do
+        tcr <- w ^? cWorld . lWorld . creatures . ix i
+        let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
+            (np,_) = (cr ^. crPos, Q.qz (cr ^. crDir)) 
+                `Q.comp` (V3 8 0 14, Q.qid)
+            v = tp - np
+            a = angleVV3 v (v & _z .~ 0)
+        return $ f 
+            (0.45*pi - a)
+            (-0.9*pi)
+            (0.45*pi)
+    | otherwise = f (0.6*pi) (-0.2*pi) (-0.4*pi)
+  where
+    f a b c = (0,a,b,c)
+
+ccKState :: World -> Creature -> ChaseKState
+ccKState _ cr
+    | Eat i _ <- cr^?!crActionPlan.apAction = PeckingCK i
+    | CloseToMelee i <- cr^?!crActionPlan.apStrategy = AimingCK i
+    | otherwise = UprightCK
+
+setChaseCritKinematics' :: World -> Creature -> Creature
+setChaseCritKinematics' w = f . g
+  where
+    g cr | ccKState w cr == cr ^?! crType . chaseKState = cr
+        | PeckingCK i <- ccKState w cr = cr
+            & crType . chaseLerp .~ 3
+            & crType . chaseKState .~ PeckingCK i
+        | otherwise = cr & crType . chaseLerp .~ 20
+            & crType . chaseKState .~ ccKState w cr
+    f cr = 
+        let (a,b,c,d) = ccAngles w cr
+            x = cr ^?! crType . chaseLerp
+        in if x <= 1
+            then cr & crType . chaseqy0 .~ a
+              & crType . chaseqy1 .~ b
+              & crType . chaseqy2 .~ c
+              & crType . chaseqy3 .~ d
+            else cr 
+              & crType . chaseqy0 %~ h x a
+              & crType . chaseqy1 %~ h x b
+              & crType . chaseqy2 %~ h x c
+              & crType . chaseqy3 %~ h x d
+              & crType . chaseLerp -~ 1
+    h x a b = 1/fromIntegral x * a + (1-1/fromIntegral x) * b
+
 updateChaseCrit :: Int -> Creature -> World -> World
 updateChaseCrit cid cr 
     | SearchForFood <- cr ^?! crActionPlan . apGoal = updateFoodSearchChaseCrit cid cr
@@ -384,12 +444,21 @@ updateFoodSearchChaseCrit cid cr w
         = let p = fleePoint cr cxy (20 *^ normalize (cxy - tcr^.crPos._xy)) w
           in w &tocr.crActionPlan.apAction.~PathTo p NoAction
                 &tocr.crActionPlan.apGoal.~Flee
+    | Eat i 0 <- cr^?! crActionPlan.apAction = w
+            & cWorld .lWorld.creatures . at i .~ Nothing
+            & tocr . crActionPlan.apAction.~NoAction
+            & tocr . crActionPlan.apStrategy.~Search
+    | Eat i x <- cr^?! crActionPlan.apAction = w
+            & tocr .crActionPlan.apAction.acTimer-~1
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy 
+        ,Nothing <- w ^?cWorld.lWorld.creatures.ix i = w & tocr . crActionPlan.apStrategy .~ Search
     | CloseToMelee i<-cr^?!crActionPlan.apStrategy 
         ,Just tcr <-w^?cWorld.lWorld.creatures.ix i
-        ,distance cxy (tcr^.crPos._xy) < 11 = w
+        ,distance cxy (tcr^.crPos._xy) < 15 = w
-            & tocr.crActionPlan.apAction.~NoAction
+            & tocr.crActionPlan.apAction.~Eat i 5
-            & tocr.crActionPlan.apStrategy.~Search
+--            & tocr.crActionPlan.apAction.~NoAction
-            & cWorld.lWorld.creatures.at i.~Nothing
+--            & tocr.crActionPlan.apStrategy.~Search
+--            & cWorld.lWorld.creatures.at i.~Nothing
     | CloseToMelee{}<-cr^?!crActionPlan.apStrategy 
         ,PathTo{}<-cr^?!crActionPlan.apAction= w
     | xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 

src/Dodge/Data/ActionPlan.hs

@@ -132,7 +132,7 @@ data Strategy
     | Lure Int Point2
     | Patrol [Point2]
     | ShootAt Int
-    | FollowImpulses
+--    | FollowImpulses
     | WatchAndWait
     | Investigate
     | WarningCry

src/Dodge/Data/Creature/Misc.hs

@@ -59,6 +59,13 @@ data CreatureType
     | ChaseCrit {_meleeCooldown :: Int
         , _footForward :: FootForward
         , _strideAmount :: Float
+        , _chaseqy0 :: Float
+        , _chaseqy1 :: Float
+        , _chaseqy2 :: Float
+        , _chaseqy3 :: Float
+        , _chaseqz :: Float
+        , _chaseLerp :: Int
+        , _chaseKState :: ChaseKState
         }
     | CrabCrit 
         { _meleeCooldownL :: Int
@@ -102,6 +109,12 @@ data CreatureType
     | BarrelCrit {_barrelType :: BarrelType}
     | LampCrit {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
 
+data ChaseKState
+    = UprightCK
+    | AimingCK Int
+    | PeckingCK Int
+    deriving (Eq)
+
 data SlimeShapeDistortion = SlimeDistortion
     { _sdTime :: Int
     , _sdShape :: [Point2]
@@ -136,6 +149,7 @@ makeLenses ''CrMvType
 makeLenses ''CreatureType
 makeLenses ''CreatureShape
 makeLenses ''SlimeShapeDistortion
+deriveJSON defaultOptions ''ChaseKState
 deriveJSON defaultOptions ''SlimeShapeDistortion
 deriveJSON defaultOptions ''Pulse
 deriveJSON defaultOptions ''Vocalization

src/Dodge/Default/Creature.hs

@@ -5,9 +5,10 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.Creature
 import Dodge.Data.FloatFunction
 import Geometry.Data
---import qualified IntMapHelp as IM
+
---import Picture
+-- import qualified IntMapHelp as IM
---import MaybeHelp
+-- import Picture
+-- import MaybeHelp
 
 defaultCreature :: Creature
 defaultCreature =
@@ -15,27 +16,27 @@ defaultCreature =
         { _crPos = V3 0 0 0
         , _crOldPos = V3 0 0 0
         , _crOldOldPos = V3 0 0 0
---        , _crZ = 0
---        , _crZVel = 0
         , _crDir = 0
         , _crMvDir = 0
---        , _crMvAim = 0
---        , _crTwist = 0
         , _crID = 1
-        , _crType = ChaseCrit 0 LeftForward 0
+        , _crType =
---        , _crRad = 10
+            ChaseCrit
+                { _meleeCooldown = 0
+                , _footForward = LeftForward
+                , _strideAmount = 0
+                , _chaseqy0 = 0
+                , _chaseqy1 = 0.45 * pi
+                , _chaseqy2 = -0.9*pi
+                , _chaseqy3 = 0.45*pi
+                , _chaseqz = 0
+                , _chaseLerp = 0
+                , _chaseKState = UprightCK
+                }
         , _crHP = HP 100
---        , _crMaxHP = 150
         , _crInv = mempty
---        , _crInvCapacity = 25
         , _crDamage = []
---        , _crCorpse = MakeDefaultCorpse
---        , _crMaterial = Flesh
         , _crPain = 0
---        , _crInvEquipped = mempty
         , _crEquipment = M.empty
---        , _crInvHotkeys = mempty
---        , _crHotkeys = M.empty
         , _crStance =
             Stance
                 { _carriage = Walking
@@ -49,13 +50,12 @@ defaultCreature =
         , _crIntention = defaultIntention
         , _crGroup = LoneWolf
         , _crName = "DEFAULTCRNAME"
---        , _crStatistics = CreatureStatistics 50 50 50
         , _crDeathTimer = Nothing
         , _crWallTouch = mempty
         }
 
---defaultCreatureSkin :: CreatureType
+-- defaultCreatureSkin :: CreatureType
---defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
+-- defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
 
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
@@ -101,15 +101,14 @@ defaultIntention =
         , _viewPoint = Nothing
         }
 
-
 defaultAimingCrit :: Creature
 defaultAimingCrit = defaultCreature
 
 yourDefaultStrideLength :: Float
 yourDefaultStrideLength = 35
 
---defaultState :: CreatureState
+-- defaultState :: CreatureState
---defaultState =
+-- defaultState =
 --    CrSt
 --        { _csDamage = []
 ----        , _csSpState = GenCr

src/Dodge/TestString.hs

@@ -58,7 +58,10 @@ crs :: Universe -> [Creature]
 crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
 
 testStringInit :: Universe -> [String]
-testStringInit u = [ u ^. uvWorld . testString ]
+testStringInit u = [ u ^. uvWorld . testString 
+    ] 
+    <> fold (u ^? uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort)
+    -- ] <> u ^.. uvWorld . cWorld . lWorld . creatures . each . crType . to (concat . prettyShort)
 --    <> u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjPos . _z . to show
 --    <> u ^.. uvWorld . cWorld . lWorld . creatures . each . crType . slimeSlime .  to (show . slimeToRad)
 --    , u ^. uvWorld . input . mouseContext . to show

src/Quaternion.hs

@@ -8,6 +8,8 @@ The warnings have been disabled.
 module Quaternion (
     qid,
     qz,
+    qx,
+    qy,
     qToV3,
     qToV2,
     qToAng,
@@ -81,4 +83,10 @@ apply (p,q) p1 = p + Q.rotate q p1
 qz :: Float -> Q.Quaternion Float
 qz = Q.axisAngle (V3 0 0 1)
 
+qx :: Float -> Q.Quaternion Float
+qx = Q.axisAngle (V3 1 0 0)
+
+qy :: Float -> Q.Quaternion Float
+qy = Q.axisAngle (V3 0 1 0)
+
 --deriving instance (Flat a => Flat (Quaternion a))