{-# 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 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.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') ← 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
		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