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