1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, RecordWildCards #-}
module Sequence.Contact.Tests
( enactTest, enactTestMod
, critTables
) where
import Sequence.Formula
import Sequence.Types
import Sequence.Utils
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
import Data.List
import Data.Maybe
import Data.Monoid
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
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
, test "Ausdauer" $ sAEndurance . attributeTest
, test "Masse" $ sAMass . attributeTest
, test "Reflexe" $ sAReflexes . attributeTest
, test "Beweglichkeit" $ sAMobility . attributeTest
, test "Geschicklichkeit" $ sADexterity . attributeTest
, test "Intelligenz" $ sAIntelligence . attributeTest
, test "Charisma" $ sACharisma . attributeTest
, test "Wahrnehmung" $ sAPerception . attributeTest
, test "Entschlossenheit" $ sAWillpower . attributeTest
, test "Archaische Distanzwaffen" $ sSArchaicRanged . skillTest
, test "Handfeuerwaffen" $ sSFirearms . skillTest
, test "Schwere Waffen" $ sSHeavyWeapons . skillTest
, test "Energiewaffen" $ sSEnergyWeapons . skillTest
, test "Waffenloser Nahkampf" $ sSUnarmedMelee . skillTest
, test "Bewaffneter Nahkampf" $ sSArmedMelee . skillTest
, test "Wurfwaffen" $ sSThrownWeapons . skillTest
, test "Tarnung & Schleichen" $ sSStealth . skillTest
, test "Diebeshandwerk & Betrügerei" $ sSThievery . skillTest
, test "Schlösser Knacken" $ sSLockpicking . skillTest
, test "Fallen Stellen & Entschärfen" $ sSTrapping . skillTest
, test "Naturwissenschaften" $ sSSciences . skillTest
, test "Erste Hilfe" $ sSFirstAid . skillTest
, test "Medizinische Praktik" $ sSMedicine . skillTest
, test "Geisteswissenschaften" $ sSHumanities . skillTest
, test "Ingenieurwesen & Reperatur" $ sSEngineering . skillTest
, test "Handwerkskunst" $ sSCraft . skillTest
, test "Interface" $ sSInterface . skillTest
, test "Redekunst" $ sSSpeech . skillTest
, test "Führung" $ sSLeadership . skillTest
, test "Hauswirtschaft" $ sSHomeEconomics . skillTest
, test "Überlebenskunst" $ sSSurvival . skillTest
, test "Motorrad" $ sSMotorcycle . skillTest
, test "Radfahrzeug" $ sSWheeled . skillTest
, test "Schwebefahrzeug" $ sSHovercraft . skillTest
, test "Tragflächenmaschine" $ sSAircraft . skillTest
, test "Raumfahrzeug" $ sSSpacecraft . skillTest
, test "Wasserfahrzeug" $ sSWatercraft . skillTest
, test "Kettenfahrzeug" $ sSTracked . skillTest
, test "Exoskelett" $ sSExoskeleton . skillTest
, test "Beißen" $ sSBiting . skillTest
, test "Aufspüren" $ sSSearching . skillTest
, test "Betragen" $ sSDemeanour . skillTest
, test "Rammen" $ sSRamming . skillTest
, test "Zielerfassung" $ sSTargeting . skillTest
, test "Verständnis" $ sSComprehension . skillTest
, test "Grotesker Angriff" $ sSGrotesqueAssault . skillTest
, test "Zerfleischen" $ sSMauling . skillTest
, test "Ätzende Ausscheidung" $ sSExcreting . skillTest
]
views sExtraSkills (baseTests <>)
where
test k v = maybe mempty (Map.singleton k) <$> previews v (set (mapped . tName) k)
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'
where
tests' state = Map.lookup str (tests state) -- >>= (\get -> preview get state)
instance Completion (FormulaM Stats Test) GameState where
completableLabel _ = "<test>"
complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) . Map.keys) $ previews (gFocus' . eStats) tests st
instance Argument (FormulaM Stats Test) GameState where
arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str))
enactTest :: Test -> FormulaM Stats TestResult
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 <- modFormula
let
critFailureBar = 95 - test^.tCritFailureMod
critSuccessBar = 5 + test^.tCritSuccessMod
bar = test^.tBaseDifficulty + test^.tMod + manualMod
toResult pw = (toResult' pw) pw (abs $ bar - pw)
toResult' pw
| bar > critSuccessBar
, pw <= critSuccessBar = CritSuccess
| pw <= bar = Success
| pw >= critFailureBar = CritFailure
| otherwise = Failure
dResult <- toResult <$> d 100
TestResult <$> pure dResult <*> runMaybeT ((test ^. tEffect) dResult)
-- hasTest :: Stats -> String -> Bool
-- hasTest stats str = has (getTest str) stats
-- rollTest :: String -> FormulaM Stats (Maybe TestResult)
-- rollTest str = preview (getTest str) >>= enactTest'
-- where
-- enactTest' Nothing = return Nothing
-- enactTest' (Just t) = Just <$> (enactTest =<< t)
|
