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

module Raylib.Internal (WindowResources(..), defaultWindowResources, unloadSingleShader, unloadSingleTexture, unloadSingleFrameBuffer, unloadSingleVaoId, unloadSingleVboIdList, unloadSingleCtxDataPtr, unloadSingleAudioBuffer, unloadShaders, unloadTextures, unloadFrameBuffers, unloadVaoIds, unloadVboIds, unloadCtxData, unloadAudioBuffers, addShaderId, addTextureId, addFrameBuffer, addVaoId, addVboIds, addCtxData, addAudioBuffer, c'rlGetShaderIdDefault, getPixelDataSize) where

import Control.Monad (forM_, unless, when)
import Data.IORef (IORef, modifyIORef, readIORef, newIORef)
import Data.List (delete)
import Data.Map (Map)
import Foreign (Ptr)
import Foreign.C (CInt (..), CUInt (..))
import GHC.IO (unsafePerformIO)
import qualified Data.Map as Map

data WindowResources = WindowResources
  { WindowResources -> IORef [CUInt]
shaderIds :: IORef [CUInt],
    WindowResources -> IORef (Map Integer (Map String Int))
shaderLocations :: IORef (Map Integer (Map String Int)),
    WindowResources -> IORef [CUInt]
textureIds :: IORef [CUInt],
    WindowResources -> IORef [CUInt]
frameBuffers :: IORef [CUInt],
    WindowResources -> IORef [CUInt]
vaoIds :: IORef [CUInt],
    WindowResources -> IORef [CUInt]
vboIds :: IORef [CUInt],
    WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs :: IORef [(CInt, Ptr ())],
    WindowResources -> IORef [Ptr ()]
audioBuffers :: IORef [Ptr ()]
  }

defaultWindowResources :: IO WindowResources
defaultWindowResources :: IO WindowResources
defaultWindowResources = do
  IORef [CUInt]
sIds <- forall a. a -> IO (IORef a)
newIORef []
  IORef (Map Integer (Map String Int))
sLocs <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
  IORef [CUInt]
tIds <- forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
fbs <- forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
vaos <- forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
vbos <- forall a. a -> IO (IORef a)
newIORef []
  IORef [(CInt, Ptr ())]
cdps <- forall a. a -> IO (IORef a)
newIORef []
  IORef [Ptr ()]
aBufs <- forall a. a -> IO (IORef a)
newIORef []
  forall (m :: * -> *) a. Monad m => a -> m a
return WindowResources {
    shaderIds :: IORef [CUInt]
shaderIds = IORef [CUInt]
sIds,
    shaderLocations :: IORef (Map Integer (Map String Int))
shaderLocations = IORef (Map Integer (Map String Int))
sLocs,
    textureIds :: IORef [CUInt]
textureIds = IORef [CUInt]
tIds,
    frameBuffers :: IORef [CUInt]
frameBuffers = IORef [CUInt]
fbs,
    vaoIds :: IORef [CUInt]
vaoIds = IORef [CUInt]
vaos,
    vboIds :: IORef [CUInt]
vboIds = IORef [CUInt]
vbos,
    ctxDataPtrs :: IORef [(CInt, Ptr ())]
ctxDataPtrs = IORef [(CInt, Ptr ())]
cdps,
    audioBuffers :: IORef [Ptr ()]
audioBuffers = IORef [Ptr ()]
aBufs
  }

unloadSingleShader :: (Integral a) => a -> WindowResources -> IO ()
unloadSingleShader :: forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleShader a
sId' WindowResources
wr = do
  CUInt
shaderIdDefault <- IO CUInt
c'rlGetShaderIdDefault
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CUInt
sId forall a. Eq a => a -> a -> Bool
== CUInt
shaderIdDefault) (CUInt -> IO ()
c'rlUnloadShaderProgram CUInt
sId)
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
shaderIds WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete CUInt
sId)
  where
    sId :: CUInt
sId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sId'

unloadSingleTexture :: (Integral a) => a -> WindowResources -> IO ()
unloadSingleTexture :: forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture a
tId' WindowResources
wr = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tId forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadTexture CUInt
tId)
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
textureIds WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete CUInt
tId)
  where
    tId :: CUInt
tId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tId'

unloadSingleFrameBuffer :: (Integral a) => a -> WindowResources -> IO ()
unloadSingleFrameBuffer :: forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleFrameBuffer a
fbId' WindowResources
wr = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
fbId forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadFramebuffer CUInt
fbId)
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
frameBuffers WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete CUInt
fbId)
  where
    fbId :: CUInt
fbId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
fbId'

unloadSingleVaoId :: (Integral a) => a -> WindowResources -> IO ()
unloadSingleVaoId :: forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleVaoId a
vaoId' WindowResources
wr = do
  CUInt -> IO ()
c'rlUnloadVertexArray CUInt
vaoId
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vaoIds WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete CUInt
vaoId)
  where
    vaoId :: CUInt
vaoId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
vaoId'

unloadSingleVboIdList :: (Integral a) => Maybe [a] -> WindowResources -> IO ()
unloadSingleVboIdList :: forall a. Integral a => Maybe [a] -> WindowResources -> IO ()
unloadSingleVboIdList Maybe [a]
Nothing WindowResources
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unloadSingleVboIdList (Just [a]
vboIdList') WindowResources
wr = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    [CUInt]
vboIdList
    ( \CUInt
vboId -> do
        CUInt -> IO ()
c'rlUnloadVertexBuffer CUInt
vboId
        forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vboIds WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete CUInt
vboId)
    )
  where
    vboIdList :: [CUInt]
vboIdList = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
vboIdList'

unloadSingleCtxDataPtr :: (Integral a) => a -> Ptr () -> WindowResources -> IO ()
unloadSingleCtxDataPtr :: forall a. Integral a => a -> Ptr () -> WindowResources -> IO ()
unloadSingleCtxDataPtr a
ctxType' Ptr ()
ctxData WindowResources
wr = do
  CInt -> Ptr () -> IO ()
c'unloadMusicStreamData CInt
ctxType Ptr ()
ctxData
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete (CInt
ctxType, Ptr ()
ctxData))
  where
    ctxType :: CInt
ctxType = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ctxType'

unloadSingleAudioBuffer :: Ptr () -> WindowResources -> IO ()
unloadSingleAudioBuffer :: Ptr () -> WindowResources -> IO ()
unloadSingleAudioBuffer Ptr ()
buffer WindowResources
wr = do
  Ptr () -> IO ()
c'unloadAudioBuffer Ptr ()
buffer
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
audioBuffers WindowResources
wr) (forall a. Eq a => a -> [a] -> [a]
delete Ptr ()
buffer)

unloadShaders :: WindowResources -> IO ()
unloadShaders :: WindowResources -> IO ()
unloadShaders WindowResources
wr = do
  CUInt
shaderIdDefault <- IO CUInt
c'rlGetShaderIdDefault
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [CUInt]
shaderIds WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUInt]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
vals (\CUInt
sId -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CUInt
sId forall a. Eq a => a -> a -> Bool
== CUInt
shaderIdDefault) (CUInt -> IO ()
c'rlUnloadShaderProgram CUInt
sId))
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: SHADER: h-raylib successfully auto-unloaded shaders (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadTextures :: WindowResources -> IO ()
unloadTextures :: WindowResources -> IO ()
unloadTextures WindowResources
wr = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [CUInt]
textureIds WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUInt]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
vals (\CUInt
tId -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tId forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadTexture CUInt
tId))
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: TEXTURE: h-raylib successfully auto-unloaded textures (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadFrameBuffers :: WindowResources -> IO ()
unloadFrameBuffers :: WindowResources -> IO ()
unloadFrameBuffers WindowResources
wr = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [CUInt]
frameBuffers WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUInt]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
vals (\CUInt
fbId -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
fbId forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadFramebuffer CUInt
fbId))
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: FBO: h-raylib successfully auto-unloaded frame buffers (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadVaoIds :: WindowResources -> IO ()
unloadVaoIds :: WindowResources -> IO ()
unloadVaoIds WindowResources
wr = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [CUInt]
vaoIds WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUInt]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
vals CUInt -> IO ()
c'rlUnloadVertexArray
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: VAO: h-raylib successfully auto-unloaded vertex arrays (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadVboIds :: WindowResources -> IO ()
unloadVboIds :: WindowResources -> IO ()
unloadVboIds WindowResources
wr = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [CUInt]
vboIds WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUInt]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
vals CUInt -> IO ()
c'rlUnloadVertexBuffer
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: VBO: h-raylib successfully auto-unloaded vertex buffers (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadCtxData :: WindowResources -> IO ()
unloadCtxData :: WindowResources -> IO ()
unloadCtxData WindowResources
wr = do
  [(CInt, Ptr ())]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CInt, Ptr ())]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(CInt, Ptr ())]
vals forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CInt -> Ptr () -> IO ()
c'unloadMusicStreamData
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: AUDIO: h-raylib successfully auto-unloaded music data (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadAudioBuffers :: WindowResources -> IO ()
unloadAudioBuffers :: WindowResources -> IO ()
unloadAudioBuffers WindowResources
wr = do
  [Ptr ()]
vals <- forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [Ptr ()]
audioBuffers WindowResources
wr)
  let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr ()]
vals
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Ptr ()]
vals Ptr () -> IO ()
c'unloadAudioBuffer
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"INFO: AUDIO: h-raylib successfully auto-unloaded audio buffers (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

addShaderId :: (Integral a) => a -> WindowResources -> IO ()
addShaderId :: forall a. Integral a => a -> WindowResources -> IO ()
addShaderId a
sId' WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
shaderIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
sId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
sId forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    sId :: CUInt
sId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sId'

addTextureId :: (Integral a) => a -> WindowResources -> IO ()
addTextureId :: forall a. Integral a => a -> WindowResources -> IO ()
addTextureId a
tId' WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
textureIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
tId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
tId forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    tId :: CUInt
tId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tId'

addFrameBuffer :: (Integral a) => a -> WindowResources -> IO ()
addFrameBuffer :: forall a. Integral a => a -> WindowResources -> IO ()
addFrameBuffer a
fbId' WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
frameBuffers WindowResources
wr) (\[CUInt]
xs -> if CUInt
fbId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
fbId forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    fbId :: CUInt
fbId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
fbId'

addVaoId :: (Integral a) => a -> WindowResources -> IO ()
addVaoId :: forall a. Integral a => a -> WindowResources -> IO ()
addVaoId a
vaoId' WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vaoIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
vaoId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
vaoId forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    vaoId :: CUInt
vaoId = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
vaoId'

addVboIds :: (Integral a) => Maybe [a] -> WindowResources -> IO ()
addVboIds :: forall a. Integral a => Maybe [a] -> WindowResources -> IO ()
addVboIds Maybe [a]
Nothing WindowResources
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
addVboIds (Just [a]
bIds') WindowResources
wr = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
bIds (\CUInt
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vboIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
x forall a. a -> [a] -> [a]
: [CUInt]
xs))
  where
    bIds :: [CUInt]
bIds = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
bIds'

addCtxData :: (Integral a) => a -> Ptr () -> WindowResources -> IO ()
addCtxData :: forall a. Integral a => a -> Ptr () -> WindowResources -> IO ()
addCtxData a
ctxType' Ptr ()
ctxData WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs WindowResources
wr) (\[(CInt, Ptr ())]
xs -> if (CInt
ctxType, Ptr ()
ctxData) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(CInt, Ptr ())]
xs then [(CInt, Ptr ())]
xs else (CInt
ctxType, Ptr ()
ctxData) forall a. a -> [a] -> [a]
: [(CInt, Ptr ())]
xs)
  where
    ctxType :: CInt
ctxType = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ctxType'

addAudioBuffer :: Ptr () -> WindowResources -> IO ()
addAudioBuffer :: Ptr () -> WindowResources -> IO ()
addAudioBuffer Ptr ()
buffer WindowResources
wr = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
audioBuffers WindowResources
wr) (\[Ptr ()]
xs -> if Ptr ()
buffer forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ptr ()]
xs then [Ptr ()]
xs else Ptr ()
buffer forall a. a -> [a] -> [a]
: [Ptr ()]
xs)

foreign import ccall safe "rlgl.h rlGetShaderIdDefault" c'rlGetShaderIdDefault :: IO CUInt

foreign import ccall safe "rlgl.h rlUnloadShaderProgram" c'rlUnloadShaderProgram :: CUInt -> IO ()

foreign import ccall safe "rlgl.h rlUnloadTexture" c'rlUnloadTexture :: CUInt -> IO ()

foreign import ccall safe "rlgl.h rlUnloadFramebuffer" c'rlUnloadFramebuffer :: CUInt -> IO ()

foreign import ccall safe "rlgl.h rlUnloadVertexArray" c'rlUnloadVertexArray :: CUInt -> IO ()

foreign import ccall safe "rlgl.h rlUnloadVertexBuffer" c'rlUnloadVertexBuffer :: CUInt -> IO ()

foreign import ccall safe "rl_internal.h UnloadMusicStreamData" c'unloadMusicStreamData :: CInt -> Ptr () -> IO ()

foreign import ccall safe "rl_internal.h UnloadAudioBuffer_" c'unloadAudioBuffer :: Ptr () -> IO ()

foreign import ccall safe "raylib.h GetPixelDataSize"
  c'getPixelDataSize ::
    CInt -> CInt -> CInt -> IO CInt

getPixelDataSize :: Int -> Int -> Int -> Int
getPixelDataSize :: Int -> Int -> Int -> Int
getPixelDataSize Int
width Int
height Int
format = forall a. IO a -> a
unsafePerformIO (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'getPixelDataSize (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 Int
format))