{-# LANGUAGE UnicodeSyntax #-}
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 Data.Maybe
import System.Exit
--import Control.DeepSeq

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 Data.Maybe
import SoccerFun.Field
import SoccerFun.Ball

gameLength  TimeUnit
gameLength = 1

runMatch  (Home  Field  Team)  (Home  Field  Team)  IO ()
runMatch t1 t2 = do
	let
		field = Field 70 105
		team1 = t1 West field
		team2 = t2 East field
	match  liftM (setMatchStart team1 team2 field (ivanovReferee field team1 team2) 1) newStdGen
	(prog,args)  GL.getArgsAndInitialize
--	GL.initialDisplayCapabilities $= [GL.With GL.DisplayDouble, GL.With GL.DisplaySamples]
--	GL.multisample $= GL.Enabled
	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 match
	GL.cursor $= GL.LeftArrow
	GL.mainLoop
	GL.exit

registerCallbacks  GL.Window  IORef GL.GLdouble  IORef Match  IO ()
registerCallbacks window aspect match = do
	GL.displayCallback $= display
	GL.reshapeCallback $= Just reshape
	GL.closeCallback $= Just exitSuccess
	gameLoop
--	GL.keyboardMouseCallback $= Just inputCallback
	where

	gameLoop = do
		((refereeActions,playerWithActions),match')  liftM stepMatch $ readIORef match
		writeIORef match match'
		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}  readIORef match
		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
		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