{-# 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 Control.DeepSeq

import SoccerFun.MatchControl
import SoccerFun.Types
import SoccerFun.Geometry
import SoccerFun.Referee.Ivanov
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
	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