{-

HOpenGL Tutorial - Andre W B Furtado - 2001
www.cin.ufpe.br/~haskell/hopengl/
awbf@cin.ufpe.br

** Input / Output Reference **

-}

import GL
import GLUT
import IOExts

myInit :: IO () 
myInit = do
	clearColor (Color4 0.0 0.0 0.0 0.0)
	clear [ColorBufferBit]
	matrixMode Projection
	loadIdentity
	ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0

special :: IORef Float -> IORef Float -> SpecialAction
special pX _  KeyRight _ = readIORef pX >>= \posX -> writeIORef pX (posX + 0.2) >> postRedisplay
special pX _  KeyLeft  _ = readIORef pX >>= \posX -> writeIORef pX (posX - 0.2) >> postRedisplay
special _  pY KeyUp    _ = readIORef pY >>= \posY -> writeIORef pY (posY + 0.2) >> postRedisplay
special _  pY KeyDown  _ = readIORef pY >>= \posY -> writeIORef pY (posY - 0.2) >> postRedisplay
special _ _ _ _ = return ()

drawSquare :: (GLfloat,GLfloat) -> IO ()
drawSquare (x,y) = do
	clear [ColorBufferBit]
	color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)
	beginEnd Quads $ mapM_ vertex [
		Vertex3   x         y         0.0,
		Vertex3  (x + 0.2)  y         0.0,
		Vertex3  (x + 0.2) (y + 0.2)  0.0,
		Vertex3   x        (y + 0.2) (0.0 :: GLfloat)]

	flush
	
display :: IORef Float -> IORef Float -> DisplayAction
display pX pY = do
	clear [ColorBufferBit]
	posX <- readIORef pX
	posY <- readIORef pY
	drawSquare (posX, posY)
	flush

main :: IO ()
main = do
	GLUT.init Nothing
	createWindow "IORef" (return ()) [ Single, GLUT.Rgba ]
               	(Just (WindowPosition 100 100))
               	(Just (WindowSize     500 500))
	myInit
	pX <- newIORef 0.0
	pY <- newIORef 0.0
	displayFunc (display pX pY)
	specialFunc (Just (special pX pY))
	mainLoop