about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Entities/Character.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities/Character.hs')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Character.hs241
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 c8153086f1ac..000000000000
--- 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) #-}