{-
   MoveLight.hs (adapted from movelight.c which is (c) Silicon Graphics, Inc)
   This file is part of HOpenGL - a binding of OpenGL and GLUT for Haskell.
   Copyright (C) 2000  Sven Panne <Sven.Panne@informatik.uni-muenchen.de>

   This program demonstrates when to issue lighting and
   transformation commands to render a model with a light
   which is moved by a modeling transformation (rotate or
   translate).  The light position is reset after the modeling
   transformation is called.  The eye position does not change.
 
   A sphere is drawn using a grey material characteristic.
   A single light source illuminates the object.
 
   Interaction:  pressing the left mouse button alters
   the modeling transformation (x rotation) by 30 degrees.
   The scene is then redrawn with the light in a new position.
-}

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

import GL
import GLU
import Graphics.UI.GLUT

-- Initialize material property, light source, lighting model,
-- and depth buffer.
myInit :: IO ()
myInit = do
   clearColor (Color4 0.0 0.0 0.0 0.0)
   shadeModel GL.Smooth
   enable Lighting
   enable (Light 0)
   enable DepthTest

-- Here is where the light position is reset after the modeling
-- transformation (rotate) is called.  This places the
-- light at a new position in world coordinates.  The cube
-- represents the position of the light.
display :: IORef GLint -> DisplayCallback
display spin = do
   clear [ ColorBufferBit, DepthBufferBit ]
   pushMatrix
   lookAt (0, 0, 5) (0, 0, 0) (0, 1, 0)

   pushMatrix
   s <- readIORef spin
   rotate (fromIntegral s :: GLdouble) (Vector3 1.0 0.0 0.0)
   light (Light 0) (Position (Vertex4 0.0 0.0 1.5 1.0))

   translate (Vector3 0.0 0.0 (1.5 :: GLdouble))
   disable Lighting
   color (Color3 0.0 1.0 (1.0 :: GLfloat))
   renderObject Wireframe (Cube 0.1)
   enable Lighting
   popMatrix

   renderObject Solid (Torus 0.275 0.85 8 15)
   popMatrix
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   perspective 40.0 (fromIntegral w / fromIntegral h) 1.0 20.0
   matrixMode Modelview
   loadIdentity

keyboardMouse :: IORef GLint -> KeyboardMouseCallback
keyboardMouse _    (Char '\27')             Down _ _ = exitWith ExitSuccess
keyboardMouse spin (MouseButton LeftButton) Down _ _= do
   modifyIORef spin (\s -> (s+30) `mod` 360)
   postRedisplay
keyboardMouse _ _ _ _ _ = return ()

main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB, Graphics.UI.GLUT.Depth ]
   setInitialWindowSize (WindowSize 500 500)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   myInit
   spin <- newIORef 0
   setDisplayCallback (display spin)
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just (keyboardMouse spin))
   mainLoop
