module Graphics.Rendering.OpenGL.GL.CoordTrans (
depthRange,
Position(..), Size(..), viewport, maxViewportDims,
MatrixMode(..), matrixMode,
MatrixOrder(..), MatrixComponent(rotate,translate,scale), Matrix(..),
matrix, multMatrix, GLmatrix, loadIdentity,
ortho, frustum, depthClamp,
activeTexture,
preservingMatrix, unsafePreservingMatrix,
stackDepth, maxStackDepth,
rescaleNormal, normalize,
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
depthRange :: StateVar (GLclampd, GLclampd)
depthRange :: StateVar (GLclampd, GLclampd)
depthRange = IO (GLclampd, GLclampd)
-> ((GLclampd, GLclampd) -> IO ()) -> StateVar (GLclampd, GLclampd)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLclampd -> GLclampd -> (GLclampd, GLclampd))
-> PName2F -> IO (GLclampd, GLclampd)
forall p a.
GetPName2F p =>
(GLclampd -> GLclampd -> a) -> p -> IO a
getClampd2 (,) PName2F
GetDepthRange) ((GLclampd -> GLclampd -> IO ()) -> (GLclampd, GLclampd) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GLclampd -> GLclampd -> IO ()
forall (m :: * -> *). MonadIO m => GLclampd -> GLclampd -> m ()
glDepthRange)
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
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: 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
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$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
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq 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
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show )
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
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: 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
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$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
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
$cp1Ord :: Eq 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
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show )
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
getInteger4 GLint -> GLint -> GLint -> GLint -> (Position, Size)
forall a a.
(Integral a, Integral a) =>
GLint -> GLint -> a -> a -> (Position, Size)
makeVp PName4I
GetViewport)
(\(Position x :: GLint
x y :: GLint
y, Size w :: GLint
w h :: 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 x :: GLint
x y :: GLint
y w :: a
w h :: 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))
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
getSizei2 GLint -> GLint -> Size
Size PName2I
GetMaxViewportDims)
data MatrixMode =
Modelview GLsizei
| Projection
| Texture
| Color
| MatrixPalette
deriving ( MatrixMode -> MatrixMode -> Bool
(MatrixMode -> MatrixMode -> Bool)
-> (MatrixMode -> MatrixMode -> Bool) -> Eq MatrixMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatrixMode -> MatrixMode -> Bool
$c/= :: MatrixMode -> MatrixMode -> Bool
== :: MatrixMode -> MatrixMode -> Bool
$c== :: 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
min :: MatrixMode -> MatrixMode -> MatrixMode
$cmin :: MatrixMode -> MatrixMode -> MatrixMode
max :: MatrixMode -> MatrixMode -> MatrixMode
$cmax :: MatrixMode -> MatrixMode -> MatrixMode
>= :: MatrixMode -> MatrixMode -> Bool
$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
compare :: MatrixMode -> MatrixMode -> Ordering
$ccompare :: MatrixMode -> MatrixMode -> Ordering
$cp1Ord :: Eq 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
showList :: [MatrixMode] -> ShowS
$cshowList :: [MatrixMode] -> ShowS
show :: MatrixMode -> String
$cshow :: MatrixMode -> String
showsPrec :: Int -> MatrixMode -> ShowS
$cshowsPrec :: Int -> MatrixMode -> ShowS
Show )
marshalMatrixMode :: MatrixMode -> Maybe GLenum
marshalMatrixMode :: MatrixMode -> Maybe GLenum
marshalMatrixMode x :: MatrixMode
x = case MatrixMode
x of
Modelview i :: GLint
i -> GLint -> Maybe GLenum
modelviewIndexToEnum GLint
i
Projection -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_PROJECTION
Texture -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_TEXTURE
Color -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_COLOR
MatrixPalette -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_MATRIX_PALETTE_ARB
unmarshalMatrixMode :: GLenum -> MatrixMode
unmarshalMatrixMode :: GLenum -> MatrixMode
unmarshalMatrixMode x :: 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 i :: GLint
i -> GLint -> MatrixMode
Modelview GLint
i
Nothing -> String -> MatrixMode
forall a. HasCallStack => String -> a
error ("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 x :: MatrixMode
x = case MatrixMode
x of
Modelview _ -> PNameMatrix
GetModelviewMatrix
Projection -> PNameMatrix
GetProjectionMatrix
Texture -> PNameMatrix
GetTextureMatrix
Color -> PNameMatrix
GetColorMatrix
MatrixPalette -> PNameMatrix
GetMatrixPalette
matrixModeToGetStackDepth :: MatrixMode -> PName1I
matrixModeToGetStackDepth :: MatrixMode -> PName1I
matrixModeToGetStackDepth x :: MatrixMode
x = case MatrixMode
x of
Modelview _ -> PName1I
GetModelviewStackDepth
Projection -> PName1I
GetProjectionStackDepth
Texture -> PName1I
GetTextureStackDepth
Color -> PName1I
GetColorMatrixStackDepth
MatrixPalette -> String -> PName1I
forall a. HasCallStack => String -> a
error "matrixModeToGetStackDepth: impossible"
matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I
matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I
matrixModeToGetMaxStackDepth x :: MatrixMode
x = case MatrixMode
x of
Modelview _ -> PName1I
GetMaxModelviewStackDepth
Projection -> PName1I
GetMaxProjectionStackDepth
Texture -> PName1I
GetMaxTextureStackDepth
Color -> PName1I
GetMaxColorMatrixStackDepth
MatrixPalette -> PName1I
GetMaxMatrixPaletteStackDepth
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
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
/= :: MatrixOrder -> MatrixOrder -> Bool
$c/= :: MatrixOrder -> MatrixOrder -> Bool
== :: MatrixOrder -> MatrixOrder -> Bool
$c== :: 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
min :: MatrixOrder -> MatrixOrder -> MatrixOrder
$cmin :: MatrixOrder -> MatrixOrder -> MatrixOrder
max :: MatrixOrder -> MatrixOrder -> MatrixOrder
$cmax :: MatrixOrder -> MatrixOrder -> MatrixOrder
>= :: MatrixOrder -> MatrixOrder -> Bool
$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
compare :: MatrixOrder -> MatrixOrder -> Ordering
$ccompare :: MatrixOrder -> MatrixOrder -> Ordering
$cp1Ord :: Eq 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
showList :: [MatrixOrder] -> ShowS
$cshowList :: [MatrixOrder] -> ShowS
show :: MatrixOrder -> String
$cshow :: MatrixOrder -> String
showsPrec :: Int -> MatrixOrder -> ShowS
$cshowsPrec :: Int -> MatrixOrder -> ShowS
Show )
class Matrix m where
withNewMatrix ::
MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
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 order :: MatrixOrder
order act :: 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 16 ((Ptr c -> IO (m c)) -> IO (m c))
-> (Ptr c -> IO (m c)) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ \p :: 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 16 Ptr c
p
MatrixOrder -> [c] -> IO (m c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> [c] -> IO (m c)
newMatrix MatrixOrder
order [c]
components
withMatrix mat :: m c
mat act :: MatrixOrder -> Ptr c -> IO a
act = do
[c]
components <- 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 order :: MatrixOrder
order components :: [c]
components =
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 16 [c]
components)
getMatrixComponents desiredOrder :: MatrixOrder
desiredOrder mat :: m c
mat =
m c -> (MatrixOrder -> Ptr c -> IO [c]) -> IO [c]
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
$ \order :: MatrixOrder
order p :: 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 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)
mapM (Ptr c -> Int -> IO c
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr c
p) [ 0, 4, 8, 12,
1, 5, 9, 13,
2, 6, 10, 14,
3, 7, 11, 15 ]
matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)
matrix :: Maybe MatrixMode -> StateVar (m c)
matrix maybeMode :: 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
get StateVar MatrixMode
matrixMode) MatrixMode -> IO MatrixMode
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MatrixMode
maybeMode IO MatrixMode -> (MatrixMode -> IO (m c)) -> IO (m c)
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 :: MatrixMode -> IO a -> IO a
withMatrixMode mode :: MatrixMode
mode act :: 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 ()
$= MatrixMode
mode
IO a
act
getMatrix' :: (Matrix m, MatrixComponent c) => PNameMatrix -> IO (m c)
getMatrix' :: PNameMatrix -> IO (m c)
getMatrix' = 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 c p.
(MatrixComponent c, GetPNameMatrix p) =>
p -> Ptr c -> IO ()
getMatrix
setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()
setMatrix :: m c -> IO ()
setMatrix mat :: m c
mat =
m c -> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
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
$ \order :: MatrixOrder
order ->
case MatrixOrder
order of
ColumnMajor -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
loadMatrix
RowMajor -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
loadTransposeMatrix
multMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()
multMatrix :: m c -> IO ()
multMatrix mat :: m c
mat =
m c -> (MatrixOrder -> Ptr c -> IO ()) -> IO ()
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
$ \order :: MatrixOrder
order ->
case MatrixOrder
order of
ColumnMajor -> Ptr c -> IO ()
forall c. MatrixComponent c => Ptr c -> IO ()
multMatrix_
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
/= :: 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
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
min :: GLmatrix a -> GLmatrix a -> GLmatrix a
$cmin :: forall a. GLmatrix a -> GLmatrix a -> GLmatrix a
max :: GLmatrix a -> GLmatrix a -> GLmatrix a
$cmax :: forall a. GLmatrix a -> GLmatrix a -> GLmatrix a
>= :: 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
$c< :: forall a. GLmatrix a -> GLmatrix a -> Bool
compare :: GLmatrix a -> GLmatrix a -> Ordering
$ccompare :: forall a. GLmatrix a -> GLmatrix a -> Ordering
$cp1Ord :: forall a. Eq (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
showList :: [GLmatrix a] -> ShowS
$cshowList :: forall a. [GLmatrix a] -> ShowS
show :: GLmatrix a -> String
$cshow :: forall a. GLmatrix a -> String
showsPrec :: Int -> GLmatrix a -> ShowS
$cshowsPrec :: forall a. Int -> GLmatrix a -> ShowS
Show )
instance Matrix GLmatrix where
withNewMatrix :: MatrixOrder -> (Ptr c -> IO ()) -> IO (GLmatrix c)
withNewMatrix order :: MatrixOrder
order f :: Ptr c -> IO ()
f = do
ForeignPtr c
fp <- Int -> IO (ForeignPtr c)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray 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 (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 :: GLmatrix c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
withMatrix (GLmatrix order :: MatrixOrder
order fp :: ForeignPtr c
fp) f :: 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 :: GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> IO ()
ortho = GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLclampd
-> GLclampd -> GLclampd -> GLclampd -> GLclampd -> GLclampd -> m ()
glOrtho
frustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
frustum :: GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> IO ()
frustum = GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> GLclampd
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLclampd
-> GLclampd -> GLclampd -> GLclampd -> GLclampd -> GLclampd -> 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
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)
preservingMatrix :: IO a -> IO a
preservingMatrix :: 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
preservingMatrixMode :: IO a -> IO a
preservingMatrixMode :: 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
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
unsafePreservingMatrix :: IO a -> IO a
unsafePreservingMatrix :: 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 maybeMode :: 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
Nothing -> (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getSizei1 GLint -> GLint
forall a. a -> a
id PName1I
GetCurrentMatrixStackDepth
Just MatrixPalette -> do IO ()
recordInvalidEnum ; GLint -> GettableStateVar GLint
forall (m :: * -> *) a. Monad m => a -> m a
return 0
Just mode :: MatrixMode
mode -> (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> 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
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
rescaleNormal :: StateVar Capability
rescaleNormal :: StateVar Capability
rescaleNormal = EnableCap -> StateVar Capability
makeCapability EnableCap
CapRescaleNormal
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
/= :: Plane a -> Plane a -> Bool
$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
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
min :: Plane a -> Plane a -> Plane a
$cmin :: forall a. Ord a => Plane a -> Plane a -> Plane a
max :: Plane a -> Plane a -> Plane a
$cmax :: forall a. Ord a => Plane a -> Plane a -> Plane a
>= :: 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
$c< :: forall a. Ord a => Plane a -> Plane a -> Bool
compare :: Plane a -> Plane a -> Ordering
$ccompare :: forall a. Ord a => Plane a -> Plane a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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
showList :: [Plane a] -> ShowS
$cshowList :: forall a. Show a => [Plane a] -> ShowS
show :: Plane a -> String
$cshow :: forall a. Show a => Plane a -> String
showsPrec :: Int -> Plane a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Plane a -> ShowS
Show )
instance Storable a => Storable (Plane a) where
sizeOf :: Plane a -> Int
sizeOf ~(Plane a :: a
a _ _ _) = 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 -> 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 :: Ptr (Plane a)
ptr (Plane a :: a
a b :: a
b c :: a
c d :: 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
/= :: TextureCoordName -> TextureCoordName -> Bool
$c/= :: TextureCoordName -> TextureCoordName -> Bool
== :: TextureCoordName -> TextureCoordName -> Bool
$c== :: 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
min :: TextureCoordName -> TextureCoordName -> TextureCoordName
$cmin :: TextureCoordName -> TextureCoordName -> TextureCoordName
max :: TextureCoordName -> TextureCoordName -> TextureCoordName
$cmax :: TextureCoordName -> TextureCoordName -> TextureCoordName
>= :: TextureCoordName -> TextureCoordName -> Bool
$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
compare :: TextureCoordName -> TextureCoordName -> Ordering
$ccompare :: TextureCoordName -> TextureCoordName -> Ordering
$cp1Ord :: Eq 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
showList :: [TextureCoordName] -> ShowS
$cshowList :: [TextureCoordName] -> ShowS
show :: TextureCoordName -> String
$cshow :: TextureCoordName -> String
showsPrec :: Int -> TextureCoordName -> ShowS
$cshowsPrec :: Int -> TextureCoordName -> ShowS
Show )
marshalTextureCoordName :: TextureCoordName -> GLenum
marshalTextureCoordName :: TextureCoordName -> GLenum
marshalTextureCoordName x :: TextureCoordName
x = case TextureCoordName
x of
S -> GLenum
GL_S
T -> GLenum
GL_T
R -> GLenum
GL_R
Q -> GLenum
GL_Q
data TextureGenParameter =
TextureGenMode
| ObjectPlane
| EyePlane
marshalTextureGenParameter :: TextureGenParameter -> GLenum
marshalTextureGenParameter :: TextureGenParameter -> GLenum
marshalTextureGenParameter x :: TextureGenParameter
x = case TextureGenParameter
x of
TextureGenMode -> GLenum
GL_TEXTURE_GEN_MODE
ObjectPlane -> GLenum
GL_OBJECT_PLANE
EyePlane -> GLenum
GL_EYE_PLANE
data TextureGenMode' =
EyeLinear'
| ObjectLinear'
| SphereMap'
| NormalMap'
| ReflectionMap'
marshalTextureGenMode' :: TextureGenMode' -> GLint
marshalTextureGenMode' :: TextureGenMode' -> GLint
marshalTextureGenMode' x :: 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
EyeLinear' -> GLenum
GL_EYE_LINEAR
ObjectLinear' -> GLenum
GL_OBJECT_LINEAR
SphereMap' -> GLenum
GL_SPHERE_MAP
NormalMap' -> GLenum
GL_NORMAL_MAP
ReflectionMap' -> GLenum
GL_REFLECTION_MAP
unmarshalTextureGenMode' :: GLint -> TextureGenMode'
unmarshalTextureGenMode' :: GLint -> TextureGenMode'
unmarshalTextureGenMode' x :: 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 ("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
/= :: TextureGenMode -> TextureGenMode -> Bool
$c/= :: TextureGenMode -> TextureGenMode -> Bool
== :: TextureGenMode -> TextureGenMode -> Bool
$c== :: 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
min :: TextureGenMode -> TextureGenMode -> TextureGenMode
$cmin :: TextureGenMode -> TextureGenMode -> TextureGenMode
max :: TextureGenMode -> TextureGenMode -> TextureGenMode
$cmax :: TextureGenMode -> TextureGenMode -> TextureGenMode
>= :: TextureGenMode -> TextureGenMode -> Bool
$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
compare :: TextureGenMode -> TextureGenMode -> Ordering
$ccompare :: TextureGenMode -> TextureGenMode -> Ordering
$cp1Ord :: Eq 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
showList :: [TextureGenMode] -> ShowS
$cshowList :: [TextureGenMode] -> ShowS
show :: TextureGenMode -> String
$cshow :: TextureGenMode -> String
showsPrec :: Int -> TextureGenMode -> ShowS
$cshowsPrec :: Int -> 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 _) = TextureGenMode'
EyeLinear'
convertMode (ObjectLinear _) = TextureGenMode'
ObjectLinear'
convertMode SphereMap = TextureGenMode'
SphereMap'
convertMode NormalMap = TextureGenMode'
NormalMap'
convertMode ReflectionMap = TextureGenMode'
ReflectionMap'
textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)
textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)
textureGenMode coord :: 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 (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
EyeLinear' -> (Plane GLclampd -> TextureGenMode)
-> IO (Plane GLclampd) -> IO TextureGenMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Plane GLclampd -> TextureGenMode
EyeLinear (IO (Plane GLclampd) -> IO TextureGenMode)
-> IO (Plane GLclampd) -> IO TextureGenMode
forall a b. (a -> b) -> a -> b
$ TextureCoordName -> TextureGenParameter -> IO (Plane GLclampd)
getPlane TextureCoordName
coord TextureGenParameter
EyePlane
ObjectLinear' -> (Plane GLclampd -> TextureGenMode)
-> IO (Plane GLclampd) -> IO TextureGenMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Plane GLclampd -> TextureGenMode
ObjectLinear (IO (Plane GLclampd) -> IO TextureGenMode)
-> IO (Plane GLclampd) -> IO TextureGenMode
forall a b. (a -> b) -> a -> b
$ TextureCoordName -> TextureGenParameter -> IO (Plane GLclampd)
getPlane TextureCoordName
coord TextureGenParameter
ObjectPlane
SphereMap' -> TextureGenMode -> IO TextureGenMode
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
SphereMap
NormalMap' -> TextureGenMode -> IO TextureGenMode
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
NormalMap
ReflectionMap' -> TextureGenMode -> IO TextureGenMode
forall (m :: * -> *) a. Monad m => a -> m a
return TextureGenMode
ReflectionMap)
(\mode :: TextureGenMode
mode -> do
TextureCoordName -> TextureGenMode -> IO ()
setMode TextureCoordName
coord TextureGenMode
mode
case TextureGenMode
mode of
EyeLinear plane :: Plane GLclampd
plane -> TextureCoordName -> TextureGenParameter -> Plane GLclampd -> IO ()
setPlane TextureCoordName
coord TextureGenParameter
EyePlane Plane GLclampd
plane
ObjectLinear plane :: Plane GLclampd
plane -> TextureCoordName -> TextureGenParameter -> Plane GLclampd -> IO ()
setPlane TextureCoordName
coord TextureGenParameter
ObjectPlane Plane GLclampd
plane
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
textureCoordNameToEnableCap :: TextureCoordName -> EnableCap
textureCoordNameToEnableCap :: TextureCoordName -> EnableCap
textureCoordNameToEnableCap coord :: TextureCoordName
coord = case TextureCoordName
coord of
S -> EnableCap
CapTextureGenS
T -> EnableCap
CapTextureGenT
R -> EnableCap
CapTextureGenR
Q -> EnableCap
CapTextureGenQ
getMode :: TextureCoordName -> IO TextureGenMode'
getMode :: TextureCoordName -> IO TextureGenMode'
getMode coord :: 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
$ \buf :: 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 coord :: TextureCoordName
coord mode :: 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 GLclampd)
getPlane coord :: TextureCoordName
coord param :: TextureGenParameter
param = (Ptr (Plane GLclampd) -> IO (Plane GLclampd))
-> IO (Plane GLclampd)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Plane GLclampd) -> IO (Plane GLclampd))
-> IO (Plane GLclampd))
-> (Ptr (Plane GLclampd) -> IO (Plane GLclampd))
-> IO (Plane GLclampd)
forall a b. (a -> b) -> a -> b
$ \planeBuffer :: Ptr (Plane GLclampd)
planeBuffer -> do
GLenum -> GLenum -> Ptr GLclampd -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLclampd -> m ()
glGetTexGendv (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
(TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
param)
(Ptr (Plane GLclampd) -> Ptr GLclampd
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLclampd)
planeBuffer)
Ptr (Plane GLclampd) -> IO (Plane GLclampd)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Plane GLclampd)
planeBuffer
setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLclampd -> IO ()
setPlane coord :: TextureCoordName
coord param :: TextureGenParameter
param plane :: Plane GLclampd
plane =
Plane GLclampd -> (Ptr (Plane GLclampd) -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Plane GLclampd
plane ((Ptr (Plane GLclampd) -> IO ()) -> IO ())
-> (Ptr (Plane GLclampd) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \planeBuffer :: Ptr (Plane GLclampd)
planeBuffer ->
GLenum -> GLenum -> Ptr GLclampd -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLclampd -> m ()
glTexGendv (TextureCoordName -> GLenum
marshalTextureCoordName TextureCoordName
coord)
(TextureGenParameter -> GLenum
marshalTextureGenParameter TextureGenParameter
param)
(Ptr (Plane GLclampd) -> Ptr GLclampd
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLclampd)
planeBuffer)