summaryrefslogtreecommitdiff
path: root/src/Sequence/Contact/Tests.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sequence/Contact/Tests.hs')
-rw-r--r--src/Sequence/Contact/Tests.hs56
1 files changed, 51 insertions, 5 deletions
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 @@
1{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances #-} 1{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, RecordWildCards #-}
2 2
3module Sequence.Contact.Tests 3module Sequence.Contact.Tests
4 ( enactTest 4 ( enactTest, enactTestMod
5 , critTables
5 ) where 6 ) where
6 7
7import Sequence.Formula 8import Sequence.Formula
@@ -12,6 +13,7 @@ import Sequence.Contact.Types
12import Control.Monad 13import Control.Monad
13import Control.Monad.Reader 14import Control.Monad.Reader
14import Control.Monad.Base 15import Control.Monad.Base
16import Control.Monad.Trans.Maybe
15import Control.Lens 17import Control.Lens
16 18
17import Data.Default 19import Data.Default
@@ -29,6 +31,8 @@ import Data.Traversable (mapM)
29 31
30import Prelude hiding (mapM) 32import Prelude hiding (mapM)
31 33
34import Debug.Trace
35
32tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) 36tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test))
33tests = do 37tests = do
34 baseTests <- mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest 38 baseTests <- mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest
@@ -94,6 +98,45 @@ tests = do
94 skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x) 98 skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x)
95 attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) 99 attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x)
96 100
101critTables :: CI String -> (DiceResult -> Table (Maybe Effect))
102critTables skill CritSuccess{..}
103 | skill `elem` ([ "Handfeuerwaffen"
104 , "Schwere Waffen"
105 , "Energiewaffen"
106 , "Archaische Distanzwaffen"
107 ] :: [CI String])
108 || skill == "Fernkampfangriffe"
109 = cTable [ (1, 5, Just "Ziel wird zu Boden geschleudert und verliert 10-(En) AP")
110 , (6, 15, Just "Glückstreffer an einer ungepanzerten Stelle (Schutzwert 0)")
111 , (16, 25, Just "Schwachstelle in der Panzerung getroffen (Halber Schutzwert)")
112 , (26, 35, Just "Lähmender Schmerz (Ziel verliert 12-(En) AP)")
113 , (36, 55, Just "Ziel wird zu Boden geworfen")
114 , (56, 75, Just "Kopfschuss")
115 , (76, 95, Just "1w10 Bonusschaden")
116 , (96, 100, Nothing)
117 ]
118 | otherwise = [(Nothing, 1)]
119critTables skill CritFailure{..}
120 | skill `elem` ([ "Handfeuerwaffen"
121 , "Schwere Waffen"
122 , "Energiewaffen"
123 , "Archaische Distanzwaffen"
124 ] :: [CI String])
125 || skill == "Fernkampfangriffe"
126 = cTable [ (1, 5, Nothing)
127 , (6, 25, Just "Ladehemmung oder andere Fehlfunktion der Waffe. Erfordert zum Beheben die gleiche Anzahl AP wie das vollständige Nachladen der Waffe.")
128 , (26, 45, Just "Waffe wird fallengelassen")
129 , (46, 65, Just "Ein anderer Charakter in der Nähe wird getroffen")
130 , (66, 75, Just "Angreifer schießt sich selbst in den Fuß (voller Schaden, Trefferzone: ein Bein)")
131 , (76, 85, Just "Waffe wird beschädigt und praktisch nutzlos (Qualität -100%)")
132 , (86, 95, Just "Charakter verliert geladene Munition (fällt heraus oder zündet im Magazin)")
133 , (96, 100, Just $ "Unkoordinierter Schuss in eine zufällige Richtung"
134 <> "Waffe wird fallengelassen"
135 )
136 ]
137 | otherwise = [(Nothing, 1)]
138critTables _ _ = [(Nothing, 1)]
139
97 140
98getTest :: String -> Fold Stats (FormulaM Stats Test) 141getTest :: String -> Fold Stats (FormulaM Stats Test)
99getTest (CI.mk -> str) = folding tests' 142getTest (CI.mk -> str) = folding tests'
@@ -108,9 +151,12 @@ instance Argument (FormulaM Stats Test) GameState where
108 arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str)) 151 arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str))
109 152
110enactTest :: Test -> FormulaM Stats TestResult 153enactTest :: Test -> FormulaM Stats TestResult
111enactTest rawTest = do 154enactTest rawTest = enactTestMod rawTest $ val ignored [CI.original (rawTest ^. tName), "Modifier"] False
155
156enactTestMod :: Test -> Formula Stats -> FormulaM Stats TestResult
157enactTestMod rawTest modFormula = do
112 test <- foldM (&) rawTest =<< toListOf (ctx . sModifiers . folded . _Modifier . _2) <$> ask 158 test <- foldM (&) rawTest =<< toListOf (ctx . sModifiers . folded . _Modifier . _2) <$> ask
113 manualMod <- val ignored [CI.original (rawTest ^. tName), "Modifier"] False 159 manualMod <- modFormula
114 let 160 let
115 critFailureBar = 95 - test^.tCritFailureMod 161 critFailureBar = 95 - test^.tCritFailureMod
116 critSuccessBar = 5 + test^.tCritSuccessMod 162 critSuccessBar = 5 + test^.tCritSuccessMod
@@ -123,7 +169,7 @@ enactTest rawTest = do
123 | pw >= critFailureBar = CritFailure 169 | pw >= critFailureBar = CritFailure
124 | otherwise = Failure 170 | otherwise = Failure
125 dResult <- toResult <$> d 100 171 dResult <- toResult <$> d 100
126 TestResult <$> pure dResult <*> (test ^. tEffect) dResult 172 TestResult <$> pure dResult <*> runMaybeT ((test ^. tEffect) dResult)
127 173
128-- hasTest :: Stats -> String -> Bool 174-- hasTest :: Stats -> String -> Bool
129-- hasTest stats str = has (getTest str) stats 175-- hasTest stats str = has (getTest str) stats