Death & Unconsciousness

1 files changed, 59 insertions, 22 deletions

diff --git a/src/Main.hs b/src/Main.hs
index e8e0a49..f409a04 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -36,6 +36,7 @@ import Data.Function
 
 import Control.Monad.State.Strict
 import Control.Monad.Trans.Maybe
+import Control.Monad.List
 
 import Sequence.Types
 import Sequence.Contact.Types
@@ -54,6 +55,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"
@@ -63,7 +66,8 @@ main = do
                   { historyFile = Just historyFile
                   , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName <$> view gFocus st) ++ "→ "
                   , beforePrompt = do
-                      { gets stateOutline >>= (\str -> if null str then return () else shellPutStr str)
+                      { stateMaintenance
+                      ; stateOutline >>= (\str -> if null str then return () else shellPutStr str)
                       ; gets focusNotes >>= (\str -> if null str then return () else shellPutStr str)
                       }
                   , commandStyle = OnlyCommands
@@ -94,27 +98,38 @@ main = do
                   }
   void $ runShell description haskelineBackend (def :: GameState)
 
-stateOutline :: GameState -> String
-stateOutline st
-  | null (st ^. priorityQueue) = ""
-  | otherwise                  = unlines . map table $ st ^. gRounds'
+stateOutline :: Sh GameState String
+stateOutline = do
+  st <- get
+  case st of
+    st | null (st ^. priorityQueue) -> return ""
+       | otherwise                  -> unlines <$> mapM 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
+    table :: Int -> Sh GameState String
+    table round = do
+      factions <- map (view faction') <$> use inhabitedFactions
+      st <- get
+      let
+        roundStr 0 = "Current Round"
+        roundStr 1 = "Next Round"
+        roundStr n = show n ++ " Rounds later"
+
+        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
+
+        rowGs :: Sh GameState [RowGroup]
+        rowGs = runListT $ do
+          rowGroup'@((seq, _):_) <- ListT $ return 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
+            factionColumn i = runListT $ do
+              x <- ListT $ return rowGroup
+              guard $ factionIndex x == i
+              toDesc x
+            factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions
+          colsAllG top . ([maybe "" show $ view seqVal seq] :) <$> mapM factionColumn [0..(length factions - 1)]
+      layoutTableToString <$> rowGs <*> pure (Just (roundStr round : factions, repeat def)) <*> pure (repeat def) <*> pure unicodeBoldHeaderS
 
 focusNotes :: GameState -> String
 focusNotes = maybe "" (unlines . map dotted) . preview (gFocus' . eNotes)
@@ -125,6 +140,27 @@ focusNotes = maybe "" (unlines . map dotted) . preview (gFocus' . eNotes)
       | fstL : tailL <- lines str = " • " ++ fstL ++ "\n" ++ unlines (map ("   " ++ ) tailL)
       | otherwise = ""
 
+stateMaintenance :: Sh GameState ()
+stateMaintenance = do
+  void . runMaybeT $ do
+    focusId <- MaybeT $ use gFocus
+    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
+    isDead <- evalF =<< MaybeT (preuse $ lStats . sDead)
+    isUnconscious <- evalF =<< MaybeT (preuse $ lStats . sUnconscious)
+    guard $ isDead || isUnconscious
+    when isDead . lift . shellPutStrLn $ name ++ " died"
+    when isUnconscious . lift . shellPutStrLn $ name ++ " is unconscious"
+    gFocus' . eSeqVal .= Nothing
+    gFocus .= Nothing
+
 -- Query state
 listFactions, listEntities :: Sh GameState ()
 listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction')
@@ -259,11 +295,12 @@ doShock dmg efLens = withFocus $ \focusId -> do
   name <- toName focusId
   void . runMaybeT $ do
     cripple <- MaybeT . preuse $ lStats . efLens
-    let 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
+    let -- 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
+        evalF = MaybeT . focusState lStats . evalFormula' name
         cVar cLens = evalF =<< MaybeT (preuse $ lStats . (cripple ^. cLens))
     bar <- cVar seBar
     val <- cVar seVal