-- | 	Implements functions to open windows and draw pictures in them.
--
module	Graphics.Plot.Display
(
	displayInWindow,
	animateInWindow
)

where

-- import	qualified System.Posix.Unistd		as System
import	qualified System.Exit			as System

import	qualified Graphics.Rendering.OpenGL.GL	as GL
import	qualified Graphics.UI.GLUT		as GLUT
import	Graphics.UI.GLUT			(($=), get)
import 	Graphics.UI.GLUT.Initialization		(DisplayCapabilityDescription(..), Relation(..))

import	Graphics.Plot.Dump
import	Graphics.Plot.State
import	Graphics.Plot.Control
import	Graphics.Plot.Render
import	Graphics.Plot.Overlay
import	Graphics.Plot.Coord
import	Graphics.Plot.Util
import	Graphics.Plot.Picture

-----
displayInWindow
	:: String				-- ^ Name of the window.
	-> (Int, Int)				-- ^ Initial size of the window, in pixels.
	-> (Int, Int)				-- ^ Initial position of the window, in pixels relative to
						--	the top left corner of the screen.
	
	-> Picture				-- ^ The picture to draw.
	-> IO ()

-- ^	Opens a window and displays a static picture.

displayInWindow name size pos picture
 = 	renderInWindow name size pos 
 		(\s -> renderPicture s picture)	
		False

-----
animateInWindow
	:: String				-- ^ Name of the window.
	-> (Int, Int)				-- ^ Initial size of the window, in pixels.
	-> (Int, Int)				-- ^ Initial position of the window, in pixels relative to
						--	the top left corner of the screen.
	-> (Float -> Picture)			-- ^ New frame function. The function is passed the current animation
						--	time, in seconds.
	-> IO ()

-- ^	Opens a window and displays an animation.

animateInWindow name size pos frameFun
 = do	
 	let renderFun stateRef = do

		-- extract the current time from the state
  	 	time		<- stateRef ## stateAnimateTime
		let timeS	= (fromIntegral time / 1000)

		-- call the user function to get the animation frame
		let picture	= frameFun timeS 

		-- render the frame
		renderPicture stateRef picture

  	renderInWindow name size pos 
 		renderFun 
		True


-----
renderInWindow	
	:: String 				-- ^ Name of the window.
	-> (Int, Int) 				-- ^ Initial size of the window, in pixels.
	-> (Int, Int)				-- ^ Initial position of the window, in pixels relative to 
						--	the top left corner of the screen.
	-> (IORef DisplayState -> IO ())	-- ^ The function to call to draw the frame.
	-> Bool					-- ^ Whether to animate the picture.
	-> IO ()

-- ^ 	Opens a window and calls a user supplied function to draw frames for animation.
--	Timing and event information can be obtained from the display state which is passed
--	to the user function at each call.

renderInWindow
	windowName
	size@(sizeX, sizeY) 
	pos @(posX,  posY)
	displayFun
	animate
 = do
	---------------
	-- Setup state info
	--
	let state	= displayStateInit
			{ stateAnimate	= animate }

	stateRef	<- newIORef state
	
	let debug	= stateDebug state


	-- Initialize GLUT
 	(progName, args)	<- GLUT.getArgsAndInitialize
	glutVersion		<- get GLUT.glutVersion

	when debug
	 $ do 	putStr	$ "* displayInWindow\n"
	 	putStr	$ "  glutVersion        = " ++ show glutVersion		++ "\n"

	-- Setup and create a new window.
	--	Be sure to set initialWindow{Position,Size} before calling
	--	createWindow. If we don't do this we get wierd half-created
	--	windows some of the time.
	--
	GLUT.initialWindowPosition	
	 $= 	GL.Position		
	 		(fromIntegral posX)
			(fromIntegral posY)

	GLUT.initialWindowSize	
	 $= 	GL.Size 
			(fromIntegral sizeX) 
			(fromIntegral sizeY)

	GLUT.initialDisplayMode
	 $= 	[ GLUT.RGBMode
		, GLUT.DoubleBuffered]

{-	Clem's laptop freaks on this..
	GLUT.initialDisplayCapabilities
	 $= 	[ With	GLUT.DisplayRGBA
		, Where GLUT.DisplayDepth IsAtLeast 16 
		, With  GLUT.DisplayDouble ]
-}

	-- See if our requested display mode is possible
	--
	displayMode		<- get GLUT.initialDisplayMode
	displayModePossible	<- get GLUT.displayModePossible
	when debug
	 $ do	putStr	$  "  displayMode        = " ++ show displayMode ++ "\n"
	 		++ "       possible      = " ++ show displayModePossible ++ "\n"
			++ "\n"
		
	-- Here we go!
	--
	when debug
	 $ do	putStr	$ "* creating window\n\n"

	GLUT.createWindow windowName
	GLUT.windowSize	
	 $= 	GL.Size 
			(fromIntegral sizeX)
			(fromIntegral sizeY)
	
	---------------
	-- Setup callbacks
	-- 
	GLUT.displayCallback		$= callbackDisplay stateRef displayFun
	GLUT.reshapeCallback		$= Just (callbackReshape  stateRef)
	GLUT.keyboardMouseCallback	$= Just (callbackKeyMouse stateRef)
	GLUT.motionCallback		$= Just (callbackMotion   stateRef)

	(if animate 
	 then	GLUT.idleCallback	$= Just (callbackIdle     stateRef)
	 else	GLUT.idleCallback	$= Nothing)

	
	---------------
	--  Switch some things.
	--
	-- auto repeat interferes with key up / key down checks.
	--	BUGS: this doesn't seem to work?
	--
	GLUT.perWindowKeyRepeat		$= GLUT.PerWindowKeyRepeatOff	

	-- line smoothing looks nice for vector graphics.
	lineSmooth 	<- stateRef ## stateRenderLineSmooth
	setLineSmooth	lineSmooth
	
	-- enabling this makes the alpha channel in the colors work.
	blendAlpha	<- stateRef ## stateRenderBlendAlpha
	setBlendAlpha	blendAlpha

	-- we don't need the depth buffer for 2d.
	GL.depthFunc		$= Just GL.Always

	---------------
	-- Dump some debugging info
	--
	when debug
	 $ do	dumpGlutState
	 	dumpFramebufferState
		dumpFragmentState

	---------------
	-- Call the GLUT mainloop. 
	--	This function will return when something calls GLUT.leaveMainLoop
	--
	--	We can ask for this in freeglut, but it doesn't seem to work :(.
	--	GLUT.actionOnWindowClose	$= GLUT.MainLoopReturns

	when debug
	 $ do	putStr	$ "* entering mainloop..\n"
	
	GLUT.mainLoop

	when debug
	 $	putStr	$ "* all done\n"
	 
	return ()


-----
callbackDisplay	
	:: (IORef DisplayState)			-- ^ The current state.
	-> (IORef DisplayState -> IO ())	-- ^ The user's display function.
	-> IO ()

-- ^ 	GLUT calls back on this function when it's time to draw a new frame.
--	It sets up the render state, calls the user's display function and manages display timings.

callbackDisplay	stateRef displayFun
 = do
	debug	<- stateRef ## stateDebug

	when debug
	 $ 	putStr	$ "* display\n"

	-- clear the display
	GL.clear [GL.ColorBuffer, GL.DepthBuffer]
	GL.color $ GL.Color4 1 1 1 (1 :: Float)

	-- setup render state for world
	lineSmooth 	<- stateRef ## stateRenderLineSmooth
	setLineSmooth	lineSmooth
	
	blendAlpha	<- stateRef ## stateRenderBlendAlpha
	setBlendAlpha	blendAlpha

	-- write the current time into the display state
	displayTime		<- get GLUT.elapsedTime
	displayTimeLast		<- stateRef ## stateDisplayTime
	let displayTimeElapsed	= displayTime - displayTimeLast

	stateRef <##> \s -> s 
		{ stateDisplayTime	= displayTime 
		, stateDisplayTimeLast	= displayTimeLast }

	when debug
	 $ 	putStr   $ "  displayTime        = " ++ show displayTime 		++ "\n"
	 		++ "  displayTimeLast    = " ++ show displayTimeLast 		++ "\n"
			++ "  displayTimeElapsed = " ++ show displayTimeElapsed 	++ "\n"


	-- increment the animation time
	animate			<- stateRef ## stateAnimate
	animateTime		<- stateRef ## stateAnimateTime
	animateStart		<- stateRef ## stateAnimateStart
	
	when (animate && not animateStart)
	 $ do	stateRef <##> \s -> s
			{ stateAnimateTime	= animateTime + displayTimeElapsed }
			
	when animate
	 $ do	stateRef <##> \s -> s
	 		{ stateAnimateStart	= False }

	-- draw the world
	withWorldCoords
		stateRef
		(displayFun stateRef)


	-- setup render state for overlay
	setLineSmooth	False
	setBlendAlpha	True
	
	-- draw the overlay
	showOverlay	<- stateRef ## stateShowOverlay

	when showOverlay
	 $ do	withOverlayCoords stateRef
			(renderOverlay stateRef)
	
	-- swap back/front buffers
	GLUT.swapBuffers


	-- timing gate
	--
	timeClamp	<- stateRef ## stateDisplayTimeClamp

	gateTimeStart	<- get GLUT.elapsedTime			-- the start of this gate
	gateTimeEnd	<- stateRef ## stateGateTimeEnd		-- end of the previous gate
	let gateTimeElapsed	
			= gateTimeStart - gateTimeEnd
	
--	when (gateTimeElapsed < timeClamp)
--   $ do
--		System.usleep ((timeClamp - gateTimeElapsed) * 1000)

	gateTimeFinal	<- get GLUT.elapsedTime

	stateRef <##> \s -> s 
		{ stateGateTimeEnd	= gateTimeFinal }
		
	
{-	putStr	$  "gateTimeStart   = " ++ show gateTimeStart	++ "\n"
	++ "gateTimeEnd     = " ++ show gateTimeEnd	++ "\n"
	++ "gateTimeElapsed = " ++ show gateTimeElapsed	++ "\n"
	++ "\n"
-}	

	GLUT.reportErrors 

	return ()

	
-----
callbackReshape 
	:: (IORef DisplayState)		-- ^ The current state.
	-> GL.Size 			-- ^ New window size.
	-> IO ()

-- ^	GLUT calls back on this function when the window size changes.
--	It configures the new viewport and writes the new size into the state.

callbackReshape stateRef size
 = do
	debug	<- stateRef ## stateDebug
	when debug
	 $	putStr	$  "* event reshape\n"
	 		++ "  size               = " ++ show size ++ "\n"
			++ "\n"

	-- Setup the viewport
	--	This controls what part of the window openGL renders to.
	--	We'll use the whole window.
	--
 	GL.viewport 	$= (GL.Position 0 0, size)

	-- Update the state with the new window size.
	--
	let GL.Size sizeX sizeY	= size

	stateRef <##> \s -> s { 
		stateWindowSize = (fromIntegral sizeX, fromIntegral sizeY) }

	GLUT.postRedisplay Nothing

	return ()


-----
setBlendAlpha state
 | state	
 = do
	GL.blend	$= GL.Enabled
	GL.blendFunc	$= (GL.SrcAlpha, GL.OneMinusSrcAlpha)

 | otherwise
 = do
 	GL.blend	$= GL.Disabled
	GL.blendFunc	$= (GL.One, GL.Zero) 	

setLineSmooth state
 | state	= GL.lineSmooth	$= GL.Enabled
 | otherwise	= GL.lineSmooth $= GL.Disabled