{- 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