From d8b49cbe1aff7cb3fcacac01d36128a248fc848b Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 10 Jun 2016 14:02:54 +0200 Subject: More sequence fu --- src/Main.hs | 48 +++++++++++++++++++++++++--------- src/Sequence/Contact/Archetypes.hs | 13 ++++++++- src/Sequence/Contact/Types.hs | 6 +++-- src/Sequence/Contact/Types/Internal.hs | 15 ++++++++--- src/Sequence/Types.hs | 19 +++++++------- 5 files changed, 72 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index f46fd3e..e6d694a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -78,26 +78,33 @@ main = do , cmd "test" rollTest "Roll a test using the stats of the currently focused entity" , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat" + , cmd "spend" spendSeq "Spend some of the current focus´ AP" + , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest" ] } void $ runShell description haskelineBackend (def :: GameState) stateOutline :: GameState -> String stateOutline st - | null pQueue = "" - | otherwise = layoutTableToString rowGs (Just ("" : factions, repeat def)) (repeat def) unicodeBoldHeaderS + | null (st ^. priorityQueue) = "" + | otherwise = unlines . map table $ st ^. gRounds' where + table round = layoutTableToString rowGs (Just (roundStr round : factions, repeat def)) (repeat def) unicodeBoldHeaderS + where + pQueue = filter (\(v, _) -> round == v ^. seqRound . _Wrapped)$ st ^. priorityQueue + protoRows = groupBy ((==) `on` fst) pQueue + faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) + factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions + rowGs = do + rowGroup'@((seq, _):_) <- protoRows + let + rowGroup = map snd rowGroup' + factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ] + return . colsAllG top $ [maybe "" show $ view seqVal seq] : map factionColumn [0..(length factions - 1)] + roundStr 0 = "Current Round" + roundStr 1 = "Next Round" + roundStr n = show n ++ " Rounds later" factions = map (view faction') $ st ^. inhabitedFactions - pQueue = st ^. priorityQueue - protoRows = groupBy ((==) `on` fst) pQueue - faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) - factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions - rowGs = do - rowGroup'@((seq, _):_) <- protoRows - let - rowGroup = map snd rowGroup' - factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ] - return . colsAllG top $ [show $ view seqVal seq] : map factionColumn [0..(length factions - 1)] -- Query state listFactions, listEntities :: Sh GameState () @@ -203,6 +210,21 @@ entitySeqVal' ident = void . runMaybeT $ do round <- use gRound (newEntity, sNum) <- evalFormula name entity sVal let val = Just $ def - & set seqRound round + & set (seqRound . _Wrapped) round & set seqVal (Just sNum) + & set seqEpsilon (entity ^. eStats . sSeqEpsilon) gEntities . at ident .= Just (newEntity & set eSeqVal val) + +spendSeq :: Int -> Sh GameState () +spendSeq n = withFocus $ \focusId -> do + gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just -= n + +delay :: Sh GameState () +delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId) + where + delay' focusId = do + tipId <- MaybeT $ preuse tip + tipSeq <- MaybeT . preuse $ gEntities . ix tipId . eStats . sSequence . _Just . seqVal . _Just + focusSeq <- MaybeT . preuse $ gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just + guard $ focusSeq > tipSeq + lift . spendSeq $ focusSeq - tipSeq diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index ff37fdb..32cfa22 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs @@ -96,6 +96,7 @@ human = Humanoid , _sPainTolerance = vMass `quot'` 2 + vWillpower , _sFatigueTolerance = vWillpower `quot'` 2 + vEndurance + , _sHitzones = cTable [ (1, 5, "Kopf") , (6, 54, "Torso") , (55, 62, "Rechter Arm") @@ -113,7 +114,7 @@ human = Humanoid , (26, 35, effect "Blind, Rechts") , (36, 45, effect "Blind, Links") , (46, 75, effect "Taub") - , (76, 100, effect "Bewusstlos – 1w10 Runden") + , (76, 100, Effect "Bewusstlos" . unconscious $ d 10) ]) ) , ("Torso", def) @@ -127,8 +128,13 @@ human = Humanoid , _sDamage = const 0 , _sFatigue = 0 + , _sSequence = Nothing + , _sPainShock = def , _sFatigueShock = def + + , _sExtraSkills = [] + , _sModifiers = [] } where headshot = runMaybeT $ do @@ -139,6 +145,11 @@ human = Humanoid dmg' = if dmg >= 0 then dmg else 0 MaybeT . previews ctx $ set (sDamage' "Kopf") dmg' + unconscious :: Formula Stats -> FormulaM Stats (Maybe Stats) + unconscious roundsF = do + rounds <- roundsF + previews ctx $ over (sSequence . _Just . seqRound . _Wrapped) (+ rounds) + dog = Quadruped { _sAStrength = vStrength , _sAEndurance = vEndurance diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index a0add1a..dff886d 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs @@ -94,7 +94,7 @@ makePrisms ''SeqVal makeLenses ''SeqVal instance Default SeqVal where - def = SeqVal { _seqRound = 0 + def = SeqVal { _seqRound = Down 0 , _seqVal = Nothing , _seqEpsilon = False } @@ -112,7 +112,9 @@ makeLenses ''Stats instance Default Stats where def = Prop - { _sHitzones = [("Volumen", 1)] + { _sSeqEpsilon = False + + , _sHitzones = [("Volumen", 1)] , _sArmor = const def , _sCripple = const def diff --git a/src/Sequence/Contact/Types/Internal.hs b/src/Sequence/Contact/Types/Internal.hs index 7e9be2b..e4a2eef 100644 --- a/src/Sequence/Contact/Types/Internal.hs +++ b/src/Sequence/Contact/Types/Internal.hs @@ -7,6 +7,7 @@ import Sequence.Formula (Formula, FormulaM, Table) import Data.Map (Map) import Data.Set (Set) import Data.Ratio +import Data.Ord import Data.Monoid import Control.Lens @@ -46,11 +47,11 @@ data Modifier = Modifier (CI String) (Test -> FormulaM Stats Test) data Effect = Effect (CI String) (FormulaM Stats (Maybe Stats)) data SeqVal = SeqVal - { _seqRound :: Int + { _seqRound :: Down Int , _seqVal :: Maybe Int , _seqEpsilon :: Bool } - deriving (Show, Ord, Eq) + deriving (Show, Eq, Ord) data ShockEffect = ShockEffect { _seApplied :: Bool @@ -60,7 +61,9 @@ data ShockEffect = ShockEffect } data Stats = Prop - { _sHitzones :: Table Hitzone + { _sSeqEpsilon :: Bool + + , _sHitzones :: Table Hitzone , _sArmor :: Hitzone -> Armor , _sCripple :: Hitzone -> ShockEffect @@ -123,6 +126,8 @@ data Stats = Prop , _sPainTolerance , _sFatigueTolerance :: Formula Stats + , _sSeqEpsilon :: Bool + , _sHitzones :: Table Hitzone , _sArmor :: Hitzone -> Armor , _sCripple :: Hitzone -> ShockEffect @@ -161,6 +166,8 @@ data Stats = Prop , _sPainTolerance , _sFatigueTolerance :: Formula Stats + , _sSeqEpsilon :: Bool + , _sHitzones :: Table Hitzone , _sArmor :: Hitzone -> Armor , _sCripple :: Hitzone -> ShockEffect @@ -199,6 +206,8 @@ data Stats = Prop , _sPainTolerance , _sFatigueTolerance :: Formula Stats + , _sSeqEpsilon :: Bool + , _sHitzones :: Table Hitzone , _sArmor :: Hitzone -> Armor , _sCripple :: Hitzone -> ShockEffect diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs index 33bbc2a..f5bf010 100644 --- a/src/Sequence/Types.hs +++ b/src/Sequence/Types.hs @@ -6,7 +6,7 @@ module Sequence.Types , Entity(..), eFaction, eSeqVal, eStats , EntityName(..), entityName , EntityIdentifier(..), entityId, entityId' - , inhabitedFactions, priorityQueue, tip, insertEntity, gFocus', gRound + , inhabitedFactions, priorityQueue, tip, insertEntity, gFocus', gRounds, gRounds', gRound ) where import Control.Lens @@ -151,13 +151,12 @@ insertEntity entity = execState $ do identifier <- use gNextId gEntities . at identifier ?= entity gNextId %= succ + +gRounds :: Traversal' GameState Int +gRounds = gEntities . each . eStats . sSequence . _Just . seqRound . _Wrapped + +gRounds' :: Getter GameState [Int] +gRounds' = to $ nub . sort . toListOf gRounds -gRound :: Lens' GameState Int -gRound = lens lowestRound $ flip trimBelow - where - lowestRound = getMin . (<> Min 0) . view (gEntities . each . eStats . sSequence . _Just . seqRound . _Unwrapped) - trimBelow = over (gEntities . each . eStats . sSequence) . trimBelow' - trimBelow' cutoff = runReader . runMaybeT $ do - round <- MaybeT . preview $ _Just . seqRound - guard $ round >= cutoff - MaybeT ask +gRound :: Getter GameState Int +gRound = to $ getMin . (<> Min 0) . view (gRounds . _Unwrapped) -- cgit v1.2.3