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…
	
	Add table
		Add a link
		
	
		Reference in a new issue