diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities')
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Entities/Character.hs | 149 |
1 files changed, 135 insertions, 14 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs index f27ed1e475d6..b073f0d0719b 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs @@ -1,6 +1,10 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- module Xanthous.Entities.Character - ( Character(..) + + ( -- * Character datatype + Character(..) , characterName , inventory , characterDamage @@ -8,13 +12,14 @@ module Xanthous.Entities.Character , characterHitpoints , hitpointRecoveryRate , speed + , body - -- * Inventory + -- ** Inventory , Inventory(..) , backpack , wielded , items - -- ** Wielded items + -- *** Wielded items , Wielded(..) , hands , leftHand @@ -28,7 +33,16 @@ module Xanthous.Entities.Character , wieldableItem , asWieldedItem - -- * + -- *** Body + , Body(..) + , initialBody + , knuckles + , Knuckles(..) + , fistDamageChance + , damageKnuckles + , fistfightingDamage + + -- * Character functions , mkCharacter , pickUpItem , isDead @@ -45,6 +59,8 @@ import Data.Coerce (coerce) import Test.QuickCheck import Test.QuickCheck.Instances.Vector () import Test.QuickCheck.Arbitrary.Generic +import Test.QuickCheck.Gen (chooseUpTo) +import Test.QuickCheck.Checkers (EqProp) -------------------------------------------------------------------------------- import Xanthous.Util.QuickCheck import Xanthous.Game.State @@ -55,6 +71,10 @@ import Xanthous.Data ) import Xanthous.Entities.RawTypes (WieldableItem, wieldable) import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Util (EqEqProp(EqEqProp), modifyKL) +import Control.Monad.State.Lazy (execState) +import Control.Monad.Trans.State.Lazy (execStateT) +import Xanthous.Monad (say_) -------------------------------------------------------------------------------- data WieldedItem = WieldedItem @@ -199,11 +219,107 @@ instance Monoid Inventory where -------------------------------------------------------------------------------- +-- | The status of the character's knuckles +-- +-- This struct is used to track the damage and then eventual build-up of +-- calluses when the character is fighting with their fists +data Knuckles = Knuckles + { -- | How damaged are the knuckles currently, from 0 to 5? + -- + -- At 0, no calluses will form + -- At 1 and up, the character will form calluses after a while + -- At 5, continuing to fistfight will deal the character even more damage + _knuckleDamage :: !Word + -- | How built-up are the character's calluses, from 0 to 5? + -- + -- Each level of calluses decreases the likelihood of being damaged when + -- fistfighting by 1%, up to 5 where the character will never be damaged + -- fistfighting + , _knuckleCalluses :: !Word + + -- | Number of turns that have passed since the last time the knuckles were + -- damaged + , _ticksSinceDamaged :: Ticks + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving EqProp via EqEqProp Knuckles + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Knuckles +makeLenses ''Knuckles + +instance Semigroup Knuckles where + (Knuckles d₁ c₁ t₁) <> (Knuckles d₂ c₂ t₂) = Knuckles + (min (d₁ + d₂) 5) + (min (c₁ + c₂) 5) + (max t₁ t₂) + +instance Monoid Knuckles where + mempty = Knuckles 0 0 0 + +instance Arbitrary Knuckles where + arbitrary = do + _knuckleDamage <- fromIntegral <$> chooseUpTo 5 + _knuckleCalluses <- fromIntegral <$> chooseUpTo 5 + _ticksSinceDamaged <- arbitrary + pure Knuckles{..} + +-- | Likelihood that the character fighting with their fists will damage +-- themselves +fistDamageChance :: Knuckles -> Float +fistDamageChance knuckles + | calluses == 5 = 0 + | otherwise = baseChance - (0.01 * fromIntegral calluses) + where + baseChance = 0.08 + calluses = knuckles ^. knuckleCalluses + +-- | Damage the knuckles by a level (capping at the max knuckle damage) +damageKnuckles :: Knuckles -> Knuckles +damageKnuckles = execState $ do + knuckleDamage %= min 5 . succ + ticksSinceDamaged .= 0 + +-- | Damage taken when fistfighting and 'fistDamageChance' has occurred +fistfightingDamage :: Knuckles -> Hitpoints +fistfightingDamage knuckles + | knuckles ^. knuckleDamage == 5 = 2 + | otherwise = 1 + +stepKnuckles :: Ticks -> Knuckles -> AppM Knuckles +stepKnuckles ticks = execStateT . whenM (uses knuckleDamage (> 0)) $ do + ticksSinceDamaged += ticks + whenM (uses ticksSinceDamaged (>= 2000)) $ do + dam <- knuckleDamage <<.= 0 + knuckleCalluses %= min 5 . (+ dam) + ticksSinceDamaged .= 0 + lift $ say_ ["character", "body", "knuckles", "calluses"] + + +-- | Status of the character's body +data Body = Body + { _knuckles :: !Knuckles + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Body + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Body +makeLenses ''Body + +initialBody :: Body +initialBody = Body { _knuckles = mempty } + +-------------------------------------------------------------------------------- + data Character = Character - { _inventory :: !Inventory - , _characterName :: !(Maybe Text) + { _inventory :: !Inventory + , _characterName :: !(Maybe Text) , _characterHitpoints' :: !Double - , _speed :: TicksPerTile + , _speed :: !TicksPerTile + , _body :: !Body } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -226,10 +342,12 @@ instance Draw Character where drawPriority = const maxBound -- Character should always be on top, for now instance Brain Character where - step ticks = (pure .) $ positioned . characterHitpoints' %~ \hp -> - if hp > fromIntegral initialHitpoints - then hp - else hp + hitpointRecoveryRate |*| ticks + step ticks = execStateT $ do + positioned . characterHitpoints' %= \hp -> + if hp > fromIntegral initialHitpoints + then hp + else hp + hitpointRecoveryRate |*| ticks + modifyKL (positioned . body . knuckles) $ lift . stepKnuckles ticks instance Entity Character where description _ = "yourself" @@ -249,10 +367,11 @@ defaultSpeed = 100 mkCharacter :: Character mkCharacter = Character - { _inventory = mempty - , _characterName = Nothing + { _inventory = mempty + , _characterName = Nothing , _characterHitpoints' = fromIntegral initialHitpoints - , _speed = defaultSpeed + , _speed = defaultSpeed + , _body = initialBody } defaultCharacterDamage :: Hitpoints @@ -280,3 +399,5 @@ damage :: Hitpoints -> Character -> Character damage (fromIntegral -> amount) = characterHitpoints' %~ \case n | n <= amount -> 0 | otherwise -> n - amount + +{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} |