Recover character hitpoints over time
Wrap hitpoints in a newtype, and recover character hitpoints over time
This commit is contained in:
parent
87fedcb6c9
commit
7b90b02049
6 changed files with 44 additions and 18 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue