From d632a30d057f9a2775c4516570168b195c053879 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 21 Sep 2019 12:43:54 -0400
Subject: Implement combat

Put a bunch of gormlaks randomly on the level, and implement combat via
damaging those gormlaks by one point.
---
 src/Xanthous/Entities/Character.hs |  3 +++
 src/Xanthous/Entities/Creature.hs  | 14 +++++++++++---
 src/Xanthous/Entities/RawTypes.hs  |  5 ++---
 3 files changed, 16 insertions(+), 6 deletions(-)

(limited to 'src/Xanthous/Entities')

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
-- 
cgit 1.4.1