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 <grfn@gws.fyi>
Tested-by: BuildkiteCI
This commit is contained in:
Griffin Smith 2021-06-18 16:07:39 -04:00 committed by grfn
parent 4d2402a64e
commit f00dd30cad
8 changed files with 229 additions and 20 deletions

View file

@ -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]

View file

@ -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) #-}

View file

@ -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

View file

@ -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.

View file

@ -10,6 +10,7 @@ import qualified Xanthous.Data.MemoSpec
import qualified Xanthous.Data.NestedMapSpec
import qualified Xanthous.DataSpec
import qualified Xanthous.Entities.RawsSpec
import qualified Xanthous.Entities.CharacterSpec
import qualified Xanthous.GameSpec
import qualified Xanthous.Game.StateSpec
import qualified Xanthous.Generators.Level.UtilSpec
@ -36,6 +37,7 @@ test = testGroup "Xanthous"
, Xanthous.Data.NestedMapSpec.test
, Xanthous.DataSpec.test
, Xanthous.Entities.RawsSpec.test
, Xanthous.Entities.CharacterSpec.test
, Xanthous.GameSpec.test
, Xanthous.Game.StateSpec.test
, Xanthous.Generators.Level.UtilSpec.test

View file

@ -0,0 +1,24 @@
{-# OPTIONS_GHC -Wno-type-defaults #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.CharacterSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
--------------------------------------------------------------------------------
import Xanthous.Entities.Character
import Xanthous.Util (endoTimes)
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Entities.CharacterSpec"
[ testGroup "Knuckles"
[ testBatch $ monoid @Knuckles mempty
, testGroup "damageKnuckles"
[ testCase "caps at 5" $
let knuckles' = endoTimes 6 damageKnuckles mempty
in _knuckleDamage knuckles' @?= 5
]
]
]

View file

@ -2,6 +2,7 @@ module Xanthous.UtilSpec (main, test) where
import Test.Prelude
import Xanthous.Util
import Control.Monad.State.Lazy (execState)
main :: IO ()
main = defaultMain test
@ -25,4 +26,12 @@ test = testGroup "Xanthous.Util"
[ testProperty "takeWhileInclusive (const True) ≡ id"
$ \(xs :: [Int]) -> takeWhileInclusive (const True) xs === xs
]
, testGroup "endoTimes"
[ testCase "endoTimes 4 succ 5"
$ endoTimes (4 :: Int) succ (5 :: Int) @?= 9
]
, testGroup "modifyKL"
[ testCase "_1 += 1"
$ execState (modifyKL _1 $ pure . succ) (1 :: Int, 2 :: Int) @?= (2, 2)
]
]

View file

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 715e0ab333afb8723ffec128cf69c065f6f018e9622d65c45d404e5084852f54
-- hash: b39d4dd906804ca42f8965c2dbe519434e80622fef7fafce1dca0d211a1c6663
name: xanthous
version: 0.1.0.0
@ -355,6 +355,7 @@ test-suite test
Xanthous.Data.MemoSpec
Xanthous.Data.NestedMapSpec
Xanthous.DataSpec
Xanthous.Entities.CharacterSpec
Xanthous.Entities.RawsSpec
Xanthous.Game.StateSpec
Xanthous.GameSpec