{-# LANGUAGE UnicodeSyntax #-}
-- | Usage: Hit /q/ to abort the match
module SoccerFun.UI.GL where

import qualified Graphics.UI.GLUT as GL
import Graphics.UI.GLUT (($=), get)
import Data.IORef
import Control.Monad
import Unsafe.Coerce
import System.Exit

import Prelude.Unicode
import SoccerFun.MatchControl
import SoccerFun.Types
import SoccerFun.Geometry
import SoccerFun.Referee.Ivanov
import SoccerFun.RefereeAction
import System.Random
import SoccerFun.MatchGame
import SoccerFun.Player
import SoccerFun.Team (Team)
import SoccerFun.Tape
import Data.Maybe
import SoccerFun.Field
import SoccerFun.Ball

gameLength  TimeUnit
gameLength = 1

initialise  IO (String,[String])
initialise = GL.getArgsAndInitialize

runMatch  (Home  Field  Team)  (Home  Field  Team)  IO ()
runMatch t1 t2 = do
	initialise
	playTape =<< liftM recordMatch (setupMatch t1 t2)

setupMatch  (Home  Field  Team)  (Home  Field  Team)  IO Match
setupMatch t1 t2 = let
		field = Field 70 105
		team1 = t1 West field
		team2 = t2 East field
	in liftM (setMatchStart team1 team2 field (ivanovReferee field team1 team2) 1) newStdGen

--	GL.initialDisplayCapabilities $= [GL.With GL.DisplayDouble, GL.With GL.DisplaySamples]
--	GL.multisample $= GL.Enabled

playTape  Tape  IO ()
playTape (Tape tape) = do
	GL.initialDisplayMode $= [GL.DoubleBuffered, GL.Multisampling]
	p  get GL.displayModePossible
	when (not p) $ do
		GL.initialDisplayMode $= [GL.DoubleBuffered]
		p  get GL.displayModePossible
		when (not p) $ GL.initialDisplayMode $= []
	window  GL.createWindow "SoccerFun"
	GL.clearColor $= (GL.Color4 0 0.5 0 0  GL.Color4 GL.GLclampf) -- green
	aspect  newIORef 1
	registerCallbacks window aspect =<< newIORef tape
	GL.cursor $= GL.LeftArrow
	GL.mainLoop
	GL.exit

registerCallbacks  GL.Window  IORef GL.GLdouble  IORef [Step]  IO ()
registerCallbacks window aspect tape = do
	GL.displayCallback $= display
	GL.reshapeCallback $= Just reshape
	GL.keyboardMouseCallback $= Just inputCallback
	gameLoop
--	GL.keyboardMouseCallback $= Just inputCallback
	where

	inputCallback  GL.Key  GL.KeyState  GL.Modifiers  GL.Position  IO ()
	inputCallback (GL.Char 'q') _ _ _ = exitSuccess
	inputCallback _ _ _ _ = return ()

	gameLoop = do
		((refereeActions,playerWithActions),match) : tape'  readIORef tape
		writeIORef tape tape'
		GL.postRedisplay $ Just window
		let actions = mapMaybe logRefereeAction refereeActions
		when (not $ GameOver `elem` refereeActions) $ do
			if null actions
				then GL.addTimerCallback 30 gameLoop
				else GL.addTimerCallback 1000 gameLoop
		mapM_ putStrLn actions

	reshape s@(GL.Size w h) = do
		writeIORef aspect newAspect
		GL.viewport $= (GL.Position 0 0, s)
		GL.matrixMode $= GL.Projection
		GL.loadIdentity
		GL.perspective 0 newAspect (-1) 1
		GL.matrixMode $= GL.Modelview 0
		where newAspect = fromIntegral w / fromIntegral (max 1 h)

	display = do
		m@Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time}  liftM (snd  head) $ readIORef tape
		GL.clear [GL.ColorBuffer]
		GL.loadIdentity
		a  readIORef aspect
		if a < 1 then GL.ortho2D (-1) 1 (-1/a) (1/a) else GL.ortho2D (-1*a) (1*a) (-1) 1
		let zoom = convertFloat $ 2.1 / flength field
		GL.scale zoom zoom 1
		GL.translate $ vector2 (-flength field/2,-fwidth field/2)

		renderStatus m
		GL.lineWidth $= 3
		renderField field
		GL.lineWidth $= 2
		renderBall ball m
		colorRGB (1,0,0) -- red
		mapM_ renderPlayer t1
		colorRGB (0,0,1) -- blue
		mapM_ renderPlayer t2

		GL.swapBuffers

	renderStatus Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time} = do
		colorRGB (0,0,0) -- black
		GL.preservingMatrix $ do
			GL.translate $ vector2 (0, fwidth field + 2)
			GL.lineWidth $= 2
			drawStatus $ show (fst score) ++ ":" ++ show (snd score) ++ "   " ++ show (round $ (1 - time) * 90) ++ ":00"

	renderField field@Field {flength = l, fwidth = w} = do
		colorRGB (0.8,1,0.8) -- green-white
		GL.renderPrimitive GL.LineLoop $ do -- side line
			vertex2 (0,0)
			vertex2 (l,0)
			vertex2 (l,w)
			vertex2 (0,w)
		GL.renderPrimitive GL.LineStrip $ do -- middle line
			vertex2 (l/2,0)
			vertex2 (l/2,w)
		GL.preservingMatrix $ do -- centre circle and centre spot
			GL.translate $ vector2 (l/2,w/2)
			GL.renderPrimitive GL.LineLoop $ circle radiusCentreCircle 23
			GL.renderPrimitive GL.Polygon $ circle radiusCentreSpot 7
		colorRGB (1,1,1) -- white
		mapM_ renderPole [(x,y) | let (n,s) = goalPoles field, y  [n,s], x  [0,l]] -- goal poles
		GL.preservingMatrix $ do
			GL.translate $ vector2 (penaltySpotDepth, w/2)
			GL.renderPrimitive GL.Polygon $ circle radiusPenaltySpot 7
		GL.preservingMatrix $ do
			GL.translate $ vector2 (l - penaltySpotDepth, w/2)
			GL.renderPrimitive GL.Polygon $ circle radiusPenaltySpot 7

	renderPole pos = GL.preservingMatrix $ do
		colorRGB (0.3,0.3,0.3)
		GL.translate $ vector2 pos
		GL.renderPrimitive GL.Polygon (circle goalPoleWidth 7)

	renderBall ball match = do
		let p = case ball of
			GainedBy pid  toPosition3D $ pos $ fromJust $ lookupPlayer pid match
			Free Ball {ballPos = p}  p
		colorRGB (1,1,1) -- white
		drawAt3D p $ GL.renderPrimitive GL.Polygon (circle radiusBall 7)

	renderPlayer Player {pos = p, playerID = id} = drawAt p $ do
		square
		drawString $ show $ playerNo id

colorRGB  (GL.GLfloat,GL.GLfloat,GL.GLfloat)  IO ()
colorRGB (r,g,b) = GL.color $ GL.Color3 r g b

--dot3D ∷ Position3D → IO ()
--dot3D pos3D = dot $ pxy pos3D

drawAt3D  Position3D  IO ()  IO ()
drawAt3D pos = drawAt (pxy pos)

drawAt  Position  IO ()  IO ()
drawAt pos draw = GL.preservingMatrix $ do
	GL.translate $ vector2 (px pos, py pos)
	draw

square  IO ()
square = GL.preservingMatrix $ do
	GL.renderPrimitive GL.LineLoop $ do
		vertex2 (-0.7,-0.7)
		vertex2 (0.7,-0.7)
		vertex2 (0.7,0.7)
		vertex2 (-0.7,0.7)

vector2  (Float,Float)  GL.Vector3 GL.GLfloat
vector2 (x,y) = GL.Vector3 (convertFloat x) (convertFloat y) 0

vertex2  (Float,Float)  IO ()
vertex2 (x,y) = GL.vertex $ GL.Vertex2 (convertFloat x) (convertFloat y)

circle r = oval r r

oval r1 r2 step = mapM_ vertex2 vs where
	is = take (truncate step + 1) [0, i' .. ]
	i' = 2 * pi / step
	vs = [ (r1 * cos i, r2 * sin i) | i <- is ]

{-
drawPort pos = GL.preservingMatrix $ do
	GL.translate $ vector pos
	GL.renderPrimitive GL.Polygon (circle 0.15 0.15 10)

drawNode label = do
	GL.renderPrimitive GL.LineLoop (circle 1 1 20)
	drawString label
-}

drawString label = GL.preservingMatrix $ do
	GL.translate $ GL.Vector3 (-0.3) (-0.3) (0  GL.GLfloat)
	GL.scale 0.007 0.007 (0  GL.GLdouble)
	GL.renderString GL.MonoRoman label

drawStatus label = GL.preservingMatrix $ do
	GL.translate $ GL.Vector3 (-0.3) (-0.3) (0  GL.GLfloat)
	GL.scale 0.03 0.03 (0  GL.GLdouble)
	GL.renderString GL.MonoRoman label

convertDouble  Double  GL.GLdouble
convertDouble = unsafeCoerce

convertFloat  Float  GL.GLfloat
convertFloat = unsafeCoerce