-- ==================================
-- Module name: Court
-- Project: Foo
-- Copyright (C) 2007  Bartosz Wójcik
-- Created on: 01.10.2007
-- Last update: 07.04.2008
-- Version: %

{-  This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
-- ==================================
module Court where

-- This module is simply user interface to Foo Engine.

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.Either
import Data.IORef
import System.Exit
import List

import Foo
import FooField
import FooMove
import MyPrimitives

-- import FooState

-- List of predefined colours used in game
courtBckgdCol  = Color4 0.1 0 0 1          -- black
courtCol       = Color4 1 1 1 1            -- white
lastPointCol   = Color4 1 0.5 0 1          -- orange
activePointCol = Color4 1 0 0 1            -- red
newMoveCol     = Color4 1 0 0 1            -- red
fstMoveCol     = Color4 1 1 1 1            -- white
sndMoveCol     = Color4 0 1 0 1            -- green
lstMoveCol     = Color4 1 1 0 1            -- yellow

-- Main graphical function.
-- Initializes screen and controls the current game until it's finished.
-- ======================================================================
court :: (Ord b, Num b) => Int -> Int               -- size of field
         -> (Bool, PlayingAlgorithm)                -- whether algorithm is 1st player and which one
         -> (Bool, PlayingAlgorithm)                -- whether algorithm is 2nd player and which one
         -> b                                       -- number of games to be played
         -> IO ()
court fL fW (fstPlayerComp,fstAlg) (sndPlayerComp,sndAlg) nbrGames = do
-- ======================================================================
  (progname, _) <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered]
  w <- createWindow ("Foo Field (C) Bartosz Wojcik 2008")
  windowSize $= Size 400 550

  -- List of states of game                                                               -- screen size is adjusted to game
  activeVertex <- newIORef (0,0)                                                          -- vertex, mouse cursor points on
  activeFstPlayer <- newIORef True                                                        -- True - 1st player on move; False - 2nd one
  fstPlayerBegins <- newIORef True                                                        -- True - 1st player begins current game; False - opposite
  lastPositionVertex <- newIORef (fromIntegral fW / 2, fromIntegral fL / 2 + 1)           -- vertex, last pass finished on
  myScreenSize <- newIORef (Size 300 400)                                                 -- size of the visible screen
  court <- newIORef (field fL fW)                                                         -- Foo.field - the Graph
  rmdEdges <- newIORef []                                                                 -- list of removed edges for display purposes only
  rmdLstMvEdges <- newIORef []                                                            -- list of removed edges of last move for display purposes only
  gameNumber <- newIORef (nbrGames,1)                                                     -- game lasts until snd gameResult == fst gameResult
  gameResult <- newIORef (0,0)

  -- main display
  displayCallback $= display fL fW activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges gameNumber gameResult (playerName fstPlayerComp fstAlg) (playerName sndPlayerComp sndAlg)

  -- screen is renormalized from 0,0 at bottom left to fW,fL+4
  projection (-0.1) (fromIntegral fW + 0.1) 0 (fromIntegral fL + 4) 0 1

  -- mouse movement control
  if not fstPlayerComp || not sndPlayerComp
     then passiveMotionCallback $= Just (mousePosition activeVertex (fromIntegral fW) (fromIntegral fL + 4) myScreenSize)
     else passiveMotionCallback $= Nothing

  -- action when window gets reshaped
  reshapeCallback $= Just (reshape myScreenSize)

  -- action on mouse click
  keyboardMouseCallback $= Just (keyboardMouse activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer fL fW w gameNumber gameResult fstPlayerBegins)

  -- computer plays
  if fstPlayerComp || sndPlayerComp
     then idleCallback $= Just (idle activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer fL fW w fstPlayerComp fstAlg sndPlayerComp sndAlg gameResult)
     else idleCallback $= Nothing

  mainLoop
-- ======================================================================


-- Computer plays
-- ========================================================================
idle activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer
     fL fW win fstPlayerComp fstAlg sndPlayerComp sndAlg gameResult = do
-- ========================================================================
   c <- readIORef court
   lV <- readIORef lastPositionVertex
   aV <- readIORef activeVertex
   rmdE <- readIORef rmdEdges
   rmdLME <- readIORef rmdLstMvEdges
   aFP <- readIORef activeFstPlayer
   if lVy lV == 0 || lVy lV == fromIntegral fL + 2 || vertices (vx lV) c == []    -- end of game
      then postRedisplay Nothing
      else if aFP && fstPlayerComp || not aFP && sndPlayerComp
      then do
         if aFP
            then  putStrLn $ "Player1. Nbr possible moves: " ++ (show $ sizeMove 0 $ nextMove aFP (vx lV) c fL fW 0)
            else  putStrLn $ "Player2. Nbr possible moves: " ++ (show $ sizeMove 0 $ nextMove aFP (vx lV) c fL fW 0)
   -- Here starts computer's move
         court $= (graphAfterPass c $ computerPlays (vx lV) c aFP)
         lastPositionVertex $= ((\(x,y) -> (fromIntegral x,fromIntegral y)) $ head $ vOfMove $ computerPlays (vx lV) c aFP)
         rmdEdges $= (lastMove2RmdEdges rmdLME aFP fstPlayerComp sndPlayerComp []) ++ rmdE
         rmdLstMvEdges $= lOfP2lOfReEd (vOfMove $ computerPlays (vx lV) c aFP) [] lstMoveCol

  -- Following line of code gives even 35% overhead!
  -- Ther reason of this feature is not clear to me. The function that costs here is one that has been already called couple lines above.
  -- I'd expect that its result is kept and can be applied with minimal overhead.

  --       putStrLn $ show $ computerPlays (vx lV) c aFP               

         lV' <- readIORef lastPositionVertex
         activeFstPlayer $= newActivePlayer aFP (active (vx lV') c)

         -- Actualize result if end of game
         c' <- readIORef court                                               -- court after move

         if lVy lV' == 0 || lVy lV' == fromIntegral fL + 2 || vertices (vx lV') c' == []    -- end of game
            then readIORef gameResult >>= \gR -> gameResult $= actualizeResult gR lV' fL c' (not aFP)
            else court $= c'

         postRedisplay Nothing
      else court $= c
     where computerPlays v g aFP = bestMove $ mapSelectedMove (Play (alg aFP) aFP) (alg aFP) $ nextMove aFP v g fL fW 0
           lOfP2lOfReEd (l1:[])    os col = os
           lOfP2lOfReEd (l1:l2:ls) os col = lOfP2lOfReEd (l2:ls) ((l1,col):(l2,col):os) col
           alg True = fstAlg
           alg False = sndAlg
-- ========================================================================

-- Simple XOR.
-- ========================================================================
newActivePlayer True True   = True
newActivePlayer False False = True
newActivePlayer _     _     = False
-- ========================================================================

-- To case Vertex of field into vertex of graph.
-- ========================================================================
vx (x,y) = (round x,round y)
-- ========================================================================

-- ========================================================================
lVy (x,y) = y
-- ========================================================================

-- ========================================================================
col True  = fstMoveCol
col False = sndMoveCol
-- ========================================================================

-- When left button is down and the activeVertex has edge with lastPositionVertex, then this constitutes next pass.
-- ================================================================================
keyboardMouse activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer
              fL fW win gameNumber gameResult fstPlayerBegins (MouseButton LeftButton) Down _ _ = do
-- ================================================================================
   c <- readIORef court
   lV <- readIORef lastPositionVertex
   aV <- readIORef activeVertex
   rmdE <- readIORef rmdEdges
   rmdLME <- readIORef rmdLstMvEdges
   aFP <- readIORef activeFstPlayer
   (gN,gI) <- readIORef gameNumber
   if lVy lV == 0 || lVy lV == fromIntegral fL + 2 || vertices (vx lV) c == []    -- end of game
      then if gN > gI
         then do
            putStrLn "End of Game"
            renewGame activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer fL fW gameNumber fstPlayerBegins
            postRedisplay Nothing
         else do
            putStrLn "End of Tournament"
            exitWith ExitSuccess
            destroyWindow win
            -- postRedisplay Nothing
      else if activeV aV /= [] && chckEdge (vx lV) (vx aV) c                 -- if vertex belongs to field and there is an edge between it and last position one
      then do
         court $= rmEdge (vx lV) (vx aV) c                                   -- remove just chosen edge from field
         rmdEdges $= ((vx lV),col aFP):((vx aV),col aFP):rmdE                -- add chosen edge to list of removed edges
         lastPositionVertex $= aV                                            -- change of last position vertes
         activeFstPlayer $= newActivePlayer aFP (active (vx aV) c)           -- check what player is on move afterwards

         -- Actualize result if end of game
         c' <- readIORef court                                               -- court after move
         if lVy aV == 0 || lVy aV == fromIntegral fL + 2 || vertices (vx aV) c' == []    -- end of game
            then readIORef gameResult >>= \gR -> gameResult $= actualizeResult gR aV fL c' (not aFP)
            else court $= c'

         postRedisplay Nothing
      else court $= c
   where activeV aV = filter (== aV) (verticesOfField fL fW)

-- Other action with mouse click or keyboard usage are without effect.
-- ================================================================================
keyboardMouse _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = return ()
-- ================================================================================


-- ========================================================================
actualizeResult (gA,gB) (_,0) _  _ _                              = (gA + 1,gB)
actualizeResult (gA,gB) (x,y) fL c aFP | y == fromIntegral fL + 2 = (gA,gB + 1)
                                       | aFP                      = (gA + 0.5,gB)
                                       | otherwise                = (gA,gB + 0.5)
-- ========================================================================

-- Creates list of passes in trerms of vertives mixed with colour of pass.
-- ========================================================================
lastMove2RmdEdges :: [(a, b)]
                     -> Bool                    -- towards goal (_,0)
                     -> Bool                    -- 1st player is computer
                     -> Bool                    -- 2nd player is computer
                     -> [(a, Color4 GLfloat)]   -- dragged output list
                     -> [(a, Color4 GLfloat)]
lastMove2RmdEdges []         _    _    _    os  = reverse os
lastMove2RmdEdges ((v,c):ls) True True True os  = lastMove2RmdEdges ls True True True ((v,sndMoveCol):os)
lastMove2RmdEdges ((v,c):ls) True _    _    os  = lastMove2RmdEdges ls True False False ((v,fstMoveCol):os)
lastMove2RmdEdges ((v,c):ls) False True True os = lastMove2RmdEdges ls False True True ((v,fstMoveCol):os)
lastMove2RmdEdges ((v,c):ls) False _    _    os = lastMove2RmdEdges ls False False False ((v,sndMoveCol):os)
-- ========================================================================

-- Reaction on mouse movement.
-- If mouse cursor approaches vertex of field, it gets activated.
-- If there is edge between active vertex and last vertex, it will be displayed.
-- =========================================================
mousePosition activeV fW fL myScreenSize (Position x y) = do
-- =========================================================
  s <- readIORef myScreenSize
  if (dx s) <= 0.2 && (dy s) <= 0.2                            -- mouse cursor close to a vertex
     then activeV $= (x'' s,fL - y'' s)
     else activeV $= (0,0)
  postRedisplay Nothing
  where x' (Size w h) = fW * fromIntegral x / fromIntegral w
        y' (Size w h) = fL * fromIntegral y / fromIntegral h
        x'' s = fromIntegral $ round (x' s)
        y'' s = fromIntegral $ round (y' s)
        dx s = abs $ x'' s - x' s
        dy s = abs $ y'' s - y' s
-- =========================================================

-- Current game finished, new one starts.
-- =========================================================
renewGame activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges activeFstPlayer fL fW gameNumber fstPlayerBegins = do
-- =========================================================
  activeVertex $= (0,0)                                                                  -- vertex, mouse cursor points on
  fPB <- readIORef fstPlayerBegins
  activeFstPlayer $= not fPB                                                                -- True - 1st player on move; False - 2nd one
  fstPlayerBegins $= not fPB
  lastPositionVertex $= (fromIntegral fW / 2, fromIntegral fL / 2 + 1)                   -- vertex, last pass finished on
  court $= field fL fW                                                                 -- Foo.field - the Graph
  rmdEdges $= []                                                                         -- list of removed edges for display purposes only
  rmdLstMvEdges $= []
  (gN,gI) <- readIORef gameNumber
  gameNumber $= (gN,gI + 1)
-- =========================================================

-- Size of screen has to be traced in order to show active vertex correctly.
-- =========================================================
reshape myScreenSize s@(Size w h) = do
-- =========================================================
  myScreenSize $= s
  viewport $= (Position 0 0, s)
-- =========================================================

-- List of vertices that have to be displayed.
-- =========================================================
verticesOfField :: Int -> Int -> [(GLfloat,GLfloat)]
verticesOfField fL fW = [(fromIntegral x,fromIntegral y) | x<-[0..fW], y<-[0..fL+2], y > 0 && y < fL+2 || x > 2 && x < 5 ]
-- =========================================================

-- Usual orthogonal projection
-- =========================================================
projection xl xu yl yu zl zu = do
  matrixMode $= Projection
  loadIdentity
  ortho xl xu yl yu zl zu
  matrixMode $= Modelview 0
-- =========================================================

-- =========================================================
playerName False _ = "Human"
playerName True  algorithm = show algorithm
-- =========================================================

-- Displays nothing - sometimes required for if statement
-- =========================================================
dispNothing = renderPrimitive Points $ vertex $ Vertex2 0 (0::GLfloat)
-- =========================================================

-- Main display function
-- =========================================================
display fL fW activeVertex lastPositionVertex court rmdEdges rmdLstMvEdges gameNumber gameResult fstName sndName = do
-- =========================================================
  clearColor $= courtBckgdCol
  clear [ColorBuffer]

  -- first display vertices inside field
  loadIdentity
  renderPrimitive Points $ do
    currentColor $= courtCol
    mapM_ (\(x,y) -> vertex$Vertex2 x y) (verticesOfField fL fW)

  -- then display the court
  loadIdentity
  renderPrimitive LineLoop $ do
    currentColor $= courtCol
    vertex $ Vertex2 0 (1::GLfloat)
    vertex $ Vertex2 (leftGoalLine::GLfloat) 1
    vertex $ Vertex2 leftGoalLine 0
    vertex $ Vertex2 rightGoalLine 0
    vertex $ Vertex2 rightGoalLine 1
    vertex $ Vertex2 fW' 1
    vertex $ Vertex2 fW' (fL' + 1)
    vertex $ Vertex2 rightGoalLine (fL' + 1)
    vertex $ Vertex2 rightGoalLine (fL' + 2)
    vertex $ Vertex2 leftGoalLine (fL' + 2)
    vertex $ Vertex2 leftGoalLine (fL' + 1)
    vertex $ Vertex2 0 (fL' + 1)

  readIORef gameNumber >>= \x -> displayGameNumber x (fromIntegral fL)
  readIORef gameResult >>= \x -> displayGameResult x (fromIntegral fL)
  displayName fstName (fromIntegral fL + 1.5) fstMoveCol
  displayName sndName 0.5 sndMoveCol

  -- then display done movements
  readIORef rmdEdges >>= \ls -> displayDoneMoves ls
  readIORef rmdLstMvEdges >>= \ls -> displayDoneMoves ls

  -- then display pass that finishes at mouse cursor - if there is such a pass
  c <- readIORef court
  lV <- readIORef lastPositionVertex
  aV <- readIORef activeVertex
  loadIdentity
  currentColor $= newMoveCol
  if activeV aV /= [] && chckEdge (vx lV) (vx aV) c
     then displayPoints [lV,aV] Lines
     else dispNothing

  -- then emphasise vertex of end of last pass
  loadIdentity
  currentColor $= lastPointCol
  filledCircleAtV lV (0.1::GLfloat)

  -- then mark active vertex
  loadIdentity
  currentColor $= activePointCol
  if activeV aV == []
    then dispNothing
    else filledCircleAtV (head $ activeV aV) (0.1::GLfloat)

  swapBuffers
  where leftGoalLine = fW' / 2 - 1
        rightGoalLine = fW' / 2 + 1
        fW' = fromIntegral fW
        fL' = fromIntegral fL
        activeV aV = filter (== aV) (verticesOfField fL fW)
        vx (x,y) = (round x,round y)
-- =========================================================

-- Gets list of passes in terms of pair of vertices.
-- Renders lines that reflect given passes. Passes are in 3 possible predefined colors and are rendered separatelly.
-- ls == [((x,y),c)] where
-- (x,y) - vertex; c - color
-- =========================================================
displayDoneMoves :: (Integral b, Integral a) => [((a, b), Color4 GLfloat)] -> IO ()
-- =========================================================
displayDoneMoves ls = do
   loadIdentity
   renderPrimitive Lines $ do
      currentColor $= fstMoveCol
      mapM_ (\(x,y) -> vertex$Vertex2 (fromIntegral x::GLfloat) (fromIntegral y)) (map fst $ filter ((== fstMoveCol).snd) ls)
   loadIdentity
   renderPrimitive Lines $ do
      currentColor $= sndMoveCol
      mapM_ (\(x,y) -> vertex$Vertex2 (fromIntegral x::GLfloat) (fromIntegral y)) (map fst $ filter ((== sndMoveCol).snd) ls)
   loadIdentity
   renderPrimitive Lines $ do
      currentColor $= lstMoveCol
      mapM_ (\(x,y) -> vertex$Vertex2 (fromIntegral x::GLfloat) (fromIntegral y)) (map fst $ filter ((== lstMoveCol).snd) ls)
-- =========================================================

-- =========================================================
displayGameNumber (n,i) fL = do
-- =========================================================
   loadIdentity
   translate $ Vector3 0 (fL + 3.5) (0::GLfloat)
   scale 0.003 0.003 (1::GLfloat)
   renderString Roman ("Game " ++ show i ++ " out of " ++ show n)
-- =========================================================

-- =========================================================
displayGameResult (a,b) fL = do
-- =========================================================
   loadIdentity
   translate $ Vector3 0 (fL + 2.5) (0::GLfloat)
   scale 0.003 0.003 (1::GLfloat)
   renderString Roman ("Result " ++ show a ++ " : " ++ show b)
-- =========================================================

-- =========================================================
displayName name y col = do
-- =========================================================
   loadIdentity
   translate $ Vector3 0 y (0::GLfloat)
   scale 0.0021 0.0025 (1::GLfloat)
   currentColor $= col
   renderString Roman name
-- =========================================================