{-# OPTIONS -Wall #-} {-# LANGUAGE ForeignFunctionInterface #-} module Raylib.Internal (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 Foreign (Ptr) import Foreign.C (CInt (..), CUInt (..)) import GHC.IO (unsafePerformIO) shaderIds :: IO (IORef [CUInt]) shaderIds = newIORef [] textureIds :: IO (IORef [CUInt]) textureIds = newIORef [] frameBuffers :: IO (IORef [CUInt]) frameBuffers = newIORef [] vaoIds :: IO (IORef [CUInt]) vaoIds = newIORef [] vboIds :: IO (IORef [CUInt]) vboIds = newIORef [] ctxDataPtrs :: IO (IORef [(CInt, Ptr ())]) ctxDataPtrs = newIORef [] audioBuffers :: IO (IORef [Ptr ()]) audioBuffers = newIORef [] unloadShaders :: IO () unloadShaders = do shaderIdDefault <- c'rlGetShaderIdDefault shaderIds' <- shaderIds vals <- readIORef shaderIds' forM_ vals (\sId -> unless (sId == shaderIdDefault) (c'rlUnloadShaderProgram sId)) putStrLn "INFO: SHADER: h-raylib successfully auto-unloaded shaders" unloadTextures :: IO () unloadTextures = do textureIds' <- textureIds vals <- readIORef textureIds' forM_ vals (\tId -> when (tId > 0) (c'rlUnloadTexture tId)) putStrLn "INFO: TEXTURE: h-raylib successfully auto-unloaded textures" unloadFrameBuffers :: IO () unloadFrameBuffers = do frameBuffers' <- frameBuffers vals <- readIORef frameBuffers' forM_ vals (\fbId -> when (fbId > 0) (c'rlUnloadFramebuffer fbId)) putStrLn "INFO: FBO: h-raylib successfully auto-unloaded frame buffers" unloadVaoIds :: IO () unloadVaoIds = do vaoIds' <- vaoIds vals <- readIORef vaoIds' forM_ vals c'rlUnloadVertexArray putStrLn "INFO: VAO: h-raylib successfully auto-unloaded vertex arrays" unloadVboIds :: IO () unloadVboIds = do vboIds' <- vboIds vals <- readIORef vboIds' forM_ vals c'rlUnloadVertexBuffer putStrLn "INFO: VBO: h-raylib successfully auto-unloaded vertex buffers" unloadCtxData :: IO () unloadCtxData = do ctxDataPtrs' <- ctxDataPtrs vals <- readIORef ctxDataPtrs' forM_ vals $ uncurry c'unloadMusicStreamData putStrLn "INFO: AUDIO: h-raylib successfully auto-unloaded music data" unloadAudioBuffers :: IO () unloadAudioBuffers = do audioBuffers' <- audioBuffers vals <- readIORef audioBuffers' forM_ vals c'unloadAudioBuffer putStrLn "INFO: AUDIO: h-raylib successfully auto-unloaded audio buffers" addShaderId :: (Integral a) => a -> IO () addShaderId sId' = do shaderIds' <- shaderIds modifyIORef shaderIds' (\xs -> if sId `elem` xs then xs else sId : xs) where sId = fromIntegral sId' addTextureId :: (Integral a) => a -> IO () addTextureId tId' = do textureIds' <- textureIds modifyIORef textureIds' (\xs -> if tId `elem` xs then xs else tId : xs) where tId = fromIntegral tId' addFrameBuffer :: (Integral a) => a -> IO () addFrameBuffer fbId' = do frameBuffers' <- frameBuffers modifyIORef frameBuffers' (\xs -> if fbId `elem` xs then xs else fbId : xs) where fbId = fromIntegral fbId' addVaoId :: (Integral a) => a -> IO () addVaoId vaoId' = do vaoIds' <- vaoIds modifyIORef vaoIds' (\xs -> if vaoId `elem` xs then xs else vaoId : xs) where vaoId = fromIntegral vaoId' addVboIds :: (Integral a) => Maybe [a] -> IO () addVboIds Nothing = return () addVboIds (Just bIds') = do vboIds' <- vboIds forM_ bIds (\x -> modifyIORef vboIds' (\xs -> if x `elem` xs then xs else x : xs)) where bIds = map fromIntegral bIds' addCtxData :: (Integral a) => a -> Ptr () -> IO () addCtxData ctxType' ctxData = do ctxDataPtrs' <- ctxDataPtrs modifyIORef ctxDataPtrs' (\xs -> if (ctxType, ctxData) `elem` xs then xs else (ctxType, ctxData) : xs) where ctxType = fromIntegral ctxType' addAudioBuffer :: Ptr () -> IO () addAudioBuffer buffer = do audioBuffers' <- audioBuffers modifyIORef audioBuffers' (\xs -> if buffer `elem` xs then xs else buffer : 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 width height format = unsafePerformIO (fromIntegral <$> c'getPixelDataSize (fromIntegral width) (fromIntegral height) (fromIntegral format))