From ae1ea97cdcca8d230dbee9460ae5d28242404d20 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 12 Jun 2016 16:13:08 +0200 Subject: damage modifiers --- src/Sequence/Contact/Archetypes.hs | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index 5f431de..d790917 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, RankNTypes #-} module Sequence.Contact.Archetypes where @@ -18,6 +18,9 @@ import Sequence.Utils import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + import Data.Default import Data.Maybe import Data.Ratio @@ -72,6 +75,19 @@ amputate zone = Effect (CI.mk $ review hitzone zone ++ " ist verloren") . runMay sHitzones %= Map.delete zone sMaxVitality %= view (mapping . scaled $ 1 - zoneProp) +damageMods :: Set Modifier +damageMods = [ Modifier "Schmerz" $ damageMod sTotalDamage sPainTolerance + , Modifier "Erschöpfung" $ damageMod sFatigue sFatigueTolerance + ] + where + damageMod :: Traversal' Stats Int -> Traversal' Stats (Formula Stats) -> Test -> FormulaM Stats Test + damageMod lDmg lTolerance test = fmap (fromMaybe test) . runMaybeT $ do + dmg <- MaybeT (preview $ ctx . lDmg) + tolerance <- lift =<< MaybeT (preview $ ctx . lTolerance) + guard $ dmg > tolerance + let mod = dmg - tolerance + return $ test & over tMod (+ mod) + human = Humanoid { _sAStrength = vStrength , _sAEndurance = vEndurance @@ -192,7 +208,7 @@ human = Humanoid ]) , _sExtraSkills = [] - , _sModifiers = [] + , _sModifiers = damageMods } where arm zone = def -- cgit v1.2.3