From 0802edda630246a0ff9f82196e55f09780ffa965 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 12 Jun 2016 03:44:53 +0200 Subject: Armour --- src/Main.hs | 25 ++++++++++++--- src/Sequence/Contact/Types.hs | 56 ++++++++++++++++++++++++++-------- src/Sequence/Contact/Types/Internal.hs | 22 +++++++------ src/Sequence/Utils.hs | 9 ++++++ 4 files changed, 85 insertions(+), 27 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index f409a04..a38b514 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -308,16 +308,31 @@ doShock dmg efLens = withFocus $ \focusId -> do if cripple ^. seApplied then guard $ dmg >= reBar else guard $ val >= bar + lStats . efLens . seApplied .= True (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ cripple ^. seEffect) lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect) lift $ shellPutStrLn effectName lift . addNote $ "Effect: " ++ effectName -takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState () -takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> do - gEntities . ix focusId . eStats . sDamage . ix zone += dmg - doShock dmg (sCripple . ix zone) - doShock dmg sPainShock +takeHit :: Int -> Completable (Set Hitzone) -> Completable DamageType -> Sh GameState () +takeHit dmg a1 a2 = flip withArg a1 $ \zones -> flip withArg a2 $ \dType -> withFocus $ \focusId -> forM_ zones $ \zone -> void . runMaybeT $ do + let + lStats :: Traversal' GameState Stats + lStats = gEntities . ix focusId . eStats + name <- toName focusId + armor <- MaybeT . preuse $ lStats . sArmor . ix zone + dmg' <- MaybeT . focusState lStats . evalFormula' name $ absorb armor dType dmg + forM_ (Map.toList dmg') $ \(dType, dmg) -> lift . runMaybeT $ do + guard $ dmg > 0 + lift $ shellPutStrLn $ name ++ " took " ++ show dmg ++ " " ++ show dType + case dType of + Fatigue -> lStats . sFatigue += dmg + _ -> lStats . sDamage . ix zone += dmg + case dType of + Fatigue -> lift $ doShock dmg sFatigueShock + _ -> lift $ do + doShock dmg (sCripple . ix zone) + doShock dmg sPainShock takeFatigue :: Int -> Sh GameState () takeFatigue dmg = withFocus $ \focusId -> do diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index 80d4360..9bb9903 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, RecordWildCards, OverloadedStrings, OverloadedLists, ViewPatterns, RankNTypes, ImpredicativeTypes, FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell, RecordWildCards, OverloadedStrings, OverloadedLists, ViewPatterns, RankNTypes, ImpredicativeTypes, FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-} module Sequence.Contact.Types ( module Sequence.Contact.Types @@ -38,18 +38,10 @@ instance IsString Hitzone where makePrisms ''Hitzone -makeLenses ''Armor - -instance Default Armor where - def = Armor - { _aBallistic = 0 - , _aPiercing = 0 - , _aBlunt = 0 - , _aHeat = 0 - , _aCold = 0 - , _aToxic = 0 - , _aExplosive = 0 - } +makePrisms ''DamageType + +instance {-# OVERLAPS #-} Default Armor where + def = const 0 makeLenses ''TestResult @@ -188,3 +180,41 @@ sUnconscious = folding $ do maxVitality <- preview sMaxVitality damage <- view sFatigue return $ liftM2 (>=) <$> Just (return damage) <*> maxVitality + +absorb :: Armor -> DamageType -> Int -> FormulaM Stats (Map DamageType Int) +absorb armor = absorb' Map.empty + where + absorb' :: Map DamageType Int -> DamageType -> Int -> FormulaM Stats (Map DamageType Int) + absorb' old dType dmg = do + mass <- maybe (return (Nothing :: Maybe Int)) (fmap Just) =<< preview (ctx . sAMass) + armor' <- wArmor dType + let + current = transmit mass dType $ min dmg armor' + new <- Map.unionsWith (+) <$> (sequence . Map.elems $ Map.mapWithKey (absorb' current) current) + return . Map.unionWith (+) (leftover mass dType . clamp $ dmg - armor') $ if old /= current then new else current + + wArmor :: DamageType -> Formula Stats + wArmor Passthrough = return $ 0 + wArmor Electric = (2 *) . maximum <$> mapM wArmor ([minBound..maxBound] \\ [Electric] :: [DamageType]) + wArmor x = armor x + + clamp n + | n <= 0 = 0 + | otherwise = n + + transmit, leftover :: Maybe Int -> DamageType -> Int -> Map DamageType Int + transmit _ Ballistic n = [ (Blunt, n) ] + transmit _ Piercing n = [ (Blunt, n) ] + transmit _ _ _ = [] + + + leftover (Just m) Blunt n = [ (Fatigue, min n m) + , (Blunt, clamp $ n - m) + ] + leftover (Just m) Cold n = [ (Fatigue, min n $ m * 2) + , (Cold, clamp $ n - m * 2) + ] + leftover _ Explosive n = [ (Fatigue, n) + , (Explosive, n) + ] + leftover _ dType n = [ (dType, n) ] diff --git a/src/Sequence/Contact/Types/Internal.hs b/src/Sequence/Contact/Types/Internal.hs index 0fe6266..6fde09d 100644 --- a/src/Sequence/Contact/Types/Internal.hs +++ b/src/Sequence/Contact/Types/Internal.hs @@ -17,15 +17,19 @@ import Data.CaseInsensitive (CI) newtype Hitzone = Hitzone { _hitzone :: CI String } deriving (Eq, Ord) -data Armor = Armor - { _aBallistic - , _aPiercing - , _aBlunt - , _aHeat - , _aCold - , _aToxic - , _aExplosive :: Int - } +type Armor = DamageType -> Formula Stats + +data DamageType = Ballistic + | Piercing + | Blunt + | Heat + | Cold + | Toxic + | Explosive + | Fatigue + | Electric + | Passthrough + deriving (Eq, Ord, Enum, Bounded, Show) data TestResult = CritSuccess { _rWith, _rBy :: Int } | Success { _rWith, _rBy :: Int } diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs index 1b52630..dc6657a 100644 --- a/src/Sequence/Utils.hs +++ b/src/Sequence/Utils.hs @@ -131,3 +131,12 @@ instance Argument (Set Hitzone) GameState where hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones) guard (hasGlob || ws `Set.isSubsetOf` hitzones) return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws + +instance Completion DamageType GameState where + completableLabel _ = "" + complete _ _ prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) $ map show ([minBound .. maxBound] :: [DamageType]) + +instance Argument DamageType GameState where + arg (CI.mk -> word) = return $ Map.lookup word types + where + types = Map.fromList [(CI.mk $ show dType, dType) | dType <- [minBound .. maxBound]] -- cgit v1.2.3