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