--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix
-- Copyright   :  (c) Sven Panne 2002-2005
-- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
-- 
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  provisional
-- Portability :  portable
--
-- This module corresponds to chapter 4 (Matrix Manipulation) of the GLU specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GLU.Matrix (
   ortho2D, perspective, lookAt, pickMatrix,
   project, unProject, unProject4
) where

import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( withArray )
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable(peek,peekElemOff) )
import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLdouble, GLclampd )
import Graphics.Rendering.OpenGL.GL.CoordTrans (
   MatrixOrder(..), Matrix(..), MatrixComponent,
   Vector3(..), Position(..), Size(..) )
import Graphics.Rendering.OpenGL.GL.Extensions (
   FunPtr, unsafePerformIO, Invoker, getProcAddress )
import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )
import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex3(..), Vertex4(..) )
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )

--------------------------------------------------------------------------------

#include "HsOpenGLExt.h"

--------------------------------------------------------------------------------
-- matrix setup

foreign import CALLCONV unsafe "gluOrtho2D" ortho2D ::
   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()

foreign import CALLCONV unsafe "gluPerspective" perspective ::
   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()

lookAt :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble -> IO ()
lookAt (Vertex3 eyeX    eyeY    eyeZ)
       (Vertex3 centerX centerY centerZ)
       (Vector3 upX     upY     upZ) =
   gluLookAt eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ

foreign import CALLCONV unsafe "gluLookAt" gluLookAt ::
      GLdouble -> GLdouble -> GLdouble
   -> GLdouble -> GLdouble -> GLdouble
   -> GLdouble -> GLdouble -> GLdouble -> IO ()

pickMatrix ::
   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()
pickMatrix (x, y) (w, h) viewport =
   withViewport viewport $ gluPickMatrix x y w h

foreign import CALLCONV unsafe "gluPickMatrix" gluPickMatrix ::
   GLdouble -> GLdouble -> GLdouble -> GLdouble -> Ptr GLint -> IO ()

--------------------------------------------------------------------------------
-- coordinate projection

project ::
      Matrix m
   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> IO (Vertex3 GLdouble)
project (Vertex3 objX objY objZ) model proj viewport =
   withColumnMajor model $ \modelBuf ->
   withColumnMajor proj $ \projBuf ->
   withViewport viewport $ \viewBuf ->
   getVertex3 $ gluProject objX objY objZ modelBuf projBuf viewBuf

foreign import CALLCONV unsafe "gluProject" gluProject ::
      GLdouble -> GLdouble -> GLdouble
   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint
   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint

unProject ::
      Matrix m
   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> IO (Vertex3 GLdouble)
unProject (Vertex3 objX objY objZ) model proj viewport =
   withColumnMajor model $ \modelBuf ->
   withColumnMajor proj $ \projBuf ->
   withViewport viewport $ \viewBuf ->
   getVertex3 $ gluUnProject objX objY objZ modelBuf projBuf viewBuf

foreign import CALLCONV unsafe "gluUnProject" gluUnProject ::
      GLdouble -> GLdouble -> GLdouble
   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint
   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint

unProject4 ::
      Matrix m
   => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> GLclampd -> GLclampd
   -> IO (Vertex4 GLdouble)
unProject4 (Vertex4 objX objY objZ clipW) model proj viewport near far =
   withColumnMajor model $ \modelBuf ->
   withColumnMajor proj $ \projBuf ->
   withViewport viewport $ \viewBuf ->
   getVertex4 $
      gluUnProject4 objX objY objZ clipW modelBuf projBuf viewBuf near far

EXTENSION_ENTRY("GLU 1.3",gluUnProject4,GLdouble -> GLdouble -> GLdouble -> GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint -> GLclampd -> GLclampd -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)

--------------------------------------------------------------------------------

withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a
withViewport (Position x y, Size w h) =
   withArray [ x, y, fromIntegral w, fromIntegral h ]

withColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO b) -> IO b
withColumnMajor mat act = withMatrix mat juggle
   where juggle ColumnMajor p = act p
         juggle RowMajor    p = do
            transposedElems <- mapM (peekElemOff p) [ 0, 4,  8, 12,
                                                      1, 5,  9, 13,
                                                      2, 6, 10, 14,
                                                      3, 7, 11, 15 ]
            withArray transposedElems act

getVertex3 ::
      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
   -> IO (Vertex3 GLdouble)
getVertex3 act =
   alloca $ \xBuf ->
   alloca $ \yBuf ->
   alloca $ \zBuf -> do
   ok <- act xBuf yBuf zBuf
   if unmarshalGLboolean ok
      then do x <- peek xBuf
              y <- peek yBuf
              z <- peek zBuf
              return $ Vertex3 x y z
      else do recordInvalidValue
              return $ Vertex3 0 0 0

getVertex4 ::
      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
   -> IO (Vertex4 GLdouble)
getVertex4 act =
   alloca $ \xBuf ->
   alloca $ \yBuf ->
   alloca $ \zBuf ->
   alloca $ \wBuf -> do
   ok <- act xBuf yBuf zBuf wBuf
   if unmarshalGLboolean ok
      then do x <- peek xBuf
              y <- peek yBuf
              z <- peek zBuf
              w <- peek wBuf
              return $ Vertex4 x y z w
      else do recordInvalidValue
              return $ Vertex4 0 0 0 0