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.

4 files changed, 86 insertions, 14 deletions

diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 84e653e6a09d..7d2d22c9983b 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -5,6 +5,9 @@ module Xanthous.Entities.Character
   , inventory
   , characterDamage
   , characterHitpoints
+  , speed
+
+    -- *
   , mkCharacter
   , pickUpItem
   , isDead
@@ -12,6 +15,7 @@ module Xanthous.Entities.Character
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
+--------------------------------------------------------------------------------
 import Test.QuickCheck
 import Test.QuickCheck.Instances.Vector ()
 import Test.QuickCheck.Arbitrary.Generic
@@ -21,6 +25,7 @@ import Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
 import Xanthous.Entities
 import Xanthous.Entities.Item
+import Xanthous.Data (TicksPerTile)
 --------------------------------------------------------------------------------
 
 data Character = Character
@@ -28,6 +33,7 @@ data Character = Character
   , _characterName :: !(Maybe Text)
   , _characterDamage :: !Word
   , _characterHitpoints :: !Word
+  , _speed :: TicksPerTile
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass (CoArbitrary, Function)
@@ -58,12 +64,16 @@ instance Arbitrary Character where
 initialHitpoints :: Word
 initialHitpoints = 10
 
+defaultSpeed :: TicksPerTile
+defaultSpeed = 100
+
 mkCharacter :: Character
 mkCharacter = Character
   { _inventory = mempty
   , _characterName = Nothing
   , _characterDamage = 1
   , _characterHitpoints = initialHitpoints
+  , _speed = defaultSpeed
   }
 
 isDead :: Character -> Bool
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) #-}
diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs
index f1f5e05f7aac..fd66140376bb 100644
--- a/src/Xanthous/Entities/RawTypes.hs
+++ b/src/Xanthous/Entities/RawTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 --------------------------------------------------------------------------------
 module Xanthous.Entities.RawTypes
@@ -8,6 +8,7 @@ module Xanthous.Entities.RawTypes
   , isEdible
   , EntityRaw(..)
 
+  , _Creature
     -- * Lens classes
   , HasName(..)
   , HasDescription(..)
@@ -17,7 +18,7 @@ module Xanthous.Entities.RawTypes
   , HasEatMessage(..)
   , HasHitpointsHealed(..)
   , HasEdible(..)
-  , _Creature
+  , HasSpeed(..)
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
@@ -28,16 +29,18 @@ import Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
 import Xanthous.Entities (EntityChar, HasChar(..))
 import Xanthous.Messages (Message(..))
+import Xanthous.Data (TicksPerTile)
 --------------------------------------------------------------------------------
 data CreatureType = CreatureType
-  { _name :: Text
-  , _description :: Text
-  , _char :: EntityChar
-  , _maxHitpoints :: Word
-  , _friendly :: Bool
+  { _name         :: !Text
+  , _description  :: !Text
+  , _char         :: !EntityChar
+  , _maxHitpoints :: !Word
+  , _friendly     :: !Bool
+  , _speed        :: !TicksPerTile
   }
   deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
+  deriving anyclass (NFData, CoArbitrary, Function)
   deriving (ToJSON, FromJSON)
        via WithOptions '[ FieldLabelModifier '[Drop 1] ]
                        CreatureType
diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml
index 2441e7e7822e..9a9281c9a91a 100644
--- a/src/Xanthous/Entities/Raws/gormlak.yaml
+++ b/src/Xanthous/Entities/Raws/gormlak.yaml
@@ -8,5 +8,5 @@ Creature:
     style:
       foreground: red
   maxHitpoints: 5
-  speed: 120
+  speed: 125
   friendly: false