-- Putting it all together: Tic Tac Toe -- cabal update -- cabal install gloss -- ghc tictactoe.hs -- tictactoe.exe -- import is just like Java, but you can give modules (akin to Java packages) their own local name import qualified Graphics.Gloss.Interface.Pure.Game as Gloss import qualified Graphics.Gloss.Data.Bitmap as Bitmap import qualified Data.Map as Map import Data.List -- A tic-tac-toe cell is either blank, X, or O data Cell = Blank | X | O deriving (Eq, Ord) -- To encode game state: -- we have the board (a map from a pair of ints to a Cell) -- and the current "player" (either X or O) data Game = Game { board :: Map.Map (Int, Int) Cell, player :: Cell } -- Initially, the board is a 3x3 grid of blank cells initialBoard = Map.fromList [((i,j), Blank) | i <- [0..2], j <- [0..2]] -- Given a game board, and two coordinates, is the move legit? validMove :: Map.Map (Int, Int) Cell -> Int -> Int -> Bool validMove board i j | i < 0 || i >= 3 || j < 0 || j >= 3 = False | otherwise = Blank == board Map.! (i,j) -- X starts the game initialGame = Game initialBoard X -- List the rows in the game board rows :: Map.Map (Int, Int) Cell -> [[Cell]] rows board = map (map snd) $ groupBy (\((i,j),_) ((k,l),_) -> i == k) $ Map.assocs board -- List the diagonals in the game board diagonals :: Map.Map (Int, Int) Cell -> [[Cell]] diagonals board = [[board Map.! (0,0), board Map.! (1,1), board Map.! (2,2)], [board Map.! (2,0), board Map.! (1,1), board Map.! (0,2)]] -- Players switch when taking turns switch :: Cell -> Cell switch O = X switch X = O -- Given a game board, and a move, get the new game board state takeTurn :: Game -> (Int, Int) -> Game takeTurn game@Game { board=b, player=p } (i, j) | validMove b i j = newGame | otherwise = game where newGame = Game { board = Map.adjust (\_ -> p) (i,j) b, player = switch p } -- Did anybody win? winner :: Map.Map (Int, Int) Cell -> Bool winner board = any win slices where slices = ((rows board) ++ (diagonals board) ++ (transpose $ rows board)) -- Given a slice (row, column, diagonal), are they all the same? win slice = foldl1 (\x y -> if x == y then x else Blank) slice /= Blank -- is the game over? either somebody won, or there's no blanks left gameOver :: Map.Map (Int, Int) Cell -> Bool gameOver board = winner board || (not $ any (== Blank) $ Map.elems board) -- So, who won, if anybody? outcome (Game board player) | winner board = switch player | otherwise = Blank -- Translate mouse clicks (Gloss.Event) into turns handleMouse :: Gloss.Event -> Game -> Game handleMouse (Gloss.EventKey (Gloss.MouseButton Gloss.LeftButton) Gloss.Down _ (x, y)) game@(Game board player) | gameOver board = game | otherwise = takeTurn game (i, j) where i = round $ (y+160) / 160 j = round $ (x+240) / 160 -- don't care about the other events handleMouse _ game = game main = do oPicture <- Bitmap.loadBMP "O.bmp" xPicture <- Bitmap.loadBMP "X.bmp" _Picture <- Bitmap.loadBMP "_.bmp" xwin <- Bitmap.loadBMP "xwin.bmp" owin <- Bitmap.loadBMP "owin.bmp" tie <- Bitmap.loadBMP "tie.bmp" let cellPicture = Map.fromList [(O,oPicture), (X, xPicture), (Blank, _Picture)] let outcomePicture = Map.fromList [(O,owin), (X, xwin), (Blank, tie)] let displayCell (i,j) cell = Gloss.translate ((fromIntegral j :: Float)*160-240) ((fromIntegral i :: Float)*160-160) $ cellPicture Map.! cell let displayBoard (Game board _) = Gloss.Pictures $ Map.elems $ Map.mapWithKey displayCell board let displayOutcome game = Gloss.translate (230) (0) (outcomePicture Map.! (outcome game)) let display game@(Game board player) = if gameOver board then Gloss.Pictures [displayOutcome game, displayBoard game] else displayBoard game Gloss.play (Gloss.InWindow "Rock Paper Scissors" (1920,1080) (0,0)) Gloss.black 10 initialGame display handleMouse (\f g -> g)