From a016d9c507e906cba12f8d39d42a93e09ab4e7ec Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 9 Jul 2016 14:45:28 +0200 Subject: Transfinite armor --- src/Main.hs | 9 ++++++--- src/Sequence/Contact/Types.hs | 28 ++++++++++++++++++---------- src/Sequence/Contact/Types/Internal.hs | 21 ++++++++++++++++++++- 3 files changed, 44 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index 4b78ae2..3d098e2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -165,9 +165,12 @@ stateMaintenance = do return x isDead <- evalF =<< MaybeT (preuse $ lStats . sDead) isUnconscious <- evalF =<< MaybeT (preuse $ lStats . sUnconscious) - guard $ isDead || isUnconscious - when isDead . lift . shellPutStrLn $ name ++ " is dead" - when (isUnconscious && not isDead) . lift . shellPutStrLn $ name ++ " is unconscious" + isDestroyed <- evalF =<< MaybeT (preuse $ lStats . sDestroyed) + guard $ isDead || isUnconscious || isDestroyed + case (isDead, isDestroyed, isUnconscious) of + (True, _, _) -> lift . shellPutStrLn $ name ++ " is dead" + (_, True, _) -> lift . shellPutStrLn $ name ++ " is unconscious" + (_, _, True) -> lift . shellPutStrLn $ name ++ " is destroyed" gFocus' . eSeqVal .= Nothing -- gFocus .= Nothing void $ do diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index 2e8adcb..1d057fd 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs @@ -24,6 +24,7 @@ import Data.Maybe import Data.Ratio import Data.List import Data.Ord +import Data.ExtendedReal import Control.Monad.Reader (ask) import Control.Monad.State @@ -41,7 +42,7 @@ makePrisms ''Hitzone makePrisms ''DamageType instance {-# OVERLAPS #-} Default Armor where - def = const 0 + def = const $ return 0 makeLenses ''TestResult @@ -107,7 +108,9 @@ makeLenses ''Stats instance Default Stats where def = Prop - { _sSeqEpsilon = False + { _sRobustness = Nothing + + , _sSeqEpsilon = False , _sHitzones = [("Volumen", 1)] , _sArmor = const def @@ -169,31 +172,36 @@ sTotalDamage = lens retrieve $ flip spread | otherwise = damageMap z + d sDamage .= damageMap' -sDead :: Fold Stats (FormulaM Stats Bool) +sDead, sUnconscious, sDestroyed :: Fold Stats (FormulaM Stats Bool) sDead = folding $ do maxVitality <- preview sMaxVitality damage <- view sTotalDamage return $ liftM2 (>=) <$> Just (return damage) <*> maxVitality - -sUnconscious :: Fold Stats (FormulaM Stats Bool) sUnconscious = folding $ do maxVitality <- preview sMaxVitality damage <- view sFatigue return $ liftM2 (>=) <$> Just (return damage) <*> maxVitality +sDestroyed = folding $ do + robustness <- preview $ sRobustness . _Just + damage <- view sTotalDamage + return $ liftM2 (>=) <$> Just (return damage) <*> robustness absorb :: Armor -> DamageType -> Int -> FormulaM Stats (Map DamageType Int) -absorb armor = absorb' Map.empty +absorb armor dType (Finite -> dmg) = fmap ensureFinite <$> absorb' Map.empty dType dmg where - absorb' :: Map DamageType Int -> DamageType -> Int -> FormulaM Stats (Map DamageType Int) + 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) + mass <- maybe (return (Nothing :: Maybe Int')) (fmap $ Just . Finite) =<< 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 + ensureFinite (Finite n) = n + ensureFinite _ = error "Infinite amounts of damage should not occur" + + wArmor :: DamageType -> FormulaM Stats Int' wArmor Passthrough = 0 wArmor Fatigue = 0 wArmor Electric = (2 *) . maximum <$> mapM wArmor ([minBound..maxBound] \\ [Electric] :: [DamageType]) @@ -203,7 +211,7 @@ absorb armor = absorb' Map.empty | n <= 0 = 0 | otherwise = n - transmit, leftover :: Maybe Int -> DamageType -> Int -> Map DamageType Int + transmit, leftover :: Maybe Int' -> DamageType -> Int' -> Map DamageType Int' transmit _ Ballistic n = [ (Blunt, n) ] transmit _ Piercing n = [ (Blunt, n) ] transmit _ _ _ = [] diff --git a/src/Sequence/Contact/Types/Internal.hs b/src/Sequence/Contact/Types/Internal.hs index 6fde09d..fef2792 100644 --- a/src/Sequence/Contact/Types/Internal.hs +++ b/src/Sequence/Contact/Types/Internal.hs @@ -14,10 +14,29 @@ import Control.Lens import Data.CaseInsensitive (CI) +import Data.ExtendedReal + newtype Hitzone = Hitzone { _hitzone :: CI String } deriving (Eq, Ord) -type Armor = DamageType -> Formula Stats +type Int' = Extended Int + +type Armor = DamageType -> FormulaM Stats Int' + +instance Enum a => Enum (Extended a) where + toEnum = Finite . toEnum + fromEnum (Finite n) = fromEnum n + fromEnum _ = error "Cannot convert infinite value to Int" + +instance Real a => Real (Extended a) where + toRational (Finite r) = toRational r + toRational _ = error "Connot convert infinite value to Rational" + +instance Integral a => Integral (Extended a) where + toInteger (Finite n) = toInteger n + toInteger _ = error "Connot convert infinite value to Integer" + quotRem (Finite x) (Finite y) = quotRem x y & over each Finite + quotRem x _ = (0, x) data DamageType = Ballistic | Piercing -- cgit v1.2.3