From bf24ff9ffd25841da5e20386548fb63ff191ed9a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 11 Jun 2016 23:00:13 +0200 Subject: Death & Unconsciousness --- src/Main.hs | 81 ++++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 59 insertions(+), 22 deletions(-) (limited to 'src/Main.hs') 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 -- cgit v1.2.3