{-
   Material.hs (adapted from material.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 GL lighting model.
  Several objects are drawn using different material characteristics.
  A single light source illuminates the objects.
-}

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

import GL
import Graphics.UI.GLUT

-- Initialize z-buffer, projection matrix, light source, 
-- and lighting model.  Do not specify a material property here.
myInit :: IO ()
myInit = do
   clearColor (Color4 0.0 0.1 0.1 0.0)
   enable DepthTest
   shadeModel Smooth

   mapM_ (light (Light 0)) [
      LightColor Ambient (Color4 0.0 0.0 0.0 1.0),
      LightColor Diffuse (Color4 1.0 1.0 1.0 1.0),
      Position (Vertex4 0.0 3.0 2.0 0.0) ]
   mapM_ lightModel [
      LightModelAmbient (Color4 0.4 0.4 0.4 1.0),
      LightModelLocalViewer False ]

   enable Lighting
   enable (Light 0)

-- Draw twelve spheres in 3 rows with 4 columns.  
-- The spheres in the first row have materials with no ambient reflection.
-- The second row has materials with significant ambient reflection.
-- The third row has materials with colored ambient reflection.
--
-- The first column has materials with blue, diffuse reflection only.
-- The second column has blue diffuse reflection, as well as specular
-- reflection with a low shininess exponent.
-- The third column has blue diffuse reflection, as well as specular
-- reflection with a high shininess exponent (a more concentrated highlight).
-- The fourth column has materials which also include an emissive component.
--
-- translate is used to move spheres to their appropriate locations.
display :: DisplayCallback
display = do
   let noMat           = Color4 0.0 0.0 0.0 1.0
       matAmbient      = Color4 0.7 0.7 0.7 1.0
       matAmbientColor = Color4 0.8 0.8 0.2 1.0
       matDiffuse      = Color4 0.1 0.5 0.8 1.0
       matSpecular     = Color4 1.0 1.0 1.0 1.0
       noShininess     =   0.0
       lowShininess    =   5.0
       highShininess   = 100.0
       matEmission     = Color4 0.3 0.2 0.2 0.0

   clear [ ColorBufferBit, DepthBufferBit ]

   -- draw sphere in first row, first column
   -- diffuse reflection only; no ambient or specular  
   pushMatrix
   translate (Vector3 (-3.75) 3.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient noMat,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in first row, second column
   -- diffuse and specular reflection; low shininess; no ambient
   pushMatrix
   translate (Vector3 (-1.25) 3.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient noMat,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess lowShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in first row, third column
   -- diffuse and specular reflection; high shininess; no ambient
   pushMatrix
   translate (Vector3 1.25 3.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient noMat,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess highShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in first row, fourth column
   -- diffuse reflection; emission; no ambient or specular reflection
   pushMatrix
   translate (Vector3 3.75 3.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient noMat,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission matEmission ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in second row, first column
   -- ambient and diffuse reflection; no specular  
   pushMatrix
   translate (Vector3 (-3.75) 0.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbient,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in second row, second column
   -- ambient, diffuse and specular reflection; low shininess
   pushMatrix
   translate (Vector3 (-1.25) 0.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbient,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess lowShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in second row, third column
   -- ambient, diffuse and specular reflection; high shininess
   pushMatrix
   translate (Vector3 1.25 0.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbient,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess highShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in second row, fourth column
   -- ambient and diffuse reflection; emission; no specular
   pushMatrix
   translate (Vector3 3.75 0.0 (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbient,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission matEmission ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in third row, first column
   -- colored ambient and diffuse reflection; no specular  
   pushMatrix
   translate (Vector3 (-3.75) (-3.0) (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbientColor,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in third row, second column
   -- colored ambient, diffuse and specular reflection; low shininess
   pushMatrix
   translate (Vector3 (-1.25) (-3.0) (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbientColor,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess lowShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in third row, third column
   -- colored ambient, diffuse and specular reflection; high shininess
   pushMatrix
   translate (Vector3 (1.25) (-3.0) (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbientColor,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular matSpecular,
      Shininess highShininess,
      MaterialColor Emission noMat ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   -- draw sphere in third row, fourth column
   -- colored ambient and diffuse reflection; emission; no specular
   pushMatrix
   translate (Vector3 3.75 (-3.0) (0.0 :: GLfloat))
   mapM_ (material Front) [
      MaterialColor Ambient matAmbientColor,
      MaterialColor Diffuse matDiffuse,
      MaterialColor Specular noMat,
      Shininess noShininess,
      MaterialColor Emission matEmission ]
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   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 * 2)
      then ortho (-6.0) 6.0 (-3.0*(hf*2)/wf) (3.0*(hf*2)/wf) (-10.0) 10.0
      else ortho (-6.0*wf/(hf*2)) (6.0*wf/(hf*2)) (-3.0) 3.0 (-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 600 450)
   createWindow progName
   myInit
   setReshapeCallback (Just reshape)
   setDisplayCallback display
   setKeyboardMouseCallback (Just keyboard)
   mainLoop
