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

-- | Internal h-raylib utilities for automatic memory management
module Raylib.Internal
  ( WindowResources (..),
    defaultWindowResources,

    -- * Unloading individual resources
    unloadSingleShader,
    unloadSingleTexture,
    unloadSingleFrameBuffer,
    unloadSingleVaoId,
    unloadSingleVboIdList,
    unloadSingleCtxDataPtr,
    unloadSingleAudioBuffer,
    unloadSingleAudioBufferAlias,
    unloadSingleAutomationEventList,
    unloadSingleFunPtr,

    -- * Unloading all resources
    unloadShaders,
    unloadTextures,
    unloadFrameBuffers,
    unloadVaoIds,
    unloadVboIds,
    unloadCtxData,
    unloadAudioBuffers,
    unloadAudioBufferAliases,
    unloadAutomationEventLists,
    unloadFunPtrs,

    -- * Adding resources
    addShaderId,
    addTextureId,
    addFrameBuffer,
    addVaoId,
    addVboIds,
    addCtxData,
    addAudioBuffer,
    addAudioBufferAlias,
    addAutomationEventList,
    addFunPtr,

    -- * Miscellaneous
    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 (FunPtr, Ptr, Storable (peekByteOff), free, freeHaskellFunPtr)
import Foreign.C (CInt (..), CUInt (..))
import GHC.IO (unsafePerformIO)
import Raylib.Internal.TH (genNative)

#ifdef WEB_FFI

import Raylib.Internal.Web.Native (callRaylibFunction)

#endif

-- | Tracks all raylib resources which cannot be immediately freed.
--
--   Each field is an `IORef` to a list, and the list contains the data to be
--   tracked. Typically, data allocated on the GPU is stored here.
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 ()],
    WindowResources -> IORef [Ptr ()]
audioBufferAliases :: IORef [Ptr ()],
    WindowResources -> IORef [Ptr ()]
automationEventLists :: IORef [Ptr ()],
    WindowResources -> IORef [FunPtr ()]
funPtrs :: IORef [FunPtr ()]
  }

defaultWindowResources :: IO WindowResources
defaultWindowResources :: IO WindowResources
defaultWindowResources = do
  IORef [CUInt]
sIds <- [CUInt] -> IO (IORef [CUInt])
forall a. a -> IO (IORef a)
newIORef []
  IORef (Map Integer (Map String Int))
sLocs <- Map Integer (Map String Int)
-> IO (IORef (Map Integer (Map String Int)))
forall a. a -> IO (IORef a)
newIORef Map Integer (Map String Int)
forall k a. Map k a
Map.empty
  IORef [CUInt]
tIds <- [CUInt] -> IO (IORef [CUInt])
forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
fbs <- [CUInt] -> IO (IORef [CUInt])
forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
vaos <- [CUInt] -> IO (IORef [CUInt])
forall a. a -> IO (IORef a)
newIORef []
  IORef [CUInt]
vbos <- [CUInt] -> IO (IORef [CUInt])
forall a. a -> IO (IORef a)
newIORef []
  IORef [(CInt, Ptr ())]
cdps <- [(CInt, Ptr ())] -> IO (IORef [(CInt, Ptr ())])
forall a. a -> IO (IORef a)
newIORef []
  IORef [Ptr ()]
aBufs <- [Ptr ()] -> IO (IORef [Ptr ()])
forall a. a -> IO (IORef a)
newIORef []
  IORef [Ptr ()]
aliases <- [Ptr ()] -> IO (IORef [Ptr ()])
forall a. a -> IO (IORef a)
newIORef []
  IORef [Ptr ()]
eventLists <- [Ptr ()] -> IO (IORef [Ptr ()])
forall a. a -> IO (IORef a)
newIORef []
  IORef [FunPtr ()]
fPtrs <- [FunPtr ()] -> IO (IORef [FunPtr ()])
forall a. a -> IO (IORef a)
newIORef []
  WindowResources -> IO WindowResources
forall a. a -> IO a
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,
        audioBufferAliases :: IORef [Ptr ()]
audioBufferAliases = IORef [Ptr ()]
aliases,
        automationEventLists :: IORef [Ptr ()]
automationEventLists = IORef [Ptr ()]
eventLists,
        funPtrs :: IORef [FunPtr ()]
funPtrs = IORef [FunPtr ()]
fPtrs
      }

$( genNative
     [ ("c'rlGetShaderIdDefault", "rlGetShaderIdDefault_", "rlgl_bindings.h", [t|IO CUInt|], False),
       ("c'rlUnloadShaderProgram", "rlUnloadShaderProgram_", "rlgl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'rlUnloadTexture", "rlUnloadTexture_", "rlgl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'rlUnloadFramebuffer", "rlUnloadFramebuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'rlUnloadVertexArray", "rlUnloadVertexArray_", "rlgl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'rlUnloadVertexBuffer", "rlUnloadVertexBuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'unloadMusicStreamData", "UnloadMusicStreamData", "rl_internal.h", [t|CInt -> Ptr () -> IO ()|], False),
       ("c'unloadAudioBuffer", "UnloadAudioBuffer_", "rl_internal.h", [t|Ptr () -> IO ()|], False),
       ("c'unloadAudioBufferAlias", "UnloadAudioBufferAlias", "rl_internal.h", [t|Ptr () -> IO ()|], False),
       ("c'getPixelDataSize", "GetPixelDataSize_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> IO CInt|], False)
     ]
 )

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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CUInt
sId CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
shaderIdDefault) (CUInt -> IO ()
c'rlUnloadShaderProgram CUInt
sId)
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
shaderIds WindowResources
wr) (CUInt -> [CUInt] -> [CUInt]
forall a. Eq a => a -> [a] -> [a]
delete CUInt
sId)
  where
    sId :: CUInt
sId = a -> CUInt
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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tId CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadTexture CUInt
tId)
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
textureIds WindowResources
wr) (CUInt -> [CUInt] -> [CUInt]
forall a. Eq a => a -> [a] -> [a]
delete CUInt
tId)
  where
    tId :: CUInt
tId = a -> CUInt
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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
fbId CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0) (CUInt -> IO ()
c'rlUnloadFramebuffer CUInt
fbId)
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
frameBuffers WindowResources
wr) (CUInt -> [CUInt] -> [CUInt]
forall a. Eq a => a -> [a] -> [a]
delete CUInt
fbId)
  where
    fbId :: CUInt
fbId = a -> CUInt
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
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vaoIds WindowResources
wr) (CUInt -> [CUInt] -> [CUInt]
forall a. Eq a => a -> [a] -> [a]
delete CUInt
vaoId)
  where
    vaoId :: CUInt
vaoId = a -> CUInt
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
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unloadSingleVboIdList (Just [a]
vboIdList') WindowResources
wr = do
  [CUInt] -> (CUInt -> IO ()) -> IO ()
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
        IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vboIds WindowResources
wr) (CUInt -> [CUInt] -> [CUInt]
forall a. Eq a => a -> [a] -> [a]
delete CUInt
vboId)
    )
  where
    vboIdList :: [CUInt]
vboIdList = (a -> CUInt) -> [a] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map a -> CUInt
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
  IORef [(CInt, Ptr ())]
-> ([(CInt, Ptr ())] -> [(CInt, Ptr ())]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs WindowResources
wr) ((CInt, Ptr ()) -> [(CInt, Ptr ())] -> [(CInt, Ptr ())]
forall a. Eq a => a -> [a] -> [a]
delete (CInt
ctxType, Ptr ()
ctxData))
  where
    ctxType :: CInt
ctxType = a -> CInt
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
  IORef [Ptr ()] -> ([Ptr ()] -> [Ptr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
audioBuffers WindowResources
wr) (Ptr () -> [Ptr ()] -> [Ptr ()]
forall a. Eq a => a -> [a] -> [a]
delete Ptr ()
buffer)

unloadSingleAudioBufferAlias :: Ptr () -> WindowResources -> IO ()
unloadSingleAudioBufferAlias :: Ptr () -> WindowResources -> IO ()
unloadSingleAudioBufferAlias Ptr ()
buffer WindowResources
wr = do
  Ptr () -> IO ()
c'unloadAudioBufferAlias Ptr ()
buffer
  IORef [Ptr ()] -> ([Ptr ()] -> [Ptr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
audioBufferAliases WindowResources
wr) (Ptr () -> [Ptr ()] -> [Ptr ()]
forall a. Eq a => a -> [a] -> [a]
delete Ptr ()
buffer)

unloadSingleAutomationEventList :: Ptr () -> WindowResources -> IO ()
unloadSingleAutomationEventList :: Ptr () -> WindowResources -> IO ()
unloadSingleAutomationEventList Ptr ()
eventList WindowResources
wr = do
  Ptr () -> IO ()
_unloadAutomationEventList Ptr ()
eventList
  IORef [Ptr ()] -> ([Ptr ()] -> [Ptr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
automationEventLists WindowResources
wr) (Ptr () -> [Ptr ()] -> [Ptr ()]
forall a. Eq a => a -> [a] -> [a]
delete Ptr ()
eventList)

unloadSingleFunPtr :: FunPtr () -> WindowResources -> IO ()
unloadSingleFunPtr :: FunPtr () -> WindowResources -> IO ()
unloadSingleFunPtr FunPtr ()
fPtr WindowResources
wr = do
  FunPtr () -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr ()
fPtr
  IORef [FunPtr ()] -> ([FunPtr ()] -> [FunPtr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [FunPtr ()]
funPtrs WindowResources
wr) (FunPtr () -> [FunPtr ()] -> [FunPtr ()]
forall a. Eq a => a -> [a] -> [a]
delete FunPtr ()
fPtr)

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

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

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

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

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

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

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

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

unloadAutomationEventLists :: WindowResources -> IO ()
unloadAutomationEventLists :: WindowResources -> IO ()
unloadAutomationEventLists WindowResources
wr = do
  [Ptr ()]
vals <- IORef [Ptr ()] -> IO [Ptr ()]
forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [Ptr ()]
automationEventLists WindowResources
wr)
  let l :: Int
l = [Ptr ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr ()]
vals
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        [Ptr ()] -> (Ptr () -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Ptr ()]
vals Ptr () -> IO ()
_unloadAutomationEventList
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"INFO: AUTOMATION: h-raylib successfully auto-unloaded automation event lists (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in total)"
    )

unloadFunPtrs :: WindowResources -> IO ()
unloadFunPtrs :: WindowResources -> IO ()
unloadFunPtrs WindowResources
wr = do
  [FunPtr ()]
vals <- IORef [FunPtr ()] -> IO [FunPtr ()]
forall a. IORef a -> IO a
readIORef (WindowResources -> IORef [FunPtr ()]
funPtrs WindowResources
wr)
  let l :: Int
l = [FunPtr ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunPtr ()]
vals
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    ( do
        [FunPtr ()] -> (FunPtr () -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FunPtr ()]
vals FunPtr () -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"INFO: h-raylib successfully auto-unloaded `FunPtr`s (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
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
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
shaderIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
sId CUInt -> [CUInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
sId CUInt -> [CUInt] -> [CUInt]
forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    sId :: CUInt
sId = a -> CUInt
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
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
textureIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
tId CUInt -> [CUInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
tId CUInt -> [CUInt] -> [CUInt]
forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    tId :: CUInt
tId = a -> CUInt
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
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
frameBuffers WindowResources
wr) (\[CUInt]
xs -> if CUInt
fbId CUInt -> [CUInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
fbId CUInt -> [CUInt] -> [CUInt]
forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    fbId :: CUInt
fbId = a -> CUInt
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
  IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vaoIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
vaoId CUInt -> [CUInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
vaoId CUInt -> [CUInt] -> [CUInt]
forall a. a -> [a] -> [a]
: [CUInt]
xs)
  where
    vaoId :: CUInt
vaoId = a -> CUInt
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
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addVboIds (Just [a]
bIds') WindowResources
wr = do
  [CUInt] -> (CUInt -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CUInt]
bIds (\CUInt
x -> IORef [CUInt] -> ([CUInt] -> [CUInt]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [CUInt]
vboIds WindowResources
wr) (\[CUInt]
xs -> if CUInt
x CUInt -> [CUInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CUInt]
xs then [CUInt]
xs else CUInt
x CUInt -> [CUInt] -> [CUInt]
forall a. a -> [a] -> [a]
: [CUInt]
xs))
  where
    bIds :: [CUInt]
bIds = (a -> CUInt) -> [a] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map a -> CUInt
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
  IORef [(CInt, Ptr ())]
-> ([(CInt, Ptr ())] -> [(CInt, Ptr ())]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [(CInt, Ptr ())]
ctxDataPtrs WindowResources
wr) (\[(CInt, Ptr ())]
xs -> if (CInt
ctxType, Ptr ()
ctxData) (CInt, Ptr ()) -> [(CInt, Ptr ())] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(CInt, Ptr ())]
xs then [(CInt, Ptr ())]
xs else (CInt
ctxType, Ptr ()
ctxData) (CInt, Ptr ()) -> [(CInt, Ptr ())] -> [(CInt, Ptr ())]
forall a. a -> [a] -> [a]
: [(CInt, Ptr ())]
xs)
  where
    ctxType :: CInt
ctxType = a -> CInt
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
  IORef [Ptr ()] -> ([Ptr ()] -> [Ptr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [Ptr ()]
audioBuffers WindowResources
wr) (\[Ptr ()]
xs -> if Ptr ()
buffer Ptr () -> [Ptr ()] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ptr ()]
xs then [Ptr ()]
xs else Ptr ()
buffer Ptr () -> [Ptr ()] -> [Ptr ()]
forall a. a -> [a] -> [a]
: [Ptr ()]
xs)

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

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

addFunPtr :: FunPtr () -> WindowResources -> IO ()
addFunPtr :: FunPtr () -> WindowResources -> IO ()
addFunPtr FunPtr ()
fPtr WindowResources
wr = do
  IORef [FunPtr ()] -> ([FunPtr ()] -> [FunPtr ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (WindowResources -> IORef [FunPtr ()]
funPtrs WindowResources
wr) (\[FunPtr ()]
xs -> if FunPtr ()
fPtr FunPtr () -> [FunPtr ()] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FunPtr ()]
xs then [FunPtr ()]
xs else FunPtr ()
fPtr FunPtr () -> [FunPtr ()] -> [FunPtr ()]
forall a. a -> [a] -> [a]
: [FunPtr ()]
xs)

_unloadAutomationEventList :: Ptr () -> IO ()
_unloadAutomationEventList :: Ptr () -> IO ()
_unloadAutomationEventList Ptr ()
ptr = (Ptr () -> IO ()
forall a. Ptr a -> IO ()
free (Ptr () -> IO ()) -> IO (Ptr ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Ptr () -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr Int
8 :: IO (Ptr ()))) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO ()
forall a. Ptr a -> IO ()
free Ptr ()
ptr

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