Permalink
Browse files

n/a: add basic types and helper methods

  • Loading branch information...
1 parent aba8e3e commit 151917fdd948dada1266e186db17b9b13ed1fbd6 @rizsotto committed Nov 16, 2011
Showing with 80 additions and 0 deletions.
  1. +13 −0 src/Domina/Line.hs
  2. +43 −0 src/Domina/Set.hs
  3. +24 −0 src/Domina/Types.hs
View
@@ -0,0 +1,13 @@
+-- Copyright 2011 by Laszlo Nagy [see file COPYRIGHT]
+module Domina.Line
+ ( ends
+ ) where
+
+import Domina.Types
+
+ends :: Line -> Maybe Domino
+ends [] = Nothing
+ends li = let (a,_) = head li
+ (_,b) = last li
+ in Just (a,b)
+
View
@@ -0,0 +1,43 @@
+-- Copyright 2011 by Laszlo Nagy [see file COPYRIGHT]
+module Domina.Set
+ ( generateDominoSet
+ , shuffle
+ ) where
+
+import Domina.Types
+import System.Random
+import Data.Array.ST
+import Control.Monad
+import Control.Monad.ST
+import Data.STRef
+
+generateDominoSet :: Int -> [Domino]
+generateDominoSet max =
+ [(a, b) | a <- [0..max], b <- [0..a]]
+
+shuffle :: [Domino] -> IO [Domino]
+shuffle ds = getStdRandom (shuffle' ds)
+
+-- | Randomly shuffle a list without the IO Monad
+-- /O(N)/
+shuffle' :: [a] -> StdGen -> ([a],StdGen)
+shuffle' xs gen = runST (do
+ g <- newSTRef gen
+ let randomRST lohi = do
+ (a,s') <- liftM (randomR lohi) (readSTRef g)
+ writeSTRef g s'
+ return a
+ ar <- newArray n xs
+ xs' <- forM [1..n] $ \i -> do
+ j <- randomRST (i,n)
+ vi <- readArray ar i
+ vj <- readArray ar j
+ writeArray ar j vi
+ return vj
+ gen' <- readSTRef g
+ return (xs',gen'))
+ where
+ n = length xs
+ newArray :: Int -> [a] -> ST s (STArray s Int a)
+ newArray n xs = newListArray (1,n) xs
+
View
@@ -0,0 +1,24 @@
+-- Copyright 2011 by Laszlo Nagy [see file COPYRIGHT]
+module Domina.Types where
+
+type Domino = (Int, Int)
+
+type Line = [Domino]
+data Ends = L | R
+
+type Stock = [Domino]
+
+data Player = P String
+ deriving (Eq)
+
+type Hand = (Player, [Domino])
+
+data Move = M Domino Ends
+ | Pass
+ | Draw
+
+type Event = (Player, Move)
+type History = [Event]
+
+data Result = Drawn
+ | Winner Player

0 comments on commit 151917f

Please sign in to comment.