{-
   Plane.hs (adapted from plane.c which is (c) Mark J. Kilgard)
   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 local versus
   infinite lighting on a flat plane.
-}

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

import GL
import Graphics.UI.GLUT

-- Initialize material property, light source, and lighting model.
myInit :: IO ()
myInit = do
   mapM_ (material Front) [
      MaterialColor Ambient  (Color4 0.0 0.0 0.0 1.0),
      MaterialColor Diffuse  (Color4 0.4 0.4 0.4 1.0),
      MaterialColor Specular (Color4 1.0 1.0 1.0 1.0),
      Shininess 15 ]
   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),
      LightColor    Specular (Color4 1.0 1.0 1.0 1.0) ]
   lightModel (LightModelAmbient (Color4 0.2 0.2 0.2 1.0))

   enable Lighting
   enable (Light 0)
   depthFunc GL.Less
   enable DepthTest

drawPlane :: IO ()
drawPlane = do
    beginEnd Quads $ do
       normal (Normal3 0.0 0.0 (1.0 :: GLfloat))
       vertex (Vertex3 (-1.0) (-1.0) (0.0 :: GLfloat))
       vertex (Vertex3   0.0  (-1.0) (0.0 :: GLfloat))
       vertex (Vertex3   0.0    0.0  (0.0 :: GLfloat))
       vertex (Vertex3 (-1.0)   0.0  (0.0 :: GLfloat))

       normal (Normal3 0.0 0.0 (1.0 :: GLfloat))
       vertex (Vertex3 0.0 (-1.0) (0.0 :: GLfloat))
       vertex (Vertex3 1.0 (-1.0) (0.0 :: GLfloat))
       vertex (Vertex3 1.0   0.0  (0.0 :: GLfloat))
       vertex (Vertex3 0.0   0.0  (0.0 :: GLfloat))

       normal (Normal3 0.0 0.0 (1.0 :: GLfloat))
       vertex (Vertex3 0.0 0.0 (0.0 :: GLfloat))
       vertex (Vertex3 1.0 0.0 (0.0 :: GLfloat))
       vertex (Vertex3 1.0 1.0 (0.0 :: GLfloat))
       vertex (Vertex3 0.0 1.0 (0.0 :: GLfloat))

       normal (Normal3 0.0 0.0 (1.0 :: GLfloat))
       vertex (Vertex3   0.0  0.0 (0.0 :: GLfloat))
       vertex (Vertex3   0.0  1.0 (0.0 :: GLfloat))
       vertex (Vertex3 (-1.0) 1.0 (0.0 :: GLfloat))
       vertex (Vertex3 (-1.0) 0.0 (0.0 :: GLfloat))

display :: DisplayCallback
display = do
   clear [ ColorBufferBit, DepthBufferBit ]

   pushMatrix
   translate (Vector3 (-1.5) 0.0 (0.0 :: GLfloat))
   light (Light 0) (Position (Vertex4 1.0 1.0 1.0 0.0))
   drawPlane
   popMatrix

   pushMatrix
   translate (Vector3 1.5 0.0 (0.0 :: GLfloat))
   light (Light 0) (Position (Vertex4 1.0 1.0 1.0 1.0))
   drawPlane
   popMatrix
   flush

myReshape :: ReshapeCallback
myReshape (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

key :: KeyboardMouseCallback
key (Char '\27') Down _ _ = exitWith ExitSuccess
key _            _    _ _ = return ()

-- Main Loop
-- Open window with initial window size, title bar,
-- RGBA display mode, and handle input events.
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB, Graphics.UI.GLUT.Depth ]
   setInitialWindowSize (WindowSize 500 200)
   createWindow progName
   myInit
   setReshapeCallback (Just myReshape)
   setDisplayCallback display
   setKeyboardMouseCallback (Just key)
   mainLoop
