{-# OPTIONS -Wall #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Raylib.Util.RLGL
  ( rlMatrixMode,
    rlPushMatrix,
    rlPopMatrix,
    rlLoadIdentity,
    rlTranslatef,
    rlRotatef,
    rlScalef,
    rlMultMatrixf,
    rlFrustum,
    rlOrtho,
    rlViewport,
    rlBegin,
    rlEnd,
    rlVertex2i,
    rlVertex2f,
    rlVertex3f,
    rlTexCoord2f,
    rlNormal3f,
    rlColor4ub,
    rlColor3f,
    rlColor4f,
    rlEnableVertexArray,
    rlDisableVertexArray,
    rlEnableVertexBuffer,
    rlDisableVertexBuffer,
    rlEnableVertexBufferElement,
    rlDisableVertexBufferElement,
    rlEnableVertexAttribute,
    rlDisableVertexAttribute,
    rlActiveTextureSlot,
    rlEnableTexture,
    rlDisableTexture,
    rlEnableTextureCubemap,
    rlDisableTextureCubemap,
    rlTextureParameters,
    rlCubemapParameters,
    rlEnableShader,
    rlDisableShader,
    rlEnableFramebuffer,
    rlDisableFramebuffer,
    rlActiveDrawBuffers,
    rlEnableColorBlend,
    rlDisableColorBlend,
    rlEnableDepthTest,
    rlDisableDepthTest,
    rlEnableDepthMask,
    rlDisableDepthMask,
    rlEnableBackfaceCulling,
    rlDisableBackfaceCulling,
    rlSetCullFace,
    rlEnableScissorTest,
    rlDisableScissorTest,
    rlScissor,
    rlEnableWireMode,
    rlDisableWireMode,
    rlSetLineWidth,
    rlGetLineWidth,
    rlEnableSmoothLines,
    rlDisableSmoothLines,
    rlEnableStereoRender,
    rlDisableStereoRender,
    rlIsStereoRenderEnabled,
    rlClearColor,
    rlClearScreenBuffers,
    rlCheckErrors,
    rlSetBlendMode,
    rlSetBlendFactors,
    rlSetBlendFactorsSeparate,
    rlglInit,
    rlglClose,
    rlLoadExtensions,
    rlGetVersion,
    rlSetFramebufferWidth,
    rlGetFramebufferWidth,
    rlSetFramebufferHeight,
    rlGetFramebufferHeight,
    rlGetTextureIdDefault,
    rlGetShaderIdDefault,
    rlGetShaderLocsDefault,
    rlLoadRenderBatch,
    rlUnloadRenderBatch,
    rlDrawRenderBatch,
    rlSetRenderBatchActive,
    rlDrawRenderBatchActive,
    rlCheckRenderBatchLimit,
    rlSetTexture,
    rlLoadVertexArray,
    rlLoadVertexBuffer,
    rlLoadVertexBufferElement,
    rlUpdateVertexBuffer,
    rlUpdateVertexBufferElements,
    rlUnloadVertexArray,
    rlUnloadVertexBuffer,
    rlSetVertexAttribute,
    rlSetVertexAttributeDivisor,
    rlSetVertexAttributeDefault,
    rlDrawVertexArray,
    rlDrawVertexArrayElements,
    rlDrawVertexArrayInstanced,
    rlDrawVertexArrayElementsInstanced,
    rlLoadTexture,
    rlLoadTextureDepth,
    rlLoadTextureCubemap,
    rlUpdateTexture,
    rlGetGlTextureFormats,
    rlGetPixelFormatName,
    rlUnloadTexture,
    rlGenTextureMipmaps,
    rlReadTexturePixels,
    rlReadScreenPixels,
    rlLoadFramebuffer,
    rlFramebufferAttach,
    rlFramebufferComplete,
    rlUnloadFramebuffer,
    rlLoadShaderCode,
    rlCompileShader,
    rlLoadShaderProgram,
    rlUnloadShaderProgram,
    rlGetLocationUniform,
    rlGetLocationAttrib,
    rlSetUniform,
    rlSetUniformMatrix,
    rlSetUniformSampler,
    rlSetShader,
    rlLoadComputeShaderProgram,
    rlComputeShaderDispatch,
    rlLoadShaderBuffer,
    rlUnloadShaderBuffer,
    rlUpdateShaderBuffer,
    rlBindShaderBuffer,
    rlCopyShaderBuffer,
    rlGetShaderBufferSize,
    rlBindImageTexture,
    rlGetMatrixModelview,
    rlGetMatrixProjection,
    rlGetMatrixTransform,
    rlGetMatrixProjectionStereo,
    rlGetMatrixViewOffsetStereo,
    rlSetMatrixProjection,
    rlSetMatrixModelview,
    rlSetMatrixProjectionStereo,
    rlSetMatrixViewOffsetStereo,
    rlLoadDrawCube,
    rlLoadDrawQuad,
    rlBlitFramebuffer,
    rlBindFramebuffer,
    rlColorMask,
    rlEnablePointMode
  )
where

import Foreign
  ( Ptr,
    Storable (peek, poke, sizeOf),
    Word8,
    castPtr,
    fromBool,
    malloc,
    nullPtr,
    toBool,
  )
import Foreign.C (CInt, CUChar, CUInt, CUShort, withCString)
import Raylib.ForeignUtil
  ( Freeable,
    configsToBitflag,
    pop,
    popCArray,
    withFreeable,
    withFreeableArray,
    withFreeableArrayLen,
  )
import Raylib.Native
  ( c'rlActiveDrawBuffers,
    c'rlActiveTextureSlot,
    c'rlBegin,
    c'rlBindFramebuffer,
    c'rlBindImageTexture,
    c'rlBindShaderBuffer,
    c'rlBlitFramebuffer,
    c'rlCheckRenderBatchLimit,
    c'rlClearColor,
    c'rlColor3f,
    c'rlColor4f,
    c'rlColor4ub,
    c'rlColorMask,
    c'rlCompileShader,
    c'rlComputeShaderDispatch,
    c'rlCopyShaderBuffer,
    c'rlCubemapParameters,
    c'rlDisableVertexAttribute,
    c'rlDrawRenderBatch,
    c'rlDrawVertexArray,
    c'rlDrawVertexArrayElements,
    c'rlDrawVertexArrayElementsInstanced,
    c'rlDrawVertexArrayInstanced,
    c'rlEnableFramebuffer,
    c'rlEnableShader,
    c'rlEnableTexture,
    c'rlEnableTextureCubemap,
    c'rlEnableVertexArray,
    c'rlEnableVertexAttribute,
    c'rlEnableVertexBuffer,
    c'rlEnableVertexBufferElement,
    c'rlFramebufferAttach,
    c'rlFramebufferComplete,
    c'rlFrustum,
    c'rlGenTextureMipmaps,
    c'rlGetFramebufferHeight,
    c'rlGetFramebufferWidth,
    c'rlGetGlTextureFormats,
    c'rlGetLineWidth,
    c'rlGetLocationAttrib,
    c'rlGetLocationUniform,
    c'rlGetMatrixModelview,
    c'rlGetMatrixProjection,
    c'rlGetMatrixProjectionStereo,
    c'rlGetMatrixTransform,
    c'rlGetMatrixViewOffsetStereo,
    c'rlGetPixelDataSize,
    c'rlGetShaderBufferSize,
    c'rlGetShaderIdDefault,
    c'rlGetShaderLocsDefault,
    c'rlGetTextureIdDefault,
    c'rlGetVersion,
    c'rlIsStereoRenderEnabled,
    c'rlLoadComputeShaderProgram,
    c'rlLoadExtensions,
    c'rlLoadFramebuffer,
    c'rlLoadRenderBatch,
    c'rlLoadShaderBuffer,
    c'rlLoadShaderCode,
    c'rlLoadShaderProgram,
    c'rlLoadTexture,
    c'rlLoadTextureCubemap,
    c'rlLoadTextureDepth,
    c'rlLoadVertexArray,
    c'rlLoadVertexBuffer,
    c'rlLoadVertexBufferElement,
    c'rlMatrixMode,
    c'rlMultMatrixf,
    c'rlNormal3f,
    c'rlOrtho,
    c'rlReadScreenPixels,
    c'rlReadTexturePixels,
    c'rlRotatef,
    c'rlScalef,
    c'rlScissor,
    c'rlSetBlendFactors,
    c'rlSetBlendFactorsSeparate,
    c'rlSetBlendMode,
    c'rlSetCullFace,
    c'rlSetFramebufferHeight,
    c'rlSetFramebufferWidth,
    c'rlSetLineWidth,
    c'rlSetMatrixModelview,
    c'rlSetMatrixProjection,
    c'rlSetMatrixProjectionStereo,
    c'rlSetMatrixViewOffsetStereo,
    c'rlSetRenderBatchActive,
    c'rlSetShader,
    c'rlSetTexture,
    c'rlSetUniform,
    c'rlSetUniformMatrix,
    c'rlSetUniformSampler,
    c'rlSetVertexAttribute,
    c'rlSetVertexAttributeDefault,
    c'rlSetVertexAttributeDivisor,
    c'rlTexCoord2f,
    c'rlTextureParameters,
    c'rlTranslatef,
    c'rlUnloadFramebuffer,
    c'rlUnloadRenderBatch,
    c'rlUnloadShaderBuffer,
    c'rlUnloadShaderProgram,
    c'rlUnloadTexture,
    c'rlUnloadVertexArray,
    c'rlUnloadVertexBuffer,
    c'rlUpdateShaderBuffer,
    c'rlUpdateTexture,
    c'rlUpdateVertexBuffer,
    c'rlUpdateVertexBufferElements,
    c'rlVertex2f,
    c'rlVertex2i,
    c'rlVertex3f,
    c'rlViewport,
    c'rlglInit,
  )
import Raylib.Types
  ( Matrix,
    RLBitField,
    RLBlendMode,
    RLBufferHint,
    RLCullMode,
    RLDrawMode,
    RLFramebufferAttachTextureType,
    RLFramebufferAttachType,
    RLMatrixMode,
    RLPixelFormat (..),
    RLRenderBatch,
    RLShaderType,
    RLTextureParam,
    ShaderUniformDataV,
    unpackShaderUniformDataV,
  )

-- | Choose the current matrix to be transformed

rlMatrixMode :: RLMatrixMode -> IO ()
rlMatrixMode :: RLMatrixMode -> IO ()
rlMatrixMode RLMatrixMode
mode = CInt -> IO ()
c'rlMatrixMode (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLMatrixMode -> Int
forall a. Enum a => a -> Int
fromEnum RLMatrixMode
mode)

-- | Push the current matrix to stack

foreign import ccall safe "rlgl.h rlPushMatrix" rlPushMatrix :: IO ()

-- | Pop latest inserted matrix from stack

foreign import ccall safe "rlgl.h rlPopMatrix" rlPopMatrix :: IO ()

-- | Reset current matrix to identity matrix

foreign import ccall safe "rlgl.h rlLoadIdentity" rlLoadIdentity :: IO ()

-- | Multiply the current matrix by a translation matrix

rlTranslatef :: Float -> Float -> Float -> IO ()
rlTranslatef :: Float -> Float -> Float -> IO ()
rlTranslatef Float
x Float
y Float
z = CFloat -> CFloat -> CFloat -> IO ()
c'rlTranslatef (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- | Multiply the current matrix by a rotation matrix

rlRotatef :: Float -> Float -> Float -> Float -> IO ()
rlRotatef :: Float -> Float -> Float -> Float -> IO ()
rlRotatef Float
angle Float
x Float
y Float
z = CFloat -> CFloat -> CFloat -> CFloat -> IO ()
c'rlRotatef (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
angle) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- | Multiply the current matrix by a scaling matrix

rlScalef :: Float -> Float -> Float -> IO ()
rlScalef :: Float -> Float -> Float -> IO ()
rlScalef Float
x Float
y Float
z = CFloat -> CFloat -> CFloat -> IO ()
c'rlScalef (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- | Multiply the current matrix by another matrix

rlMultMatrixf :: [Float] -> IO ()
rlMultMatrixf :: [Float] -> IO ()
rlMultMatrixf [Float]
matf = [CFloat] -> (Ptr CFloat -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray ((Float -> CFloat) -> [Float] -> [CFloat]
forall a b. (a -> b) -> [a] -> [b]
map Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
matf) Ptr CFloat -> IO ()
c'rlMultMatrixf

-- | Multiply the current matrix by a perspective matrix generated by parameters

rlFrustum :: Double -> Double -> Double -> Double -> Double -> Double -> IO ()
rlFrustum :: Double -> Double -> Double -> Double -> Double -> Double -> IO ()
rlFrustum Double
left Double
right Double
bottom Double
top Double
znear Double
zfar = CDouble
-> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()
c'rlFrustum (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
left) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
right) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
bottom) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
top) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
znear) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
zfar)

-- | Multiply the current matrix by an orthographic matrix generated by parameters

rlOrtho :: Double -> Double -> Double -> Double -> Double -> Double -> IO ()
rlOrtho :: Double -> Double -> Double -> Double -> Double -> Double -> IO ()
rlOrtho Double
left Double
right Double
bottom Double
top Double
znear Double
zfar = CDouble
-> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()
c'rlOrtho (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
left) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
right) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
bottom) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
top) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
znear) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
zfar)

-- | Set the viewport area

rlViewport :: Int -> Int -> Int -> Int -> IO ()
rlViewport :: Int -> Int -> Int -> Int -> IO ()
rlViewport Int
x Int
y Int
width Int
height = CInt -> CInt -> CInt -> CInt -> IO ()
c'rlViewport (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Initialize drawing mode (how to organize vertex)

rlBegin :: RLDrawMode -> IO ()
rlBegin :: RLDrawMode -> IO ()
rlBegin RLDrawMode
mode = CInt -> IO ()
c'rlBegin (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLDrawMode -> Int
forall a. Enum a => a -> Int
fromEnum RLDrawMode
mode)

-- | Finish vertex providing

foreign import ccall safe "rlgl.h rlEnd" rlEnd :: IO ()

-- | Define one vertex (position) - 2 int

rlVertex2i :: Int -> Int -> IO ()
rlVertex2i :: Int -> Int -> IO ()
rlVertex2i Int
x Int
y = CInt -> CInt -> IO ()
c'rlVertex2i (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Define one vertex (position) - 2 float

rlVertex2f :: Float -> Float -> IO ()
rlVertex2f :: Float -> Float -> IO ()
rlVertex2f Float
x Float
y = CFloat -> CFloat -> IO ()
c'rlVertex2f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y)

-- | Define one vertex (position) - 3 float

rlVertex3f :: Float -> Float -> Float -> IO ()
rlVertex3f :: Float -> Float -> Float -> IO ()
rlVertex3f Float
x Float
y Float
z = CFloat -> CFloat -> CFloat -> IO ()
c'rlVertex3f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- | Define one vertex (texture coordinate) - 2 float

rlTexCoord2f :: Float -> Float -> IO ()
rlTexCoord2f :: Float -> Float -> IO ()
rlTexCoord2f Float
x Float
y = CFloat -> CFloat -> IO ()
c'rlTexCoord2f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y)

-- | Define one vertex (normal) - 3 float

rlNormal3f :: Float -> Float -> Float -> IO ()
rlNormal3f :: Float -> Float -> Float -> IO ()
rlNormal3f Float
x Float
y Float
z = CFloat -> CFloat -> CFloat -> IO ()
c'rlNormal3f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- | Define one vertex (color) - 4 byte

rlColor4ub :: Word8 -> Word8 -> Word8 -> Word8 -> IO ()
rlColor4ub :: Word8 -> Word8 -> Word8 -> Word8 -> IO ()
rlColor4ub Word8
r Word8
g Word8
b Word8
a = CUChar -> CUChar -> CUChar -> CUChar -> IO ()
c'rlColor4ub (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a)

-- | Define one vertex (color) - 3 float

rlColor3f :: Float -> Float -> Float -> IO ()
rlColor3f :: Float -> Float -> Float -> IO ()
rlColor3f Float
r Float
g Float
b = CFloat -> CFloat -> CFloat -> IO ()
c'rlColor3f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
r) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
g) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b)

-- | Define one vertex (color) - 4 float

rlColor4f :: Float -> Float -> Float -> Float -> IO ()
rlColor4f :: Float -> Float -> Float -> Float -> IO ()
rlColor4f Float
r Float
g Float
b Float
a = CFloat -> CFloat -> CFloat -> CFloat -> IO ()
c'rlColor4f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
r) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
g) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a)

-- | Enable vertex array (VAO, if supported)

rlEnableVertexArray :: Integer -> IO Bool
rlEnableVertexArray :: Integer -> IO Bool
rlEnableVertexArray Integer
vaoId = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CBool
c'rlEnableVertexArray (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vaoId)

-- | Disable vertex array (VAO, if supported)

foreign import ccall safe "rlgl.h rlDisableVertexArray" rlDisableVertexArray :: IO ()

-- | Enable vertex buffer (VBO)

rlEnableVertexBuffer :: Integer -> IO ()
rlEnableVertexBuffer :: Integer -> IO ()
rlEnableVertexBuffer Integer
vboId = CUInt -> IO ()
c'rlEnableVertexBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vboId)

-- | Disable vertex buffer (VBO)

foreign import ccall safe "rlgl.h rlDisableVertexBuffer" rlDisableVertexBuffer :: IO ()

-- | Enable vertex buffer element (VBO element)

rlEnableVertexBufferElement :: Integer -> IO ()
rlEnableVertexBufferElement :: Integer -> IO ()
rlEnableVertexBufferElement Integer
vboeId = CUInt -> IO ()
c'rlEnableVertexBufferElement (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vboeId)

-- | Disable vertex buffer element (VBO element)

foreign import ccall safe "rlgl.h rlDisableVertexBufferElement" rlDisableVertexBufferElement :: IO ()

-- | Enable vertex attribute index

rlEnableVertexAttribute :: Integer -> IO ()
rlEnableVertexAttribute :: Integer -> IO ()
rlEnableVertexAttribute Integer
index = CUInt -> IO ()
c'rlEnableVertexAttribute (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index)

-- | Disable vertex attribute index

rlDisableVertexAttribute :: Integer -> IO ()
rlDisableVertexAttribute :: Integer -> IO ()
rlDisableVertexAttribute Integer
index = CUInt -> IO ()
c'rlDisableVertexAttribute (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index)

-- OpenGL 1.1 only, not implemented

-- -- | Enable attribute state pointer

-- rlEnableStatePointer :: Int -> Ptr () -> IO ()


-- -- | Disable attribute state pointer

-- rlDisableStatePointer :: Int -> IO ()


-- | Select and active a texture slot

rlActiveTextureSlot :: Int -> IO ()
rlActiveTextureSlot :: Int -> IO ()
rlActiveTextureSlot Int
slot = CInt -> IO ()
c'rlActiveTextureSlot (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slot)

-- | Enable texture

rlEnableTexture :: Integer -> IO ()
rlEnableTexture :: Integer -> IO ()
rlEnableTexture Integer
tId = CUInt -> IO ()
c'rlEnableTexture (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId)

-- | Disable texture

foreign import ccall safe "rlgl.h rlDisableTexture" rlDisableTexture :: IO ()

-- | Enable texture cubemap

rlEnableTextureCubemap :: Integer -> IO ()
rlEnableTextureCubemap :: Integer -> IO ()
rlEnableTextureCubemap Integer
tId = CUInt -> IO ()
c'rlEnableTextureCubemap (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId)

-- | Disable texture cubemap

foreign import ccall safe "rlgl.h rlDisableTextureCubemap" rlDisableTextureCubemap :: IO ()

-- | Set texture parameters (filter, wrap)

rlTextureParameters :: Integer -> RLTextureParam -> Int -> IO ()
rlTextureParameters :: Integer -> RLTextureParam -> Int -> IO ()
rlTextureParameters Integer
tId RLTextureParam
param Int
value = CUInt -> CInt -> CInt -> IO ()
c'rlTextureParameters (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLTextureParam -> Int
forall a. Enum a => a -> Int
fromEnum RLTextureParam
param) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)

-- | Set cubemap parameters (filter, wrap)

rlCubemapParameters :: Integer -> RLTextureParam -> Int -> IO ()
rlCubemapParameters :: Integer -> RLTextureParam -> Int -> IO ()
rlCubemapParameters Integer
tId RLTextureParam
param Int
value = CUInt -> CInt -> CInt -> IO ()
c'rlCubemapParameters (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLTextureParam -> Int
forall a. Enum a => a -> Int
fromEnum RLTextureParam
param) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)

-- | Enable shader program

rlEnableShader :: Integer -> IO ()
rlEnableShader :: Integer -> IO ()
rlEnableShader Integer
sId = CUInt -> IO ()
c'rlEnableShader (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sId)

-- | Disable shader program

foreign import ccall safe "rlgl.h rlDisableShader" rlDisableShader :: IO ()

-- | Enable render texture (fbo)

rlEnableFramebuffer :: Integer -> IO ()
rlEnableFramebuffer :: Integer -> IO ()
rlEnableFramebuffer Integer
fboId = CUInt -> IO ()
c'rlEnableFramebuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fboId)

-- | Disable render texture (fbo), return to default framebuffer

foreign import ccall safe "rlgl.h rlDisableFramebuffer" rlDisableFramebuffer :: IO ()

-- | Activate multiple draw color buffers

rlActiveDrawBuffers :: Int -> IO ()
rlActiveDrawBuffers :: Int -> IO ()
rlActiveDrawBuffers Int
count = CInt -> IO ()
c'rlActiveDrawBuffers (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

-- | Blit active framebuffer to main framebuffer

rlBlitFramebuffer :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [RLBitField] -> IO ()
rlBlitFramebuffer :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> [RLBitField]
-> IO ()
rlBlitFramebuffer Int
srcX Int
srcY Int
srcWidth Int
srcHeight Int
dstX Int
dstY Int
dstWidth Int
dstHeight [RLBitField]
bufferMask =
  CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
c'rlBlitFramebuffer (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcWidth) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcHeight) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dstX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dstY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dstWidth) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dstHeight) (Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([RLBitField] -> Integer
forall a. Enum a => [a] -> Integer
configsToBitflag [RLBitField]
bufferMask))

-- | Bind framebuffer (FBO)

rlBindFramebuffer :: Integer -> Integer -> IO ()
rlBindFramebuffer :: Integer -> Integer -> IO ()
rlBindFramebuffer Integer
target Integer
framebuffer = CUInt -> CUInt -> IO ()
c'rlBindFramebuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
target) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
framebuffer)

-- | Enable color blending

foreign import ccall safe "rlgl.h rlEnableColorBlend" rlEnableColorBlend :: IO ()

-- | Disable color blending

foreign import ccall safe "rlgl.h rlDisableColorBlend" rlDisableColorBlend :: IO ()

-- | Enable depth test

foreign import ccall safe "rlgl.h rlEnableDepthTest" rlEnableDepthTest :: IO ()

-- | Disable depth test

foreign import ccall safe "rlgl.h rlDisableDepthTest" rlDisableDepthTest :: IO ()

-- | Enable depth write

foreign import ccall safe "rlgl.h rlEnableDepthMask" rlEnableDepthMask :: IO ()

-- | Disable depth write

foreign import ccall safe "rlgl.h rlDisableDepthMask" rlDisableDepthMask :: IO ()

-- | Enable backface culling

foreign import ccall safe "rlgl.h rlEnableBackfaceCulling" rlEnableBackfaceCulling :: IO ()

-- | Disable backface culling

foreign import ccall safe "rlgl.h rlDisableBackfaceCulling" rlDisableBackfaceCulling :: IO ()

-- | Color mask control

rlColorMask :: Bool -> Bool -> Bool -> Bool -> IO ()
rlColorMask :: Bool -> Bool -> Bool -> Bool -> IO ()
rlColorMask Bool
r Bool
g Bool
b Bool
a = CBool -> CBool -> CBool -> CBool -> IO ()
c'rlColorMask (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
r) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
g) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
b) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
a)

-- | Set face culling mode

rlSetCullFace :: RLCullMode -> IO ()
rlSetCullFace :: RLCullMode -> IO ()
rlSetCullFace RLCullMode
mode = CInt -> IO ()
c'rlSetCullFace (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLCullMode -> Int
forall a. Enum a => a -> Int
fromEnum RLCullMode
mode)

-- | Enable scissor test

foreign import ccall safe "rlgl.h rlEnableScissorTest" rlEnableScissorTest :: IO ()

-- | Disable scissor test

foreign import ccall safe "rlgl.h rlDisableScissorTest" rlDisableScissorTest :: IO ()

-- | Scissor test

rlScissor :: Int -> Int -> Int -> Int -> IO ()
rlScissor :: Int -> Int -> Int -> Int -> IO ()
rlScissor Int
x Int
y Int
width Int
height = CInt -> CInt -> CInt -> CInt -> IO ()
c'rlScissor (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Enable wire mode

foreign import ccall safe "rlgl.h rlEnableWireMode" rlEnableWireMode :: IO ()

-- | Enable point mode

foreign import ccall safe "rlgl.h rlEnablePointMode" rlEnablePointMode :: IO ()

-- | Disable wire and point mode

foreign import ccall safe "rlgl.h rlDisableWireMode" rlDisableWireMode :: IO ()

-- | Set the line drawing width

rlSetLineWidth :: Float -> IO ()
rlSetLineWidth :: Float -> IO ()
rlSetLineWidth Float
width = CFloat -> IO ()
c'rlSetLineWidth (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width)

-- | Get the line drawing width

rlGetLineWidth :: IO Float
rlGetLineWidth :: IO Float
rlGetLineWidth = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> IO CFloat -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'rlGetLineWidth

-- | Enable line aliasing

foreign import ccall safe "rlgl.h rlEnableSmoothLines" rlEnableSmoothLines :: IO ()

-- | Disable line aliasing

foreign import ccall safe "rlgl.h rlDisableSmoothLines" rlDisableSmoothLines :: IO ()

-- | Enable stereo rendering

foreign import ccall safe "rlgl.h rlEnableStereoRender" rlEnableStereoRender :: IO ()

-- | Disable stereo rendering

foreign import ccall safe "rlgl.h rlDisableStereoRender" rlDisableStereoRender :: IO ()

-- | Check if stereo render is enabled

rlIsStereoRenderEnabled :: IO Bool
rlIsStereoRenderEnabled :: IO Bool
rlIsStereoRenderEnabled = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'rlIsStereoRenderEnabled

-- | Clear color buffer with color

rlClearColor :: Word8 -> Word8 -> Word8 -> Word8 -> IO ()
rlClearColor :: Word8 -> Word8 -> Word8 -> Word8 -> IO ()
rlClearColor Word8
r Word8
g Word8
b Word8
a = CUChar -> CUChar -> CUChar -> CUChar -> IO ()
c'rlClearColor (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a)

-- | Clear used screen buffers (color and depth)

foreign import ccall safe "rlgl.h rlClearScreenBuffers" rlClearScreenBuffers :: IO ()

-- | Check and log OpenGL error codes

foreign import ccall safe "rlgl.h rlCheckErrors" rlCheckErrors :: IO ()

-- | Set blending mode

rlSetBlendMode :: RLBlendMode -> IO ()
rlSetBlendMode :: RLBlendMode -> IO ()
rlSetBlendMode RLBlendMode
mode = CInt -> IO ()
c'rlSetBlendMode (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLBlendMode -> Int
forall a. Enum a => a -> Int
fromEnum RLBlendMode
mode)

-- | Set blending mode factor and equation (using OpenGL factors)

rlSetBlendFactors :: Int -> Int -> Int -> IO ()
rlSetBlendFactors :: Int -> Int -> Int -> IO ()
rlSetBlendFactors Int
glSrcFactor Int
glDstFactor Int
glEquation = CInt -> CInt -> CInt -> IO ()
c'rlSetBlendFactors (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcFactor) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstFactor) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glEquation)

-- | Set blending mode factors and equations separately (using OpenGL factors)

rlSetBlendFactorsSeparate :: Int -> Int -> Int -> Int -> Int -> Int -> IO ()
rlSetBlendFactorsSeparate :: Int -> Int -> Int -> Int -> Int -> Int -> IO ()
rlSetBlendFactorsSeparate Int
glSrcRGB Int
glDstRGB Int
glSrcAlpha Int
glDstAlpha Int
glEqRGB Int
glEqAlpha =
  CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
c'rlSetBlendFactorsSeparate (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcRGB) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstRGB) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcAlpha) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstAlpha) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glEqRGB) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glEqAlpha)

-- | Initialize rlgl (buffers, shaders, textures, states)

rlglInit :: Int -> Int -> IO ()
rlglInit :: Int -> Int -> IO ()
rlglInit Int
width Int
height = CInt -> CInt -> IO ()
c'rlglInit (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | De-initialize rlgl (buffers, shaders, textures)

foreign import ccall safe "rlgl.h rlglClose" rlglClose :: IO ()

-- | Load OpenGL extensions (loader function required)

rlLoadExtensions :: Ptr () -> IO ()
rlLoadExtensions :: Ptr () -> IO ()
rlLoadExtensions = Ptr () -> IO ()
c'rlLoadExtensions

-- | Get current OpenGL version

rlGetVersion :: IO Int
rlGetVersion :: IO Int
rlGetVersion = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'rlGetVersion

-- | Set current framebuffer width

rlSetFramebufferWidth :: Int -> IO ()
rlSetFramebufferWidth :: Int -> IO ()
rlSetFramebufferWidth Int
width = CInt -> IO ()
c'rlSetFramebufferWidth (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)

-- | Get default framebuffer width

rlGetFramebufferWidth :: IO Int
rlGetFramebufferWidth :: IO Int
rlGetFramebufferWidth = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'rlGetFramebufferWidth

-- | Set current framebuffer height

rlSetFramebufferHeight :: Int -> IO ()
rlSetFramebufferHeight :: Int -> IO ()
rlSetFramebufferHeight Int
height = CInt -> IO ()
c'rlSetFramebufferHeight (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Get default framebuffer height

rlGetFramebufferHeight :: IO Int
rlGetFramebufferHeight :: IO Int
rlGetFramebufferHeight = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'rlGetFramebufferHeight

-- | Get default texture id

rlGetTextureIdDefault :: IO Integer
rlGetTextureIdDefault :: IO Integer
rlGetTextureIdDefault = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CUInt
c'rlGetTextureIdDefault

-- | Get default shader id

rlGetShaderIdDefault :: IO Integer
rlGetShaderIdDefault :: IO Integer
rlGetShaderIdDefault = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CUInt
c'rlGetShaderIdDefault

-- | Get default shader locations

rlGetShaderLocsDefault :: IO [Int]
rlGetShaderLocsDefault :: IO [Int]
rlGetShaderLocsDefault = (CInt -> Int) -> [CInt] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CInt] -> [Int]) -> IO [CInt] -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Ptr CInt -> IO [CInt]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
32 (Ptr CInt -> IO [CInt]) -> IO (Ptr CInt) -> IO [CInt]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr CInt)
c'rlGetShaderLocsDefault)

-- | Load a render batch system

rlLoadRenderBatch :: Int -> Int -> IO RLRenderBatch
rlLoadRenderBatch :: Int -> Int -> IO RLRenderBatch
rlLoadRenderBatch Int
numBuffers Int
bufferElements = CInt -> CInt -> IO (Ptr RLRenderBatch)
c'rlLoadRenderBatch (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBuffers) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferElements) IO (Ptr RLRenderBatch)
-> (Ptr RLRenderBatch -> IO RLRenderBatch) -> IO RLRenderBatch
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RLRenderBatch -> IO RLRenderBatch
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Unload render batch system

rlUnloadRenderBatch :: RLRenderBatch -> IO ()
rlUnloadRenderBatch :: RLRenderBatch -> IO ()
rlUnloadRenderBatch RLRenderBatch
batch = RLRenderBatch -> (Ptr RLRenderBatch -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable RLRenderBatch
batch Ptr RLRenderBatch -> IO ()
c'rlUnloadRenderBatch

-- | Draw render batch data (Update->Draw->Reset)

rlDrawRenderBatch :: RLRenderBatch -> IO RLRenderBatch
rlDrawRenderBatch :: RLRenderBatch -> IO RLRenderBatch
rlDrawRenderBatch RLRenderBatch
batch = RLRenderBatch
-> (Ptr RLRenderBatch -> IO RLRenderBatch) -> IO RLRenderBatch
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable RLRenderBatch
batch (\Ptr RLRenderBatch
p -> Ptr RLRenderBatch -> IO ()
c'rlDrawRenderBatch Ptr RLRenderBatch
p IO () -> IO RLRenderBatch -> IO RLRenderBatch
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr RLRenderBatch -> IO RLRenderBatch
forall a. Storable a => Ptr a -> IO a
peek Ptr RLRenderBatch
p)

-- | Set the active render batch for rlgl (NULL for default internal)

rlSetRenderBatchActive :: Maybe RLRenderBatch -> IO ()
rlSetRenderBatchActive :: Maybe RLRenderBatch -> IO ()
rlSetRenderBatchActive Maybe RLRenderBatch
Nothing = Ptr RLRenderBatch -> IO ()
c'rlSetRenderBatchActive Ptr RLRenderBatch
forall a. Ptr a
nullPtr
rlSetRenderBatchActive (Just RLRenderBatch
val) = do
  Ptr RLRenderBatch
ptr <- IO (Ptr RLRenderBatch)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr RLRenderBatch -> RLRenderBatch -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr RLRenderBatch
ptr RLRenderBatch
val
  Ptr RLRenderBatch -> IO ()
c'rlSetRenderBatchActive Ptr RLRenderBatch
ptr

-- | Update and draw internal render batch

foreign import ccall safe "rlgl.h rlDrawRenderBatchActive" rlDrawRenderBatchActive :: IO ()

-- | Check internal buffer overflow for a given number of vertex

rlCheckRenderBatchLimit :: Int -> IO Bool
rlCheckRenderBatchLimit :: Int -> IO Bool
rlCheckRenderBatchLimit Int
vCount = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'rlCheckRenderBatchLimit (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vCount)

-- | Set current texture for render batch and check buffers limits

rlSetTexture :: Integer -> IO ()
rlSetTexture :: Integer -> IO ()
rlSetTexture Integer
tId = CUInt -> IO ()
c'rlSetTexture (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId)

-- | Load vertex array (vao) if supported

rlLoadVertexArray :: IO Integer
rlLoadVertexArray :: IO Integer
rlLoadVertexArray = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CUInt
c'rlLoadVertexArray

-- | Load a vertex buffer attribute

rlLoadVertexBuffer :: (Freeable a, Storable a) => [a] -> Int -> Bool -> IO Integer
rlLoadVertexBuffer :: forall a.
(Freeable a, Storable a) =>
[a] -> Int -> Bool -> IO Integer
rlLoadVertexBuffer [a]
buffer Int
size Bool
dynamic =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> (Ptr a -> IO CUInt) -> IO CUInt
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
buffer (\Ptr a
p -> Ptr () -> CInt -> CBool -> IO CUInt
c'rlLoadVertexBuffer (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
dynamic))

-- | Load a new attributes element buffer (typically the buffer data will be a list of `Int`s)

rlLoadVertexBufferElement :: (Freeable a, Storable a) => [a] -> Int -> Bool -> IO Integer
rlLoadVertexBufferElement :: forall a.
(Freeable a, Storable a) =>
[a] -> Int -> Bool -> IO Integer
rlLoadVertexBufferElement [a]
buffer Int
size Bool
dynamic =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> (Ptr a -> IO CUInt) -> IO CUInt
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
buffer (\Ptr a
p -> Ptr () -> CInt -> CBool -> IO CUInt
c'rlLoadVertexBufferElement (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
dynamic))

-- | Update GPU buffer with new data.

-- WARNING: Fails on empty list

rlUpdateVertexBuffer :: (Freeable a, Storable a) => Integer -> [a] -> Int -> Int -> IO ()
rlUpdateVertexBuffer :: forall a.
(Freeable a, Storable a) =>
Integer -> [a] -> Int -> Int -> IO ()
rlUpdateVertexBuffer Integer
bufferId [a]
bufferData Int
size Int
offset =
  [a] -> (Ptr a -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
bufferData (\Ptr a
p -> CUInt -> Ptr () -> CInt -> CInt -> IO ()
c'rlUpdateVertexBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufferId) (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))

-- | Update vertex buffer elements with new data (typically the buffer data will be a list of `Int`s).

-- WARNING: Fails on empty list

rlUpdateVertexBufferElements :: (Freeable a, Storable a) => Integer -> [a] -> Int -> Int -> IO ()
rlUpdateVertexBufferElements :: forall a.
(Freeable a, Storable a) =>
Integer -> [a] -> Int -> Int -> IO ()
rlUpdateVertexBufferElements Integer
bufferId [a]
bufferData Int
size Int
offset =
  [a] -> (Ptr a -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
bufferData (\Ptr a
p -> CUInt -> Ptr () -> CInt -> CInt -> IO ()
c'rlUpdateVertexBufferElements (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufferId) (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))

-- | Unload vertex array object (VAO)

rlUnloadVertexArray :: Integer -> IO ()
rlUnloadVertexArray :: Integer -> IO ()
rlUnloadVertexArray Integer
vaoId = CUInt -> IO ()
c'rlUnloadVertexArray (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vaoId)

-- | Unload vertex buffer (VBO)

rlUnloadVertexBuffer :: Integer -> IO ()
rlUnloadVertexBuffer :: Integer -> IO ()
rlUnloadVertexBuffer Integer
vboId = CUInt -> IO ()
c'rlUnloadVertexBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vboId)

-- TODO: improve types for the functions below


-- | Set vertex attribute (the type must be a valid GLenum value)

rlSetVertexAttribute :: Integer -> Int -> Int -> Bool -> Int -> Ptr () -> IO ()
rlSetVertexAttribute :: Integer -> Int -> Int -> Bool -> Int -> Ptr () -> IO ()
rlSetVertexAttribute Integer
index Int
compSize Int
aType Bool
normalized Int
stride =
  CUInt -> CInt -> CInt -> CBool -> CInt -> Ptr () -> IO ()
c'rlSetVertexAttribute (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
compSize) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aType) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
normalized) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride)

-- | Set vertex attribute divisor

rlSetVertexAttributeDivisor :: Integer -> Int -> IO ()
rlSetVertexAttributeDivisor :: Integer -> Int -> IO ()
rlSetVertexAttributeDivisor Integer
index Int
divisor = CUInt -> CInt -> IO ()
c'rlSetVertexAttributeDivisor (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
divisor)

-- | Set vertex attribute default value

rlSetVertexAttributeDefault :: Int -> Ptr () -> Int -> Int -> IO ()
rlSetVertexAttributeDefault :: Int -> Ptr () -> Int -> Int -> IO ()
rlSetVertexAttributeDefault Int
locIndex Ptr ()
value Int
attribType Int
count =
  CInt -> Ptr () -> CInt -> CInt -> IO ()
c'rlSetVertexAttributeDefault (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
value (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
attribType) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

-- | Draw vertex array

rlDrawVertexArray :: Int -> Int -> IO ()
rlDrawVertexArray :: Int -> Int -> IO ()
rlDrawVertexArray Int
offset Int
count = CInt -> CInt -> IO ()
c'rlDrawVertexArray (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

-- | Draw vertex array elements

rlDrawVertexArrayElements :: Int -> [Int] -> IO ()
rlDrawVertexArrayElements :: Int -> [Int] -> IO ()
rlDrawVertexArrayElements Int
offset [Int]
buffer =
  [CUShort] -> (Ptr CUShort -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
    ((Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
buffer :: [CUShort])
    (CInt -> CInt -> Ptr () -> IO ()
c'rlDrawVertexArrayElements (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
buffer) (Ptr () -> IO ())
-> (Ptr CUShort -> Ptr ()) -> Ptr CUShort -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CUShort -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr)

-- | Draw vertex array instanced

rlDrawVertexArrayInstanced :: Int -> Int -> Int -> IO ()
rlDrawVertexArrayInstanced :: Int -> Int -> Int -> IO ()
rlDrawVertexArrayInstanced Int
offset Int
count Int
instances = CInt -> CInt -> CInt -> IO ()
c'rlDrawVertexArrayInstanced (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
instances)

-- | Draw vertex array elements instanced

rlDrawVertexArrayElementsInstanced :: Int -> [Int] -> Int -> IO ()
rlDrawVertexArrayElementsInstanced :: Int -> [Int] -> Int -> IO ()
rlDrawVertexArrayElementsInstanced Int
offset [Int]
buffer Int
instances =
  [CUShort] -> (Ptr CUShort -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
    ((Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
buffer :: [CUShort])
    ( \Ptr CUShort
p ->
        CInt -> CInt -> Ptr () -> CInt -> IO ()
c'rlDrawVertexArrayElementsInstanced (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
buffer) (Ptr CUShort -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
instances)
    )

-- | Load texture in GPU

rlLoadTexture :: [Int] -> Int -> Int -> RLPixelFormat -> Int -> IO Integer
rlLoadTexture :: [Int] -> Int -> Int -> RLPixelFormat -> Int -> IO Integer
rlLoadTexture [Int]
tData Int
width Int
height RLPixelFormat
format Int
mipmapCount =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CUShort] -> (Ptr CUShort -> IO CUInt) -> IO CUInt
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
      ((Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
tData :: [CUShort])
      (\Ptr CUShort
p -> Ptr () -> CInt -> CInt -> CInt -> CInt -> IO CUInt
c'rlLoadTexture (Ptr CUShort -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mipmapCount))

-- | Load depth texture/renderbuffer (to be attached to fbo)

rlLoadTextureDepth :: Int -> Int -> Bool -> IO Integer
rlLoadTextureDepth :: Int -> Int -> Bool -> IO Integer
rlLoadTextureDepth Int
width Int
height Bool
useRenderBuffer = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> CBool -> IO CUInt
c'rlLoadTextureDepth (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
useRenderBuffer)

-- | Load texture cubemap

rlLoadTextureCubemap :: [Int] -> RLPixelFormat -> IO Integer
rlLoadTextureCubemap :: [Int] -> RLPixelFormat -> IO Integer
rlLoadTextureCubemap [Int]
tData RLPixelFormat
format =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CUShort] -> (Int -> Ptr CUShort -> IO CUInt) -> IO CUInt
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen ((Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
tData :: [CUShort]) (\Int
l Ptr CUShort
p -> Ptr () -> CInt -> CInt -> IO CUInt
c'rlLoadTextureCubemap (Ptr CUShort -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUShort -> Int
forall a. Storable a => a -> Int
sizeOf (CUShort
0 :: CUShort)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format))

-- | Update GPU texture with new data

rlUpdateTexture :: (Freeable a, Storable a) => Integer -> Int -> Int -> Int -> Int -> RLPixelFormat -> [a] -> IO ()
rlUpdateTexture :: forall a.
(Freeable a, Storable a) =>
Integer
-> Int -> Int -> Int -> Int -> RLPixelFormat -> [a] -> IO ()
rlUpdateTexture Integer
tId Int
offsetX Int
offsetY Int
width Int
height RLPixelFormat
format [a]
tData =
  [a] -> (Ptr a -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
tData (CUInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO ()
c'rlUpdateTexture (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) (Ptr () -> IO ()) -> (Ptr a -> Ptr ()) -> Ptr a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr)

-- | Get OpenGL internal formats

rlGetGlTextureFormats ::
  RLPixelFormat ->
  -- | Return type as tuple: (glInternalFormat, glFormat, glType)

  IO (Integer, Integer, Integer)
rlGetGlTextureFormats :: RLPixelFormat -> IO (Integer, Integer, Integer)
rlGetGlTextureFormats RLPixelFormat
format =
  CUInt
-> (Ptr CUInt -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    (CUInt
0 :: CUInt)
    ( \Ptr CUInt
gif ->
        CUInt
-> (Ptr CUInt -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (CUInt
0 :: CUInt)
          ( \Ptr CUInt
gf ->
              CUInt
-> (Ptr CUInt -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (CUInt
0 :: CUInt)
                ( \Ptr CUInt
gt -> do
                    CInt -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
c'rlGetGlTextureFormats (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) Ptr CUInt
gif Ptr CUInt
gf Ptr CUInt
gt
                    Integer
glInternalFormat <- CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gif
                    Integer
glFormat <- CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gf
                    Integer
glType <- CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gt
                    (Integer, Integer, Integer) -> IO (Integer, Integer, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
glInternalFormat, Integer
glFormat, Integer
glType)
                )
          )
    )

-- | Get name string for pixel format

rlGetPixelFormatName :: RLPixelFormat -> String
rlGetPixelFormatName :: RLPixelFormat -> String
rlGetPixelFormatName RLPixelFormat
format =
  case RLPixelFormat
format of
    RLPixelFormat
RLPixelFormatUncompressedGrayscale -> String
"GRAYSCALE"
    RLPixelFormat
RLPixelFormatUncompressedGrayAlpha -> String
"GRAY_ALPHA"
    RLPixelFormat
RLPixelFormatUncompressedR5G6B5 -> String
"R5G6B5"
    RLPixelFormat
RLPixelFormatUncompressedR8G8B8 -> String
"R8G8B8"
    RLPixelFormat
RLPixelFormatUncompressedR5G5B5A1 -> String
"R5G5B5A1"
    RLPixelFormat
RLPixelFormatUncompressedR4G4B4A4 -> String
"R4G4B4A4"
    RLPixelFormat
RLPixelFormatUncompressedR8G8B8A8 -> String
"R8G8B8A8"
    RLPixelFormat
RLPixelFormatUncompressedR32 -> String
"R32"
    RLPixelFormat
RLPixelFormatUncompressedR32G32B32 -> String
"R32G32B32"
    RLPixelFormat
RLPixelFormatUncompressedR32G32B32A32 -> String
"R32G32B32A32"
    RLPixelFormat
RLPixelFormatUncompressedR16 -> String
"R16"
    RLPixelFormat
RLPixelFormatUncompressedR16G16B16 -> String
"R16G16B16"
    RLPixelFormat
RLPixelFormatUncompressedR16G16B16A16 -> String
"R16G16B16A16"
    RLPixelFormat
RLPixelFormatCompressedDxt1Rgb -> String
"DXT1_RGB"
    RLPixelFormat
RLPixelFormatCompressedDxt1Rgba -> String
"DXT1_RGBA"
    RLPixelFormat
RLPixelFormatCompressedDxt3Rgba -> String
"DXT3_RGBA"
    RLPixelFormat
RLPixelFormatCompressedDxt5Rgba -> String
"DXT5_RGBA"
    RLPixelFormat
RLPixelFormatCompressedEtc1Rgb -> String
"ETC1_RGB"
    RLPixelFormat
RLPixelFormatCompressedEtc2Rgb -> String
"ETC2_RGB"
    RLPixelFormat
RLPixelFormatCompressedEtc2EacRgba -> String
"ETC2_RGBA"
    RLPixelFormat
RLPixelFormatCompressedPvrtRgb -> String
"PVRT_RGB"
    RLPixelFormat
RLPixelFormatCompressedPvrtRgba -> String
"PVRT_RGBA"
    RLPixelFormat
RLPixelFormatCompressedAstc4x4Rgba -> String
"ASTC_4x4_RGBA"
    RLPixelFormat
RLPixelFormatCompressedAstc8x8Rgba -> String
"ASTC_8x8_RGBA"

-- | Unload texture from GPU memory

rlUnloadTexture :: Integer -> IO ()
rlUnloadTexture :: Integer -> IO ()
rlUnloadTexture Integer
tId = CUInt -> IO ()
c'rlUnloadTexture (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId)

-- | Generate mipmap data for selected texture

rlGenTextureMipmaps ::
  Integer ->
  Int ->
  Int ->
  RLPixelFormat ->
  -- | The number of mipmaps generated

  IO Int
rlGenTextureMipmaps :: Integer -> Int -> Int -> RLPixelFormat -> IO Int
rlGenTextureMipmaps Integer
tId Int
width Int
height RLPixelFormat
format =
  CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> (Ptr CInt -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable (CInt
0 :: CInt) (\Ptr CInt
p -> CUInt -> CInt -> CInt -> CInt -> Ptr CInt -> IO ()
c'rlGenTextureMipmaps (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) Ptr CInt
p IO () -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p)

-- | Read texture pixel data

rlReadTexturePixels :: Integer -> Int -> Int -> RLPixelFormat -> IO [Word8]
rlReadTexturePixels :: Integer -> Int -> Int -> RLPixelFormat -> IO [Word8]
rlReadTexturePixels Integer
tId Int
width Int
height RLPixelFormat
format = do
  Ptr ()
ptr <- CUInt -> CInt -> CInt -> CInt -> IO (Ptr ())
c'rlReadTexturePixels (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format)
  Int
size <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> CInt -> IO CInt
c'rlGetPixelDataSize (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format)
  (CUChar -> Word8) -> [CUChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUChar] -> [Word8]) -> IO [CUChar] -> IO [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CUChar -> IO [CUChar]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
size (Ptr () -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr :: Ptr CUChar)

-- | Read screen pixel data (color buffer)

rlReadScreenPixels :: Int -> Int -> IO [Word8]
rlReadScreenPixels :: Int -> Int -> IO [Word8]
rlReadScreenPixels Int
width Int
height =
  (CUChar -> Word8) -> [CUChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUChar] -> [Word8]) -> IO [CUChar] -> IO [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CInt -> CInt -> IO (Ptr CUChar)
c'rlReadScreenPixels (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) IO (Ptr CUChar) -> (Ptr CUChar -> IO [CUChar]) -> IO [CUChar]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr CUChar -> IO [CUChar]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4))

-- | Load an empty framebuffer

rlLoadFramebuffer :: Int -> Int -> IO Integer
rlLoadFramebuffer :: Int -> Int -> IO Integer
rlLoadFramebuffer Int
width Int
height = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CUInt
c'rlLoadFramebuffer (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Attach texture/renderbuffer to a framebuffer

rlFramebufferAttach :: Integer -> Integer -> RLFramebufferAttachType -> RLFramebufferAttachTextureType -> Int -> IO ()
rlFramebufferAttach :: Integer
-> Integer
-> RLFramebufferAttachType
-> RLFramebufferAttachTextureType
-> Int
-> IO ()
rlFramebufferAttach Integer
fboId Integer
texId RLFramebufferAttachType
attachType RLFramebufferAttachTextureType
texType Int
mipLevel =
  CUInt -> CUInt -> CInt -> CInt -> CInt -> IO ()
c'rlFramebufferAttach (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fboId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
texId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLFramebufferAttachType -> Int
forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachType
attachType) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLFramebufferAttachTextureType -> Int
forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachTextureType
texType) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mipLevel)

-- | Verify framebuffer is complete

rlFramebufferComplete :: Integer -> IO Bool
rlFramebufferComplete :: Integer -> IO Bool
rlFramebufferComplete Integer
fboId = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CBool
c'rlFramebufferComplete (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fboId)

-- | Delete framebuffer from GPU

rlUnloadFramebuffer :: Integer -> IO ()
rlUnloadFramebuffer :: Integer -> IO ()
rlUnloadFramebuffer Integer
fboId = CUInt -> IO ()
c'rlUnloadFramebuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fboId)

-- | Load shader from code strings

rlLoadShaderCode :: String -> String -> IO Integer
rlLoadShaderCode :: String -> String -> IO Integer
rlLoadShaderCode String
vsCode String
fsCode =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO CUInt) -> IO CUInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
vsCode (String -> (CString -> IO CUInt) -> IO CUInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
fsCode ((CString -> IO CUInt) -> IO CUInt)
-> (CString -> CString -> IO CUInt) -> CString -> IO CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO CUInt
c'rlLoadShaderCode)

-- | Compile custom shader and return shader id

rlCompileShader :: String -> RLShaderType -> IO Integer
rlCompileShader :: String -> RLShaderType -> IO Integer
rlCompileShader String
shaderCode RLShaderType
shaderType =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO CUInt) -> IO CUInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
shaderCode (\CString
s -> CString -> CInt -> IO CUInt
c'rlCompileShader CString
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLShaderType -> Int
forall a. Enum a => a -> Int
fromEnum RLShaderType
shaderType))

-- | Load custom shader program

rlLoadShaderProgram :: Integer -> Integer -> IO Integer
rlLoadShaderProgram :: Integer -> Integer -> IO Integer
rlLoadShaderProgram Integer
vsShaderId Integer
fsShaderId =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> CUInt -> IO CUInt
c'rlLoadShaderProgram (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vsShaderId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fsShaderId)

-- | Unload shader program

rlUnloadShaderProgram :: Integer -> IO ()
rlUnloadShaderProgram :: Integer -> IO ()
rlUnloadShaderProgram Integer
shaderId = CUInt -> IO ()
c'rlUnloadShaderProgram (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
shaderId)

-- | Get shader location uniform

rlGetLocationUniform :: Integer -> String -> IO Int
rlGetLocationUniform :: Integer -> String -> IO Int
rlGetLocationUniform Integer
shaderId String
uniformName =
  CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
uniformName (CUInt -> CString -> IO CInt
c'rlGetLocationUniform (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
shaderId))

-- | Get shader location attribute

rlGetLocationAttrib :: Integer -> String -> IO Int
rlGetLocationAttrib :: Integer -> String -> IO Int
rlGetLocationAttrib Integer
shaderId String
attribName =
  CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
attribName (CUInt -> CString -> IO CInt
c'rlGetLocationAttrib (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
shaderId))

-- | Set shader value uniform

rlSetUniform :: Int -> ShaderUniformDataV -> IO ()
rlSetUniform :: Int -> ShaderUniformDataV -> IO ()
rlSetUniform Int
locIndex ShaderUniformDataV
value = do
  (ShaderUniformDataType
dataType, Ptr ()
ptr, Int
count) <- ShaderUniformDataV -> IO (ShaderUniformDataType, Ptr (), Int)
unpackShaderUniformDataV ShaderUniformDataV
value
  CInt -> Ptr () -> CInt -> CInt -> IO ()
c'rlSetUniform (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ ShaderUniformDataType -> Int
forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
dataType) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

-- | Set shader value matrix

rlSetUniformMatrix :: Int -> Matrix -> IO ()
rlSetUniformMatrix :: Int -> Matrix -> IO ()
rlSetUniformMatrix Int
locIndex Matrix
mat = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
mat (CInt -> Ptr Matrix -> IO ()
c'rlSetUniformMatrix (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex))

-- | Set shader value sampler

rlSetUniformSampler :: Int -> Integer -> IO ()
rlSetUniformSampler :: Int -> Integer -> IO ()
rlSetUniformSampler Int
locIndex Integer
textureId = CInt -> CUInt -> IO ()
c'rlSetUniformSampler (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
textureId)

-- | Set shader currently active (id and locations)

rlSetShader :: Integer -> [Int] -> IO ()
rlSetShader :: Integer -> [Int] -> IO ()
rlSetShader Integer
shaderId [Int]
locs = [CInt] -> (Ptr CInt -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray ((Int -> CInt) -> [Int] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
locs :: [CInt]) (CUInt -> Ptr CInt -> IO ()
c'rlSetShader (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
shaderId))

-- | Load compute shader program

rlLoadComputeShaderProgram :: Integer -> IO Integer
rlLoadComputeShaderProgram :: Integer -> IO Integer
rlLoadComputeShaderProgram Integer
shaderId = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CUInt
c'rlLoadComputeShaderProgram (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
shaderId)

-- | Dispatch compute shader (equivalent to *draw* for graphics pipeline)

rlComputeShaderDispatch :: Integer -> Integer -> Integer -> IO ()
rlComputeShaderDispatch :: Integer -> Integer -> Integer -> IO ()
rlComputeShaderDispatch Integer
groupX Integer
groupY Integer
groupZ =
  CUInt -> CUInt -> CUInt -> IO ()
c'rlComputeShaderDispatch (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
groupX) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
groupY) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
groupZ)

-- | Load shader storage buffer object (SSBO).

-- WARNING: Fails if list is empty

rlLoadShaderBuffer :: (Freeable a, Storable a) => Integer -> [a] -> RLBufferHint -> IO Integer
rlLoadShaderBuffer :: forall a.
(Freeable a, Storable a) =>
Integer -> [a] -> RLBufferHint -> IO Integer
rlLoadShaderBuffer Integer
size [a]
bufferData RLBufferHint
hint =
  CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> (Ptr a -> IO CUInt) -> IO CUInt
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
bufferData (\Ptr a
p -> CUInt -> Ptr () -> CInt -> IO CUInt
c'rlLoadShaderBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLBufferHint -> Int
forall a. Enum a => a -> Int
fromEnum RLBufferHint
hint))

-- | Unload shader storage buffer object (SSBO)

rlUnloadShaderBuffer :: Integer -> IO ()
rlUnloadShaderBuffer :: Integer -> IO ()
rlUnloadShaderBuffer Integer
ssboId = CUInt -> IO ()
c'rlUnloadShaderBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId)

-- | Update SSBO buffer data

rlUpdateShaderBuffer :: (Freeable a, Storable a) => Integer -> a -> Integer -> IO ()
rlUpdateShaderBuffer :: forall a.
(Freeable a, Storable a) =>
Integer -> a -> Integer -> IO ()
rlUpdateShaderBuffer Integer
ssboId a
sbData Integer
offset =
  a -> (Ptr a -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable a
sbData (\Ptr a
p -> CUInt -> Ptr () -> CUInt -> CUInt -> IO ()
c'rlUpdateShaderBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId) (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Storable a => a -> Int
sizeOf a
sbData) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset))

-- | Bind SSBO buffer

rlBindShaderBuffer :: Integer -> Integer -> IO ()
rlBindShaderBuffer :: Integer -> Integer -> IO ()
rlBindShaderBuffer Integer
ssboId Integer
index = CUInt -> CUInt -> IO ()
c'rlBindShaderBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index)

-- Read SSBO buffer data (GPU->CPU)

-- Skipped because I'm not sure how to bind this correctly

-- rlReadShaderBuffer :: Integer -> Integer -> Integer -> IO (Ptr ())

-- rlReadShaderBuffer ssboId count offset = undefined


-- | Copy SSBO data between buffers

rlCopyShaderBuffer :: Integer -> Integer -> Integer -> Integer -> Integer -> IO ()
rlCopyShaderBuffer :: Integer -> Integer -> Integer -> Integer -> Integer -> IO ()
rlCopyShaderBuffer Integer
destId Integer
srcId Integer
destOffset Integer
srcOffset Integer
count = CUInt -> CUInt -> CUInt -> CUInt -> CUInt -> IO ()
c'rlCopyShaderBuffer (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
destId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
srcId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
destOffset) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
srcOffset) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count)

-- | Get SSBO buffer size

rlGetShaderBufferSize :: Integer -> IO Integer
rlGetShaderBufferSize :: Integer -> IO Integer
rlGetShaderBufferSize Integer
ssboId = CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Integer) -> IO CUInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CUInt
c'rlGetShaderBufferSize (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId)

-- | Bind image texture

rlBindImageTexture :: Integer -> Integer -> RLPixelFormat -> Bool -> IO ()
rlBindImageTexture :: Integer -> Integer -> RLPixelFormat -> Bool -> IO ()
rlBindImageTexture Integer
tId Integer
index RLPixelFormat
format Bool
readonly = CUInt -> CUInt -> CInt -> CBool -> IO ()
c'rlBindImageTexture (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ RLPixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
readonly)

-- | Get internal modelview matrix

rlGetMatrixModelview :: IO Matrix
rlGetMatrixModelview :: IO Matrix
rlGetMatrixModelview = IO (Ptr Matrix)
c'rlGetMatrixModelview IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Get internal projection matrix

rlGetMatrixProjection :: IO Matrix
rlGetMatrixProjection :: IO Matrix
rlGetMatrixProjection = IO (Ptr Matrix)
c'rlGetMatrixProjection IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Get internal accumulated transform matrix

rlGetMatrixTransform :: IO Matrix
rlGetMatrixTransform :: IO Matrix
rlGetMatrixTransform = IO (Ptr Matrix)
c'rlGetMatrixTransform IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Get internal projection matrix for stereo render (selected eye)

rlGetMatrixProjectionStereo :: Int -> IO Matrix
rlGetMatrixProjectionStereo :: Int -> IO Matrix
rlGetMatrixProjectionStereo Int
eye = CInt -> IO (Ptr Matrix)
c'rlGetMatrixProjectionStereo (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eye) IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Get internal view offset matrix for stereo render (selected eye)

rlGetMatrixViewOffsetStereo :: Int -> IO Matrix
rlGetMatrixViewOffsetStereo :: Int -> IO Matrix
rlGetMatrixViewOffsetStereo Int
eye = CInt -> IO (Ptr Matrix)
c'rlGetMatrixViewOffsetStereo (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eye) IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Set a custom projection matrix (replaces internal projection matrix)

rlSetMatrixProjection :: Matrix -> IO ()
rlSetMatrixProjection :: Matrix -> IO ()
rlSetMatrixProjection Matrix
matrix = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
matrix Ptr Matrix -> IO ()
c'rlSetMatrixProjection

-- | Set a custom modelview matrix (replaces internal modelview matrix)

rlSetMatrixModelview :: Matrix -> IO ()
rlSetMatrixModelview :: Matrix -> IO ()
rlSetMatrixModelview Matrix
matrix = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
matrix Ptr Matrix -> IO ()
c'rlSetMatrixModelview

-- | Set eyes projection matrices for stereo rendering

rlSetMatrixProjectionStereo :: Matrix -> Matrix -> IO ()
rlSetMatrixProjectionStereo :: Matrix -> Matrix -> IO ()
rlSetMatrixProjectionStereo Matrix
right Matrix
left = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
right (Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
left ((Ptr Matrix -> IO ()) -> IO ())
-> (Ptr Matrix -> Ptr Matrix -> IO ()) -> Ptr Matrix -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Matrix -> Ptr Matrix -> IO ()
c'rlSetMatrixProjectionStereo)

-- | Set eyes view offsets matrices for stereo rendering

rlSetMatrixViewOffsetStereo :: Matrix -> Matrix -> IO ()
rlSetMatrixViewOffsetStereo :: Matrix -> Matrix -> IO ()
rlSetMatrixViewOffsetStereo Matrix
right Matrix
left = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
right (Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
left ((Ptr Matrix -> IO ()) -> IO ())
-> (Ptr Matrix -> Ptr Matrix -> IO ()) -> Ptr Matrix -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Matrix -> Ptr Matrix -> IO ()
c'rlSetMatrixViewOffsetStereo)

-- | Load and draw a cube

foreign import ccall safe "rlgl.h rlLoadDrawCube" rlLoadDrawCube :: IO ()

-- | Load and draw a quad

foreign import ccall safe "rlgl.h rlLoadDrawQuad" rlLoadDrawQuad :: IO ()