diff --git a/.github/workflows/cabal-build.yml b/.github/workflows/cabal-build.yml index 0f6d85e..333ddd3 100644 --- a/.github/workflows/cabal-build.yml +++ b/.github/workflows/cabal-build.yml @@ -17,7 +17,7 @@ jobs: fail-fast: false matrix: os: [ubuntu-latest, windows-latest, macos-latest] - ghc-version: ["9.8", "9.6", "9.2"] + ghc-version: ["9.12", "9.6", "9.2"] exclude: - os: macos-latest ghc-version: "9.2" diff --git a/cabal.project b/cabal.project index e3c9ffb..2d9df69 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,4 @@ packages: *.cabal -optimization: 2 - package h-raylib flags: +examples diff --git a/examples/basic-audio/src/Main.hs b/examples/basic-audio/src/Main.hs index 0229269..765f052 100644 --- a/examples/basic-audio/src/Main.hs +++ b/examples/basic-audio/src/Main.hs @@ -1,15 +1,19 @@ {-# LANGUAGE TemplateHaskell #-} + module Main where +import Control.Concurrent (forkOS) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Foreign (ForeignPtr) import Paths_h_raylib (getDataFileName) -import Raylib.Core (clearBackground, initWindow, setTargetFPS, windowShouldClose, closeWindow) +import Raylib.Core (clearBackground, closeWindow, initWindow, setTargetFPS, windowShouldClose) import Raylib.Core.Audio (closeAudioDevice, initAudioDevice, loadMusicStream, playMusicStream, updateMusicStream) import Raylib.Core.Text (drawText) -import Raylib.Util (drawing, managed, WindowResources, raylibApplication) -import Raylib.Util.Colors (lightGray, rayWhite) import Raylib.Types (Music) +import Raylib.Util (WindowResources, drawing, managed, raylibApplication) +import Raylib.Util.Colors (lightGray, rayWhite) -type AppState = (WindowResources, Music) +type AppState = (WindowResources, IORef (Maybe (ForeignPtr Music))) musicPath :: String musicPath = "examples/basic-audio/assets/mini1111.xm" @@ -18,20 +22,26 @@ startup :: IO AppState startup = do window <- initWindow 650 400 "raylib [audio] example - basic audio" setTargetFPS 60 - initAudioDevice - - music <- managed window $ loadMusicStream =<< getDataFileName musicPath - playMusicStream music + -- Multithreaded to avoid pause on startup when initAudioDevice is called + mref <- newIORef Nothing + _ <- forkOS $ do + initAudioDevice + music <- managed window $ loadMusicStream =<< getDataFileName musicPath + playMusicStream music + writeIORef mref (Just music) - return (window, music) + return (window, mref) mainLoop :: AppState -> IO AppState -mainLoop state@(_, music) = do +mainLoop state@(_, mref) = do + music <- readIORef mref drawing $ do clearBackground rayWhite - drawText "You should hear music playing!" 20 20 20 lightGray - updateMusicStream music + case music of + Nothing -> drawText "Music is loading..." 20 20 20 lightGray + Just _ -> drawText "You should hear music playing!" 20 20 20 lightGray + maybe (return ()) updateMusicStream music return state shouldClose :: AppState -> IO Bool diff --git a/examples/basic-callbacks/src/Main.hs b/examples/basic-callbacks/src/Main.hs index ee11189..9284c3f 100644 --- a/examples/basic-callbacks/src/Main.hs +++ b/examples/basic-callbacks/src/Main.hs @@ -1,10 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} + module Main where import Paths_h_raylib (getDataFileName) -import Raylib.Core (clearBackground, initWindow, setTargetFPS, windowShouldClose, closeWindow, setLoadFileTextCallback, setTraceLogCallback, loadFileText) +import Raylib.Core (clearBackground, closeWindow, initWindow, loadFileText, setLoadFileTextCallback, setTargetFPS, setTraceLogCallback, windowShouldClose) import Raylib.Core.Text (drawText) -import Raylib.Util (drawing, raylibApplication, WindowResources) +import Raylib.Util (WindowResources, drawing, raylibApplication) import Raylib.Util.Colors (black, rayWhite) filePath :: String @@ -28,7 +29,8 @@ mainLoop (text, window) = clearBackground rayWhite drawText "File contents:" 30 40 24 black drawText text 30 70 24 black - ) >> return (text, window) + ) + >> return (text, window) shouldClose :: AppState -> IO Bool shouldClose _ = windowShouldClose diff --git a/examples/basic-images/src/Main.hs b/examples/basic-images/src/Main.hs index 1ce41f0..3360fd8 100644 --- a/examples/basic-images/src/Main.hs +++ b/examples/basic-images/src/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} + module Main where import Paths_h_raylib (getDataFileName) @@ -12,8 +13,8 @@ import Raylib.Core.Textures loadRenderTexture, loadTextureFromImage, ) -import Raylib.Types (Rectangle (Rectangle), RenderTexture (renderTexture'texture), pattern Vector2) -import Raylib.Util (drawing, textureMode, whileWindowOpen0, withWindow, managed) +import Raylib.Types (Image, Rectangle (Rectangle), RenderTexture (renderTexture'texture), Texture, pattern Vector2) +import Raylib.Util (drawing, managed, textureMode, whileWindowOpen0, withWindow) import Raylib.Util.Colors (black, lightGray, orange, white) logoPath :: String @@ -27,9 +28,9 @@ main = do "raylib [textures] example - basic images" 60 ( \window -> do - texture <- managed window $ loadTextureFromImage =<< genImagePerlinNoise 600 450 20 20 2 - logo <- managed window $ loadTextureFromImage =<< loadImage =<< getDataFileName logoPath - rt <- managed window $ loadRenderTexture 200 200 + texture <- managed window $ loadTextureFromImage =<< (genImagePerlinNoise 600 450 20 20 2 :: IO Image) :: IO Texture + logo <- managed window $ loadTextureFromImage =<< (loadImage =<< getDataFileName logoPath :: IO Image) :: IO Texture + rt <- managed window $ loadRenderTexture 200 200 :: IO RenderTexture whileWindowOpen0 ( drawing diff --git a/examples/basic-models/src/Main.hs b/examples/basic-models/src/Main.hs index 2ebe56c..29f1ba0 100644 --- a/examples/basic-models/src/Main.hs +++ b/examples/basic-models/src/Main.hs @@ -2,12 +2,13 @@ module Main where +import Foreign (ForeignPtr) import Paths_h_raylib (getDataFileName) import Raylib.Core (clearBackground, disableCursor) import Raylib.Core.Camera (updateCamera) -import Raylib.Core.Models (drawGrid, drawModel, genMeshCube, loadModel, loadModelFromMesh) -import Raylib.Types (Camera3D (Camera3D), CameraMode (CameraModeFirstPerson), CameraProjection (CameraPerspective), pattern Vector3) -import Raylib.Util (drawing, mode3D, whileWindowOpen_, withWindow, managed) +import Raylib.Core.Models (drawGrid, drawModel, genMeshCube, loadModel, loadModelFromMeshManaged) +import Raylib.Types (Camera3D (Camera3D), CameraMode (CameraModeFirstPerson), CameraProjection (CameraPerspective), Mesh, Model, pattern Vector3) +import Raylib.Util (drawing, managed, mode3D, whileWindowOpen_, withWindow) import Raylib.Util.Colors (orange, white) modelPath :: String @@ -23,9 +24,9 @@ main = do ( \window -> do disableCursor - mesh <- managed window $ genMeshCube 2 3 4 - cubeModel <- managed window $ loadModelFromMesh mesh - customModel <- managed window $ loadModel =<< getDataFileName modelPath + mesh <- managed window $ genMeshCube 2 3 4 :: IO (ForeignPtr Mesh) + cubeModel <- loadModelFromMeshManaged mesh window :: IO (ForeignPtr Model) + customModel <- managed window $ loadModel =<< getDataFileName modelPath :: IO (ForeignPtr Model) let camera = Camera3D (Vector3 3 2 3) (Vector3 0 0 0) (Vector3 0 1 0) 70 CameraPerspective diff --git a/examples/basic-rlgl/src/Main.hs b/examples/basic-rlgl/src/Main.hs index 29e4520..3d8a720 100644 --- a/examples/basic-rlgl/src/Main.hs +++ b/examples/basic-rlgl/src/Main.hs @@ -7,7 +7,7 @@ import Raylib.Core (clearBackground) import Raylib.Core.Models (drawGrid) import Raylib.Core.Textures (loadTexture) import Raylib.Types (Camera3D (Camera3D), CameraProjection (CameraPerspective), Color (Color), RLDrawMode (RLQuads), Rectangle (Rectangle), Texture (texture'height, texture'id, texture'width), Vector3, pattern Vector3) -import Raylib.Util (drawing, mode3D, whileWindowOpen0, withWindow, managed) +import Raylib.Util (drawing, managed, mode3D, whileWindowOpen0, withWindow) import Raylib.Util.Colors (rayWhite, white) import Raylib.Util.RLGL (rlBegin, rlColor4ub, rlEnd, rlNormal3f, rlPopMatrix, rlPushMatrix, rlRotatef, rlScalef, rlSetTexture, rlTexCoord2f, rlTranslatef, rlVertex3f) import Prelude hiding (length) diff --git a/examples/basic-shaders/src/Main.hs b/examples/basic-shaders/src/Main.hs index 59ab716..92552df 100644 --- a/examples/basic-shaders/src/Main.hs +++ b/examples/basic-shaders/src/Main.hs @@ -2,9 +2,10 @@ module Main where -import Paths_h_raylib (getDataFileName) import Control.Monad (when) +import Foreign (ForeignPtr) import Numeric (showFFloat) +import Paths_h_raylib (getDataFileName) import Raylib.Core ( beginDrawing, beginMode3D, @@ -21,13 +22,16 @@ import Raylib.Core setTargetFPS, ) import Raylib.Core.Camera (updateCamera) -import Raylib.Core.Models (drawModel, drawSphereWires, genMeshCube, genMeshPlane, genMeshSphere, loadModelFromMesh) +import Raylib.Core.Models (drawModel, drawSphereWires, genMeshCube, genMeshPlane, genMeshSphere, loadModelFromMeshManaged) import Raylib.Core.Text (drawText) import Raylib.Types ( Camera3D (Camera3D, camera3D'position), CameraMode (CameraModeFirstPerson), CameraProjection (CameraPerspective), KeyboardKey (KeyH, KeyJ, KeyU, KeyY), + Mesh, + Model, + Shader, ShaderUniformData ( ShaderUniformFloat, ShaderUniformVec3, @@ -38,7 +42,7 @@ import Raylib.Types pattern Vector3, pattern Vector4, ) -import Raylib.Util (setMaterialShader, whileWindowOpen_, managed) +import Raylib.Util (managed, setMaterialShader, whileWindowOpen_) import Raylib.Util.Colors (black, blue, lightGray, orange, white) assetsPath :: String @@ -54,7 +58,7 @@ main = do vert <- getDataFileName (assetsPath ++ "lighting.vert") frag <- getDataFileName (assetsPath ++ "lighting.frag") - shader <- managed window $ loadShader (Just vert) (Just frag) + shader <- managed window $ loadShader (Just vert) (Just frag) :: IO (ForeignPtr Shader) let pointLightPosition = Vector3 0 3 2 let pointLightColor = Vector4 1 1 1 1 @@ -70,17 +74,17 @@ main = do setShaderValue shader "ambientLightColor" (ShaderUniformVec4 ambientLightColor) window setShaderValue shader "ambientStrength" (ShaderUniformFloat ambientStrength) window - cubeMesh <- managed window $ genMeshCube 2 2 2 - cubeModel' <- managed window $ loadModelFromMesh cubeMesh - let cubeModel = setMaterialShader cubeModel' 0 shader + cubeMesh <- managed window $ genMeshCube 2 2 2 :: IO (ForeignPtr Mesh) + cubeModel <- loadModelFromMeshManaged cubeMesh window :: IO (ForeignPtr Model) + _ <- setMaterialShader cubeModel 0 shader - sphereMesh <- managed window $ genMeshSphere 0.5 32 32 - sphereModel' <- managed window $ loadModelFromMesh sphereMesh - let sphereModel = setMaterialShader sphereModel' 0 shader + sphereMesh <- managed window $ genMeshSphere 0.5 32 32 :: IO (ForeignPtr Mesh) + sphereModel <- loadModelFromMeshManaged sphereMesh window :: IO (ForeignPtr Model) + _ <- setMaterialShader sphereModel 0 shader - planeMesh <- managed window $ genMeshPlane 100 100 20 20 - planeModel' <- managed window $ loadModelFromMesh planeMesh - let planeModel = setMaterialShader planeModel' 0 shader + planeMesh <- managed window $ genMeshPlane 100 100 20 20 :: IO (ForeignPtr Mesh) + planeModel <- loadModelFromMeshManaged planeMesh window :: IO (ForeignPtr Model) + _ <- setMaterialShader planeModel 0 shader whileWindowOpen_ ( \(c, ls, ss) -> do diff --git a/examples/basic-window/src/Main.hs b/examples/basic-window/src/Main.hs index 68b1a87..4690ea2 100644 --- a/examples/basic-window/src/Main.hs +++ b/examples/basic-window/src/Main.hs @@ -1,9 +1,10 @@ {-# LANGUAGE TemplateHaskell #-} + module Main where -import Raylib.Core (clearBackground, initWindow, setTargetFPS, windowShouldClose, closeWindow) +import Raylib.Core (clearBackground, closeWindow, initWindow, setTargetFPS, windowShouldClose) import Raylib.Core.Text (drawText) -import Raylib.Util (drawing, raylibApplication, WindowResources) +import Raylib.Util (WindowResources, drawing, raylibApplication) import Raylib.Util.Colors (lightGray, rayWhite) startup :: IO WindowResources @@ -18,7 +19,8 @@ mainLoop window = ( do clearBackground rayWhite drawText "Basic raylib window" 30 40 18 lightGray - ) >> return window + ) + >> return window shouldClose :: WindowResources -> IO Bool shouldClose _ = windowShouldClose diff --git a/examples/bunnymark/src/Main.hs b/examples/bunnymark/src/Main.hs index 9adc33f..3ce6db2 100644 --- a/examples/bunnymark/src/Main.hs +++ b/examples/bunnymark/src/Main.hs @@ -1,32 +1,32 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TemplateHaskell #-} --- Writing performant h-raylib code requires the use of pointers and other --- un-Haskelly functionality. Unfortunately, this cannot be avoided. +-- Writing performant h-raylib code requires the use of pointers. However, +-- most h-raylib functions work fine with pointers. module Main where -import Paths_h_raylib (getDataFileName) import Control.Monad (forM_, when) import Foreign ( ForeignPtr, Ptr, Storable (alignment, peek, poke, sizeOf), advancePtr, - free, mallocForeignPtrArray, peek, plusPtr, poke, withForeignPtr, ) -import Foreign.C (CFloat, withCString) +import Foreign.C (CFloat) +import Paths_h_raylib (getDataFileName) import Raylib.Core ( beginDrawing, - c'getMouseX, - c'getMouseY, - c'getRandomValue, + getMouseX, + getMouseY, + getRandomValue, clearBackground, + closeWindow, endDrawing, getFrameTime, getScreenHeight, @@ -34,13 +34,13 @@ import Raylib.Core initWindow, isMouseButtonDown, setTargetFPS, - windowShouldClose, closeWindow, + windowShouldClose, ) import Raylib.Core.Shapes (drawRectangle) import Raylib.Core.Text (drawFPS, drawText) -import Raylib.Core.Textures (c'drawTexture, c'loadTexture, c'unloadTexture) +import Raylib.Core.Textures (drawTexture, loadTexture) import Raylib.Types (Color (Color), MouseButton (MouseButtonLeft), Texture, p'texture'height, p'texture'width) -import Raylib.Util (raylibApplication) +import Raylib.Util (WindowResources, managed, raylibApplication) import Raylib.Util.Colors (black, green, maroon, rayWhite) texPath :: String @@ -102,38 +102,48 @@ p'color :: Ptr Bunny -> Ptr Color p'color = (`plusPtr` (4 * cfs)) data AppState = AppState - { texBunny :: !(Ptr Texture), + { texBunny :: !(ForeignPtr Texture), halfTexWidth :: !CFloat, halfTexHeight :: !CFloat, - bunnies :: !(ForeignPtr Bunny), -- Store the bunnies as a pointer (C-style array) because Haskell linked lists are extremely slow - bunniesCount :: !Int + -- Store the bunnies as a pointer (C-style array) because Haskell linked lists are extremely slow. + -- For actual applications a `vector` is probably more practical. + bunnies :: !(ForeignPtr Bunny), + bunniesCount :: !Int, + window :: !WindowResources } - deriving (Show, Eq) startup :: IO AppState startup = do - _ <- initWindow 800 450 "raylib [textures] example - bunnymark" + wr <- initWindow 800 450 "raylib [textures] example - bunnymark" setTargetFPS 60 texPath' <- getDataFileName texPath - texPtr <- withCString texPath' c'loadTexture - -- Use `peek` when you need to access the underlying fields - - -- This could be rewritten as - -- tex <- peek texPtr - -- let tWidth = texture'width tex - -- ... - -- but the code below is faster as it doesn't have to load the entire structure into Haskell - tWidth <- peek (p'texture'width texPtr) - tHeight <- peek (p'texture'height texPtr) - bunniesPtr <- mallocForeignPtrArray maxBunnies - return - ( AppState - { texBunny = texPtr, - bunnies = bunniesPtr, - halfTexWidth = fromIntegral tWidth / 2, - halfTexHeight = fromIntegral tHeight / 2, - bunniesCount = 0 - } + -- Use `withForeignPtr` and `peek` when you need to access the underlying fields. + -- You don't need to worry about freeing/unloading it because `managed` takes + -- care of that automatically. + texPtr <- managed wr $ loadTexture texPath' + + withForeignPtr + texPtr + (\p -> do + -- This could be rewritten as + -- tex <- peek p + -- let tWidth = texture'width tex + -- ... + -- but the code below is faster as it doesn't have to load the entire structure into Haskell + tWidth <- peek (p'texture'width p) + tHeight <- peek (p'texture'height p) + bunniesPtr <- mallocForeignPtrArray maxBunnies + + return + ( AppState + { texBunny = texPtr, + bunnies = bunniesPtr, + halfTexWidth = fromIntegral tWidth / 2, + halfTexHeight = fromIntegral tHeight / 2, + bunniesCount = 0, + window = wr + } + ) ) mainLoop :: AppState -> IO AppState @@ -153,7 +163,7 @@ mainLoop state = do -- Advancing the bunny pointer to access the fields _px <- peek $ p'px bunny _py <- peek $ p'py bunny - c'drawTexture (texBunny state) (floor _px) (floor _py) (p'color bunny) + drawTexture (texBunny state) (floor _px) (floor _py) =<< peek (p'color bunny) ) drawRectangle 0 0 screenWidth 40 black drawText ("bunnies: " ++ show (bunniesCount state)) 120 10 20 green @@ -187,19 +197,19 @@ mainLoop state = do then do frameTime <- getFrameTime let newBunnies = min (round (10000 * frameTime)) (maxBunnies - bunniesCount state) - mx <- realToFrac <$> c'getMouseX - my <- realToFrac <$> c'getMouseY + mx <- fromIntegral <$> getMouseX + my <- fromIntegral <$> getMouseY forM_ [bunniesCount state .. (bunniesCount state + newBunnies - 1)] ( \(!i) -> do -- Creating elements uses `poke`, just like writing let bunny = advancePtr bptr i - xSpeed <- (/ 60) . fromIntegral <$> c'getRandomValue (-250) 250 - ySpeed <- (/ 60) . fromIntegral <$> c'getRandomValue (-250) 250 - r <- fromIntegral <$> c'getRandomValue 50 240 - g <- fromIntegral <$> c'getRandomValue 80 240 - b <- fromIntegral <$> c'getRandomValue 100 240 + xSpeed <- (/ 60) . fromIntegral <$> getRandomValue (-250) 250 + ySpeed <- (/ 60) . fromIntegral <$> getRandomValue (-250) 250 + r <- fromIntegral <$> getRandomValue 50 240 + g <- fromIntegral <$> getRandomValue 80 240 + b <- fromIntegral <$> getRandomValue 100 240 poke (p'px bunny) mx poke (p'py bunny) my @@ -214,10 +224,6 @@ shouldClose :: AppState -> IO Bool shouldClose _ = windowShouldClose teardown :: AppState -> IO () -teardown state = do - -- Unload and free functions have to be manually called - c'unloadTexture (texBunny state) - free (texBunny state) - closeWindow Nothing +teardown state = closeWindow (Just (window state)) $(raylibApplication 'startup 'mainLoop 'shouldClose 'teardown) diff --git a/examples/camera-ray-collision/src/Main.hs b/examples/camera-ray-collision/src/Main.hs index 3ded7a3..1df0b4f 100644 --- a/examples/camera-ray-collision/src/Main.hs +++ b/examples/camera-ray-collision/src/Main.hs @@ -6,6 +6,7 @@ import Control.Monad (when) import Raylib.Core (clearBackground, disableCursor, getWorldToScreen) import Raylib.Core.Camera (updateCamera) import Raylib.Core.Models (drawBoundingBox, getRayCollisionQuad) +import Raylib.Core.Shapes (drawCircleV) import Raylib.Core.Text (drawFPS) import Raylib.Types ( BoundingBox (BoundingBox), @@ -17,7 +18,6 @@ import Raylib.Types ) import Raylib.Util (cameraDirectionRay, drawing, mode3D, whileWindowOpen_, withWindow) import Raylib.Util.Colors (black, red, white) -import Raylib.Core.Shapes (drawCircleV) main :: IO () main = do diff --git a/examples/custom-font-text/src/Main.hs b/examples/custom-font-text/src/Main.hs index b1620f8..191b963 100644 --- a/examples/custom-font-text/src/Main.hs +++ b/examples/custom-font-text/src/Main.hs @@ -2,12 +2,12 @@ module Main where +import Foreign (ForeignPtr, fromBool) import Paths_h_raylib (getDataFileName) -import Foreign (fromBool) import Raylib.Core (clearBackground, isKeyPressed) import Raylib.Core.Text (drawText, drawTextEx, loadFont) -import Raylib.Types (KeyboardKey (KeyDown, KeyUp), pattern Vector2) -import Raylib.Util (whileWindowOpen_, withWindow, drawing, managed) +import Raylib.Types (Font, KeyboardKey (KeyDown, KeyUp), pattern Vector2) +import Raylib.Util (drawing, managed, whileWindowOpen_, withWindow) import Raylib.Util.Colors (black, rayWhite) mainFontPath :: String @@ -21,18 +21,18 @@ main = do "raylib [text] example - custom font text" 60 ( \window -> do - mainFont <- managed window $ loadFont =<< getDataFileName mainFontPath + mainFont <- managed window $ loadFont =<< getDataFileName mainFontPath :: IO (ForeignPtr Font) whileWindowOpen_ ( \size -> do drawing ( do clearBackground rayWhite - + drawTextEx mainFont "Testing drawTextEx" (Vector2 20.0 12.0) (fromIntegral size) 1.0 black drawText "Press the up and down arrows to change the font size" 20 (size + 15) 24 black ) - + increaseSize <- isKeyPressed KeyUp decreaseSize <- isKeyPressed KeyDown return (size + fromBool increaseSize - fromBool decreaseSize) diff --git a/examples/first-person-camera/src/Main.hs b/examples/first-person-camera/src/Main.hs index ad78fc9..c8e6478 100644 --- a/examples/first-person-camera/src/Main.hs +++ b/examples/first-person-camera/src/Main.hs @@ -3,7 +3,7 @@ module Main where -import Raylib.Core (initWindowUnmanaged, setTargetFPS, windowShouldClose, closeWindow, clearBackground, disableCursor) +import Raylib.Core (clearBackground, closeWindow, disableCursor, initWindowUnmanaged, setTargetFPS, windowShouldClose) import Raylib.Core.Camera (updateCamera) import Raylib.Core.Models (drawCircle3D, drawCubeWiresV, drawLine3D) import Raylib.Core.Text (drawFPS) diff --git a/examples/postprocessing-effects/src/Main.hs b/examples/postprocessing-effects/src/Main.hs index ffd663b..a3c0582 100644 --- a/examples/postprocessing-effects/src/Main.hs +++ b/examples/postprocessing-effects/src/Main.hs @@ -2,15 +2,16 @@ module Main where -import Paths_h_raylib (getDataFileName) import Control.Monad (unless, void) +import Foreign (ForeignPtr) +import Paths_h_raylib (getDataFileName) import Raylib.Core (changeDirectory, clearBackground, getApplicationDirectory, isKeyPressed, loadShader, setShaderValue) import Raylib.Core.Camera (updateCamera) import Raylib.Core.Models (drawCube, drawGrid, drawSphere) import Raylib.Core.Text (drawText) import Raylib.Core.Textures (drawTextureRec, loadRenderTexture) -import Raylib.Types (Camera3D (Camera3D), CameraMode (CameraModeOrbital), CameraProjection (CameraPerspective), KeyboardKey (KeyLeft, KeyRight), Rectangle (Rectangle), RenderTexture (renderTexture'texture), ShaderUniformData (ShaderUniformVec2), pattern Vector2, pattern Vector3) -import Raylib.Util (inGHCi, mode3D, textureMode, whileWindowOpen_, withWindow, drawing, shaderMode, managed) +import Raylib.Types (Camera3D (Camera3D), CameraMode (CameraModeOrbital), CameraProjection (CameraPerspective), KeyboardKey (KeyLeft, KeyRight), Rectangle (Rectangle), RenderTexture (renderTexture'texture), Shader, ShaderUniformData (ShaderUniformVec2), pattern Vector2, pattern Vector3) +import Raylib.Util (drawing, inGHCi, managed, mode3D, shaderMode, textureMode, whileWindowOpen_, withWindow) import Raylib.Util.Colors (black, blue, darkBlue, darkGreen, green, maroon, orange, red, white) assetsPath :: String @@ -27,18 +28,18 @@ main = do "raylib [shaders] example - postprocessing effects" 60 ( \window -> do - unless inGHCi (void $ changeDirectory =<< getApplicationDirectory) + unless inGHCi (void $ changeDirectory =<< (getApplicationDirectory :: IO String)) let camera = Camera3D (Vector3 3 4 3) (Vector3 0 1 0) (Vector3 0 1 0) 45 CameraPerspective rt <- managed window $ loadRenderTexture width height -- Most of the shaders here are based on the ones at https://github.com/raysan5/raylib/tree/master/examples/shaders/resources/shaders/glsl330 - defaultShader <- managed window $ loadShader Nothing Nothing - grayscaleShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "grayscale.frag") - blurShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "blur.frag") - pixelateShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "pixelate.frag") - bloomShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "bloom.frag") + defaultShader <- managed window $ loadShader Nothing Nothing :: IO (ForeignPtr Shader) + grayscaleShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "grayscale.frag") :: IO (ForeignPtr Shader) + blurShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "blur.frag") :: IO (ForeignPtr Shader) + pixelateShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "pixelate.frag") :: IO (ForeignPtr Shader) + bloomShader <- managed window $ loadShader Nothing . Just =<< getDataFileName (assetsPath ++ "bloom.frag") :: IO (ForeignPtr Shader) let shaders = [("None", defaultShader), ("Grayscale", grayscaleShader), ("Blur", blurShader), ("Pixelate", pixelateShader), ("Bloom", bloomShader)] @@ -73,7 +74,7 @@ main = do clearBackground white shaderMode selectedShader $ - drawTextureRec (renderTexture'texture rt) (Rectangle 0 0 (fromIntegral width) (fromIntegral $ - height)) (Vector2 0 0) white + drawTextureRec (renderTexture'texture rt) (Rectangle 0 0 (fromIntegral width) (fromIntegral $ -height)) (Vector2 0 0) white drawText "Press the left and right arrow keys to change the effect" 20 20 20 black drawText ("Current effect: " ++ shaderName) 20 50 20 black diff --git a/examples/raygui-suite/src/Main.hs b/examples/raygui-suite/src/Main.hs index 1903b0d..c96fa9f 100644 --- a/examples/raygui-suite/src/Main.hs +++ b/examples/raygui-suite/src/Main.hs @@ -2,20 +2,23 @@ module Main where -import Control.Monad (when, unless) +import Control.Monad (unless, when) import Data.Maybe (fromJust, fromMaybe, isNothing) import Raylib.Core (clearBackground, closeWindow, initWindow, isKeyPressed, setTargetFPS, windowShouldClose) import Raylib.Types - ( GuiControl (Statusbar), + ( Color, + GuiControl (Statusbar), GuiControlProperty (TextPadding), GuiState (StateDisabled), GuiTextAlignmentVertical (TextAlignMiddle), KeyboardKey (KeyE, KeyU), - Rectangle (Rectangle), Color, + Rectangle (Rectangle), ) import Raylib.Util (WindowResources, drawing, raylibApplication) import Raylib.Util.GUI ( guiButton, + guiCheckBox, + guiColorPicker, guiDisable, guiEnable, guiGetState, @@ -34,7 +37,7 @@ import Raylib.Util.GUI guiStatusBar, guiTextBox, guiUnlock, - guiWindowBox, guiCheckBox, guiColorPicker, + guiWindowBox, ) import Raylib.Util.GUI.Styles ( guiLoadStyleAmber, @@ -302,7 +305,7 @@ mainLoop state = do unless (oldState == StateDisabled) guiEnable when (theme' /= theme ps) (themes !! (fromMaybe 0 theme')) - return $ state { page2 = ps { scroll = scroll', theme = theme', useCustomBackground = custom', customBackground = Just color' }} + return $ state {page2 = ps {scroll = scroll', theme = theme', useCustomBackground = custom', customBackground = Just color'}} shouldClose :: AppState -> IO Bool shouldClose = const windowShouldClose diff --git a/h-raylib.cabal b/h-raylib.cabal index 1c87c1a..86a0918 100644 --- a/h-raylib.cabal +++ b/h-raylib.cabal @@ -45,7 +45,7 @@ data-files: source-repository head type: git - location: git://github.com/Anut-py/h-raylib.git + location: https://github.com/Anut-py/h-raylib.git flag detect-platform description: @@ -191,6 +191,7 @@ executable basic-audio import: example-options hs-source-dirs: examples/basic-audio/src main-is: Main.hs + ghc-options: -threaded -- rlgl executable basic-rlgl @@ -245,7 +246,7 @@ library , exceptions >=0.10.4 && <0.11 , lens >=4.0 && <5.4 , linear >=1.22 && <1.24 - , template-haskell >=2.16.0.0 && <2.23.0.0 + , template-haskell >=2.16 && <2.24 , text >=2.0 && <2.2 hs-source-dirs: src diff --git a/lib/rl_common.h b/lib/rl_common.h index fca3945..2830299 100644 --- a/lib/rl_common.h +++ b/lib/rl_common.h @@ -1,9 +1,10 @@ -#include -#include -#include -#include #include +#include "raylib.h" +#include "rlgl.h" +#include "raygui.h" +#include "config.h" + #ifndef RLBIND #ifdef __EMSCRIPTEN__ diff --git a/src/Raylib/Core.hs b/src/Raylib/Core.hs index d6c9473..791fb31 100644 --- a/src/Raylib/Core.hs +++ b/src/Raylib/Core.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rcore@ @@ -438,6 +440,7 @@ import Foreign ) import Foreign.C ( CBool (..), + CChar, CDouble (..), CFloat (..), CInt (..), @@ -452,7 +455,7 @@ import Foreign.C import Foreign.Ptr (nullPtr) import GHC.IO (unsafePerformIO) import Raylib.Internal (WindowResources, defaultWindowResources, releaseNonAudioWindowResources, shaderLocations, unloadSingleAutomationEventList, unloadSingleShader) -import Raylib.Internal.Foreign (configsToBitflag, pop, popCArray, popCString, withFreeable, withFreeableArray, withFreeableArrayLen, withMaybeCString) +import Raylib.Internal.Foreign (ALike (peekALike, popALike, withALike, withALikeLen), PALike, PLike, StringLike, TLike (peekTLike, popTLike, withTLike), configsToBitflag, pop, withFreeable, withMaybeCString) import Raylib.Internal.TH (genNative) import Raylib.Types ( AutomationEvent, @@ -483,7 +486,7 @@ import Raylib.Types RenderTexture, SaveFileDataCallback, SaveFileTextCallback, - Shader (shader'id), + Shader, ShaderUniformData, ShaderUniformDataV, Texture, @@ -493,6 +496,7 @@ import Raylib.Types Vector3, VrDeviceInfo, VrStereoConfig, + p'shader'id, unpackShaderUniformData, unpackShaderUniformDataV, ) @@ -773,11 +777,11 @@ minimizeWindow = c'minimizeWindow restoreWindow :: IO () restoreWindow = c'restoreWindow -setWindowIcon :: Image -> IO () -setWindowIcon image = withFreeable image c'setWindowIcon +setWindowIcon :: (PLike Image image) => image -> IO () +setWindowIcon image = withTLike image c'setWindowIcon -setWindowIcons :: [Image] -> IO () -setWindowIcons images = withFreeableArrayLen images (\l ptr -> c'setWindowIcons ptr (fromIntegral l)) +setWindowIcons :: (PALike Image images) => images -> IO () +setWindowIcons images = withALikeLen images (\l ptr -> c'setWindowIcons ptr (fromIntegral l)) setWindowTitle :: String -> IO () setWindowTitle title = withCString title c'setWindowTitle @@ -890,8 +894,8 @@ disableCursor = c'disableCursor isCursorOnScreen :: IO Bool isCursorOnScreen = toBool <$> c'isCursorOnScreen -clearBackground :: Color -> IO () -clearBackground color = withFreeable color c'clearBackground +clearBackground :: (PLike Color color) => color -> IO () +clearBackground color = withTLike color c'clearBackground beginDrawing :: IO () beginDrawing = c'beginDrawing @@ -899,26 +903,26 @@ beginDrawing = c'beginDrawing endDrawing :: IO () endDrawing = c'endDrawing -beginMode2D :: Camera2D -> IO () -beginMode2D camera = withFreeable camera c'beginMode2D +beginMode2D :: (PLike Camera2D camera2D) => camera2D -> IO () +beginMode2D camera = withTLike camera c'beginMode2D endMode2D :: IO () endMode2D = c'endMode2D -beginMode3D :: Camera3D -> IO () -beginMode3D camera = withFreeable camera c'beginMode3D +beginMode3D :: (PLike Camera3D camera3D) => camera3D -> IO () +beginMode3D camera = withTLike camera c'beginMode3D endMode3D :: IO () endMode3D = c'endMode3D -beginTextureMode :: RenderTexture -> IO () -beginTextureMode renderTexture = withFreeable renderTexture c'beginTextureMode +beginTextureMode :: (PLike RenderTexture renderTexture) => renderTexture -> IO () +beginTextureMode renderTexture = withTLike renderTexture c'beginTextureMode endTextureMode :: IO () endTextureMode = c'endTextureMode -beginShaderMode :: Shader -> IO () -beginShaderMode shader = withFreeable shader c'beginShaderMode +beginShaderMode :: (PLike Shader shader) => shader -> IO () +beginShaderMode shader = withTLike shader c'beginShaderMode endShaderMode :: IO () endShaderMode = c'endShaderMode @@ -935,103 +939,112 @@ beginScissorMode x y width height = c'beginScissorMode (fromIntegral x) (fromInt endScissorMode :: IO () endScissorMode = c'endScissorMode -beginVrStereoMode :: VrStereoConfig -> IO () -beginVrStereoMode config = withFreeable config c'beginVrStereoMode +beginVrStereoMode :: (PLike VrStereoConfig vrStereoConfig) => vrStereoConfig -> IO () +beginVrStereoMode config = withTLike config c'beginVrStereoMode endVrStereoMode :: IO () endVrStereoMode = c'endVrStereoMode -loadVrStereoConfig :: VrDeviceInfo -> IO VrStereoConfig -loadVrStereoConfig deviceInfo = withFreeable deviceInfo c'loadVrStereoConfig >>= pop - -loadShader :: Maybe String -> Maybe String -> IO Shader -loadShader vsFileName fsFileName = withMaybeCString vsFileName (withMaybeCString fsFileName . c'loadShader) >>= pop - -loadShaderFromMemory :: Maybe String -> Maybe String -> IO Shader -loadShaderFromMemory vsCode fsCode = withMaybeCString vsCode (withMaybeCString fsCode . c'loadShaderFromMemory) >>= pop - -isShaderValid :: Shader -> IO Bool -isShaderValid shader = toBool <$> withFreeable shader c'isShaderValid - -getShaderLocation :: Shader -> String -> WindowResources -> IO Int -getShaderLocation shader uniformName wr = do - let sId = shader'id shader - let sLocs = shaderLocations wr - locs <- readIORef sLocs - case Map.lookup sId locs of - Nothing -> do - idx <- locIdx - let newMap = Map.fromList [(uniformName, idx)] - modifyIORef' sLocs (Map.insert sId newMap) - return idx - Just m -> case Map.lookup uniformName m of - Nothing -> do - idx <- locIdx - let newMap = Map.insert uniformName idx m - modifyIORef' sLocs (Map.insert sId newMap) - return idx - Just val -> return val - where - locIdx = fromIntegral <$> withFreeable shader (withCString uniformName . c'getShaderLocation) - -getShaderLocationAttrib :: Shader -> String -> IO Int -getShaderLocationAttrib shader attribName = fromIntegral <$> withFreeable shader (withCString attribName . c'getShaderLocationAttrib) - -setShaderValue :: Shader -> String -> ShaderUniformData -> WindowResources -> IO () +loadVrStereoConfig :: (PLike VrStereoConfig vrStereoConfig) => VrDeviceInfo -> IO vrStereoConfig +loadVrStereoConfig deviceInfo = withFreeable deviceInfo c'loadVrStereoConfig >>= popTLike + +loadShader :: (PLike Shader shader) => Maybe String -> Maybe String -> IO shader +loadShader vsFileName fsFileName = withMaybeCString vsFileName (withMaybeCString fsFileName . c'loadShader) >>= popTLike + +loadShaderFromMemory :: (PLike Shader shader) => Maybe String -> Maybe String -> IO shader +loadShaderFromMemory vsCode fsCode = withMaybeCString vsCode (withMaybeCString fsCode . c'loadShaderFromMemory) >>= popTLike + +isShaderValid :: (PLike Shader shader) => shader -> IO Bool +isShaderValid shader = toBool <$> withTLike shader c'isShaderValid + +getShaderLocation :: (PLike Shader shader) => shader -> String -> WindowResources -> IO Int +getShaderLocation shader uniformName wr = + withTLike + shader + ( \shaderPtr -> do + sId <- fromIntegral <$> peek (p'shader'id shaderPtr) + let sLocs = shaderLocations wr + locIdx = fromIntegral <$> withCString uniformName (c'getShaderLocation shaderPtr) + locs <- readIORef sLocs + case Map.lookup sId locs of + Nothing -> do + idx <- locIdx + let newMap = Map.fromList [(uniformName, idx)] + modifyIORef' sLocs (Map.insert sId newMap) + return idx + Just m -> case Map.lookup uniformName m of + Nothing -> do + idx <- locIdx + let newMap = Map.insert uniformName idx m + modifyIORef' sLocs (Map.insert sId newMap) + return idx + Just val -> return val + ) + +getShaderLocationAttrib :: (PLike Shader shader) => shader -> String -> IO Int +getShaderLocationAttrib shader attribName = fromIntegral <$> withTLike shader (withCString attribName . c'getShaderLocationAttrib) + +setShaderValue :: (PLike Shader shader) => shader -> String -> ShaderUniformData -> WindowResources -> IO () setShaderValue shader uniformName value wr = do idx <- getShaderLocation shader uniformName wr nativeSetShaderValue shader idx value -setShaderValueV :: Shader -> String -> ShaderUniformDataV -> WindowResources -> IO () +setShaderValueV :: (PLike Shader shader) => shader -> String -> ShaderUniformDataV -> WindowResources -> IO () setShaderValueV shader uniformName values wr = do idx <- getShaderLocation shader uniformName wr nativeSetShaderValueV shader idx values -nativeSetShaderValue :: Shader -> Int -> ShaderUniformData -> IO () +nativeSetShaderValue :: (PLike Shader shader) => shader -> Int -> ShaderUniformData -> IO () nativeSetShaderValue shader locIndex value = do (uniformType, fptr) <- unpackShaderUniformData value - withFreeable shader (\s -> withForeignPtr fptr (\ptr -> c'setShaderValue s (fromIntegral locIndex) ptr (fromIntegral $ fromEnum uniformType))) + withTLike shader (\s -> withForeignPtr fptr (\ptr -> c'setShaderValue s (fromIntegral locIndex) ptr (fromIntegral $ fromEnum uniformType))) finalizeForeignPtr fptr -nativeSetShaderValueV :: Shader -> Int -> ShaderUniformDataV -> IO () +nativeSetShaderValueV :: (PLike Shader shader) => shader -> Int -> ShaderUniformDataV -> IO () nativeSetShaderValueV shader locIndex values = do (uniformType, fptr, l) <- unpackShaderUniformDataV values - withFreeable shader (\s -> withForeignPtr fptr (\ptr -> c'setShaderValueV s (fromIntegral locIndex) ptr (fromIntegral $ fromEnum uniformType) (fromIntegral l))) + withTLike shader (\s -> withForeignPtr fptr (\ptr -> c'setShaderValueV s (fromIntegral locIndex) ptr (fromIntegral $ fromEnum uniformType) (fromIntegral l))) finalizeForeignPtr fptr -setShaderValueMatrix :: Shader -> Int -> Matrix -> IO () -setShaderValueMatrix shader locIndex mat = withFreeable shader (\s -> withFreeable mat (c'setShaderValueMatrix s (fromIntegral locIndex))) +setShaderValueMatrix :: (PLike Shader shader) => shader -> Int -> Matrix -> IO () +setShaderValueMatrix shader locIndex mat = withTLike shader (\s -> withFreeable mat (c'setShaderValueMatrix s (fromIntegral locIndex))) -setShaderValueTexture :: Shader -> Int -> Texture -> IO () -setShaderValueTexture shader locIndex tex = withFreeable shader (\s -> withFreeable tex (c'setShaderValueTexture s (fromIntegral locIndex))) +setShaderValueTexture :: (PLike Shader shader) => shader -> Int -> Texture -> IO () +setShaderValueTexture shader locIndex tex = withTLike shader (\s -> withFreeable tex (c'setShaderValueTexture s (fromIntegral locIndex))) -- | Unloads a `managed` shader from GPU memory (VRAM) -unloadShader :: Shader -> WindowResources -> IO () -unloadShader shader = unloadSingleShader (shader'id shader) +unloadShader :: (PLike Shader shader) => shader -> WindowResources -> IO () +unloadShader shader wr = + withTLike + shader + ( \shaderPtr -> do + sId <- peek (p'shader'id shaderPtr) + unloadSingleShader sId wr + ) -getScreenToWorldRay :: Vector2 -> Camera3D -> IO Ray -getScreenToWorldRay position camera = withFreeable position (withFreeable camera . c'getScreenToWorldRay) >>= pop +getScreenToWorldRay :: (PLike Camera3D camera3D) => Vector2 -> camera3D -> IO Ray +getScreenToWorldRay position camera = withFreeable position (withTLike camera . c'getScreenToWorldRay) >>= pop -getScreenToWorldRayEx :: Vector2 -> Camera3D -> Float -> Float -> Ray -getScreenToWorldRayEx position camera width height = unsafePerformIO $ withFreeable position (\p -> withFreeable camera (\c -> c'getScreenToWorldRayEx p c (realToFrac width) (realToFrac height))) >>= pop +getScreenToWorldRayEx :: (PLike Camera3D camera3D) => Vector2 -> camera3D -> Float -> Float -> Ray +getScreenToWorldRayEx position camera width height = unsafePerformIO $ withFreeable position (\p -> withTLike camera (\c -> c'getScreenToWorldRayEx p c (realToFrac width) (realToFrac height))) >>= pop -getCameraMatrix :: Camera3D -> Matrix -getCameraMatrix camera = unsafePerformIO $ withFreeable camera c'getCameraMatrix >>= pop +getCameraMatrix :: (PLike Camera3D camera3D, PLike Matrix matrix) => camera3D -> matrix +getCameraMatrix camera = unsafePerformIO $ withTLike camera c'getCameraMatrix >>= popTLike -getCameraMatrix2D :: Camera2D -> Matrix -getCameraMatrix2D camera = unsafePerformIO $ withFreeable camera c'getCameraMatrix2D >>= pop +getCameraMatrix2D :: (PLike Camera2D camera2D, PLike Matrix matrix) => camera2D -> matrix +getCameraMatrix2D camera = unsafePerformIO $ withTLike camera c'getCameraMatrix2D >>= popTLike -getWorldToScreen :: Vector3 -> Camera3D -> IO Vector2 -getWorldToScreen position camera = withFreeable position (withFreeable camera . c'getWorldToScreen) >>= pop +getWorldToScreen :: (PLike Camera3D camera3D) => Vector3 -> camera3D -> IO Vector2 +getWorldToScreen position camera = withFreeable position (withTLike camera . c'getWorldToScreen) >>= pop -getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> Vector2 -getWorldToScreenEx position camera width height = unsafePerformIO $ withFreeable position (\p -> withFreeable camera (\c -> c'getWorldToScreenEx p c (fromIntegral width) (fromIntegral height))) >>= pop +getWorldToScreenEx :: (PLike Camera3D camera3D) => Vector3 -> camera3D -> Int -> Int -> Vector2 +getWorldToScreenEx position camera width height = unsafePerformIO $ withFreeable position (\p -> withTLike camera (\c -> c'getWorldToScreenEx p c (fromIntegral width) (fromIntegral height))) >>= pop -getWorldToScreen2D :: Vector2 -> Camera2D -> Vector2 -getWorldToScreen2D position camera = unsafePerformIO $ withFreeable position (withFreeable camera . c'getWorldToScreen2D) >>= pop +getWorldToScreen2D :: (PLike Camera2D camera2D) => Vector2 -> camera2D -> Vector2 +getWorldToScreen2D position camera = unsafePerformIO $ withFreeable position (withTLike camera . c'getWorldToScreen2D) >>= pop -getScreenToWorld2D :: Vector2 -> Camera2D -> Vector2 -getScreenToWorld2D position camera = unsafePerformIO $ withFreeable position (withFreeable camera . c'getScreenToWorld2D) >>= pop +getScreenToWorld2D :: (PLike Camera2D camera2D) => Vector2 -> camera2D -> Vector2 +getScreenToWorld2D position camera = unsafePerformIO $ withFreeable position (withTLike camera . c'getScreenToWorld2D) >>= pop setTargetFPS :: Int -> IO () setTargetFPS fps = c'setTargetFPS $ fromIntegral fps @@ -1051,23 +1064,23 @@ setRandomSeed seed = c'setRandomSeed $ fromIntegral seed getRandomValue :: Int -> Int -> IO Int getRandomValue minVal maxVal = fromIntegral <$> c'getRandomValue (fromIntegral minVal) (fromIntegral maxVal) -loadRandomSequence :: Integer -> Int -> Int -> IO [Int] -loadRandomSequence count rMin rMax = map fromIntegral <$> (popCArray (fromIntegral count) =<< c'loadRandomSequence (fromIntegral count) (fromIntegral rMin) (fromIntegral rMax)) +loadRandomSequence :: (PALike CInt sequence) => Integer -> Int -> Int -> IO sequence +loadRandomSequence count rMin rMax = popALike (fromIntegral count) =<< c'loadRandomSequence (fromIntegral count) (fromIntegral rMin) (fromIntegral rMax) -takeScreenshot :: String -> IO () -takeScreenshot fileName = withCString fileName c'takeScreenshot +takeScreenshot :: (StringLike string) => string -> IO () +takeScreenshot fileName = withTLike fileName c'takeScreenshot setConfigFlags :: [ConfigFlag] -> IO () setConfigFlags flags = c'setConfigFlags $ fromIntegral $ configsToBitflag flags -traceLog :: TraceLogLevel -> String -> IO () -traceLog logLevel text = withCString text $ c'traceLog $ fromIntegral $ fromEnum logLevel +traceLog :: (StringLike string) => TraceLogLevel -> string -> IO () +traceLog logLevel text = withTLike text $ c'traceLog $ fromIntegral $ fromEnum logLevel setTraceLogLevel :: TraceLogLevel -> IO () setTraceLogLevel = c'setTraceLogLevel . fromIntegral . fromEnum -openURL :: String -> IO () -openURL url = withCString url c'openURL +openURL :: (StringLike string) => string -> IO () +openURL url = withTLike url c'openURL setTraceLogCallback :: TraceLogCallback -> IO () setTraceLogCallback callback = do @@ -1094,193 +1107,185 @@ setSaveFileTextCallback callback = do c <- createSaveFileTextCallback callback c'setSaveFileTextCallback c -loadFileData :: String -> IO [Integer] +loadFileData :: (StringLike string, PALike CUChar contents) => string -> IO contents loadFileData fileName = withFreeable 0 ( \size -> do - withCString + withTLike fileName ( \path -> do ptr <- c'loadFileData path size arrSize <- fromIntegral <$> peek size - map fromIntegral <$> popCArray arrSize ptr + popALike arrSize ptr ) ) -saveFileData :: (Storable a) => String -> Ptr a -> Integer -> IO Bool +saveFileData :: (StringLike string, PALike CUChar contents) => string -> contents -> Integer -> IO Bool saveFileData fileName contents bytesToWrite = - toBool <$> withCString fileName (\s -> c'saveFileData s (castPtr contents) (fromIntegral bytesToWrite)) + toBool <$> withTLike fileName (\s -> withALike contents (\(c :: Ptr CUChar) -> c'saveFileData s (castPtr c) (fromIntegral bytesToWrite))) -exportDataAsCode :: [Integer] -> Integer -> String -> IO Bool +exportDataAsCode :: (PALike CUChar contents, StringLike string) => contents -> Integer -> string -> IO Bool exportDataAsCode contents size fileName = - toBool <$> withFreeableArray (map fromInteger contents) (\c -> withCString fileName (c'exportDataAsCode c (fromIntegral size))) + toBool <$> withALike contents (\(c :: Ptr CUChar) -> withTLike fileName (c'exportDataAsCode (castPtr c) (fromIntegral size))) -loadFileText :: String -> IO String -loadFileText fileName = withCString fileName c'loadFileText >>= popCString +loadFileText :: (StringLike string1, StringLike string2) => string1 -> IO string2 +loadFileText fileName = withTLike fileName c'loadFileText >>= popTLike -saveFileText :: String -> String -> IO Bool -saveFileText fileName text = toBool <$> withCString fileName (withCString text . c'saveFileText) +saveFileText :: (StringLike string1, StringLike string2) => string1 -> string2 -> IO Bool +saveFileText fileName text = toBool <$> withTLike fileName (withTLike text . c'saveFileText) -fileExists :: String -> IO Bool -fileExists fileName = toBool <$> withCString fileName c'fileExists +fileExists :: (StringLike string) => string -> IO Bool +fileExists fileName = toBool <$> withTLike fileName c'fileExists -directoryExists :: String -> IO Bool -directoryExists dirPath = toBool <$> withCString dirPath c'directoryExists +directoryExists :: (StringLike string) => string -> IO Bool +directoryExists dirPath = toBool <$> withTLike dirPath c'directoryExists -isFileExtension :: String -> String -> IO Bool -isFileExtension fileName ext = toBool <$> withCString fileName (withCString ext . c'isFileExtension) +isFileExtension :: (StringLike string1, StringLike string2) => string1 -> string2 -> IO Bool +isFileExtension fileName ext = toBool <$> withTLike fileName (withTLike ext . c'isFileExtension) -getFileLength :: String -> IO Bool -getFileLength fileName = toBool <$> withCString fileName c'getFileLength +getFileLength :: (StringLike string) => string -> IO Bool +getFileLength fileName = toBool <$> withTLike fileName c'getFileLength -getFileExtension :: String -> IO String -getFileExtension fileName = withCString fileName c'getFileExtension >>= peekCString +getFileExtension :: (StringLike string1, StringLike string2) => string1 -> IO string2 +getFileExtension fileName = withTLike fileName c'getFileExtension >>= peekTLike -getFileName :: String -> IO String -getFileName filePath = withCString filePath c'getFileName >>= peekCString +getFileName :: (StringLike string1, StringLike string2) => string1 -> IO string2 +getFileName filePath = withTLike filePath c'getFileName >>= peekTLike -getFileNameWithoutExt :: String -> IO String -getFileNameWithoutExt fileName = withCString fileName c'getFileNameWithoutExt >>= peekCString +getFileNameWithoutExt :: (StringLike string1, StringLike string2) => string1 -> IO string2 +getFileNameWithoutExt fileName = withTLike fileName c'getFileNameWithoutExt >>= peekTLike -getDirectoryPath :: String -> IO String -getDirectoryPath filePath = withCString filePath c'getDirectoryPath >>= peekCString +getDirectoryPath :: (StringLike string1, StringLike string2) => string1 -> IO string2 +getDirectoryPath filePath = withTLike filePath c'getDirectoryPath >>= peekTLike -getPrevDirectoryPath :: String -> IO String -getPrevDirectoryPath dirPath = withCString dirPath c'getPrevDirectoryPath >>= peekCString +getPrevDirectoryPath :: (StringLike string1, StringLike string2) => string1 -> IO string2 +getPrevDirectoryPath dirPath = withTLike dirPath c'getPrevDirectoryPath >>= peekTLike -getWorkingDirectory :: IO String -getWorkingDirectory = c'getWorkingDirectory >>= peekCString +getWorkingDirectory :: (StringLike string) => IO string +getWorkingDirectory = c'getWorkingDirectory >>= peekTLike -getApplicationDirectory :: IO String -getApplicationDirectory = c'getApplicationDirectory >>= peekCString +getApplicationDirectory :: (StringLike string) => IO string +getApplicationDirectory = c'getApplicationDirectory >>= peekTLike -makeDirectory :: String -> IO Bool -makeDirectory dirPath = (== 0) <$> withCString dirPath c'makeDirectory +makeDirectory :: (StringLike string) => string -> IO Bool +makeDirectory dirPath = (== 0) <$> withTLike dirPath c'makeDirectory -changeDirectory :: String -> IO Bool -changeDirectory dir = toBool <$> withCString dir c'changeDirectory +changeDirectory :: (StringLike string) => string -> IO Bool +changeDirectory dir = toBool <$> withTLike dir c'changeDirectory -isPathFile :: String -> IO Bool -isPathFile path = toBool <$> withCString path c'isPathFile +isPathFile :: (StringLike string) => string -> IO Bool +isPathFile path = toBool <$> withTLike path c'isPathFile -isFileNameValid :: String -> IO Bool -isFileNameValid path = toBool <$> withCString path c'isFileNameValid +isFileNameValid :: (StringLike string) => string -> IO Bool +isFileNameValid path = toBool <$> withTLike path c'isFileNameValid -loadDirectoryFiles :: String -> IO FilePathList -loadDirectoryFiles dirPath = withCString dirPath c'loadDirectoryFiles >>= pop +loadDirectoryFiles :: (StringLike string, PLike FilePathList filePathList) => string -> IO filePathList +loadDirectoryFiles dirPath = withTLike dirPath c'loadDirectoryFiles >>= popTLike -loadDirectoryFilesEx :: String -> String -> Bool -> IO FilePathList +loadDirectoryFilesEx :: (StringLike string1, StringLike string2, PLike FilePathList filePathList) => string1 -> string2 -> Bool -> IO filePathList loadDirectoryFilesEx basePath filterStr scanSubdirs = - withCString basePath (\b -> withCString filterStr (\f -> c'loadDirectoryFilesEx b f (fromBool scanSubdirs))) >>= pop + withTLike basePath (\b -> withTLike filterStr (\f -> c'loadDirectoryFilesEx b f (fromBool scanSubdirs))) >>= popTLike isFileDropped :: IO Bool isFileDropped = toBool <$> c'isFileDropped -loadDroppedFiles :: IO FilePathList -loadDroppedFiles = do - ptr <- c'loadDroppedFiles - val <- peek ptr - c'unloadDroppedFiles ptr - return val +loadDroppedFiles :: (PLike FilePathList filePathList) => IO filePathList +loadDroppedFiles = popTLike =<< c'loadDroppedFiles -getFileModTime :: String -> IO Integer -getFileModTime fileName = fromIntegral <$> withCString fileName c'getFileModTime +getFileModTime :: (StringLike string) => string -> IO Integer +getFileModTime fileName = fromIntegral <$> withTLike fileName c'getFileModTime -compressData :: [Integer] -> IO [Integer] +compressData :: (PALike CUChar contents1, PALike CUChar contents2) => contents1 -> IO contents2 compressData contents = do - withFreeableArrayLen - (map fromIntegral contents) + withALikeLen + contents ( \size c -> do withFreeable 0 ( \ptr -> do compressed <- c'compressData c (fromIntegral $ size * sizeOf (0 :: CUChar)) ptr compressedSize <- fromIntegral <$> peek ptr - arr <- peekArray compressedSize compressed - return $ map fromIntegral arr + peekALike compressedSize compressed ) ) -decompressData :: [Integer] -> IO [Integer] +decompressData :: (PALike CUChar contents1, PALike CUChar contents2) => contents1 -> IO contents2 decompressData compressedData = do - withFreeableArrayLen - (map fromIntegral compressedData) + withALikeLen + compressedData ( \size c -> do withFreeable 0 ( \ptr -> do decompressed <- c'decompressData c (fromIntegral $ size * sizeOf (0 :: CUChar)) ptr decompressedSize <- fromIntegral <$> peek ptr - arr <- peekArray decompressedSize decompressed - return $ map fromIntegral arr + peekALike decompressedSize decompressed ) ) -encodeDataBase64 :: [Integer] -> IO [Integer] +encodeDataBase64 :: (PALike CUChar contents, PALike CChar string) => contents -> IO string encodeDataBase64 contents = do - withFreeableArrayLen - (map fromIntegral contents) + withALikeLen + contents ( \size c -> do withFreeable 0 ( \ptr -> do encoded <- c'encodeDataBase64 c (fromIntegral $ size * sizeOf (0 :: CUChar)) ptr encodedSize <- fromIntegral <$> peek ptr - arr <- peekArray encodedSize encoded - return $ map fromIntegral arr + peekALike encodedSize encoded ) ) -decodeDataBase64 :: [Integer] -> IO [Integer] +decodeDataBase64 :: (PALike CChar string, PALike CUChar contents) => string -> IO contents decodeDataBase64 encodedData = do - withFreeableArray - (map fromIntegral encodedData) - ( \c -> do + withALike + encodedData + ( \(c :: Ptr CChar) -> do withFreeable 0 ( \ptr -> do - decoded <- c'decodeDataBase64 c ptr + decoded <- c'decodeDataBase64 (castPtr c) ptr decodedSize <- fromIntegral <$> peek ptr - arr <- peekArray decodedSize decoded - return $ map fromIntegral arr + peekALike decodedSize decoded ) ) -computeCRC32 :: [Integer] -> IO Integer +computeCRC32 :: (PALike CUChar contents) => contents -> IO Integer computeCRC32 contents = do - withFreeableArrayLen - (map fromIntegral contents) + withALikeLen + contents (\size c -> fromIntegral <$> c'computeCRC32 c (fromIntegral $ size * sizeOf (0 :: CUChar))) -computeMD5 :: [Integer] -> IO [Integer] +computeMD5 :: (PALike CUChar contents) => contents -> IO [Integer] computeMD5 contents = do - withFreeableArrayLen - (map fromIntegral contents) + withALikeLen + contents ( \size c -> do encoded <- c'computeMD5 c (fromIntegral $ size * sizeOf (0 :: CUChar)) arr <- peekArray 4 encoded return $ map fromIntegral arr ) -computeSHA1 :: [Integer] -> IO [Integer] +computeSHA1 :: (PALike CUChar contents) => contents -> IO [Integer] computeSHA1 contents = do - withFreeableArrayLen - (map fromIntegral contents) + withALikeLen + contents ( \size c -> do encoded <- c'computeSHA1 c (fromIntegral $ size * sizeOf (0 :: CUChar)) arr <- peekArray 5 encoded return $ map fromIntegral arr ) -loadAutomationEventList :: String -> IO AutomationEventList -loadAutomationEventList fileName = withCString fileName c'loadAutomationEventList >>= pop +loadAutomationEventList :: (StringLike string) => string -> IO AutomationEventList +loadAutomationEventList fileName = withTLike fileName c'loadAutomationEventList >>= pop newAutomationEventList :: IO AutomationEventList newAutomationEventList = c'loadAutomationEventList nullPtr >>= pop -exportAutomationEventList :: AutomationEventList -> String -> IO Bool -exportAutomationEventList list fileName = toBool <$> withFreeable list (withCString fileName . c'exportAutomationEventList) +exportAutomationEventList :: (PLike AutomationEventList automationEventList, StringLike string) => automationEventList -> string -> IO Bool +exportAutomationEventList list fileName = toBool <$> withTLike list (withTLike fileName . c'exportAutomationEventList) setAutomationEventList :: AutomationEventList -> IO AutomationEventListRef setAutomationEventList list = do @@ -1298,8 +1303,8 @@ startAutomationEventRecording = c'startAutomationEventRecording stopAutomationEventRecording :: IO () stopAutomationEventRecording = c'stopAutomationEventRecording -playAutomationEvent :: AutomationEvent -> IO () -playAutomationEvent event = withFreeable event c'playAutomationEvent +playAutomationEvent :: (PLike AutomationEvent automationEvent) => automationEvent -> IO () +playAutomationEvent event = withTLike event c'playAutomationEvent peekAutomationEventList :: AutomationEventListRef -> IO AutomationEventList peekAutomationEventList = peek diff --git a/src/Raylib/Core/Audio.hs b/src/Raylib/Core/Audio.hs index 1f6e043..02af38f 100644 --- a/src/Raylib/Core/Audio.hs +++ b/src/Raylib/Core/Audio.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-} @@ -143,7 +144,7 @@ module Raylib.Core.Audio ) where -import Foreign (Ptr, Storable (peek, sizeOf), castPtr, toBool, castFunPtr) +import Foreign (Ptr, Storable (peek, sizeOf), castFunPtr, castPtr, toBool) import Foreign.C ( CBool (..), CFloat (..), @@ -153,21 +154,29 @@ import Foreign.C CUInt (..), withCString, ) -import Raylib.Internal (WindowResources, unloadSingleAudioBuffer, unloadSingleAudioBufferAlias, unloadSingleCtxDataPtr, addFunPtr, unloadSingleFunPtr, releaseAudioWindowResources) +import Raylib.Internal (WindowResources, addFunPtr, releaseAudioWindowResources, unloadSingleAudioBuffer, unloadSingleAudioBufferAlias, unloadSingleCtxDataPtr, unloadSingleFunPtr) import Raylib.Internal.Foreign - ( pop, - popCArray, - withFreeable, - withFreeableArrayLen, + ( ALike (..), + Mutable (peekMutated), + PALike, + PLike, + StringLike, + TLike (..), ) import Raylib.Internal.TH (genNative) import Raylib.Types ( AudioCallback, - AudioStream (audioStream'buffer), + AudioStream, C'AudioCallback, - Music (music'ctxData, music'ctxType), - Sound (sound'stream), - Wave (wave'channels, wave'frameCount), + Music, + Sound, + Wave, + p'audioStream'buffer, + p'music'ctxData, + p'music'ctxType, + p'sound'stream, + p'wave'channels, + p'wave'frameCount, ) $( genNative @@ -257,183 +266,208 @@ setMasterVolume volume = c'setMasterVolume (realToFrac volume) getMasterVolume :: IO Float getMasterVolume = realToFrac <$> c'getMasterVolume -loadWave :: String -> IO Wave -loadWave fileName = withCString fileName c'loadWave >>= pop +loadWave :: (StringLike string, PLike Wave wave) => string -> IO wave +loadWave fileName = withTLike fileName c'loadWave >>= popTLike -loadWaveFromMemory :: String -> [Integer] -> IO Wave -loadWaveFromMemory fileType fileData = withCString fileType (\f -> withFreeableArrayLen (map fromIntegral fileData) (\size d -> c'loadWaveFromMemory f d (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= pop +loadWaveFromMemory :: (PALike CUChar contents, PLike Wave wave) => String -> contents -> IO wave +loadWaveFromMemory fileType fileData = withCString fileType (\f -> withALikeLen fileData (\size d -> c'loadWaveFromMemory f d (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= popTLike -loadSound :: String -> IO Sound -loadSound fileName = withCString fileName c'loadSound >>= pop +loadSound :: (StringLike string, PLike Sound sound) => string -> IO sound +loadSound fileName = withTLike fileName c'loadSound >>= popTLike -loadSoundFromWave :: Wave -> IO Sound -loadSoundFromWave wave = withFreeable wave c'loadSoundFromWave >>= pop +loadSoundFromWave :: (PLike Wave wave, PLike Sound sound) => wave -> IO sound +loadSoundFromWave wave = withTLike wave c'loadSoundFromWave >>= popTLike -loadSoundAlias :: Sound -> IO Sound -loadSoundAlias source = withFreeable source c'loadSoundAlias >>= pop +loadSoundAlias :: (PLike Sound sound1, PLike Sound sound2) => sound1 -> IO sound2 +loadSoundAlias source = withTLike source c'loadSoundAlias >>= popTLike -- | Unloads a `managed` sound alias from RAM -unloadSoundAlias :: Sound -> WindowResources -> IO () -unloadSoundAlias sound = unloadSingleAudioBufferAlias (castPtr (audioStream'buffer (sound'stream sound))) +unloadSoundAlias :: (PLike Sound sound) => sound -> WindowResources -> IO () +unloadSoundAlias sound wr = + withTLike + sound + ( \soundPtr -> do + buf <- castPtr <$> peek (p'audioStream'buffer (p'sound'stream soundPtr)) + unloadSingleAudioBufferAlias buf wr + ) -updateSound :: Sound -> Ptr () -> Int -> IO () -updateSound sound dataValue sampleCount = withFreeable sound (\s -> c'updateSound s dataValue (fromIntegral sampleCount)) +updateSound :: (PLike Sound sound) => sound -> Ptr () -> Int -> IO () +updateSound sound dataValue sampleCount = withTLike sound (\s -> c'updateSound s dataValue (fromIntegral sampleCount)) -- | Unloads a `managed` sound from RAM -unloadSound :: Sound -> WindowResources -> IO () -unloadSound sound = unloadAudioStream (sound'stream sound) +unloadSound :: (PLike Sound sound) => sound -> WindowResources -> IO () +unloadSound sound wr = + withTLike + sound + ( \soundPtr -> do + stream <- peek (p'sound'stream soundPtr) + unloadAudioStream stream wr + ) -isWaveValid :: Wave -> IO Bool -isWaveValid wave = toBool <$> withFreeable wave c'isWaveValid +isWaveValid :: (PLike Wave wave) => wave -> IO Bool +isWaveValid wave = toBool <$> withTLike wave c'isWaveValid -isSoundValid :: Sound -> IO Bool -isSoundValid sound = toBool <$> withFreeable sound c'isSoundValid +isSoundValid :: (PLike Sound sound) => sound -> IO Bool +isSoundValid sound = toBool <$> withTLike sound c'isSoundValid -exportWave :: Wave -> String -> IO Bool -exportWave wave fileName = toBool <$> withFreeable wave (withCString fileName . c'exportWave) +exportWave :: (PLike Wave wave, StringLike string) => wave -> string -> IO Bool +exportWave wave fileName = toBool <$> withTLike wave (withTLike fileName . c'exportWave) -exportWaveAsCode :: Wave -> String -> IO Bool -exportWaveAsCode wave fileName = toBool <$> withFreeable wave (withCString fileName . c'exportWaveAsCode) +exportWaveAsCode :: (PLike Wave wave, StringLike string) => wave -> string -> IO Bool +exportWaveAsCode wave fileName = toBool <$> withTLike wave (withTLike fileName . c'exportWaveAsCode) -playSound :: Sound -> IO () -playSound sound = withFreeable sound c'playSound +playSound :: (PLike Sound sound) => sound -> IO () +playSound sound = withTLike sound c'playSound -stopSound :: Sound -> IO () -stopSound sound = withFreeable sound c'stopSound +stopSound :: (PLike Sound sound) => sound -> IO () +stopSound sound = withTLike sound c'stopSound -pauseSound :: Sound -> IO () -pauseSound sound = withFreeable sound c'pauseSound +pauseSound :: (PLike Sound sound) => sound -> IO () +pauseSound sound = withTLike sound c'pauseSound -resumeSound :: Sound -> IO () -resumeSound sound = withFreeable sound c'resumeSound +resumeSound :: (PLike Sound sound) => sound -> IO () +resumeSound sound = withTLike sound c'resumeSound -isSoundPlaying :: Sound -> IO Bool -isSoundPlaying sound = toBool <$> withFreeable sound c'isSoundPlaying +isSoundPlaying :: (PLike Sound sound) => sound -> IO Bool +isSoundPlaying sound = toBool <$> withTLike sound c'isSoundPlaying -setSoundVolume :: Sound -> Float -> IO () -setSoundVolume sound volume = withFreeable sound (\s -> c'setSoundVolume s (realToFrac volume)) +setSoundVolume :: (PLike Sound sound) => sound -> Float -> IO () +setSoundVolume sound volume = withTLike sound (\s -> c'setSoundVolume s (realToFrac volume)) -setSoundPitch :: Sound -> Float -> IO () -setSoundPitch sound pitch = withFreeable sound (\s -> c'setSoundPitch s (realToFrac pitch)) +setSoundPitch :: (PLike Sound sound) => sound -> Float -> IO () +setSoundPitch sound pitch = withTLike sound (\s -> c'setSoundPitch s (realToFrac pitch)) -setSoundPan :: Sound -> Float -> IO () -setSoundPan sound pan = withFreeable sound (\s -> c'setSoundPan s (realToFrac pan)) +setSoundPan :: (PLike Sound sound) => sound -> Float -> IO () +setSoundPan sound pan = withTLike sound (\s -> c'setSoundPan s (realToFrac pan)) -waveCopy :: Wave -> IO Wave -waveCopy wave = withFreeable wave c'waveCopy >>= pop +waveCopy :: (PLike Wave wave) => wave -> IO wave +waveCopy wave = withTLike wave c'waveCopy >>= popTLike -waveCrop :: Wave -> Int -> Int -> IO Wave -waveCrop wave initFrame finalFrame = do - new <- waveCopy wave - withFreeable new (\w -> c'waveCrop w (fromIntegral initFrame) (fromIntegral finalFrame) >> peek w) +waveCrop :: (PLike Wave wave, Mutable wave mut) => wave -> Int -> Int -> IO mut +waveCrop wave initFrame finalFrame = withTLike wave (\w -> c'waveCrop w (fromIntegral initFrame) (fromIntegral finalFrame) >> peekMutated wave w) -waveFormat :: Wave -> Int -> Int -> Int -> IO () -waveFormat wave sampleRate sampleSize channels = do - new <- waveCopy wave - withFreeable new (\n -> c'waveFormat n (fromIntegral sampleRate) (fromIntegral sampleSize) (fromIntegral channels)) +waveFormat :: (PLike Wave wave, Mutable wave mut) => wave -> Int -> Int -> Int -> IO mut +waveFormat wave sampleRate sampleSize channels = withTLike wave (\w -> c'waveFormat w (fromIntegral sampleRate) (fromIntegral sampleSize) (fromIntegral channels) >> peekMutated wave w) -loadWaveSamples :: Wave -> IO [Float] +loadWaveSamples :: (PLike Wave wave, PALike CFloat samples) => wave -> IO samples loadWaveSamples wave = - withFreeable + withTLike wave - (\w -> map realToFrac <$> (popCArray (fromIntegral $ wave'frameCount wave * wave'channels wave) =<< c'loadWaveSamples w)) + ( \wavePtr -> do + fc <- peek (p'wave'frameCount wavePtr) + c <- peek (p'wave'channels wavePtr) + popALike (fromIntegral $ fc * c) =<< c'loadWaveSamples wavePtr + ) -loadMusicStream :: String -> IO Music -loadMusicStream fileName = withCString fileName c'loadMusicStream >>= pop +loadMusicStream :: (StringLike string, PLike Music music) => string -> IO music +loadMusicStream fileName = withTLike fileName c'loadMusicStream >>= popTLike -loadMusicStreamFromMemory :: String -> [Integer] -> IO Music +loadMusicStreamFromMemory :: (PALike CUChar contents, PLike Music music) => String -> contents -> IO music loadMusicStreamFromMemory fileType streamData = - withCString fileType (\t -> withFreeableArrayLen (map fromIntegral streamData) (\size d -> c'loadMusicStreamFromMemory t d (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= pop + withCString fileType (\t -> withALikeLen streamData (\size d -> c'loadMusicStreamFromMemory t d (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= popTLike -- | Unloads a `managed` music stream from RAM -unloadMusicStream :: Music -> WindowResources -> IO () -unloadMusicStream music = unloadSingleCtxDataPtr (fromEnum (music'ctxType music)) (music'ctxData music) +unloadMusicStream :: (PLike Music music) => music -> WindowResources -> IO () +unloadMusicStream music wr = + withTLike + music + ( \musicPtr -> do + ct <- peek (p'music'ctxType musicPtr) + cd <- peek (p'music'ctxData musicPtr) + unloadSingleCtxDataPtr (fromEnum ct) cd wr + ) -isMusicValid :: Music -> IO Bool -isMusicValid music = toBool <$> withFreeable music c'isMusicValid +isMusicValid :: (PLike Music music) => music -> IO Bool +isMusicValid music = toBool <$> withTLike music c'isMusicValid -playMusicStream :: Music -> IO () -playMusicStream music = withFreeable music c'playMusicStream +playMusicStream :: (PLike Music music) => music -> IO () +playMusicStream music = withTLike music c'playMusicStream -isMusicStreamPlaying :: Music -> IO Bool -isMusicStreamPlaying music = toBool <$> withFreeable music c'isMusicStreamPlaying +isMusicStreamPlaying :: (PLike Music music) => music -> IO Bool +isMusicStreamPlaying music = toBool <$> withTLike music c'isMusicStreamPlaying -updateMusicStream :: Music -> IO () -updateMusicStream music = withFreeable music c'updateMusicStream +updateMusicStream :: (PLike Music music) => music -> IO () +updateMusicStream music = withTLike music c'updateMusicStream -stopMusicStream :: Music -> IO () -stopMusicStream music = withFreeable music c'stopMusicStream +stopMusicStream :: (PLike Music music) => music -> IO () +stopMusicStream music = withTLike music c'stopMusicStream -pauseMusicStream :: Music -> IO () -pauseMusicStream music = withFreeable music c'pauseMusicStream +pauseMusicStream :: (PLike Music music) => music -> IO () +pauseMusicStream music = withTLike music c'pauseMusicStream -resumeMusicStream :: Music -> IO () -resumeMusicStream music = withFreeable music c'resumeMusicStream +resumeMusicStream :: (PLike Music music) => music -> IO () +resumeMusicStream music = withTLike music c'resumeMusicStream -seekMusicStream :: Music -> Float -> IO () -seekMusicStream music position = withFreeable music (\m -> c'seekMusicStream m (realToFrac position)) +seekMusicStream :: (PLike Music music) => music -> Float -> IO () +seekMusicStream music position = withTLike music (\m -> c'seekMusicStream m (realToFrac position)) -setMusicVolume :: Music -> Float -> IO () -setMusicVolume music volume = withFreeable music (\m -> c'setMusicVolume m (realToFrac volume)) +setMusicVolume :: (PLike Music music) => music -> Float -> IO () +setMusicVolume music volume = withTLike music (\m -> c'setMusicVolume m (realToFrac volume)) -setMusicPitch :: Music -> Float -> IO () -setMusicPitch music pitch = withFreeable music (\m -> c'setMusicPitch m (realToFrac pitch)) +setMusicPitch :: (PLike Music music) => music -> Float -> IO () +setMusicPitch music pitch = withTLike music (\m -> c'setMusicPitch m (realToFrac pitch)) -setMusicPan :: Music -> Float -> IO () -setMusicPan music pan = withFreeable music (\m -> c'setMusicPan m (realToFrac pan)) +setMusicPan :: (PLike Music music) => music -> Float -> IO () +setMusicPan music pan = withTLike music (\m -> c'setMusicPan m (realToFrac pan)) -getMusicTimeLength :: Music -> IO Float -getMusicTimeLength music = realToFrac <$> withFreeable music c'getMusicTimeLength +getMusicTimeLength :: (PLike Music music) => music -> IO Float +getMusicTimeLength music = realToFrac <$> withTLike music c'getMusicTimeLength -getMusicTimePlayed :: Music -> IO Float -getMusicTimePlayed music = realToFrac <$> withFreeable music c'getMusicTimePlayed +getMusicTimePlayed :: (PLike Music music) => music -> IO Float +getMusicTimePlayed music = realToFrac <$> withTLike music c'getMusicTimePlayed -loadAudioStream :: Integer -> Integer -> Integer -> IO AudioStream -loadAudioStream sampleRate sampleSize channels = c'loadAudioStream (fromIntegral sampleRate) (fromIntegral sampleSize) (fromIntegral channels) >>= pop +loadAudioStream :: (PLike AudioStream audioStream) => Integer -> Integer -> Integer -> IO audioStream +loadAudioStream sampleRate sampleSize channels = c'loadAudioStream (fromIntegral sampleRate) (fromIntegral sampleSize) (fromIntegral channels) >>= popTLike -- | Unloads a `managed` audio stream from RAM -unloadAudioStream :: AudioStream -> WindowResources -> IO () -unloadAudioStream stream = unloadSingleAudioBuffer (castPtr $ audioStream'buffer stream) +unloadAudioStream :: (PLike AudioStream audioStream) => audioStream -> WindowResources -> IO () +unloadAudioStream stream wr = + withTLike + stream + ( \streamPtr -> do + buf <- peek (p'audioStream'buffer streamPtr) + unloadSingleAudioBuffer (castPtr buf) wr + ) -isAudioStreamValid :: AudioStream -> IO Bool -isAudioStreamValid stream = toBool <$> withFreeable stream c'isAudioStreamValid +isAudioStreamValid :: (PLike AudioStream audioStream) => audioStream -> IO Bool +isAudioStreamValid stream = toBool <$> withTLike stream c'isAudioStreamValid -updateAudioStream :: AudioStream -> Ptr () -> Int -> IO () -updateAudioStream stream value frameCount = withFreeable stream (\s -> c'updateAudioStream s value (fromIntegral frameCount)) +updateAudioStream :: (PLike AudioStream audioStream) => audioStream -> Ptr () -> Int -> IO () +updateAudioStream stream value frameCount = withTLike stream (\s -> c'updateAudioStream s value (fromIntegral frameCount)) -isAudioStreamProcessed :: AudioStream -> IO Bool -isAudioStreamProcessed stream = toBool <$> withFreeable stream c'isAudioStreamProcessed +isAudioStreamProcessed :: (PLike AudioStream audioStream) => audioStream -> IO Bool +isAudioStreamProcessed stream = toBool <$> withTLike stream c'isAudioStreamProcessed -playAudioStream :: AudioStream -> IO () -playAudioStream stream = withFreeable stream c'playAudioStream +playAudioStream :: (PLike AudioStream audioStream) => audioStream -> IO () +playAudioStream stream = withTLike stream c'playAudioStream -pauseAudioStream :: AudioStream -> IO () -pauseAudioStream stream = withFreeable stream c'pauseAudioStream +pauseAudioStream :: (PLike AudioStream audioStream) => audioStream -> IO () +pauseAudioStream stream = withTLike stream c'pauseAudioStream -resumeAudioStream :: AudioStream -> IO () -resumeAudioStream stream = withFreeable stream c'resumeAudioStream +resumeAudioStream :: (PLike AudioStream audioStream) => audioStream -> IO () +resumeAudioStream stream = withTLike stream c'resumeAudioStream -isAudioStreamPlaying :: AudioStream -> IO Bool -isAudioStreamPlaying stream = toBool <$> withFreeable stream c'isAudioStreamPlaying +isAudioStreamPlaying :: (PLike AudioStream audioStream) => audioStream -> IO Bool +isAudioStreamPlaying stream = toBool <$> withTLike stream c'isAudioStreamPlaying -stopAudioStream :: AudioStream -> IO () -stopAudioStream stream = withFreeable stream c'stopAudioStream +stopAudioStream :: (PLike AudioStream audioStream) => audioStream -> IO () +stopAudioStream stream = withTLike stream c'stopAudioStream -setAudioStreamVolume :: AudioStream -> Float -> IO () -setAudioStreamVolume stream volume = withFreeable stream (\s -> c'setAudioStreamVolume s (realToFrac volume)) +setAudioStreamVolume :: (PLike AudioStream audioStream) => audioStream -> Float -> IO () +setAudioStreamVolume stream volume = withTLike stream (\s -> c'setAudioStreamVolume s (realToFrac volume)) -setAudioStreamPitch :: AudioStream -> Float -> IO () -setAudioStreamPitch stream pitch = withFreeable stream (\s -> c'setAudioStreamPitch s (realToFrac pitch)) +setAudioStreamPitch :: (PLike AudioStream audioStream) => audioStream -> Float -> IO () +setAudioStreamPitch stream pitch = withTLike stream (\s -> c'setAudioStreamPitch s (realToFrac pitch)) -setAudioStreamPan :: AudioStream -> Float -> IO () -setAudioStreamPan stream pan = withFreeable stream (\s -> c'setAudioStreamPan s (realToFrac pan)) +setAudioStreamPan :: (PLike AudioStream audioStream) => audioStream -> Float -> IO () +setAudioStreamPan stream pan = withTLike stream (\s -> c'setAudioStreamPan s (realToFrac pan)) setAudioStreamBufferSizeDefault :: Int -> IO () setAudioStreamBufferSizeDefault = c'setAudioStreamBufferSizeDefault . fromIntegral -setAudioStreamCallback :: AudioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback +setAudioStreamCallback :: (PLike AudioStream audioStream) => audioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback setAudioStreamCallback stream callback window = - withFreeable + withTLike stream ( \s -> do @@ -443,9 +477,9 @@ setAudioStreamCallback stream callback window = return c ) -attachAudioStreamProcessor :: AudioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback +attachAudioStreamProcessor :: (PLike AudioStream audioStream) => audioStream -> AudioCallback -> WindowResources -> IO C'AudioCallback attachAudioStreamProcessor stream callback window = - withFreeable + withTLike stream ( \s -> do @@ -455,9 +489,9 @@ attachAudioStreamProcessor stream callback window = return c ) -detachAudioStreamProcessor :: AudioStream -> C'AudioCallback -> WindowResources -> IO () +detachAudioStreamProcessor :: (PLike AudioStream audioStream) => audioStream -> C'AudioCallback -> WindowResources -> IO () detachAudioStreamProcessor stream callback window = - withFreeable stream (`c'detachAudioStreamProcessor` callback) >> unloadSingleFunPtr (castFunPtr callback) window + withTLike stream (`c'detachAudioStreamProcessor` callback) >> unloadSingleFunPtr (castFunPtr callback) window attachAudioMixedProcessor :: AudioCallback -> WindowResources -> IO C'AudioCallback attachAudioMixedProcessor callback window = diff --git a/src/Raylib/Core/Camera.hs b/src/Raylib/Core/Camera.hs index e69afab..61a7b90 100644 --- a/src/Raylib/Core/Camera.hs +++ b/src/Raylib/Core/Camera.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rcamera@ (raylib.h) @@ -12,10 +13,9 @@ module Raylib.Core.Camera ) where -import Foreign (Ptr, Storable (peek)) +import Foreign (Ptr) import Foreign.C (CFloat (..), CInt (..)) -import GHC.IO (unsafePerformIO) -import Raylib.Internal.Foreign (withFreeable) +import Raylib.Internal.Foreign (Mutable (peekMutated), PLike, TLike (..), withFreeable) import Raylib.Internal.TH (genNative) import Raylib.Types (Camera3D, CameraMode, Vector3) @@ -25,21 +25,20 @@ $( genNative ] ) -updateCamera :: Camera3D -> CameraMode -> IO Camera3D +updateCamera :: (PLike Camera3D camera3D, Mutable camera3D mut) => camera3D -> CameraMode -> IO mut updateCamera camera mode = - withFreeable + withTLike camera ( \c -> do c'updateCamera c (fromIntegral $ fromEnum mode) - peek c + peekMutated camera c ) -updateCameraPro :: Camera3D -> Vector3 -> Vector3 -> Float -> Camera3D +updateCameraPro :: (PLike Camera3D camera3D, Mutable camera3D mut) => camera3D -> Vector3 -> Vector3 -> Float -> IO mut updateCameraPro camera movement rotation zoom = - unsafePerformIO $ - withFreeable - camera - ( \c -> do - withFreeable movement (\m -> withFreeable rotation (\r -> c'updateCameraPro c m r (realToFrac zoom))) - peek c - ) + withTLike + camera + ( \c -> do + withFreeable movement (\m -> withFreeable rotation (\r -> c'updateCameraPro c m r (realToFrac zoom))) + peekMutated camera c + ) diff --git a/src/Raylib/Core/Models.hs b/src/Raylib/Core/Models.hs index 2f5cb8d..32853db 100644 --- a/src/Raylib/Core/Models.hs +++ b/src/Raylib/Core/Models.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rmodels@ @@ -160,22 +162,25 @@ module Raylib.Core.Models where import Control.Monad (forM_) -import Foreign (Ptr, Storable (peek), fromBool, peekArray, toBool, with) +import Foreign (Ptr, Storable (peek), advancePtr, fromBool, nullPtr, toBool) import Foreign.C ( CBool (..), CFloat (..), CInt (..), CString, - withCString, ) import GHC.IO (unsafePerformIO) -import Raylib.Internal (WindowResources, unloadSingleShader, unloadSingleTexture, unloadSingleVaoId, unloadSingleVboIdList, addToWindowResources) +import Raylib.Internal (WindowResources, addToWindowResources, unloadSingleShader, unloadSingleTexture, unloadSingleVaoId, unloadSingleVboIdList) import Raylib.Internal.Foreign - ( pop, - popCArray, + ( ALike (peekALike, popALike, withALike, withALikeLen), + Mutable (peekMutated), + PALike, + PLike, + StringLike, + TLike (peekTLike, popTLike, withTLike), + peekMaybeArray, + pop, withFreeable, - withFreeableArray, - withFreeableArrayLen, ) import Raylib.Internal.TH (genNative) import Raylib.Types @@ -183,19 +188,29 @@ import Raylib.Types Camera3D, Color, Image, - Material (material'maps, material'shader), - MaterialMap (materialMap'texture), + Material, + MaterialMapIndex, Matrix, - Mesh (mesh'vaoId, mesh'vboId), - Model (model'materials, model'meshes), + Mesh, + Model, ModelAnimation, Ray, RayCollision, Rectangle, - Shader (shader'id), - Texture (texture'id), + Texture, Vector2, - Vector3, MaterialMapIndex, + Vector3, + p'material'maps, + p'material'shader, + p'materialMap'texture, + p'mesh'vaoId, + p'mesh'vboId, + p'model'materialCount, + p'model'materials, + p'model'meshCount, + p'model'meshes, + p'shader'id, + p'texture'id, ) $( genNative @@ -290,8 +305,8 @@ drawCircle3D center radius rotationAxis rotationAngle color = withFreeable cente drawTriangle3D :: Vector3 -> Vector3 -> Vector3 -> Color -> IO () drawTriangle3D v1 v2 v3 color = withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (withFreeable color . c'drawTriangle3D p1 p2))) -drawTriangleStrip3D :: [Vector3] -> Int -> Color -> IO () -drawTriangleStrip3D points pointCount color = withFreeableArray points (\p -> withFreeable color (c'drawTriangleStrip3D p (fromIntegral pointCount))) +drawTriangleStrip3D :: (PALike Vector3 points) => points -> Int -> Color -> IO () +drawTriangleStrip3D points pointCount color = withALike points (\p -> withFreeable color (c'drawTriangleStrip3D p (fromIntegral pointCount))) drawCube :: Vector3 -> Float -> Float -> Float -> Color -> IO () drawCube position width height _length color = withFreeable position (\p -> withFreeable color (c'drawCube p (realToFrac width) (realToFrac height) (realToFrac _length))) @@ -341,127 +356,149 @@ drawRay ray color = withFreeable ray (withFreeable color . c'drawRay) drawGrid :: Int -> Float -> IO () drawGrid slices spacing = c'drawGrid (fromIntegral slices) (realToFrac spacing) -loadModel :: String -> IO Model -loadModel fileName = withCString fileName c'loadModel >>= pop +loadModel :: (StringLike string, PLike Model model) => string -> IO model +loadModel fileName = withTLike fileName c'loadModel >>= popTLike -- | Use `loadModelFromMeshManaged` for a resource-managed version -loadModelFromMesh :: Mesh -> IO Model -loadModelFromMesh mesh = with mesh c'loadModelFromMesh >>= pop +-- +-- WARNING: Do not use this with `managed` +loadModelFromMesh :: (PLike Mesh mesh, PLike Model model) => mesh -> IO model +loadModelFromMesh mesh = withTLike mesh c'loadModelFromMesh >>= popTLike -loadModelFromMeshManaged :: Mesh -> WindowResources -> IO Model +loadModelFromMeshManaged :: (PLike Mesh mesh, PLike Model model) => mesh -> WindowResources -> IO model loadModelFromMeshManaged mesh wr = do model <- loadModelFromMesh mesh - forM_ (model'materials model) (addToWindowResources wr) + withTLike + model + ( \modelPtr -> do + matCount :: Int <- fromIntegral <$> peek (p'model'materialCount modelPtr) + mats <- peek (p'model'materials modelPtr) + forM_ [0 .. matCount - 1] (addToWindowResources wr . advancePtr mats) + ) return model -- | Unloads a `managed` model from GPU memory (VRAM) -unloadModel :: Model -> WindowResources -> IO () -unloadModel model wr = do - forM_ (model'meshes model) (`unloadMesh` wr) - forM_ (model'materials model) (`unloadMaterial` wr) +unloadModel :: (PLike Model model) => model -> WindowResources -> IO () +unloadModel model wr = + withTLike + model + ( \modelPtr -> do + meshCount :: Int <- fromIntegral <$> peek (p'model'meshCount modelPtr) + matCount :: Int <- fromIntegral <$> peek (p'model'materialCount modelPtr) + meshes <- peek (p'model'meshes modelPtr) + mats <- peek (p'model'materials modelPtr) + forM_ [0 .. meshCount - 1] (addToWindowResources wr . advancePtr meshes) + forM_ [0 .. matCount - 1] (addToWindowResources wr . advancePtr mats) + ) -isModelValid :: Model -> IO Bool -isModelValid model = toBool <$> withFreeable model c'isModelValid +isModelValid :: (PLike Model model) => model -> IO Bool +isModelValid model = toBool <$> withTLike model c'isModelValid -getModelBoundingBox :: Model -> IO BoundingBox -getModelBoundingBox model = withFreeable model c'getModelBoundingBox >>= pop +getModelBoundingBox :: (PLike Model model) => model -> IO BoundingBox +getModelBoundingBox model = withTLike model c'getModelBoundingBox >>= pop -drawModel :: Model -> Vector3 -> Float -> Color -> IO () -drawModel model position scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModel m p (realToFrac scale)))) +drawModel :: (PLike Model model) => model -> Vector3 -> Float -> Color -> IO () +drawModel model position scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModel m p (realToFrac scale)))) -drawModelEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () -drawModelEx model position rotationAxis rotationAngle scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelEx m p r (realToFrac rotationAngle))))) +drawModelEx :: (PLike Model model) => model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () +drawModelEx model position rotationAxis rotationAngle scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelEx m p r (realToFrac rotationAngle))))) -drawModelWires :: Model -> Vector3 -> Float -> Color -> IO () -drawModelWires model position scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModelWires m p (realToFrac scale)))) +drawModelWires :: (PLike Model model) => model -> Vector3 -> Float -> Color -> IO () +drawModelWires model position scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModelWires m p (realToFrac scale)))) -drawModelWiresEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () -drawModelWiresEx model position rotationAxis rotationAngle scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelWiresEx m p r (realToFrac rotationAngle))))) +drawModelWiresEx :: (PLike Model model) => model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () +drawModelWiresEx model position rotationAxis rotationAngle scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelWiresEx m p r (realToFrac rotationAngle))))) -drawModelPoints :: Model -> Vector3 -> Float -> Color -> IO () -drawModelPoints model position scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModelPoints m p (realToFrac scale)))) +drawModelPoints :: (PLike Model model) => model -> Vector3 -> Float -> Color -> IO () +drawModelPoints model position scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable tint (c'drawModelPoints m p (realToFrac scale)))) -drawModelPointsEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () -drawModelPointsEx model position rotationAxis rotationAngle scale tint = withFreeable model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelPointsEx m p r (realToFrac rotationAngle))))) +drawModelPointsEx :: (PLike Model model) => model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO () +drawModelPointsEx model position rotationAxis rotationAngle scale tint = withTLike model (\m -> withFreeable position (\p -> withFreeable rotationAxis (\r -> withFreeable scale (withFreeable tint . c'drawModelPointsEx m p r (realToFrac rotationAngle))))) drawBoundingBox :: BoundingBox -> Color -> IO () drawBoundingBox box color = withFreeable box (withFreeable color . c'drawBoundingBox) -drawBillboard :: Camera3D -> Texture -> Vector3 -> Float -> Color -> IO () -drawBillboard camera texture position size tint = withFreeable camera (\c -> withFreeable texture (\t -> withFreeable position (\p -> withFreeable tint (c'drawBillboard c t p (realToFrac size))))) +drawBillboard :: (PLike Camera3D camera3D, PLike Texture texture) => camera3D -> texture -> Vector3 -> Float -> Color -> IO () +drawBillboard camera texture position size tint = withTLike camera (\c -> withTLike texture (\t -> withFreeable position (\p -> withFreeable tint (c'drawBillboard c t p (realToFrac size))))) -drawBillboardRec :: Camera3D -> Texture -> Rectangle -> Vector3 -> Vector2 -> Color -> IO () -drawBillboardRec camera texture source position size tint = withFreeable camera (\c -> withFreeable texture (\t -> withFreeable source (\s -> withFreeable position (\p -> withFreeable size (withFreeable tint . c'drawBillboardRec c t s p))))) +drawBillboardRec :: (PLike Camera3D camera3D, PLike Texture texture) => camera3D -> texture -> Rectangle -> Vector3 -> Vector2 -> Color -> IO () +drawBillboardRec camera texture source position size tint = withTLike camera (\c -> withTLike texture (\t -> withFreeable source (\s -> withFreeable position (\p -> withFreeable size (withFreeable tint . c'drawBillboardRec c t s p))))) -drawBillboardPro :: Camera3D -> Texture -> Rectangle -> Vector3 -> Vector3 -> Vector2 -> Vector2 -> Float -> Color -> IO () -drawBillboardPro camera texture source position up size origin rotation tint = withFreeable camera (\c -> withFreeable texture (\t -> withFreeable source (\s -> withFreeable position (\p -> withFreeable up (\u -> withFreeable size (\sz -> withFreeable origin (\o -> withFreeable tint (c'drawBillboardPro c t s p u sz o (realToFrac rotation))))))))) +drawBillboardPro :: (PLike Camera3D camera3D, PLike Texture texture) => camera3D -> texture -> Rectangle -> Vector3 -> Vector3 -> Vector2 -> Vector2 -> Float -> Color -> IO () +drawBillboardPro camera texture source position up size origin rotation tint = withTLike camera (\c -> withTLike texture (\t -> withFreeable source (\s -> withFreeable position (\p -> withFreeable up (\u -> withFreeable size (\sz -> withFreeable origin (\o -> withFreeable tint (c'drawBillboardPro c t s p u sz o (realToFrac rotation))))))))) -uploadMesh :: Mesh -> Bool -> IO Mesh -uploadMesh mesh dynamic = withFreeable mesh (\m -> c'uploadMesh m (fromBool dynamic) >> peek m) +uploadMesh :: (PLike Mesh mesh) => mesh -> Bool -> IO mesh +uploadMesh mesh dynamic = withTLike mesh (\m -> c'uploadMesh m (fromBool dynamic) >> peekTLike m) -updateMeshBuffer :: Mesh -> Int -> Ptr () -> Int -> Int -> IO () -updateMeshBuffer mesh index dataValue dataSize offset = withFreeable mesh (\m -> c'updateMeshBuffer m (fromIntegral index) dataValue (fromIntegral dataSize) (fromIntegral offset)) +updateMeshBuffer :: (PLike Mesh mesh) => mesh -> Int -> Ptr () -> Int -> Int -> IO () +updateMeshBuffer mesh index dataValue dataSize offset = withTLike mesh (\m -> c'updateMeshBuffer m (fromIntegral index) dataValue (fromIntegral dataSize) (fromIntegral offset)) -- | Unloads a `managed` mesh from GPU memory (VRAM) -unloadMesh :: Mesh -> WindowResources -> IO () -unloadMesh mesh wr = do - unloadSingleVaoId (mesh'vaoId mesh) wr - unloadSingleVboIdList (mesh'vboId mesh) wr +unloadMesh :: (PLike Mesh mesh) => mesh -> WindowResources -> IO () +unloadMesh mesh wr = + withTLike + mesh + ( \meshPtr -> do + vao <- peek (p'mesh'vaoId meshPtr) + vbo <- peekMaybeArray 9 =<< peek (p'mesh'vboId meshPtr) + unloadSingleVaoId vao wr + unloadSingleVboIdList vbo wr + ) -drawMesh :: Mesh -> Material -> Matrix -> IO () -drawMesh mesh material transform = withFreeable mesh (\m -> withFreeable material (withFreeable transform . c'drawMesh m)) +drawMesh :: (PLike Mesh mesh, PLike Material material, PLike Matrix matrix) => mesh -> material -> matrix -> IO () +drawMesh mesh material transform = withTLike mesh (\m -> withTLike material (withTLike transform . c'drawMesh m)) -drawMeshInstanced :: Mesh -> Material -> [Matrix] -> IO () -drawMeshInstanced mesh material transforms = withFreeable mesh (\m -> withFreeable material (\mat -> withFreeableArrayLen transforms (\size t -> c'drawMeshInstanced m mat t (fromIntegral size)))) +drawMeshInstanced :: (PLike Mesh mesh, PLike Material material, PALike Matrix matrices) => mesh -> material -> matrices -> IO () +drawMeshInstanced mesh material transforms = withTLike mesh (\m -> withTLike material (\mat -> withALikeLen transforms (\size t -> c'drawMeshInstanced m mat t (fromIntegral size)))) -exportMesh :: Mesh -> String -> IO Bool -exportMesh mesh fileName = toBool <$> withFreeable mesh (withCString fileName . c'exportMesh) +exportMesh :: (PLike Mesh mesh, StringLike string) => mesh -> string -> IO Bool +exportMesh mesh fileName = toBool <$> withTLike mesh (withTLike fileName . c'exportMesh) -exportMeshAsCode :: Mesh -> String -> IO Bool -exportMeshAsCode mesh fileName = toBool <$> withFreeable mesh (withCString fileName . c'exportMeshAsCode) +exportMeshAsCode :: (PLike Mesh mesh, StringLike string) => mesh -> string -> IO Bool +exportMeshAsCode mesh fileName = toBool <$> withTLike mesh (withTLike fileName . c'exportMeshAsCode) -getMeshBoundingBox :: Mesh -> IO BoundingBox -getMeshBoundingBox mesh = withFreeable mesh c'getMeshBoundingBox >>= pop +getMeshBoundingBox :: (PLike Mesh mesh) => mesh -> IO BoundingBox +getMeshBoundingBox mesh = withTLike mesh c'getMeshBoundingBox >>= pop -genMeshTangents :: Mesh -> IO Mesh -genMeshTangents mesh = withFreeable mesh (\m -> c'genMeshTangents m >> peek m) +genMeshTangents :: (PLike Mesh mesh, Mutable mesh mut) => mesh -> IO mut +genMeshTangents mesh = withTLike mesh (\m -> c'genMeshTangents m >> peekMutated mesh m) -genMeshPoly :: Int -> Float -> IO Mesh -genMeshPoly sides radius = c'genMeshPoly (fromIntegral sides) (realToFrac radius) >>= pop +genMeshPoly :: (PLike Mesh mesh) => Int -> Float -> IO mesh +genMeshPoly sides radius = c'genMeshPoly (fromIntegral sides) (realToFrac radius) >>= popTLike -genMeshPlane :: Float -> Float -> Int -> Int -> IO Mesh -genMeshPlane width _length resX resZ = c'genMeshPlane (realToFrac width) (realToFrac _length) (fromIntegral resX) (fromIntegral resZ) >>= pop +genMeshPlane :: (PLike Mesh mesh) => Float -> Float -> Int -> Int -> IO mesh +genMeshPlane width _length resX resZ = c'genMeshPlane (realToFrac width) (realToFrac _length) (fromIntegral resX) (fromIntegral resZ) >>= popTLike -genMeshCube :: Float -> Float -> Float -> IO Mesh -genMeshCube width height _length = c'genMeshCube (realToFrac width) (realToFrac height) (realToFrac _length) >>= pop +genMeshCube :: (PLike Mesh mesh) => Float -> Float -> Float -> IO mesh +genMeshCube width height _length = c'genMeshCube (realToFrac width) (realToFrac height) (realToFrac _length) >>= popTLike -genMeshSphere :: Float -> Int -> Int -> IO Mesh -genMeshSphere radius rings slices = c'genMeshSphere (realToFrac radius) (fromIntegral rings) (fromIntegral slices) >>= pop +genMeshSphere :: (PLike Mesh mesh) => Float -> Int -> Int -> IO mesh +genMeshSphere radius rings slices = c'genMeshSphere (realToFrac radius) (fromIntegral rings) (fromIntegral slices) >>= popTLike -genMeshHemiSphere :: Float -> Int -> Int -> IO Mesh -genMeshHemiSphere radius rings slices = c'genMeshHemiSphere (realToFrac radius) (fromIntegral rings) (fromIntegral slices) >>= pop +genMeshHemiSphere :: (PLike Mesh mesh) => Float -> Int -> Int -> IO mesh +genMeshHemiSphere radius rings slices = c'genMeshHemiSphere (realToFrac radius) (fromIntegral rings) (fromIntegral slices) >>= popTLike -genMeshCylinder :: Float -> Float -> Int -> IO Mesh -genMeshCylinder radius height slices = c'genMeshCylinder (realToFrac radius) (realToFrac height) (fromIntegral slices) >>= pop +genMeshCylinder :: (PLike Mesh mesh) => Float -> Float -> Int -> IO mesh +genMeshCylinder radius height slices = c'genMeshCylinder (realToFrac radius) (realToFrac height) (fromIntegral slices) >>= popTLike -genMeshCone :: Float -> Float -> Int -> IO Mesh -genMeshCone radius height slices = c'genMeshCone (realToFrac radius) (realToFrac height) (fromIntegral slices) >>= pop +genMeshCone :: (PLike Mesh mesh) => Float -> Float -> Int -> IO mesh +genMeshCone radius height slices = c'genMeshCone (realToFrac radius) (realToFrac height) (fromIntegral slices) >>= popTLike -genMeshTorus :: Float -> Float -> Int -> Int -> IO Mesh -genMeshTorus radius size radSeg sides = c'genMeshTorus (realToFrac radius) (realToFrac size) (fromIntegral radSeg) (fromIntegral sides) >>= pop +genMeshTorus :: (PLike Mesh mesh) => Float -> Float -> Int -> Int -> IO mesh +genMeshTorus radius size radSeg sides = c'genMeshTorus (realToFrac radius) (realToFrac size) (fromIntegral radSeg) (fromIntegral sides) >>= popTLike -genMeshKnot :: Float -> Float -> Int -> Int -> IO Mesh -genMeshKnot radius size radSeg sides = c'genMeshKnot (realToFrac radius) (realToFrac size) (fromIntegral radSeg) (fromIntegral sides) >>= pop +genMeshKnot :: (PLike Mesh mesh) => Float -> Float -> Int -> Int -> IO mesh +genMeshKnot radius size radSeg sides = c'genMeshKnot (realToFrac radius) (realToFrac size) (fromIntegral radSeg) (fromIntegral sides) >>= popTLike -genMeshHeightmap :: Image -> Vector3 -> IO Mesh -genMeshHeightmap heightmap size = withFreeable heightmap (withFreeable size . c'genMeshHeightmap) >>= pop +genMeshHeightmap :: (PLike Image image, PLike Mesh mesh) => image -> Vector3 -> IO mesh +genMeshHeightmap heightmap size = withTLike heightmap (withFreeable size . c'genMeshHeightmap) >>= popTLike -genMeshCubicmap :: Image -> Vector3 -> IO Mesh -genMeshCubicmap cubicmap cubeSize = withFreeable cubicmap (withFreeable cubeSize . c'genMeshCubicmap) >>= pop +genMeshCubicmap :: (PLike Image image, PLike Mesh mesh) => image -> Vector3 -> IO mesh +genMeshCubicmap cubicmap cubeSize = withTLike cubicmap (withFreeable cubeSize . c'genMeshCubicmap) >>= popTLike -loadMaterials :: String -> IO [Material] +loadMaterials :: (StringLike string, PALike Material materials) => string -> IO materials loadMaterials fileName = - withCString + withTLike fileName ( \f -> withFreeable @@ -469,34 +506,46 @@ loadMaterials fileName = ( \n -> do ptr <- c'loadMaterials f n num <- peek n - materials <- popCArray (fromIntegral num) ptr - return materials + popALike (fromIntegral num) ptr ) ) -- | Unloads a `managed` material from GPU memory (VRAM) -unloadMaterial :: Material -> WindowResources -> IO () -unloadMaterial material wr = do - unloadSingleShader (shader'id $ material'shader material) wr - case material'maps material of - Nothing -> return () - (Just maps) -> forM_ maps (\m -> unloadSingleTexture (texture'id $ materialMap'texture m) wr) +unloadMaterial :: (PLike Material material) => material -> WindowResources -> IO () +unloadMaterial material wr = + withTLike + material + ( \materialPtr -> do + sId <- peek (p'shader'id (p'material'shader materialPtr)) + unloadSingleShader sId wr + + maps <- peek (p'material'maps materialPtr) + if maps == nullPtr + then return () + else + forM_ + [0 .. 11] + ( \i -> do + tId <- peek (p'texture'id (p'materialMap'texture (advancePtr maps i))) + unloadSingleTexture tId wr + ) + ) -loadMaterialDefault :: IO Material -loadMaterialDefault = c'loadMaterialDefault >>= pop +loadMaterialDefault :: (PLike Material material) => IO material +loadMaterialDefault = c'loadMaterialDefault >>= popTLike -isMaterialValid :: Material -> IO Bool -isMaterialValid material = toBool <$> withFreeable material c'isMaterialValid +isMaterialValid :: (PLike Material material) => material -> IO Bool +isMaterialValid material = toBool <$> withTLike material c'isMaterialValid -setMaterialTexture :: Material -> MaterialMapIndex -> Texture -> IO Material -setMaterialTexture material mapType texture = withFreeable material (\m -> withFreeable texture (c'setMaterialTexture m (fromIntegral (fromEnum mapType))) >> peek m) +setMaterialTexture :: (PLike Material material, PLike Texture texture) => material -> MaterialMapIndex -> texture -> IO material +setMaterialTexture material mapType texture = withTLike material (\m -> withTLike texture (c'setMaterialTexture m (fromIntegral (fromEnum mapType))) >> peekTLike m) -setModelMeshMaterial :: Model -> Int -> Int -> IO Model -setModelMeshMaterial model meshId materialId = withFreeable model (\m -> c'setModelMeshMaterial m (fromIntegral meshId) (fromIntegral materialId) >> peek m) +setModelMeshMaterial :: (PLike Model model) => model -> Int -> Int -> IO model +setModelMeshMaterial model meshId materialId = withTLike model (\m -> c'setModelMeshMaterial m (fromIntegral meshId) (fromIntegral materialId) >> peekTLike m) -loadModelAnimations :: String -> IO [ModelAnimation] +loadModelAnimations :: (StringLike string, PALike ModelAnimation modelAnimations) => string -> IO modelAnimations loadModelAnimations fileName = - withCString + withTLike fileName ( \f -> withFreeable @@ -504,18 +553,18 @@ loadModelAnimations fileName = ( \n -> do ptr <- c'loadModelAnimations f n num <- peek n - peekArray (fromIntegral num) ptr + peekALike (fromIntegral num) ptr ) ) -updateModelAnimation :: Model -> ModelAnimation -> Int -> IO () -updateModelAnimation model animation frame = withFreeable model (\m -> withFreeable animation (\a -> c'updateModelAnimation m a (fromIntegral frame))) +updateModelAnimation :: (PLike Model model, PLike ModelAnimation modelAnimation) => model -> modelAnimation -> Int -> IO () +updateModelAnimation model animation frame = withTLike model (\m -> withTLike animation (\a -> c'updateModelAnimation m a (fromIntegral frame))) -isModelAnimationValid :: Model -> ModelAnimation -> IO Bool -isModelAnimationValid model animation = toBool <$> withFreeable model (withFreeable animation . c'isModelAnimationValid) +isModelAnimationValid :: (PLike Model model, PLike ModelAnimation modelAnimation) => model -> modelAnimation -> IO Bool +isModelAnimationValid model animation = toBool <$> withTLike model (withTLike animation . c'isModelAnimationValid) -updateModelAnimationBoneMatrices :: Model -> ModelAnimation -> Int -> IO () -updateModelAnimationBoneMatrices model animation frame = withFreeable model (\m -> withFreeable animation (\a -> c'updateModelAnimationBoneMatrices m a (fromIntegral frame))) +updateModelAnimationBoneMatrices :: (PLike Model model, PLike ModelAnimation modelAnimation) => model -> modelAnimation -> Int -> IO () +updateModelAnimationBoneMatrices model animation frame = withTLike model (\m -> withTLike animation (\a -> c'updateModelAnimationBoneMatrices m a (fromIntegral frame))) checkCollisionSpheres :: Vector3 -> Float -> Vector3 -> Float -> Bool checkCollisionSpheres center1 radius1 center2 radius2 = toBool $ unsafePerformIO (withFreeable center1 (\c1 -> withFreeable center2 (\c2 -> c'checkCollisionSpheres c1 (realToFrac radius1) c2 (realToFrac radius2)))) diff --git a/src/Raylib/Core/Shapes.hs b/src/Raylib/Core/Shapes.hs index d58b629..a7dcf76 100644 --- a/src/Raylib/Core/Shapes.hs +++ b/src/Raylib/Core/Shapes.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rshapes@ module Raylib.Core.Shapes @@ -137,11 +138,10 @@ module Raylib.Core.Shapes c'checkCollisionLines, c'checkCollisionPointLine, c'checkCollisionCircleLine, - c'getCollisionRec + c'getCollisionRec, ) where -import Data.List (genericLength) import Foreign (Ptr, Storable (peek), toBool) import Foreign.C ( CBool (..), @@ -149,7 +149,7 @@ import Foreign.C CInt (..), ) import GHC.IO (unsafePerformIO) -import Raylib.Internal.Foreign (pop, withFreeable, withFreeableArray, withFreeableArrayLen) +import Raylib.Internal.Foreign (ALike (withALikeLen), PALike, PLike, TLike (popTLike, withTLike), pop, withFreeable) import Raylib.Internal.TH (genNative) import Raylib.Types (Color, Rectangle, Texture, Vector2, pattern Vector2) @@ -223,11 +223,11 @@ $( genNative ] ) -setShapesTexture :: Texture -> Rectangle -> IO () -setShapesTexture tex source = withFreeable tex (withFreeable source . c'setShapesTexture) +setShapesTexture :: (PLike Texture texture) => texture -> Rectangle -> IO () +setShapesTexture tex source = withTLike tex (withFreeable source . c'setShapesTexture) -getShapesTexture :: IO Texture -getShapesTexture = c'getShapesTexture >>= pop +getShapesTexture :: (PLike Texture texture) => IO texture +getShapesTexture = c'getShapesTexture >>= popTLike getShapesTextureRectangle :: IO Rectangle getShapesTextureRectangle = c'getShapesTextureRectangle >>= pop @@ -249,8 +249,8 @@ drawLineEx :: Vector2 -> Vector2 -> Float -> Color -> IO () drawLineEx start end thickness color = withFreeable start (\s -> withFreeable end (\e -> withFreeable color (c'drawLineEx s e (realToFrac thickness)))) -drawLineStrip :: [Vector2] -> Color -> IO () -drawLineStrip points color = withFreeableArray points (\p -> withFreeable color $ c'drawLineStrip p (genericLength points)) +drawLineStrip :: (PALike Vector2 points) => points -> Color -> IO () +drawLineStrip points color = withALikeLen points (\s p -> withFreeable color $ c'drawLineStrip p (fromIntegral s)) drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO () drawLineBezier start end thickness color = @@ -266,8 +266,7 @@ drawCircleSector center radius startAngle endAngle segments color = ( \c -> withFreeable color - ( c'drawCircleSector c (realToFrac radius) (realToFrac startAngle) (realToFrac endAngle) (fromIntegral segments) - ) + (c'drawCircleSector c (realToFrac radius) (realToFrac startAngle) (realToFrac endAngle) (fromIntegral segments)) ) drawCircleSectorLines :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO () @@ -277,8 +276,7 @@ drawCircleSectorLines center radius startAngle endAngle segments color = ( \c -> withFreeable color - ( c'drawCircleSectorLines c (realToFrac radius) (realToFrac startAngle) (realToFrac endAngle) (fromIntegral segments) - ) + (c'drawCircleSectorLines c (realToFrac radius) (realToFrac startAngle) (realToFrac endAngle) (fromIntegral segments)) ) drawCircleGradient :: Int -> Int -> Float -> Color -> Color -> IO () @@ -420,8 +418,7 @@ drawTriangle v1 v2 v3 color = ( \p1 -> withFreeable v2 - ( \p2 -> withFreeable v3 (withFreeable color . c'drawTriangle p1 p2) - ) + (\p2 -> withFreeable v3 (withFreeable color . c'drawTriangle p1 p2)) ) drawTriangleLines :: Vector2 -> Vector2 -> Vector2 -> Color -> IO () @@ -431,16 +428,15 @@ drawTriangleLines v1 v2 v3 color = ( \p1 -> withFreeable v2 - ( \p2 -> withFreeable v3 (withFreeable color . c'drawTriangleLines p1 p2) - ) + (\p2 -> withFreeable v3 (withFreeable color . c'drawTriangleLines p1 p2)) ) -drawTriangleFan :: [Vector2] -> Color -> IO () -drawTriangleFan points color = withFreeableArray points (\p -> withFreeable color $ c'drawTriangleFan p (genericLength points)) +drawTriangleFan :: (PALike Vector2 points) => points -> Color -> IO () +drawTriangleFan points color = withALikeLen points (\s p -> withFreeable color $ c'drawTriangleFan p (fromIntegral s)) -drawTriangleStrip :: [Vector2] -> Color -> IO () +drawTriangleStrip :: (PALike Vector2 points) => points -> Color -> IO () drawTriangleStrip points color = - withFreeableArray points (\p -> withFreeable color $ c'drawTriangleStrip p (genericLength points)) + withALikeLen points (\s p -> withFreeable color $ c'drawTriangleStrip p (fromIntegral s)) drawPoly :: Vector2 -> Int -> Float -> Float -> Color -> IO () drawPoly center sides radius rotation color = @@ -464,20 +460,20 @@ drawPolyLinesEx center sides radius rotation thickness color = (realToFrac thickness) ) -drawSplineLinear :: [Vector2] -> Float -> Color -> IO () -drawSplineLinear points thick color = withFreeableArrayLen points (\l p -> withFreeable color (c'drawSplineLinear p (fromIntegral l) (realToFrac thick))) +drawSplineLinear :: (PALike Vector2 points) => points -> Float -> Color -> IO () +drawSplineLinear points thick color = withALikeLen points (\l p -> withFreeable color (c'drawSplineLinear p (fromIntegral l) (realToFrac thick))) -drawSplineBasis :: [Vector2] -> Float -> Color -> IO () -drawSplineBasis points thick color = withFreeableArrayLen points (\l p -> withFreeable color (c'drawSplineBasis p (fromIntegral l) (realToFrac thick))) +drawSplineBasis :: (PALike Vector2 points) => points -> Float -> Color -> IO () +drawSplineBasis points thick color = withALikeLen points (\l p -> withFreeable color (c'drawSplineBasis p (fromIntegral l) (realToFrac thick))) -drawSplineCatmullRom :: [Vector2] -> Float -> Color -> IO () -drawSplineCatmullRom points thick color = withFreeableArrayLen points (\l p -> withFreeable color (c'drawSplineCatmullRom p (fromIntegral l) (realToFrac thick))) +drawSplineCatmullRom :: (PALike Vector2 points) => points -> Float -> Color -> IO () +drawSplineCatmullRom points thick color = withALikeLen points (\l p -> withFreeable color (c'drawSplineCatmullRom p (fromIntegral l) (realToFrac thick))) -drawSplineBezierQuadratic :: [Vector2] -> Float -> Color -> IO () -drawSplineBezierQuadratic points thick color = withFreeableArrayLen points (\l p -> withFreeable color (c'drawSplineBezierQuadratic p (fromIntegral l) (realToFrac thick))) +drawSplineBezierQuadratic :: (PALike Vector2 points) => points -> Float -> Color -> IO () +drawSplineBezierQuadratic points thick color = withALikeLen points (\l p -> withFreeable color (c'drawSplineBezierQuadratic p (fromIntegral l) (realToFrac thick))) -drawSplineBezierCubic :: [Vector2] -> Float -> Color -> IO () -drawSplineBezierCubic points thick color = withFreeableArrayLen points (\l p -> withFreeable color (c'drawSplineBezierCubic p (fromIntegral l) (realToFrac thick))) +drawSplineBezierCubic :: (PALike Vector2 points) => points -> Float -> Color -> IO () +drawSplineBezierCubic points thick color = withALikeLen points (\l p -> withFreeable color (c'drawSplineBezierCubic p (fromIntegral l) (realToFrac thick))) drawSplineSegmentLinear :: Vector2 -> Vector2 -> Float -> Color -> IO () drawSplineSegmentLinear p1 p2 thick color = withFreeable p1 (\q1 -> withFreeable p2 (\q2 -> withFreeable color (c'drawSplineSegmentLinear q1 q2 (realToFrac thick)))) @@ -532,9 +528,9 @@ checkCollisionPointTriangle :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Bool checkCollisionPointTriangle point p1 p2 p3 = unsafePerformIO $ toBool <$> withFreeable point (\p -> withFreeable p1 (\ptr1 -> withFreeable p2 (withFreeable p3 . c'checkCollisionPointTriangle p ptr1))) -checkCollisionPointPoly :: Vector2 -> [Vector2] -> Bool +checkCollisionPointPoly :: (PALike Vector2 points) => Vector2 -> points -> IO Bool checkCollisionPointPoly point points = - unsafePerformIO $ toBool <$> withFreeableArrayLen points (\l ps -> withFreeable point (\p -> c'checkCollisionPointPoly p ps (fromIntegral l))) + toBool <$> withALikeLen points (\l ps -> withFreeable point (\p -> c'checkCollisionPointPoly p ps (fromIntegral l))) -- | If a collision is found, returns @Just collisionPoint@, otherwise returns @Nothing@ checkCollisionLines :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Maybe Vector2 diff --git a/src/Raylib/Core/Text.hs b/src/Raylib/Core/Text.hs index d56b144..70d0221 100644 --- a/src/Raylib/Core/Text.hs +++ b/src/Raylib/Core/Text.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rtext@ @@ -65,6 +66,7 @@ module Raylib.Core.Text ) where +import Control.Monad ((>=>)) import Foreign (Ptr, Storable (peek, sizeOf), nullPtr, toBool) import Foreign.C ( CBool (..), @@ -72,29 +74,31 @@ import Foreign.C CInt (..), CString, CUChar, - peekCString, withCString, ) import Raylib.Internal (WindowResources, unloadSingleTexture) import Raylib.Internal.Foreign - ( pop, - popCArray, - popCString, + ( ALike (popALike, withALike, withALikeLen), + PALike, + PLike, + StringLike, + TLike (peekTLike, popTLike, withTLike), + pop, withFreeable, - withFreeableArray, withFreeableArray2D, withFreeableArrayLen, ) import Raylib.Internal.TH (genNative) import Raylib.Types ( Color, - Font (font'texture), + Font, FontType, GlyphInfo, Image, Rectangle, - Texture (texture'id), Vector2, + p'font'texture, + p'texture'id, ) $( genNative @@ -130,117 +134,122 @@ $( genNative ] ) -getFontDefault :: IO Font -getFontDefault = c'getFontDefault >>= pop +getFontDefault :: (PLike Font font) => IO font +getFontDefault = c'getFontDefault >>= popTLike -loadFont :: String -> IO Font -loadFont fileName = withCString fileName c'loadFont >>= pop +loadFont :: (StringLike string, PLike Font font) => string -> IO font +loadFont fileName = withTLike fileName c'loadFont >>= popTLike -loadFontEx :: String -> Int -> Maybe [Int] -> IO Font +loadFontEx :: (StringLike string, PLike Font font) => string -> Int -> Maybe [Int] -> IO font loadFontEx fileName fontSize codepoints = - withCString + withTLike fileName ( \f -> case codepoints of Just codepoints' -> withFreeableArrayLen (map fromIntegral codepoints') (\l c -> c'loadFontEx f (fromIntegral fontSize) c (fromIntegral l)) Nothing -> c'loadFontEx f (fromIntegral fontSize) nullPtr 0 ) - >>= pop + >>= popTLike -loadFontFromImage :: Image -> Color -> Int -> IO Font -loadFontFromImage image key firstChar = withFreeable image (\i -> withFreeable key (\k -> c'loadFontFromImage i k (fromIntegral firstChar))) >>= pop +loadFontFromImage :: (PLike Image image, PLike Font font) => image -> Color -> Int -> IO font +loadFontFromImage image key firstChar = withTLike image (\i -> withFreeable key (\k -> c'loadFontFromImage i k (fromIntegral firstChar))) >>= popTLike -loadFontFromMemory :: String -> [Integer] -> Int -> Maybe [Int] -> IO Font +loadFontFromMemory :: (PALike CUChar contents, PLike Font font) => String -> contents -> Int -> Maybe [Int] -> IO font loadFontFromMemory fileType fileData fontSize codepoints = withCString fileType ( \t -> - withFreeableArrayLen - (map fromIntegral fileData) + withALikeLen + fileData ( \size d -> case codepoints of Just codepoints' -> withFreeableArrayLen (map fromIntegral codepoints') - ( \l c -> c'loadFontFromMemory t d (fromIntegral $ size * sizeOf (0 :: CUChar)) (fromIntegral fontSize) c (fromIntegral l) - ) + (\l c -> c'loadFontFromMemory t d (fromIntegral $ size * sizeOf (0 :: CUChar)) (fromIntegral fontSize) c (fromIntegral l)) Nothing -> c'loadFontFromMemory t d (fromIntegral $ size * sizeOf (0 :: CUChar)) (fromIntegral fontSize) nullPtr 0 ) ) - >>= pop + >>= popTLike -loadFontData :: [Integer] -> Int -> Maybe [Int] -> FontType -> IO GlyphInfo +loadFontData :: (PALike CUChar contents, PLike GlyphInfo glyphInfo) => contents -> Int -> Maybe [Int] -> FontType -> IO glyphInfo loadFontData fileData fontSize codepoints fontType = - withFreeableArrayLen - (map fromIntegral fileData) + withALikeLen + fileData ( \size d -> case codepoints of Just codepoints' -> withFreeableArrayLen (map fromIntegral codepoints') (\l c -> c'loadFontData d (fromIntegral (size * sizeOf (0 :: CUChar))) (fromIntegral fontSize) c (fromIntegral l) (fromIntegral (fromEnum fontType))) Nothing -> c'loadFontData d (fromIntegral (size * sizeOf (0 :: CUChar))) (fromIntegral fontSize) nullPtr 0 (fromIntegral (fromEnum fontType)) ) - >>= pop + >>= popTLike -genImageFontAtlas :: [GlyphInfo] -> [[Rectangle]] -> Int -> Int -> Int -> Int -> IO Image -genImageFontAtlas chars recs glyphCount fontSize padding packMethod = withFreeableArray chars (\c -> withFreeableArray2D recs (\r -> c'genImageFontAtlas c r (fromIntegral glyphCount) (fromIntegral fontSize) (fromIntegral padding) (fromIntegral packMethod))) >>= pop +genImageFontAtlas :: (PALike GlyphInfo glyphInfos, PLike Image image) => glyphInfos -> [[Rectangle]] -> Int -> Int -> Int -> Int -> IO image +genImageFontAtlas chars recs glyphCount fontSize padding packMethod = withALike chars (\c -> withFreeableArray2D recs (\r -> c'genImageFontAtlas c r (fromIntegral glyphCount) (fromIntegral fontSize) (fromIntegral padding) (fromIntegral packMethod))) >>= popTLike -- | Unloads a `managed` font from GPU memory (VRAM) -unloadFont :: Font -> WindowResources -> IO () -unloadFont font = unloadSingleTexture (texture'id $ font'texture font) +unloadFont :: (PLike Font font) => font -> WindowResources -> IO () +unloadFont font wr = + withTLike + font + ( \fontPtr -> do + tId <- peek (p'texture'id (p'font'texture fontPtr)) + unloadSingleTexture tId wr + ) -isFontValid :: Font -> IO Bool -isFontValid font = toBool <$> withFreeable font c'isFontValid +isFontValid :: (PLike Font font) => font -> IO Bool +isFontValid font = toBool <$> withTLike font c'isFontValid -exportFontAsCode :: Font -> String -> IO Bool -exportFontAsCode font fileName = toBool <$> withFreeable font (withCString fileName . c'exportFontAsCode) +exportFontAsCode :: (PLike Font font, StringLike string) => font -> string -> IO Bool +exportFontAsCode font fileName = toBool <$> withTLike font (withTLike fileName . c'exportFontAsCode) drawFPS :: Int -> Int -> IO () drawFPS x y = c'drawFPS (fromIntegral x) (fromIntegral y) -drawText :: String -> Int -> Int -> Int -> Color -> IO () -drawText text x y fontSize color = withCString text (\t -> withFreeable color (c'drawText t (fromIntegral x) (fromIntegral y) (fromIntegral fontSize))) +drawText :: (StringLike string) => string -> Int -> Int -> Int -> Color -> IO () +drawText text x y fontSize color = withTLike text (\t -> withFreeable color (c'drawText t (fromIntegral x) (fromIntegral y) (fromIntegral fontSize))) -drawTextEx :: Font -> String -> Vector2 -> Float -> Float -> Color -> IO () -drawTextEx font text position fontSize spacing tint = withFreeable font (\f -> withCString text (\t -> withFreeable position (\p -> withFreeable tint (c'drawTextEx f t p (realToFrac fontSize) (realToFrac spacing))))) +drawTextEx :: (PLike Font font, StringLike string) => font -> string -> Vector2 -> Float -> Float -> Color -> IO () +drawTextEx font text position fontSize spacing tint = withTLike font (\f -> withTLike text (\t -> withFreeable position (\p -> withFreeable tint (c'drawTextEx f t p (realToFrac fontSize) (realToFrac spacing))))) -drawTextPro :: Font -> String -> Vector2 -> Vector2 -> Float -> Float -> Float -> Color -> IO () -drawTextPro font text position origin rotation fontSize spacing tint = withFreeable font (\f -> withCString text (\t -> withFreeable position (\p -> withFreeable origin (\o -> withFreeable tint (c'drawTextPro f t p o (realToFrac rotation) (realToFrac fontSize) (realToFrac spacing)))))) +drawTextPro :: (PLike Font font, StringLike string) => font -> string -> Vector2 -> Vector2 -> Float -> Float -> Float -> Color -> IO () +drawTextPro font text position origin rotation fontSize spacing tint = withTLike font (\f -> withTLike text (\t -> withFreeable position (\p -> withFreeable origin (\o -> withFreeable tint (c'drawTextPro f t p o (realToFrac rotation) (realToFrac fontSize) (realToFrac spacing)))))) -drawTextCodepoint :: Font -> Int -> Vector2 -> Float -> Color -> IO () -drawTextCodepoint font codepoint position fontSize tint = withFreeable font (\f -> withFreeable position (\p -> withFreeable tint (c'drawTextCodepoint f (fromIntegral codepoint) p (realToFrac fontSize)))) +drawTextCodepoint :: (PLike Font font) => font -> Int -> Vector2 -> Float -> Color -> IO () +drawTextCodepoint font codepoint position fontSize tint = withTLike font (\f -> withFreeable position (\p -> withFreeable tint (c'drawTextCodepoint f (fromIntegral codepoint) p (realToFrac fontSize)))) -drawTextCodepoints :: Font -> [Int] -> Vector2 -> Float -> Float -> Color -> IO () -drawTextCodepoints font codepoints position fontSize spacing tint = withFreeable font (\f -> withFreeableArrayLen (map fromIntegral codepoints) (\count cp -> withFreeable position (\p -> withFreeable tint (c'drawTextCodepoints f cp (fromIntegral count) p (realToFrac fontSize) (realToFrac spacing))))) +drawTextCodepoints :: (PLike Font font, PALike CInt codepoints) => font -> codepoints -> Vector2 -> Float -> Float -> Color -> IO () +drawTextCodepoints font codepoints position fontSize spacing tint = withTLike font (\f -> withALikeLen codepoints (\count cp -> withFreeable position (\p -> withFreeable tint (c'drawTextCodepoints f cp (fromIntegral count) p (realToFrac fontSize) (realToFrac spacing))))) setTextLineSpacing :: Int -> IO () setTextLineSpacing = c'setTextLineSpacing . fromIntegral -measureText :: String -> Int -> IO Int -measureText text fontSize = fromIntegral <$> withCString text (\t -> c'measureText t (fromIntegral fontSize)) +measureText :: (StringLike string) => string -> Int -> IO Int +measureText text fontSize = fromIntegral <$> withTLike text (\t -> c'measureText t (fromIntegral fontSize)) -measureTextEx :: Font -> String -> Float -> Float -> IO Vector2 -measureTextEx font text fontSize spacing = withFreeable font (\f -> withCString text (\t -> c'measureTextEx f t (realToFrac fontSize) (realToFrac spacing))) >>= pop +measureTextEx :: (PLike Font font, StringLike string) => font -> string -> Float -> Float -> IO Vector2 +measureTextEx font text fontSize spacing = withTLike font (\f -> withTLike text (\t -> c'measureTextEx f t (realToFrac fontSize) (realToFrac spacing))) >>= pop -getGlyphIndex :: Font -> Int -> IO Int -getGlyphIndex font codepoint = fromIntegral <$> withFreeable font (\f -> c'getGlyphIndex f (fromIntegral codepoint)) +getGlyphIndex :: (PLike Font font) => font -> Int -> IO Int +getGlyphIndex font codepoint = fromIntegral <$> withTLike font (\f -> c'getGlyphIndex f (fromIntegral codepoint)) -getGlyphInfo :: Font -> Int -> IO GlyphInfo -getGlyphInfo font codepoint = withFreeable font (\f -> c'getGlyphInfo f (fromIntegral codepoint)) >>= pop +getGlyphInfo :: (PLike Font font) => font -> Int -> IO GlyphInfo +getGlyphInfo font codepoint = withTLike font (\f -> c'getGlyphInfo f (fromIntegral codepoint)) >>= pop -getGlyphAtlasRec :: Font -> Int -> IO Rectangle -getGlyphAtlasRec font codepoint = withFreeable font (\f -> c'getGlyphAtlasRec f (fromIntegral codepoint)) >>= pop +getGlyphAtlasRec :: (PLike Font font) => font -> Int -> IO Rectangle +getGlyphAtlasRec font codepoint = withTLike font (\f -> c'getGlyphAtlasRec f (fromIntegral codepoint)) >>= pop -loadUTF8 :: [Integer] -> IO String +loadUTF8 :: (PALike CInt codepoints, StringLike string) => codepoints -> IO string loadUTF8 codepoints = - withFreeableArrayLen - (map fromIntegral codepoints) + withALikeLen + codepoints ( \size c -> c'loadUTF8 c (fromIntegral size) ) - >>= popCString + >>= popTLike -loadCodepoints :: String -> IO [Int] +loadCodepoints :: (StringLike string, PALike CInt codepoints) => string -> IO codepoints loadCodepoints text = - withCString + withTLike text ( \t -> withFreeable @@ -248,16 +257,16 @@ loadCodepoints text = ( \n -> do res <- c'loadCodepoints t n num <- peek n - map fromIntegral <$> popCArray (fromIntegral num) res + popALike (fromIntegral num) res ) ) -getCodepointCount :: String -> IO Int -getCodepointCount text = fromIntegral <$> withCString text c'getCodepointCount +getCodepointCount :: (StringLike string) => string -> IO Int +getCodepointCount text = fromIntegral <$> withTLike text c'getCodepointCount -getCodepointNext :: String -> IO (Int, Int) +getCodepointNext :: (StringLike string) => string -> IO (Int, Int) getCodepointNext text = - withCString + withTLike text ( \t -> withFreeable @@ -270,9 +279,9 @@ getCodepointNext text = ) ) -getCodepointPrevious :: String -> IO (Int, Int) +getCodepointPrevious :: (StringLike string) => string -> IO (Int, Int) getCodepointPrevious text = - withCString + withTLike text ( \t -> withFreeable @@ -285,5 +294,5 @@ getCodepointPrevious text = ) ) -codepointToUTF8 :: Int -> IO String -codepointToUTF8 codepoint = withFreeable 0 (c'codepointToUTF8 $ fromIntegral codepoint) >>= peekCString +codepointToUTF8 :: (StringLike string) => Int -> IO string +codepointToUTF8 codepoint = withFreeable 0 (c'codepointToUTF8 (fromIntegral codepoint) >=> peekTLike) diff --git a/src/Raylib/Core/Textures.hs b/src/Raylib/Core/Textures.hs index 903138f..643686e 100644 --- a/src/Raylib/Core/Textures.hs +++ b/src/Raylib/Core/Textures.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rtextures@ @@ -14,6 +15,14 @@ module Raylib.Core.Textures exportImage, exportImageToMemory, exportImageAsCode, + + -- ** Image generation + + -- + + -- | WARNING: When these functions return `Ptr`, you must manually free + -- the pointer. Using `ForeignPtr` is recommended as the pointer will + -- automatically be freed. genImageColor, genImageGradientLinear, genImageGradientRadial, @@ -227,8 +236,6 @@ module Raylib.Core.Textures ) where -import Control.Monad ((<=<)) -import Data.Word (Word8) import Foreign ( Ptr, Storable (peek, sizeOf), @@ -247,28 +254,36 @@ import GHC.IO (unsafePerformIO) import Raylib.Internal (WindowResources, unloadSingleFrameBuffer, unloadSingleTexture) import qualified Raylib.Internal as I import Raylib.Internal.Foreign - ( pop, - popCArray, + ( ALike (popALike, withALikeLen), + Mutable (peekMutated), + PALike, + PLike, + StringLike, + TLike (popTLike, withTLike), + pop, withFreeable, - withFreeableArray, - withFreeableArrayLen, ) import Raylib.Internal.TH (genNative) import Raylib.Types ( Color, CubemapLayout, Font, - Image (image'height, image'width), + Image, NPatchInfo, PixelFormat, Rectangle, - RenderTexture (renderTexture'id, renderTexture'texture), - Texture (texture'id), + RenderTexture, + Texture, TextureFilter, TextureWrap, Vector2, Vector3, Vector4, + p'image'height, + p'image'width, + p'renderTexture'id, + p'renderTexture'texture, + p'texture'id, ) $( genNative @@ -385,65 +400,65 @@ $( genNative ] ) -loadImage :: String -> IO Image -loadImage fileName = withCString fileName c'loadImage >>= pop +loadImage :: (StringLike string, PLike Image image) => string -> IO image +loadImage fileName = withTLike fileName c'loadImage >>= popTLike -loadImageRaw :: String -> Int -> Int -> Int -> Int -> IO Image +loadImageRaw :: (StringLike string, PLike Image image) => string -> Int -> Int -> Int -> Int -> IO image loadImageRaw fileName width height format headerSize = - withCString fileName (\str -> c'loadImageRaw str (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) (fromIntegral headerSize)) >>= pop + withTLike fileName (\str -> c'loadImageRaw str (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) (fromIntegral headerSize)) >>= popTLike -- | Returns the animation and the number of frames in a tuple -loadImageAnim :: String -> IO (Image, Int) +loadImageAnim :: (StringLike string, PLike Image image) => string -> IO (image, Int) loadImageAnim fileName = withFreeable 0 ( \frames -> - withCString + withTLike fileName ( \fn -> do - img <- c'loadImageAnim fn frames >>= pop + img <- c'loadImageAnim fn frames >>= popTLike frameNum <- fromIntegral <$> peek frames return (img, frameNum) ) ) -loadImageAnimFromMemory :: String -> [Integer] -> IO (Image, Int) +loadImageAnimFromMemory :: (PALike CUChar contents, PLike Image image) => String -> contents -> IO (image, Int) loadImageAnimFromMemory fileType fileData = withCString fileType ( \ft -> - withFreeableArrayLen - (map fromIntegral fileData) + withALikeLen + fileData ( \size fd -> withFreeable (0 :: CInt) ( \frames -> do - img <- c'loadImageAnimFromMemory ft fd (fromIntegral $ size * sizeOf (0 :: CUChar)) frames >>= pop + img <- c'loadImageAnimFromMemory ft fd (fromIntegral $ size * sizeOf (0 :: CUChar)) frames >>= popTLike frameNum <- fromIntegral <$> peek frames return (img, frameNum) ) ) ) -loadImageFromMemory :: String -> [Integer] -> IO Image +loadImageFromMemory :: (PALike CUChar contents, PLike Image image) => String -> contents -> IO image loadImageFromMemory fileType fileData = - withCString fileType (\ft -> withFreeableArrayLen (map fromIntegral fileData) (\size fd -> c'loadImageFromMemory ft fd (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= pop + withCString fileType (\ft -> withALikeLen fileData (\size fd -> c'loadImageFromMemory ft fd (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= popTLike -loadImageFromTexture :: Texture -> IO Image -loadImageFromTexture tex = withFreeable tex c'loadImageFromTexture >>= pop +loadImageFromTexture :: (PLike Texture texture, PLike Image image) => texture -> IO image +loadImageFromTexture tex = withTLike tex c'loadImageFromTexture >>= popTLike -loadImageFromScreen :: IO Image -loadImageFromScreen = c'loadImageFromScreen >>= pop +loadImageFromScreen :: (PLike Image image) => IO image +loadImageFromScreen = c'loadImageFromScreen >>= popTLike -isImageValid :: Image -> IO Bool -isImageValid image = toBool <$> withFreeable image c'isImageValid +isImageValid :: (PLike Image image) => image -> IO Bool +isImageValid image = toBool <$> withTLike image c'isImageValid -exportImage :: Image -> String -> IO Bool -exportImage image fileName = toBool <$> withFreeable image (withCString fileName . c'exportImage) +exportImage :: (PLike Image image, StringLike string) => image -> string -> IO Bool +exportImage image fileName = toBool <$> withTLike image (withTLike fileName . c'exportImage) -exportImageToMemory :: Image -> String -> IO [Word8] +exportImageToMemory :: (PLike Image image, PALike CUChar contents) => image -> String -> IO contents exportImageToMemory image fileType = - withFreeable + withTLike image ( \i -> withCString @@ -454,149 +469,153 @@ exportImageToMemory image fileType = ( \s -> do bytes <- c'exportImageToMemory i t s size <- fromIntegral <$> peek s - map (\(CUChar x) -> x) <$> popCArray size bytes + popALike size bytes ) ) ) -exportImageAsCode :: Image -> String -> IO Bool +exportImageAsCode :: (PLike Image image, StringLike string) => image -> string -> IO Bool exportImageAsCode image fileName = - toBool <$> withFreeable image (withCString fileName . c'exportImageAsCode) + toBool <$> withTLike image (withTLike fileName . c'exportImageAsCode) -genImageColor :: Int -> Int -> Color -> IO Image +genImageColor :: (PLike Image image) => Int -> Int -> Color -> IO image genImageColor width height color = - withFreeable color (c'genImageColor (fromIntegral width) (fromIntegral height)) >>= pop + withFreeable color (c'genImageColor (fromIntegral width) (fromIntegral height)) >>= popTLike -genImageGradientLinear :: Int -> Int -> Int -> Color -> Color -> IO Image +genImageGradientLinear :: (PLike Image image) => Int -> Int -> Int -> Color -> Color -> IO image genImageGradientLinear width height direction start end = - withFreeable start (withFreeable end . c'genImageGradientLinear (fromIntegral width) (fromIntegral height) (fromIntegral direction)) >>= pop + withFreeable start (withFreeable end . c'genImageGradientLinear (fromIntegral width) (fromIntegral height) (fromIntegral direction)) >>= popTLike -genImageGradientRadial :: Int -> Int -> Float -> Color -> Color -> IO Image +genImageGradientRadial :: (PLike Image image) => Int -> Int -> Float -> Color -> Color -> IO image genImageGradientRadial width height density inner outer = - withFreeable inner (withFreeable outer . c'genImageGradientRadial (fromIntegral width) (fromIntegral height) (realToFrac density)) >>= pop + withFreeable inner (withFreeable outer . c'genImageGradientRadial (fromIntegral width) (fromIntegral height) (realToFrac density)) >>= popTLike -genImageGradientSquare :: Int -> Int -> Float -> Color -> Color -> IO Image +genImageGradientSquare :: (PLike Image image) => Int -> Int -> Float -> Color -> Color -> IO image genImageGradientSquare width height density inner outer = - withFreeable inner (withFreeable outer . c'genImageGradientSquare (fromIntegral width) (fromIntegral height) (realToFrac density)) >>= pop + withFreeable inner (withFreeable outer . c'genImageGradientSquare (fromIntegral width) (fromIntegral height) (realToFrac density)) >>= popTLike -genImageChecked :: Int -> Int -> Int -> Int -> Color -> Color -> IO Image +genImageChecked :: (PLike Image image) => Int -> Int -> Int -> Int -> Color -> Color -> IO image genImageChecked width height checksX checksY col1 col2 = - withFreeable col1 (withFreeable col2 . c'genImageChecked (fromIntegral width) (fromIntegral height) (fromIntegral checksX) (fromIntegral checksY)) >>= pop + withFreeable col1 (withFreeable col2 . c'genImageChecked (fromIntegral width) (fromIntegral height) (fromIntegral checksX) (fromIntegral checksY)) >>= popTLike -genImageWhiteNoise :: Int -> Int -> Float -> IO Image +genImageWhiteNoise :: (PLike Image image) => Int -> Int -> Float -> IO image genImageWhiteNoise width height factor = - c'genImageWhiteNoise (fromIntegral width) (fromIntegral height) (realToFrac factor) >>= pop + c'genImageWhiteNoise (fromIntegral width) (fromIntegral height) (realToFrac factor) >>= popTLike -genImagePerlinNoise :: Int -> Int -> Int -> Int -> Float -> IO Image -genImagePerlinNoise width height offsetX offsetY scale = c'genImagePerlinNoise (fromIntegral width) (fromIntegral height) (fromIntegral offsetX) (fromIntegral offsetY) (realToFrac scale) >>= pop +genImagePerlinNoise :: (PLike Image image) => Int -> Int -> Int -> Int -> Float -> IO image +genImagePerlinNoise width height offsetX offsetY scale = c'genImagePerlinNoise (fromIntegral width) (fromIntegral height) (fromIntegral offsetX) (fromIntegral offsetY) (realToFrac scale) >>= popTLike -genImageCellular :: Int -> Int -> Int -> IO Image +genImageCellular :: (PLike Image image) => Int -> Int -> Int -> IO image genImageCellular width height tileSize = - c'genImageCellular (fromIntegral width) (fromIntegral height) (fromIntegral tileSize) >>= pop + c'genImageCellular (fromIntegral width) (fromIntegral height) (fromIntegral tileSize) >>= popTLike -genImageText :: Int -> Int -> String -> IO Image +genImageText :: (PLike Image image) => Int -> Int -> String -> IO image genImageText width height text = - withCString text (c'genImageText (fromIntegral width) (fromIntegral height)) >>= pop + withCString text (c'genImageText (fromIntegral width) (fromIntegral height)) >>= popTLike -imageFromImage :: Image -> Rectangle -> IO Image -imageFromImage image rect = withFreeable image (withFreeable rect . c'imageFromImage) >>= pop +imageFromImage :: (PLike Image image) => image -> Rectangle -> IO image +imageFromImage image rect = withTLike image (withFreeable rect . c'imageFromImage) >>= popTLike -imageFromChannel :: Image -> Int -> IO Image -imageFromChannel image channel = withFreeable image (\i -> c'imageFromChannel i (fromIntegral channel)) >>= pop +imageFromChannel :: (PLike Image image) => image -> Int -> IO image +imageFromChannel image channel = withTLike image (\i -> c'imageFromChannel i (fromIntegral channel)) >>= popTLike -imageText :: String -> Int -> Color -> IO Image +imageText :: (StringLike string, PLike Image image) => string -> Int -> Color -> IO image imageText text fontSize color = - withCString text (\t -> withFreeable color (c'imageText t (fromIntegral fontSize))) >>= pop + withTLike text (\t -> withFreeable color (c'imageText t (fromIntegral fontSize))) >>= popTLike -imageTextEx :: Font -> String -> Float -> Float -> Color -> IO Image +imageTextEx :: (PLike Font font, StringLike string, PLike Image image) => font -> string -> Float -> Float -> Color -> IO image imageTextEx font text fontSize spacing tint = - withFreeable font (\f -> withCString text (\t -> withFreeable tint (c'imageTextEx f t (realToFrac fontSize) (realToFrac spacing)))) >>= pop + withTLike font (\f -> withTLike text (\t -> withFreeable tint (c'imageTextEx f t (realToFrac fontSize) (realToFrac spacing)))) >>= popTLike -imageFormat :: Image -> PixelFormat -> IO Image +imageFormat :: (PLike Image image, Mutable image mut) => image -> PixelFormat -> IO mut imageFormat image newFormat = - withFreeable image (\i -> c'imageFormat i (fromIntegral $ fromEnum newFormat) >> peek i) + withTLike image (\i -> c'imageFormat i (fromIntegral $ fromEnum newFormat) >> peekMutated image i) -imageToPOT :: Image -> Color -> IO Image -imageToPOT image color = withFreeable image (\i -> withFreeable color (c'imageToPOT i) >> peek i) +imageToPOT :: (PLike Image image, Mutable image mut) => image -> Color -> IO mut +imageToPOT image color = withTLike image (\i -> withFreeable color (c'imageToPOT i) >> peekMutated image i) -imageCrop :: Image -> Rectangle -> IO Image -imageCrop image crop = withFreeable image (\i -> withFreeable crop (c'imageCrop i) >> peek i) +imageCrop :: (PLike Image image, Mutable image mut) => image -> Rectangle -> IO mut +imageCrop image crop = withTLike image (\i -> withFreeable crop (c'imageCrop i) >> peekMutated image i) -imageAlphaCrop :: Image -> Float -> IO Image -imageAlphaCrop image threshold = withFreeable image (\i -> c'imageAlphaCrop i (realToFrac threshold) >> peek i) +imageAlphaCrop :: (PLike Image image, Mutable image mut) => image -> Float -> IO mut +imageAlphaCrop image threshold = withTLike image (\i -> c'imageAlphaCrop i (realToFrac threshold) >> peekMutated image i) -imageAlphaClear :: Image -> Color -> Float -> IO Image -imageAlphaClear image color threshold = withFreeable image (\i -> withFreeable color (\c -> c'imageAlphaClear i c (realToFrac threshold) >> peek i)) +imageAlphaClear :: (PLike Image image, Mutable image mut) => image -> Color -> Float -> IO mut +imageAlphaClear image color threshold = withTLike image (\i -> withFreeable color (\c -> c'imageAlphaClear i c (realToFrac threshold) >> peekMutated image i)) -imageAlphaMask :: Image -> Image -> IO Image -imageAlphaMask image alphaMask = withFreeable image (\i -> withFreeable alphaMask (c'imageAlphaMask i) >> peek i) +imageAlphaMask :: (PLike Image image1, PLike Image image2, Mutable image1 mut) => image1 -> image2 -> IO mut +imageAlphaMask image alphaMask = withTLike image (\i -> withTLike alphaMask (c'imageAlphaMask i) >> peekMutated image i) -imageAlphaPremultiply :: Image -> IO Image -imageAlphaPremultiply image = withFreeable image (\i -> c'imageAlphaPremultiply i >> peek i) +imageAlphaPremultiply :: (PLike Image image, Mutable image mut) => image -> IO mut +imageAlphaPremultiply image = withTLike image (\i -> c'imageAlphaPremultiply i >> peekMutated image i) -imageBlurGaussian :: Image -> Int -> IO Image -imageBlurGaussian image blurSize = withFreeable image (\i -> c'imageBlurGaussian i (fromIntegral blurSize) >> peek i) +imageBlurGaussian :: (PLike Image image, Mutable image mut) => image -> Int -> IO mut +imageBlurGaussian image blurSize = withTLike image (\i -> c'imageBlurGaussian i (fromIntegral blurSize) >> peekMutated image i) -imageKernelConvolution :: Image -> [Float] -> IO Image -imageKernelConvolution image kernel = withFreeable image (\i -> withFreeableArray (map realToFrac kernel :: [CFloat]) (\k -> c'imageKernelConvolution i k (fromIntegral $ length kernel) >> peek i)) +imageKernelConvolution :: (PLike Image image, PALike CFloat kernel, Mutable image mut) => image -> kernel -> IO mut +imageKernelConvolution image kernel = withTLike image (\i -> withALikeLen kernel (\l k -> c'imageKernelConvolution i k (fromIntegral l) >> peekMutated image i)) -imageResize :: Image -> Int -> Int -> IO Image -imageResize image newWidth newHeight = withFreeable image (\i -> c'imageResize i (fromIntegral newWidth) (fromIntegral newHeight) >> peek i) +imageResize :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> IO mut +imageResize image newWidth newHeight = withTLike image (\i -> c'imageResize i (fromIntegral newWidth) (fromIntegral newHeight) >> peekMutated image i) -imageResizeNN :: Image -> Int -> Int -> IO Image -imageResizeNN image newWidth newHeight = withFreeable image (\i -> c'imageResizeNN i (fromIntegral newWidth) (fromIntegral newHeight) >> peek i) +imageResizeNN :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> IO mut +imageResizeNN image newWidth newHeight = withTLike image (\i -> c'imageResizeNN i (fromIntegral newWidth) (fromIntegral newHeight) >> peekMutated image i) -imageResizeCanvas :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image -imageResizeCanvas image newWidth newHeight offsetX offsetY fill = withFreeable image (\i -> withFreeable fill (c'imageResizeCanvas i (fromIntegral newWidth) (fromIntegral newHeight) (fromIntegral offsetX) (fromIntegral offsetY)) >> peek i) +imageResizeCanvas :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Int -> Color -> IO mut +imageResizeCanvas image newWidth newHeight offsetX offsetY fill = withTLike image (\i -> withFreeable fill (c'imageResizeCanvas i (fromIntegral newWidth) (fromIntegral newHeight) (fromIntegral offsetX) (fromIntegral offsetY)) >> peekMutated image i) -imageMipmaps :: Image -> IO Image -imageMipmaps image = withFreeable image (\i -> c'imageMipmaps i >> peek i) +imageMipmaps :: (PLike Image image, Mutable image mut) => image -> IO mut +imageMipmaps image = withTLike image (\i -> c'imageMipmaps i >> peekMutated image i) -imageDither :: Image -> Int -> Int -> Int -> Int -> IO Image -imageDither image rBpp gBpp bBpp aBpp = withFreeable image (\i -> c'imageDither i (fromIntegral rBpp) (fromIntegral gBpp) (fromIntegral bBpp) (fromIntegral aBpp) >> peek i) +imageDither :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Int -> IO mut +imageDither image rBpp gBpp bBpp aBpp = withTLike image (\i -> c'imageDither i (fromIntegral rBpp) (fromIntegral gBpp) (fromIntegral bBpp) (fromIntegral aBpp) >> peekMutated image i) -imageFlipVertical :: Image -> IO Image -imageFlipVertical image = withFreeable image (\i -> c'imageFlipVertical i >> peek i) +imageFlipVertical :: (PLike Image image, Mutable image mut) => image -> IO mut +imageFlipVertical image = withTLike image (\i -> c'imageFlipVertical i >> peekMutated image i) -imageFlipHorizontal :: Image -> IO Image -imageFlipHorizontal image = withFreeable image (\i -> c'imageFlipHorizontal i >> peek i) +imageFlipHorizontal :: (PLike Image image, Mutable image mut) => image -> IO mut +imageFlipHorizontal image = withTLike image (\i -> c'imageFlipHorizontal i >> peekMutated image i) -imageRotate :: Image -> Int -> IO Image -imageRotate image degrees = withFreeable image (\i -> c'imageRotate i (fromIntegral degrees) >> peek i) +imageRotate :: (PLike Image image, Mutable image mut) => image -> Int -> IO mut +imageRotate image degrees = withTLike image (\i -> c'imageRotate i (fromIntegral degrees) >> peekMutated image i) -imageRotateCW :: Image -> IO Image -imageRotateCW image = withFreeable image (\i -> c'imageRotateCW i >> peek i) +imageRotateCW :: (PLike Image image, Mutable image mut) => image -> IO mut +imageRotateCW image = withTLike image (\i -> c'imageRotateCW i >> peekMutated image i) -imageRotateCCW :: Image -> IO Image -imageRotateCCW image = withFreeable image (\i -> c'imageRotateCCW i >> peek i) +imageRotateCCW :: (PLike Image image, Mutable image mut) => image -> IO mut +imageRotateCCW image = withTLike image (\i -> c'imageRotateCCW i >> peekMutated image i) -imageColorTint :: Image -> Color -> IO Image -imageColorTint image color = withFreeable image (\i -> withFreeable color (c'imageColorTint i) >> peek i) +imageColorTint :: (PLike Image image, Mutable image mut) => image -> Color -> IO mut +imageColorTint image color = withTLike image (\i -> withFreeable color (c'imageColorTint i) >> peekMutated image i) -imageColorInvert :: Image -> IO Image -imageColorInvert image = withFreeable image (\i -> c'imageColorInvert i >> peek i) +imageColorInvert :: (PLike Image image, Mutable image mut) => image -> IO mut +imageColorInvert image = withTLike image (\i -> c'imageColorInvert i >> peekMutated image i) -imageColorGrayscale :: Image -> IO Image -imageColorGrayscale image = withFreeable image (\i -> c'imageColorGrayscale i >> peek i) +imageColorGrayscale :: (PLike Image image, Mutable image mut) => image -> IO mut +imageColorGrayscale image = withTLike image (\i -> c'imageColorGrayscale i >> peekMutated image i) -imageColorContrast :: Image -> Float -> IO Image -imageColorContrast image contrast = withFreeable image (\i -> c'imageColorContrast i (realToFrac contrast) >> peek i) +imageColorContrast :: (PLike Image image, Mutable image mut) => image -> Float -> IO mut +imageColorContrast image contrast = withTLike image (\i -> c'imageColorContrast i (realToFrac contrast) >> peekMutated image i) -imageColorBrightness :: Image -> Int -> IO Image -imageColorBrightness image brightness = withFreeable image (\i -> c'imageColorBrightness i (fromIntegral brightness) >> peek i) +imageColorBrightness :: (PLike Image image, Mutable image mut) => image -> Int -> IO mut +imageColorBrightness image brightness = withTLike image (\i -> c'imageColorBrightness i (fromIntegral brightness) >> peekMutated image i) -imageColorReplace :: Image -> Color -> Color -> IO Image -imageColorReplace image color replace = withFreeable image (\i -> withFreeable color (withFreeable replace . c'imageColorReplace i) >> peek i) +imageColorReplace :: (PLike Image image, Mutable image mut) => image -> Color -> Color -> IO mut +imageColorReplace image color replace = withTLike image (\i -> withFreeable color (withFreeable replace . c'imageColorReplace i) >> peekMutated image i) -loadImageColors :: Image -> IO [Color] +loadImageColors :: (PLike Image image, PALike Color colors) => image -> IO colors loadImageColors image = - withFreeable + withTLike image - (popCArray (fromIntegral $ image'width image * image'height image) <=< c'loadImageColors) + ( \i -> do + w <- fromIntegral <$> peek (p'image'width i) + h <- fromIntegral <$> peek (p'image'height i) + popALike (w * h) =<< c'loadImageColors i + ) -loadImagePalette :: Image -> Int -> IO [Color] +loadImagePalette :: (PLike Image image, PALike Color colors) => image -> Int -> IO colors loadImagePalette image maxPaletteSize = - withFreeable + withTLike image ( \i -> do (palette, num) <- @@ -607,138 +626,150 @@ loadImagePalette image maxPaletteSize = s <- peek size return (cols, s) ) - popCArray (fromIntegral num) palette + popALike (fromIntegral num) palette ) -getImageAlphaBorder :: Image -> Float -> IO Rectangle -getImageAlphaBorder image threshold = withFreeable image (\i -> c'getImageAlphaBorder i (realToFrac threshold)) >>= pop +getImageAlphaBorder :: (PLike Image image) => image -> Float -> IO Rectangle +getImageAlphaBorder image threshold = withTLike image (\i -> c'getImageAlphaBorder i (realToFrac threshold)) >>= pop -getImageColor :: Image -> Int -> Int -> IO Color -getImageColor image x y = withFreeable image (\i -> c'getImageColor i (fromIntegral x) (fromIntegral y)) >>= pop +getImageColor :: (PLike Image image) => image -> Int -> Int -> IO Color +getImageColor image x y = withTLike image (\i -> c'getImageColor i (fromIntegral x) (fromIntegral y)) >>= pop -imageClearBackground :: Image -> Color -> IO Image -imageClearBackground image color = withFreeable image (\i -> withFreeable color (c'imageClearBackground i) >> peek i) +imageClearBackground :: (PLike Image image, Mutable image mut) => image -> Color -> IO mut +imageClearBackground image color = withTLike image (\i -> withFreeable color (c'imageClearBackground i) >> peekMutated image i) -imageDrawPixel :: Image -> Int -> Int -> Color -> IO Image -imageDrawPixel image x y color = withFreeable image (\i -> withFreeable color (c'imageDrawPixel i (fromIntegral x) (fromIntegral y)) >> peek i) +imageDrawPixel :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Color -> IO mut +imageDrawPixel image x y color = withTLike image (\i -> withFreeable color (c'imageDrawPixel i (fromIntegral x) (fromIntegral y)) >> peekMutated image i) -imageDrawPixelV :: Image -> Vector2 -> Color -> IO Image -imageDrawPixelV image position color = withFreeable image (\i -> withFreeable position (withFreeable color . c'imageDrawPixelV i) >> peek i) +imageDrawPixelV :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Color -> IO mut +imageDrawPixelV image position color = withTLike image (\i -> withFreeable position (withFreeable color . c'imageDrawPixelV i) >> peekMutated image i) -imageDrawLine :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image -imageDrawLine image startPosX startPosY endPosX endPosY color = withFreeable image (\i -> withFreeable color (c'imageDrawLine i (fromIntegral startPosX) (fromIntegral startPosY) (fromIntegral endPosX) (fromIntegral endPosY)) >> peek i) +imageDrawLine :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Int -> Color -> IO mut +imageDrawLine image startPosX startPosY endPosX endPosY color = withTLike image (\i -> withFreeable color (c'imageDrawLine i (fromIntegral startPosX) (fromIntegral startPosY) (fromIntegral endPosX) (fromIntegral endPosY)) >> peekMutated image i) -imageDrawLineV :: Image -> Vector2 -> Vector2 -> Color -> IO Image -imageDrawLineV image start end color = withFreeable image (\i -> withFreeable start (\s -> withFreeable end (withFreeable color . c'imageDrawLineV i s)) >> peek i) +imageDrawLineV :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Vector2 -> Color -> IO mut +imageDrawLineV image start end color = withTLike image (\i -> withFreeable start (\s -> withFreeable end (withFreeable color . c'imageDrawLineV i s)) >> peekMutated image i) -imageDrawCircle :: Image -> Int -> Int -> Int -> Color -> IO Image -imageDrawCircle image centerX centerY radius color = withFreeable image (\i -> withFreeable color (c'imageDrawCircle i (fromIntegral centerX) (fromIntegral centerY) (fromIntegral radius)) >> peek i) +imageDrawCircle :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Color -> IO mut +imageDrawCircle image centerX centerY radius color = withTLike image (\i -> withFreeable color (c'imageDrawCircle i (fromIntegral centerX) (fromIntegral centerY) (fromIntegral radius)) >> peekMutated image i) -imageDrawCircleV :: Image -> Vector2 -> Int -> Color -> IO Image -imageDrawCircleV image center radius color = withFreeable image (\i -> withFreeable center (\c -> withFreeable color (c'imageDrawCircleV i c (fromIntegral radius))) >> peek i) +imageDrawCircleV :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Int -> Color -> IO mut +imageDrawCircleV image center radius color = withTLike image (\i -> withFreeable center (\c -> withFreeable color (c'imageDrawCircleV i c (fromIntegral radius))) >> peekMutated image i) -imageDrawCircleLines :: Image -> Int -> Int -> Int -> Color -> IO Image -imageDrawCircleLines image centerX centerY radius color = withFreeable image (\i -> withFreeable color (c'imageDrawCircleLines i (fromIntegral centerX) (fromIntegral centerY) (fromIntegral radius)) >> peek i) +imageDrawCircleLines :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Color -> IO mut +imageDrawCircleLines image centerX centerY radius color = withTLike image (\i -> withFreeable color (c'imageDrawCircleLines i (fromIntegral centerX) (fromIntegral centerY) (fromIntegral radius)) >> peekMutated image i) -imageDrawCircleLinesV :: Image -> Vector2 -> Int -> Color -> IO Image -imageDrawCircleLinesV image center radius color = withFreeable image (\i -> withFreeable center (\c -> withFreeable color (c'imageDrawCircleLinesV i c (fromIntegral radius))) >> peek i) +imageDrawCircleLinesV :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Int -> Color -> IO mut +imageDrawCircleLinesV image center radius color = withTLike image (\i -> withFreeable center (\c -> withFreeable color (c'imageDrawCircleLinesV i c (fromIntegral radius))) >> peekMutated image i) -imageDrawRectangle :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image -imageDrawRectangle image posX posY width height color = withFreeable image (\i -> withFreeable color (c'imageDrawRectangle i (fromIntegral posX) (fromIntegral posY) (fromIntegral width) (fromIntegral height)) >> peek i) +imageDrawRectangle :: (PLike Image image, Mutable image mut) => image -> Int -> Int -> Int -> Int -> Color -> IO mut +imageDrawRectangle image posX posY width height color = withTLike image (\i -> withFreeable color (c'imageDrawRectangle i (fromIntegral posX) (fromIntegral posY) (fromIntegral width) (fromIntegral height)) >> peekMutated image i) -imageDrawRectangleV :: Image -> Vector2 -> Vector2 -> Color -> IO Image -imageDrawRectangleV image position size color = withFreeable image (\i -> withFreeable position (\p -> withFreeable size (withFreeable color . c'imageDrawRectangleV i p)) >> peek i) +imageDrawRectangleV :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Vector2 -> Color -> IO mut +imageDrawRectangleV image position size color = withTLike image (\i -> withFreeable position (\p -> withFreeable size (withFreeable color . c'imageDrawRectangleV i p)) >> peekMutated image i) -imageDrawRectangleRec :: Image -> Rectangle -> Color -> IO Image -imageDrawRectangleRec image rectangle color = withFreeable image (\i -> withFreeable rectangle (withFreeable color . c'imageDrawRectangleRec i) >> peek i) +imageDrawRectangleRec :: (PLike Image image, Mutable image mut) => image -> Rectangle -> Color -> IO mut +imageDrawRectangleRec image rectangle color = withTLike image (\i -> withFreeable rectangle (withFreeable color . c'imageDrawRectangleRec i) >> peekMutated image i) -imageDrawRectangleLines :: Image -> Rectangle -> Int -> Color -> IO Image -imageDrawRectangleLines image rectangle thickness color = withFreeable image (\i -> withFreeable rectangle (\r -> withFreeable color (c'imageDrawRectangleLines i r (fromIntegral thickness))) >> peek i) +imageDrawRectangleLines :: (PLike Image image, Mutable image mut) => image -> Rectangle -> Int -> Color -> IO mut +imageDrawRectangleLines image rectangle thickness color = withTLike image (\i -> withFreeable rectangle (\r -> withFreeable color (c'imageDrawRectangleLines i r (fromIntegral thickness))) >> peekMutated image i) -imageDrawTriangle :: Image -> Vector2 -> Vector2 -> Vector2 -> Color -> IO Image -imageDrawTriangle image v1 v2 v3 color = withFreeable image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable color (\c -> c'imageDrawTriangle i p1 p2 p3 c)))) >> peek i) +imageDrawTriangle :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Vector2 -> Vector2 -> Color -> IO mut +imageDrawTriangle image v1 v2 v3 color = withTLike image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable color (\c -> c'imageDrawTriangle i p1 p2 p3 c)))) >> peekMutated image i) -imageDrawTriangleEx :: Image -> Vector2 -> Vector2 -> Vector2 -> Color -> Color -> Color -> IO Image -imageDrawTriangleEx image v1 v2 v3 c1 c2 c3 = withFreeable image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable c1 (\q1 -> withFreeable c2 (\q2 -> withFreeable c3 (\q3 -> c'imageDrawTriangleEx i p1 p2 p3 q1 q2 q3)))))) >> peek i) +imageDrawTriangleEx :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Vector2 -> Vector2 -> Color -> Color -> Color -> IO mut +imageDrawTriangleEx image v1 v2 v3 c1 c2 c3 = withTLike image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable c1 (\q1 -> withFreeable c2 (\q2 -> withFreeable c3 (\q3 -> c'imageDrawTriangleEx i p1 p2 p3 q1 q2 q3)))))) >> peekMutated image i) -imageDrawTriangleLines :: Image -> Vector2 -> Vector2 -> Vector2 -> Color -> IO Image -imageDrawTriangleLines image v1 v2 v3 color = withFreeable image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable color (\c -> c'imageDrawTriangleLines i p1 p2 p3 c)))) >> peek i) +imageDrawTriangleLines :: (PLike Image image, Mutable image mut) => image -> Vector2 -> Vector2 -> Vector2 -> Color -> IO mut +imageDrawTriangleLines image v1 v2 v3 color = withTLike image (\i -> withFreeable v1 (\p1 -> withFreeable v2 (\p2 -> withFreeable v3 (\p3 -> withFreeable color (\c -> c'imageDrawTriangleLines i p1 p2 p3 c)))) >> peekMutated image i) -imageDrawTriangleFan :: Image -> [Vector2] -> Color -> IO Image -imageDrawTriangleFan image points color = withFreeable image (\i -> withFreeableArrayLen points (\l p -> withFreeable color (c'imageDrawTriangleFan i p (fromIntegral l))) >> peek i) +imageDrawTriangleFan :: (PLike Image image, PALike Vector2 points, Mutable image mut) => image -> points -> Color -> IO mut +imageDrawTriangleFan image points color = withTLike image (\i -> withALikeLen points (\l p -> withFreeable color (c'imageDrawTriangleFan i p (fromIntegral l))) >> peekMutated image i) -imageDrawTriangleStrip :: Image -> [Vector2] -> Color -> IO Image -imageDrawTriangleStrip image points color = withFreeable image (\i -> withFreeableArrayLen points (\l p -> withFreeable color (c'imageDrawTriangleStrip i p (fromIntegral l))) >> peek i) +imageDrawTriangleStrip :: (PLike Image image, PALike Vector2 points, Mutable image mut) => image -> points -> Color -> IO mut +imageDrawTriangleStrip image points color = withTLike image (\i -> withALikeLen points (\l p -> withFreeable color (c'imageDrawTriangleStrip i p (fromIntegral l))) >> peekMutated image i) -imageDraw :: Image -> Image -> Rectangle -> Rectangle -> Color -> IO Image -imageDraw image source srcRec dstRec tint = withFreeable image (\i -> withFreeable source (\s -> withFreeable srcRec (\sr -> withFreeable dstRec (withFreeable tint . c'imageDraw i s sr))) >> peek i) +imageDraw :: (PLike Image image1, PLike Image image2, Mutable image1 mut) => image1 -> image2 -> Rectangle -> Rectangle -> Color -> IO mut +imageDraw image source srcRec dstRec tint = withTLike image (\i -> withTLike source (\s -> withFreeable srcRec (\sr -> withFreeable dstRec (withFreeable tint . c'imageDraw i s sr))) >> peekMutated image i) -imageDrawText :: Image -> String -> Int -> Int -> Int -> Color -> IO Image -imageDrawText image text x y fontSize color = withFreeable image (\i -> withCString text (\t -> withFreeable color (c'imageDrawText i t (fromIntegral x) (fromIntegral y) (fromIntegral fontSize))) >> peek i) +imageDrawText :: (PLike Image image, StringLike string, Mutable image mut) => image -> string -> Int -> Int -> Int -> Color -> IO mut +imageDrawText image text x y fontSize color = withTLike image (\i -> withTLike text (\t -> withFreeable color (c'imageDrawText i t (fromIntegral x) (fromIntegral y) (fromIntegral fontSize))) >> peekMutated image i) -imageDrawTextEx :: Image -> Font -> String -> Vector2 -> Float -> Float -> Color -> IO Image -imageDrawTextEx image font text position fontSize spacing tint = withFreeable image (\i -> withFreeable font (\f -> withCString text (\t -> withFreeable position (\p -> withFreeable tint (c'imageDrawTextEx i f t p (realToFrac fontSize) (realToFrac spacing))))) >> peek i) +imageDrawTextEx :: (PLike Image image, PLike Font font, StringLike string, Mutable image mut) => image -> font -> string -> Vector2 -> Float -> Float -> Color -> IO mut +imageDrawTextEx image font text position fontSize spacing tint = withTLike image (\i -> withTLike font (\f -> withTLike text (\t -> withFreeable position (\p -> withFreeable tint (c'imageDrawTextEx i f t p (realToFrac fontSize) (realToFrac spacing))))) >> peekMutated image i) -loadTexture :: String -> IO Texture -loadTexture fileName = withCString fileName c'loadTexture >>= pop +loadTexture :: (StringLike string, PLike Texture texture) => string -> IO texture +loadTexture fileName = withTLike fileName c'loadTexture >>= popTLike -loadTextureFromImage :: Image -> IO Texture -loadTextureFromImage image = withFreeable image c'loadTextureFromImage >>= pop +loadTextureFromImage :: (PLike Image image, PLike Texture texture) => image -> IO texture +loadTextureFromImage image = withTLike image c'loadTextureFromImage >>= popTLike -loadTextureCubemap :: Image -> CubemapLayout -> IO Texture -loadTextureCubemap image layout = withFreeable image (\i -> c'loadTextureCubemap i (fromIntegral $ fromEnum layout)) >>= pop +loadTextureCubemap :: (PLike Image image, PLike Texture texture) => image -> CubemapLayout -> IO texture +loadTextureCubemap image layout = withTLike image (\i -> c'loadTextureCubemap i (fromIntegral $ fromEnum layout)) >>= popTLike -loadRenderTexture :: Int -> Int -> IO RenderTexture -loadRenderTexture width height = c'loadRenderTexture (fromIntegral width) (fromIntegral height) >>= pop +loadRenderTexture :: (PLike RenderTexture renderTexture) => Int -> Int -> IO renderTexture +loadRenderTexture width height = c'loadRenderTexture (fromIntegral width) (fromIntegral height) >>= popTLike -isTextureValid :: Texture -> IO Bool -isTextureValid texture = toBool <$> withFreeable texture c'isTextureValid +isTextureValid :: (PLike Texture texture) => texture -> IO Bool +isTextureValid texture = toBool <$> withTLike texture c'isTextureValid -isRenderTextureValid :: RenderTexture -> IO Bool -isRenderTextureValid renderTexture = toBool <$> withFreeable renderTexture c'isRenderTextureValid +isRenderTextureValid :: (PLike RenderTexture renderTexture) => renderTexture -> IO Bool +isRenderTextureValid renderTexture = toBool <$> withTLike renderTexture c'isRenderTextureValid -- | Unloads a `managed` texture from GPU memory (VRAM) -unloadTexture :: Texture -> WindowResources -> IO () -unloadTexture texture = unloadSingleTexture (texture'id texture) +unloadTexture :: (PLike Texture texture) => texture -> WindowResources -> IO () +unloadTexture texture wr = + withTLike + texture + ( \t -> do + tId <- peek (p'texture'id t) + unloadSingleTexture tId wr + ) -- | Unloads a `managed` render texture from GPU memory (VRAM) -unloadRenderTexture :: RenderTexture -> WindowResources -> IO () -unloadRenderTexture renderTexture wr = do - unloadSingleTexture (texture'id $ renderTexture'texture renderTexture) wr - unloadSingleFrameBuffer (renderTexture'id renderTexture) wr +unloadRenderTexture :: (PLike RenderTexture renderTexture) => renderTexture -> WindowResources -> IO () +unloadRenderTexture renderTexture wr = + withTLike + renderTexture + ( \rt -> do + tId <- peek (p'texture'id (p'renderTexture'texture rt)) + rtId <- peek (p'renderTexture'id rt) + unloadSingleTexture tId wr + unloadSingleFrameBuffer rtId wr + ) -updateTexture :: Texture -> Ptr () -> IO () -updateTexture texture pixels = withFreeable texture (\t -> c'updateTexture t pixels) +updateTexture :: (PLike Texture texture) => texture -> Ptr () -> IO () +updateTexture texture pixels = withTLike texture (\t -> c'updateTexture t pixels) -updateTextureRec :: Texture -> Rectangle -> Ptr () -> IO () -updateTextureRec texture rect pixels = withFreeable texture (\t -> withFreeable rect (\r -> c'updateTextureRec t r pixels)) +updateTextureRec :: (PLike Texture texture) => texture -> Rectangle -> Ptr () -> IO () +updateTextureRec texture rect pixels = withTLike texture (\t -> withFreeable rect (\r -> c'updateTextureRec t r pixels)) -genTextureMipmaps :: Texture -> IO Texture -genTextureMipmaps texture = withFreeable texture (\t -> c'genTextureMipmaps t >> peek t) +genTextureMipmaps :: (PLike Texture texture, Mutable texture mut) => texture -> IO mut +genTextureMipmaps texture = withTLike texture (\t -> c'genTextureMipmaps t >> peekMutated texture t) -setTextureFilter :: Texture -> TextureFilter -> IO Texture -setTextureFilter texture filterType = withFreeable texture (\t -> c'setTextureFilter t (fromIntegral $ fromEnum filterType) >> peek t) +setTextureFilter :: (PLike Texture texture, Mutable texture mut) => texture -> TextureFilter -> IO mut +setTextureFilter texture filterType = withTLike texture (\t -> c'setTextureFilter t (fromIntegral $ fromEnum filterType) >> peekMutated texture t) -setTextureWrap :: Texture -> TextureWrap -> IO Texture -setTextureWrap texture wrap = withFreeable texture (\t -> c'setTextureWrap t (fromIntegral $ fromEnum wrap) >> peek t) +setTextureWrap :: (PLike Texture texture, Mutable texture mut) => texture -> TextureWrap -> IO mut +setTextureWrap texture wrap = withTLike texture (\t -> c'setTextureWrap t (fromIntegral $ fromEnum wrap) >> peekMutated texture t) -drawTexture :: Texture -> Int -> Int -> Color -> IO () -drawTexture texture x y tint = withFreeable texture (\t -> withFreeable tint (c'drawTexture t (fromIntegral x) (fromIntegral y))) +drawTexture :: (PLike Texture texture) => texture -> Int -> Int -> Color -> IO () +drawTexture texture x y tint = withTLike texture (\t -> withFreeable tint (c'drawTexture t (fromIntegral x) (fromIntegral y))) -drawTextureV :: Texture -> Vector2 -> Color -> IO () -drawTextureV texture position color = withFreeable texture (\t -> withFreeable position (withFreeable color . c'drawTextureV t)) +drawTextureV :: (PLike Texture texture) => texture -> Vector2 -> Color -> IO () +drawTextureV texture position color = withTLike texture (\t -> withFreeable position (withFreeable color . c'drawTextureV t)) -drawTextureEx :: Texture -> Vector2 -> Float -> Float -> Color -> IO () -drawTextureEx texture position rotation scale tint = withFreeable texture (\t -> withFreeable position (\p -> withFreeable tint (c'drawTextureEx t p (realToFrac rotation) (realToFrac scale)))) +drawTextureEx :: (PLike Texture texture) => texture -> Vector2 -> Float -> Float -> Color -> IO () +drawTextureEx texture position rotation scale tint = withTLike texture (\t -> withFreeable position (\p -> withFreeable tint (c'drawTextureEx t p (realToFrac rotation) (realToFrac scale)))) -drawTextureRec :: Texture -> Rectangle -> Vector2 -> Color -> IO () -drawTextureRec texture source position tint = withFreeable texture (\t -> withFreeable source (\s -> withFreeable position (withFreeable tint . c'drawTextureRec t s))) +drawTextureRec :: (PLike Texture texture) => texture -> Rectangle -> Vector2 -> Color -> IO () +drawTextureRec texture source position tint = withTLike texture (\t -> withFreeable source (\s -> withFreeable position (withFreeable tint . c'drawTextureRec t s))) -drawTexturePro :: Texture -> Rectangle -> Rectangle -> Vector2 -> Float -> Color -> IO () -drawTexturePro texture source dest origin rotation tint = withFreeable texture (\t -> withFreeable source (\s -> withFreeable dest (\d -> withFreeable origin (\o -> withFreeable tint (c'drawTexturePro t s d o (realToFrac rotation)))))) +drawTexturePro :: (PLike Texture texture) => texture -> Rectangle -> Rectangle -> Vector2 -> Float -> Color -> IO () +drawTexturePro texture source dest origin rotation tint = withTLike texture (\t -> withFreeable source (\s -> withFreeable dest (\d -> withFreeable origin (\o -> withFreeable tint (c'drawTexturePro t s d o (realToFrac rotation)))))) -drawTextureNPatch :: Texture -> NPatchInfo -> Rectangle -> Vector2 -> Float -> Color -> IO () -drawTextureNPatch texture nPatchInfo dest origin rotation tint = withFreeable texture (\t -> withFreeable nPatchInfo (\n -> withFreeable dest (\d -> withFreeable origin (\o -> withFreeable tint (c'drawTextureNPatch t n d o (realToFrac rotation)))))) +drawTextureNPatch :: (PLike Texture texture) => texture -> NPatchInfo -> Rectangle -> Vector2 -> Float -> Color -> IO () +drawTextureNPatch texture nPatchInfo dest origin rotation tint = withTLike texture (\t -> withFreeable nPatchInfo (\n -> withFreeable dest (\d -> withFreeable origin (\o -> withFreeable tint (c'drawTextureNPatch t n d o (realToFrac rotation)))))) fade :: Color -> Float -> Color fade color alpha = unsafePerformIO $ withFreeable color (\c -> c'fade c (realToFrac alpha)) >>= pop diff --git a/src/Raylib/Internal.hs b/src/Raylib/Internal.hs index 7843d79..a662e9b 100644 --- a/src/Raylib/Internal.hs +++ b/src/Raylib/Internal.hs @@ -35,6 +35,7 @@ module Raylib.Internal unloadAudioBufferAliases, unloadAutomationEventLists, unloadFunPtrs, + unloadFinalizers, -- * Adding resources addShaderId, @@ -47,6 +48,7 @@ module Raylib.Internal addAudioBufferAlias, addAutomationEventList, addFunPtr, + addFinalizer, -- * Native unload functions c'rlUnloadShaderProgram, @@ -66,14 +68,15 @@ module Raylib.Internal ) where -import Control.Monad (forM_, unless, when) +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, castFunPtr) +import Foreign (ForeignPtr, FunPtr, Ptr, Storable (peek, peekByteOff), castFunPtr, finalizeForeignPtr, free, freeHaskellFunPtr, withForeignPtr) import Foreign.C (CInt (..), CUInt (..)) import GHC.IO (unsafePerformIO) +import Raylib.Internal.Foreign (Freeable (..)) import Raylib.Internal.TH (genNative) #ifdef WEB_FFI @@ -82,6 +85,20 @@ import Raylib.Internal.Web.Native (callRaylibFunction) #endif +$( genNative + [ ("c'rlGetShaderIdDefault", "rlGetShaderIdDefault_", "rlgl_bindings.h", [t|IO CUInt|]), + ("c'rlUnloadShaderProgram", "rlUnloadShaderProgram_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), + ("c'rlUnloadTexture", "rlUnloadTexture_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), + ("c'rlUnloadFramebuffer", "rlUnloadFramebuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), + ("c'rlUnloadVertexArray", "rlUnloadVertexArray_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), + ("c'rlUnloadVertexBuffer", "rlUnloadVertexBuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), + ("c'unloadMusicStreamData", "UnloadMusicStreamData", "rl_internal.h", [t|CInt -> Ptr () -> IO ()|]), + ("c'unloadAudioBuffer", "UnloadAudioBuffer_", "rl_internal.h", [t|Ptr () -> IO ()|]), + ("c'unloadAudioBufferAlias", "UnloadAudioBufferAlias", "rl_internal.h", [t|Ptr () -> IO ()|]), + ("c'getPixelDataSize", "GetPixelDataSize_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> IO CInt|]) + ] + ) + -- | 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 @@ -97,19 +114,39 @@ data WindowResources = WindowResources audioBuffers :: IORef [Ptr ()], audioBufferAliases :: IORef [Ptr ()], automationEventLists :: IORef [Ptr ()], - funPtrs :: IORef [FunPtr ()] + funPtrs :: IORef [FunPtr ()], + finalizers :: IORef [IO ()] } -- | Typeclass to conveniently release resources class Closeable a where -- | Release a resource; this is only necessary when using an unmanaged resource -- - -- WARNING: Do not use this on a managed resource, doing so will cause it to be freed twice + -- WARNING: Do not use this on a managed resource, doing so will attempt + -- to free it twice close :: a -> IO () -- | Add an unmanaged resource to a `WindowResources` handle to be freed later addToWindowResources :: WindowResources -> a -> IO () +instance {-# OVERLAPPABLE #-} (Closeable a, Freeable a, Storable a) => Closeable (Ptr a) where + close x = do + v <- peek x + close v + rlFree v x + addToWindowResources window x = do + addToWindowResources window =<< peek x + addFinalizer + ( do + v <- peek x + rlFree v x + ) + window + +instance {-# OVERLAPPABLE #-} (Closeable a, Freeable a, Storable a) => Closeable (ForeignPtr a) where + close x = withForeignPtr x (close <=< peek) >> finalizeForeignPtr x + addToWindowResources window x = withForeignPtr x (addToWindowResources window <=< peek) >> addFinalizer (finalizeForeignPtr x) window + instance {-# OVERLAPPABLE #-} (Closeable a) => Closeable [a] where close xs = forM_ xs close addToWindowResources window xs = forM_ xs (addToWindowResources window) @@ -134,6 +171,7 @@ defaultWindowResources = do aliases <- newIORef [] eventLists <- newIORef [] fPtrs <- newIORef [] + fins <- newIORef [] return WindowResources { shaderIds = sIds, @@ -146,23 +184,10 @@ defaultWindowResources = do audioBuffers = aBufs, audioBufferAliases = aliases, automationEventLists = eventLists, - funPtrs = fPtrs + funPtrs = fPtrs, + finalizers = fins } -$( genNative - [ ("c'rlGetShaderIdDefault", "rlGetShaderIdDefault_", "rlgl_bindings.h", [t|IO CUInt|]), - ("c'rlUnloadShaderProgram", "rlUnloadShaderProgram_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), - ("c'rlUnloadTexture", "rlUnloadTexture_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), - ("c'rlUnloadFramebuffer", "rlUnloadFramebuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), - ("c'rlUnloadVertexArray", "rlUnloadVertexArray_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), - ("c'rlUnloadVertexBuffer", "rlUnloadVertexBuffer_", "rlgl_bindings.h", [t|CUInt -> IO ()|]), - ("c'unloadMusicStreamData", "UnloadMusicStreamData", "rl_internal.h", [t|CInt -> Ptr () -> IO ()|]), - ("c'unloadAudioBuffer", "UnloadAudioBuffer_", "rl_internal.h", [t|Ptr () -> IO ()|]), - ("c'unloadAudioBufferAlias", "UnloadAudioBufferAlias", "rl_internal.h", [t|Ptr () -> IO ()|]), - ("c'getPixelDataSize", "GetPixelDataSize_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> IO CInt|]) - ] - ) - unloadSingleShader :: (Integral a) => a -> WindowResources -> IO () unloadSingleShader sId' wr = do shaderIdDefault <- c'rlGetShaderIdDefault @@ -342,6 +367,17 @@ unloadFunPtrs wr = do putStrLn $ "INFO: h-raylib successfully auto-unloaded `FunPtr`s (" ++ show l ++ " in total)" ) +unloadFinalizers :: WindowResources -> IO () +unloadFinalizers wr = do + vals <- readIORef (finalizers wr) + let l = length vals + when + (l > 0) + ( do + sequence_ vals + putStrLn $ "INFO: h-raylib successfully invoked finalizers (" ++ show l ++ " in total)" + ) + addShaderId :: (Integral a) => a -> WindowResources -> IO () addShaderId sId' wr = do modifyIORef (shaderIds wr) (\xs -> if sId `elem` xs then xs else sId : xs) @@ -395,8 +431,12 @@ addFunPtr :: FunPtr () -> WindowResources -> IO () addFunPtr fPtr wr = do modifyIORef (funPtrs wr) (\xs -> if fPtr `elem` xs then xs else fPtr : xs) +addFinalizer :: IO () -> WindowResources -> IO () +addFinalizer fin wr = do + modifyIORef (finalizers wr) (fin :) + instance Closeable (FunPtr a) where - close fun = freeHaskellFunPtr fun + close = freeHaskellFunPtr addToWindowResources window fun = addFunPtr (castFunPtr fun) window releaseNonAudioWindowResources :: WindowResources -> IO () @@ -408,6 +448,7 @@ releaseNonAudioWindowResources wr = do unloadVboIds wr unloadAutomationEventLists wr unloadFunPtrs wr + unloadFinalizers wr releaseAudioWindowResources :: WindowResources -> IO () releaseAudioWindowResources wr = do diff --git a/src/Raylib/Internal/Foreign.hs b/src/Raylib/Internal/Foreign.hs index d623d8a..6c22cb7 100644 --- a/src/Raylib/Internal/Foreign.hs +++ b/src/Raylib/Internal/Foreign.hs @@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} -- | -- Miscellaneous utility functions for marshalling values to/from C. The most @@ -9,6 +13,14 @@ module Raylib.Internal.Foreign p'free, freeMaybePtr, Freeable (..), + TLike (..), + Mutable (..), + ALike (..), + ComplexArray, + StringLike, + StringALike, + PLike, + PALike, rlFreeMaybeArray, pop, popCArray, @@ -38,12 +50,15 @@ where import Control.Monad (forM_, unless) import Data.Bits ((.|.)) import qualified Data.ByteString as BS +import Data.Char (chr, ord) import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import Foreign (FunPtr, Ptr, Storable (peek, peekByteOff, poke, sizeOf), allocaBytes, castPtr, malloc, newArray, nullPtr, peekArray, plusPtr, pokeArray0, with, withArray, withArrayLen) +import Data.Word (Word8) +import Foreign (ForeignPtr, FunPtr, Ptr, Storable (peek, peekByteOff, poke, sizeOf), advancePtr, allocaBytes, castPtr, malloc, newArray, newForeignPtr_, nullPtr, peekArray, plusPtr, pokeArray0, with, withArray, withArrayLen, withForeignPtr) import Foreign.C (CFloat, CInt, CString, CUChar, CUInt, peekCString, withCString) import Foreign.C.Types (CBool, CChar, CShort, CUShort) +import GHC.ForeignPtr (newConcForeignPtr) import Linear (V2, V3, V4) -- Internal utility functions @@ -69,13 +84,12 @@ foreign import ccall "stdlib.h &free" p'free :: FunPtr (Ptr a -> IO ()) freeMaybePtr :: Ptr () -> IO () freeMaybePtr ptr = unless (ptr == nullPtr) (c'free ptr) --- | A typeclass used internally to free complex data types. You will most --- likely not have to use this directly. If you do need to implement it, you --- can probably just stick with the default definitions of `rlFree` and --- `rlFreeDependents`. +-- | A typeclass used internally to free complex data types class Freeable a where -- | Frees the data \"dependent\" on a pointer, which usually means dynamic -- C arrays, i.e. more pointers + -- + -- WARNING: This must not free the pointer itself! rlFreeDependents :: a -> Ptr a -> IO () rlFreeDependents _ _ = return () @@ -117,6 +131,166 @@ instance Freeable (V3 a) instance Freeable (V4 a) +-- | A typeclass to allow usage of Haskell values and pointers interchangeably. +-- For example, @TLike (ForeignPtr X) X@ means a value of type X can be converted to +-- and used as a @ForeignPtr X@. +class TLike a b where + withTLike :: b -> (a -> IO c) -> IO c + popTLike :: a -> IO b + peekTLike :: a -> IO b + +-- | A typeclass to allow for mutation of values. For example, @Mutable X X@ +-- means mutating a value of type @X@ will result in a value of type @IO X@. +-- @Mutable (Ptr X) ()@ means mutating a value of type @Ptr X@ will result +-- in a value of type @IO ()@. +class Mutable a b where + peekMutated :: (TLike c a) => a -> c -> IO b + +instance TLike CString String where + withTLike = withCString + popTLike = popCString + peekTLike = peekCString + +instance Mutable String String where + peekMutated _ = peekTLike + +instance (Freeable a, Storable a) => TLike (Ptr a) a where + withTLike = withFreeable + popTLike = pop + peekTLike = peek + +instance (Freeable a, Storable a) => Mutable a a where + peekMutated _ = peekTLike + +instance TLike (Ptr a) (Ptr a) where + withTLike = flip ($) + popTLike = return + peekTLike = return + +instance Mutable (Ptr a) () where + peekMutated _ _ = return () + +instance (Storable a, Freeable a) => TLike (Ptr a) (ForeignPtr a) where + withTLike = withForeignPtr + popTLike ptr = + newConcForeignPtr + ptr + ( do + v <- peek ptr + rlFree v ptr + ) + peekTLike = newForeignPtr_ + +instance Mutable (ForeignPtr a) () where + peekMutated _ _ = return () + +type StringLike = TLike CString + +type PLike a = TLike (Ptr a) + +-- | Similar to @TLike@ but for arrays. In particular, @(Int, Ptr X)@ can be +-- passed as an argument to functions rather than @[X]@. +class ALike a b where + withALikeLen :: b -> (Int -> a -> IO c) -> IO c + withALike :: b -> (a -> IO c) -> IO c + withALike x f = withALikeLen x (\_ p -> f p) + peekALike :: Int -> a -> IO b + popALike :: Int -> a -> IO b + +-- | Use this for `ForeignPtr` arrays of types with complex data, e.g. `Image`. +-- Do not use this for numeric types; use a @(Int, ForeignPtr a)@ tuple instead. +data ComplexArray a = ComplexArray Int (ForeignPtr a) + +instance (Freeable a, Storable a) => ALike (Ptr a) [a] where + withALikeLen = withFreeableArrayLen + withALike = withFreeableArray + peekALike = peekArray + popALike = popCArray + +instance (Freeable a, Storable a) => ALike (Ptr a) (Int, Ptr a) where + withALikeLen = flip uncurry + withALike x f = f $ snd x + peekALike l p = return (l, p) + popALike l p = return (l, p) + +instance (Freeable a, Storable a) => ALike (Ptr a) (Int, ForeignPtr a) where + withALikeLen (l, x) f = withForeignPtr x (f l) + withALike = withForeignPtr . snd + peekALike l p = (l,) <$> newForeignPtr_ p + popALike l p = (l,) <$> newConcForeignPtr p (c'free (castPtr p)) + +instance (Freeable a, Storable a) => ALike (Ptr a) (ComplexArray a) where + withALikeLen (ComplexArray l x) f = withForeignPtr x (f l) + withALike (ComplexArray _ x) = withForeignPtr x + peekALike l p = ComplexArray l <$> newForeignPtr_ p + popALike l p = + ComplexArray l + <$> newConcForeignPtr + p + ( forM_ + [0 .. l - 1] + ( \i -> do + v <- peek (advancePtr p i) + rlFreeDependents v (advancePtr p i) + ) + >> c'free (castPtr p) + ) + +instance ALike (Ptr CUChar) [Word8] where + withALikeLen = withFreeableArrayLen . map fromIntegral + withALike = withFreeableArray . map fromIntegral + peekALike l p = map fromIntegral <$> peekArray l p + popALike l p = map fromIntegral <$> popCArray l p + +instance ALike (Ptr CChar) String where + withALikeLen = withFreeableArrayLen . map (fromIntegral . ord) + withALike = withFreeableArray . map (fromIntegral . ord) + peekALike l p = map (chr . fromIntegral) <$> peekArray l p + popALike l p = map (chr . fromIntegral) <$> popCArray l p + +instance ALike (Ptr CUShort) [Int] where + withALikeLen = withFreeableArrayLen . map fromIntegral + withALike = withFreeableArray . map fromIntegral + peekALike l p = map fromIntegral <$> peekArray l p + popALike l p = map fromIntegral <$> popCArray l p + +instance ALike (Ptr CUInt) [Integer] where + withALikeLen = withFreeableArrayLen . map fromIntegral + withALike = withFreeableArray . map fromIntegral + peekALike l p = map fromIntegral <$> peekArray l p + popALike l p = map fromIntegral <$> popCArray l p + +instance ALike (Ptr CInt) [Int] where + withALikeLen = withFreeableArrayLen . map fromIntegral + withALike = withFreeableArray . map fromIntegral + peekALike l p = map fromIntegral <$> peekArray l p + popALike l p = map fromIntegral <$> popCArray l p + +instance ALike (Ptr CFloat) [Float] where + withALikeLen = withFreeableArrayLen . map realToFrac + withALike = withFreeableArray . map realToFrac + peekALike l p = map realToFrac <$> peekArray l p + popALike l p = map realToFrac <$> popCArray l p + +instance ALike (Ptr CString) [String] where + withALikeLen ss f = helper [] ss + where + helper ps (x : xs) = withCString x (\p -> helper (p : ps) xs) + helper ps [] = withArray ps (f (length ss)) + withALike ss f = helper [] ss + where + helper ps (x : xs) = withCString x (\p -> helper (p : ps) xs) + helper ps [] = withArray (reverse ps) f + peekALike l p = mapM peekCString =<< peekArray l p + popALike l p = do + v <- mapM popCString =<< peekArray l p + c'free (castPtr p) + return v + +type PALike a b = ALike (Ptr a) b + +type StringALike = ALike (Ptr CString) + rlFreeMaybeArray :: (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO () rlFreeMaybeArray Nothing _ = return () rlFreeMaybeArray (Just arr) ptr = rlFree arr (castPtr ptr) @@ -170,22 +344,19 @@ withFreeableArrayLen arr f = do ) withFreeableArray2D :: (Freeable a, Storable a) => [[a]] -> (Ptr (Ptr a) -> IO b) -> IO b -withFreeableArray2D arr func = do - arrays <- mapM newArray arr - ptr <- newArray arrays - res <- func ptr - forM_ (zip [0 ..] arrays) (\(i, a) -> rlFree (arr !! i) (castPtr a)) - c'free $ castPtr ptr - return res +withFreeableArray2D arr func = helper [] arr + where + helper ps (x : xs) = withFreeableArray x (\p -> helper (p : ps) xs) + helper ps [] = withArray (reverse ps) func configsToBitflag :: (Enum a) => [a] -> Integer configsToBitflag = fromIntegral . foldr folder (toEnum 0) where folder a b = fromEnum a .|. b -withMaybe :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b +withMaybe :: (Storable a, Freeable a) => Maybe a -> (Ptr a -> IO b) -> IO b withMaybe a f = case a of - (Just val) -> with val f + (Just val) -> withFreeable val f Nothing -> f nullPtr withMaybeCString :: Maybe String -> (CString -> IO b) -> IO b diff --git a/src/Raylib/Internal/Web/Native.hs b/src/Raylib/Internal/Web/Native.hs index 716da7f..eb68a37 100644 --- a/src/Raylib/Internal/Web/Native.hs +++ b/src/Raylib/Internal/Web/Native.hs @@ -111,4 +111,4 @@ p'jsfree = error "(p'jsfree) Not running in the web!" c'callRaylibFunction :: CString -> CUInt -> Ptr (Ptr ()) -> Ptr CUInt -> Ptr CUChar -> CUInt -> CUInt -> CUChar -> IO (Ptr ()) c'callRaylibFunction = error "(c'callRaylibFunction): Not running in the web!" -#endif \ No newline at end of file +#endif diff --git a/src/Raylib/Internal/Web/Processable.hs b/src/Raylib/Internal/Web/Processable.hs index b1fd697..6791fe1 100644 --- a/src/Raylib/Internal/Web/Processable.hs +++ b/src/Raylib/Internal/Web/Processable.hs @@ -6,8 +6,8 @@ -- /NOTE: This module is only used when building for the web/ module Raylib.Internal.Web.Processable (ProcessedParam (..), ParamType (..), Processable (..)) where -import Foreign (Ptr, FunPtr, Storable (poke, sizeOf), castPtr, malloc) -import Foreign.C (CChar, CDouble, CFloat, CInt, CLong, CUChar, CUInt, CBool) +import Foreign (FunPtr, Ptr, Storable (poke, sizeOf), castPtr, malloc) +import Foreign.C (CBool, CChar, CDouble, CFloat, CInt, CLong, CUChar, CUInt) data ParamType = SignedIntParam | UnsignedIntParam | FloatParam | VoidParam deriving (Enum) diff --git a/src/Raylib/Types/Core.hs b/src/Raylib/Types/Core.hs index 2d32a27..e0deb0f 100644 --- a/src/Raylib/Types/Core.hs +++ b/src/Raylib/Types/Core.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -- | Bindings for types used in all raylib modules module Raylib.Types.Core @@ -140,11 +140,10 @@ import Foreign.C newCString, peekCString, ) -import Linear (V2(V2), V3(V3), V4(V4)) -import Raylib.Internal (Closeable(..), _unloadAutomationEventList, addAutomationEventList) +import Linear (V2 (V2), V3 (V3), V4 (V4)) +import Raylib.Internal (Closeable (..), addAutomationEventList, _unloadAutomationEventList) import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArray, pokeStaticArray) - --------------------------------------- -- core enums ------------------------- --------------------------------------- @@ -659,14 +658,15 @@ instance Enum Gesture where -- core structures -------------------- --------------------------------------- - type Vector2 = V2 Float pattern Vector2 :: Float -> Float -> Vector2 pattern Vector2 - { vector2'x , + { vector2'x, vector2'y - } = V2 vector2'x vector2'y + } = + V2 vector2'x vector2'y + {-# COMPLETE Vector2 :: V2 #-} p'vector2'x :: Ptr Vector2 -> Ptr CFloat @@ -679,10 +679,12 @@ type Vector3 = V3 Float pattern Vector3 :: Float -> Float -> Float -> Vector3 pattern Vector3 - { vector3'x , - vector3'y , + { vector3'x, + vector3'y, vector3'z - } = V3 vector3'x vector3'y vector3'z + } = + V3 vector3'x vector3'y vector3'z + {-# COMPLETE Vector3 :: V3 #-} p'vector3'x :: Ptr Vector3 -> Ptr CFloat @@ -702,7 +704,9 @@ pattern Vector4 vector4'y, vector4'z, vector4'w - } = V4 vector4'x vector4'y vector4'z vector4'w + } = + V4 vector4'x vector4'y vector4'z vector4'w + {-# COMPLETE Vector4 :: V4 #-} vectorToColor :: Vector4 -> Color diff --git a/src/Raylib/Types/Core/Audio.hs b/src/Raylib/Types/Core/Audio.hs index 084d0e5..d01d14b 100644 --- a/src/Raylib/Types/Core/Audio.hs +++ b/src/Raylib/Types/Core/Audio.hs @@ -83,7 +83,7 @@ import Foreign.C CUChar, CUInt, ) -import Raylib.Internal (Closeable (..), c'unloadAudioBuffer, addAudioBuffer, c'unloadMusicStreamData, addCtxData) +import Raylib.Internal (Closeable (..), addAudioBuffer, addCtxData, c'unloadAudioBuffer, c'unloadMusicStreamData) import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekMaybe, peekStaticArray, pokeMaybe, pokeStaticArray) --------------------------------------- @@ -225,7 +225,7 @@ instance Storable RAudioBuffer where let formatIn = case converter of [] -> error "invalid miniaudio converter" - x:_ -> x + x : _ -> x funPtr <- peek (p'rAudioBuffer'callback ptr) let callback = if funPtr == nullFunPtr then Nothing else Just funPtr processor <- peekMaybe (p'rAudioBuffer'processor ptr) @@ -577,4 +577,4 @@ p'music'ctxData = (`plusPtr` 48) type AudioCallback = Ptr () -> Integer -> IO () -type C'AudioCallback = FunPtr (Ptr () -> CUInt -> IO ()) \ No newline at end of file +type C'AudioCallback = FunPtr (Ptr () -> CUInt -> IO ()) diff --git a/src/Raylib/Types/Core/Models.hs b/src/Raylib/Types/Core/Models.hs index e5581c1..5377474 100644 --- a/src/Raylib/Types/Core/Models.hs +++ b/src/Raylib/Types/Core/Models.hs @@ -520,7 +520,8 @@ instance Closeable Shader where close shader = do shaderIdDefault <- c'rlGetShaderIdDefault unless (sId == shaderIdDefault) (c'rlUnloadShaderProgram sId) - where sId = fromIntegral (shader'id shader) + where + sId = fromIntegral (shader'id shader) addToWindowResources window shader = addShaderId (shader'id shader) window p'shader'id :: Ptr Shader -> Ptr CUInt diff --git a/src/Raylib/Types/Core/Text.hs b/src/Raylib/Types/Core/Text.hs index d983b8d..b20368f 100644 --- a/src/Raylib/Types/Core/Text.hs +++ b/src/Raylib/Types/Core/Text.hs @@ -33,7 +33,7 @@ import Foreign import Foreign.C ( CInt (..), ) -import Raylib.Internal (Closeable(..)) +import Raylib.Internal (Closeable (..)) import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, rlFree) import Raylib.Types.Core (Rectangle) import Raylib.Types.Core.Textures (Image, Texture, p'image'data) diff --git a/src/Raylib/Types/Core/Textures.hs b/src/Raylib/Types/Core/Textures.hs index 29924f2..82227ff 100644 --- a/src/Raylib/Types/Core/Textures.hs +++ b/src/Raylib/Types/Core/Textures.hs @@ -41,6 +41,7 @@ module Raylib.Types.Core.Textures ) where +import Control.Monad (when) import Foreign ( Ptr, Storable (alignment, peek, poke, sizeOf), @@ -55,10 +56,9 @@ import Foreign.C CUChar, CUInt, ) -import Raylib.Internal (getPixelDataSize, Closeable (..), c'rlUnloadTexture, addTextureId, c'rlUnloadFramebuffer, addFrameBuffer) +import Raylib.Internal (Closeable (..), addFrameBuffer, addTextureId, c'rlUnloadFramebuffer, c'rlUnloadTexture, getPixelDataSize) import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free) import Raylib.Types.Core (Rectangle) -import Control.Monad (when) --------------------------------------- -- textures enums --------------------- diff --git a/src/Raylib/Util.hs b/src/Raylib/Util.hs index 15ff4b9..00392ee 100644 --- a/src/Raylib/Util.hs +++ b/src/Raylib/Util.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskellQuotes #-} -- | Utility functions that may be useful for an h-raylib application @@ -37,19 +38,22 @@ where import Control.Monad (void) import Control.Monad.Catch (MonadMask, bracket, bracket_) import Control.Monad.IO.Class (MonadIO (liftIO)) +import Foreign (Storable (peek, poke), advancePtr) +import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName)) import Raylib.Core (beginBlendMode, beginDrawing, beginMode2D, beginMode3D, beginScissorMode, beginShaderMode, beginTextureMode, beginVrStereoMode, closeWindow, endBlendMode, endDrawing, endMode2D, endMode3D, endScissorMode, endShaderMode, endTextureMode, endVrStereoMode, initWindow, setTargetFPS, windowShouldClose) -import Raylib.Internal (WindowResources, Closeable (..), managed) -import Raylib.Internal.Foreign (Freeable (..)) +import Raylib.Internal (Closeable (..), WindowResources, managed) +import Raylib.Internal.Foreign (Freeable (..), PLike, TLike (peekTLike, withTLike)) import Raylib.Types ( BlendMode, Camera2D, Camera3D (camera3D'position, camera3D'target), - Material (material'shader), - Model (model'materials), + Model, Ray (Ray), RenderTexture, Shader, VrStereoConfig, + p'material'shader, + p'model'materials, ) import Raylib.Util.Math (Vector (vectorNormalize, (|-|))) @@ -57,12 +61,10 @@ import Raylib.Util.Math (Vector (vectorNormalize, (|-|))) import Foreign (Ptr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr) import Language.Haskell.TH (Body (NormalB), Callconv (CCall), Clause (Clause), Dec (ForeignD, FunD, SigD), DecsQ, Exp (AppE, VarE), Foreign (ExportF), Name, Pat (VarP), Q, Type (AppT, ArrowT, ConT, TupleT), mkName, ppr, reifyType) -import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName)) #else -import Language.Haskell.TH (Name, DecsQ, Type (AppT, ConT, ArrowT, TupleT), Q, reifyType, mkName, ppr, Dec (SigD, FunD), Clause (Clause), Body (NormalB), Exp (VarE, AppE)) -import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName)) +import Language.Haskell.TH (DecsQ, Type (AppT, ConT, ArrowT, TupleT), Q, reifyType, mkName, ppr, Dec (SigD, FunD), Clause (Clause), Body (NormalB), Exp (VarE, AppE)) #endif @@ -85,16 +87,16 @@ withWindow w h title fps = bracket (liftIO $ initWindow w h title <* setTargetFP drawing :: (MonadIO m, MonadMask m) => m b -> m b drawing = bracket_ (liftIO beginDrawing) (liftIO endDrawing) -mode2D :: (MonadIO m, MonadMask m) => Camera2D -> m b -> m b +mode2D :: (MonadIO m, MonadMask m, PLike Camera2D camera2D) => camera2D -> m b -> m b mode2D camera = bracket_ (liftIO (beginMode2D camera)) (liftIO endMode2D) -mode3D :: (MonadIO m, MonadMask m) => Camera3D -> m b -> m b +mode3D :: (MonadIO m, MonadMask m, PLike Camera3D camera3D) => camera3D -> m b -> m b mode3D camera = bracket_ (liftIO (beginMode3D camera)) (liftIO endMode3D) -textureMode :: (MonadIO m, MonadMask m) => RenderTexture -> m b -> m b +textureMode :: (MonadIO m, MonadMask m, PLike RenderTexture renderTexture) => renderTexture -> m b -> m b textureMode rt = bracket_ (liftIO (beginTextureMode rt)) (liftIO endTextureMode) -shaderMode :: (MonadIO m, MonadMask m) => Shader -> m b -> m b +shaderMode :: (MonadIO m, MonadMask m, PLike Shader shader) => shader -> m b -> m b shaderMode shader = bracket_ (liftIO (beginShaderMode shader)) (liftIO endShaderMode) blendMode :: (MonadIO m, MonadMask m) => BlendMode -> m b -> m b @@ -103,7 +105,7 @@ blendMode bm = bracket_ (liftIO (beginBlendMode bm)) (liftIO endBlendMode) scissorMode :: (MonadIO m, MonadMask m) => Int -> Int -> Int -> Int -> m b -> m b scissorMode x y width height = bracket_ (liftIO (beginScissorMode x y width height)) (liftIO endScissorMode) -vrStereoMode :: (MonadIO m, MonadMask m) => VrStereoConfig -> m b -> m b +vrStereoMode :: (MonadIO m, MonadMask m, PLike VrStereoConfig vrStereoConfig) => vrStereoConfig -> m b -> m b vrStereoMode config = bracket_ (liftIO (beginVrStereoMode config)) (liftIO endVrStereoMode) -- | Gets the direction of a camera as a ray. @@ -307,22 +309,31 @@ whileWindowOpen0 :: m () whileWindowOpen0 f = whileWindowOpen (const f) () --- | Sets the shader of a material at a specific index (WARNING: This will fail --- if the index provided is out of bounds). +-- | Sets the shader of a material at a specific index +-- +-- WARNING: This will fail if the index provided is out of bounds setMaterialShader :: + (PLike Model model, PLike Shader shader) => -- | The model to operate on - Model -> + model -> -- | The index of the material Int -> -- | The shader to use - Shader -> + shader -> -- | The modified model - Model -setMaterialShader model matIdx shader = model {model'materials = setIdx mats matIdx newMat} - where - mats = model'materials model - newMat = (mats !! matIdx) {material'shader = shader} - setIdx l i v = take i l ++ [v] ++ drop (i + 1) l + IO model +setMaterialShader model matIdx shader = + withTLike + model + ( \modelPtr -> + withTLike + shader + ( \shaderPtr -> do + mats <- peek (p'model'materials modelPtr) + poke (p'material'shader (advancePtr mats matIdx)) =<< peek shaderPtr + peekTLike modelPtr + ) + ) -- | True if the program is running in GHCi inGHCi :: Bool diff --git a/src/Raylib/Util/GUI.hs b/src/Raylib/Util/GUI.hs index ce6b94e..fad577c 100644 --- a/src/Raylib/Util/GUI.hs +++ b/src/Raylib/Util/GUI.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} -- | -- Bindings to @raygui@ @@ -226,15 +227,13 @@ import Foreign.C CFloat (..), CInt (..), CString, - CUInt (..), - newCString, - peekCString, - withCString, + CUInt, ) import Raylib.Core.Textures (colorToInt, getColor) -import Raylib.Internal.Foreign (pop, popCArray, popCString, withCStringBuffer, withFreeable, withFreeableArrayLen, withMaybe, withMaybeCString) +import Raylib.Internal.Foreign (ALike (peekALike, popALike, withALikeLen), Mutable (peekMutated), PALike, PLike, StringALike, StringLike, TLike (popTLike, withTLike), withCStringBuffer, withFreeable, withMaybe, withMaybeCString) import Raylib.Internal.TH (genNative) -import Raylib.Types (Color (Color), Font, GuiControl (Default), GuiControlProperty (..), GuiDefaultProperty (..), GuiIconName, GuiState, GuiTextAlignment, GuiTextAlignmentVertical, GuiTextWrapMode, Rectangle (Rectangle), Vector2, pattern Vector2, Vector3, pattern Vector3) +import Raylib.Types (Color (Color), Font, GuiControl (Default), GuiControlProperty (..), GuiDefaultProperty (..), GuiIconName, GuiState, GuiTextAlignment, GuiTextAlignmentVertical, GuiTextWrapMode, Rectangle (Rectangle), Vector2, Vector3, pattern Vector2, pattern Vector3) + $( genNative [ ("c'guiEnable", "GuiEnable_", "rgui_bindings.h", [t|IO ()|]), ("c'guiDisable", "GuiDisable_", "rgui_bindings.h", [t|IO ()|]), @@ -329,12 +328,12 @@ guiGetState :: IO GuiState guiGetState = toEnum . fromIntegral <$> c'guiGetState -- | Set gui custom font (global state) -guiSetFont :: Font -> IO () -guiSetFont font = withFreeable font c'guiSetFont +guiSetFont :: (PLike Font font) => font -> IO () +guiSetFont font = withTLike font c'guiSetFont -- | Get gui custom font (global state) -guiGetFont :: IO Font -guiGetFont = c'guiGetFont >>= pop +guiGetFont :: (PLike Font font) => IO font +guiGetFont = c'guiGetFont >>= popTLike -- | Set style property as `Int` guiSetStyle :: (Enum e) => GuiControl -> e -> Int -> IO () @@ -581,8 +580,8 @@ guiGetStyleTextWrapMode :: IO GuiTextWrapMode guiGetStyleTextWrapMode = guiGetStyleE Default TextWrapMode -- | Load style file over global style variable (.rgs) -guiLoadStyle :: String -> IO () -guiLoadStyle fileName = withCString fileName c'guiLoadStyle +guiLoadStyle :: (StringLike string) => string -> IO () +guiLoadStyle fileName = withTLike fileName c'guiLoadStyle -- | Load style default over global style guiLoadStyleDefault :: IO () @@ -597,32 +596,31 @@ guiDisableTooltip :: IO () guiDisableTooltip = c'guiDisableTooltip -- | Set tooltip string -guiSetTooltip :: String -> IO () -guiSetTooltip tooltip = withCString tooltip c'guiSetTooltip +guiSetTooltip :: (StringLike string) => string -> IO () +guiSetTooltip tooltip = withTLike tooltip c'guiSetTooltip -- | Get text with icon id prepended (if supported) -guiIconText :: GuiIconName -> String -> IO String -guiIconText icon text = withCString text (c'guiIconText (fromIntegral (fromEnum icon)) >=> peekCString) +guiIconText :: (StringLike string, Mutable string mut) => GuiIconName -> string -> IO mut +guiIconText icon text = withTLike text (c'guiIconText (fromIntegral (fromEnum icon)) >=> peekMutated text) -- | Set default icon drawing size guiSetIconScale :: Int -> IO () guiSetIconScale = c'guiSetIconScale . fromIntegral --- | Get raygui icons raw pointer (8192 bytes) -guiGetIcons :: IO (Ptr CUInt) -guiGetIcons = c'guiGetIcons +-- | Get raygui icons raw pointer +guiGetIcons :: (PALike CUInt contents) => IO contents +guiGetIcons = c'guiGetIcons >>= peekALike 2048 -- | Load raygui icons file (.rgi) into internal icons data guiLoadIcons :: - String -> + (StringLike string, StringALike strings) => + string -> Bool -> -- | The number of icons in the file Int -> - IO [String] -guiLoadIcons fileName loadIconsName count = do - raw <- withCString fileName (\f -> c'guiLoadIcons f (fromBool loadIconsName)) - cStrings <- popCArray count raw - mapM popCString cStrings + IO strings +guiLoadIcons fileName loadIconsName count = + popALike count =<< withTLike fileName (\f -> c'guiLoadIcons f (fromBool loadIconsName)) -- | Draw icon using pixel size at specified position guiDrawIcon :: GuiIconName -> Int -> Int -> Int -> Color -> IO () @@ -650,8 +648,9 @@ guiPanel bounds text = void (withFreeable bounds (withMaybeCString text . c'guiP -- | Tab Bar control guiTabBar :: + (StringALike strings) => Rectangle -> - [String] -> + strings -> -- | The currently active tab's index, use `Nothing` if creating the tab bar -- for the first time Maybe Int -> @@ -659,12 +658,11 @@ guiTabBar :: -- element is the tab whose close button is pressed (if any) IO (Int, Maybe Int) guiTabBar bounds tabNames active = do - cStrings <- mapM newCString tabNames withFreeable bounds ( \b -> - withFreeableArrayLen - cStrings + withALikeLen + tabNames ( \l t -> withFreeable (fromIntegral (fromMaybe 0 active)) @@ -716,8 +714,8 @@ guiScrollPanel bounds text content scroll view = ) -- | Label control -guiLabel :: Rectangle -> String -> IO () -guiLabel bounds text = void (withFreeable bounds (withCString text . c'guiLabel)) +guiLabel :: (StringLike string) => Rectangle -> string -> IO () +guiLabel bounds text = void (withFreeable bounds (withTLike text . c'guiLabel)) -- | Button control, returns true when clicked guiButton :: Rectangle -> Maybe String -> IO Bool @@ -733,21 +731,23 @@ guiToggle bounds text active = toBool <$> withFreeable bounds (\b -> withMaybeCS -- | Toggle Group control guiToggleGroup :: + (StringLike string) => Rectangle -> -- | The names of the toggles, separated with semicolons - String -> + string -> -- | The currently active toggle's index, use `Nothing` if creating the -- toggle group for the first time Maybe Int -> -- | The updated active toggle index IO Int -guiToggleGroup bounds text active = fromIntegral <$> withFreeable bounds (\b -> withCString text (\t -> withFreeable (fromIntegral (fromMaybe 0 active)) (\a -> c'guiToggleGroup b t a >> peek a))) +guiToggleGroup bounds text active = fromIntegral <$> withFreeable bounds (\b -> withTLike text (\t -> withFreeable (fromIntegral (fromMaybe 0 active)) (\a -> c'guiToggleGroup b t a >> peek a))) -- | Toggle Slider control guiToggleSlider :: + (StringLike string) => Rectangle -> -- | The names of the toggles, separated with semicolons - String -> + string -> -- | The currently active toggle's index, use `Nothing` if creating the -- toggle slider for the first time Maybe Int -> @@ -758,7 +758,7 @@ guiToggleSlider bounds text active = withFreeable bounds ( \b -> - withCString + withTLike text ( \t -> withFreeable @@ -783,21 +783,23 @@ guiCheckBox bounds text checked = toBool <$> withFreeable bounds (\b -> withMayb -- | Combo Box control guiComboBox :: + (StringLike string) => Rectangle -> -- | The names of the combobox options, separated with semicolons - String -> + string -> -- | The currently active option's index, use `Nothing` if creating the -- combobox for the first time Maybe Int -> -- | The updated active option index IO Int -guiComboBox bounds text active = fromIntegral <$> withFreeable bounds (\b -> withCString text (\t -> withFreeable (fromIntegral (fromMaybe 0 active)) (\a -> c'guiComboBox b t a >> peek a))) +guiComboBox bounds text active = fromIntegral <$> withFreeable bounds (\b -> withTLike text (\t -> withFreeable (fromIntegral (fromMaybe 0 active)) (\a -> c'guiComboBox b t a >> peek a))) -- | Dropdown Box control guiDropdownBox :: + (StringLike string) => Rectangle -> -- | The names of the dropdown options, separated with semicolons - String -> + string -> -- | The currently active option's index, use `Nothing` if creating the -- dropdown for the first time Maybe Int -> @@ -811,7 +813,7 @@ guiDropdownBox bounds text active editMode = withFreeable bounds ( \b -> - withCString + withTLike text ( \t -> withFreeable @@ -948,8 +950,7 @@ guiTextBox bounds text bufferSize editMode = withCStringBuffer text bufferSize - ( \s t -> toBool <$> c'guiTextBox b t (fromIntegral s) (fromBool editMode) - ) + (\s t -> toBool <$> c'guiTextBox b t (fromIntegral s) (fromBool editMode)) ) -- | Slider control @@ -1050,12 +1051,12 @@ guiProgressBar bounds textLeft textRight value minValue maxValue = ) -- | Status Bar control, shows info text -guiStatusBar :: Rectangle -> String -> IO () -guiStatusBar bounds text = void (withFreeable bounds (withCString text . c'guiStatusBar)) +guiStatusBar :: (StringLike string) => Rectangle -> string -> IO () +guiStatusBar bounds text = void (withFreeable bounds (withTLike text . c'guiStatusBar)) -- | Dummy control for placeholders -guiDummyRec :: Rectangle -> String -> IO () -guiDummyRec bounds text = void (withFreeable bounds (withCString text . c'guiDummyRec)) +guiDummyRec :: (StringLike string) => Rectangle -> string -> IO () +guiDummyRec bounds text = void (withFreeable bounds (withTLike text . c'guiDummyRec)) -- | Grid control guiGrid :: @@ -1071,8 +1072,7 @@ guiGrid bounds spacing subdivs = withFreeable (Vector2 (-1) (-1)) ( \v -> - ( \cell -> if cell == Vector2 (-1) (-1) then Nothing else Just cell - ) + (\cell -> if cell == Vector2 (-1) (-1) then Nothing else Just cell) <$> ( c'guiGrid b nullPtr (realToFrac spacing) (fromIntegral subdivs) v >> peek v ) @@ -1081,9 +1081,10 @@ guiGrid bounds spacing subdivs = -- | List View control guiListView :: + (StringLike string) => Rectangle -> -- | The names of the list options, separated with semicolons - String -> + string -> -- | Current scroll index Int -> -- | Currently selected option index (active index) @@ -1095,7 +1096,7 @@ guiListView bounds text scrollIndex active = withFreeable bounds ( \b -> - withCString + withTLike text ( \t -> withFreeable @@ -1115,9 +1116,10 @@ guiListView bounds text scrollIndex active = -- | List View with extended parameters guiListViewEx :: + (StringALike strings) => Rectangle -> -- | The names of the list options - [String] -> + strings -> -- | Current scroll index Int -> -- | Currently selected option index (active index) @@ -1129,12 +1131,11 @@ guiListViewEx :: -- focus index IO (Int, Maybe Int, Maybe Int) guiListViewEx bounds text scrollIndex active focus = do - cStrings <- mapM newCString text withFreeable bounds ( \b -> - withFreeableArrayLen - cStrings + withALikeLen + text ( \c t -> withFreeable (fromIntegral scrollIndex) @@ -1158,11 +1159,12 @@ guiListViewEx bounds text scrollIndex active focus = do -- | Message Box control, displays a message guiMessageBox :: + (StringLike string1, StringLike string2) => Rectangle -> Maybe String -> - String -> + string1 -> -- | Button labels separated by semicolons - String -> + string2 -> -- | The index of the clicked button, if any (0 = close message box, -- 1,2,... = custom button) IO (Maybe Int) @@ -1173,10 +1175,10 @@ guiMessageBox bounds title message buttons = withMaybeCString title ( \t -> - withCString + withTLike message ( \m -> - withCString + withTLike buttons ( \bu -> do res <- c'guiMessageBox b t m bu @@ -1188,11 +1190,12 @@ guiMessageBox bounds title message buttons = -- | Text Input Box control, ask for text, supports secret guiTextInputBox :: + (StringLike string1, StringLike string2) => Rectangle -> Maybe String -> - String -> + string1 -> -- | Button names, separated by semicolons - String -> + string2 -> -- | Current text box value String -> -- | Text box buffer size; if `Nothing`, then it will automatically allocate @@ -1215,10 +1218,10 @@ guiTextInputBox bounds title message buttons value bufferSize secret = do withMaybeCString title ( \t -> - withCString + withTLike message ( \m -> - withCString + withTLike buttons ( \bu -> withCStringBuffer @@ -1253,8 +1256,7 @@ guiColorPicker bounds color = ( \b -> withFreeable (fromMaybe (Color 200 0 0 255) color) - ( \c -> c'guiColorPicker b nullPtr c >> peek c - ) + (\c -> c'guiColorPicker b nullPtr c >> peek c) ) -- | Color Panel control @@ -1271,8 +1273,7 @@ guiColorPanel bounds color = ( \b -> withFreeable (fromMaybe (Color 200 0 0 255) color) - ( \c -> c'guiColorPanel b nullPtr c >> peek c - ) + (\c -> c'guiColorPanel b nullPtr c >> peek c) ) -- | Color Bar Alpha control @@ -1289,8 +1290,7 @@ guiColorBarAlpha bounds alpha = ( \b -> withFreeable (realToFrac alpha) - ( \a -> c'guiColorBarAlpha b nullPtr a >> peek a - ) + (\a -> c'guiColorBarAlpha b nullPtr a >> peek a) ) -- | Color Bar Hue control @@ -1307,8 +1307,7 @@ guiColorBarHue bounds hue = ( \b -> withFreeable (realToFrac hue) - ( \h -> c'guiColorBarHue b nullPtr h >> peek h - ) + (\h -> c'guiColorBarHue b nullPtr h >> peek h) ) -- | Color Picker control that avoids conversion to RGB on each call (multiple color controls) @@ -1325,8 +1324,7 @@ guiColorPickerHSV bounds color = ( \b -> withFreeable (fromMaybe (Vector3 (200.0 / 255.0) 0 0) color) - ( \c -> c'guiColorPickerHSV b nullPtr c >> peek c - ) + (\c -> c'guiColorPickerHSV b nullPtr c >> peek c) ) -- | Color Panel control that updates Hue-Saturation-Value color value, used by guiColorPickerHSV @@ -1343,6 +1341,5 @@ guiColorPanelHSV bounds color = ( \b -> withFreeable (fromMaybe (Vector3 (200.0 / 255.0) 0 0) color) - ( \c -> c'guiColorPanelHSV b nullPtr c >> peek c - ) + (\c -> c'guiColorPanelHSV b nullPtr c >> peek c) ) diff --git a/src/Raylib/Util/Math.hs b/src/Raylib/Util/Math.hs index b5aff2a..9b9ab10 100644 --- a/src/Raylib/Util/Math.hs +++ b/src/Raylib/Util/Math.hs @@ -1,6 +1,8 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Parenthesize unary negation" #-} -- | Bindings to @raymath@ -- @@ -97,7 +99,8 @@ module Raylib.Util.Math where import Data.Foldable (foldl') -import Raylib.Types (Matrix (..), Quaternion, Vector2, pattern Vector2, Vector3, pattern Vector3, Vector4, pattern Vector4) +import Raylib.Types (Matrix (..), Quaternion, Vector2, Vector3, Vector4, pattern Vector2, pattern Vector3, pattern Vector4) + epsilon :: Float epsilon = 0.000001 @@ -257,11 +260,11 @@ class Vector a where -- | Vector additive inverse additiveInverse :: a -> a - additiveInverse v = mapV negate v + additiveInverse = mapV negate -- | Vector multiplicative inverse multiplicativeInverse :: a -> a - multiplicativeInverse v = mapV (1 /) v + multiplicativeInverse = mapV (1 /) -- | Squared magnitude of a vector magnitudeSqr :: a -> Float @@ -318,7 +321,7 @@ class Vector a where -- | Upper bound a -> a - vectorClamp v low high = zipWithV3 clamp v low high + vectorClamp = zipWithV3 clamp -- | Clamp the magnitude of a vector to a range vectorClampValue :: @@ -335,11 +338,11 @@ class Vector a where -- | Min value for each pair of components vectorMin :: a -> a -> a - vectorMin v1 v2 = zipWithV min v1 v2 + vectorMin = zipWithV min -- | Max value for each pair of components vectorMax :: a -> a -> a - vectorMax v1 v2 = zipWithV max v1 v2 + vectorMax = zipWithV max instance Vector Vector2 where asList (Vector2 x y) = [x, y] @@ -950,10 +953,10 @@ matrixDecompose (Matrix m0 m4 m8 m12 m1 m5 m9 m13 m2 m6 m10 m14 m3 m7 m11 m15) = h = m6 i = m10 translation = Vector3 m12 m13 m14 - a' = e*i - f*h - b' = f*g - d*i - c' = d*h - e*g - det = a*a' + b*b' + c*c' + a' = e * i - f * h + b' = f * g - d * i + c' = d * h - e * g + det = a * a' + b * b' + c * c' abc = Vector3 a b c def = Vector3 d e f ghi = Vector3 g h i diff --git a/src/Raylib/Util/RLGL.hs b/src/Raylib/Util/RLGL.hs index 687ee23..c2d1c26 100644 --- a/src/Raylib/Util/RLGL.hs +++ b/src/Raylib/Util/RLGL.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -- | Bindings to @rlgl@ @@ -386,13 +387,13 @@ import Foreign.C withCString, ) import Raylib.Internal.Foreign - ( Freeable, + ( ALike (popALike, withALike, withALikeLen), + Freeable, + PALike, configsToBitflag, pop, - popCArray, withFreeable, withFreeableArray, - withFreeableArrayLen, ) import Raylib.Internal.TH (genNative) import Raylib.Types @@ -601,8 +602,8 @@ rlScalef :: Float -> Float -> Float -> IO () rlScalef x y z = c'rlScalef (realToFrac x) (realToFrac y) (realToFrac z) -- | Multiply the current matrix by another matrix -rlMultMatrixf :: [Float] -> IO () -rlMultMatrixf matf = withFreeableArray (map realToFrac matf) c'rlMultMatrixf +rlMultMatrixf :: (PALike CFloat matrix) => matrix -> IO () +rlMultMatrixf matf = withALike matf c'rlMultMatrixf -- | Multiply the current matrix by a perspective matrix generated by parameters rlFrustum :: Double -> Double -> Double -> Double -> Double -> Double -> IO () @@ -926,8 +927,8 @@ rlGetShaderIdDefault :: IO Integer rlGetShaderIdDefault = fromIntegral <$> c'rlGetShaderIdDefault -- | Get default shader locations -rlGetShaderLocsDefault :: IO [Int] -rlGetShaderLocsDefault = map fromIntegral <$> (popCArray 32 =<< c'rlGetShaderLocsDefault) +rlGetShaderLocsDefault :: (PALike CInt locs) => IO locs +rlGetShaderLocsDefault = popALike 32 =<< c'rlGetShaderLocsDefault -- | Load a render batch system rlLoadRenderBatch :: Int -> Int -> IO RLRenderBatch @@ -1016,42 +1017,42 @@ rlDrawVertexArray :: Int -> Int -> IO () rlDrawVertexArray offset count = c'rlDrawVertexArray (fromIntegral offset) (fromIntegral count) -- | Draw vertex array elements -rlDrawVertexArrayElements :: Int -> [Int] -> IO () +rlDrawVertexArrayElements :: (PALike CUShort buffer) => Int -> buffer -> IO () rlDrawVertexArrayElements offset buffer = - withFreeableArray - (map fromIntegral buffer :: [CUShort]) - (c'rlDrawVertexArrayElements (fromIntegral offset) (fromIntegral $ length buffer) . castPtr) + withALikeLen + buffer + (\l p -> c'rlDrawVertexArrayElements (fromIntegral offset) (fromIntegral l) (castPtr (p :: Ptr CUShort))) -- | Draw vertex array instanced rlDrawVertexArrayInstanced :: Int -> Int -> Int -> IO () rlDrawVertexArrayInstanced offset count instances = c'rlDrawVertexArrayInstanced (fromIntegral offset) (fromIntegral count) (fromIntegral instances) -- | Draw vertex array elements instanced -rlDrawVertexArrayElementsInstanced :: Int -> [Int] -> Int -> IO () +rlDrawVertexArrayElementsInstanced :: (PALike CUShort buffer) => Int -> buffer -> Int -> IO () rlDrawVertexArrayElementsInstanced offset buffer instances = - withFreeableArray - (map fromIntegral buffer :: [CUShort]) - ( \p -> - c'rlDrawVertexArrayElementsInstanced (fromIntegral offset) (fromIntegral $ length buffer) (castPtr p) (fromIntegral instances) + withALikeLen + buffer + ( \l p -> + c'rlDrawVertexArrayElementsInstanced (fromIntegral offset) (fromIntegral l) (castPtr (p :: Ptr CUShort)) (fromIntegral instances) ) -- | Load texture in GPU -rlLoadTexture :: [Int] -> Int -> Int -> RLPixelFormat -> Int -> IO Integer +rlLoadTexture :: (PALike CUShort buffer) => buffer -> Int -> Int -> RLPixelFormat -> Int -> IO Integer rlLoadTexture tData width height format mipmapCount = fromIntegral - <$> withFreeableArray - (map fromIntegral tData :: [CUShort]) - (\p -> c'rlLoadTexture (castPtr p) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) (fromIntegral mipmapCount)) + <$> withALike + tData + (\p -> c'rlLoadTexture (castPtr (p :: Ptr CUShort)) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) (fromIntegral mipmapCount)) -- | Load depth texture/renderbuffer (to be attached to fbo) rlLoadTextureDepth :: Int -> Int -> Bool -> IO Integer rlLoadTextureDepth width height useRenderBuffer = fromIntegral <$> c'rlLoadTextureDepth (fromIntegral width) (fromIntegral height) (fromBool useRenderBuffer) -- | Load texture cubemap -rlLoadTextureCubemap :: [Int] -> RLPixelFormat -> IO Integer +rlLoadTextureCubemap :: (PALike CUShort buffer) => buffer -> RLPixelFormat -> IO Integer rlLoadTextureCubemap tData format = fromIntegral - <$> withFreeableArrayLen (map fromIntegral tData :: [CUShort]) (\l p -> c'rlLoadTextureCubemap (castPtr p) (fromIntegral $ l * sizeOf (0 :: CUShort)) (fromIntegral $ fromEnum format)) + <$> withALikeLen tData (\l p -> c'rlLoadTextureCubemap (castPtr (p :: Ptr CUShort)) (fromIntegral $ l * sizeOf (0 :: CUShort)) (fromIntegral $ fromEnum format)) -- | Update GPU texture with new data rlUpdateTexture :: (Freeable a, Storable a) => Integer -> Int -> Int -> Int -> Int -> RLPixelFormat -> [a] -> IO () @@ -1127,16 +1128,16 @@ rlGenTextureMipmaps tId width height format = fromIntegral <$> withFreeable (0 :: CInt) (\p -> c'rlGenTextureMipmaps (fromIntegral tId) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) p >> peek p) -- | Read texture pixel data -rlReadTexturePixels :: Integer -> Int -> Int -> RLPixelFormat -> IO [Word8] +rlReadTexturePixels :: (PALike CUChar contents) => Integer -> Int -> Int -> RLPixelFormat -> IO contents rlReadTexturePixels tId width height format = do ptr <- c'rlReadTexturePixels (fromIntegral tId) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) size <- fromIntegral <$> c'rlGetPixelDataSize (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum format) - map fromIntegral <$> popCArray size (castPtr ptr :: Ptr CUChar) + popALike size (castPtr ptr :: Ptr CUChar) -- | Read screen pixel data (color buffer) -rlReadScreenPixels :: Int -> Int -> IO [Word8] +rlReadScreenPixels :: (PALike CUChar contents) => Int -> Int -> IO contents rlReadScreenPixels width height = - map fromIntegral <$> (c'rlReadScreenPixels (fromIntegral width) (fromIntegral height) >>= popCArray (width * height * 4)) + c'rlReadScreenPixels (fromIntegral width) (fromIntegral height) >>= popALike (width * height * 4) -- | Load an empty framebuffer rlLoadFramebuffer :: IO Integer @@ -1196,16 +1197,16 @@ rlSetUniformMatrix :: Int -> Matrix -> IO () rlSetUniformMatrix locIndex mat = withFreeable mat (c'rlSetUniformMatrix (fromIntegral locIndex)) -- | Set shader value matrices -rlSetUniformMatrices :: Int -> [Matrix] -> IO () -rlSetUniformMatrices locIndex mats = withFreeableArrayLen mats (\c m -> c'rlSetUniformMatrices (fromIntegral locIndex) m (fromIntegral c)) +rlSetUniformMatrices :: (PALike Matrix matrices) => Int -> matrices -> IO () +rlSetUniformMatrices locIndex mats = withALikeLen mats (\c m -> c'rlSetUniformMatrices (fromIntegral locIndex) m (fromIntegral c)) -- | Set shader value sampler rlSetUniformSampler :: Int -> Integer -> IO () rlSetUniformSampler locIndex textureId = c'rlSetUniformSampler (fromIntegral locIndex) (fromIntegral textureId) -- | Set shader currently active (id and locations) -rlSetShader :: Integer -> [Int] -> IO () -rlSetShader shaderId locs = withFreeableArray (map fromIntegral locs :: [CInt]) (c'rlSetShader (fromIntegral shaderId)) +rlSetShader :: (PALike CInt locs) => Integer -> locs -> IO () +rlSetShader shaderId locs = withALike locs (c'rlSetShader (fromIntegral shaderId)) -- | Load compute shader program rlLoadComputeShaderProgram :: Integer -> IO Integer