{-
   FogIndex.hs (adapted from fogindex.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 draws 5 wireframe spheres, each at 
   a different z distance from the eye, in linear fog.
-}

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

import GL
import Graphics.UI.GLUT

-- Initialize color map and fog.  Set screen clear color
-- to end of color ramp.

numColors :: GLint
numColors = 32

rampStart :: ColorIndex GLint
rampStart = ColorIndex 16

myInit :: IO ()
myInit = do
   enable DepthTest

   let ColorIndex rStart = rampStart
   sequence_ [ setColor (ColorIndex (fromIntegral (rStart+i)))
                        (Color3 shade shade shade) |
               i <- [ 0 .. numColors-1 ],
               let shade = fromIntegral (numColors-i) / fromIntegral numColors ]
   enable Fog

   mapM_ fog [ FogDensity (FogLinear 1 6), FogIndex (ColorIndex numColors) ]
   hint FogHint Nicest
   clearIndex . ColorIndex . fromRational . fromIntegral $ numColors+rStart-1

renderSpehere :: Vector3 GLfloat -> IO ()
renderSpehere xyz = do
   pushMatrix
   translate xyz
   renderObject Wireframe (Sphere 0.4 16 16)
   popMatrix

-- display draws 5 spheres at different z positions.
display :: DisplayCallback
display = do
   clear [ColorBufferBit, DepthBufferBit]
   index rampStart
   mapM_ renderSpehere [ Vector3 x (-0.5) (-3-x) | x <- [-2..2] ]
   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 (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10.0) 10.0
      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10.0) 10.0
   matrixMode Modelview
   loadIdentity

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

-- Main Loop
-- Open window with initial window size, title bar, 
-- color index mode, depth buffer, and handle input events.
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, Index, Graphics.UI.GLUT.Depth ]
   setInitialWindowSize (WindowSize 500 500)
   createWindow progName
   myInit
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just keyboard)
   setDisplayCallback display
   mainLoop
