{-
   Light.hs (adapted from light.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 the use of the OpenGL lighting
   model.  A sphere is drawn using a grey material characteristic.
   A single light source illuminates the object.
-}

import System.Exit ( exitWith, ExitCode(ExitSuccess) )

import GL
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 Smooth
   mapM_ (material Front) [ MaterialColor Specular (Color4 1.0 1.0 1.0 1.0),
                            Shininess 50.0 ]
   light (Light 0) (Position (Vertex4 1.0 1.0 1.0 0.0))
   enable Lighting
   enable (Light 0)
   enable DepthTest

display :: DisplayCallback
display = do
   clear [ ColorBufferBit, DepthBufferBit ]
   renderObject Solid (Sphere 1.0 20 16)
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   let wf = fromIntegral w
       hf = fromIntegral h
   if (w <= h)
      then ortho (-1.5) 1.5 (-1.5*hf/wf) (1.5*hf/wf) (-10.0) 10.0
      else ortho (-1.5*wf/hf) (1.5*wf/hf) (-1.5) 1.5 (-10.0) 10.0
   matrixMode Modelview
   loadIdentity

keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _            _    _ _ = 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
   setDisplayCallback display
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just keyboard)
   mainLoop
