From 8a4220df830adb6f1616ca02dd06902474fd25df Mon Sep 17 00:00:00 2001 From: Griffin Smith 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/Character.hs | 10 +++++ src/Xanthous/Entities/Creature.hs | 69 ++++++++++++++++++++++++++++++--- src/Xanthous/Entities/RawTypes.hs | 19 +++++---- src/Xanthous/Entities/Raws/gormlak.yaml | 2 +- 4 files changed, 86 insertions(+), 14 deletions(-) (limited to 'src/Xanthous/Entities') 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 -- cgit 1.4.1