--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.11 (Coordinate Transformations) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.CoordTrans (
   -- * Controlling the Viewport
   depthRange,
   Position(..), Size(..), viewport, maxViewportDims,

   -- * Matrices
   MatrixMode(..), matrixMode,
   MatrixOrder(..), MatrixComponent(rotate,translate,scale), Matrix(..),
   matrix, multMatrix, GLmatrix, loadIdentity,
   ortho, frustum, depthClamp,
   activeTexture,
   preservingMatrix, unsafePreservingMatrix,
   stackDepth, maxStackDepth,

   -- * Normal Transformation
   rescaleNormal, normalize,

   -- * Generating Texture Coordinates
   Plane(..), TextureCoordName(..), TextureGenMode(..), textureGenMode
) where

import Data.StateVar
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.MatrixComponent
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

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

-- | After clipping and division by /w/, depth coordinates range from -1 to 1,
-- corresponding to the near and far clipping planes. 'depthRange' specifies a
-- linear mapping of the normalized depth coordinates in this range to window
-- depth coordinates. Regardless of the actual depth buffer implementation,
-- window coordinate depth values are treated as though they range from 0
-- through 1 (like color components). Thus, the values accepted by 'depthRange'
-- are both clamped to this range before they are accepted.
--
-- The initial setting of (0, 1) maps the near plane to 0 and the far plane to
-- 1. With this mapping, the depth buffer range is fully utilized.
--
-- It is not necessary that the near value be less than the far value. Reverse
-- mappings such as (1, 0) are acceptable.

depthRange :: StateVar (GLclampd, GLclampd)
depthRange :: StateVar (GLdouble, GLdouble)
depthRange = IO (GLdouble, GLdouble)
-> ((GLdouble, GLdouble) -> IO ()) -> StateVar (GLdouble, GLdouble)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLdouble -> GLdouble -> (GLdouble, GLdouble))
-> PName2F -> IO (GLdouble, GLdouble)
forall p a.
GetPName2F p =>
(GLdouble -> GLdouble -> a) -> p -> IO a
forall a. (GLdouble -> GLdouble -> a) -> PName2F -> IO a
getClampd2 (,) PName2F
GetDepthRange) ((GLdouble -> GLdouble -> IO ()) -> (GLdouble, GLdouble) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GLdouble -> GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLdouble -> GLdouble -> m ()
glDepthRange)

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

-- | A 2-dimensional position, measured in pixels.
data Position = Position !GLint !GLint
   deriving ( Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$c< :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show )

-- | A 2-dimensional size, measured in pixels.
data Size = Size !GLsizei !GLsizei
   deriving ( Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Eq Size
Eq Size
-> (Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show )

-- | Controls the affine transformation from normalized device coordinates to
-- window coordinates. The viewport state variable consists of the coordinates
-- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,
-- initial value (0,0)), and the size (/width/, /height/) of the viewport. When
-- a GL context is first attached to a window, /width/ and /height/ are set to
-- the dimensions of that window.
--
-- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window
-- coordinates (/xw/, /yw/) are computed as follows:
--
-- /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/
--
-- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/
--
-- Viewport width and height are silently clamped to a range that depends on the
-- implementation, see 'maxViewportDims'.

viewport :: StateVar (Position, Size)
viewport :: StateVar (Position, Size)
viewport = IO (Position, Size)
-> ((Position, Size) -> IO ()) -> StateVar (Position, Size)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLint -> GLint -> GLint -> GLint -> (Position, Size))
-> PName4I -> IO (Position, Size)
forall p a.
GetPName4I p =>
(GLint -> GLint -> GLint -> GLint -> a) -> p -> IO a
forall a.
(GLint -> GLint -> GLint -> GLint -> a) -> PName4I -> IO a
getInteger4 GLint -> GLint -> GLint -> GLint -> (Position, Size)
forall {a} {a}.
(Integral a, Integral a) =>
GLint -> GLint -> a -> a -> (Position, Size)
makeVp PName4I
GetViewport)
                        (\(Position GLint
x GLint
y, Size GLint
w GLint
h) -> GLint -> GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glViewport GLint
x GLint
y GLint
w GLint
h)
   where makeVp :: GLint -> GLint -> a -> a -> (Position, Size)
makeVp GLint
x GLint
y a
w a
h = (GLint -> GLint -> Position
Position GLint
x GLint
y, GLint -> GLint -> Size
Size (a -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w) (a -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h))

-- | The implementation-dependent maximum viewport width and height.

maxViewportDims :: GettableStateVar Size
maxViewportDims :: GettableStateVar Size
maxViewportDims = GettableStateVar Size -> GettableStateVar Size
forall a. IO a -> IO a
makeGettableStateVar ((GLint -> GLint -> Size) -> PName2I -> GettableStateVar Size
forall p a. GetPName2I p => (GLint -> GLint -> a) -> p -> IO a
forall a. (GLint -> GLint -> a) -> PName2I -> IO a
getSizei2 GLint -> GLint -> Size
Size PName2I
GetMaxViewportDims)

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

-- | A matrix stack.

data MatrixMode =
     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.
   | Projection         -- ^ The projection matrix stack.
   | Texture            -- ^ The texture matrix stack.
   | Color              -- ^ The color matrix stack.
   | MatrixPalette      -- ^ The matrix palette stack.
   deriving ( MatrixMode -> MatrixMode -> Bool
(MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> Bool) -> Eq MatrixMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatrixMode -> MatrixMode -> Bool
== :: MatrixMode -> MatrixMode -> Bool
$c/= :: MatrixMode -> MatrixMode -> Bool
/= :: MatrixMode -> MatrixMode -> Bool
Eq, Eq MatrixMode
Eq MatrixMode
-> (MatrixMode -> MatrixMode -> Ordering)
-> (MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> MatrixMode)
-> (MatrixMode -> MatrixMode -> MatrixMode)
-> Ord MatrixMode
MatrixMode -> MatrixMode -> Bool
MatrixMode -> MatrixMode -> Ordering
MatrixMode -> MatrixMode -> MatrixMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MatrixMode -> MatrixMode -> Ordering
compare :: MatrixMode -> MatrixMode -> Ordering
$c< :: MatrixMode -> MatrixMode -> Bool
< :: MatrixMode -> MatrixMode -> Bool
$c<= :: MatrixMode -> MatrixMode -> Bool
<= :: MatrixMode -> MatrixMode -> Bool
$c> :: MatrixMode -> MatrixMode -> Bool
> :: MatrixMode -> MatrixMode -> Bool
$c>= :: MatrixMode -> MatrixMode -> Bool
>= :: MatrixMode -> MatrixMode -> Bool
$cmax :: MatrixMode -> MatrixMode -> MatrixMode
max :: MatrixMode -> MatrixMode -> MatrixMode
$cmin :: MatrixMode -> MatrixMode -> MatrixMode
min :: MatrixMode -> MatrixMode -> MatrixMode
Ord, Int -> MatrixMode -> ShowS
[MatrixMode] -> ShowS
MatrixMode -> String
(Int -> MatrixMode -> ShowS)
-> (MatrixMode -> String)
-> ([MatrixMode] -> ShowS)
-> Show MatrixMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatrixMode -> ShowS
showsPrec :: Int -> MatrixMode -> ShowS
$cshow :: MatrixMode -> String
show :: MatrixMode -> String
$cshowList :: [MatrixMode] -> ShowS
showList :: [MatrixMode] -> ShowS
Show )

marshalMatrixMode :: MatrixMode -> Maybe GLenum
marshalMatrixMode :: MatrixMode -> Maybe GLenum
marshalMatrixMode MatrixMode
x = case MatrixMode
x of
   Modelview GLint
i -> GLint -> Maybe GLenum
modelviewIndexToEnum GLint
i
   MatrixMode
Projection -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_PROJECTION
   MatrixMode
Texture -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_TEXTURE
   MatrixMode
Color -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_COLOR
   MatrixMode
MatrixPalette -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_MATRIX_PALETTE_ARB

unmarshalMatrixMode :: GLenum -> MatrixMode
unmarshalMatrixMode :: GLenum -> MatrixMode
unmarshalMatrixMode GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_PROJECTION = MatrixMode
Projection
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TEXTURE = MatrixMode
Texture
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_COLOR = MatrixMode
Color
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MATRIX_PALETTE_ARB = MatrixMode
MatrixPalette
   | Bool
otherwise =
        case GLenum -> Maybe GLint
modelviewEnumToIndex GLenum
x of
           Just GLint
i -> GLint -> MatrixMode
Modelview GLint
i
           Maybe GLint
Nothing -> String -> MatrixMode
forall a. HasCallStack => String -> a
error (String
"unmarshalMatrixMode: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)

matrixModeToGetMatrix :: MatrixMode -> PNameMatrix
matrixModeToGetMatrix :: MatrixMode -> PNameMatrix
matrixModeToGetMatrix MatrixMode
x = case MatrixMode
x of
   Modelview GLint
_   -> PNameMatrix
GetModelviewMatrix -- ???
   MatrixMode
Projection    -> PNameMatrix
GetProjectionMatrix
   MatrixMode
Texture       -> PNameMatrix
GetTextureMatrix
   MatrixMode
Color         -> PNameMatrix
GetColorMatrix
   MatrixMode
MatrixPalette -> PNameMatrix
GetMatrixPalette

matrixModeToGetStackDepth :: MatrixMode -> PName1I
matrixModeToGetStackDepth :: MatrixMode -> PName1I
matrixModeToGetStackDepth MatrixMode
x =  case MatrixMode
x of
   Modelview GLint
_   -> PName1I
GetModelviewStackDepth
   MatrixMode
Projection    -> PName1I
GetProjectionStackDepth
   MatrixMode
Texture       -> PName1I
GetTextureStackDepth
   MatrixMode
Color         -> PName1I
GetColorMatrixStackDepth
   MatrixMode
MatrixPalette -> String -> PName1I
forall a. HasCallStack => String -> a
error String
"matrixModeToGetStackDepth: impossible"

matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I
matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I
matrixModeToGetMaxStackDepth MatrixMode
x = case MatrixMode
x of
   Modelview GLint
_    -> PName1I
GetMaxModelviewStackDepth
   MatrixMode
Projection     -> PName1I
GetMaxProjectionStackDepth
   MatrixMode
Texture        -> PName1I
GetMaxTextureStackDepth
   MatrixMode
Color          -> PName1I
GetMaxColorMatrixStackDepth
   MatrixMode
MatrixPalette  -> PName1I
GetMaxMatrixPaletteStackDepth

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

-- | Controls which matrix stack is the target for subsequent matrix operations.
-- The initial value is ('Modelview' 0).

matrixMode :: StateVar MatrixMode
matrixMode :: StateVar MatrixMode
matrixMode =
   IO MatrixMode -> (MatrixMode -> IO ()) -> StateVar MatrixMode
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLenum -> MatrixMode) -> PName1I -> IO MatrixMode
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 GLenum -> MatrixMode
unmarshalMatrixMode PName1I
GetMatrixMode)
                (IO () -> (GLenum -> IO ()) -> Maybe GLenum -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
recordInvalidValue GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glMatrixMode (Maybe GLenum -> IO ())
-> (MatrixMode -> Maybe GLenum) -> MatrixMode -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatrixMode -> Maybe GLenum
marshalMatrixMode)

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

data MatrixOrder = ColumnMajor | RowMajor
   deriving ( MatrixOrder -> MatrixOrder -> Bool
(MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool) -> Eq MatrixOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatrixOrder -> MatrixOrder -> Bool
== :: MatrixOrder -> MatrixOrder -> Bool
$c/= :: MatrixOrder -> MatrixOrder -> Bool
/= :: MatrixOrder -> MatrixOrder -> Bool
Eq, Eq MatrixOrder
Eq MatrixOrder
-> (MatrixOrder -> MatrixOrder -> Ordering)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> MatrixOrder)
-> (MatrixOrder -> MatrixOrder -> MatrixOrder)
-> Ord MatrixOrder
MatrixOrder -> MatrixOrder -> Bool
MatrixOrder -> MatrixOrder -> Ordering
MatrixOrder -> MatrixOrder -> MatrixOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MatrixOrder -> MatrixOrder -> Ordering
compare :: MatrixOrder -> MatrixOrder -> Ordering
$c< :: MatrixOrder -> MatrixOrder -> Bool
< :: MatrixOrder -> MatrixOrder -> Bool
$c<= :: MatrixOrder -> MatrixOrder -> Bool
<= :: MatrixOrder -> MatrixOrder -> Bool
$c> :: MatrixOrder -> MatrixOrder -> Bool
> :: MatrixOrder -> MatrixOrder -> Bool
$c>= :: MatrixOrder -> MatrixOrder -> Bool
>= :: MatrixOrder -> MatrixOrder -> Bool
$cmax :: MatrixOrder -> MatrixOrder -> MatrixOrder
max :: MatrixOrder -> MatrixOrder -> MatrixOrder
$cmin :: MatrixOrder -> MatrixOrder -> MatrixOrder
min :: MatrixOrder -> MatrixOrder -> MatrixOrder
Ord, Int -> MatrixOrder -> ShowS
[MatrixOrder] -> ShowS
MatrixOrder -> String
(Int -> MatrixOrder -> ShowS)
-> (MatrixOrder -> String)
-> ([MatrixOrder] -> ShowS)
-> Show MatrixOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatrixOrder -> ShowS
showsPrec :: Int -> MatrixOrder -> ShowS
$cshow :: MatrixOrder -> String
show :: MatrixOrder -> String
$cshowList :: [MatrixOrder] -> ShowS
showList :: [MatrixOrder] -> ShowS
Show )

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

class Matrix m where
   -- | Create a new matrix of the given order (containing undefined elements)
   -- and call the action to fill it with 4x4 elements.
   withNewMatrix ::
      MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)

   -- | Call the action with the given matrix. /Note:/ The action is /not/
   -- allowed to modify the matrix elements!
   withMatrix ::
      MatrixComponent c => m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a

   newMatrix :: MatrixComponent c => MatrixOrder -> [c] -> IO (m c)
   getMatrixComponents :: MatrixComponent c => MatrixOrder -> m c -> IO [c]

   withNewMatrix MatrixOrder
order Ptr c -> IO ()
act =
      Int -> (Ptr c -> IO (m c)) -> IO (m c)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
16 ((Ptr c -> IO (m c)) -> IO (m c))
-> (Ptr c -> IO (m c)) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ \Ptr c
p -> do
         Ptr c -> IO ()
act Ptr c
p
         [c]
components <- Int -> Ptr c -> IO [c]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
16 Ptr c
p
         MatrixOrder -> [c] -> IO (m c)
forall c. MatrixComponent c => MatrixOrder -> [c] -> IO (m c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> [c] -> IO (m c)
newMatrix MatrixOrder
order [c]
components

   withMatrix m c
mat MatrixOrder -> Ptr c -> IO a
act = do
      [c]
components <- MatrixOrder -> m c -> IO [c]
forall c. MatrixComponent c => MatrixOrder -> m c -> IO [c]
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> m c -> IO [c]
getMatrixComponents MatrixOrder
ColumnMajor m c
mat
      [c] -> (Ptr c -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [c]
components ((Ptr c -> IO a) -> IO a) -> (Ptr c -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ MatrixOrder -> Ptr c -> IO a
act MatrixOrder
ColumnMajor

   newMatrix MatrixOrder
order [c]
components =
      MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
forall c.
MatrixComponent c =>
MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
withNewMatrix MatrixOrder
order ((Ptr c -> IO ()) -> IO (m c)) -> (Ptr c -> IO ()) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ (Ptr c -> [c] -> IO ()) -> [c] -> Ptr c -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr c -> [c] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
16 [c]
components)

   getMatrixComponents MatrixOrder
desiredOrder m c
mat =
      m c -> (MatrixOrder -> Ptr c -> IO [c]) -> IO [c]
forall c a.
MatrixComponent c =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
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 [c]) -> IO [c])
-> (MatrixOrder -> Ptr c -> IO [c]) -> IO [c]
forall a b. (a -> b) -> a -> b
$ \MatrixOrder
order Ptr c
p ->
        if MatrixOrder
desiredOrder MatrixOrder -> MatrixOrder -> Bool
forall a. Eq a => a -> a -> Bool
== MatrixOrder
order
           then Int -> Ptr c -> IO [c]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
16 Ptr c
p
           else (Int -> IO c) -> [Int] -> IO [c]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr c -> Int -> IO c
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 ]

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

matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)
matrix :: forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
Maybe MatrixMode -> StateVar (m c)
matrix Maybe MatrixMode
maybeMode =
   IO (m c) -> (m c -> IO ()) -> StateVar (m c)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (IO MatrixMode
-> (MatrixMode -> IO MatrixMode)
-> Maybe MatrixMode
-> IO MatrixMode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StateVar MatrixMode -> IO MatrixMode
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> m MatrixMode
get StateVar MatrixMode
matrixMode) MatrixMode -> IO MatrixMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MatrixMode
maybeMode IO MatrixMode -> (MatrixMode -> IO (m c)) -> IO (m c)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PNameMatrix -> IO (m c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
PNameMatrix -> IO (m c)
getMatrix' (PNameMatrix -> IO (m c))
-> (MatrixMode -> PNameMatrix) -> MatrixMode -> IO (m c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatrixMode -> PNameMatrix
matrixModeToGetMatrix))
      ((IO () -> IO ())
-> (MatrixMode -> IO () -> IO ())
-> Maybe MatrixMode
-> IO ()
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO () -> IO ()
forall a. a -> a
id MatrixMode -> IO () -> IO ()
forall a. MatrixMode -> IO a -> IO a
withMatrixMode Maybe MatrixMode
maybeMode (IO () -> IO ()) -> (m c -> IO ()) -> m c -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m c -> IO ()
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
m c -> IO ()
setMatrix)

withMatrixMode :: MatrixMode -> IO a -> IO a
withMatrixMode :: forall a. MatrixMode -> IO a -> IO a
withMatrixMode MatrixMode
mode IO a
act =
   IO a -> IO a
forall a. IO a -> IO a
preservingMatrixMode (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
      StateVar MatrixMode
matrixMode StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= MatrixMode
mode
      IO a
act

getMatrix' :: (Matrix m, MatrixComponent c) => PNameMatrix -> IO (m c)
getMatrix' :: forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
PNameMatrix -> IO (m c)
getMatrix' = MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
forall c.
MatrixComponent c =>
MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
withNewMatrix MatrixOrder
ColumnMajor ((Ptr c -> IO ()) -> IO (m c))
-> (PNameMatrix -> Ptr c -> IO ()) -> PNameMatrix -> IO (m c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PNameMatrix -> Ptr c -> IO ()
forall p. GetPNameMatrix p => p -> Ptr c -> IO ()
forall c p.
(MatrixComponent c, GetPNameMatrix p) =>
p -> Ptr c -> IO ()
getMatrix

setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()
setMatrix :: forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
m c -> IO ()
setMatrix m c
mat =
   m c -> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
forall c a.
MatrixComponent c =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
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 ()) -> IO ())
-> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MatrixOrder
order ->
      case MatrixOrder
order of
         MatrixOrder
ColumnMajor -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
loadMatrix
         MatrixOrder
RowMajor    -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
loadTransposeMatrix

multMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()
multMatrix :: forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
m c -> IO ()
multMatrix m c
mat =
   m c -> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
forall c a.
MatrixComponent c =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
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 ()) -> IO ())
-> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MatrixOrder
order ->
      case MatrixOrder
order of
         MatrixOrder
ColumnMajor -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
multMatrix_
         MatrixOrder
RowMajor    -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
multTransposeMatrix

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

data GLmatrix a = GLmatrix MatrixOrder (ForeignPtr a)
   deriving ( GLmatrix a -> GLmatrix a -> Bool
(GLmatrix a -> GLmatrix a -> Bool)
-> (GLmatrix a -> GLmatrix a -> Bool) -> Eq (GLmatrix a)
forall a. GLmatrix a -> GLmatrix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. GLmatrix a -> GLmatrix a -> Bool
== :: GLmatrix a -> GLmatrix a -> Bool
$c/= :: forall a. GLmatrix a -> GLmatrix a -> Bool
/= :: GLmatrix a -> GLmatrix a -> Bool
Eq, Eq (GLmatrix a)
Eq (GLmatrix a)
-> (GLmatrix a -> GLmatrix a -> Ordering)
-> (GLmatrix a -> GLmatrix a -> Bool)
-> (GLmatrix a -> GLmatrix a -> Bool)
-> (GLmatrix a -> GLmatrix a -> Bool)
-> (GLmatrix a -> GLmatrix a -> Bool)
-> (GLmatrix a -> GLmatrix a -> GLmatrix a)
-> (GLmatrix a -> GLmatrix a -> GLmatrix a)
-> Ord (GLmatrix a)
GLmatrix a -> GLmatrix a -> Bool
GLmatrix a -> GLmatrix a -> Ordering
GLmatrix a -> GLmatrix a -> GLmatrix a
forall a. Eq (GLmatrix a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. GLmatrix a -> GLmatrix a -> Bool
forall a. GLmatrix a -> GLmatrix a -> Ordering
forall a. GLmatrix a -> GLmatrix a -> GLmatrix a
$ccompare :: forall a. GLmatrix a -> GLmatrix a -> Ordering
compare :: GLmatrix a -> GLmatrix a -> Ordering
$c< :: forall a. GLmatrix a -> GLmatrix a -> Bool
< :: GLmatrix a -> GLmatrix a -> Bool
$c<= :: forall a. GLmatrix a -> GLmatrix a -> Bool
<= :: GLmatrix a -> GLmatrix a -> Bool
$c> :: forall a. GLmatrix a -> GLmatrix a -> Bool
> :: GLmatrix a -> GLmatrix a -> Bool
$c>= :: forall a. GLmatrix a -> GLmatrix a -> Bool
>= :: GLmatrix a -> GLmatrix a -> Bool
$cmax :: forall a. GLmatrix a -> GLmatrix a -> GLmatrix a
max :: GLmatrix a -> GLmatrix a -> GLmatrix a
$cmin :: forall a. GLmatrix a -> GLmatrix a -> GLmatrix a
min :: GLmatrix a -> GLmatrix a -> GLmatrix a
Ord, Int -> GLmatrix a -> ShowS
[GLmatrix a] -> ShowS
GLmatrix a -> String
(Int -> GLmatrix a -> ShowS)
-> (GLmatrix a -> String)
-> ([GLmatrix a] -> ShowS)
-> Show (GLmatrix a)
forall a. Int -> GLmatrix a -> ShowS
forall a. [GLmatrix a] -> ShowS
forall a. GLmatrix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> GLmatrix a -> ShowS
showsPrec :: Int -> GLmatrix a -> ShowS
$cshow :: forall a. GLmatrix a -> String
show :: GLmatrix a -> String
$cshowList :: forall a. [GLmatrix a] -> ShowS
showList :: [GLmatrix a] -> ShowS
Show )

instance Matrix GLmatrix where
   withNewMatrix :: forall c.
MatrixComponent c =>
MatrixOrder -> (Ptr c -> IO ()) -> IO (GLmatrix c)
withNewMatrix MatrixOrder
order Ptr c -> IO ()
f = do
      ForeignPtr c
fp <- Int -> IO (ForeignPtr c)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
16
      ForeignPtr c -> (Ptr c -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr c
fp Ptr c -> IO ()
f
      GLmatrix c -> IO (GLmatrix c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GLmatrix c -> IO (GLmatrix c)) -> GLmatrix c -> IO (GLmatrix c)
forall a b. (a -> b) -> a -> b
$ MatrixOrder -> ForeignPtr c -> GLmatrix c
forall a. MatrixOrder -> ForeignPtr a -> GLmatrix a
GLmatrix MatrixOrder
order ForeignPtr c
fp

   withMatrix :: forall c a.
MatrixComponent c =>
GLmatrix c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
withMatrix (GLmatrix MatrixOrder
order ForeignPtr c
fp) MatrixOrder -> Ptr c -> IO a
f = ForeignPtr c -> (Ptr c -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr c
fp (MatrixOrder -> Ptr c -> IO a
f MatrixOrder
order)

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

loadIdentity :: IO ()
loadIdentity :: IO ()
loadIdentity = IO ()
forall (m :: * -> *). MonadIO m => m ()
glLoadIdentity

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

ortho :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
ortho :: GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
ortho = GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble
-> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
glOrtho

frustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
frustum :: GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
frustum = GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble
-> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
glFrustum

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

depthClamp :: StateVar Capability
depthClamp :: StateVar Capability
depthClamp = EnableCap -> StateVar Capability
makeCapability EnableCap
CapDepthClamp

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

activeTexture :: StateVar TextureUnit
activeTexture :: StateVar TextureUnit
activeTexture = IO TextureUnit -> (TextureUnit -> IO ()) -> StateVar TextureUnit
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLenum -> TextureUnit) -> PName1I -> IO TextureUnit
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 GLenum -> TextureUnit
unmarshalTextureUnit PName1I
GetActiveTexture)
                             (GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glActiveTexture (GLenum -> IO ())
-> (TextureUnit -> GLenum) -> TextureUnit -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureUnit -> GLenum
marshalTextureUnit)

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

-- | Push the current matrix stack down by one, duplicating the current matrix,
-- excute the given action, and pop the current matrix stack, replacing the
-- current matrix with the one below it on the stack (i.e. restoring it to its
-- previous state). The returned value is that of the given action. Note that
-- a round-trip to the server is probably required. For a more efficient
-- version, see 'unsafePreservingMatrix'.

preservingMatrix :: IO a -> IO a
preservingMatrix :: forall a. IO a -> IO a
preservingMatrix = IO a -> IO a
forall a. IO a -> IO a
unsafePreservingMatrix (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
preservingMatrixMode

-- performance paranoia: No (un-)marshaling by avoiding matrixMode
preservingMatrixMode :: IO a -> IO a
preservingMatrixMode :: forall a. IO a -> IO a
preservingMatrixMode = IO GLenum -> (GLenum -> IO ()) -> (GLenum -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ((GLenum -> GLenum) -> PName1I -> IO GLenum
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
forall a. (GLenum -> a) -> PName1I -> IO a
getEnum1 GLenum -> GLenum
forall a. a -> a
id PName1I
GetMatrixMode) GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glMatrixMode ((GLenum -> IO a) -> IO a)
-> (IO a -> GLenum -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> GLenum -> IO a
forall a b. a -> b -> a
const

-- | A more efficient, but potentially dangerous version of 'preservingMatrix':
-- The given action is not allowed to throw an exception or change the
-- current matrix mode permanently.

unsafePreservingMatrix :: IO a -> IO a
unsafePreservingMatrix :: forall a. IO a -> IO a
unsafePreservingMatrix = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
unsafeBracket_ IO ()
forall (m :: * -> *). MonadIO m => m ()
glPushMatrix IO ()
forall (m :: * -> *). MonadIO m => m ()
glPopMatrix

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

stackDepth :: Maybe MatrixMode -> GettableStateVar GLsizei
stackDepth :: Maybe MatrixMode -> GettableStateVar GLint
stackDepth Maybe MatrixMode
maybeMode =
   GettableStateVar GLint -> GettableStateVar GLint
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar GLint -> GettableStateVar GLint)
-> GettableStateVar GLint -> GettableStateVar GLint
forall a b. (a -> b) -> a -> b
$
      case Maybe MatrixMode
maybeMode of
         Maybe MatrixMode
Nothing -> (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getSizei1 GLint -> GLint
forall a. a -> a
id PName1I
GetCurrentMatrixStackDepth -- only with ARB_fragment_program
         Just MatrixMode
MatrixPalette -> do IO ()
recordInvalidEnum ; GLint -> GettableStateVar GLint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GLint
0
         Just MatrixMode
mode -> (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getSizei1 GLint -> GLint
forall a. a -> a
id (MatrixMode -> PName1I
matrixModeToGetStackDepth MatrixMode
mode)

maxStackDepth :: MatrixMode -> GettableStateVar GLsizei
maxStackDepth :: MatrixMode -> GettableStateVar GLint
maxStackDepth =
   GettableStateVar GLint -> GettableStateVar GLint
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar GLint -> GettableStateVar GLint)
-> (MatrixMode -> GettableStateVar GLint)
-> MatrixMode
-> GettableStateVar GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getSizei1 GLint -> GLint
forall a. a -> a
id (PName1I -> GettableStateVar GLint)
-> (MatrixMode -> PName1I) -> MatrixMode -> GettableStateVar GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatrixMode -> PName1I
matrixModeToGetMaxStackDepth

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

-- | If 'rescaleNormal' contains 'Enabled', normal vectors specified with
-- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled by a scaling
-- factor derived from the modelview matrix. 'rescaleNormal' requires that the
-- originally specified normals were of unit length, and that the modelview
-- matrix contains only uniform scales for proper results. The initial value of
-- 'rescaleNormal' is 'Disabled'.

rescaleNormal :: StateVar Capability
rescaleNormal :: StateVar Capability
rescaleNormal = EnableCap -> StateVar Capability
makeCapability EnableCap
CapRescaleNormal

-- | If 'normalize' contains 'Enabled', normal vectors specified with
-- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled to unit length
-- after transformation. The initial value of 'normalize' is 'Disabled'.

normalize :: StateVar Capability
normalize :: StateVar Capability
normalize = EnableCap -> StateVar Capability
makeCapability EnableCap
CapNormalize

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

data Plane a = Plane !a !a !a !a
   deriving ( Plane a -> Plane a -> Bool
(Plane a -> Plane a -> Bool)
-> (Plane a -> Plane a -> Bool) -> Eq (Plane a)
forall a. Eq a => Plane a -> Plane a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Plane a -> Plane a -> Bool
== :: Plane a -> Plane a -> Bool
$c/= :: forall a. Eq a => Plane a -> Plane a -> Bool
/= :: Plane a -> Plane a -> Bool
Eq, Eq (Plane a)
Eq (Plane a)
-> (Plane a -> Plane a -> Ordering)
-> (Plane a -> Plane a -> Bool)
-> (Plane a -> Plane a -> Bool)
-> (Plane a -> Plane a -> Bool)
-> (Plane a -> Plane a -> Bool)
-> (Plane a -> Plane a -> Plane a)
-> (Plane a -> Plane a -> Plane a)
-> Ord (Plane a)
Plane a -> Plane a -> Bool
Plane a -> Plane a -> Ordering
Plane a -> Plane a -> Plane a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Plane a)
forall a. Ord a => Plane a -> Plane a -> Bool
forall a. Ord a => Plane a -> Plane a -> Ordering
forall a. Ord a => Plane a -> Plane a -> Plane a
$ccompare :: forall a. Ord a => Plane a -> Plane a -> Ordering
compare :: Plane a -> Plane a -> Ordering
$c< :: forall a. Ord a => Plane a -> Plane a -> Bool
< :: Plane a -> Plane a -> Bool
$c<= :: forall a. Ord a => Plane a -> Plane a -> Bool
<= :: Plane a -> Plane a -> Bool
$c> :: forall a. Ord a => Plane a -> Plane a -> Bool
> :: Plane a -> Plane a -> Bool
$c>= :: forall a. Ord a => Plane a -> Plane a -> Bool
>= :: Plane a -> Plane a -> Bool
$cmax :: forall a. Ord a => Plane a -> Plane a -> Plane a
max :: Plane a -> Plane a -> Plane a
$cmin :: forall a. Ord a => Plane a -> Plane a -> Plane a
min :: Plane a -> Plane a -> Plane a
Ord, Int -> Plane a -> ShowS
[Plane a] -> ShowS
Plane a -> String
(Int -> Plane a -> ShowS)
-> (Plane a -> String) -> ([Plane a] -> ShowS) -> Show (Plane a)
forall a. Show a => Int -> Plane a -> ShowS
forall a. Show a => [Plane a] -> ShowS
forall a. Show a => Plane a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Plane a -> ShowS
showsPrec :: Int -> Plane a -> ShowS
$cshow :: forall a. Show a => Plane a -> String
show :: Plane a -> String
$cshowList :: forall a. Show a => [Plane a] -> ShowS
showList :: [Plane a] -> ShowS
Show )

instance Storable a => Storable (Plane a) where
   sizeOf :: Plane a -> Int
sizeOf    ~(Plane a
a a
_ a
_ a
_) = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
a
   alignment :: Plane a -> Int
alignment ~(Plane a
a a
_ a
_ a
_) = a -> Int
forall a. Storable a => a -> Int
alignment a
a
   peek :: Ptr (Plane a) -> IO (Plane a)
peek                       = (a -> a -> a -> a -> Plane a) -> Ptr a -> IO (Plane a)
forall a b. Storable a => (a -> a -> a -> a -> b) -> Ptr a -> IO b
peek4 a -> a -> a -> a -> Plane a
forall a. a -> a -> a -> a -> Plane a
Plane (Ptr a -> IO (Plane a))
-> (Ptr (Plane a) -> Ptr a) -> Ptr (Plane a) -> IO (Plane a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Plane a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr
   poke :: Ptr (Plane a) -> Plane a -> IO ()
poke Ptr (Plane a)
ptr   (Plane a
a a
b a
c a
d) = Ptr a -> a -> a -> a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> a -> a -> a -> IO ()
poke4 (Ptr (Plane a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane a)
ptr) a
a a
b a
c a
d

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

data TextureCoordName =
     S
   | T
   | R
   | Q
   deriving ( TextureCoordName -> TextureCoordName -> Bool
(TextureCoordName -> TextureCoordName -> Bool)
-> (TextureCoordName -> TextureCoordName -> Bool)
-> Eq TextureCoordName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextureCoordName -> TextureCoordName -> Bool
== :: TextureCoordName -> TextureCoordName -> Bool
$c/= :: TextureCoordName -> TextureCoordName -> Bool
/= :: TextureCoordName -> TextureCoordName -> Bool
Eq, Eq TextureCoordName
Eq TextureCoordName
-> (TextureCoordName -> TextureCoordName -> Ordering)
-> (TextureCoordName -> TextureCoordName -> Bool)
-> (TextureCoordName -> TextureCoordName -> Bool)
-> (TextureCoordName -> TextureCoordName -> Bool)
-> (TextureCoordName -> TextureCoordName -> Bool)
-> (TextureCoordName -> TextureCoordName -> TextureCoordName)
-> (TextureCoordName -> TextureCoordName -> TextureCoordName)
-> Ord TextureCoordName
TextureCoordName -> TextureCoordName -> Bool
TextureCoordName -> TextureCoordName -> Ordering
TextureCoordName -> TextureCoordName -> TextureCoordName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TextureCoordName -> TextureCoordName -> Ordering
compare :: TextureCoordName -> TextureCoordName -> Ordering
$c< :: TextureCoordName -> TextureCoordName -> Bool
< :: TextureCoordName -> TextureCoordName -> Bool
$c<= :: TextureCoordName -> TextureCoordName -> Bool
<= :: TextureCoordName -> TextureCoordName -> Bool
$c> :: TextureCoordName -> TextureCoordName -> Bool
> :: TextureCoordName -> TextureCoordName -> Bool
$c>= :: TextureCoordName -> TextureCoordName -> Bool
>= :: TextureCoordName -> TextureCoordName -> Bool
$cmax :: TextureCoordName -> TextureCoordName -> TextureCoordName
max :: TextureCoordName -> TextureCoordName -> TextureCoordName
$cmin :: TextureCoordName -> TextureCoordName -> TextureCoordName
min :: TextureCoordName -> TextureCoordName -> TextureCoordName
Ord, Int -> TextureCoordName -> ShowS
[TextureCoordName] -> ShowS
TextureCoordName -> String
(Int -> TextureCoordName -> ShowS)
-> (TextureCoordName -> String)
-> ([TextureCoordName] -> ShowS)
-> Show TextureCoordName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextureCoordName -> ShowS
showsPrec :: Int -> TextureCoordName -> ShowS
$cshow :: TextureCoordName -> String
show :: TextureCoordName -> String
$cshowList :: [TextureCoordName] -> ShowS
showList :: [TextureCoordName] -> ShowS
Show )

marshalTextureCoordName :: TextureCoordName -> GLenum
marshalTextureCoordName :: TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
x = case TextureCoordName
x of
   TextureCoordName
S -> GLenum
GL_S
   TextureCoordName
T -> GLenum
GL_T
   TextureCoordName
R -> GLenum
GL_R
   TextureCoordName
Q -> GLenum
GL_Q

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

data TextureGenParameter =
     TextureGenMode
   | ObjectPlane
   | EyePlane

marshalTextureGenParameter :: TextureGenParameter -> GLenum
marshalTextureGenParameter :: TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
x = case TextureGenParameter
x of
   TextureGenParameter
TextureGenMode -> GLenum
GL_TEXTURE_GEN_MODE
   TextureGenParameter
ObjectPlane -> GLenum
GL_OBJECT_PLANE
   TextureGenParameter
EyePlane -> GLenum
GL_EYE_PLANE

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

data TextureGenMode' =
     EyeLinear'
   | ObjectLinear'
   | SphereMap'
   | NormalMap'
   | ReflectionMap'

marshalTextureGenMode' :: TextureGenMode' -> GLint
marshalTextureGenMode' :: TextureGenMode' -> GLint
marshalTextureGenMode' TextureGenMode'
x = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ case TextureGenMode'
x of
   TextureGenMode'
EyeLinear' -> GLenum
GL_EYE_LINEAR
   TextureGenMode'
ObjectLinear' -> GLenum
GL_OBJECT_LINEAR
   TextureGenMode'
SphereMap' -> GLenum
GL_SPHERE_MAP
   TextureGenMode'
NormalMap' -> GLenum
GL_NORMAL_MAP
   TextureGenMode'
ReflectionMap' -> GLenum
GL_REFLECTION_MAP

unmarshalTextureGenMode' :: GLint -> TextureGenMode'
unmarshalTextureGenMode' :: GLint -> TextureGenMode'
unmarshalTextureGenMode' GLint
x
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_EYE_LINEAR = TextureGenMode'
EyeLinear'
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_OBJECT_LINEAR = TextureGenMode'
ObjectLinear'
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_SPHERE_MAP = TextureGenMode'
SphereMap'
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_NORMAL_MAP = TextureGenMode'
NormalMap'
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_REFLECTION_MAP = TextureGenMode'
ReflectionMap'
   | Bool
otherwise = String -> TextureGenMode'
forall a. HasCallStack => String -> a
error (String
"unmarshalTextureGenMode': illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLint -> String
forall a. Show a => a -> String
show GLint
x)
   where y :: GLenum
y = GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

data TextureGenMode =
     EyeLinear    (Plane GLdouble)
   | ObjectLinear (Plane GLdouble)
   | SphereMap
   | NormalMap
   | ReflectionMap
   deriving ( TextureGenMode -> TextureGenMode -> Bool
(TextureGenMode -> TextureGenMode -> Bool)
-> (TextureGenMode -> TextureGenMode -> Bool) -> Eq TextureGenMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextureGenMode -> TextureGenMode -> Bool
== :: TextureGenMode -> TextureGenMode -> Bool
$c/= :: TextureGenMode -> TextureGenMode -> Bool
/= :: TextureGenMode -> TextureGenMode -> Bool
Eq, Eq TextureGenMode
Eq TextureGenMode
-> (TextureGenMode -> TextureGenMode -> Ordering)
-> (TextureGenMode -> TextureGenMode -> Bool)
-> (TextureGenMode -> TextureGenMode -> Bool)
-> (TextureGenMode -> TextureGenMode -> Bool)
-> (TextureGenMode -> TextureGenMode -> Bool)
-> (TextureGenMode -> TextureGenMode -> TextureGenMode)
-> (TextureGenMode -> TextureGenMode -> TextureGenMode)
-> Ord TextureGenMode
TextureGenMode -> TextureGenMode -> Bool
TextureGenMode -> TextureGenMode -> Ordering
TextureGenMode -> TextureGenMode -> TextureGenMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TextureGenMode -> TextureGenMode -> Ordering
compare :: TextureGenMode -> TextureGenMode -> Ordering
$c< :: TextureGenMode -> TextureGenMode -> Bool
< :: TextureGenMode -> TextureGenMode -> Bool
$c<= :: TextureGenMode -> TextureGenMode -> Bool
<= :: TextureGenMode -> TextureGenMode -> Bool
$c> :: TextureGenMode -> TextureGenMode -> Bool
> :: TextureGenMode -> TextureGenMode -> Bool
$c>= :: TextureGenMode -> TextureGenMode -> Bool
>= :: TextureGenMode -> TextureGenMode -> Bool
$cmax :: TextureGenMode -> TextureGenMode -> TextureGenMode
max :: TextureGenMode -> TextureGenMode -> TextureGenMode
$cmin :: TextureGenMode -> TextureGenMode -> TextureGenMode
min :: TextureGenMode -> TextureGenMode -> TextureGenMode
Ord, Int -> TextureGenMode -> ShowS
[TextureGenMode] -> ShowS
TextureGenMode -> String
(Int -> TextureGenMode -> ShowS)
-> (TextureGenMode -> String)
-> ([TextureGenMode] -> ShowS)
-> Show TextureGenMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextureGenMode -> ShowS
showsPrec :: Int -> TextureGenMode -> ShowS
$cshow :: TextureGenMode -> String
show :: TextureGenMode -> String
$cshowList :: [TextureGenMode] -> ShowS
showList :: [TextureGenMode] -> ShowS
Show )

marshalTextureGenMode :: TextureGenMode -> GLint
marshalTextureGenMode :: TextureGenMode -> GLint
marshalTextureGenMode = TextureGenMode' -> GLint
marshalTextureGenMode' (TextureGenMode' -> GLint)
-> (TextureGenMode -> TextureGenMode') -> TextureGenMode -> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureGenMode -> TextureGenMode'
convertMode
   where convertMode :: TextureGenMode -> TextureGenMode'
convertMode (EyeLinear    Plane GLdouble
_) = TextureGenMode'
EyeLinear'
         convertMode (ObjectLinear Plane GLdouble
_) = TextureGenMode'
ObjectLinear'
         convertMode TextureGenMode
SphereMap        = TextureGenMode'
SphereMap'
         convertMode TextureGenMode
NormalMap        = TextureGenMode'
NormalMap'
         convertMode TextureGenMode
ReflectionMap    = TextureGenMode'
ReflectionMap'

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

textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)
textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)
textureGenMode TextureCoordName
coord =
   IO EnableCap
-> IO TextureGenMode
-> (TextureGenMode -> IO ())
-> StateVar (Maybe TextureGenMode)
forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (EnableCap -> IO EnableCap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnableCap -> IO EnableCap) -> EnableCap -> IO EnableCap
forall a b. (a -> b) -> a -> b
$ TextureCoordName -> EnableCap
textureCoordNameToEnableCap TextureCoordName
coord)
      (do TextureGenMode'
mode <- TextureCoordName -> IO TextureGenMode'
getMode TextureCoordName
coord
          case TextureGenMode'
mode of
             TextureGenMode'
EyeLinear'     -> (Plane GLdouble -> TextureGenMode)
-> IO (Plane GLdouble) -> IO TextureGenMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Plane GLdouble -> TextureGenMode
EyeLinear (IO (Plane GLdouble) -> IO TextureGenMode)
-> IO (Plane GLdouble) -> IO TextureGenMode
forall a b. (a -> b) -> a -> b
$ TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)
getPlane TextureCoordName
coord TextureGenParameter
EyePlane
             TextureGenMode'
ObjectLinear'  -> (Plane GLdouble -> TextureGenMode)
-> IO (Plane GLdouble) -> IO TextureGenMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Plane GLdouble -> TextureGenMode
ObjectLinear (IO (Plane GLdouble) -> IO TextureGenMode)
-> IO (Plane GLdouble) -> IO TextureGenMode
forall a b. (a -> b) -> a -> b
$ TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)
getPlane TextureCoordName
coord TextureGenParameter
ObjectPlane
             TextureGenMode'
SphereMap'     -> TextureGenMode -> IO TextureGenMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
SphereMap
             TextureGenMode'
NormalMap'     -> TextureGenMode -> IO TextureGenMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
NormalMap
             TextureGenMode'
ReflectionMap' -> TextureGenMode -> IO TextureGenMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
ReflectionMap)
      (\TextureGenMode
mode -> do
         TextureCoordName -> TextureGenMode -> IO ()
setMode TextureCoordName
coord TextureGenMode
mode
         case TextureGenMode
mode of
            EyeLinear    Plane GLdouble
plane -> TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane TextureCoordName
coord TextureGenParameter
EyePlane    Plane GLdouble
plane
            ObjectLinear Plane GLdouble
plane -> TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane TextureCoordName
coord TextureGenParameter
ObjectPlane Plane GLdouble
plane
            TextureGenMode
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

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

textureCoordNameToEnableCap :: TextureCoordName -> EnableCap
textureCoordNameToEnableCap :: TextureCoordName -> EnableCap
textureCoordNameToEnableCap TextureCoordName
coord = case TextureCoordName
coord of
   TextureCoordName
S -> EnableCap
CapTextureGenS
   TextureCoordName
T -> EnableCap
CapTextureGenT
   TextureCoordName
R -> EnableCap
CapTextureGenR
   TextureCoordName
Q -> EnableCap
CapTextureGenQ

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

getMode :: TextureCoordName -> IO TextureGenMode'
getMode :: TextureCoordName -> IO TextureGenMode'
getMode TextureCoordName
coord = (Ptr GLint -> IO TextureGenMode') -> IO TextureGenMode'
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLint -> IO TextureGenMode') -> IO TextureGenMode')
-> (Ptr GLint -> IO TextureGenMode') -> IO TextureGenMode'
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
   GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glGetTexGeniv (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
                 (TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
TextureGenMode)
                 Ptr GLint
buf
   (GLint -> TextureGenMode') -> Ptr GLint -> IO TextureGenMode'
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLint -> TextureGenMode'
unmarshalTextureGenMode' Ptr GLint
buf

setMode :: TextureCoordName -> TextureGenMode -> IO ()
setMode :: TextureCoordName -> TextureGenMode -> IO ()
setMode TextureCoordName
coord TextureGenMode
mode =
   GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexGeni (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
             (TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
TextureGenMode)
             (TextureGenMode -> GLint
marshalTextureGenMode TextureGenMode
mode)

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

getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)
getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)
getPlane TextureCoordName
coord TextureGenParameter
param = (Ptr (Plane GLdouble) -> IO (Plane GLdouble))
-> IO (Plane GLdouble)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Plane GLdouble) -> IO (Plane GLdouble))
 -> IO (Plane GLdouble))
-> (Ptr (Plane GLdouble) -> IO (Plane GLdouble))
-> IO (Plane GLdouble)
forall a b. (a -> b) -> a -> b
$ \Ptr (Plane GLdouble)
planeBuffer -> do
   GLenum -> GLenum -> Ptr GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLdouble -> m ()
glGetTexGendv (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
                 (TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
param)
                 (Ptr (Plane GLdouble) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLdouble)
planeBuffer)
   Ptr (Plane GLdouble) -> IO (Plane GLdouble)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Plane GLdouble)
planeBuffer

setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane TextureCoordName
coord TextureGenParameter
param Plane GLdouble
plane =
   Plane GLdouble -> (Ptr (Plane GLdouble) -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Plane GLdouble
plane ((Ptr (Plane GLdouble) -> IO ()) -> IO ())
-> (Ptr (Plane GLdouble) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Plane GLdouble)
planeBuffer ->
      GLenum -> GLenum -> Ptr GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLdouble -> m ()
glTexGendv (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
                 (TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
param)
                 (Ptr (Plane GLdouble) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLdouble)
planeBuffer)