diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities/Character.hs')
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Entities/Character.hs | 241 |
1 files changed, 0 insertions, 241 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs deleted file mode 100644 index c8153086f1..0000000000 --- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs +++ /dev/null @@ -1,241 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} --------------------------------------------------------------------------------- -module Xanthous.Entities.Character - - ( -- * Character datatype - Character(..) - , characterName - , HasInventory(..) - , characterDamage - , characterHitpoints' - , characterHitpoints - , hitpointRecoveryRate - , speed - , body - - -- *** Body - , Body(..) - , initialBody - , knuckles - , Knuckles(..) - , fistDamageChance - , damageKnuckles - , fistfightingDamage - - -- * Character functions - , mkCharacter - , pickUpItem - , isDead - , isFullyHealed - , damage - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude --------------------------------------------------------------------------------- -import Brick -import Data.Aeson.Generic.DerivingVia -import Data.Aeson (ToJSON, FromJSON) -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 Control.Monad.State.Lazy (execState) -import Control.Monad.Trans.State.Lazy (execStateT) --------------------------------------------------------------------------------- -import Xanthous.Game.State -import Xanthous.Entities.Item -import Xanthous.Entities.Common -import Xanthous.Data - ( TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned ) -import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Util (EqEqProp(EqEqProp), modifyKL) -import Xanthous.Monad (say_) --------------------------------------------------------------------------------- - --- | 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) - , _characterHitpoints' :: !Double - , _speed :: !TicksPerTile - , _body :: !Body - } - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - Character -makeFieldsNoPrefix ''Character - -characterHitpoints :: Character -> Hitpoints -characterHitpoints = views characterHitpoints' floor - -scrollOffset :: Int -scrollOffset = 5 - -instance Draw Character where - draw _ = visibleRegion rloc rreg $ str "@" - where - rloc = Location (negate scrollOffset, negate scrollOffset) - rreg = (2 * scrollOffset, 2 * scrollOffset) - drawPriority = const maxBound -- Character should always be on top, for now - -instance Brain Character where - 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" - entityChar _ = "@" - -instance Arbitrary Character where - arbitrary = genericArbitrary - -initialHitpoints :: Hitpoints -initialHitpoints = 10 - -hitpointRecoveryRate :: Double `Per` Ticks -hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed) - -defaultSpeed :: TicksPerTile -defaultSpeed = 100 - -mkCharacter :: Character -mkCharacter = Character - { _inventory = mempty - , _characterName = Nothing - , _characterHitpoints' = fromIntegral initialHitpoints - , _speed = defaultSpeed - , _body = initialBody - } - -defaultCharacterDamage :: Hitpoints -defaultCharacterDamage = 1 - --- | Returns the damage that the character currently does with an attack --- TODO use double-handed/left-hand/right-hand here -characterDamage :: Character -> Hitpoints -characterDamage - = fromMaybe defaultCharacterDamage - . filter (/= 0) - . Just - . sumOf (inventory . wielded . wieldedItems . wieldableItem . Raw.damage) - --- | Is the character fully healed up to or past their initial hitpoints? -isFullyHealed :: Character -> Bool -isFullyHealed = (>= initialHitpoints) . characterHitpoints - --- | Is the character dead? -isDead :: Character -> Bool -isDead = (== 0) . characterHitpoints - -pickUpItem :: Item -> Character -> Character -pickUpItem it = inventory . backpack %~ (it <|) - -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) #-} |