From ce890f4b6fd478bf5a254390f5bc49e4afd97c8c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 16 Jan 2017 18:10:17 +0100 Subject: Burstfire --- src/Main.hs | 57 +++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 49 insertions(+), 8 deletions(-) (limited to 'src/Main.hs') 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 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" -- cgit v1.2.3