diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-21T16·43-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-21T16·43-0400 |
commit | d632a30d057f9a2775c4516570168b195c053879 (patch) | |
tree | 3bfebac7b14567edfb11d3917e9b2fd9114becb9 /src/Xanthous/Entities | |
parent | dd1616666593f65bab70f1363b5d040fe5edd054 (diff) |
Implement combat
Put a bunch of gormlaks randomly on the level, and implement combat via damaging those gormlaks by one point.
Diffstat (limited to 'src/Xanthous/Entities')
-rw-r--r-- | src/Xanthous/Entities/Character.hs | 3 | ||||
-rw-r--r-- | src/Xanthous/Entities/Creature.hs | 14 | ||||
-rw-r--r-- | src/Xanthous/Entities/RawTypes.hs | 5 |
3 files changed, 16 insertions, 6 deletions
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 924c1857a8ae..9423f2dc96b0 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -3,6 +3,7 @@ module Xanthous.Entities.Character ( Character(..) , characterName , inventory + , characterDamage , mkCharacter , pickUpItem ) where @@ -22,6 +23,7 @@ import Xanthous.Entities.Item data Character = Character { _inventory :: !(Vector Item) , _characterName :: !(Maybe Text) + , _characterDamage :: !Word } deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) @@ -50,6 +52,7 @@ mkCharacter :: Character mkCharacter = Character { _inventory = mempty , _characterName = Nothing + , _characterDamage = 1 } pickUpItem :: Item -> Character -> Character diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index c660a6cdf5d4..5151f78b3061 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -7,12 +7,14 @@ module Xanthous.Entities.Creature , hitpoints , newWithType , damage + , isDead ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Data.Word import Test.QuickCheck.Arbitrary.Generic +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) import qualified Xanthous.Entities.RawTypes as Raw @@ -21,10 +23,13 @@ import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) data Creature = Creature { _creatureType :: CreatureType - , _hitpoints :: Word16 + , _hitpoints :: Word } deriving stock (Eq, Show, Generic) deriving Draw via DrawRawChar "_creatureType" Creature + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Creature makeLenses ''Creature instance Arbitrary Creature where @@ -39,8 +44,11 @@ newWithType _creatureType = let _hitpoints = _creatureType ^. maxHitpoints in Creature {..} -damage :: Word16 -> Creature -> Creature +damage :: Word -> Creature -> Creature damage amount = hitpoints %~ \hp -> if hp <= amount then 0 else hp - amount + +isDead :: Creature -> Bool +isDead = views hitpoints (== 0) diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 94f650545325..3fb89c58ba3b 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -19,7 +19,6 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -import Data.Word -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) -------------------------------------------------------------------------------- @@ -27,12 +26,12 @@ data CreatureType = CreatureType { _name :: Text , _description :: Text , _char :: EntityChar - , _maxHitpoints :: Word16 + , _maxHitpoints :: Word , _friendly :: Bool } deriving stock (Show, Eq, Generic) deriving anyclass (NFData) - deriving (FromJSON) + deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType makeFieldsNoPrefix ''CreatureType |