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