More sequence fu

5 files changed, 72 insertions, 29 deletions

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)