From 12dce406808620989646a163ff77a0782eb5ef63 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Mon, 13 Jun 2016 18:44:54 +0200
Subject: combat rounds

---
 src/Main.hs           | 23 ++++++++++++++++++++++-
 src/Sequence/Types.hs |  2 +-
 src/Sequence/Utils.hs |  2 +-
 3 files changed, 24 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index a38b514..e93d725 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -31,10 +31,12 @@ import Data.List
 import Data.List
 import Data.Maybe
 import Data.Bool
+import Data.Monoid (All(..))
 
 import Data.Function
 
 import Control.Monad.State.Strict
+import Control.Monad.Reader
 import Control.Monad.Trans.Maybe
 import Control.Monad.List
 
@@ -157,9 +159,28 @@ stateMaintenance = do
     isUnconscious <- evalF =<< MaybeT (preuse $ lStats . sUnconscious)
     guard $ isDead || isUnconscious
     when isDead . lift . shellPutStrLn $ name ++ " died"
-    when isUnconscious . lift . shellPutStrLn $ name ++ " is unconscious"
+    when (isUnconscious && not isDead) . lift . shellPutStrLn $ name ++ " is unconscious"
     gFocus' . eSeqVal .= Nothing
     gFocus .= Nothing
+  void $ do
+    round <- use gRound
+    let
+      finished sVal = fromMaybe False (previews (seqVal . _Just) (<= 0) sVal) || view (seqRound . _Wrapped) sVal /= round
+    allFinished <- getAll . foldMapOf (gEntities . each . eStats . sSequence . _Just) (All . finished) <$> get
+    when allFinished $ do
+      let
+        advanceRound' :: EntityIdentifier -> Entity -> Sh GameState Entity
+        advanceRound' ident entity = fmap (fromMaybe entity . (\(m, s) -> s <$ m)) . (runStateT ?? entity) . runMaybeT $ do
+          cRound <- MaybeT . preuse $ eStats . sSequence . _Just . seqRound . _Wrapped
+          guard $ cRound < 0
+          cVal <- MaybeT . preuse $ eStats . sSequence . _Just . seqVal . _Just
+          name <- lift . lift $ toName ident
+          nVal' <- MaybeT . preuse $ eStats . sSeqVal
+          nVal <- MaybeT . focusState eStats $ evalFormula' name nVal'
+          eStats . sSequence . _Just . seqVal . _Just += nVal
+          eStats . sSequence . _Just . seqRound . _Wrapped += 1
+      gRounds -= 1
+      gEntities <~ (imapM advanceRound' =<< use gEntities)
 
 -- Query state
 listFactions, listEntities :: Sh GameState ()
diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs
index 59397d5..4aa55d3 100644
--- a/src/Sequence/Types.hs
+++ b/src/Sequence/Types.hs
@@ -159,4 +159,4 @@ gRounds' :: Getter GameState [Int]
 gRounds' = to $ nub . sort . toListOf gRounds
   
 gRound :: Getter GameState Int
-gRound = to $ getMin . (<> Min 0) . view (gRounds . _Unwrapped)
+gRound = to $ fromMaybe 0 . minimumOf gRounds
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index dc6657a..513cb0b 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -61,7 +61,7 @@ withFocus f = use gFocus >>= maybe (shellPutErrLn $ "Currently not focusing any
 withFocus' :: (Entity -> Sh GameState a) -> Sh GameState (Maybe a)
 withFocus' f = preuse gFocus' >>= maybe (Nothing <$ shellPutErrLn "Currently not focusing any entity") (fmap Just . f)
 
-focusState :: MonadState GameState m => Traversal' GameState a -> StateT a (MaybeT m) b -> m (Maybe b)
+focusState :: MonadState s m => Traversal' s a -> StateT a (MaybeT m) b -> m (Maybe b)
 focusState lens action = runMaybeT $ uncurry (<$) . over _2 (lens .=) =<< runStateT action =<< MaybeT (preuse lens)
 
 unaligned = view faction' def
-- 
cgit v1.2.3