import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef

main = do 
  (progname, _) <- getArgsAndInitialize

  initialDisplayMode $= [WithDepthBuffer,DoubleBuffered,RGBAMode]
  createWindow "Hello World"

  depthFunc $= Just Less
  matrixMode $= Projection
  loadIdentity
  let near = 1
      far = 40
      right = 1
      top = 1
  frustum (-right) right (-top) top near far
  matrixMode $= Modelview 0

  tme <- get elapsedTime
  lasttime <- newIORef(tme)
  frame <- newIORef(-1.0)
  idleCallback $= Just (idle lasttime)  
    
  windowSize $= Size 800 500
  
  lighting $= Enabled
  position (Light 0) $= (Vertex4 1 0 (0.8::GLfloat) 1)
  ambient (Light 0) $= Color4 1 1 1 1
  diffuse (Light 0) $= Color4 1 1 1 1
  specular (Light 0) $= Color4 1 1 1 1
  light (Light 0) $= Enabled

  displayCallback $= (display frame)
  
  mainLoop

idle :: IORef(Int) -> IO()
idle lasttime = do lTime <- readIORef lasttime
                   currenttime <- get elapsedTime
                   case (currenttime - lTime >= 16) of
                     True -> do
                       writeIORef lasttime currenttime
                       postRedisplay Nothing
                       return ()
                     _ -> return ()

display :: IORef(Float) -> IO()
display f = do
  frame <- readIORef f 
  clear [ColorBuffer,DepthBuffer]
  loadIdentity

  --currentColor $= (Color4 1 1 1 1)
  
  preservingMatrix $ do --currentColor $= Color4 1 0 0 1
                        let rd = 1.0
                            gd = 0.0
                            bd = 0.6
                            rs = 0.5
                            gs = 0.5
                            bs = 0.0
                        materialDiffuse Front $= Color4 rd gd bd 1.0
                        materialAmbient Front $= Color4 0.0 0.7 0.8 0.2
                        materialSpecular Front $= Color4 rs gs bs 1.0

                        translate (Vector3 (-0.5) (-0.5) ((-2)::GLfloat))
                        rotate frame (Vector3 0 1 (1::GLfloat))
                        cube 1
  flush

  writeIORef f (frame+1)
  swapBuffers


makeVertices ((x,y,z):[]) = do (vertex (Vertex3 x y z))
makeVertices ((x,y,z):xs) = do (vertex (Vertex3 (x::GLfloat) y z))
                               makeVertices xs

cube l = do renderPrimitive Quads (makeVertices corners)
  where 
   corners =
    [(l,0,l),(0,0,l),(0,l,l),(l,l,l)
    ,(l,l,l),(l,l,0),(l,0,0),(l,0,l)
    ,(0,0,0),(l,0,0),(l,0,l),(0,0,l)
    ,(l,l,0),(0,l,0),(0,0,0),(l,0,0)
    ,(0,l,l),(l,l,l),(l,l,0),(0,l,0)
    ,(0,l,l),(0,l,0),(0,0,0),(0,0,l)
    ]