{-# 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 :: String -> IO Image
loadImage String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Image)
c'loadImage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadImageRaw :: String -> Int -> Int -> Int -> Int -> IO Image
loadImageRaw :: String -> Int -> Int -> Int -> Int -> IO Image
loadImageRaw String
fileName Int
width Int
height Int
format Int
headerSize =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (\CString
str -> CString -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Image)
c'loadImageRaw CString
str (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Int
format) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
headerSize)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Returns the animation and the number of frames in a tuple

loadImageAnim :: String -> IO (Image, Int)
loadImageAnim :: String -> IO (Image, Int)
loadImageAnim String
fileName =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    CInt
0
    ( \Ptr CInt
frames ->
        forall a. String -> (CString -> IO a) -> IO a
withCString
          String
fileName
          ( \CString
fn -> do
              Image
img <- CString -> Ptr CInt -> IO (Ptr Image)
c'loadImageAnim CString
fn Ptr CInt
frames forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
              Int
frameNum <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
frames
              forall (m :: * -> *) a. Monad m => a -> m a
return (Image
img, Int
frameNum)
          )
    )

loadImageFromMemory :: String -> [Integer] -> IO Image
loadImageFromMemory :: String -> [Integer] -> IO Image
loadImageFromMemory String
fileType [Integer]
fileData =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
ft -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
fd -> CString -> Ptr CUChar -> CInt -> IO (Ptr Image)
c'loadImageFromMemory CString
ft Ptr CUChar
fd (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
size forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadImageFromTexture :: Texture -> IO Image
loadImageFromTexture :: Texture -> IO Image
loadImageFromTexture Texture
tex = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
tex Ptr Texture -> IO (Ptr Image)
c'loadImageFromTexture forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadImageFromScreen :: IO Image
loadImageFromScreen :: IO Image
loadImageFromScreen = IO (Ptr Image)
c'loadImageFromScreen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

isImageReady :: Image -> IO Bool
isImageReady :: Image -> IO Bool
isImageReady Image
image = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image Ptr Image -> IO CBool
c'isImageReady

exportImage :: Image -> String -> IO Bool
exportImage :: Image -> String -> IO Bool
exportImage Image
image String
fileName = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> CString -> IO CBool
c'exportImage)

exportImageAsCode :: Image -> String -> IO Bool
exportImageAsCode :: Image -> String -> IO Bool
exportImageAsCode Image
image String
fileName =
  forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> CString -> IO CBool
c'exportImageAsCode)

genImageColor :: Int -> Int -> Color -> IO Image
genImageColor :: Int -> Int -> Color -> IO Image
genImageColor Int
width Int
height Color
color =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> Ptr Color -> IO (Ptr Image)
c'genImageColor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageGradientV :: Int -> Int -> Color -> Color -> IO Image
genImageGradientV :: Int -> Int -> Color -> Color -> IO Image
genImageGradientV Int
width Int
height Color
top Color
bottom =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
top (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
bottom forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> Ptr Color -> Ptr Color -> IO (Ptr Image)
c'genImageGradientV (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageGradientH :: Int -> Int -> Color -> Color -> IO Image
genImageGradientH :: Int -> Int -> Color -> Color -> IO Image
genImageGradientH Int
width Int
height Color
left Color
right =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
left (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
right forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> Ptr Color -> Ptr Color -> IO (Ptr Image)
c'genImageGradientH (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageGradientRadial :: Int -> Int -> Float -> Color -> Color -> IO Image
genImageGradientRadial :: Int -> Int -> Float -> Color -> Color -> IO Image
genImageGradientRadial Int
width Int
height Float
density Color
inner Color
outer =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
inner (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
outer forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CFloat -> Ptr Color -> Ptr Color -> IO (Ptr Image)
c'genImageGradientRadial (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
density)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageChecked :: Int -> Int -> Int -> Int -> Color -> Color -> IO Image
genImageChecked :: Int -> Int -> Int -> Int -> Color -> Color -> IO Image
genImageChecked Int
width Int
height Int
checksX Int
checksY Color
col1 Color
col2 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col1 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt
-> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO (Ptr Image)
c'genImageChecked (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
checksX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
checksY)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageWhiteNoise :: Int -> Int -> Float -> IO Image
genImageWhiteNoise :: Int -> Int -> Float -> IO Image
genImageWhiteNoise Int
width Int
height Float
factor =
  CInt -> CInt -> CFloat -> IO (Ptr Image)
c'genImageWhiteNoise (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factor) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImagePerlinNoise :: Int -> Int -> Int -> Int -> Float -> IO Image
genImagePerlinNoise :: Int -> Int -> Int -> Int -> Float -> IO Image
genImagePerlinNoise Int
width Int
height Int
offsetX Int
offsetY Float
scale = CInt -> CInt -> CInt -> CInt -> CFloat -> IO (Ptr Image)
c'genImagePerlinNoise (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageCellular :: Int -> Int -> Int -> IO Image
genImageCellular :: Int -> Int -> Int -> IO Image
genImageCellular Int
width Int
height Int
tileSize =
  CInt -> CInt -> CInt -> IO (Ptr Image)
c'genImageCellular (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tileSize) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageText :: Int -> Int -> String -> IO Image
genImageText :: Int -> Int -> String -> IO Image
genImageText Int
width Int
height String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
text (CInt -> CInt -> CString -> IO (Ptr Image)
c'genImageText (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageCopy :: Image -> IO Image
imageCopy :: Image -> IO Image
imageCopy Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image Ptr Image -> IO (Ptr Image)
c'imageCopy forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageFromImage :: Image -> Rectangle -> IO Image
imageFromImage :: Image -> Rectangle -> IO Image
imageFromImage Image
image Rectangle
rect = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Rectangle -> IO (Ptr Image)
c'imageFromImage) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageText :: String -> Int -> Color -> IO Image
imageText :: String -> Int -> Color -> IO Image
imageText String
text Int
fontSize Color
color =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ CString -> CInt -> Ptr Color -> IO (Ptr Image)
c'imageText CString
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageTextEx :: Font -> String -> Float -> Float -> Color -> IO Image
imageTextEx :: Font -> String -> Float -> Float -> Color -> IO Image
imageTextEx Font
font String
text Float
fontSize Float
spacing Color
tint =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall a b. (a -> b) -> a -> b
$ Ptr Font
-> CString -> CFloat -> CFloat -> Ptr Color -> IO (Ptr Image)
c'imageTextEx Ptr Font
f CString
t (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageFormat :: Image -> PixelFormat -> IO Image
imageFormat :: Image -> PixelFormat -> IO Image
imageFormat Image
image PixelFormat
newFormat =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> IO ()
c'imageFormat Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum PixelFormat
newFormat) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageToPOT :: Image -> Color -> IO Image
imageToPOT :: Image -> Color -> IO Image
imageToPOT Image
image Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Color -> IO ()
c'imageToPOT Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageCrop :: Image -> Rectangle -> IO Image
imageCrop :: Image -> Rectangle -> IO Image
imageCrop Image
image Rectangle
crop = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
crop (Ptr Image -> Ptr Rectangle -> IO ()
c'imageCrop Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageAlphaCrop :: Image -> Float -> IO Image
imageAlphaCrop :: Image -> Float -> IO Image
imageAlphaCrop Image
image Float
threshold = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CFloat -> IO ()
c'imageAlphaCrop Ptr Image
i (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
threshold) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageAlphaClear :: Image -> Color -> Float -> IO Image
imageAlphaClear :: Image -> Color -> Float -> IO Image
imageAlphaClear Image
image Color
color Float
threshold = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr Image -> Ptr Color -> CFloat -> IO ()
c'imageAlphaClear Ptr Image
i Ptr Color
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
threshold) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i))

imageAlphaMask :: Image -> Image -> IO Image
imageAlphaMask :: Image -> Image -> IO Image
imageAlphaMask Image
image Image
alphaMask = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
alphaMask (Ptr Image -> Ptr Image -> IO ()
c'imageAlphaMask Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageAlphaPremultiply :: Image -> IO Image
imageAlphaPremultiply :: Image -> IO Image
imageAlphaPremultiply Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageAlphaPremultiply Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageBlurGaussian :: Image -> Int -> IO Image
imageBlurGaussian :: Image -> Int -> IO Image
imageBlurGaussian Image
image Int
blurSize = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> IO ()
c'imageBlurGaussian Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blurSize) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageResize :: Image -> Int -> Int -> IO Image
imageResize :: Image -> Int -> Int -> IO Image
imageResize Image
image Int
newWidth Int
newHeight = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> CInt -> IO ()
c'imageResize Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newWidth) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newHeight) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageResizeNN :: Image -> Int -> Int -> IO Image
imageResizeNN :: Image -> Int -> Int -> IO Image
imageResizeNN Image
image Int
newWidth Int
newHeight = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> CInt -> IO ()
c'imageResizeNN Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newWidth) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newHeight) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageResizeCanvas :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageResizeCanvas :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageResizeCanvas Image
image Int
newWidth Int
newHeight Int
offsetX Int
offsetY Color
fill = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
fill (Ptr Image -> CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageResizeCanvas Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newWidth) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newHeight) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageMipmaps :: Image -> IO Image
imageMipmaps :: Image -> IO Image
imageMipmaps Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageMipmaps Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDither :: Image -> Int -> Int -> Int -> Int -> IO Image
imageDither :: Image -> Int -> Int -> Int -> Int -> IO Image
imageDither Image
image Int
rBpp Int
gBpp Int
bBpp Int
aBpp = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> CInt -> CInt -> CInt -> IO ()
c'imageDither Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rBpp) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gBpp) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bBpp) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aBpp) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageFlipVertical :: Image -> IO Image
imageFlipVertical :: Image -> IO Image
imageFlipVertical Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageFlipVertical Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageFlipHorizontal :: Image -> IO Image
imageFlipHorizontal :: Image -> IO Image
imageFlipHorizontal Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageFlipHorizontal Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageRotateCW :: Image -> IO Image
imageRotateCW :: Image -> IO Image
imageRotateCW Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageRotateCW Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageRotateCCW :: Image -> IO Image
imageRotateCCW :: Image -> IO Image
imageRotateCCW Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageRotateCCW Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorTint :: Image -> Color -> IO Image
imageColorTint :: Image -> Color -> IO Image
imageColorTint Image
image Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Color -> IO ()
c'imageColorTint Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorInvert :: Image -> IO Image
imageColorInvert :: Image -> IO Image
imageColorInvert Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageColorInvert Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorGrayscale :: Image -> IO Image
imageColorGrayscale :: Image -> IO Image
imageColorGrayscale Image
image = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> IO ()
c'imageColorGrayscale Ptr Image
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorContrast :: Image -> Float -> IO Image
imageColorContrast :: Image -> Float -> IO Image
imageColorContrast Image
image Float
contrast = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CFloat -> IO ()
c'imageColorContrast Ptr Image
i (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
contrast) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorBrightness :: Image -> Int -> IO Image
imageColorBrightness :: Image -> Int -> IO Image
imageColorBrightness Image
image Int
brightness = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> IO ()
c'imageColorBrightness Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
brightness) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageColorReplace :: Image -> Color -> Color -> IO Image
imageColorReplace :: Image -> Color -> Color -> IO Image
imageColorReplace Image
image Color
color Color
replace = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
replace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Color -> Ptr Color -> IO ()
c'imageColorReplace Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

loadImageColors :: Image -> IO [Color]
loadImageColors :: Image -> IO [Color]
loadImageColors Image
image =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Image
image
    (forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Image -> Int
image'width Image
image forall a. Num a => a -> a -> a
* Image -> Int
image'height Image
image) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr Image -> IO (Ptr Color)
c'loadImageColors)

loadImagePalette :: Image -> Int -> IO [Color]
loadImagePalette :: Image -> Int -> IO [Color]
loadImagePalette Image
image Int
maxPaletteSize =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Image
image
    ( \Ptr Image
i -> do
        (Ptr Color
palette, CInt
num) <-
          forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
            CInt
0
            ( \Ptr CInt
size -> do
                Ptr Color
cols <- Ptr Image -> CInt -> Ptr CInt -> IO (Ptr Color)
c'loadImagePalette Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPaletteSize) Ptr CInt
size
                CInt
s <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
size
                forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Color
cols, CInt
s)
            )
        forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr Color
palette
    )

getImageAlphaBorder :: Image -> Float -> IO Rectangle
getImageAlphaBorder :: Image -> Float -> IO Rectangle
getImageAlphaBorder Image
image Float
threshold = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CFloat -> IO (Ptr Rectangle)
c'getImageAlphaBorder Ptr Image
i (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
threshold)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getImageColor :: Image -> Int -> Int -> IO Color
getImageColor :: Image -> Int -> Int -> IO Color
getImageColor Image
image Int
x Int
y = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> CInt -> IO (Ptr Color)
c'getImageColor Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

imageClearBackground :: Image -> Color -> IO Image
imageClearBackground :: Image -> Color -> IO Image
imageClearBackground Image
image Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Color -> IO ()
c'imageClearBackground Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawPixel :: Image -> Int -> Int -> Color -> IO Image
imageDrawPixel :: Image -> Int -> Int -> Color -> IO Image
imageDrawPixel Image
image Int
x Int
y Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawPixel Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawPixelV :: Image -> Vector2 -> Color -> IO Image
imageDrawPixelV :: Image -> Vector2 -> Color -> IO Image
imageDrawPixelV Image
image Vector2
position Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector2 -> Ptr Color -> IO ()
c'imageDrawPixelV Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawLine :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageDrawLine :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageDrawLine Image
image Int
startPosX Int
startPosY Int
endPosX Int
endPosY Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawLine Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startPosX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startPosY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endPosX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endPosY)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawLineV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawLineV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawLineV Image
image Vector2
start Vector2
end Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'imageDrawLineV Ptr Image
i Ptr Vector2
s)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawCircle :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircle :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircle Image
image Int
centerX Int
centerY Int
radius Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawCircle Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawCircleV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleV Image
image Vector2
center Int
radius Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'imageDrawCircleV Ptr Image
i Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawCircleLines :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircleLines :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircleLines Image
image Int
centerX Int
centerY Int
radius Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawCircleLines Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawCircleLinesV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleLinesV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleLinesV Image
image Vector2
center Int
radius Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'imageDrawCircleLinesV Ptr Image
i Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawRectangle :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageDrawRectangle :: Image -> Int -> Int -> Int -> Int -> Color -> IO Image
imageDrawRectangle Image
image Int
posX Int
posY Int
width Int
height Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawRectangle Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawRectangleV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawRectangleV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawRectangleV Image
image Vector2
position Vector2
size Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'imageDrawRectangleV Ptr Image
i Ptr Vector2
p)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawRectangleRec :: Image -> Rectangle -> Color -> IO Image
imageDrawRectangleRec :: Image -> Rectangle -> Color -> IO Image
imageDrawRectangleRec Image
image Rectangle
rectangle Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rectangle (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Rectangle -> Ptr Color -> IO ()
c'imageDrawRectangleRec Ptr Image
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawRectangleLines :: Image -> Rectangle -> Int -> Color -> IO Image
imageDrawRectangleLines :: Image -> Rectangle -> Int -> Color -> IO Image
imageDrawRectangleLines Image
image Rectangle
rectangle Int
thickness Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rectangle (\Ptr Rectangle
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> Ptr Rectangle -> CInt -> Ptr Color -> IO ()
c'imageDrawRectangleLines Ptr Image
i Ptr Rectangle
r (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
thickness))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDraw :: Image -> Image -> Rectangle -> Rectangle -> Color -> IO Image
imageDraw :: Image -> Image -> Rectangle -> Rectangle -> Color -> IO Image
imageDraw Image
image Image
source Rectangle
srcRec Rectangle
dstRec Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
source (\Ptr Image
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
srcRec (\Ptr Rectangle
sr -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
dstRec (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image
-> Ptr Image
-> Ptr Rectangle
-> Ptr Rectangle
-> Ptr Color
-> IO ()
c'imageDraw Ptr Image
i Ptr Image
s Ptr Rectangle
sr))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawText :: Image -> String -> Int -> Int -> Int -> Color -> IO Image
imageDrawText :: Image -> String -> Int -> Int -> Int -> Color -> IO Image
imageDrawText Image
image String
text Int
x Int
y Int
fontSize Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Image -> CString -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'imageDrawText Ptr Image
i CString
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

imageDrawTextEx :: Image -> Font -> String -> Vector2 -> Float -> Float -> Color -> IO Image
imageDrawTextEx :: Image
-> Font -> String -> Vector2 -> Float -> Float -> Color -> IO Image
imageDrawTextEx Image
image Font
font String
text Vector2
position Float
fontSize Float
spacing Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Image
-> Ptr Font
-> CString
-> Ptr Vector2
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'imageDrawTextEx Ptr Image
i Ptr Font
f CString
t Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing))))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Image
i)

loadTexture :: String -> WindowResources -> IO Texture
loadTexture :: String -> WindowResources -> IO Texture
loadTexture String
fileName WindowResources
wr = do
  Texture
texture <- forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Texture)
c'loadTexture forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id Texture
texture) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Texture
texture

loadTextureFromImage :: Image -> WindowResources -> IO Texture
loadTextureFromImage :: Image -> WindowResources -> IO Texture
loadTextureFromImage Image
image WindowResources
wr = do
  Texture
texture <- forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image Ptr Image -> IO (Ptr Texture)
c'loadTextureFromImage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id Texture
texture) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Texture
texture

loadTextureCubemap :: Image -> CubemapLayout -> WindowResources -> IO Texture
loadTextureCubemap :: Image -> CubemapLayout -> WindowResources -> IO Texture
loadTextureCubemap Image
image CubemapLayout
layout WindowResources
wr = do
  Texture
texture <- forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> Ptr Image -> CInt -> IO (Ptr Texture)
c'loadTextureCubemap Ptr Image
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum CubemapLayout
layout)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id Texture
texture) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Texture
texture

loadRenderTexture :: Int -> Int -> WindowResources -> IO RenderTexture
loadRenderTexture :: Int -> Int -> WindowResources -> IO RenderTexture
loadRenderTexture Int
width Int
height WindowResources
wr = do
  RenderTexture
renderTexture <- CInt -> CInt -> IO (Ptr RenderTexture)
c'loadRenderTexture (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addFrameBuffer (RenderTexture -> Integer
renderTexture'id RenderTexture
renderTexture) WindowResources
wr
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ RenderTexture -> Texture
renderTexture'texture RenderTexture
renderTexture) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return RenderTexture
renderTexture

isTextureReady :: Texture -> IO Bool
isTextureReady :: Texture -> IO Bool
isTextureReady Texture
texture = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture Ptr Texture -> IO CBool
c'isTextureReady

isRenderTextureReady :: RenderTexture -> IO Bool
isRenderTextureReady :: RenderTexture -> IO Bool
isRenderTextureReady RenderTexture
renderTexture = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable RenderTexture
renderTexture Ptr RenderTexture -> IO CBool
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 -> WindowResources -> IO ()
unloadTexture Texture
texture = forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture (Texture -> Integer
texture'id Texture
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 -> WindowResources -> IO ()
unloadRenderTexture RenderTexture
renderTexture WindowResources
wr = do
  forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ RenderTexture -> Texture
renderTexture'texture RenderTexture
renderTexture) WindowResources
wr
  forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleFrameBuffer (RenderTexture -> Integer
renderTexture'id RenderTexture
renderTexture) WindowResources
wr

updateTexture :: Texture -> Ptr () -> IO Texture
updateTexture :: Texture -> Ptr () -> IO Texture
updateTexture Texture
texture Ptr ()
pixels = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Ptr Texture -> Ptr () -> IO ()
c'updateTexture Ptr Texture
t Ptr ()
pixels forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Texture
t)

updateTextureRec :: Texture -> Rectangle -> Ptr () -> IO Texture
updateTextureRec :: Texture -> Rectangle -> Ptr () -> IO Texture
updateTextureRec Texture
texture Rectangle
rect Ptr ()
pixels = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> Ptr Texture -> Ptr Rectangle -> Ptr () -> IO ()
c'updateTextureRec Ptr Texture
t Ptr Rectangle
r Ptr ()
pixels) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Texture
t)

genTextureMipmaps :: Texture -> IO Texture
genTextureMipmaps :: Texture -> IO Texture
genTextureMipmaps Texture
texture = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Ptr Texture -> IO ()
c'genTextureMipmaps Ptr Texture
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Texture
t)

setTextureFilter :: Texture -> TextureFilter -> IO Texture
setTextureFilter :: Texture -> TextureFilter -> IO Texture
setTextureFilter Texture
texture TextureFilter
filterType = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Ptr Texture -> CInt -> IO ()
c'setTextureFilter Ptr Texture
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum TextureFilter
filterType) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Texture
t)

setTextureWrap :: Texture -> TextureWrap -> IO Texture
setTextureWrap :: Texture -> TextureWrap -> IO Texture
setTextureWrap Texture
texture TextureWrap
wrap = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Ptr Texture -> CInt -> IO ()
c'setTextureWrap Ptr Texture
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum TextureWrap
wrap) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Texture
t)

drawTexture :: Texture -> Int -> Int -> Color -> IO ()
drawTexture :: Texture -> Int -> Int -> Color -> IO ()
drawTexture Texture
texture Int
x Int
y Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Texture -> CInt -> CInt -> Ptr Color -> IO ()
c'drawTexture Ptr Texture
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)))

drawTextureV :: Texture -> Vector2 -> Color -> IO ()
drawTextureV :: Texture -> Vector2 -> Color -> IO ()
drawTextureV Texture
texture Vector2
position Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Texture -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTextureV Ptr Texture
t))

drawTextureEx :: Texture -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextureEx :: Texture -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextureEx Texture
texture Vector2
position Float
rotation Float
scale Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Texture
-> Ptr Vector2 -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawTextureEx Ptr Texture
t Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale))))

drawTextureRec :: Texture -> Rectangle -> Vector2 -> Color -> IO ()
drawTextureRec :: Texture -> Rectangle -> Vector2 -> Color -> IO ()
drawTextureRec Texture
texture Rectangle
source Vector2
position Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Texture -> Ptr Rectangle -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTextureRec Ptr Texture
t Ptr Rectangle
s)))

drawTexturePro :: Texture -> Rectangle -> Rectangle -> Vector2 -> Float -> Color -> IO ()
drawTexturePro :: Texture
-> Rectangle -> Rectangle -> Vector2 -> Float -> Color -> IO ()
drawTexturePro Texture
texture Rectangle
source Rectangle
dest Vector2
origin Float
rotation Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
dest (\Ptr Rectangle
d -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Texture
-> Ptr Rectangle
-> Ptr Rectangle
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawTexturePro Ptr Texture
t Ptr Rectangle
s Ptr Rectangle
d Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))))))

drawTextureNPatch :: Texture -> NPatchInfo -> Rectangle -> Vector2 -> Float -> Color -> IO ()
drawTextureNPatch :: Texture
-> NPatchInfo -> Rectangle -> Vector2 -> Float -> Color -> IO ()
drawTextureNPatch Texture
texture NPatchInfo
nPatchInfo Rectangle
dest Vector2
origin Float
rotation Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable NPatchInfo
nPatchInfo (\Ptr NPatchInfo
n -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
dest (\Ptr Rectangle
d -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Texture
-> Ptr NPatchInfo
-> Ptr Rectangle
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawTextureNPatch Ptr Texture
t Ptr NPatchInfo
n Ptr Rectangle
d Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))))))

fade :: Color -> Float -> Color
fade :: Color -> Float -> Color
fade Color
color Float
alpha = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr Color -> CFloat -> IO (Ptr Color)
c'fade Ptr Color
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorToInt :: Color -> Int
colorToInt :: Color -> Int
colorToInt Color
color = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color Ptr Color -> IO CInt
c'colorToInt

colorNormalize :: Color -> Vector4
colorNormalize :: Color -> Vector4
colorNormalize Color
color = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color Ptr Color -> IO (Ptr Vector4)
c'colorNormalize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorFromNormalized :: Vector4 -> Color
colorFromNormalized :: Vector4 -> Color
colorFromNormalized Vector4
normalized = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector4
normalized Ptr Vector4 -> IO (Ptr Color)
c'colorFromNormalized forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorToHSV :: Color -> Vector3
colorToHSV :: Color -> Vector3
colorToHSV Color
color = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color Ptr Color -> IO (Ptr Vector3)
c'colorToHSV forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorFromHSV :: Float -> Float -> Float -> Color
colorFromHSV :: Float -> Float -> Float -> Color
colorFromHSV Float
hue Float
saturation Float
value = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ CFloat -> CFloat -> CFloat -> IO (Ptr Color)
c'colorFromHSV (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hue) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
saturation) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorTint :: Color -> Color -> Color
colorTint :: Color -> Color -> Color
colorTint Color
color Color
tint = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Color -> Ptr Color -> IO (Ptr Color)
c'colorTint) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorBrightness :: Color -> Float -> Color
colorBrightness :: Color -> Float -> Color
colorBrightness Color
color Float
brightness = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr Color -> CFloat -> IO (Ptr Color)
c'colorBrightness Ptr Color
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
brightness)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorContrast :: Color -> Float -> Color
colorContrast :: Color -> Float -> Color
colorContrast Color
color Float
contrast = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr Color -> CFloat -> IO (Ptr Color)
c'colorContrast Ptr Color
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
contrast)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorAlpha :: Color -> Float -> Color
colorAlpha :: Color -> Float -> Color
colorAlpha Color
color Float
alpha = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr Color -> CFloat -> IO (Ptr Color)
c'colorAlpha Ptr Color
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

colorAlphaBlend :: Color -> Color -> Color -> Color
colorAlphaBlend :: Color -> Color -> Color -> Color
colorAlphaBlend Color
dst Color
src Color
tint = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
dst (\Ptr Color
d -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
src (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Color -> Ptr Color -> Ptr Color -> IO (Ptr Color)
c'colorAlphaBlend Ptr Color
d)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getColor :: Integer -> Color
getColor :: Integer -> Color
getColor Integer
hexValue = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ CUInt -> IO (Ptr Color)
c'getColor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
hexValue) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getPixelColor :: Ptr () -> PixelFormat -> IO Color
getPixelColor :: Ptr () -> PixelFormat -> IO Color
getPixelColor Ptr ()
srcPtr PixelFormat
format = Ptr () -> CInt -> IO (Ptr Color)
c'getPixelColor Ptr ()
srcPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum PixelFormat
format) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

setPixelColor :: Ptr () -> Color -> PixelFormat -> IO ()
setPixelColor :: Ptr () -> Color -> PixelFormat -> IO ()
setPixelColor Ptr ()
dstPtr Color
color PixelFormat
format = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Ptr () -> Ptr Color -> CInt -> IO ()
c'setPixelColor Ptr ()
dstPtr Ptr Color
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum PixelFormat
format))