{-
   Anti.hs  (adapted from anti.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 antialiased lines in RGBA mode.
-}

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

import GL
import GLU
import Graphics.UI.GLUT

-- Initialize antialiasing for RGBA mode, including alpha
-- blending, hint, and line width.  Print out implementation
-- specific info on line width granularity and width.
myInit :: IO ()
myInit = do
   gran <- get VarLineWidthGranularity
   putStrLn ("GL_LINE_WIDTH_GRANULARITY value is " ++ show (gran :: GLfloat))

   (lo,hi) <- get VarLineWidthRange
   putStrLn ("GL_LINE_WIDTH_RANGE values are " ++
             show (lo :: GLfloat) ++ " " ++ show (hi :: GLfloat))

   enable LineSmooth
   enable Blend'
   blendFunc SrcAlpha OneMinusSrcAlpha
   hint LineSmoothHint DontCare
   lineWidth 1.5

   shadeModel GL.Flat
   clearColor (Color4 0.0 0.0 0.0 0.0)
   depthFunc GL.Less
   enable DepthTest

-- display draws an icosahedron with a large alpha value, 1.0.
display :: DisplayCallback
display = do
    clear [ ColorBufferBit, DepthBufferBit ]
    color (Color4 1 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))

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