From 05da490185e970b2cfdf6c61f69932fa373993f6 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sun, 29 Sep 2019 10:54:52 -0400
Subject: Gormlaks attack back

When gormlaks see the character, they step towards them and attack
dealing 1 damage when adjacent. Characters have hitpoints now, displayed
at the bottom of the game screen, and when the game is over they die.
---
 src/Xanthous/AI/Gormlak.hs | 45 +++++++++++++++++++++++++++++----------------
 1 file changed, 29 insertions(+), 16 deletions(-)

(limited to 'src/Xanthous/AI/Gormlak.hs')

diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs
index 6ea9254ba200..c9af68842635 100644
--- a/src/Xanthous/AI/Gormlak.hs
+++ b/src/Xanthous/AI/Gormlak.hs
@@ -7,18 +7,22 @@ import           Xanthous.Prelude hiding (lines)
 import           Data.Coerce
 import           Control.Monad.State
 import           Control.Monad.Random
+import           Data.Aeson (object)
+import qualified Data.Aeson as A
 --------------------------------------------------------------------------------
-import           Xanthous.Data (Positioned(..), positioned)
+import           Xanthous.Data (Positioned(..), diffPositions, stepTowards, isUnit)
 import           Xanthous.Data.EntityMap
 import qualified Xanthous.Entities.Creature as Creature
 import           Xanthous.Entities.Creature (Creature)
-import           Xanthous.Entities.Character (Character)
+import           Xanthous.Entities.Character (Character, characterHitpoints)
 import qualified Xanthous.Entities.RawTypes as Raw
 import           Xanthous.Entities (Entity(..), Brain(..), brainVia)
 import           Xanthous.Game.State (entities, GameState, entityIs)
-import           Xanthous.Game.Lenses (Collision(..), collisionAt)
-import           Xanthous.Data.EntityMap.Graphics (linesOfSight)
+import           Xanthous.Game.Lenses
+                 ( Collision(..), collisionAt, character, characterPosition )
+import           Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee)
 import           Xanthous.Random
+import           Xanthous.Monad (say)
 --------------------------------------------------------------------------------
 
 stepGormlak
@@ -26,28 +30,37 @@ stepGormlak
   => Positioned Creature
   -> m (Positioned Creature)
 stepGormlak pe@(Positioned pos creature) = do
-  lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature)
-  line <- choose $ weightedBy length lines
-  -- traceShowM ("current position", pos)
-  -- traceShowM ("lines", (headMay <=< tailMay) <$> lines)
-  let newPos = fromMaybe pos
-               $ fmap fst
-               . headMay
-               =<< tailMay
-               =<< line
+  newPos <- do
+    canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision
+    if canSeeCharacter
+      then do
+        charPos <- use characterPosition
+        if isUnit (pos `diffPositions` charPos)
+          then attackCharacter $> charPos
+          else pure $ pos `stepTowards` charPos
+    else do
+      lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature)
+      line <- choose $ weightedBy length lines
+      pure $ fromMaybe pos $ fmap fst . headMay =<< tailMay =<< line
   collisionAt newPos >>= \case
     Nothing -> pure $ Positioned newPos creature
     Just Stop -> pure pe
     Just Combat -> do
       ents <- use $ entities . atPosition newPos
-      if | any (entityIs @Creature) ents -> pure pe
-         | any (entityIs @Character) ents -> undefined
-         | otherwise -> pure pe
+      when (any (entityIs @Character) ents) attackCharacter
+      pure pe
+
+  where
+    vision = Creature.visionRadius creature
+    attackCharacter = do
+      say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ]
+      character . characterHitpoints -= 1
 
 newtype GormlakBrain = GormlakBrain Creature
 
 instance Brain GormlakBrain where
   step = fmap coerce . stepGormlak . coerce
+
 --------------------------------------------------------------------------------
 
 instance Brain Creature where step = brainVia GormlakBrain
-- 
cgit 1.4.1