{-# 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,
  )
where

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

-- | Choose the current matrix to be transformed

rlMatrixMode :: RLMatrixMode -> IO ()
rlMatrixMode :: RLMatrixMode -> IO ()
rlMatrixMode RLMatrixMode
mode = CInt -> IO ()
c'rlMatrixMode (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
angle) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (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 = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
left) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
right) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
bottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
top) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
znear) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
left) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
right) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
bottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
top) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
znear) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
r) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
g) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
r) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
g) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b) (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 = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CBool
c'rlEnableVertexArray (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 (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 (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 (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 (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 (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 (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 (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLTextureParam
param) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLTextureParam
param) (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 (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 (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

-- | 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 ()

-- | Set face culling mode

rlSetCullFace :: RLCullMode -> IO ()
rlSetCullFace :: RLCullMode -> IO ()
rlSetCullFace RLCullMode
mode = CInt -> IO ()
c'rlSetCullFace (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Enable wire mode

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

-- | Disable wire 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width)

-- | Get the line drawing width

rlGetLineWidth :: IO Float
rlGetLineWidth :: IO Float
rlGetLineWidth = forall a b. (Real a, Fractional b) => a -> b
realToFrac 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 = forall a. (Eq a, Num a) => a -> Bool
toBool 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcFactor) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstFactor) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcRGB) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstRGB) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glSrcAlpha) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glDstAlpha) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glEqRGB) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)

-- | Get default framebuffer width

rlGetFramebufferWidth :: IO Int
rlGetFramebufferWidth :: IO Int
rlGetFramebufferWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Get default framebuffer height

rlGetFramebufferHeight :: IO Int
rlGetFramebufferHeight :: IO Int
rlGetFramebufferHeight = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
32 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBuffers) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferElements) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Unload render batch system

rlUnloadRenderBatch :: RLRenderBatch -> IO ()
rlUnloadRenderBatch :: RLRenderBatch -> IO ()
rlUnloadRenderBatch RLRenderBatch
batch = 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 = 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall a. Ptr a
nullPtr
rlSetRenderBatchActive (Just RLRenderBatch
val) = do
  Ptr RLRenderBatch
ptr <- forall a. Storable a => IO (Ptr a)
malloc
  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 = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'rlCheckRenderBatchLimit (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 (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufferId) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufferId) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (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 (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 (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
compSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aType) (forall a. Num a => Bool -> a
fromBool Bool
normalized) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
attribType) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (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 =
  forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
buffer :: [CUShort])
    (CInt -> CInt -> Ptr () -> IO ()
c'rlDrawVertexArrayElements (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
buffer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count) (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 =
  forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
buffer :: [CUShort])
    ( \Ptr CUShort
p ->
        CInt -> CInt -> Ptr () -> CInt -> IO ()
c'rlDrawVertexArrayElementsInstanced (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
buffer) (forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray
      (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> CBool -> IO CUInt
c'rlLoadTextureDepth (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
l forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (CUShort
0 :: CUShort)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    (CUInt
0 :: CUInt)
    ( \Ptr CUInt
gif ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (CUInt
0 :: CUInt)
          ( \Ptr CUInt
gf ->
              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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) Ptr CUInt
gif Ptr CUInt
gf Ptr CUInt
gt
                    Integer
glInternalFormat <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gif
                    Integer
glFormat <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gf
                    Integer
glType <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
gt
                    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
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 (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) Ptr CInt
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format)
  Int
size <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> CInt -> IO CInt
c'rlGetPixelDataSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format)
  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
size (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 =
  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CInt -> CInt -> IO (Ptr CUChar)
c'rlReadScreenPixels (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (Int
width forall a. Num a => a -> a -> a
* Int
height 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CUInt
c'rlLoadFramebuffer (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fboId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
texId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachType
attachType) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachTextureType
texType) (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 = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CBool
c'rlFramebufferComplete (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 (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
vsCode (forall a. String -> (CString -> IO a) -> IO a
withCString String
fsCode 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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
shaderCode (\CString
s -> CString -> CInt -> IO CUInt
c'rlCompileShader CString
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> CUInt -> IO CUInt
c'rlLoadShaderProgram (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vsShaderId) (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 (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
uniformName (CUInt -> CString -> IO CInt
c'rlGetLocationUniform (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
attribName (CUInt -> CString -> IO CInt
c'rlGetLocationAttrib (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
dataType) (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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
mat (CInt -> Ptr Matrix -> IO ()
c'rlSetUniformMatrix (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) (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 = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
locs :: [CInt]) (CUInt -> Ptr CInt -> IO ()
c'rlSetShader (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CUInt
c'rlLoadComputeShaderProgram (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
groupX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
groupY) (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 =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Int
sizeOf a
sbData) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssboId) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
destId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
srcId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
destOffset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
srcOffset) (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CUInt
c'rlGetShaderBufferSize (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum RLPixelFormat
format) (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eye) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eye) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = 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 = 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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
right (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
left 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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
right (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
left 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 ()