Determine first player

1 files changed, 22 insertions, 3 deletions

diff --git a/Game.hs b/Game.hs
index 2fd87c1..2888bbe 100644
--- a/Game.hs
+++ b/Game.hs
@@ -1,7 +1,9 @@
 module Game where
 
 import Prelude hiding (round)
+import qualified Data.List as L
 import Data.Char (isDigit)
+import Data.Function (on)
 import Control.Monad (mapM_)
 import System.Random (RandomGen, getStdGen, newStdGen)
 import Player (Player(..), shed, draw)
@@ -31,21 +33,38 @@ beginGame :: Setup -> IO Game
 beginGame setup@(Setup n r d c a) = do
     gen <- getStdGen
     let decks = C.shuffle gen $ C.fullDecks d
+    let stock = drop n decks
     let defaultPlayers = [ Player "Alice" 0 []
                          , Player "Bob"   0 []
                          , Player "Carol" 0 []
                          ]
+    pidx <- firstPlayer defaultPlayers decks
     let game = Game { players     = defaultPlayers
-                    , playerIdx   = 0  -- TODO: determine first player
+                    , playerIdx   = pidx
                     , attack      = 1
                     , direction   = 1
-                    , prevCard    = head decks
-                    , stockPile   = tail decks
+                    , prevCard    = head stock
+                    , stockPile   = tail stock
                     , discardPile = []
                     , round       = 0
                     }
     beginRound setup game
 
+-- | Determine playerIdx from top `n` cards from `stock`.
+firstPlayer :: [Player] -> [Card] -> IO Int
+firstPlayer plyrs stock = do
+    let cards = take (length plyrs) stock
+    putStrLn "Drawing cards to determine playing order..."
+    mapM_ (\(Player name _ _, i) ->
+            putStrLn $ name ++ " draws " ++ C.showCard (cards !! i))
+        $ zip plyrs [0..]
+    let minRank = L.minimumBy (compare `on` C.rank)
+    let playerIdx = case L.elemIndex (minRank cards) cards of
+                      Just i -> i
+                      Nothing -> 0  -- impossible
+    putStrLn $ (P.name $ plyrs !! playerIdx) ++ " goes first"
+    return playerIdx
+
 -- | Begin round.
 beginRound :: Setup -> Game -> IO Game
 beginRound setup@(Setup _ r d c a) game =