{-
   DepthCue.hs  (adapted from depthcue.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 a wireframe model, which uses
   intensity (brightness) to give clues to distance.
   Fog is used to achieve this effect.
-}

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

import GL
import GLU
import Graphics.UI.GLUT

-- Initialize linear fog for depth cueing.
myInit :: IO ()
myInit = do
   enable Fog
   fog (FogDensity (FogLinear 3 5))
   hint FogHint Nicest   -- per pixel
   fog (FogColor (Color4 0 0 0 1))
   clearColor (Color4 0 0 0 1)
   
   depthFunc GL.Less
   enable DepthTest
   shadeModel GL.Flat

-- display draws an icosahedron.
display :: DisplayCallback
display = do
   clear [ ColorBufferBit, DepthBufferBit ]
   color (Color3 1 1 (1 :: GLfloat))
   renderObject Wireframe Icosahedron
   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
   perspective 45 (wf/hf) 3 5
   matrixMode Modelview
   loadIdentity
   translate (Vector3 0 0 (-4 :: GLfloat))   -- move object into view

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

-- Main Loop
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB, Graphics.UI.GLUT.Depth ]
   createWindow progName
   myInit
   setReshapeCallback (Just reshape)
   setDisplayCallback display
   setKeyboardMouseCallback (Just key)
   mainLoop
