{-
   DOF.hs  (adapted from dof.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 demonstrates use of the accumulation buffer to
   create an out-of-focus depth-of-field effect.  The teapots
   are drawn several times into the accumulation buffer.  The
   viewing volume is jittered, except at the focal point, where
   the viewing volume is at the same position, each time.  In
   this case, the gold teapot remains in focus.
-}

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

import GL
import Graphics.UI.GLUT

import Jitter

-- accFrustum()
-- The first 6 arguments are identical to the frustum call.
--  
-- pixDx and pixDy are anti-alias jitter in pixels. 
-- Set both equal to 0.0 for no anti-alias jitter.
-- eyeDx and eyeDy are depth-of field jitter in pixels. 
-- Set both equal to 0.0 for no depth of field effects.
--
-- focus is distance from eye to plane in focus. 
-- focus must be greater than, but not equal to 0.0.
--
-- Note that accFrustum calls translate.  You will 
-- probably want to insure that your ModelView matrix has been 
-- initialized to identity before calling accFrustum.
accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble
           -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
accFrustum left right bottom top zNear zFar pixDx pixDy eyeDx eyeDy focus = do
   ((_::GLint,_::GLint), (width::GLsizei, height::GLsizei)) <- get VarViewport
        
   let xWSize = right - left
       yWSize = top - bottom

       dx     = -(pixDx*xWSize / fromIntegral width  + eyeDx*zNear / focus)
       dy     = -(pixDy*yWSize / fromIntegral height + eyeDy*zNear / focus)

   matrixMode Projection
   loadIdentity
   frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar
   matrixMode Modelview
   loadIdentity
   translate (Vector3 (-eyeDx) (-eyeDy) 0)

-- accPerspective()
-- 
-- The first 4 arguments are identical to the gluPerspective() call.
-- pixDx and pixDy are anti-alias jitter in pixels. 
-- Set both equal to 0.0 for no anti-alias jitter.
-- eyedx and eyedy are depth-of field jitter in pixels. 
-- Set both equal to 0.0 for no depth of field effects.
--
-- focus is distance from eye to plane in focus. 
-- focus must be greater than, but not equal to 0.0.
--
-- Note that accPerspective calls accFrustum.
accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble
               -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
accPerspective fovY aspect zNear zFar pixDx pixDy eyeDx eyeDy focus =
   let fov2   = ((fovY*pi) / 180) / 2

       top    = zNear / (cos fov2 / sin fov2)
       bottom = -top

       right  = top * aspect
       left   = -right

   in accFrustum left right bottom top zNear zFar
                 pixDx pixDy eyeDx eyeDy focus

-- Initialize lighting and other values.
myInit :: IO DisplayList
myInit = do
   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),
                             Position (Vertex4 0.0 3.0 3.0 0.0)]

   mapM_ lightModel [ LightModelAmbient (Color4 0.2 0.2 0.2 1.0),
                      LightModelLocalViewer False ]

   frontFace Cw
   enable Lighting
   enable (Light 0)
   enable AutoNormal
   enable DepthTest
   enable Normalize

   clearColor (Color4 0.0 0.0 0.0 0.0)
   clearAccum (Color4 0.0 0.0 0.0 0.0)
   -- make teapot display list
   [teapotList] <- genLists 1
   newEndList teapotList Compile $ renderObject Solid (Teapot 0.5)
   return teapotList

renderTeapot :: Vector3 GLfloat -> Color4 GLfloat -> Color4 GLfloat
             -> Color4 GLfloat -> GLfloat -> DisplayList -> IO ()
renderTeapot xyz amb dif spec shine teapotList = do
   pushMatrix
   translate xyz
   mapM_ (material Front) [ MaterialColor Ambient  amb,
                            MaterialColor Diffuse  dif,
                            MaterialColor Specular spec,
                            Shininess (shine*128) ]
   callList teapotList
   popMatrix

-- display draws 5 teapots into the accumulation buffer 
-- several times; each time with a jittered perspective.
-- The focal point is at z = 5.0, so the gold teapot will 
-- stay in focus.  The amount of jitter is adjusted by the
-- magnitude of the accPerspective jitter; in this example, 0.33.
-- In this example, the teapots are drawn 8 times.  See Jitter.hs

display :: DisplayList -> DisplayCallback
display teapotList = do
   ((_::GLint,_::GLint), (width::GLsizei, height::GLsizei)) <- get VarViewport
   clear [ AccumBufferBit ]

   let jitter = j8
       len    = fromIntegral (length jitter)

   sequence_ [ do
      clear [ ColorBufferBit, DepthBufferBit ]
      accPerspective 45 (fromIntegral width / fromIntegral height) 1 15
                     0 0 (0.33 * realToFrac x) (0.33 * realToFrac y) 5
      -- ruby, gold, silver, emerald, and cyan teapots
      renderTeapot (Vector3 (-1.1) (-0.5) (-4.5))
                   (Color4 0.1745     0.01175    0.01175    1)
                   (Color4 0.61424    0.04136    0.04136    1)
                   (Color4 0.727811   0.626959   0.626959   1)
                   0.6 teapotList
      renderTeapot (Vector3 (-0.5) (-0.5) (-5.0))
                   (Color4 0.24725    0.1995     0.0745     1)
                   (Color4 0.75164    0.60648    0.22648    1)
                   (Color4 0.628281   0.555802   0.366065   1)
                   0.4 teapotList
      renderTeapot (Vector3 0.2 (-0.5) (-5.5))
                   (Color4 0.19225    0.19225    0.19225    1)
                   (Color4 0.50754    0.50754    0.50754    1)
                   (Color4 0.508273   0.508273   0.508273   1)
                   0.4 teapotList
      renderTeapot (Vector3 1.0 (-0.5) (-6.0))
                   (Color4 0.0215     0.1745     0.0215     1)
                   (Color4 0.07568    0.61424    0.07568    1)
                   (Color4 0.633      0.727811   0.633      1)
                   0.6 teapotList
      renderTeapot (Vector3 1.8 (-0.5) (-6.5))
                   (Color4 0.0        0.1        0.06       1)
                   (Color4 0.0        0.50980392 0.50980392 1)
                   (Color4 0.50196078 0.50196078 0.50196078 1)
                   0.25 teapotList
      accum GL.Accum (1.0/len)
            | JitterPoint x y <- jitter ]
   accum Return 1.0
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) =
   viewport (0, 0) (fromIntegral w, fromIntegral h)

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

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