packages feed

HTicTacToe (empty) → 0.1

raw patch · 16 files changed

+935/−0 lines, 16 filesdep +SDLdep +SDL-imagedep +SDL-ttfsetup-changedbinary-added

Dependencies added: SDL, SDL-image, SDL-ttf, array, base, mtl, random

Files

+ Alice_in_WonderLand_3.ttf view

binary file changed (absent → 81252 bytes)

+ Draw.hs view
@@ -0,0 +1,135 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+module Draw where++import Control.Monad+import Control.Monad.Trans++import Graphics.UI.SDL hiding (flip)+import qualified Graphics.UI.SDL as SDL (flip)++--import Graphics.UI.SDL.Image++import Graphics.UI.SDL.TTF++import Grid+import GameState hiding (font, screen, grid, winner, stats)+import GameEnv+import Surface++textColor :: Color+textColor = Color 0x00 0xFF 0x00++drawPlayersKey :: AppEnv ()+drawPlayersKey = do+    playerPiece <- getPlayerType+    let aiPiece = swapCell playerPiece+    +    font   <- getFont+    screen <- getScreen+    +    liftIO $ do        +        playerKey <- renderTextSolid font ("Player: " ++ show playerPiece) textColor+        aiKey     <- renderTextSolid font ("CPU: " ++ show aiPiece) textColor+        applySurface 10 10 playerKey screen Nothing+        applySurface 10 (10 + surfaceGetHeight playerKey) aiKey screen Nothing++drawBoard :: AppEnv ()+drawBoard = do++    Rect x y gw gh <- getGridBounds+    winIndices     <- snd `liftM` getWinner+    grid    <- getGrid+    screen  <- getScreen++    let (w,h) = (gw `div` 3, gh `div` 3)+    let (halfW, halfH) = (w `div` 4, h `div` 4)+    +    let applySurf r c = applySurface' (r * w + x + halfW) (c * h + y + halfH)    +    -- draw pieces+    forM_ [(r,c) | r <- [0..2], c <- [0..2]] $ \(r,c) -> do+        case cellAt grid r c of+            Nought -> do+                src <- if (r,c) `elem` winIndices+                        then getOWinSurf+                        else getNought+                applySurf r c src screen Nothing+            Cross  -> do+                src <- if (r,c) `elem` winIndices+                        then getXWinSurf+                        else getCross                +                applySurf r c src screen Nothing+            _      -> return ()+    +    -- draw/overlay grid+    let drawLine' u hh l d = liftIO . drawLine screen u hh l d    +    drawLine' (x + w, y) gh thickness Vertical gridColor+    drawLine' (x + w * 2, y) gh thickness Vertical gridColor+    +    drawLine' (x, y + h) gw thickness Horizontal gridColor+    drawLine' (x, y + h * 2) gw thickness Horizontal gridColor+    + where gridColor = Pixel 0xFF00FF+       thickness = 5++drawEndGame :: AppEnv ()+drawEndGame = do+    screen <- getScreen+    font   <- getFont+    winner <- fst `liftM` getWinner+    playerResultStr <- winOrLose winner `liftM` getPlayerType+    unless (null playerResultStr) $ liftIO $ do+        textSurface <- renderTextSolid font playerResultStr textColor+        let x = (screenWidth `div` 2) - (surfaceGetWidth textSurface `div` 2)+        applySurface x (screenHeight - 35) textSurface screen Nothing++ where winOrLose Noughts Nought = "YOU WON!"+       winOrLose Crosses Cross  = "YOU WON!"+       winOrLose Noughts Cross  = "YOU LOST!"+       winOrLose Crosses Nought = "YOU LOST!"+       winOrLose Draw _         = "DRAW GAME!"+       winOrLose _ _            = []++drawScore :: AppEnv ()+drawScore = do+    Rect _ ry _ h <- getGridBounds+    font   <- getFont+    screen <- getScreen+    stats  <- getStats                       +    +    let y = ry + h + 20+    liftIO $ do+        scores <- renderTextSolid font ("Player: " ++ (show $ playerCount stats) ++ " CPU: " ++ (show $ aiCount stats) ++ " Ties: " ++ (show $ tieCount stats)) textColor+        let x = (screenWidth `div` 2) - (surfaceGetWidth scores `div` 2)+        applySurface x y scores screen Nothing++render :: AppEnv ()+render = do+    screen <- getScreen+    liftIO $ clear screen 0x00 0x00 0x00+    drawPlayersKey+    drawBoard+    drawScore+    drawEndGame+    liftIO $ SDL.flip screen
+ FontReadMe.txt view
@@ -0,0 +1,47 @@+                                         ENGLISH
+Hello, thanks for downloading the font "Alice in Wonderland" from one of the next sites:
+   - www.por-que-tan-serio.deviantart.com (My DeviantART account)
+   - www.fontspace.com/marcotl (My FontSpace account)
+
+The rules are the following:
+   -Do not use this font for commercial purposes.
+   -Do not claim this font as yours (I beg you xD).
+   -This font is currently under development, so go to my gallery often to make sure
+    you have the latest version.
+   -You can distribute this font as long as you keep this Read-me file with it and intact.
+   -Do not rename this font.
+   -You can edit the font for personal purposes, but please do not distribute edited
+    versions of the font.
+   -You can request for special characters if they're not included in the current version
+    of the font, just let me know and make sure I answered your request.
+   -Feel free to ask whatever you want to know.
+   -PLEASE, SHOW ME YOUR WORK, I'd love to see your creativity and the way my
+    font is being used.
+
+Enjoy this font and have fun!
+-Marco T.L.
+
+______________________________________________________________________________________________
+                                             ESPAÑOL
+Hola, gracias por descargar la fuente "Alice in Wonderland" (Alicia en el País de las
+Maravillas) de alguno de los siguientes sitios:
+   - www.por-que-tan-serio.deviantart.com (Mi cuenta en DeviantART)
+   - www.fontspace.com/marcotl (Mi cuenta en Fontspace)
+
+Las reglas son las siguientes:
+   -No uses la fuente para propósitos comerciales.
+   -No digas que la fuente es tuya (te lo ruego xD).
+   -Esta fuente está bajo desarrollo, así que ve seguido a mi galería para que
+    te asegures de tener la última versión.
+   -Puedes distribuir la fuente mientras mantengas este texto con ella e intacto.
+   -No renombres la fuente.
+   -Puedes editar la fuente para propósitos personales, pero por favor no distribuyas
+    una versión editada de ésta.
+   -Puedes solicitar caracteres especiales si no están incluidos en la versión actual
+    de la fuente, sólo hazmelo saber y asegúrate de que respondí a tu petición.
+   -Siéntete libre para preguntar lo que quieras.
+   -POR FAVOR, MUÉSTRAME TU TRABAJO, me encantaría ver tu creatividad y la manera
+    en la que mi fuente está siendo usada.
+
+¡Disfruta la fuente y diviértete!
+-Marco T.L.
+ GameEnv.hs view
@@ -0,0 +1,64 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module GameEnv+(+    AppEnv(),+    runApp,+    getPTurnCell,+    modifyPlayerCount,+    screenWidth,+    screenHeight,+    sceenBpp+) where++import Control.Monad.State+import Control.Monad.Reader++import Grid+import GameState++screenWidth, screenHeight, sceenBpp :: Int+screenWidth  = 640+screenHeight = 480+sceenBpp     = 32++type AppState = StateT AppData IO+newtype AppEnv a = AppEnv { runEnv :: ReaderT AppConfig AppState a }+    deriving (Monad, MonadIO, MonadReader AppConfig, MonadState AppData)++runApp :: AppConfig -> AppData -> AppEnv a -> IO (a, AppData)+runApp config state (AppEnv env) = (runStateT . runReaderT env) config state++getPTurnCell :: AppEnv Cell+getPTurnCell = getTurn >>= mapTurn+ where mapTurn :: PlayerTurn -> AppEnv TileType+       mapTurn Player = getPlayerType+       mapTurn Ai = swapCell `liftM` getPlayerType++modifyPlayerCount :: (Integer -> Integer) -> AppEnv ()+modifyPlayerCount fn = liftM mapTurn getTurn >>= modifyStats+ where mapTurn :: PlayerTurn -> Stats -> Stats+       mapTurn Player = \s@Stats { playerCount=pc } -> s { playerCount=fn pc }+       mapTurn Ai     = \s@Stats { aiCount=pc } -> s { aiCount=fn pc }
+ GameState.hs view
@@ -0,0 +1,182 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+{-# LANGUAGE FlexibleContexts #-}+module GameState where+import System.Random++import Control.Monad.State+import Control.Monad.Reader++import Graphics.UI.SDL (Surface)+import Graphics.UI.SDL.Rect+import Graphics.UI.SDL.TTF (Font)++import Surface hiding (isInside)+import qualified Surface (isInside)++import Grid++data PlayerTurn = Player | Ai+    deriving (Eq, Show, Read)++type TileType = Cell++data Stats = Stats {+    playerCount :: Integer,+    aiCount     :: Integer,+    tieCount    :: Integer+} deriving (Eq, Show)++data AppData = AppData {+    --gameState   :: GameState,+    --tiles       :: [Tile],+    grid     :: Grid,+    stats    :: Stats,+    turn     :: PlayerTurn,+    acRand   :: StdGen,+    --gameOver :: Bool,+    winner   :: (Winner, [(Int,Int)])+}++data AppConfig = AppConfig {+    screen      :: Surface,+    font        :: Font,+    oSurface    :: Surface,+    xSurface    :: Surface,+    oWinSurf    :: Surface,+    xWinSurf    :: Surface,+    gridBounds  :: Rect,+    playerStart :: PlayerTurn,+    playerType  :: TileType+}++-- Player Cross+appData :: Int -> PlayerTurn -> AppData+appData seed t = AppData newGrid (Stats 0 0 0) t (mkStdGen seed) (Nobody,[])++getTurn :: MonadState AppData m => m PlayerTurn+getTurn = liftM turn get++putTurn :: MonadState AppData m => PlayerTurn -> m ()+putTurn t = modify $ \s -> s { turn = t }++modifyTurn :: MonadState AppData m => (PlayerTurn -> PlayerTurn) -> m ()+modifyTurn fn = fn `liftM` getTurn >>= putTurn++modifyTurnM :: MonadState AppData m => (PlayerTurn -> m PlayerTurn) -> m ()+modifyTurnM act = getTurn >>= act >>= putTurn++getStats :: MonadState AppData m => m Stats+getStats = liftM stats get++putStats :: MonadState AppData m => Stats -> m ()+putStats t = modify $ \s -> s { stats = t }++modifyStats :: MonadState AppData m => (Stats -> Stats) -> m ()+modifyStats fn = fn `liftM` getStats >>= putStats++modifyStatsM :: MonadState AppData m => (Stats -> m Stats) -> m ()+modifyStatsM act = getStats >>= act >>= putStats++getRGen :: MonadState AppData m => m StdGen+getRGen = liftM acRand get++putRGen :: MonadState AppData m => StdGen -> m ()+putRGen t = modify $ \s -> s { acRand = t }++modifyRGen :: MonadState AppData m => (StdGen -> StdGen) -> m ()+modifyRGen fn = fn `liftM` getRGen >>= putRGen++modifyRGenM :: MonadState AppData m => (StdGen -> m StdGen) -> m ()+modifyRGenM act = getRGen >>= act >>= putRGen++-- utility function to hide plumbing of random generator types.+rand :: MonadState AppData m => Int -> Int -> m Int+rand lo hi = do+    r <- getRGen+    let (val, r') = randomR (lo, hi) r+    putRGen r'+    return val++getGrid :: MonadState AppData m => m Grid+getGrid = liftM grid get++putGrid :: MonadState AppData m => Grid -> m ()+putGrid t = modify $ \s -> s { grid = t }++modifyGrid :: MonadState AppData m => (Grid -> Grid) -> m ()+modifyGrid fn = fn `liftM` getGrid >>= putGrid++modifyGridM :: MonadState AppData m => (Grid -> m Grid) -> m ()+modifyGridM act = getGrid >>= act >>= putGrid++isGameOver :: MonadState AppData m => m Bool+isGameOver = liftM (gameOver . fst . winner) get+ where gameOver Nobody = False+       gameOver _      = True++getWinner :: MonadState AppData m => m (Winner, [(Int,Int)])+getWinner = liftM winner get++putWinner :: MonadState AppData m => (Winner, [(Int,Int)]) -> m ()+putWinner t = modify $ \s -> s { winner = t }++getScreen :: MonadReader AppConfig m => m Surface+getScreen = liftM screen ask++getFont :: MonadReader AppConfig m => m Font+getFont = liftM font ask++getNought :: MonadReader AppConfig m => m Surface+getNought = liftM oSurface ask++getCross :: MonadReader AppConfig m => m Surface+getCross = liftM xSurface ask++getXWinSurf :: MonadReader AppConfig m => m Surface+getXWinSurf = liftM xWinSurf ask++getOWinSurf :: MonadReader AppConfig m => m Surface+getOWinSurf = liftM oWinSurf ask++getPlayerType :: MonadReader AppConfig m => m TileType+getPlayerType = liftM playerType ask++getPlayerStart :: MonadReader AppConfig m => m PlayerTurn+getPlayerStart = liftM playerStart ask++getGridBounds :: MonadReader AppConfig m => m Rect+getGridBounds = liftM gridBounds ask++inGridBounds :: MonadReader AppConfig m => Int -> Int -> m Bool+inGridBounds x y = getGridBounds >>= \r -> return $ Surface.isInside r x y++nextTurn :: MonadState AppData m => m ()+nextTurn = modifyTurn k+ where k Player = Ai+       k Ai = Player++toTileType :: MonadReader AppConfig m => PlayerTurn -> m TileType+toTileType Player = getPlayerType+toTileType Ai = swapCell `liftM` getPlayerType
+ Grid.hs view
@@ -0,0 +1,109 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+module Grid+(+    Cell(..),+    swapCell,+    Winner(..),+    Grid(),+    newGrid,+    toArray,+    cellAt,+    isEmpty,+    isComplete,+    takeTurn,+    whoWon+) where++import Data.List+import Data.Array hiding (indices)++data Cell   = Nought | Cross | Empty+    deriving Eq+--    deriving (Eq, Show)+instance Show Cell where+    show Nought = "O"+    show Cross  = "X"+    show _      = ""++swapCell :: Cell -> Cell+swapCell Nought = Cross+swapCell Cross  = Nought+swapCell Empty = Empty++data Winner = Noughts | Crosses | Draw | Nobody+    deriving Show++type CellArray = Array (Int,Int) Cell+newtype Grid = Grid { cells :: CellArray }++rowSize :: Int+rowSize = 3+--gridSize = rowSize * rowSize++newGrid :: Grid+newGrid = Grid $ listArray ((0,0), (rowSize - 1,rowSize - 1)) $ repeat Empty++toArray :: Grid -> CellArray+toArray (Grid t) = t++cellAt :: Grid -> Int -> Int -> Cell+cellAt (Grid cs) row col = cs ! (row, col)++isEmpty :: Grid -> Int -> Int -> Bool+isEmpty g row col =+    case cellAt g row col of+        Empty -> True+        _ -> False++isComplete :: Grid -> Bool+isComplete g = all (\(r,c) -> not $ isEmpty g r c) [(r,c) | r <- indices, c <- indices]+ where end     = rowSize - 1+       indices = [0..end]++takeTurn :: Grid -> Cell -> Int -> Int -> Grid+takeTurn g Empty _ _ = g+takeTurn g@(Grid cs) c row col =+    if isEmpty g row col then+        Grid $ cs // [((row,col), c)]+    else g++whoWon :: Grid -> (Winner, [(Int,Int)])+whoWon g@(Grid cs) =+    case findWinner Nought of+        Just x -> (Noughts, x)+        _ -> case findWinner Cross of+                Just x -> (Crosses, x)+                _ -> if isDraw g then (Draw, []) else (Nobody, [])+ where end         = rowSize - 1+       indices     = [0..end]+       rows        = [zip (repeat r) indices | r <- indices]+       cols        = [zip indices (repeat c) | c <- indices]+       diagonal    = zip indices indices+       invDiagonal = zip [end,end-1..0] indices+       searchSpace = rows ++ cols ++ [diagonal] ++ [invDiagonal]+       allCells cell = all $ \idx -> cs ! idx == cell +       findWinner cell  = find (allCells cell) searchSpace+       +       isDraw grid = not $ any (uncurry $ isEmpty grid) [(r,c) | r <- indices, c <- indices]
+ HTicTacToe.cabal view
@@ -0,0 +1,66 @@+-- HTicTacToe.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                HTicTacToe++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            A tic-tac-toe game.++-- A longer description of the package.+Description:         Another tic-tac-toe game in Haskell using the SDL bindings.++-- URL for the project homepage or repository.+Homepage:            http://github.com/snkkid/HTicTacToe++-- The license under which the package is released.+License:             MIT++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Korcan Hussein++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          korcan_h@hotmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Game,Graphics++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.4++Extra-Source-Files:  README, Surface.hs, Grid.hs, GameState.hs, GameEnv.hs, Draw.hs, HTicTacToe.hs++data-files:          "Alice_in_WonderLand_3.ttf",+                     "FontReadMe.txt",+                     "o.png", "x.png", "oWin.png", "xWin.png"++Executable HTicTacToe+  -- .hs or .lhs file containing the Main module.+    Main-is:         HTicTacToe.hs+  +  -- Packages needed in order to build this package.+    Build-depends:   base >= 4 && < 5, random, array, mtl, SDL, SDL-image, SDL-ttf++  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +  --  GHC-Options:     -O2 -Wall
+ HTicTacToe.hs view
@@ -0,0 +1,188 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein.+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+module Main where++import Prelude hiding (init)++import System.Environment++import System.Console.GetOpt++--import Data.Word+import Data.List hiding (init)++import Control.Monad+import Control.Monad.Trans+import Control.Exception++import Graphics.UI.SDL hiding (init, quit, flip)+--import qualified Graphics.UI.SDL as SDL (init, quit, flip)++import Graphics.UI.SDL.TTF hiding (init, quit)+import qualified Graphics.UI.SDL.TTF as TTFG (init, quit)++import Surface+import Grid+import GameState hiding (playerType, screen, font, winner, playerStart)+import GameEnv+import Draw++import Paths_HTicTacToe++type ProgramOptions = (PlayerTurn,TileType)++parseArgs :: IO (ProgramOptions, [String])+parseArgs = do+    argv <- getArgs+    case getOpt Permute options argv of+        (o,n,[]  ) -> return (foldl' (flip id) defaultOptions o, n)+        (_,_,errs) -> ioError $ userError $ concat errs ++ usageInfo header options+ where header = "Usage: start player"+       defaultOptions = (Player, Cross)+       options :: [OptDescr (ProgramOptions -> ProgramOptions)]+       options = [Option ['s'] ["start"]  (ReqArg (\str (_,p) -> (pStart str, p)) "PlayerStart") "which players starts \"Player\" or \"Ai\" (default is \"Player\")",+                  Option ['p'] ["player"]  (ReqArg (\str (s,_) -> (s, pType str)) "PlayerType") "player is \"x\" or \"o\" (default is \"x\")"]+       --playerStart = Player+       pType "o" = Nought+       pType "O" = Nought+       pType _   = Cross -- default playerType.+       pStart "Ai" = Ai+       pStart _ = Player -- default playerStart.++init :: IO (AppConfig, AppData)+init = do+    +    (playerStart, playerType) <- fst `liftM` parseArgs+    +    xFileName    <- getDataFileName "x.png"+    oFileName    <- getDataFileName "o.png"+    xWinFileName <- getDataFileName "xWin.png"+    oWinFileName <- getDataFileName "oWin.png"+    fontFileName <- getDataFileName "Alice_in_WonderLand_3.ttf"+    +    screen  <- setVideoMode screenWidth screenHeight sceenBpp [HWSurface, DoubleBuf]+    setCaption "tic-tac-toe" []+    enableUnicode True+    +    font       <- openFont fontFileName 24+    xSprite    <- loadImage xFileName colorKey+    oSprite    <- loadImage oFileName colorKey+    xWinSprite <- loadImage xWinFileName colorKey+    oWinSprite <- loadImage oWinFileName colorKey+    +    seed    <- fromIntegral `liftM` getTicks+    +    let wh = surfaceGetWidth xSprite * 6+    +    let gridX = (screenWidth `div` 2) - (wh `div` 2)    +    return (AppConfig screen font oSprite xSprite oWinSprite xWinSprite (Rect gridX 5 wh wh) playerStart playerType, appData seed playerStart)+ where colorKey = Just (0, 0, 0)++initGame :: AppEnv ()+initGame = do+    putGrid newGrid+    putWinner (Nobody, [])+    playerTurn <- getTurn+    case playerTurn of+        Ai -> aiPlayGame+        _  -> return ()++aiPlayGame :: AppEnv ()+aiPlayGame = do+    playerTurn <- getTurn+    case playerTurn of+        Ai -> randomCell >>= uncurry playGame+        _  -> return ()+ where randomCell = do+        r <- rand 0 2+        c <- rand 0 2+        g <- getGrid+        if isEmpty g r c+            then return (r,c)+            else randomCell++playGame :: Int -> Int -> AppEnv ()+playGame row col = do    +    g <- getGrid+    when (isEmpty g row col) $ do +        playerCell <- getPTurnCell+        modifyGrid $ \gr -> takeTurn gr playerCell row col    +        winner <- whoWon `liftM` getGrid+        putWinner winner        +        case fst winner of+            Draw    -> modifyStats $ \s@Stats{ tieCount=tc } -> s { tieCount=tc + 1 }+            Nobody  -> nextTurn+            _       -> modifyPlayerCount (+1)+        +        isOver <- isGameOver+        unless isOver aiPlayGame++handleEvent :: Event -> AppEnv ()+handleEvent VideoExpose = render+handleEvent (MouseButtonDown mx my ButtonLeft) = do+    gridBox@(Rect gx gy w h) <- getGridBounds+    when (isInside gridBox x y) $ do+        finished <- isGameOver+        if finished+            then do+                initGame+                pushEvent_ VideoExpose+            else do+                playerTurn <- getTurn+                case playerTurn of+                    Player -> do+                        let (row, col) = ((x - gx) `div` (w `div` 3), (y - gy) `div` (h `div` 3))+                        playGame row col+                        pushEvent_ VideoExpose+                    _ -> return ()+ where x = fromIntegral mx+       y = fromIntegral my+       pushEvent_ = liftIO . pushEvent++handleEvent _ = return ()++loop :: AppEnv ()+loop = do+    event <- liftIO waitEvent+    case event of+        Quit -> return ()+        _ -> do+            handleEvent event+            loop++main :: IO ()+main = withInit [InitEverything] $ -- withInit calls quit for us.+    withTtfInit $ do+        (config, state) <- init+        runApp config state $ do+            aiPlayGame -- if Ai was choosen to start first.+            render     -- initial render+            loop+        return ()++withTtfInit :: IO () -> IO ()+withTtfInit = bracket_ ttfInit TTFG.quit+ where ttfInit :: IO ()+       ttfInit = TTFG.init >>= \success -> when (not success) $ throwIO $ userError "Failed to init ttf\n"+
+ LICENSE view
@@ -0,0 +1,21 @@+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.
+ README view
@@ -0,0 +1,31 @@+HTicTacToe+==========+Author: Korcan Hussein++Install+-------++runhaskell Setup.hs configure --user+runhaskell Setup.hs build+runhaskell Setup.hs install++How to Play+-----------++You are either X or O, select an empty area in the grid you want to pick, get 3 in a row or+column or across and you win!++Game Options+------------++Pick Who starts:++HTicTacToe --start=Ai/Player++Pick your type:++HTicTacToe --player=o/x++Both:++HTicTacToe --start=Ai/Player --player=o/x
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Surface.hs view
@@ -0,0 +1,90 @@+{-+    The MIT License+    +    Copyright (c) 2010 Korcan Hussein+    +    Permission is hereby granted, free of charge, to any person obtaining a copy+    of this software and associated documentation files (the "Software"), to deal+    in the Software without restriction, including without limitation the rights+    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+    copies of the Software, and to permit persons to whom the Software is+    furnished to do so, subject to the following conditions:+    +    The above copyright notice and this permission notice shall be included in+    all copies or substantial portions of the Software.+    +    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+    THE SOFTWARE.+-}+module Surface where++import Foreign++import Control.Monad+import Control.Monad.Trans++import Graphics.UI.SDL+import Graphics.UI.SDL.Image++isInside :: Rect -> Int -> Int -> Bool+isInside (Rect sx sy w h) x y =  x > sx && x < (sx + w) && y > sy && y < (sy + h)++loadImage :: String -> Maybe (Word8, Word8, Word8) -> IO Surface+loadImage filename colorKey = load filename >>= displayFormat >>= setColorKey' colorKey++setColorKey' :: Maybe (Word8,Word8,Word8) -> Surface -> IO Surface+setColorKey' Nothing s = return s+setColorKey' (Just (r, g, b)) surface = mapRGB' surface r g b >>= setColorKey surface [SrcColorKey] >> return surface++applySurface :: Int -> Int -> Surface -> Surface -> Maybe Rect -> IO ()+applySurface x y src dst clip = blitSurface src clip dst offset >> return ()+ where offset = Just Rect { rectX = x, rectY = y, rectW = 0, rectH = 0 }++applySurface' :: MonadIO m => Int -> Int -> Surface -> Surface -> Maybe Rect -> m ()+applySurface' x y src dst = liftIO . applySurface x y src dst++mapRGB' :: Surface -> Word8 -> Word8 -> Word8 -> IO Pixel+mapRGB' = mapRGB . surfaceGetPixelFormat++clear :: Surface -> Word8 -> Word8 -> Word8 -> IO ()+clear surf r g b = do+    jrect      <- Just `liftM` getClipRect surf+    clearColor <- mapRGB' surf r g b+    fillRect surf jrect clearColor+    return ()++getPixel32 :: Surface -> Int -> Int -> IO Pixel+getPixel32 s x y = do+    ps <- surfaceGetPixels s+    Pixel `liftM` peekElemOff (castPtr ps :: Ptr Word32) offset+ where offset = y * (fromIntegral $ surfaceGetPitch s `div` 4) + x++setPixel32 :: Surface -> Int -> Int -> Pixel -> IO ()+setPixel32 s x y (Pixel pixel) = do+    ps <- surfaceGetPixels s+    pokeElemOff (castPtr ps :: Ptr Word32) offset pixel+ where offset = y * (fromIntegral $ surfaceGetPitch s `div` 4) + x++type Point2 = (Int,Int)++data LineDir = Vertical | Horizontal++drawLine :: Surface -> Point2 -> Int -> Int -> LineDir -> Pixel -> IO ()+drawLine dst (x,y) len thickness Horizontal colour =+    forM_ [(r,c) | c <- [yStart..yEnd], r <- [x..(x + len)]] $ \(r,c) ->+        setPixel32 dst r c colour+ where halfLen = thickness `div` 2+       yStart  = max (y - halfLen) 0+       yEnd    = min (yStart + thickness) $  surfaceGetHeight dst++drawLine dst (x,y) len thickness Vertical colour =+    forM_ [(r,c) | r <- [xStart..xEnd], c <- [y..(y + len)]] $ \(r,c) ->+        setPixel32 dst r c colour+ where halfLen = thickness `div` 2+       xStart  = max (x - halfLen) 0+       xEnd    = min (xStart + thickness) $ surfaceGetWidth dst
+ o.png view

binary file changed (absent → 1326 bytes)

+ oWin.png view

binary file changed (absent → 1269 bytes)

+ x.png view

binary file changed (absent → 1344 bytes)

+ xWin.png view

binary file changed (absent → 1288 bytes)