Tweak perception. Bug: CloseToMelee is not getting applied

src/Dodge/Creature/Perception.hs

@@ -29,10 +29,6 @@ perceptionUpdate ::
     Creature
 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?
@@ -64,9 +60,9 @@ basicAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
 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]]
+        ++ [[ChangeStrategy $ CloseToMelee 0]]
     HoverCrit {} | Just sid <- cognizantVoc w cr -> [[Bark sid]]
-        <> [[ChangeStrategy $ CloseToMelee 0]]
+         ++ [[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

@@ -11,6 +11,10 @@ module Dodge.Creature.Picture (
     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
@@ -20,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
@@ -61,17 +65,17 @@ drawHoverCrit cr = colorSH (_skinHead cskin)
     f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
     tpq = (V3 0 0 0, Q.qid)
 
-drawChaseCrit :: Creature -> Shape
-drawChaseCrit cr = mconcat 
-    [ chaseUpperBody cr
+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 :: Creature -> Shape
-chaseUpperBody cr =  colorSH (_skinUpper cskin)
+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) 
@@ -80,12 +84,13 @@ chaseUpperBody cr =  colorSH (_skinUpper cskin)
     <> 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.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))
+    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2*mcool+vocaltilt) * Q.qz headrot )
     vocaltilt = case cr ^? crVocalization . vcTime of
         Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
         _ -> 0
@@ -97,6 +102,12 @@ chaseUpperBody cr =  colorSH (_skinUpper cskin)
         _ -> 0
     --tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
     f i = (sLen - 2*i) / sLen
+    cxy = cr ^. crPos . _xy
+    headrot = fromMaybe pi $ do
+        i <- cr ^. crIntention . targetCr
+        tcxy <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
+        guard $ hasLOSIndirect cxy tcxy w
+        return . min (pi/2) . max (-pi/2) . nearZeroAngle $  argV (tcxy - cxy) - cr ^. crDir
     
 
 oneSmooth :: Float -> Float

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,14 @@ drawPlasmaBall pb =
         . setLayer BloomLayer
         $ circleSolidCol green white 5
 
-drawCreature :: IM.IntMap Item -> Creature -> SPic
-drawCreature m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
+drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
+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
-        ChaseCrit {} -> noPic $ drawChaseCrit cr
+        ChaseCrit {} -> noPic $ drawChaseCrit w cr
         Avatar {} -> basicCrPict m cr
         SwarmCrit -> basicCrPict m cr
         AutoCrit -> basicCrPict m cr

src/Dodge/TestString.hs

@@ -35,12 +35,13 @@ import Data.Monoid
 import RandomHelp
 
 testStringInit :: Universe -> [String]
-testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crPos . _z . to show
-    <> [show v]
-  where
-    v = x - y
-    x = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos
-    y = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos
+testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apStrategy . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apAction . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crPerception . cpAttention . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crPerception . cpAwareness . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . targetCr . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . mvToPoint . to show
+    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . viewPoint . to show
 --    u = [show p, show op, show oop, show (op - oop), show . norm $ op - oop, show d]
 --  where
 --    f = fromMaybe 0