Switch to pure functions for random board gen.

Game.hs

@@ -117,18 +117,18 @@ legalMovesInDirection b origPos d =
     else []
   where nextPos = nextPosition origPos d
 
-addRandomPlayers :: Int -> Board -> IO Board
-addRandomPlayers nPieces b = do
-  rndPosns <- shuffleIO (vacantPositions b)
-  let pps = zip (cycle players) (take nPieces rndPosns)
-  return $ updatePosStateMap (\m -> foldl addPlayerAtPos m pps) b
-
-initRandomBoard :: Int -> Int -> Int -> IO Board
-initRandomBoard w h nPieces = do
-  rndNs <- fmap (randomRs (1,3)) getStdGen
-  let b = Board (w, h) Player1 initScoreMap (initPSM rndNs)
-  addRandomPlayers nPieces b
+addRandomPlayers :: RandomGen g => g -> Int -> Board -> (Board, g)
+addRandomPlayers g nPieces b = (b', g')
+  where
+    (rndPosns, g') = shuffle g (vacantPositions b)
+    b' = updatePosStateMap (\m -> foldl addPlayerAtPos m pps) b
+    pps = zip (cycle players) (take nPieces rndPosns)
+
+initRandomBoard :: RandomGen g => g -> Int -> Int -> Int -> (Board, g)
+initRandomBoard g w h nPieces = addRandomPlayers g nPieces b
   where 
+    rndNs = randomRs (1,3) g
+    b = Board (w, h) Player1 initScoreMap (initPSM rndNs)
     initScoreMap   = M.fromList (zip players (repeat 0))
     initPSM iceNs  = M.fromList (zip hexGrid (map mkpos iceNs))
       where
@@ -327,10 +327,11 @@ main = nonguimain
 nonguimain ::  IO Board
 nonguimain = do
   args <- getArgs
+  gen  <- getStdGen
   case args of
     [w,h,nPieces,strat1,strat2,logLevel] -> do
       let logging = (read logLevel)
-      b <- initRandomBoard (read w) (read h) (read nPieces)
+      let (b, _gen') = initRandomBoard gen (read w) (read h) (read nPieces)
       when (logging <= Info) $ 
         putStrLn $ "Starting with strategies: " ++ strat1 ++ ", " ++ strat2 ++ " on a board of dimensions " ++ show (w,h) ++ " with " ++ show nPieces ++ " pieces"
       autoplay logging (stratFor $ read strat1) (stratFor $ read strat2) b

Gui.hs

@@ -1,13 +1,15 @@
 module Gui where
-import Graphics.Gloss
 import qualified Data.Map as M
 import Game hiding (main)
 import Graphics.Gloss.Interface.Pure.Game
+import System.Random(getStdGen,StdGen)
+
+initStandardRandomBoard gen = initRandomBoard gen 6 6 4
 
 main = guimain
 guimain = do
-
-  (start:bs) <- mapM (const $ initRandomBoard 6 6 4) ([1..9]::[Int])
+  gen <- getStdGen 
+  let (start, gen') = initStandardRandomBoard gen
   -- http://hackage.haskell.org/packages/archive/gloss/1.7.8.2/doc/html/Graphics-Gloss.html#v:play
   play 
           (InWindow "Penguins, Fish, Ice - Haskell UI" --name of the window
@@ -16,13 +18,13 @@ guimain = do
           )
           backgroundColor   -- background colour
           30 -- number of simulation steps to take for each second of real time
-          (initialGameState start bs)  -- the initial world
+          (initialGameState start gen')  -- the initial world
           drawStateMgr  -- A function to convert the world into a picture
           handleInputMgr -- A function to handle input events
           (const id)
 
-initialGameState ::  Board -> [Board] -> GS
-initialGameState start bs = (GS start [] bs [] handleSelect [] SplashScreen)
+initialGameState ::  Board -> StdGen -> GS
+initialGameState start gen = (GS start [] [] handleSelect [] SplashScreen gen)
 
 drawStateMgr :: GS -> Picture
 drawStateMgr gs = draw (gameMode gs) $ gs
@@ -75,16 +77,16 @@ logMsg gs msg = gs { logs = take 5 (msg : logs gs) }
 backgroundColor = colorSea -- dark $ dark $ dark blue -- makeColor8 200 200 200 100
 
 type ClickHandler = Event -> GS -> GS
--- (board in play, undo list, fresh boards, log msgs)
+
 data GameMode = SplashScreen | GamePlay deriving (Show, Eq)
 
 data GS = GS { b             :: Board
              , undos         :: [Board]
-             , nextBoards    :: [Board]
              , logs          :: [String]
              , clickHdlr     :: ClickHandler
              , hilitPosition :: [Position]
              , gameMode      :: GameMode 
+             , rndGen        :: StdGen
              }
 resetHandlers gs = gs { clickHdlr = handleSelect, hilitPosition = [] } 
 
@@ -110,9 +112,8 @@ handleChar 'b' gs =
              , logs = ("best move scored " ++ show i):logs gs }
   where (i, b') = makeBestMoveIfUnfinished (b gs)
 
-handleChar 'n' gs = case nextBoards gs of
-  []            -> gs
-  (next:others) -> gs { b = next,  nextBoards = others, undos = [] } 
+handleChar 'n' gs = gs { b = next, undos = [], rndGen = gen' } 
+  where (next,gen') = initStandardRandomBoard (rndGen gs)
 
 handleChar 'a' gs = case undos gs of
   []            -> gs
@@ -140,7 +141,7 @@ help = [ "---- Keys -------------"
        , "b - make Best move"
        , "a - start same board Again"
        , "u - Undo move"
-       , "n - New board (limited)" ]
+       , "n - New board" ]
 
 drawPlayingArea ::  Board -> [Position] -> Picture
 drawPlayingArea bd hilitPosns = 

Shuffle.hs

@@ -1,22 +1,22 @@
 -- http://www.haskell.org/haskellwiki/Random_shuffle 
-module Shuffle where
+module Shuffle (shuffle) where
 
 import System.Random
-import Data.Array.IO
-import Control.Monad
+import Data.Map hiding (foldl)
+
+fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
+fisherYatesStep (m, gen) (i, x) = ((insert j x . insert i (m ! j)) m, gen')
+  where
+    (j, gen') = randomR (0, i) gen
 
--- | Randomly shuffle a list
---   /O(N)/
-shuffleIO :: [a] -> IO [a]
-shuffleIO xs = do
-        ar <- nuArray n xs
-        forM [1..n] $ \i -> do
-            j <- randomRIO (i,n)
-            vi <- readArray ar i
-            vj <- readArray ar j
-            writeArray ar j vi
-            return vj
+fisherYates :: RandomGen g => g -> [a] -> ([a], g)
+fisherYates gen [] = ([], gen)
+fisherYates gen l = 
+  toElems $ foldl fisherYatesStep (initial (head l) gen) (numerate (tail l))
   where
-    n = length xs
-    nuArray :: Int -> [a] -> IO (IOArray Int a)
-    nuArray len ys =  newListArray (1,len) ys
+    toElems (x, y) = (elems x, y)
+    numerate = zip [1..]
+    initial x g = (singleton 0 x, g)
+
+shuffle :: RandomGen g => g -> [a] -> ([a], g)
+shuffle = fisherYates