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

module Raylib.Internal (shaderLocations, 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, newIORef, readIORef)
import Data.List (delete)
import Data.Map (Map)
import qualified Data.Map as Map
import Foreign (Ptr)
import Foreign.C (CInt (..), CUInt (..))
import GHC.IO (unsafePerformIO)

shaderIds :: IORef [CUInt]
{-# NOINLINE shaderIds #-}
shaderIds :: IORef [CUInt]
shaderIds = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

shaderLocations :: IORef (Map Integer (Map String Int))
{-# NOINLINE shaderLocations #-}
shaderLocations :: IORef (Map Integer (Map String Int))
shaderLocations = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty

textureIds :: IORef [CUInt]
{-# NOINLINE textureIds #-}
textureIds :: IORef [CUInt]
textureIds = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

frameBuffers :: IORef [CUInt]
{-# NOINLINE frameBuffers #-}
frameBuffers :: IORef [CUInt]
frameBuffers = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

vaoIds :: IORef [CUInt]
{-# NOINLINE vaoIds #-}
vaoIds :: IORef [CUInt]
vaoIds = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

vboIds :: IORef [CUInt]
{-# NOINLINE vboIds #-}
vboIds :: IORef [CUInt]
vboIds = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

ctxDataPtrs :: IORef [(CInt, Ptr ())]
{-# NOINLINE ctxDataPtrs #-}
ctxDataPtrs :: IORef [(CInt, Ptr ())]
ctxDataPtrs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

audioBuffers :: IORef [Ptr ()]
{-# NOINLINE audioBuffers #-}
audioBuffers :: IORef [Ptr ()]
audioBuffers = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []

unloadSingleShader :: (Integral a) => a -> IO ()
unloadSingleShader :: forall a. Integral a => a -> IO ()
unloadSingleShader a
sId' = 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 IORef [CUInt]
shaderIds (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 -> IO ()
unloadSingleTexture :: forall a. Integral a => a -> IO ()
unloadSingleTexture a
tId' = 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 IORef [CUInt]
textureIds (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 -> IO ()
unloadSingleFrameBuffer :: forall a. Integral a => a -> IO ()
unloadSingleFrameBuffer a
fbId' = 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 IORef [CUInt]
frameBuffers (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 -> IO ()
unloadSingleVaoId :: forall a. Integral a => a -> IO ()
unloadSingleVaoId a
vaoId' = do
  CUInt -> IO ()
c'rlUnloadVertexArray CUInt
vaoId
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CUInt]
vaoIds (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] -> IO ()
unloadSingleVboIdList :: forall a. Integral a => Maybe [a] -> IO ()
unloadSingleVboIdList Maybe [a]
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unloadSingleVboIdList (Just [a]
vboIdList') = 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 IORef [CUInt]
vboIds (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 () -> IO ()
unloadSingleCtxDataPtr :: forall a. Integral a => a -> Ptr () -> IO ()
unloadSingleCtxDataPtr a
ctxType' Ptr ()
ctxData = do
  CInt -> Ptr () -> IO ()
c'unloadMusicStreamData CInt
ctxType Ptr ()
ctxData
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(CInt, Ptr ())]
ctxDataPtrs (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 () -> IO ()
unloadSingleAudioBuffer :: Ptr () -> IO ()
unloadSingleAudioBuffer Ptr ()
buffer = do
  Ptr () -> IO ()
c'unloadAudioBuffer Ptr ()
buffer
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [Ptr ()]
audioBuffers (forall a. Eq a => a -> [a] -> [a]
delete Ptr ()
buffer)

unloadShaders :: IO ()
unloadShaders :: IO ()
unloadShaders = do
  CUInt
shaderIdDefault <- IO CUInt
c'rlGetShaderIdDefault
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef IORef [CUInt]
shaderIds
  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 :: IO ()
unloadTextures :: IO ()
unloadTextures = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef IORef [CUInt]
textureIds
  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 :: IO ()
unloadFrameBuffers :: IO ()
unloadFrameBuffers = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef IORef [CUInt]
frameBuffers
  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 :: IO ()
unloadVaoIds :: IO ()
unloadVaoIds = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef IORef [CUInt]
vaoIds
  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 :: IO ()
unloadVboIds :: IO ()
unloadVboIds = do
  [CUInt]
vals <- forall a. IORef a -> IO a
readIORef IORef [CUInt]
vboIds
  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 :: IO ()
unloadCtxData :: IO ()
unloadCtxData = do
  [(CInt, Ptr ())]
vals <- forall a. IORef a -> IO a
readIORef IORef [(CInt, Ptr ())]
ctxDataPtrs
  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 :: IO ()
unloadAudioBuffers :: IO ()
unloadAudioBuffers = do
  [Ptr ()]
vals <- forall a. IORef a -> IO a
readIORef IORef [Ptr ()]
audioBuffers
  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 -> IO ()
addShaderId :: forall a. Integral a => a -> IO ()
addShaderId a
sId' = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CUInt]
shaderIds (\[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 -> IO ()
addTextureId :: forall a. Integral a => a -> IO ()
addTextureId a
tId' = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CUInt]
textureIds (\[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 -> IO ()
addFrameBuffer :: forall a. Integral a => a -> IO ()
addFrameBuffer a
fbId' = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CUInt]
frameBuffers (\[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 -> IO ()
addVaoId :: forall a. Integral a => a -> IO ()
addVaoId a
vaoId' = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [CUInt]
vaoIds (\[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] -> IO ()
addVboIds :: forall a. Integral a => Maybe [a] -> IO ()
addVboIds Maybe [a]
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
addVboIds (Just [a]
bIds') = 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 IORef [CUInt]
vboIds (\[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 () -> IO ()
addCtxData :: forall a. Integral a => a -> Ptr () -> IO ()
addCtxData a
ctxType' Ptr ()
ctxData = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(CInt, Ptr ())]
ctxDataPtrs (\[(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 () -> IO ()
addAudioBuffer :: Ptr () -> IO ()
addAudioBuffer Ptr ()
buffer = do
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [Ptr ()]
audioBuffers (\[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))