{-
   AccAnti.hs  (adapted from accanti.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>

   Use the accumulation buffer to do full-scene antialiasing
   on a scene with orthographic parallel projection.
-}

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

import GL
import Graphics.UI.GLUT

import Jitter

default ( GLfloat )

-- Initialize lighting and other values.
myInit :: IO ()
myInit = do
   mapM_ (material Front) [ MaterialColor Ambient  (Color4 1.0 1.0 1.0 1.0),
                            MaterialColor Specular (Color4 1.0 1.0 1.0 1.0),
                            Shininess 50 ]
   light (Light 0) (Position (Vertex4 0.0 0.0 10.0 1.0))
   lightModel (LightModelAmbient (Color4 0.2 0.2 0.2 1.0))

   enable Lighting
   enable (Light 0)
   enable DepthTest
   shadeModel Flat

   clearColor (Color4 0.0 0.0 0.0 0.0)
   clearAccum (Color4 0.0 0.0 0.0 0.0)

displayObjects :: IO ()
displayObjects = do
   pushMatrix
   rotate (30 :: GLfloat) (Vector3 1 0 0)

   pushMatrix
   translate (Vector3 (-0.80) 0.35 0 :: Vector3 GLfloat)
   rotate (100 :: GLfloat) (Vector3 1 0 0)
   material Front (MaterialColor Diffuse (Color4 0.7 0.7 0.0 1.0))
   renderObject Solid (Torus 0.275 0.85 16 16)
   popMatrix

   pushMatrix
   translate (Vector3 (-0.75) (-0.50) 0 :: Vector3 GLfloat)
   rotate (45 :: GLfloat) (Vector3 0 0 1)
   rotate (45 :: GLfloat) (Vector3 1 0 0)
   material Front (MaterialColor Diffuse (Color4 0.0 0.7 0.7 1.0))
   renderObject Solid (Cube 1.5)
   popMatrix

   pushMatrix
   translate (Vector3 0.75 0.60 0 :: Vector3 GLfloat)
   rotate (30::GLfloat) (Vector3 1 0 0)
   material Front (MaterialColor Diffuse (Color4 0.7 0.0 0.7 1.0))
   renderObject Solid (Sphere 1.0 16 16)
   popMatrix

   pushMatrix
   translate (Vector3 0.70 (-0.90) 0.25 :: Vector3 GLfloat)
   material Front (MaterialColor Diffuse (Color4 0.7 0.4 0.4 1.0))
   renderObject Solid Octahedron
   popMatrix

   popMatrix

display :: DisplayCallback
display = do
   ((_::GLint,_::GLint), (width::GLsizei, height::GLsizei)) <- get VarViewport

   clear [ AccumBufferBit ]
   let jitter = j8
       len    = fromIntegral (length jitter)
   sequence_ [ do
      clear [ ColorBufferBit, DepthBufferBit ]
      pushMatrix
      -- Note that 4.5 is the distance in world space between left and right
      -- and bottom and top. This formula converts fractional pixel movement
      -- to world coordinates.
      translate (Vector3 (x * 4.5 / fromIntegral width)
                         (y * 4.5 / fromIntegral height)
                         0)
      displayObjects
      popMatrix
      accum GL.Accum (1.0/len)
            | JitterPoint x y <- jitter ]
   accum Return 1.0
   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.25) 2.25 (-2.25*hf/wf) (2.25*hf/wf) (-10) 10
      else ortho (-2.25*wf/hf) (2.25*wf/hf) (-2.25) 2.25 (-10) 10
   matrixMode Modelview
   loadIdentity

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

-- Main Loop
-- Be certain to request an accumulation buffer.
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB, Graphics.UI.GLUT.Accum, Graphics.UI.GLUT.Depth ]
   setInitialWindowSize (WindowSize 250 250)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   myInit
   setReshapeCallback (Just reshape)
   setDisplayCallback display
   setKeyboardMouseCallback (Just keyboard)
   mainLoop
