Recover character hitpoints over time

Wrap hitpoints in a newtype, and recover character hitpoints over time
This commit is contained in:
Griffin Smith 2019-11-15 21:20:01 -05:00
parent 87fedcb6c9
commit 7b90b02049
6 changed files with 44 additions and 18 deletions

View file

@ -95,7 +95,7 @@ stepGameBy ticks = do
pEntity' <- step ticks pEntity
entities . ix eid .= pEntity'
whenM (uses (character . characterHitpoints) (== 0))
whenM (uses character isDead)
. prompt_ @'Continue ["dead"] Uncancellable
. const . lift . liftIO
$ exitSuccess
@ -186,7 +186,7 @@ handleCommand Eat = do
in before <> fromMaybe Empty (tailMay after)
let msg = fromMaybe (Messages.lookup ["eat", "eat"])
$ edibleItem ^. eatMessage
character . characterHitpoints +=
character . characterHitpoints' +=
edibleItem ^. hitpointsHealed . to fromIntegral
message msg $ object ["item" A..= item]
stepGame -- TODO

View file

@ -59,6 +59,9 @@ module Xanthous.Data
, edges
, neighborDirections
, neighborPositions
-- *
, Hitpoints(..)
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude hiding (Left, Down, Right)
@ -344,7 +347,7 @@ neighborPositions pos = (`move` pos) <$> neighborDirections
newtype Per a b = Rate Double
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (Num, Ord, Enum, Real, ToJSON, FromJSON) via Double
deriving (Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) via Double
deriving (Semigroup, Monoid) via Product Double
instance Arbitrary (Per a b) where arbitrary = genericArbitrary
@ -378,3 +381,13 @@ type TilesPerTick = Tiles `Per` Ticks
timesTiles :: TicksPerTile -> Tiles -> Ticks
timesTiles = (|*|)
--------------------------------------------------------------------------------
newtype Hitpoints = Hitpoints Word
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON)
via Word
deriving (Semigroup, Monoid) via Sum Word

View file

@ -1,10 +1,13 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
module Xanthous.Entities.Character
( Character(..)
, characterName
, inventory
, characterDamage
, characterHitpoints'
, characterHitpoints
, hitpointRecoveryRate
, speed
-- *
@ -22,17 +25,18 @@ import Test.QuickCheck.Arbitrary.Generic
import Brick
import Data.Aeson.Generic.DerivingVia
import Data.Aeson (ToJSON, FromJSON)
import Data.Coerce (coerce)
--------------------------------------------------------------------------------
import Xanthous.Entities
import Xanthous.Entities.Item
import Xanthous.Data (TicksPerTile)
import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned)
--------------------------------------------------------------------------------
data Character = Character
{ _inventory :: !(Vector Item)
, _characterName :: !(Maybe Text)
, _characterDamage :: !Word
, _characterHitpoints :: !Word
, _characterDamage :: !Hitpoints
, _characterHitpoints' :: !Double
, _speed :: TicksPerTile
}
deriving stock (Show, Eq, Generic)
@ -42,6 +46,9 @@ data Character = Character
Character
makeLenses ''Character
characterHitpoints :: Character -> Hitpoints
characterHitpoints = views characterHitpoints' floor
scrollOffset :: Int
scrollOffset = 5
@ -52,8 +59,11 @@ instance Draw Character where
rreg = (2 * scrollOffset, 2 * scrollOffset)
drawPriority = const maxBound -- Character should always be on top, for now
-- the character does not (yet) have a mind of its own
instance Brain Character where step = brainVia Brainless
instance Brain Character where
step ticks = (pure .) $ positioned . characterHitpoints' %~ \hp ->
if hp > fromIntegral initialHitpoints
then hp
else hp + hitpointRecoveryRate |*| ticks
instance Entity Character where
blocksVision _ = False
@ -62,9 +72,12 @@ instance Entity Character where
instance Arbitrary Character where
arbitrary = genericArbitrary
initialHitpoints :: Word
initialHitpoints :: Hitpoints
initialHitpoints = 10
hitpointRecoveryRate :: Double `Per` Ticks
hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed)
defaultSpeed :: TicksPerTile
defaultSpeed = 100
@ -73,17 +86,17 @@ mkCharacter = Character
{ _inventory = mempty
, _characterName = Nothing
, _characterDamage = 1
, _characterHitpoints = initialHitpoints
, _characterHitpoints' = fromIntegral initialHitpoints
, _speed = defaultSpeed
}
isDead :: Character -> Bool
isDead = (== 0) . view characterHitpoints
isDead = (== 0) . characterHitpoints
pickUpItem :: Item -> Character -> Character
pickUpItem item = inventory %~ (item <|)
damage :: Word -> Character -> Character
damage amount = characterHitpoints %~ \case
damage :: Hitpoints -> Character -> Character
damage (fromIntegral -> amount) = characterHitpoints' %~ \case
n | n <= amount -> 0
| otherwise -> n - amount

View file

@ -78,7 +78,7 @@ initialHippocampus = Hippocampus Nothing
data Creature = Creature
{ _creatureType :: !CreatureType
, _hitpoints :: !Word
, _hitpoints :: !Hitpoints
, _hippocampus :: !Hippocampus
}
deriving stock (Eq, Show, Generic)
@ -99,7 +99,7 @@ newWithType _creatureType =
_hippocampus = initialHippocampus
in Creature {..}
damage :: Word -> Creature -> Creature
damage :: Hitpoints -> Creature -> Creature
damage amount = hitpoints %~ \hp ->
if hp <= amount
then 0

View file

@ -29,13 +29,13 @@ import Data.Aeson (ToJSON, FromJSON)
--------------------------------------------------------------------------------
import Xanthous.Entities (EntityChar, HasChar(..))
import Xanthous.Messages (Message(..))
import Xanthous.Data (TicksPerTile)
import Xanthous.Data (TicksPerTile, Hitpoints)
--------------------------------------------------------------------------------
data CreatureType = CreatureType
{ _name :: !Text
, _description :: !Text
, _char :: !EntityChar
, _maxHitpoints :: !Word
, _maxHitpoints :: !Hitpoints
, _friendly :: !Bool
, _speed :: !TicksPerTile
}

View file

@ -96,7 +96,7 @@ drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
= emptyWidget
charHitpoints
= txt "Hitpoints: "
<+> txt (tshow $ ch ^. characterHitpoints)
<+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp)
drawGame :: GameState -> [Widget Name]
drawGame game