From 8a4220df830adb6f1616ca02dd06902474fd25df Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sun, 13 Oct 2019 12:37:08 -0400
Subject: Implement speed and ticks

Gormlaks now move 1/8th the speed of the character, which means we can
run away from them - yay!

Unfortunately this also introduces a bug where they'll eventually get
stuck and not do anything, so I'll be tackling that next.
---
 src/Xanthous/Entities/Creature.hs | 69 ++++++++++++++++++++++++++++++++++++---
 1 file changed, 64 insertions(+), 5 deletions(-)

(limited to 'src/Xanthous/Entities/Creature.hs')

diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index f2c789d6a6a8..6ea6f93e4254 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -2,44 +2,101 @@
 {-# LANGUAGE TemplateHaskell #-}
 --------------------------------------------------------------------------------
 module Xanthous.Entities.Creature
-  ( Creature(..)
+  ( -- * Creature
+    Creature(..)
+    -- ** Lenses
   , creatureType
   , hitpoints
+  , hippocampus
+
+    -- ** Creature functions
   , newWithType
   , damage
   , isDead
   , visionRadius
+
+    -- * Hippocampus
+  , Hippocampus(..)
+    -- ** Lenses
+  , destination
+    -- ** Destination
+  , Destination(..)
+  , destinationFromPos
+    -- *** Lenses
+  , destinationPosition
+  , destinationProgress
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
 --------------------------------------------------------------------------------
+import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.Generic
 import           Data.Aeson.Generic.DerivingVia
 import           Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
 import           Xanthous.Entities.RawTypes hiding (Creature, description)
 import           Xanthous.Entities (Draw(..), DrawRawChar(..))
+import           Xanthous.Data
+--------------------------------------------------------------------------------
+
+data Destination = Destination
+  { _destinationPosition :: !Position
+    -- | The progress towards the destination, tracked as an offset from the
+    -- creature's original position.
+    --
+    -- When this value reaches >= 1, the creature has reached their destination
+  , _destinationProgress :: !Tiles
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       Destination
+instance Arbitrary Destination where arbitrary = genericArbitrary
+makeLenses ''Destination
+
+destinationFromPos :: Position -> Destination
+destinationFromPos _destinationPosition =
+  let _destinationProgress = 0
+  in Destination{..}
+
+data Hippocampus = Hippocampus
+  { _destination :: !(Maybe Destination)
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       Hippocampus
+instance Arbitrary Hippocampus where arbitrary = genericArbitrary
+makeLenses ''Hippocampus
+
+initialHippocampus :: Hippocampus
+initialHippocampus = Hippocampus Nothing
+
 --------------------------------------------------------------------------------
 
 data Creature = Creature
-  { _creatureType :: CreatureType
-  , _hitpoints :: Word
+  { _creatureType :: !CreatureType
+  , _hitpoints    :: !Word
+  , _hippocampus  :: !Hippocampus
   }
   deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
   deriving Draw via DrawRawChar "_creatureType" Creature
   deriving (ToJSON, FromJSON)
        via WithOptions '[ FieldLabelModifier '[Drop 1] ]
                        Creature
+instance Arbitrary Creature where arbitrary = genericArbitrary
 makeLenses ''Creature
 
-instance Arbitrary Creature where
-  arbitrary = genericArbitrary
 
 --------------------------------------------------------------------------------
 
 newWithType :: CreatureType -> Creature
 newWithType _creatureType =
   let _hitpoints = _creatureType ^. maxHitpoints
+      _hippocampus = initialHippocampus
   in Creature {..}
 
 damage :: Word -> Creature -> Creature
@@ -53,3 +110,5 @@ isDead = views hitpoints (== 0)
 
 visionRadius :: Creature -> Word
 visionRadius = const 50 -- TODO
+
+{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
-- 
cgit 1.4.1