Burstfirerewrite

1 files changed, 49 insertions, 8 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 236e779..a0799e0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -19,6 +19,9 @@ import qualified Data.CaseInsensitive as CI
 
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+  
+import Data.Map as Lazy (Map)
+import qualified Data.Map as Lazy.Map
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -34,7 +37,7 @@ import Data.List
 import Data.List
 import Data.Maybe
 import Data.Bool
-import Data.Monoid (All(..))
+import Data.Monoid (Monoid(..), (<>), All(..))
 import Data.Ord
 import Data.Ratio
 
@@ -67,6 +70,8 @@ import qualified Data.Text.Lazy as Lazy (Text)
 import qualified Data.Text.Lazy as Lazy.Text
 import Data.Text.Template
 
+import Debug.Trace
+
 main :: IO ()
 main = do
   historyFile <- getUserCacheFile "sequence" "history"
@@ -115,6 +120,7 @@ main = do
                                     , cmd "log" dumpLog "Print the combat log"
                                     , cmd "val" printVal "Find the distribution of a specific value of the current entities"
                                     , cmd "summary" printVals "Find the averages of applicable all values"
+                                    , cmd "burstfire" burstfire "Roll an automatic burst of <n> shots against given skill compensating for recoil with the given attribute"
                                     ]
                   , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '\'']
                   }
@@ -385,7 +391,13 @@ spawnFaction cFaction num cEntity nameTemplate
 
 -- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
-rollTest = withArg $ maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <=< enactTest'
+rollTest = withArg rollTest'
+
+rollTest' :: FormulaM Stats Test -> Sh GameState ()
+rollTest' = rollTest'' Nothing
+
+rollTest'' :: Maybe (Formula Stats) -> FormulaM Stats Test -> Sh GameState ()
+rollTest'' testMod = maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <=< enactTest' testMod
   where
     outputResult :: (String, TestResult) -> Sh GameState ()
     outputResult (test, view (rRoll . to ppResult) -> result) = do
@@ -408,7 +420,8 @@ rollTest = withArg $ maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <
 
 
     applyEffect :: (String, TestResult) -> Sh GameState ()
-    applyEffect (test, view rResult -> (Effect (CI.original -> effectDesc) effect)) = void . runMaybeT $ do
+    applyEffect (_, view rResult -> Nothing) = return ()
+    applyEffect (test, view rResult -> Just (Effect (CI.original -> effectDesc) effect)) = void . runMaybeT $ do
       focusId <- MaybeT $ use gFocus
       name <- toName focusId
       let
@@ -416,15 +429,15 @@ rollTest = withArg $ maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <
         lStats = gEntities . ix focusId . eStats
         evalF = MaybeT . focusState lStats . evalFormula' [name]
       guard =<< askBool ("Apply effects (" ++ effectDesc ++ ")?") True
-      lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
+      lStats <~ (MaybeT . fmap join . runMaybeT . evalF $ runMaybeT effect)
       lift . outputLogged focusId $ test ++ " effects: " ++ effectDesc
 
-enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
-enactTest' test = runMaybeT $ do
+enactTest' :: Maybe (Formula Stats) -> FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
+enactTest' testMod test = runMaybeT $ do
   focusName <- MaybeT (use gFocus) >>= lift . toName
   let evalF = MaybeT . focusState (gFocus' . eStats) . evalFormula' [focusName]
   test' <- evalF test
-  result <- evalF $ enactTest test'
+  result <- evalF $ (maybe enactTest (flip enactTestMod) testMod) test'
   return (view (tName . to CI.original) test', result)
       
 entitySeqVal :: Sh GameState ()
@@ -502,7 +515,7 @@ doShock dmg efLens = withFocus $ \focusId -> do
       else guard $ val >= bar
     lStats . efLens . seApplied .= True
     Effect (CI.original -> effectName) effect <- evalF . table $ cripple ^. seEffect
-    lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
+    lStats <~ (MaybeT . fmap join . runMaybeT . evalF $ runMaybeT effect)
     lift . outputLogged focusId $ "Effect: " ++ effectName
     lift . addNote $ "Effect: " ++ effectName
 
@@ -586,3 +599,31 @@ printVals = withFocus $ \focusId -> do
         Just avg -> shellPutStrLn $ printf "%*s: %5.1f" maxLength (CI.original str) (fromRational avg :: Double)
         Nothing  -> return ()
   mapM_ printAvg $ Map.toList sheet
+
+burstfire :: Int -> Completable (Formula Stats) -> Completable (Formula Stats) -> Sh GameState ()
+burstfire nShots skill' attr' = skill' <~> \skill -> attr' <~> \attr -> withFocus (burstfire' skill attr)
+  where
+    burstfire' skill attr focusId = void . runMaybeT $ do
+      name <- lift $ toName focusId
+      let
+        lStats :: Traversal' GameState Stats
+        lStats = gEntities . ix focusId . eStats
+        evalF formula = do
+          stats <- MaybeT $ preuse lStats
+          (nStats, x) <- (evalFormula [name] :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula
+          lStats .= nStats
+          return x
+      skillVal <- evalF skill
+      attrVal <- evalF attr
+      minStrRaw <- evalF $ val ignored ["Mindeststärke der Waffe"] False
+      minStrMod <- evalF $ val ignored ["Mindeststärke der Waffe", "Modifikator"] False
+      mod <- evalF $ val ignored ["Modifikator"] False
+      let
+        recoilMod = max 0 $ 10 + (minStr - attrVal) 
+        minStr = minStrRaw + minStrMod
+      lift . forM_ [1..nShots] $ \n -> do
+        rollTest'' (Just $ fromIntegral mod) . return $ def
+          & tName . iso CI.original CI.mk .~ printf "Schuss %2d" n
+          & tBaseDifficulty .~ skillVal
+          & tMod .~ (n - 1) * (-recoilMod)
+          & tEffect .~ MaybeT . table . critTables "Fernkampfangriffe"