From ce890f4b6fd478bf5a254390f5bc49e4afd97c8c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <pngwjpgh@users.noreply.github.com>
Date: Mon, 16 Jan 2017 18:10:17 +0100
Subject: Burstfire

---
 src/Sequence/Contact/Tests.hs | 56 +++++++++++++++++++++++++++++++++++++++----
 1 file changed, 51 insertions(+), 5 deletions(-)

(limited to 'src/Sequence/Contact/Tests.hs')

diff --git a/src/Sequence/Contact/Tests.hs b/src/Sequence/Contact/Tests.hs
index d10819e..be61ed3 100644
--- a/src/Sequence/Contact/Tests.hs
+++ b/src/Sequence/Contact/Tests.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, RecordWildCards #-}
 
 module Sequence.Contact.Tests
-  ( enactTest 
+  ( enactTest, enactTestMod
+  , critTables
   ) where
 
 import Sequence.Formula
@@ -12,6 +13,7 @@ import Sequence.Contact.Types
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Base
+import Control.Monad.Trans.Maybe
 import Control.Lens
 
 import Data.Default
@@ -29,6 +31,8 @@ import Data.Traversable (mapM)
 
 import Prelude hiding (mapM)
 
+import Debug.Trace
+
 tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test))
 tests = do
   baseTests <- mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest
@@ -94,6 +98,45 @@ tests = do
     skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x)
     attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) 
 
+critTables :: CI String -> (DiceResult -> Table (Maybe Effect))
+critTables skill CritSuccess{..}
+  | skill `elem` ([ "Handfeuerwaffen"
+                  , "Schwere Waffen"
+                  , "Energiewaffen"
+                  , "Archaische Distanzwaffen"
+                  ] :: [CI String])
+    || skill == "Fernkampfangriffe"
+  = cTable [ (1,  5,   Just "Ziel wird zu Boden geschleudert und verliert 10-(En) AP")
+           , (6,  15,  Just "Glückstreffer an einer ungepanzerten Stelle (Schutzwert 0)")
+           , (16, 25,  Just "Schwachstelle in der Panzerung getroffen (Halber Schutzwert)")
+           , (26, 35,  Just "Lähmender Schmerz (Ziel verliert 12-(En) AP)")
+           , (36, 55,  Just "Ziel wird zu Boden geworfen")
+           , (56, 75,  Just "Kopfschuss")
+           , (76, 95,  Just "1w10 Bonusschaden")
+           , (96, 100, Nothing)
+           ]
+  | otherwise = [(Nothing, 1)]
+critTables skill CritFailure{..}
+  | skill `elem` ([ "Handfeuerwaffen"
+                  , "Schwere Waffen"
+                  , "Energiewaffen"
+                  , "Archaische Distanzwaffen"
+                  ] :: [CI String])
+    || skill == "Fernkampfangriffe"
+  = cTable [ (1,  5,   Nothing)
+           , (6,  25,  Just "Ladehemmung oder andere Fehlfunktion der Waffe. Erfordert zum Beheben die gleiche Anzahl AP wie das vollständige Nachladen der Waffe.")
+           , (26, 45,  Just "Waffe wird fallengelassen")
+           , (46, 65,  Just "Ein anderer Charakter in der Nähe wird getroffen")
+           , (66, 75,  Just "Angreifer schießt sich selbst in den Fuß (voller Schaden, Trefferzone: ein Bein)")
+           , (76, 85,  Just "Waffe wird beschädigt und praktisch nutzlos (Qualität -100%)")
+           , (86, 95,  Just "Charakter verliert geladene Munition (fällt heraus oder zündet im Magazin)")
+           , (96, 100, Just $ "Unkoordinierter Schuss in eine zufällige Richtung"
+                            <> "Waffe wird fallengelassen"
+             )
+           ]
+  | otherwise = [(Nothing, 1)]
+critTables _ _ = [(Nothing, 1)]
+
 
 getTest :: String -> Fold Stats (FormulaM Stats Test)
 getTest (CI.mk -> str) = folding tests'
@@ -108,9 +151,12 @@ instance Argument (FormulaM Stats Test) GameState where
   arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str))
 
 enactTest :: Test -> FormulaM Stats TestResult
-enactTest rawTest = do
+enactTest rawTest = enactTestMod rawTest $ val ignored [CI.original (rawTest ^. tName), "Modifier"] False
+
+enactTestMod :: Test -> Formula Stats -> FormulaM Stats TestResult
+enactTestMod rawTest modFormula = do
   test <- foldM (&) rawTest =<< toListOf (ctx . sModifiers . folded . _Modifier . _2) <$> ask
-  manualMod <- val ignored [CI.original (rawTest ^. tName), "Modifier"] False
+  manualMod <- modFormula
   let
     critFailureBar = 95 - test^.tCritFailureMod
     critSuccessBar = 5 + test^.tCritSuccessMod
@@ -123,7 +169,7 @@ enactTest rawTest = do
       | pw >= critFailureBar = CritFailure
       | otherwise            = Failure
   dResult <- toResult <$> d 100
-  TestResult <$> pure dResult <*> (test ^. tEffect) dResult
+  TestResult <$> pure dResult <*> runMaybeT ((test ^. tEffect) dResult)
 
 -- hasTest :: Stats -> String -> Bool
 -- hasTest stats str = has (getTest str) stats
-- 
cgit v1.2.3