From f00dd30cad191bf53729fdedf66d49e9b539e19e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 18 Jun 2021 16:07:39 -0400 Subject: feat(xanthous): Fistfighting builds knuckle calluses 2000 ticks after the character damages their fists by hitting something, the character now develops calluses on their fists (scaled by *how* damaged they've become) that reduce the chance of them receiving additional damage from hitting things - up to a max of 5, which prevents *all* damage from fistfighting. This is all tracked in a new "Knuckles" struct in a new "Body" struct on the character datatype, which manages stepping itself forward as part of the Brain impl on the character. Change-Id: Ica269f16fb340fb25900d2c77fbad32f10c00be2 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3222 Reviewed-by: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/App.hs | 15 ++- .../xanthous/src/Xanthous/Entities/Character.hs | 149 +++++++++++++++++++-- users/grfn/xanthous/src/Xanthous/Util.hs | 39 +++++- users/grfn/xanthous/src/Xanthous/messages.yaml | 8 ++ 4 files changed, 192 insertions(+), 19 deletions(-) (limited to 'users/grfn/xanthous/src') diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index fa4ef2d6a5c3..1e915a03fe05 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -362,10 +362,7 @@ attackAt pos = message msg msgParams entities . ix creatureID . positioned .= SomeEntity creature' - whenM (uses character $ isNothing . weapon) - $ whenM (chance (0.08 :: Float)) $ do - say_ ["combat", "fistSelfDamage"] - character %= Character.damage 1 + whenM (uses character $ isNothing . weapon) handleFists stepGame -- TODO weapon chr = chr ^? inventory . wielded . wieldedItems . wieldableItem @@ -377,6 +374,16 @@ attackAt pos = Nothing -> Messages.lookup ["combat", "hit", "fists"] + handleFists = do + damageChance <- use $ character . body . knuckles . to fistDamageChance + whenM (chance damageChance) $ do + damageAmount <- use $ character . body . knuckles . to fistfightingDamage + say_ [ "combat" , if damageAmount > 1 + then "fistExtraSelfDamage" + else "fistSelfDamage" ] + character %= Character.damage damageAmount + character . body . knuckles %= damageKnuckles + entityMenu_ :: (Comonad w, Entity entity) => [w entity] 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) #-} diff --git a/users/grfn/xanthous/src/Xanthous/Util.hs b/users/grfn/xanthous/src/Xanthous/Util.hs index 524ad4819dac..189e781e6cec 100644 --- a/users/grfn/xanthous/src/Xanthous/Util.hs +++ b/users/grfn/xanthous/src/Xanthous/Util.hs @@ -30,7 +30,10 @@ module Xanthous.Util , minimum1 -- * Combinators - , times, times_ + , times, times_, endoTimes + + -- * State utilities + , modifyK, modifyKL -- * Type-level programming utils , KnownBool(..) @@ -45,6 +48,7 @@ import Data.Proxy import qualified Data.Vector as V import Data.Semigroup (Max(..), Min(..)) import Data.Semigroup.Foldable +import Control.Monad.State.Class -------------------------------------------------------------------------------- newtype EqEqProp a = EqEqProp a @@ -237,6 +241,13 @@ times n f = traverse f [1..n] times_ :: (Applicative f, Num n, Enum n) => n -> f a -> f [a] times_ n fa = times n (const fa) +-- | Multiply an endomorphism by an integral +-- +-- >>> endoTimes (4 :: Int) succ (5 :: Int) +-- 9 +endoTimes :: Integral n => n -> (a -> a) -> a -> a +endoTimes n f = appEndo $ stimes n (Endo f) + -------------------------------------------------------------------------------- -- | This class gives a boolean associated with a type-level bool, a'la @@ -250,3 +261,29 @@ class KnownBool (bool :: Bool) where instance KnownBool 'True where boolVal = True instance KnownBool 'False where boolVal = False + +-------------------------------------------------------------------------------- + +-- | Modify some monadic state via the application of a kleisli endomorphism on +-- the state itself +-- +-- Note that any changes made to the state during execution of @k@ will be +-- overwritten +-- +-- @@ +-- modifyK pure === pure () +-- @@ +modifyK :: MonadState s m => (s -> m s) -> m () +modifyK k = get >>= k >>= put + +-- | Modify some monadic state via the application of a kleisli endomorphism on +-- the target of a lens +-- +-- Note that any changes made to the state during execution of @k@ will be +-- overwritten +-- +-- @@ +-- modifyKL id pure === pure () +-- @@ +modifyKL :: MonadState s m => LensLike m s s a b -> (a -> m b) -> m () +modifyKL l k = get >>= traverseOf l k >>= put diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml index e3ebd8bebec2..710c0c17b067 100644 --- a/users/grfn/xanthous/src/Xanthous/messages.yaml +++ b/users/grfn/xanthous/src/Xanthous/messages.yaml @@ -57,6 +57,11 @@ look: character: namePrompt: "What's your name? " + body: + knuckles: + calluses: + - You've started developing calluses on your knuckles from all the punching you've been doing. + - You've been fighting with your fists so much they're starting to develop calluses. combat: nothingToAttack: There's nothing to attack there. @@ -64,6 +69,9 @@ combat: fistSelfDamage: - You hit so hard with your fists you hurt yourself! - The punch leaves your knuckles bloody! + fistExtraSelfDamage: + - You hurt your already-bloody fists with the strike! + - Ouch! Your fists were already bleeding! hit: fists: - You punch the {{creature.creatureType.name}} with your bare fists! It hurts. A lot. -- cgit 1.4.1