Transfinite armor

3 files changed, 44 insertions, 14 deletions

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