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 |     pEntity' <- step ticks pEntity | ||||||
|     entities . ix eid .= pEntity' |     entities . ix eid .= pEntity' | ||||||
| 
 | 
 | ||||||
|   whenM (uses (character . characterHitpoints) (== 0)) |   whenM (uses character isDead) | ||||||
|     . prompt_ @'Continue ["dead"] Uncancellable |     . prompt_ @'Continue ["dead"] Uncancellable | ||||||
|     . const . lift . liftIO |     . const . lift . liftIO | ||||||
|     $ exitSuccess |     $ exitSuccess | ||||||
|  | @ -186,7 +186,7 @@ handleCommand Eat = do | ||||||
|               in before <> fromMaybe Empty (tailMay after) |               in before <> fromMaybe Empty (tailMay after) | ||||||
|             let msg = fromMaybe (Messages.lookup ["eat", "eat"]) |             let msg = fromMaybe (Messages.lookup ["eat", "eat"]) | ||||||
|                       $ edibleItem ^. eatMessage |                       $ edibleItem ^. eatMessage | ||||||
|             character . characterHitpoints += |             character . characterHitpoints' += | ||||||
|               edibleItem ^. hitpointsHealed . to fromIntegral |               edibleItem ^. hitpointsHealed . to fromIntegral | ||||||
|             message msg $ object ["item" A..= item] |             message msg $ object ["item" A..= item] | ||||||
|   stepGame -- TODO |   stepGame -- TODO | ||||||
|  |  | ||||||
|  | @ -59,6 +59,9 @@ module Xanthous.Data | ||||||
|   , edges |   , edges | ||||||
|   , neighborDirections |   , neighborDirections | ||||||
|   , neighborPositions |   , neighborPositions | ||||||
|  | 
 | ||||||
|  |     -- * | ||||||
|  |   , Hitpoints(..) | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude hiding (Left, Down, Right) | import           Xanthous.Prelude hiding (Left, Down, Right) | ||||||
|  | @ -344,7 +347,7 @@ neighborPositions pos = (`move` pos) <$> neighborDirections | ||||||
| newtype Per a b = Rate Double | newtype Per a b = Rate Double | ||||||
|   deriving stock (Show, Eq, Generic) |   deriving stock (Show, Eq, Generic) | ||||||
|   deriving anyclass (NFData, CoArbitrary, Function) |   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 |   deriving (Semigroup, Monoid) via Product Double | ||||||
| instance Arbitrary (Per a b) where arbitrary = genericArbitrary | instance Arbitrary (Per a b) where arbitrary = genericArbitrary | ||||||
| 
 | 
 | ||||||
|  | @ -378,3 +381,13 @@ type TilesPerTick = Tiles `Per` Ticks | ||||||
| 
 | 
 | ||||||
| timesTiles :: TicksPerTile -> Tiles -> Ticks | timesTiles :: TicksPerTile -> Tiles -> Ticks | ||||||
| timesTiles = (|*|) | 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 #-} | {-# LANGUAGE TemplateHaskell #-} | ||||||
| module Xanthous.Entities.Character | module Xanthous.Entities.Character | ||||||
|   ( Character(..) |   ( Character(..) | ||||||
|   , characterName |   , characterName | ||||||
|   , inventory |   , inventory | ||||||
|   , characterDamage |   , characterDamage | ||||||
|  |   , characterHitpoints' | ||||||
|   , characterHitpoints |   , characterHitpoints | ||||||
|  |   , hitpointRecoveryRate | ||||||
|   , speed |   , speed | ||||||
| 
 | 
 | ||||||
|     -- * |     -- * | ||||||
|  | @ -22,17 +25,18 @@ import Test.QuickCheck.Arbitrary.Generic | ||||||
| import Brick | import Brick | ||||||
| import Data.Aeson.Generic.DerivingVia | import Data.Aeson.Generic.DerivingVia | ||||||
| import Data.Aeson (ToJSON, FromJSON) | import Data.Aeson (ToJSON, FromJSON) | ||||||
|  | import Data.Coerce (coerce) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import Xanthous.Entities | import Xanthous.Entities | ||||||
| import Xanthous.Entities.Item | import Xanthous.Entities.Item | ||||||
| import Xanthous.Data (TicksPerTile) | import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| data Character = Character | data Character = Character | ||||||
|   { _inventory :: !(Vector Item) |   { _inventory :: !(Vector Item) | ||||||
|   , _characterName :: !(Maybe Text) |   , _characterName :: !(Maybe Text) | ||||||
|   , _characterDamage :: !Word |   , _characterDamage :: !Hitpoints | ||||||
|   , _characterHitpoints :: !Word |   , _characterHitpoints' :: !Double | ||||||
|   , _speed :: TicksPerTile |   , _speed :: TicksPerTile | ||||||
|   } |   } | ||||||
|   deriving stock (Show, Eq, Generic) |   deriving stock (Show, Eq, Generic) | ||||||
|  | @ -42,6 +46,9 @@ data Character = Character | ||||||
|            Character |            Character | ||||||
| makeLenses ''Character | makeLenses ''Character | ||||||
| 
 | 
 | ||||||
|  | characterHitpoints :: Character -> Hitpoints | ||||||
|  | characterHitpoints = views characterHitpoints' floor | ||||||
|  | 
 | ||||||
| scrollOffset :: Int | scrollOffset :: Int | ||||||
| scrollOffset = 5 | scrollOffset = 5 | ||||||
| 
 | 
 | ||||||
|  | @ -52,8 +59,11 @@ instance Draw Character where | ||||||
|       rreg = (2 * scrollOffset, 2 * scrollOffset) |       rreg = (2 * scrollOffset, 2 * scrollOffset) | ||||||
|   drawPriority = const maxBound -- Character should always be on top, for now |   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 | ||||||
| instance Brain Character where step = brainVia Brainless |   step ticks = (pure .) $ positioned . characterHitpoints' %~ \hp -> | ||||||
|  |     if hp > fromIntegral initialHitpoints | ||||||
|  |     then hp | ||||||
|  |     else hp + hitpointRecoveryRate |*| ticks | ||||||
| 
 | 
 | ||||||
| instance Entity Character where | instance Entity Character where | ||||||
|   blocksVision _ = False |   blocksVision _ = False | ||||||
|  | @ -62,9 +72,12 @@ instance Entity Character where | ||||||
| instance Arbitrary Character where | instance Arbitrary Character where | ||||||
|   arbitrary = genericArbitrary |   arbitrary = genericArbitrary | ||||||
| 
 | 
 | ||||||
| initialHitpoints :: Word | initialHitpoints :: Hitpoints | ||||||
| initialHitpoints = 10 | initialHitpoints = 10 | ||||||
| 
 | 
 | ||||||
|  | hitpointRecoveryRate :: Double `Per` Ticks | ||||||
|  | hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed) | ||||||
|  | 
 | ||||||
| defaultSpeed :: TicksPerTile | defaultSpeed :: TicksPerTile | ||||||
| defaultSpeed = 100 | defaultSpeed = 100 | ||||||
| 
 | 
 | ||||||
|  | @ -73,17 +86,17 @@ mkCharacter = Character | ||||||
|   { _inventory = mempty |   { _inventory = mempty | ||||||
|   , _characterName = Nothing |   , _characterName = Nothing | ||||||
|   , _characterDamage = 1 |   , _characterDamage = 1 | ||||||
|   , _characterHitpoints = initialHitpoints |   , _characterHitpoints' = fromIntegral initialHitpoints | ||||||
|   , _speed = defaultSpeed |   , _speed = defaultSpeed | ||||||
|   } |   } | ||||||
| 
 | 
 | ||||||
| isDead :: Character -> Bool | isDead :: Character -> Bool | ||||||
| isDead = (== 0) . view characterHitpoints | isDead = (== 0) . characterHitpoints | ||||||
| 
 | 
 | ||||||
| pickUpItem :: Item -> Character -> Character | pickUpItem :: Item -> Character -> Character | ||||||
| pickUpItem item = inventory %~ (item <|) | pickUpItem item = inventory %~ (item <|) | ||||||
| 
 | 
 | ||||||
| damage :: Word -> Character -> Character | damage :: Hitpoints -> Character -> Character | ||||||
| damage amount = characterHitpoints %~ \case | damage (fromIntegral -> amount) = characterHitpoints' %~ \case | ||||||
|   n | n <= amount -> 0 |   n | n <= amount -> 0 | ||||||
|     | otherwise  -> n - amount |     | otherwise  -> n - amount | ||||||
|  |  | ||||||
|  | @ -78,7 +78,7 @@ initialHippocampus = Hippocampus Nothing | ||||||
| 
 | 
 | ||||||
| data Creature = Creature | data Creature = Creature | ||||||
|   { _creatureType :: !CreatureType |   { _creatureType :: !CreatureType | ||||||
|   , _hitpoints    :: !Word |   , _hitpoints    :: !Hitpoints | ||||||
|   , _hippocampus  :: !Hippocampus |   , _hippocampus  :: !Hippocampus | ||||||
|   } |   } | ||||||
|   deriving stock (Eq, Show, Generic) |   deriving stock (Eq, Show, Generic) | ||||||
|  | @ -99,7 +99,7 @@ newWithType _creatureType = | ||||||
|       _hippocampus = initialHippocampus |       _hippocampus = initialHippocampus | ||||||
|   in Creature {..} |   in Creature {..} | ||||||
| 
 | 
 | ||||||
| damage :: Word -> Creature -> Creature | damage :: Hitpoints -> Creature -> Creature | ||||||
| damage amount = hitpoints %~ \hp -> | damage amount = hitpoints %~ \hp -> | ||||||
|   if hp <= amount |   if hp <= amount | ||||||
|   then 0 |   then 0 | ||||||
|  |  | ||||||
|  | @ -29,13 +29,13 @@ import Data.Aeson (ToJSON, FromJSON) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import Xanthous.Entities (EntityChar, HasChar(..)) | import Xanthous.Entities (EntityChar, HasChar(..)) | ||||||
| import Xanthous.Messages (Message(..)) | import Xanthous.Messages (Message(..)) | ||||||
| import Xanthous.Data (TicksPerTile) | import Xanthous.Data (TicksPerTile, Hitpoints) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| data CreatureType = CreatureType | data CreatureType = CreatureType | ||||||
|   { _name         :: !Text |   { _name         :: !Text | ||||||
|   , _description  :: !Text |   , _description  :: !Text | ||||||
|   , _char         :: !EntityChar |   , _char         :: !EntityChar | ||||||
|   , _maxHitpoints :: !Word |   , _maxHitpoints :: !Hitpoints | ||||||
|   , _friendly     :: !Bool |   , _friendly     :: !Bool | ||||||
|   , _speed        :: !TicksPerTile |   , _speed        :: !TicksPerTile | ||||||
|   } |   } | ||||||
|  |  | ||||||
|  | @ -96,7 +96,7 @@ drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints | ||||||
|              = emptyWidget |              = emptyWidget | ||||||
|     charHitpoints |     charHitpoints | ||||||
|         = txt "Hitpoints: " |         = txt "Hitpoints: " | ||||||
|       <+> txt (tshow $ ch ^. characterHitpoints) |       <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp) | ||||||
| 
 | 
 | ||||||
| drawGame :: GameState -> [Widget Name] | drawGame :: GameState -> [Widget Name] | ||||||
| drawGame game | drawGame game | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue