{-# 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 _ = "" 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)