Transfinite armor

5 files changed, 52 insertions, 21 deletions

diff --git a/sequence.cabal b/sequence.cabal
index 740a975..d47291e 100644
--- a/sequence.cabal
+++ b/sequence.cabal
@@ -40,5 +40,6 @@ executable sequence
                      , text
                      , template
                      , regex-compat
+                     , extended-reals
   hs-source-dirs:      src
   default-language:    Haskell2010
\ No newline at end of file
diff --git a/sequence.nix b/sequence.nix
index e0d93b7..1dc252a 100644
--- a/sequence.nix
+++ b/sequence.nix
@@ -1,8 +1,8 @@
 { mkDerivation, ansi-terminal, base, bimap, case-insensitive
-, containers, data-default, directory, filepath, game-probability
-, lens, mtl, readline, regex-compat, Shellac, Shellac-haskeline
-, stdenv, table-layout, template, text, transformers
-, transformers-base, xdg-basedir
+, containers, data-default, directory, extended-reals, filepath
+, game-probability, lens, mtl, readline, regex-compat, Shellac
+, Shellac-haskeline, stdenv, table-layout, template, text
+, transformers, transformers-base, xdg-basedir
 }:
 mkDerivation {
   pname = "sequence";
@@ -12,9 +12,9 @@ mkDerivation {
   isExecutable = true;
   executableHaskellDepends = [
     ansi-terminal base bimap case-insensitive containers data-default
-    directory filepath game-probability lens mtl readline regex-compat
-    Shellac Shellac-haskeline table-layout template text transformers
-    transformers-base xdg-basedir
+    directory extended-reals filepath game-probability lens mtl
+    readline regex-compat Shellac Shellac-haskeline table-layout
+    template text transformers transformers-base xdg-basedir
   ];
   license = stdenv.lib.licenses.mit;
 }
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