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:
parent
4d2402a64e
commit
f00dd30cad
8 changed files with 229 additions and 20 deletions
|
@ -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]
|
||||
|
|
|
@ -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) #-}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
24
users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs
Normal file
24
users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs
Normal 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
|
||||
]
|
||||
]
|
||||
]
|
|
@ -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)
|
||||
]
|
||||
]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue