--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
-- 
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- 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
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Graphics.GLU
import Graphics.Rendering.OpenGL.GL.CoordTrans
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

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

ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
ortho2D = forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
gluOrtho2D


perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
perspective = forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
gluPerspective

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

pickMatrix ::
   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()
pickMatrix :: (GLdouble, GLdouble)
-> (GLdouble, GLdouble) -> (Position, Size) -> IO ()
pickMatrix (GLdouble
x, GLdouble
y) (GLdouble
w, GLdouble
h) (Position, Size)
viewPort =
   forall a. (Position, Size) -> (Ptr GLint -> IO a) -> IO a
withViewport (Position, Size)
viewPort forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> GLdouble -> Ptr GLint -> m ()
gluPickMatrix GLdouble
x GLdouble
y GLdouble
w GLdouble
h

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

project ::
      Matrix m
   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> IO (Vertex3 GLdouble)
project :: forall (m :: * -> *).
Matrix m =>
Vertex3 GLdouble
-> m GLdouble
-> m GLdouble
-> (Position, Size)
-> IO (Vertex3 GLdouble)
project (Vertex3 GLdouble
objX GLdouble
objY GLdouble
objZ) m GLdouble
model m GLdouble
proj (Position, Size)
viewPort =
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
model forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
modelBuf ->
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
proj forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
projBuf ->
   forall a. (Position, Size) -> (Ptr GLint -> IO a) -> IO a
withViewport (Position, Size)
viewPort forall a b. (a -> b) -> a -> b
$ \Ptr GLint
viewBuf ->
   (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
-> IO (Vertex3 GLdouble)
getVertex3 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLdouble
-> GLdouble
-> GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLint
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> m GLint
gluProject GLdouble
objX GLdouble
objY GLdouble
objZ Ptr GLdouble
modelBuf Ptr GLdouble
projBuf Ptr GLint
viewBuf

unProject ::
      Matrix m
   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> IO (Vertex3 GLdouble)
unProject :: forall (m :: * -> *).
Matrix m =>
Vertex3 GLdouble
-> m GLdouble
-> m GLdouble
-> (Position, Size)
-> IO (Vertex3 GLdouble)
unProject (Vertex3 GLdouble
objX GLdouble
objY GLdouble
objZ) m GLdouble
model m GLdouble
proj (Position, Size)
viewPort =
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
model forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
modelBuf ->
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
proj forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
projBuf ->
   forall a. (Position, Size) -> (Ptr GLint -> IO a) -> IO a
withViewport (Position, Size)
viewPort forall a b. (a -> b) -> a -> b
$ \Ptr GLint
viewBuf ->
   (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
-> IO (Vertex3 GLdouble)
getVertex3 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLdouble
-> GLdouble
-> GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLint
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> m GLint
gluUnProject GLdouble
objX GLdouble
objY GLdouble
objZ Ptr GLdouble
modelBuf Ptr GLdouble
projBuf Ptr GLint
viewBuf

unProject4 ::
      Matrix m
   => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
   -> GLclampd -> GLclampd
   -> IO (Vertex4 GLdouble)
unProject4 :: forall (m :: * -> *).
Matrix m =>
Vertex4 GLdouble
-> m GLdouble
-> m GLdouble
-> (Position, Size)
-> GLdouble
-> GLdouble
-> IO (Vertex4 GLdouble)
unProject4 (Vertex4 GLdouble
objX GLdouble
objY GLdouble
objZ GLdouble
clipW) m GLdouble
model m GLdouble
proj (Position, Size)
viewPort GLdouble
near GLdouble
far =
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
model forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
modelBuf ->
   forall (m :: * -> *) c b.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO b) -> IO b
withColumnMajor m GLdouble
proj forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
projBuf ->
   forall a. (Position, Size) -> (Ptr GLint -> IO a) -> IO a
withViewport (Position, Size)
viewPort forall a b. (a -> b) -> a -> b
$ \Ptr GLint
viewBuf ->
   (Ptr GLdouble
 -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
-> IO (Vertex4 GLdouble)
getVertex4 forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
MonadIO m =>
GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLint
-> GLdouble
-> GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> Ptr GLdouble
-> m GLint
gluUnProject4 GLdouble
objX GLdouble
objY GLdouble
objZ GLdouble
clipW Ptr GLdouble
modelBuf Ptr GLdouble
projBuf Ptr GLint
viewBuf GLdouble
near GLdouble
far

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

withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a
withViewport :: forall a. (Position, Size) -> (Ptr GLint -> IO a) -> IO a
withViewport (Position GLint
x GLint
y, Size GLint
w GLint
h) =
   forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ GLint
x, GLint
y, forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
h ]

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

getVertex3 ::
      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
   -> IO (Vertex3 GLdouble)
getVertex3 :: (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
-> IO (Vertex3 GLdouble)
getVertex3 Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint
act =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
xBuf ->
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
yBuf ->
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
zBuf -> do
   GLint
ok <- Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint
act Ptr GLdouble
xBuf Ptr GLdouble
yBuf Ptr GLdouble
zBuf
   if forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GLint
ok
      then do GLdouble
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
xBuf
              GLdouble
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
yBuf
              GLdouble
z <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
zBuf
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x GLdouble
y GLdouble
z
      else do IO ()
recordInvalidValue
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0 GLdouble
0 GLdouble
0

getVertex4 ::
      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
   -> IO (Vertex4 GLdouble)
getVertex4 :: (Ptr GLdouble
 -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
-> IO (Vertex4 GLdouble)
getVertex4 Ptr GLdouble
-> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint
act =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
xBuf ->
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
yBuf ->
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
zBuf ->
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
wBuf -> do
   GLint
ok <- Ptr GLdouble
-> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint
act Ptr GLdouble
xBuf Ptr GLdouble
yBuf Ptr GLdouble
zBuf Ptr GLdouble
wBuf
   if forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GLint
ok
      then do GLdouble
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
xBuf
              GLdouble
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
yBuf
              GLdouble
z <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
zBuf
              GLdouble
w <- forall a. Storable a => Ptr a -> IO a
peek Ptr GLdouble
wBuf
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 GLdouble
x GLdouble
y GLdouble
z GLdouble
w
      else do IO ()
recordInvalidValue
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 GLdouble
0 GLdouble
0 GLdouble
0 GLdouble
0