make newGame a pure function

This commit is contained in:
Jesse D. McDonald 2014-04-08 21:40:28 -05:00
parent 6acc6a150b
commit f7b7a6dc00
2 changed files with 30 additions and 39 deletions

View File

@ -8,6 +8,7 @@ import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Prompt
import Control.Monad.Random
import Control.Monad.State
import Data.List
import Text.Printf
@ -141,7 +142,8 @@ menuPrompt prm@(SolicitChoice w p t cs) = do
main :: IO ()
main = do
w <- newGame [p1, p2] [q1, q2] [] [b1, b2, b3, b4, b5]
g <- getSplit
let w = newGame [p1, p2] [q1, q2] [] [b1, b2, b3, b4, b5] g
let gamePlayerName n = w ^. gamePlayer n . playerName
(winners, w') <- runWaterdeepM menuPrompt waterdeepGame w
putStrLn ("Winner(s): " ++ intercalate ", " (winners ^.. traverse . to gamePlayerName))

View File

@ -23,58 +23,40 @@ import Waterdeep.Monad
import qualified Data.IntMap as IM
import qualified Data.Map as M
newGame :: (MonadRandom m, MonadSplit StdGen m)
=> [(String,Faction,Lord)]
newGame :: [(String,Faction,Lord)]
-> [Quest]
-> [IntrigueCard]
-> [Building]
-> m WaterdeepState
newGame players quests intrigues buildings
| length players < 2 || length players > 5 = error "This game requires 2-5 players."
| otherwise = do
let playerStates = IM.fromList $ flip map (zip [1..] players) $
\(i,(n,f,l)) -> (i, newPlayerState i n f l)
quests' <- shuffleM quests
intrigues' <- shuffleM intrigues
buildings' <- shuffleM buildings
splitGen <- getSplit
return $ snd $ runWaterdeep batchMode setupGame $ WaterdeepState
{ _gamePlayers = playerStates
-> StdGen
-> WaterdeepState
newGame players quests intrigues buildings rndgen
| length players < 2 || length players > 5 =
error "This game requires 2-5 players."
| otherwise =
WaterdeepState
{ _gamePlayers = IM.fromAscList playerStates
, _gameFirstPlayer = 1
, _gameCurrentRound = 0
, _gameCurrentPlayer = 1
, _gameCurrentPlayer = noPlayerID
, _gameConsecutivePasses = 0
, _gameQuestDeck = quests'
, _gameQuestDiscard = []
, _gameQuestDeck = []
, _gameQuestDiscard = quests
, _gameCliffwatchInn = []
, _gameIntrigueDeck = intrigues'
, _gameIntrigueDiscard = []
, _gameBuildingDeck = buildings'
, _gameBuildingDiscard = []
, _gameIntrigueDeck = []
, _gameIntrigueDiscard = intrigues
, _gameBuildingDeck = []
, _gameBuildingDiscard = buildings
, _gameBasicBuildings = map (newBuildingState noPlayerID) basicBuildings
, _gameBuildersHall = []
, _gameAdvancedBuildings = []
, _gameWaterdeepHarbor = ([], [], [])
, _gameStdGen = splitGen
, _gameStdGen = rndgen
}
where
batchMode :: WaterdeepPrompt a -> a
batchMode (NotifyState _) = ()
batchMode (SolicitChoice _ _ _ _) = error "No choices during setup."
playerStates = [ (i, newPlayerState i p) | (i, p) <- zip [1..] players ]
setupGame :: Waterdeep ()
setupGame = do
restockBuildersHall
restockCliffwatchInn
let ps = [1 .. length players]
forM_ (zip ps [4..]) $ \(p, g) -> do
replicateM_ 2 $ performAction p DrawQuest
replicateM_ 2 $ performAction p DrawIntrigue
replicateM_ g $ performAction p $ TakeResource [Gold]
return ()
newPlayerState :: PlayerID -> String -> Faction -> Lord -> PlayerState
newPlayerState i name faction lord =
newPlayerState :: PlayerID -> (String, Faction, Lord) -> PlayerState
newPlayerState i (name, faction, lord) =
PlayerState
{ _playerNumber = i
, _playerName = name
@ -106,6 +88,13 @@ basicBuildings = []
waterdeepGame :: Waterdeep [PlayerID]
waterdeepGame = do
ps <- sort . IM.keys <$> use gamePlayers
restockBuildersHall
restockCliffwatchInn
forM_ ps $ \p -> do
replicateM_ 2 $ performAction p DrawQuest
replicateM_ 2 $ performAction p DrawIntrigue
replicateM_ (3 + p) $ performAction p $ TakeResource [Gold]
forM_ [1..8] $ \round -> do
beginRound round
performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold]