Export victory points in summary

bartavelle · Jan 11, 2018 · 1a63863 · 1a63863
1 parent 490538a
commit 1a63863
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 22 deletions.
diff --git a/Startups/Exported.hs b/Startups/Exported.hs
@@ -14,13 +14,15 @@ import Startups.Json
 import Startups.Base
 import Startups.Cards
 import Startups.GameTypes
+import Startups.Game (victoryPoints')
 
 data ExportedPlayerState = ExportedPlayerState { _eCompany         :: CompanyProfile
                                                , _eCompanyStage    :: CompanyStage
                                                , _eCardsCount      :: Int
                                                , _eFunds           :: Funding
                                                , _eNeighborhood    :: Neighborhood
                                                , _ePoachingResults :: [PoachingOutcome]
+                                               , _eVictory         :: VictoryMap
                                                } deriving (Eq, Show)
 
 data ExportedGameState = ExportedGameState { _eplayermap   :: M.Map PlayerId ExportedPlayerState
@@ -40,14 +42,19 @@ data Todo = TodoAction Age Turn PlayerId [Card]
           deriving (Show, Eq)
 
 exportGameState :: GameState -> ExportedGameState
-exportGameState gs = ExportedGameState (fmap exportPlayerState (_playermap gs)) (length (_discardpile gs))
-    where
-        exportPlayerState pm = ExportedPlayerState (_pCompany pm)
-                                                   (_pCompanyStage pm)
-                                                   (length (_pCards pm))
-                                                   (_pFunds pm)
-                                                   (_pNeighborhood pm)
-                                                   (_pPoachingResults pm)
+exportGameState gs =
+  ExportedGameState (M.mapWithKey exportPlayerState stt) (length (_discardpile gs))
+  where
+    stt = _playermap gs
+    vpoints = victoryPoints' stt
+    exportPlayerState playername pm
+      = ExportedPlayerState (_pCompany pm)
+                            (_pCompanyStage pm)
+                            (length (_pCards pm))
+                            (_pFunds pm)
+                            (_pNeighborhood pm)
+                            (_pPoachingResults pm)
+                            (VictoryMap (vpoints ^. ix playername))
 
 newtype VictoryMap = VictoryMap { getVictoryMap :: M.Map VictoryType VictoryPoint }
                      deriving (Eq, Show)

diff --git a/Startups/Game.hs b/Startups/Game.hs
@@ -295,21 +295,23 @@ checkCopyCommunity = do
             Nothing -> tellPlayer pid (emph "There were no violet cards bought by your neighbors. You can't use your copy capacity.")
 
 victoryPoints :: GameStateOnly m => m (M.Map PlayerId (M.Map VictoryType VictoryPoint))
-victoryPoints = use playermap >>= itraverse computeScore
+victoryPoints = victoryPoints' <$> use playermap
+
+victoryPoints' :: M.Map PlayerId PlayerState -> M.Map PlayerId (M.Map VictoryType VictoryPoint)
+victoryPoints' stt = M.mapWithKey computeScore stt
     where
-        computeScore pid playerState = do
-            let poaching = (PoachingVictory, playerState ^. pPoachingResults . traverse . to poachScore)
-                poachScore Defeat = -1
-                poachScore (Victory Age1) = 1
-                poachScore (Victory Age2) = 3
-                poachScore (Victory Age3) = 5
-                funding = (FundingVictory, fromIntegral (playerState ^. pFunds `div` 3))
-                scienceTypes = playerState ^.. cardEffects . _RnD
-                scienceJokers = length (playerState ^.. cardEffects . _ScientificBreakthrough)
-                research = (RnDVictory, scienceScore scienceTypes scienceJokers)
-            stt <- use playermap
-            let cardPoints = playerState ^.. pCards . traverse . to (\c -> getCardVictory pid c stt) . folded
-            return $ M.fromListWith (+) $ poaching : funding : research : cardPoints
+      computeScore pid playerState =
+          let poaching = (PoachingVictory, playerState ^. pPoachingResults . traverse . to poachScore)
+              poachScore Defeat = -1
+              poachScore (Victory Age1) = 1
+              poachScore (Victory Age2) = 3
+              poachScore (Victory Age3) = 5
+              funding = (FundingVictory, fromIntegral (playerState ^. pFunds `div` 3))
+              scienceTypes = playerState ^.. cardEffects . _RnD
+              scienceJokers = length (playerState ^.. cardEffects . _ScientificBreakthrough)
+              research = (RnDVictory, scienceScore scienceTypes scienceJokers)
+              cardPoints = playerState ^.. pCards . traverse . to (\c -> getCardVictory pid c stt) . folded
+          in  M.fromListWith (+) $ poaching : funding : research : cardPoints
 
 -- | The main game function, runs a game. The state must be initialized in
 -- the same way as the 'initGame' function.