From 7b90b02049f891f752fff7e0e228511077bbcb84 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Fri, 15 Nov 2019 21:20:01 -0500
Subject: Recover character hitpoints over time

Wrap hitpoints in a newtype, and recover character hitpoints over time
---
 src/Xanthous/Entities/Character.hs | 33 +++++++++++++++++++++++----------
 1 file changed, 23 insertions(+), 10 deletions(-)

(limited to 'src/Xanthous/Entities/Character.hs')

diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index e3cbb2c038ff..271492d6ce26 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -1,10 +1,13 @@
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Xanthous.Entities.Character
   ( Character(..)
   , characterName
   , inventory
   , characterDamage
+  , characterHitpoints'
   , characterHitpoints
+  , hitpointRecoveryRate
   , speed
 
     -- *
@@ -22,17 +25,18 @@ import Test.QuickCheck.Arbitrary.Generic
 import Brick
 import Data.Aeson.Generic.DerivingVia
 import Data.Aeson (ToJSON, FromJSON)
+import Data.Coerce (coerce)
 --------------------------------------------------------------------------------
 import Xanthous.Entities
 import Xanthous.Entities.Item
-import Xanthous.Data (TicksPerTile)
+import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned)
 --------------------------------------------------------------------------------
 
 data Character = Character
   { _inventory :: !(Vector Item)
   , _characterName :: !(Maybe Text)
-  , _characterDamage :: !Word
-  , _characterHitpoints :: !Word
+  , _characterDamage :: !Hitpoints
+  , _characterHitpoints' :: !Double
   , _speed :: TicksPerTile
   }
   deriving stock (Show, Eq, Generic)
@@ -42,6 +46,9 @@ data Character = Character
            Character
 makeLenses ''Character
 
+characterHitpoints :: Character -> Hitpoints
+characterHitpoints = views characterHitpoints' floor
+
 scrollOffset :: Int
 scrollOffset = 5
 
@@ -52,8 +59,11 @@ instance Draw Character where
       rreg = (2 * scrollOffset, 2 * scrollOffset)
   drawPriority = const maxBound -- Character should always be on top, for now
 
--- the character does not (yet) have a mind of its own
-instance Brain Character where step = brainVia Brainless
+instance Brain Character where
+  step ticks = (pure .) $ positioned . characterHitpoints' %~ \hp ->
+    if hp > fromIntegral initialHitpoints
+    then hp
+    else hp + hitpointRecoveryRate |*| ticks
 
 instance Entity Character where
   blocksVision _ = False
@@ -62,9 +72,12 @@ instance Entity Character where
 instance Arbitrary Character where
   arbitrary = genericArbitrary
 
-initialHitpoints :: Word
+initialHitpoints :: Hitpoints
 initialHitpoints = 10
 
+hitpointRecoveryRate :: Double `Per` Ticks
+hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed)
+
 defaultSpeed :: TicksPerTile
 defaultSpeed = 100
 
@@ -73,17 +86,17 @@ mkCharacter = Character
   { _inventory = mempty
   , _characterName = Nothing
   , _characterDamage = 1
-  , _characterHitpoints = initialHitpoints
+  , _characterHitpoints' = fromIntegral initialHitpoints
   , _speed = defaultSpeed
   }
 
 isDead :: Character -> Bool
-isDead = (== 0) . view characterHitpoints
+isDead = (== 0) . characterHitpoints
 
 pickUpItem :: Item -> Character -> Character
 pickUpItem item = inventory %~ (item <|)
 
-damage :: Word -> Character -> Character
-damage amount = characterHitpoints %~ \case
+damage :: Hitpoints -> Character -> Character
+damage (fromIntegral -> amount) = characterHitpoints' %~ \case
   n | n <= amount -> 0
     | otherwise  -> n - amount
-- 
cgit 1.4.1