{-# OPTIONS -Wall #-} module Raylib.Core.Textures where import Control.Monad ((<=<)) import Foreign ( Ptr, Storable (peek, sizeOf), toBool, ) import Foreign.C (CUChar, withCString) import GHC.IO (unsafePerformIO) import Raylib.ForeignUtil ( pop, popCArray, withFreeable, withFreeableArrayLen, ) import Raylib.Internal (addFrameBuffer, addTextureId, unloadSingleFrameBuffer, unloadSingleTexture, WindowResources) import Raylib.Native ( c'colorAlpha, c'colorAlphaBlend, c'colorBrightness, c'colorContrast, c'colorFromHSV, c'colorFromNormalized, c'colorNormalize, c'colorTint, c'colorToHSV, c'colorToInt, c'drawTexture, c'drawTextureEx, c'drawTextureNPatch, c'drawTexturePro, c'drawTextureRec, c'drawTextureV, c'exportImage, c'exportImageAsCode, c'fade, c'genImageCellular, c'genImageChecked, c'genImageColor, c'genImageGradientH, c'genImageGradientRadial, c'genImageGradientV, c'genImagePerlinNoise, c'genImageText, c'genImageWhiteNoise, c'genTextureMipmaps, c'getColor, c'getImageAlphaBorder, c'getImageColor, c'getPixelColor, c'imageAlphaClear, c'imageAlphaCrop, c'imageAlphaMask, c'imageAlphaPremultiply, c'imageBlurGaussian, c'imageClearBackground, c'imageColorBrightness, c'imageColorContrast, c'imageColorGrayscale, c'imageColorInvert, c'imageColorReplace, c'imageColorTint, c'imageCopy, c'imageCrop, c'imageDither, c'imageDraw, c'imageDrawCircle, c'imageDrawCircleLines, c'imageDrawCircleLinesV, c'imageDrawCircleV, c'imageDrawLine, c'imageDrawLineV, c'imageDrawPixel, c'imageDrawPixelV, c'imageDrawRectangle, c'imageDrawRectangleLines, c'imageDrawRectangleRec, c'imageDrawRectangleV, c'imageDrawText, c'imageDrawTextEx, c'imageFlipHorizontal, c'imageFlipVertical, c'imageFormat, c'imageFromImage, c'imageMipmaps, c'imageResize, c'imageResizeCanvas, c'imageResizeNN, c'imageRotateCCW, c'imageRotateCW, c'imageText, c'imageTextEx, c'imageToPOT, c'isImageReady, c'isRenderTextureReady, c'isTextureReady, c'loadImage, c'loadImageAnim, c'loadImageColors, c'loadImageFromMemory, c'loadImageFromScreen, c'loadImageFromTexture, c'loadImagePalette, c'loadImageRaw, c'loadRenderTexture, c'loadTexture, c'loadTextureCubemap, c'loadTextureFromImage, c'setPixelColor, c'setTextureFilter, c'setTextureWrap, c'updateTexture, c'updateTextureRec, ) import Raylib.Types ( Color, CubemapLayout, Font, Image (image'height, image'width), NPatchInfo, PixelFormat, Rectangle, RenderTexture (renderTexture'id, renderTexture'texture), Texture (texture'id), TextureFilter, TextureWrap, Vector2, Vector3, Vector4, ) loadImage :: String -> IO Image loadImage fileName = withCString fileName c'loadImage >>= pop loadImageRaw :: 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 -- | Returns the animation and the number of frames in a tuple loadImageAnim :: String -> IO (Image, Int) loadImageAnim fileName = withFreeable 0 ( \frames -> withCString fileName ( \fn -> do img <- c'loadImageAnim fn frames >>= pop frameNum <- fromIntegral <$> peek frames return (img, frameNum) ) ) loadImageFromMemory :: String -> [Integer] -> IO Image loadImageFromMemory fileType fileData = withCString fileType (\ft -> withFreeableArrayLen (map fromIntegral fileData) (\size fd -> c'loadImageFromMemory ft fd (fromIntegral $ size * sizeOf (0 :: CUChar)))) >>= pop loadImageFromTexture :: Texture -> IO Image loadImageFromTexture tex = withFreeable tex c'loadImageFromTexture >>= pop loadImageFromScreen :: IO Image loadImageFromScreen = c'loadImageFromScreen >>= pop isImageReady :: Image -> IO Bool isImageReady image = toBool <$> withFreeable image c'isImageReady exportImage :: Image -> String -> IO Bool exportImage image fileName = toBool <$> withFreeable image (withCString fileName . c'exportImage) exportImageAsCode :: Image -> String -> IO Bool exportImageAsCode image fileName = toBool <$> withFreeable image (withCString fileName . c'exportImageAsCode) genImageColor :: Int -> Int -> Color -> IO Image genImageColor width height color = withFreeable color (c'genImageColor (fromIntegral width) (fromIntegral height)) >>= pop genImageGradientV :: Int -> Int -> Color -> Color -> IO Image genImageGradientV width height top bottom = withFreeable top (withFreeable bottom . c'genImageGradientV (fromIntegral width) (fromIntegral height)) >>= pop genImageGradientH :: Int -> Int -> Color -> Color -> IO Image genImageGradientH width height left right = withFreeable left (withFreeable right . c'genImageGradientH (fromIntegral width) (fromIntegral height)) >>= pop genImageGradientRadial :: 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 genImageChecked :: 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 genImageWhiteNoise :: Int -> Int -> Float -> IO Image genImageWhiteNoise width height factor = c'genImageWhiteNoise (fromIntegral width) (fromIntegral height) (realToFrac factor) >>= pop 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 genImageCellular :: Int -> Int -> Int -> IO Image genImageCellular width height tileSize = c'genImageCellular (fromIntegral width) (fromIntegral height) (fromIntegral tileSize) >>= pop genImageText :: Int -> Int -> String -> IO Image genImageText width height text = withCString text (c'genImageText (fromIntegral width) (fromIntegral height)) >>= pop imageCopy :: Image -> IO Image imageCopy image = withFreeable image c'imageCopy >>= pop imageFromImage :: Image -> Rectangle -> IO Image imageFromImage image rect = withFreeable image (withFreeable rect . c'imageFromImage) >>= pop imageText :: String -> Int -> Color -> IO Image imageText text fontSize color = withCString text (\t -> withFreeable color $ c'imageText t (fromIntegral fontSize)) >>= pop imageTextEx :: 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 imageFormat :: Image -> PixelFormat -> IO Image imageFormat image newFormat = withFreeable image (\i -> c'imageFormat i (fromIntegral $ fromEnum newFormat) >> peek i) imageToPOT :: Image -> Color -> IO Image imageToPOT image color = withFreeable image (\i -> withFreeable color (c'imageToPOT i) >> peek i) imageCrop :: Image -> Rectangle -> IO Image imageCrop image crop = withFreeable image (\i -> withFreeable crop (c'imageCrop i) >> peek i) imageAlphaCrop :: Image -> Float -> IO Image imageAlphaCrop image threshold = withFreeable image (\i -> c'imageAlphaCrop i (realToFrac threshold) >> peek 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)) imageAlphaMask :: Image -> Image -> IO Image imageAlphaMask image alphaMask = withFreeable image (\i -> withFreeable alphaMask (c'imageAlphaMask i) >> peek i) imageAlphaPremultiply :: Image -> IO Image imageAlphaPremultiply image = withFreeable image (\i -> c'imageAlphaPremultiply i >> peek i) imageBlurGaussian :: Image -> Int -> IO Image imageBlurGaussian image blurSize = withFreeable image (\i -> c'imageBlurGaussian i (fromIntegral blurSize) >> peek i) imageResize :: Image -> Int -> Int -> IO Image imageResize image newWidth newHeight = withFreeable image (\i -> c'imageResize i (fromIntegral newWidth) (fromIntegral newHeight) >> peek i) imageResizeNN :: Image -> Int -> Int -> IO Image imageResizeNN image newWidth newHeight = withFreeable image (\i -> c'imageResizeNN i (fromIntegral newWidth) (fromIntegral newHeight) >> peek 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) imageMipmaps :: Image -> IO Image imageMipmaps image = withFreeable image (\i -> c'imageMipmaps i >> peek 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) imageFlipVertical :: Image -> IO Image imageFlipVertical image = withFreeable image (\i -> c'imageFlipVertical i >> peek i) imageFlipHorizontal :: Image -> IO Image imageFlipHorizontal image = withFreeable image (\i -> c'imageFlipHorizontal i >> peek i) imageRotateCW :: Image -> IO Image imageRotateCW image = withFreeable image (\i -> c'imageRotateCW i >> peek i) imageRotateCCW :: Image -> IO Image imageRotateCCW image = withFreeable image (\i -> c'imageRotateCCW i >> peek i) imageColorTint :: Image -> Color -> IO Image imageColorTint image color = withFreeable image (\i -> withFreeable color (c'imageColorTint i) >> peek i) imageColorInvert :: Image -> IO Image imageColorInvert image = withFreeable image (\i -> c'imageColorInvert i >> peek i) imageColorGrayscale :: Image -> IO Image imageColorGrayscale image = withFreeable image (\i -> c'imageColorGrayscale i >> peek i) imageColorContrast :: Image -> Float -> IO Image imageColorContrast image contrast = withFreeable image (\i -> c'imageColorContrast i (realToFrac contrast) >> peek i) imageColorBrightness :: Image -> Int -> IO Image imageColorBrightness image brightness = withFreeable image (\i -> c'imageColorBrightness i (fromIntegral brightness) >> peek i) imageColorReplace :: Image -> Color -> Color -> IO Image imageColorReplace image color replace = withFreeable image (\i -> withFreeable color (withFreeable replace . c'imageColorReplace i) >> peek i) loadImageColors :: Image -> IO [Color] loadImageColors image = withFreeable image (popCArray (fromIntegral $ image'width image * image'height image) <=< c'loadImageColors) loadImagePalette :: Image -> Int -> IO [Color] loadImagePalette image maxPaletteSize = withFreeable image ( \i -> do (palette, num) <- withFreeable 0 ( \size -> do cols <- c'loadImagePalette i (fromIntegral maxPaletteSize) size s <- peek size return (cols, s) ) popCArray (fromIntegral num) palette ) getImageAlphaBorder :: Image -> Float -> IO Rectangle getImageAlphaBorder image threshold = withFreeable 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 imageClearBackground :: Image -> Color -> IO Image imageClearBackground image color = withFreeable image (\i -> withFreeable color (c'imageClearBackground i) >> peek 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) imageDrawPixelV :: Image -> Vector2 -> Color -> IO Image imageDrawPixelV image position color = withFreeable image (\i -> withFreeable position (withFreeable color . c'imageDrawPixelV i) >> peek 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) 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) 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) 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) 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) 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) 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) 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) imageDrawRectangleRec :: Image -> Rectangle -> Color -> IO Image imageDrawRectangleRec image rectangle color = withFreeable image (\i -> withFreeable rectangle (withFreeable color . c'imageDrawRectangleRec i) >> peek 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) 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) 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) 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) loadTexture :: String -> WindowResources -> IO Texture loadTexture fileName wr = do texture <- withCString fileName c'loadTexture >>= pop addTextureId (texture'id texture) wr return texture loadTextureFromImage :: Image -> WindowResources -> IO Texture loadTextureFromImage image wr = do texture <- withFreeable image c'loadTextureFromImage >>= pop addTextureId (texture'id texture) wr return texture loadTextureCubemap :: Image -> CubemapLayout -> WindowResources -> IO Texture loadTextureCubemap image layout wr = do texture <- withFreeable image (\i -> c'loadTextureCubemap i (fromIntegral $ fromEnum layout)) >>= pop addTextureId (texture'id texture) wr return texture loadRenderTexture :: Int -> Int -> WindowResources -> IO RenderTexture loadRenderTexture width height wr = do renderTexture <- c'loadRenderTexture (fromIntegral width) (fromIntegral height) >>= pop addFrameBuffer (renderTexture'id renderTexture) wr addTextureId (texture'id $ renderTexture'texture renderTexture) wr return renderTexture isTextureReady :: Texture -> IO Bool isTextureReady texture = toBool <$> withFreeable texture c'isTextureReady isRenderTextureReady :: RenderTexture -> IO Bool isRenderTextureReady renderTexture = toBool <$> withFreeable renderTexture c'isRenderTextureReady -- | Unloads a texture from GPU memory (VRAM). Textures are automatically unloaded -- when `closeWindow` is called, so manually unloading textures is not required. -- In larger projects, you may want to manually unload textures to avoid having -- them in VRAM for too long. unloadTexture :: Texture -> WindowResources -> IO () unloadTexture texture = unloadSingleTexture (texture'id texture) -- | Unloads a render texture from GPU memory (VRAM). Render textures are -- automatically unloaded when `closeWindow` is called, so manually unloading -- render textures is not required. In larger projects, you may want to -- manually unload render textures to avoid having them in VRAM for too long. unloadRenderTexture :: RenderTexture -> WindowResources -> IO () unloadRenderTexture renderTexture wr = do unloadSingleTexture (texture'id $ renderTexture'texture renderTexture) wr unloadSingleFrameBuffer (renderTexture'id renderTexture) wr updateTexture :: Texture -> Ptr () -> IO Texture updateTexture texture pixels = withFreeable texture (\t -> c'updateTexture t pixels >> peek t) updateTextureRec :: Texture -> Rectangle -> Ptr () -> IO Texture updateTextureRec texture rect pixels = withFreeable texture (\t -> withFreeable rect (\r -> c'updateTextureRec t r pixels) >> peek t) genTextureMipmaps :: Texture -> IO Texture genTextureMipmaps texture = withFreeable texture (\t -> c'genTextureMipmaps t >> peek t) setTextureFilter :: Texture -> TextureFilter -> IO Texture setTextureFilter texture filterType = withFreeable texture (\t -> c'setTextureFilter t (fromIntegral $ fromEnum filterType) >> peek t) setTextureWrap :: Texture -> TextureWrap -> IO Texture setTextureWrap texture wrap = withFreeable texture (\t -> c'setTextureWrap t (fromIntegral $ fromEnum wrap) >> peek t) drawTexture :: Texture -> Int -> Int -> Color -> IO () drawTexture texture x y tint = withFreeable 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)) 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)))) 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))) 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)))))) 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)))))) fade :: Color -> Float -> Color fade color alpha = unsafePerformIO $ withFreeable color (\c -> c'fade c (realToFrac alpha)) >>= pop colorToInt :: Color -> Int colorToInt color = unsafePerformIO $ fromIntegral <$> withFreeable color c'colorToInt colorNormalize :: Color -> Vector4 colorNormalize color = unsafePerformIO $ withFreeable color c'colorNormalize >>= pop colorFromNormalized :: Vector4 -> Color colorFromNormalized normalized = unsafePerformIO $ withFreeable normalized c'colorFromNormalized >>= pop colorToHSV :: Color -> Vector3 colorToHSV color = unsafePerformIO $ withFreeable color c'colorToHSV >>= pop colorFromHSV :: Float -> Float -> Float -> Color colorFromHSV hue saturation value = unsafePerformIO $ c'colorFromHSV (realToFrac hue) (realToFrac saturation) (realToFrac value) >>= pop colorTint :: Color -> Color -> Color colorTint color tint = unsafePerformIO $ withFreeable color (withFreeable tint . c'colorTint) >>= pop colorBrightness :: Color -> Float -> Color colorBrightness color brightness = unsafePerformIO $ withFreeable color (\c -> c'colorBrightness c (realToFrac brightness)) >>= pop colorContrast :: Color -> Float -> Color colorContrast color contrast = unsafePerformIO $ withFreeable color (\c -> c'colorContrast c (realToFrac contrast)) >>= pop colorAlpha :: Color -> Float -> Color colorAlpha color alpha = unsafePerformIO $ withFreeable color (\c -> c'colorAlpha c (realToFrac alpha)) >>= pop colorAlphaBlend :: Color -> Color -> Color -> Color colorAlphaBlend dst src tint = unsafePerformIO $ withFreeable dst (\d -> withFreeable src (withFreeable tint . c'colorAlphaBlend d)) >>= pop getColor :: Integer -> Color getColor hexValue = unsafePerformIO $ c'getColor (fromIntegral hexValue) >>= pop getPixelColor :: Ptr () -> PixelFormat -> IO Color getPixelColor srcPtr format = c'getPixelColor srcPtr (fromIntegral $ fromEnum format) >>= pop setPixelColor :: Ptr () -> Color -> PixelFormat -> IO () setPixelColor dstPtr color format = withFreeable color (\c -> c'setPixelColor dstPtr c (fromIntegral $ fromEnum format))