diff options
author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2017-01-16 18:10:17 +0100 |
---|---|---|
committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2017-01-16 18:10:17 +0100 |
commit | ce890f4b6fd478bf5a254390f5bc49e4afd97c8c (patch) | |
tree | fb5a239a32b610470cbefbd279f465df89c5f5f1 /src/Sequence/Contact/Tests.hs | |
parent | 7ff2052235140669bc9e9c5c1e94b194626dee67 (diff) | |
download | 2017-01-16_17:13:37-ce890f4b6fd478bf5a254390f5bc49e4afd97c8c.tar 2017-01-16_17:13:37-ce890f4b6fd478bf5a254390f5bc49e4afd97c8c.tar.gz 2017-01-16_17:13:37-ce890f4b6fd478bf5a254390f5bc49e4afd97c8c.tar.bz2 2017-01-16_17:13:37-ce890f4b6fd478bf5a254390f5bc49e4afd97c8c.tar.xz 2017-01-16_17:13:37-ce890f4b6fd478bf5a254390f5bc49e4afd97c8c.zip |
Burstfirerewrite
Diffstat (limited to 'src/Sequence/Contact/Tests.hs')
-rw-r--r-- | src/Sequence/Contact/Tests.hs | 56 |
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 | ||
3 | module Sequence.Contact.Tests | 3 | module Sequence.Contact.Tests |
4 | ( enactTest | 4 | ( enactTest, enactTestMod |
5 | , critTables | ||
5 | ) where | 6 | ) where |
6 | 7 | ||
7 | import Sequence.Formula | 8 | import Sequence.Formula |
@@ -12,6 +13,7 @@ import Sequence.Contact.Types | |||
12 | import Control.Monad | 13 | import Control.Monad |
13 | import Control.Monad.Reader | 14 | import Control.Monad.Reader |
14 | import Control.Monad.Base | 15 | import Control.Monad.Base |
16 | import Control.Monad.Trans.Maybe | ||
15 | import Control.Lens | 17 | import Control.Lens |
16 | 18 | ||
17 | import Data.Default | 19 | import Data.Default |
@@ -29,6 +31,8 @@ import Data.Traversable (mapM) | |||
29 | 31 | ||
30 | import Prelude hiding (mapM) | 32 | import Prelude hiding (mapM) |
31 | 33 | ||
34 | import Debug.Trace | ||
35 | |||
32 | tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) | 36 | tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) |
33 | tests = do | 37 | tests = 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 | ||
101 | critTables :: CI String -> (DiceResult -> Table (Maybe Effect)) | ||
102 | critTables 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)] | ||
119 | critTables 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)] | ||
138 | critTables _ _ = [(Nothing, 1)] | ||
139 | |||
97 | 140 | ||
98 | getTest :: String -> Fold Stats (FormulaM Stats Test) | 141 | getTest :: String -> Fold Stats (FormulaM Stats Test) |
99 | getTest (CI.mk -> str) = folding tests' | 142 | getTest (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 | ||
110 | enactTest :: Test -> FormulaM Stats TestResult | 153 | enactTest :: Test -> FormulaM Stats TestResult |
111 | enactTest rawTest = do | 154 | enactTest rawTest = enactTestMod rawTest $ val ignored [CI.original (rawTest ^. tName), "Modifier"] False |
155 | |||
156 | enactTestMod :: Test -> Formula Stats -> FormulaM Stats TestResult | ||
157 | enactTestMod 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 |