{- 
	A visualization of a Klein bottle

	Andrey Mirtchovski [mirtchov@cpsc.ucalgary.ca]

-}
import System.Exit   ( exitWith, ExitCode(ExitSuccess) )
import Data.IORef  ( IORef, newIORef, readIORef, modifyIORef , writeIORef)


import GL
import GLU
import Graphics.UI.GLUT

-- rotation x, y, zoom z
type Spin = (IORef GLfloat, IORef GLfloat, IORef GLfloat) 


-- calculate the [x,y,z] coordinates using the parametric
-- equation for a klein bottle
klein :: GLfloat -> GLfloat -> GLfloat -> (GLfloat, GLfloat, GLfloat)
klein u v a =
	(cos(u) * (a + sin(v) * cos(u/2) - sin(2*v)*sin(u/2)/2),
	sin(u) * (a + sin(v) * cos(u/2) - sin(2*v)*sin(u/2)/2),
	sin(u/2) * sin(v) + cos(u/2)*sin(2*v)/2)

-- mapped over (-Pi, Pi)
calc (u, v, a) = do
	let (x,y,z) = klein u v a

	color (Color3 (x+0.5) (y+0.5) (z+0.5))
	vertex (Vertex3 x y (z :: GLfloat))


display :: Spin -> IORef GLfloat-> DisplayCallback
display (spinx,spiny,spinz) param = do
	-- clear all pixels
	clear [ColorBufferBit, DepthBufferBit]

	x <- readIORef spinx
	y <- readIORef spiny
	z <- readIORef spinz
	a <- readIORef param

	pushMatrix

	translate (Vector3 0.0 0.0 (z - 5.0))

	rotate x (Vector3 0.0 1.0 0.0)
	rotate y (Vector3 1.0 0.0 0.0)



	beginEnd LineStrip $ mapM_ calc [ 
		(u,v, a) | 
			u <- [-3.14,-3.04..3.10],
			v <- [-3.14,-3.04..3.10]]

	
--	color (Color3 0.0 1.0 0.0 :: Color3 GLfloat)
--	renderObject Wireframe (Cube 1)
	popMatrix
	swapBuffers

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
	clearColor (Color4 0.0 0.0 0.0 0.0)

  	viewport (0, 0) (fromIntegral w, fromIntegral h)
	matrixMode Projection
	loadIdentity
	ortho (-(fromIntegral w)) (fromIntegral w) (-(fromIntegral w)) (fromIntegral w) (-(fromIntegral w)) (fromIntegral w)
	perspective 0.1 (fromIntegral w / fromIntegral h) 1.0 6.0

	matrixMode Modelview
	loadIdentity
	
	enable DepthTest
	color (Color4 1.0 1.0 1.0 1.0 :: Color4 GLfloat)
	pointSize 2


keyboard :: Spin -> Spin -> KeyboardMouseCallback
keyboard _ _ (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _ _ (Char 'q') Down _ _ = exitWith ExitSuccess
keyboard _ _ (Char 'Q') Down _ _ = exitWith ExitSuccess
keyboard (sx, sy, sz) (osx, osy, osz) (MouseButton LeftButton) Down _ (WindowPosition x y) = do
	s <- readIORef sx
	writeIORef osx ((fromIntegral x) - s)
	s <- readIORef sy
	writeIORef osy ((fromIntegral y) - s)
	postRedisplay
keyboard _ _ _ _ _ _= return ()


motion :: Spin -> Spin -> MotionCallback
motion (sx,sy,sz) (osx,osy,osz) (WindowPosition x y)= do
	t <- readIORef osx
	writeIORef sx ((fromIntegral x) - t);
	t <- readIORef osy
	writeIORef sy ((fromIntegral y) - t);
	postRedisplay

	
idle :: Spin
	-> (IORef GLfloat, IORef GLfloat) 
	-> DisplayCallback
idle (sx,sy,sz) (p,frames) = do
	s <- readIORef sx
	writeIORef sx (s+0.1)
	s <- readIORef sy
	writeIORef sy (s+0.3)

	f <- readIORef frames
	let mf = f+0.01

	a <- readIORef p
	writeIORef p (sin(mf))
	writeIORef frames mf

	postRedisplay


main :: IO ()
main = do
	getArgsAndInitialize
	setInitialDisplayMode [ Graphics.UI.GLUT.Double, RGBA ]
	setInitialWindowSize (WindowSize 600 600)
	setInitialWindowPosition (WindowPosition 100 100)
	createWindow "klein-haskell"

	a <- newIORef 0.0
	f <- newIORef 0.0

   	sx <- newIORef 0
   	sy <- newIORef 0
   	sz <- newIORef 0
	
	osx <- newIORef 0
	osy <- newIORef 0
	osz <- newIORef 0

	setMotionCallback(Just (motion (sx,sy,sz) (osx, osy, osz)))
	setDisplayCallback (display (sx,sy,sz) a)
	setReshapeCallback (Just reshape)
	setKeyboardMouseCallback (Just (keyboard (sx,sy,sz) (osx, osy, osz)))
	setIdleCallback (Just (idle (sx,sy,sz) (a,f)))

	mainLoop