{-# LANGUAGE ForeignFunctionInterface #-}

{-# OPTIONS -Wall #-}

module Raylib where

-- Haskell bindings to raylib


import Data.List (genericLength)
import Foreign
  ( FunPtr,
    Ptr,
    Storable (peek, sizeOf),
    castPtr,
    fromBool,
    peekArray,
    toBool,
    with,
    withArray,
    withArrayLen,
  )
import Foreign.C
  ( CBool (..),
    CChar (..),
    CDouble (..),
    CFloat (..),
    CInt (..),
    CLong (..),
    CString,
    CUChar,
    CUInt (..),
    peekCString,
    withCString,
  )
import GHC.IO (unsafePerformIO)
import Raylib.Types
  ( AudioStream,
    BoundingBox,
    Camera2D,
    Camera3D,
    Color,
    FilePathList,
    Font,
    GlyphInfo,
    Image (image'height, image'width),
    Material,
    Matrix,
    Mesh,
    Model,
    ModelAnimation,
    Music,
    NPatchInfo,
    Ray,
    RayCollision,
    Rectangle,
    RenderTexture,
    Shader,
    Sound,
    Texture,
    Vector2 (Vector2),
    Vector3,
    Vector4,
    VrDeviceInfo,
    VrStereoConfig,
    Wave (wave'channels, wave'frameCount),
    MouseButton,
    MouseCursor,
    TraceLogLevel,
    CameraMode,
    Gesture,
    BlendMode,
    CubemapLayout,
    FontType,
    TextureWrap,
    TextureFilter,
    ConfigFlag,
    KeyboardKey,
    GamepadButton,
    GamepadAxis,
    ShaderLocationIndex,
    ShaderUniformDataType,
    PixelFormat
  )
import Raylib.Util (pop, withArray2D, configsToBitflag)
import Prelude hiding (length)

-- Haskell doesn't support varargs in foreign calls, so these functions are impossible to call from FFI

-- type TraceLogCallback = FunPtr (CInt -> CString -> __builtin_va_list -> IO ())

-- foreign import ccall safe "wrapper"

--   mk'TraceLogCallback ::

--     (CInt -> CString -> __builtin_va_list -> IO ()) -> IO TraceLogCallback

-- foreign import ccall safe "dynamic"

--   mK'TraceLogCallback ::

--     TraceLogCallback -> (CInt -> CString -> __builtin_va_list -> IO ())

type LoadFileDataCallback = FunPtr (CString -> Ptr CUInt -> IO (Ptr CUChar))

foreign import ccall safe "wrapper"
  mk'loadFileDataCallback ::
    (CString -> Ptr CUInt -> IO (Ptr CUChar)) -> IO LoadFileDataCallback

foreign import ccall safe "dynamic"
  mK'loadFileDataCallback ::
    LoadFileDataCallback -> (CString -> Ptr CUInt -> IO (Ptr CUChar))

type SaveFileDataCallback = FunPtr (CString -> Ptr () -> CUInt -> IO CInt)

foreign import ccall safe "wrapper"
  mk'saveFileDataCallback ::
    (CString -> Ptr () -> CUInt -> IO CInt) -> IO SaveFileDataCallback

foreign import ccall safe "dynamic"
  mK'saveFileDataCallback ::
    SaveFileDataCallback -> (CString -> Ptr () -> CUInt -> IO CInt)

type LoadFileTextCallback = FunPtr (CString -> IO CString)

foreign import ccall safe "wrapper"
  mk'loadFileTextCallback ::
    (CString -> IO CString) -> IO LoadFileTextCallback

foreign import ccall safe "dynamic"
  mK'loadFileTextCallback ::
    LoadFileTextCallback -> (CString -> IO CString)

type SaveFileTextCallback = FunPtr (CString -> CString -> IO CInt)

foreign import ccall safe "wrapper"
  mk'saveFileTextCallback ::
    (CString -> CString -> IO CInt) -> IO SaveFileTextCallback

foreign import ccall safe "dynamic"
  mK'saveFileTextCallback ::
    SaveFileTextCallback -> (CString -> CString -> IO CInt)

foreign import ccall safe "raylib.h InitWindow"
  c'initWindow ::
    CInt -> CInt -> CString -> IO ()

initWindow :: Int -> Int -> String -> IO ()
initWindow :: Int -> Int -> String -> IO ()
initWindow Int
width Int
height String
title = forall a. String -> (CString -> IO a) -> IO a
withCString String
title forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CString -> IO ()
c'initWindow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

foreign import ccall safe "raylib.h &InitWindow"
  p'initWindow ::
    FunPtr (CInt -> CInt -> CString -> IO ())

foreign import ccall safe "raylib.h WindowShouldClose"
  c'windowShouldClose ::
    IO CBool

windowShouldClose :: IO Bool
windowShouldClose :: IO Bool
windowShouldClose = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'windowShouldClose

foreign import ccall safe "raylib.h &WindowShouldClose"
  p'windowShouldClose ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h CloseWindow"
  closeWindow ::
    IO ()

foreign import ccall safe "raylib.h &CloseWindow"
  p'closeWindow ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h IsWindowReady"
  c'isWindowReady ::
    IO CBool

isWindowReady :: IO Bool
isWindowReady :: IO Bool
isWindowReady = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowReady

foreign import ccall safe "raylib.h &IsWindowReady"
  p'isWindowReady ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowFullscreen"
  c'isWindowFullscreen ::
    IO CBool

isWindowFullscreen :: IO Bool
isWindowFullscreen :: IO Bool
isWindowFullscreen = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowFullscreen

foreign import ccall safe "raylib.h &IsWindowFullscreen"
  p'isWindowFullscreen ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowHidden"
  c'isWindowHidden ::
    IO CBool

isWindowHidden :: IO Bool
isWindowHidden :: IO Bool
isWindowHidden = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowHidden

foreign import ccall safe "raylib.h &IsWindowHidden"
  p'isWindowHidden ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowMinimized"
  c'isWindowMinimized ::
    IO CBool

isWindowMinimized :: IO Bool
isWindowMinimized :: IO Bool
isWindowMinimized = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowMinimized

foreign import ccall safe "raylib.h &IsWindowMinimized"
  p'isWindowMinimized ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowMaximized"
  c'isWindowMaximized ::
    IO CBool

isWindowMaximized :: IO Bool
isWindowMaximized :: IO Bool
isWindowMaximized = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowMaximized

foreign import ccall safe "raylib.h &IsWindowMaximized"
  p'isWindowMaximized ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowFocused"
  c'isWindowFocused ::
    IO CBool

isWindowFocused :: IO Bool
isWindowFocused :: IO Bool
isWindowFocused = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowFocused

foreign import ccall safe "raylib.h &IsWindowFocused"
  p'isWindowFocused ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowResized"
  c'isWindowResized ::
    IO CBool

isWindowResized :: IO Bool
isWindowResized :: IO Bool
isWindowResized = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isWindowResized

foreign import ccall safe "raylib.h &IsWindowResized"
  p'isWindowResized ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsWindowState"
  c'isWindowState ::
    CUInt -> IO CBool

isWindowState :: [ConfigFlag] -> IO Bool
isWindowState :: [ConfigFlag] -> IO Bool
isWindowState [ConfigFlag]
flags = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> IO CBool
c'isWindowState (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ [ConfigFlag] -> Integer
configsToBitflag [ConfigFlag]
flags)

foreign import ccall safe "raylib.h &IsWindowState"
  p'isWindowState ::
    FunPtr (CUInt -> IO CInt)

foreign import ccall safe "raylib.h SetWindowState"
  c'setWindowState ::
    CUInt -> IO ()

setWindowState :: [ConfigFlag] -> IO ()
setWindowState :: [ConfigFlag] -> IO ()
setWindowState = CUInt -> IO ()
c'setWindowState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConfigFlag] -> Integer
configsToBitflag

foreign import ccall safe "raylib.h &SetWindowState"
  p'setWindowState ::
    FunPtr (CUInt -> IO ())

foreign import ccall safe "raylib.h ClearWindowState"
  c'clearWindowState ::
    CUInt -> IO ()

clearWindowState :: [ConfigFlag] -> IO ()
clearWindowState :: [ConfigFlag] -> IO ()
clearWindowState = CUInt -> IO ()
c'clearWindowState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConfigFlag] -> Integer
configsToBitflag

foreign import ccall safe "raylib.h &ClearWindowState"
  p'clearWindowState ::
    FunPtr (CUInt -> IO ())

foreign import ccall safe "raylib.h ToggleFullscreen"
  toggleFullscreen ::
    IO ()

foreign import ccall safe "raylib.h &ToggleFullscreen"
  p'toggleFullscreen ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h MaximizeWindow"
  maximizeWindow ::
    IO ()

foreign import ccall safe "raylib.h &MaximizeWindow"
  p'maximizeWindow ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h MinimizeWindow"
  minimizeWindow ::
    IO ()

foreign import ccall safe "raylib.h &MinimizeWindow"
  p'minimizeWindow ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h RestoreWindow"
  restoreWindow ::
    IO ()

foreign import ccall safe "raylib.h &RestoreWindow"
  p'restoreWindow ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h SetWindowIcon_" c'setWindowIcon :: Ptr Raylib.Types.Image -> IO ()

setWindowIcon :: Raylib.Types.Image -> IO ()
setWindowIcon :: Image -> IO ()
setWindowIcon Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image Ptr Image -> IO ()
c'setWindowIcon

foreign import ccall safe "raylib.h &SetWindowIcon"
  p'setWindowIcon ::
    FunPtr (Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h SetWindowTitle"
  c'setWindowTitle ::
    CString -> IO ()

setWindowTitle :: String -> IO ()
setWindowTitle :: String -> IO ()
setWindowTitle String
title = forall a. String -> (CString -> IO a) -> IO a
withCString String
title CString -> IO ()
c'setWindowTitle

foreign import ccall safe "raylib.h &SetWindowTitle"
  p'setWindowTitle ::
    FunPtr (CString -> IO ())

foreign import ccall safe "raylib.h SetWindowPosition"
  c'setWindowPosition ::
    CInt -> CInt -> IO ()

setWindowPosition :: Int -> Int -> IO ()
setWindowPosition :: Int -> Int -> IO ()
setWindowPosition Int
x Int
y = CInt -> CInt -> IO ()
c'setWindowPosition (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &SetWindowPosition"
  p'setWindowPosition ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h SetWindowMonitor"
  c'setWindowMonitor ::
    CInt -> IO ()

setWindowMonitor :: Int -> IO ()
setWindowMonitor :: Int -> IO ()
setWindowMonitor = CInt -> IO ()
c'setWindowMonitor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

foreign import ccall safe "raylib.h &SetWindowMonitor"
  p'setWindowMonitor ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h SetWindowMinSize"
  c'setWindowMinSize ::
    CInt -> CInt -> IO ()

setWindowMinSize :: Int -> Int -> IO ()
setWindowMinSize :: Int -> Int -> IO ()
setWindowMinSize Int
x Int
y = CInt -> CInt -> IO ()
c'setWindowMinSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &SetWindowMinSize"
  p'setWindowMinSize ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h SetWindowSize"
  c'setWindowSize ::
    CInt -> CInt -> IO ()

setWindowSize :: Int -> Int -> IO ()
setWindowSize :: Int -> Int -> IO ()
setWindowSize Int
x Int
y = CInt -> CInt -> IO ()
c'setWindowSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &SetWindowSize"
  p'setWindowSize ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h SetWindowOpacity"
  c'setWindowOpacity ::
    CFloat -> IO ()

setWindowOpacity :: Float -> IO ()
setWindowOpacity :: Float -> IO ()
setWindowOpacity Float
opacity = CFloat -> IO ()
c'setWindowOpacity forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
opacity

foreign import ccall safe "raylib.h &SetWindowOpacity"
  p'setWindowOpacity ::
    FunPtr (CFloat -> IO ())

foreign import ccall safe "raylib.h GetWindowHandle"
  getWindowHandle ::
    IO (Ptr ())

foreign import ccall safe "raylib.h &GetWindowHandle"
  p'getWindowHandle ::
    FunPtr (IO (Ptr ()))

foreign import ccall safe "raylib.h GetScreenWidth"
  c'getScreenWidth ::
    IO CInt

getScreenWidth :: IO Int
getScreenWidth :: IO Int
getScreenWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getScreenWidth

foreign import ccall safe "raylib.h &GetScreenWidth"
  p'getScreenWidth ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetScreenHeight"
  c'getScreenHeight ::
    IO CInt

getScreenHeight :: IO Int
getScreenHeight :: IO Int
getScreenHeight = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getScreenHeight

foreign import ccall safe "raylib.h &GetScreenHeight"
  p'getScreenHeight ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetRenderWidth"
  c'getRenderWidth ::
    IO CInt

getRenderWidth :: IO Int
getRenderWidth :: IO Int
getRenderWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getRenderWidth

foreign import ccall safe "raylib.h &GetRenderWidth"
  p'getRenderWidth ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetRenderHeight"
  c'getRenderHeight ::
    IO CInt

getRenderHeight :: IO Int
getRenderHeight :: IO Int
getRenderHeight = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getRenderHeight

foreign import ccall safe "raylib.h &GetRenderHeight"
  p'getRenderHeight ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetMonitorCount"
  c'getMonitorCount ::
    IO CInt

getMonitorCount :: IO Int
getMonitorCount :: IO Int
getMonitorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getMonitorCount

foreign import ccall safe "raylib.h &GetMonitorCount"
  p'getMonitorCount ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetCurrentMonitor"
  c'getCurrentMonitor ::
    IO CInt

getCurrentMonitor :: IO Int
getCurrentMonitor :: IO Int
getCurrentMonitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getCurrentMonitor

foreign import ccall safe "raylib.h &GetCurrentMonitor"
  p'getCurrentMonitor ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h GetMonitorPosition_" c'getMonitorPosition :: CInt -> IO (Ptr Raylib.Types.Vector2)

getMonitorPosition :: Int -> IO Raylib.Types.Vector2
getMonitorPosition :: Int -> IO Vector2
getMonitorPosition Int
monitor = CInt -> IO (Ptr Vector2)
c'getMonitorPosition (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMonitorPosition"
  p'getMonitorPosition ::
    FunPtr (CInt -> IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h GetMonitorWidth"
  c'getMonitorWidth ::
    CInt -> IO CInt

getMonitorWidth :: Int -> IO Int
getMonitorWidth :: Int -> IO Int
getMonitorWidth Int
monitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getMonitorWidth (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor)

foreign import ccall safe "raylib.h &GetMonitorWidth"
  p'getMonitorWidth ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetMonitorHeight"
  c'getMonitorHeight ::
    CInt -> IO CInt

getMonitorHeight :: Int -> IO CInt
getMonitorHeight :: Int -> IO CInt
getMonitorHeight Int
monitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getMonitorHeight (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor)

foreign import ccall safe "raylib.h &GetMonitorHeight"
  p'getMonitorHeight ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetMonitorPhysicalWidth"
  c'getMonitorPhysicalWidth ::
    CInt -> IO CInt

getMonitorPhysicalWidth :: Int -> IO CInt
getMonitorPhysicalWidth :: Int -> IO CInt
getMonitorPhysicalWidth Int
monitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getMonitorPhysicalWidth (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor)

foreign import ccall safe "raylib.h &GetMonitorPhysicalWidth"
  p'getMonitorPhysicalWidth ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetMonitorPhysicalHeight"
  c'getMonitorPhysicalHeight ::
    CInt -> IO CInt

getMonitorPhysicalHeight :: Int -> IO Int
getMonitorPhysicalHeight :: Int -> IO Int
getMonitorPhysicalHeight Int
monitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getMonitorPhysicalHeight (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor)

foreign import ccall safe "raylib.h &GetMonitorPhysicalHeight"
  p'getMonitorPhysicalHeight ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetMonitorRefreshRate"
  c'getMonitorRefreshRate ::
    CInt -> IO CInt

getMonitorRefreshRate :: Int -> IO Int
getMonitorRefreshRate :: Int -> IO Int
getMonitorRefreshRate Int
monitor = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getMonitorRefreshRate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor)

foreign import ccall safe "raylib.h &GetMonitorRefreshRate"
  p'getMonitorRefreshRate ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "bindings.h GetWindowPosition_" c'getWindowPosition :: IO (Ptr Raylib.Types.Vector2)

getWindowPosition :: IO Raylib.Types.Vector2
getWindowPosition :: IO Vector2
getWindowPosition = IO (Ptr Vector2)
c'getWindowPosition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetWindowPosition"
  p'getWindowPosition ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetWindowScaleDPI_" c'getWindowScaleDPI :: IO (Ptr Raylib.Types.Vector2)

getWindowScaleDPI :: IO Raylib.Types.Vector2
getWindowScaleDPI :: IO Vector2
getWindowScaleDPI = IO (Ptr Vector2)
c'getWindowScaleDPI forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetWindowScaleDPI"
  p'getWindowScaleDPI ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h GetMonitorName"
  c'getMonitorName ::
    CInt -> IO CString

getMonitorName :: Int -> IO String
getMonitorName :: Int -> IO String
getMonitorName Int
monitor = CInt -> IO CString
c'getMonitorName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
monitor) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetMonitorName"
  p'getMonitorName ::
    FunPtr (CInt -> IO CString)

foreign import ccall safe "raylib.h SetClipboardText"
  c'setClipboardText ::
    CString -> IO ()

setClipboardText :: String -> IO ()
setClipboardText :: String -> IO ()
setClipboardText String
text = forall a. String -> (CString -> IO a) -> IO a
withCString String
text CString -> IO ()
c'setClipboardText

foreign import ccall safe "raylib.h &SetClipboardText"
  p'setClipboardText ::
    FunPtr (CString -> IO ())

foreign import ccall safe "raylib.h GetClipboardText"
  c'getClipboardText ::
    IO CString

getClipboardText :: IO String
getClipboardText :: IO String
getClipboardText = IO CString
c'getClipboardText forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetClipboardText"
  p'getClipboardText ::
    FunPtr (IO CString)

foreign import ccall safe "raylib.h EnableEventWaiting"
  enableEventWaiting ::
    IO ()

foreign import ccall safe "raylib.h &EnableEventWaiting"
  p'enableEventWaiting ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h DisableEventWaiting"
  disableEventWaiting ::
    IO ()

foreign import ccall safe "raylib.h &DisableEventWaiting"
  p'disableEventWaiting ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h SwapScreenBuffer"
  swapScreenBuffer ::
    IO ()

foreign import ccall safe "raylib.h &SwapScreenBuffer"
  p'swapScreenBuffer ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h PollInputEvents"
  pollInputEvents ::
    IO ()

foreign import ccall safe "raylib.h &PollInputEvents"
  p'pollInputEvents ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h WaitTime"
  c'waitTime ::
    CDouble -> IO ()

waitTime :: Double -> IO ()
waitTime :: Double -> IO ()
waitTime Double
seconds = CDouble -> IO ()
c'waitTime forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
seconds

foreign import ccall safe "raylib.h &WaitTime"
  p'waitTime ::
    FunPtr (CDouble -> IO ())

foreign import ccall safe "raylib.h ShowCursor"
  showCursor ::
    IO ()

foreign import ccall safe "raylib.h &ShowCursor"
  p'showCursor ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h HideCursor"
  hideCursor ::
    IO ()

foreign import ccall safe "raylib.h &HideCursor"
  p'hideCursor ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h IsCursorHidden"
  c'isCursorHidden ::
    IO CBool

isCursorHidden :: IO Bool
isCursorHidden :: IO Bool
isCursorHidden = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isCursorHidden

foreign import ccall safe "raylib.h &IsCursorHidden"
  p'isCursorHidden ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h EnableCursor"
  enableCursor ::
    IO ()

foreign import ccall safe "raylib.h &EnableCursor"
  p'enableCursor ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h DisableCursor"
  disableCursor ::
    IO ()

foreign import ccall safe "raylib.h &DisableCursor"
  p'disableCursor ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h IsCursorOnScreen"
  c'isCursorOnScreen ::
    IO CBool

isCursorOnScreen :: IO Bool
isCursorOnScreen :: IO Bool
isCursorOnScreen = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isCursorOnScreen

foreign import ccall safe "raylib.h &IsCursorOnScreen"
  p'isCursorOnScreen ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h ClearBackground_" c'clearBackground :: Ptr Raylib.Types.Color -> IO ()

clearBackground :: Raylib.Types.Color -> IO ()
clearBackground :: Color -> IO ()
clearBackground Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color Ptr Color -> IO ()
c'clearBackground

foreign import ccall safe "raylib.h &ClearBackground"
  p'clearBackground ::
    FunPtr (Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h BeginDrawing"
  beginDrawing ::
    IO ()

foreign import ccall safe "raylib.h &BeginDrawing"
  p'beginDrawing ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h EndDrawing"
  endDrawing ::
    IO ()

foreign import ccall safe "raylib.h &EndDrawing"
  p'endDrawing ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h BeginMode2D_" c'beginMode2D :: Ptr Raylib.Types.Camera2D -> IO ()

beginMode2D :: Raylib.Types.Camera2D -> IO ()
beginMode2D :: Camera2D -> IO ()
beginMode2D Camera2D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera2D
camera Ptr Camera2D -> IO ()
c'beginMode2D

foreign import ccall safe "raylib.h &BeginMode2D"
  p'beginMode2D ::
    FunPtr (Raylib.Types.Camera2D -> IO ())

foreign import ccall safe "raylib.h EndMode2D"
  endMode2D ::
    IO ()

foreign import ccall safe "raylib.h &EndMode2D"
  p'endMode2D ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h BeginMode3D_" c'beginMode3D :: Ptr Raylib.Types.Camera3D -> IO ()

beginMode3D :: Raylib.Types.Camera3D -> IO ()
beginMode3D :: Camera3D -> IO ()
beginMode3D Camera3D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera Ptr Camera3D -> IO ()
c'beginMode3D

foreign import ccall safe "raylib.h &BeginMode3D"
  p'beginMode3D ::
    FunPtr (Raylib.Types.Camera3D -> IO ())

foreign import ccall safe "raylib.h EndMode3D"
  endMode3D ::
    IO ()

foreign import ccall safe "raylib.h &EndMode3D"
  p'endMode3D ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h BeginTextureMode_" c'beginTextureMode :: Ptr Raylib.Types.RenderTexture -> IO ()

beginTextureMode :: Raylib.Types.RenderTexture -> IO ()
beginTextureMode :: RenderTexture -> IO ()
beginTextureMode RenderTexture
renderTexture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with RenderTexture
renderTexture Ptr RenderTexture -> IO ()
c'beginTextureMode

foreign import ccall safe "raylib.h &BeginTextureMode"
  p'beginTextureMode ::
    FunPtr (Raylib.Types.RenderTexture -> IO ())

foreign import ccall safe "raylib.h EndTextureMode"
  endTextureMode ::
    IO ()

foreign import ccall safe "raylib.h &EndTextureMode"
  p'endTextureMode ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h BeginShaderMode_" c'beginShaderMode :: Ptr Raylib.Types.Shader -> IO ()

beginShaderMode :: Raylib.Types.Shader -> IO ()
beginShaderMode :: Shader -> IO ()
beginShaderMode Shader
shader = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader Ptr Shader -> IO ()
c'beginShaderMode

foreign import ccall safe "raylib.h &BeginShaderMode"
  p'beginShaderMode ::
    FunPtr (Raylib.Types.Shader -> IO ())

foreign import ccall safe "raylib.h EndShaderMode"
  endShaderMode ::
    IO ()

foreign import ccall safe "raylib.h &EndShaderMode"
  p'endShaderMode ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h BeginBlendMode"
  c'beginBlendMode ::
    CInt -> IO ()

beginBlendMode :: BlendMode -> IO ()
beginBlendMode :: BlendMode -> IO ()
beginBlendMode = CInt -> IO ()
c'beginBlendMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "raylib.h &BeginBlendMode"
  p'beginBlendMode ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h EndBlendMode"
  endBlendMode ::
    IO ()

foreign import ccall safe "raylib.h &EndBlendMode"
  p'endBlendMode ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h BeginScissorMode"
  c'beginScissorMode ::
    CInt -> CInt -> CInt -> CInt -> IO ()

beginScissorMode :: Int -> Int -> Int -> Int -> IO ()
beginScissorMode :: Int -> Int -> Int -> Int -> IO ()
beginScissorMode Int
x Int
y Int
width Int
height = CInt -> CInt -> CInt -> CInt -> IO ()
c'beginScissorMode (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
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

foreign import ccall safe "raylib.h &BeginScissorMode"
  p'beginScissorMode ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h EndScissorMode"
  endScissorMode ::
    IO ()

foreign import ccall safe "raylib.h &EndScissorMode"
  p'endScissorMode ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h BeginVrStereoMode_" c'beginVrStereoMode :: Ptr Raylib.Types.VrStereoConfig -> IO ()

beginVrStereoMode :: Raylib.Types.VrStereoConfig -> IO ()
beginVrStereoMode :: VrStereoConfig -> IO ()
beginVrStereoMode VrStereoConfig
config = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with VrStereoConfig
config Ptr VrStereoConfig -> IO ()
c'beginVrStereoMode

foreign import ccall safe "raylib.h &BeginVrStereoMode"
  p'beginVrStereoMode ::
    FunPtr (Raylib.Types.VrStereoConfig -> IO ())

foreign import ccall safe "raylib.h EndVrStereoMode"
  endVrStereoMode ::
    IO ()

foreign import ccall safe "raylib.h &EndVrStereoMode"
  p'endVrStereoMode ::
    FunPtr (IO ())

foreign import ccall safe "bindings.h LoadVrStereoConfig_" c'loadVrStereoConfig :: Ptr Raylib.Types.VrDeviceInfo -> IO (Ptr Raylib.Types.VrStereoConfig)

loadVrStereoConfig :: Raylib.Types.VrDeviceInfo -> IO Raylib.Types.VrStereoConfig
loadVrStereoConfig :: VrDeviceInfo -> IO VrStereoConfig
loadVrStereoConfig VrDeviceInfo
deviceInfo = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with VrDeviceInfo
deviceInfo Ptr VrDeviceInfo -> IO (Ptr VrStereoConfig)
c'loadVrStereoConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadVrStereoConfig"
  p'loadVrStereoConfig ::
    FunPtr (Raylib.Types.VrDeviceInfo -> IO Raylib.Types.VrStereoConfig)

foreign import ccall safe "bindings.h UnloadVrStereoConfig_" c'unloadVrStereoConfig :: Ptr Raylib.Types.VrStereoConfig -> IO ()

unloadVrStereoConfig :: Raylib.Types.VrStereoConfig -> IO ()
unloadVrStereoConfig :: VrStereoConfig -> IO ()
unloadVrStereoConfig VrStereoConfig
config = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with VrStereoConfig
config Ptr VrStereoConfig -> IO ()
c'unloadVrStereoConfig

foreign import ccall safe "raylib.h &UnloadVrStereoConfig"
  p'unloadVrStereoConfig ::
    FunPtr (Raylib.Types.VrStereoConfig -> IO ())

foreign import ccall safe "bindings.h LoadShader_" c'loadShader :: CString -> CString -> IO (Ptr Raylib.Types.Shader)

loadShader :: String -> String -> IO Raylib.Types.Shader
loadShader :: String -> String -> IO Shader
loadShader String
vsFileName String
fsFileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
vsFileName (forall a. String -> (CString -> IO a) -> IO a
withCString String
fsFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO (Ptr Shader)
c'loadShader) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadShader"
  p'loadShader ::
    FunPtr (CString -> CString -> IO Raylib.Types.Shader)

foreign import ccall safe "bindings.h LoadShaderFromMemory_" c'loadShaderFromMemory :: CString -> CString -> IO (Ptr Raylib.Types.Shader)

loadShaderFromMemory :: String -> String -> IO Raylib.Types.Shader
loadShaderFromMemory :: String -> String -> IO Shader
loadShaderFromMemory String
vsCode String
fsCode = forall a. String -> (CString -> IO a) -> IO a
withCString String
vsCode (forall a. String -> (CString -> IO a) -> IO a
withCString String
fsCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO (Ptr Shader)
c'loadShaderFromMemory) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadShaderFromMemory"
  p'loadShaderFromMemory ::
    FunPtr (CString -> CString -> IO Raylib.Types.Shader)

foreign import ccall safe "bindings.h GetShaderLocation_" c'getShaderLocation :: Ptr Raylib.Types.Shader -> CString -> IO CInt

getShaderLocation :: Raylib.Types.Shader -> String -> IO Int
getShaderLocation :: Shader -> String -> IO Int
getShaderLocation Shader
shader String
uniformName = 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (forall a. String -> (CString -> IO a) -> IO a
withCString String
uniformName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shader -> CString -> IO CInt
c'getShaderLocation)

foreign import ccall safe "raylib.h &GetShaderLocation"
  p'getShaderLocation ::
    FunPtr (Raylib.Types.Shader -> CString -> IO CInt)

foreign import ccall safe "bindings.h GetShaderLocationAttrib_" c'getShaderLocationAttrib :: Ptr Raylib.Types.Shader -> CString -> IO CInt

getShaderLocationAttrib :: Raylib.Types.Shader -> String -> IO Int
getShaderLocationAttrib :: Shader -> String -> IO Int
getShaderLocationAttrib Shader
shader String
attribName = 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (forall a. String -> (CString -> IO a) -> IO a
withCString String
attribName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shader -> CString -> IO CInt
c'getShaderLocationAttrib)

foreign import ccall safe "raylib.h &GetShaderLocationAttrib"
  p'getShaderLocationAttrib ::
    FunPtr (Raylib.Types.Shader -> CString -> IO CInt)

foreign import ccall safe "bindings.h SetShaderValue_" c'setShaderValue :: Ptr Raylib.Types.Shader -> CInt -> Ptr () -> CInt -> IO ()

-- TODO: This `ShaderLocationIndex` might be a wrong type, this should be examined at a later date

-- This goes for the other functions below as well using it

setShaderValue :: Raylib.Types.Shader -> ShaderLocationIndex -> Ptr () -> ShaderUniformDataType -> IO ()
setShaderValue :: Shader
-> ShaderLocationIndex -> Ptr () -> ShaderUniformDataType -> IO ()
setShaderValue Shader
shader ShaderLocationIndex
locIndex Ptr ()
value ShaderUniformDataType
uniformType = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (\Ptr Shader
s -> Ptr Shader -> CInt -> Ptr () -> CInt -> IO ()
c'setShaderValue Ptr Shader
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderLocationIndex
locIndex) Ptr ()
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
uniformType))

foreign import ccall safe "raylib.h &SetShaderValue"
  p'setShaderValue ::
    FunPtr (Raylib.Types.Shader -> CInt -> Ptr () -> CInt -> IO ())

foreign import ccall safe "bindings.h SetShaderValueV_" c'setShaderValueV :: Ptr Raylib.Types.Shader -> CInt -> Ptr () -> CInt -> CInt -> IO ()

setShaderValueV :: Raylib.Types.Shader -> ShaderLocationIndex -> Ptr () -> ShaderUniformDataType -> Int -> IO ()
setShaderValueV :: Shader
-> ShaderLocationIndex
-> Ptr ()
-> ShaderUniformDataType
-> Int
-> IO ()
setShaderValueV Shader
shader ShaderLocationIndex
locIndex Ptr ()
value ShaderUniformDataType
uniformType Int
count = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (\Ptr Shader
s -> Ptr Shader -> CInt -> Ptr () -> CInt -> CInt -> IO ()
c'setShaderValueV Ptr Shader
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderLocationIndex
locIndex) Ptr ()
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
uniformType) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count))

foreign import ccall safe "raylib.h &SetShaderValueV"
  p'setShaderValueV ::
    FunPtr (Raylib.Types.Shader -> CInt -> Ptr () -> CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h SetShaderValueMatrix_" c'setShaderValueMatrix :: Ptr Raylib.Types.Shader -> CInt -> Ptr Raylib.Types.Matrix -> IO ()

setShaderValueMatrix :: Raylib.Types.Shader -> ShaderLocationIndex -> Raylib.Types.Matrix -> IO ()
setShaderValueMatrix :: Shader -> ShaderLocationIndex -> Matrix -> IO ()
setShaderValueMatrix Shader
shader ShaderLocationIndex
locIndex Matrix
mat = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (\Ptr Shader
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Matrix
mat (Ptr Shader -> CInt -> Ptr Matrix -> IO ()
c'setShaderValueMatrix Ptr Shader
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderLocationIndex
locIndex)))

foreign import ccall safe "raylib.h &SetShaderValueMatrix"
  p'setShaderValueMatrix ::
    FunPtr (Raylib.Types.Shader -> CInt -> Raylib.Types.Matrix -> IO ())

foreign import ccall safe "bindings.h SetShaderValueTexture_" c'setShaderValueTexture :: Ptr Raylib.Types.Shader -> CInt -> Ptr Raylib.Types.Texture -> IO ()

setShaderValueTexture :: Raylib.Types.Shader -> ShaderLocationIndex -> Raylib.Types.Texture -> IO ()
setShaderValueTexture :: Shader -> ShaderLocationIndex -> Texture -> IO ()
setShaderValueTexture Shader
shader ShaderLocationIndex
locIndex Texture
tex = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader (\Ptr Shader
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
tex (Ptr Shader -> CInt -> Ptr Texture -> IO ()
c'setShaderValueTexture Ptr Shader
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ShaderLocationIndex
locIndex)))

foreign import ccall safe "raylib.h &SetShaderValueTexture"
  p'setShaderValueTexture ::
    FunPtr (Raylib.Types.Shader -> CInt -> Raylib.Types.Texture -> IO ())

foreign import ccall safe "bindings.h UnloadShader_" c'unloadShader :: Ptr Raylib.Types.Shader -> IO ()

unloadShader :: Raylib.Types.Shader -> IO ()
unloadShader :: Shader -> IO ()
unloadShader Shader
shader = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Shader
shader Ptr Shader -> IO ()
c'unloadShader

foreign import ccall safe "raylib.h &UnloadShader"
  p'unloadShader ::
    FunPtr (Raylib.Types.Shader -> IO ())

foreign import ccall safe "bindings.h GetMouseRay_" c'getMouseRay :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Camera3D -> IO (Ptr Raylib.Types.Ray)

getMouseRay :: Raylib.Types.Vector2 -> Raylib.Types.Camera3D -> IO Raylib.Types.Ray
getMouseRay :: Vector2 -> Camera3D -> IO Ray
getMouseRay Vector2
mousePosition Camera3D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
mousePosition (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Camera3D -> IO (Ptr Ray)
c'getMouseRay) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMouseRay"
  p'getMouseRay ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Camera3D -> IO Raylib.Types.Ray)

foreign import ccall safe "bindings.h GetCameraMatrix_" c'getCameraMatrix :: Ptr Raylib.Types.Camera3D -> IO (Ptr Raylib.Types.Matrix)

getCameraMatrix :: Raylib.Types.Camera3D -> IO Raylib.Types.Matrix
getCameraMatrix :: Camera3D -> IO Matrix
getCameraMatrix Camera3D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera Ptr Camera3D -> IO (Ptr Matrix)
c'getCameraMatrix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetCameraMatrix"
  p'getCameraMatrix ::
    FunPtr (Raylib.Types.Camera3D -> IO Raylib.Types.Matrix)

foreign import ccall safe "bindings.h GetCameraMatrix2D_" c'getCameraMatrix2D :: Ptr Raylib.Types.Camera2D -> IO (Ptr Raylib.Types.Matrix)

getCameraMatrix2D :: Raylib.Types.Camera2D -> IO Raylib.Types.Matrix
getCameraMatrix2D :: Camera2D -> IO Matrix
getCameraMatrix2D Camera2D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera2D
camera Ptr Camera2D -> IO (Ptr Matrix)
c'getCameraMatrix2D forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetCameraMatrix2D"
  p'getCameraMatrix2D ::
    FunPtr (Raylib.Types.Camera2D -> IO Raylib.Types.Matrix)

foreign import ccall safe "bindings.h GetWorldToScreen_" c'getWorldToScreen :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Camera3D -> IO (Ptr Raylib.Types.Vector2)

getWorldToScreen :: Raylib.Types.Vector3 -> Raylib.Types.Camera3D -> IO Raylib.Types.Vector2
getWorldToScreen :: Vector3 -> Camera3D -> IO Vector2
getWorldToScreen Vector3
position Camera3D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Camera3D -> IO (Ptr Vector2)
c'getWorldToScreen) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetWorldToScreen"
  p'getWorldToScreen ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Camera3D -> IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetScreenToWorld2D_" c'getScreenToWorld2D :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Camera2D -> IO (Ptr Raylib.Types.Vector2)

getScreenToWorld2D :: Raylib.Types.Vector2 -> Raylib.Types.Camera2D -> IO Raylib.Types.Vector2
getScreenToWorld2D :: Vector2 -> Camera2D -> IO Vector2
getScreenToWorld2D Vector2
position Camera2D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera2D
camera forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Camera2D -> IO (Ptr Vector2)
c'getScreenToWorld2D) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetScreenToWorld2D"
  p'getScreenToWorld2D ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Camera2D -> IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetWorldToScreenEx_" c'getWorldToScreenEx :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Camera3D -> CInt -> CInt -> IO (Ptr Raylib.Types.Vector2)

getWorldToScreenEx :: Raylib.Types.Vector3 -> Raylib.Types.Camera3D -> Int -> Int -> IO Raylib.Types.Vector2
getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> IO Vector2
getWorldToScreenEx Vector3
position Camera3D
camera Int
width Int
height = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera (\Ptr Camera3D
c -> Ptr Vector3 -> Ptr Camera3D -> CInt -> CInt -> IO (Ptr Vector2)
c'getWorldToScreenEx Ptr Vector3
p Ptr Camera3D
c (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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetWorldToScreenEx"
  p'getWorldToScreenEx ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Camera3D -> CInt -> CInt -> IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetWorldToScreen2D_" c'getWorldToScreen2D :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Camera2D -> IO (Ptr Raylib.Types.Vector2)

getWorldToScreen2D :: Raylib.Types.Vector2 -> Raylib.Types.Camera2D -> IO Raylib.Types.Vector2
getWorldToScreen2D :: Vector2 -> Camera2D -> IO Vector2
getWorldToScreen2D Vector2
position Camera2D
camera = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera2D
camera forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Camera2D -> IO (Ptr Vector2)
c'getWorldToScreen2D) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetWorldToScreen2D"
  p'getWorldToScreen2D ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Camera2D -> IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h SetTargetFPS"
  c'setTargetFPS ::
    CInt -> IO ()

setTargetFPS :: Int -> IO ()
setTargetFPS :: Int -> IO ()
setTargetFPS Int
fps = CInt -> IO ()
c'setTargetFPS forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fps

foreign import ccall safe "raylib.h &SetTargetFPS"
  p'setTargetFPS ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h GetFPS"
  c'getFPS ::
    IO CInt

getFPS :: IO Int
getFPS :: IO Int
getFPS = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getFPS

foreign import ccall safe "raylib.h &GetFPS"
  p'getFPS ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetFrameTime"
  c'getFrameTime ::
    IO CFloat

getFrameTime :: IO Float
getFrameTime :: IO Float
getFrameTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getFrameTime

foreign import ccall safe "raylib.h &GetFrameTime"
  p'getFrameTime ::
    FunPtr (IO CFloat)

foreign import ccall safe "raylib.h GetTime"
  c'getTime ::
    IO CDouble

getTime :: IO Double
getTime :: IO Double
getTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CDouble
c'getTime

foreign import ccall safe "raylib.h &GetTime"
  p'getTime ::
    FunPtr (IO CDouble)

foreign import ccall safe "raylib.h GetRandomValue"
  c'getRandomValue ::
    CInt -> CInt -> IO CInt

getRandomValue :: Int -> Int -> IO Int
getRandomValue :: Int -> Int -> IO Int
getRandomValue Int
minVal Int
maxVal = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CInt
c'getRandomValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minVal) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxVal)

foreign import ccall safe "raylib.h &GetRandomValue"
  p'getRandomValue ::
    FunPtr (CInt -> CInt -> IO CInt)

foreign import ccall safe "raylib.h SetRandomSeed"
  c'setRandomSeed ::
    CUInt -> IO ()

setRandomSeed :: Integer -> IO ()
setRandomSeed :: Integer -> IO ()
setRandomSeed Integer
seed = CUInt -> IO ()
c'setRandomSeed forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seed

foreign import ccall safe "raylib.h &SetRandomSeed"
  p'setRandomSeed ::
    FunPtr (CUInt -> IO ())

foreign import ccall safe "raylib.h TakeScreenshot"
  c'takeScreenshot ::
    CString -> IO ()

takeScreenshot :: String -> IO ()
takeScreenshot :: String -> IO ()
takeScreenshot String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO ()
c'takeScreenshot

foreign import ccall safe "raylib.h &TakeScreenshot"
  p'takeScreenshot ::
    FunPtr (CString -> IO ())

foreign import ccall safe "raylib.h SetConfigFlags"
  c'setConfigFlags ::
    CUInt -> IO ()

setConfigFlags :: Integer -> IO ()
setConfigFlags :: Integer -> IO ()
setConfigFlags Integer
flags = CUInt -> IO ()
c'setConfigFlags forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
flags

foreign import ccall safe "raylib.h &SetConfigFlags"
  p'setConfigFlags ::
    FunPtr (CUInt -> IO ())

foreign import ccall safe "raylib.h TraceLog"
  c'traceLog ::
    CInt -> CString -> IO () -- Uses varags, can't implement complete functionality


traceLog :: TraceLogLevel -> String -> IO ()
traceLog :: TraceLogLevel -> String -> IO ()
traceLog TraceLogLevel
logLevel String
text = forall a. String -> (CString -> IO a) -> IO a
withCString String
text forall a b. (a -> b) -> a -> b
$ CInt -> CString -> IO ()
c'traceLog forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum TraceLogLevel
logLevel

foreign import ccall safe "raylib.h &TraceLog"
  p'traceLog ::
    FunPtr (CInt -> CString -> IO ())

foreign import ccall safe "raylib.h SetTraceLogLevel"
  c'setTraceLogLevel ::
    CInt -> IO ()

setTraceLogLevel :: TraceLogLevel -> IO ()
setTraceLogLevel :: TraceLogLevel -> IO ()
setTraceLogLevel = CInt -> IO ()
c'setTraceLogLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "raylib.h &SetTraceLogLevel"
  p'setTraceLogLevel ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h MemAlloc"
  c'memAlloc ::
    CInt -> IO (Ptr ())

memAlloc :: (Storable a) => Int -> IO (Ptr a)
memAlloc :: forall a. Storable a => Int -> IO (Ptr a)
memAlloc Int
size = forall a b. Ptr a -> Ptr b
castPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO (Ptr ())
c'memAlloc (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

foreign import ccall safe "raylib.h &MemAlloc"
  p'memAlloc ::
    FunPtr (CInt -> IO (Ptr ()))

foreign import ccall safe "raylib.h MemRealloc"
  c'memRealloc ::
    Ptr () -> CInt -> IO (Ptr ())

memRealloc :: (Storable a, Storable b) => Ptr a -> Int -> IO (Ptr b)
memRealloc :: forall a b. (Storable a, Storable b) => Ptr a -> Int -> IO (Ptr b)
memRealloc Ptr a
ptr Int
size = forall a b. Ptr a -> Ptr b
castPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr () -> CInt -> IO (Ptr ())
c'memRealloc (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

foreign import ccall safe "raylib.h &MemRealloc"
  p'memRealloc ::
    FunPtr (Ptr () -> CInt -> IO (Ptr ()))

foreign import ccall safe "raylib.h MemFree"
  c'memFree ::
    Ptr () -> IO ()

memFree :: (Storable a) => Ptr a -> IO ()
memFree :: forall a. Storable a => Ptr a -> IO ()
memFree = Ptr () -> IO ()
c'memFree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr

foreign import ccall safe "raylib.h &MemFree"
  p'memFree ::
    FunPtr (Ptr () -> IO ())

foreign import ccall safe "raylib.h OpenURL"
  c'openURL ::
    CString -> IO ()

openURL :: String -> IO ()
openURL :: String -> IO ()
openURL String
url = forall a. String -> (CString -> IO a) -> IO a
withCString String
url CString -> IO ()
c'openURL

foreign import ccall safe "raylib.h &OpenURL"
  p'openURL ::
    FunPtr (CString -> IO ())

-- These functions use varargs so they can't be implemented through FFI

-- foreign import ccall safe "raylib.h SetTraceLogCallback"

--   SetTraceLogCallback ::

--     TraceLogCallback -> IO ()

-- foreign import ccall safe "raylib.h &SetTraceLogCallback"

--   p'SetTraceLogCallback ::

--     FunPtr (TraceLogCallback -> IO ())


foreign import ccall safe "raylib.h SetLoadFileDataCallback"
  setLoadFileDataCallback ::
    LoadFileDataCallback -> IO ()

foreign import ccall safe "raylib.h &SetLoadFileDataCallback"
  p'setLoadFileDataCallback ::
    FunPtr (LoadFileDataCallback -> IO ())

foreign import ccall safe "raylib.h SetSaveFileDataCallback"
  setSaveFileDataCallback ::
    SaveFileDataCallback -> IO ()

foreign import ccall safe "raylib.h &SetSaveFileDataCallback"
  p'setSaveFileDataCallback ::
    FunPtr (SaveFileDataCallback -> IO ())

foreign import ccall safe "raylib.h SetLoadFileTextCallback"
  setLoadFileTextCallback ::
    LoadFileTextCallback -> IO ()

foreign import ccall safe "raylib.h &SetLoadFileTextCallback"
  p'setLoadFileTextCallback ::
    FunPtr (LoadFileTextCallback -> IO ())

foreign import ccall safe "raylib.h SetSaveFileTextCallback"
  setSaveFileTextCallback ::
    SaveFileTextCallback -> IO ()

foreign import ccall safe "raylib.h &SetSaveFileTextCallback"
  p'setSaveFileTextCallback ::
    FunPtr (SaveFileTextCallback -> IO ())

foreign import ccall safe "raylib.h LoadFileData"
  c'loadFileData ::
    CString -> Ptr CUInt -> IO (Ptr CUChar)

loadFileData :: String -> IO [Integer]
loadFileData :: String -> IO [Integer]
loadFileData String
fileName =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    CUInt
0
    ( \Ptr CUInt
size -> do
        forall a. String -> (CString -> IO a) -> IO a
withCString
          String
fileName
          ( \CString
path -> do
              Ptr CUChar
ptr <- CString -> Ptr CUInt -> IO (Ptr CUChar)
c'loadFileData CString
path Ptr CUInt
size
              Int
arrSize <- 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 CUInt
size
              [CUChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
arrSize Ptr CUChar
ptr
              Ptr CUChar -> IO ()
c'unloadFileData Ptr CUChar
ptr
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

foreign import ccall safe "raylib.h &LoadFileData"
  p'loadFileData ::
    FunPtr (CString -> Ptr CUInt -> IO (Ptr CUChar))

foreign import ccall safe "raylib.h UnloadFileData"
  c'unloadFileData ::
    Ptr CUChar -> IO ()

foreign import ccall safe "raylib.h &UnloadFileData"
  p'unloadFileData ::
    FunPtr (Ptr CUChar -> IO ())

foreign import ccall safe "raylib.h SaveFileData"
  c'saveFileData ::
    CString -> Ptr () -> CUInt -> IO CBool

saveFileData :: (Storable a) => String -> Ptr a -> Integer -> IO Bool
saveFileData :: forall a. Storable a => String -> Ptr a -> Integer -> IO Bool
saveFileData String
fileName Ptr a
contents Integer
bytesToWrite =
  forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (\CString
s -> CString -> Ptr () -> CUInt -> IO CBool
c'saveFileData CString
s (forall a b. Ptr a -> Ptr b
castPtr Ptr a
contents) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bytesToWrite))

foreign import ccall safe "raylib.h &SaveFileData"
  p'saveFileData ::
    FunPtr (CString -> Ptr () -> CUInt -> IO CInt)

foreign import ccall safe "raylib.h ExportDataAsCode"
  c'exportDataAsCode ::
    Ptr CUChar -> CUInt -> CString -> IO CBool

exportDataAsCode :: [Integer] -> Integer -> String -> IO Bool
exportDataAsCode :: [Integer] -> Integer -> String -> IO Bool
exportDataAsCode [Integer]
contents Integer
size 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. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => Integer -> a
fromInteger [Integer]
contents) (\Ptr CUChar
c -> forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (Ptr CUChar -> CUInt -> CString -> IO CBool
c'exportDataAsCode Ptr CUChar
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)))

foreign import ccall safe "raylib.h &ExportDataAsCode"
  p'exportDataAsCode ::
    FunPtr (CString -> CUInt -> CString -> IO CInt)

foreign import ccall safe "raylib.h LoadFileText"
  c'loadFileText ::
    CString -> IO CString

loadFileText :: String -> IO String
loadFileText :: String -> IO String
loadFileText String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CString
c'loadFileText forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &LoadFileText"
  p'loadFileText ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h UnloadFileText"
  c'unloadFileText ::
    CString -> IO ()

unloadFileText :: String -> IO ()
unloadFileText :: String -> IO ()
unloadFileText String
text = forall a. String -> (CString -> IO a) -> IO a
withCString String
text CString -> IO ()
c'unloadFileText

foreign import ccall safe "raylib.h &UnloadFileText"
  p'unloadFileText ::
    FunPtr (CString -> IO ())

foreign import ccall safe "raylib.h SaveFileText"
  c'saveFileText ::
    CString -> CString -> IO CBool

saveFileText :: String -> String -> IO Bool
saveFileText :: String -> String -> IO Bool
saveFileText String
fileName String
text = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (forall a. String -> (CString -> IO a) -> IO a
withCString String
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO CBool
c'saveFileText)

foreign import ccall safe "raylib.h &SaveFileText"
  p'saveFileText ::
    FunPtr (CString -> CString -> IO CInt)

foreign import ccall safe "raylib.h FileExists"
  c'fileExists ::
    CString -> IO CBool

fileExists :: String -> IO Bool
fileExists :: String -> IO Bool
fileExists 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. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CBool
c'fileExists

foreign import ccall safe "raylib.h &FileExists"
  p'fileExists ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "raylib.h DirectoryExists"
  c'directoryExists ::
    CString -> IO CBool

directoryExists :: String -> IO Bool
directoryExists :: String -> IO Bool
directoryExists String
dirPath = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
dirPath CString -> IO CBool
c'directoryExists

foreign import ccall safe "raylib.h &DirectoryExists"
  p'directoryExists ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "raylib.h IsFileExtension"
  c'isFileExtension ::
    CString -> CString -> IO CBool

isFileExtension :: String -> String -> IO Bool
isFileExtension :: String -> String -> IO Bool
isFileExtension String
fileName String
ext = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (forall a. String -> (CString -> IO a) -> IO a
withCString String
ext forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO CBool
c'isFileExtension)

foreign import ccall safe "raylib.h &IsFileExtension"
  p'isFileExtension ::
    FunPtr (CString -> CString -> IO CInt)

foreign import ccall safe "raylib.h GetFileLength"
  c'getFileLength ::
    CString -> IO CBool

getFileLength :: String -> IO Bool
getFileLength :: String -> IO Bool
getFileLength 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. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CBool
c'getFileLength

foreign import ccall safe "raylib.h &GetFileLength"
  p'getFileLength ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "raylib.h GetFileExtension"
  c'getFileExtension ::
    CString -> IO CString

getFileExtension :: String -> IO String
getFileExtension :: String -> IO String
getFileExtension String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CString
c'getFileExtension forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetFileExtension"
  p'getFileExtension ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h GetFileName"
  c'getFileName ::
    CString -> IO CString

getFileName :: String -> IO String
getFileName :: String -> IO String
getFileName String
filePath = forall a. String -> (CString -> IO a) -> IO a
withCString String
filePath CString -> IO CString
c'getFileName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetFileName"
  p'getFileName ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h GetFileNameWithoutExt"
  c'getFileNameWithoutExt ::
    CString -> IO CString

getFileNameWithoutExt :: String -> IO String
getFileNameWithoutExt :: String -> IO String
getFileNameWithoutExt String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CString
c'getFileNameWithoutExt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetFileNameWithoutExt"
  p'getFileNameWithoutExt ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h GetDirectoryPath"
  c'getDirectoryPath ::
    CString -> IO CString

getDirectoryPath :: String -> IO String
getDirectoryPath :: String -> IO String
getDirectoryPath String
filePath = forall a. String -> (CString -> IO a) -> IO a
withCString String
filePath CString -> IO CString
c'getDirectoryPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetDirectoryPath"
  p'getDirectoryPath ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h GetPrevDirectoryPath"
  c'getPrevDirectoryPath ::
    CString -> IO CString

getPrevDirectoryPath :: String -> IO String
getPrevDirectoryPath :: String -> IO String
getPrevDirectoryPath String
dirPath = forall a. String -> (CString -> IO a) -> IO a
withCString String
dirPath CString -> IO CString
c'getPrevDirectoryPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetPrevDirectoryPath"
  p'getPrevDirectoryPath ::
    FunPtr (CString -> IO CString)

foreign import ccall safe "raylib.h GetWorkingDirectory"
  c'getWorkingDirectory ::
    IO CString

getWorkingDirectory :: IO String
getWorkingDirectory :: IO String
getWorkingDirectory = IO CString
c'getWorkingDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetWorkingDirectory"
  p'getWorkingDirectory ::
    FunPtr (IO CString)

foreign import ccall safe "raylib.h GetApplicationDirectory"
  c'getApplicationDirectory ::
    IO CString

getApplicationDirectory :: IO String
getApplicationDirectory :: IO String
getApplicationDirectory = IO CString
c'getApplicationDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetApplicationDirectory"
  p'getApplicationDirectory ::
    FunPtr (IO CString)

foreign import ccall safe "raylib.h ChangeDirectory"
  c'changeDirectory ::
    CString -> IO CBool

changeDirectory :: String -> IO Bool
changeDirectory :: String -> IO Bool
changeDirectory String
dir = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
dir CString -> IO CBool
c'changeDirectory

foreign import ccall safe "raylib.h &ChangeDirectory"
  p'changeDirectory ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "raylib.h IsPathFile"
  c'isPathFile ::
    CString -> IO CBool

isPathFile :: String -> IO Bool
isPathFile :: String -> IO Bool
isPathFile String
path = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
path CString -> IO CBool
c'isPathFile

foreign import ccall safe "raylib.h &IsPathFile"
  p'isPathFile ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "bindings.h LoadDirectoryFiles_" c'loadDirectoryFiles :: CString -> IO (Ptr Raylib.Types.FilePathList)

loadDirectoryFiles :: String -> IO Raylib.Types.FilePathList
loadDirectoryFiles :: String -> IO FilePathList
loadDirectoryFiles String
dirPath = forall a. String -> (CString -> IO a) -> IO a
withCString String
dirPath CString -> IO (Ptr FilePathList)
c'loadDirectoryFiles forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadDirectoryFiles"
  p'loadDirectoryFiles ::
    FunPtr (CString -> IO Raylib.Types.FilePathList)

foreign import ccall safe "bindings.h LoadDirectoryFilesEx_" c'loadDirectoryFilesEx :: CString -> CString -> CInt -> IO (Ptr Raylib.Types.FilePathList)

loadDirectoryFilesEx :: String -> String -> Bool -> IO Raylib.Types.FilePathList
loadDirectoryFilesEx :: String -> String -> Bool -> IO FilePathList
loadDirectoryFilesEx String
basePath String
filterStr Bool
scanSubdirs =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
basePath (\CString
b -> forall a. String -> (CString -> IO a) -> IO a
withCString String
filterStr (\CString
f -> CString -> CString -> CInt -> IO (Ptr FilePathList)
c'loadDirectoryFilesEx CString
b CString
f (forall a. Num a => Bool -> a
fromBool Bool
scanSubdirs))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadDirectoryFilesEx"
  p'loadDirectoryFilesEx ::
    FunPtr (CString -> CString -> CInt -> IO Raylib.Types.FilePathList)

foreign import ccall safe "bindings.h UnloadDirectoryFiles_" c'unloadDirectoryFiles :: Ptr Raylib.Types.FilePathList -> IO ()

unloadDirectoryFiles :: Raylib.Types.FilePathList -> IO ()
unloadDirectoryFiles :: FilePathList -> IO ()
unloadDirectoryFiles FilePathList
files = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with FilePathList
files Ptr FilePathList -> IO ()
c'unloadDirectoryFiles

foreign import ccall safe "raylib.h &UnloadDirectoryFiles"
  p'unloadDirectoryFiles ::
    FunPtr (Raylib.Types.FilePathList -> IO ())

foreign import ccall safe "raylib.h IsFileDropped"
  c'isFileDropped ::
    IO CBool

isFileDropped :: IO Bool
isFileDropped :: IO Bool
isFileDropped = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isFileDropped

foreign import ccall safe "raylib.h &IsFileDropped"
  p'isFileDropped ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h LoadDroppedFiles_" c'loadDroppedFiles :: IO (Ptr Raylib.Types.FilePathList)

loadDroppedFiles :: IO Raylib.Types.FilePathList
loadDroppedFiles :: IO FilePathList
loadDroppedFiles = IO (Ptr FilePathList)
c'loadDroppedFiles forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadDroppedFiles"
  p'loadDroppedFiles ::
    FunPtr (IO Raylib.Types.FilePathList)

foreign import ccall safe "bindings.h UnloadDroppedFiles_" c'unloadDroppedFiles :: Ptr Raylib.Types.FilePathList -> IO ()

unloadDroppedFiles :: Raylib.Types.FilePathList -> IO ()
unloadDroppedFiles :: FilePathList -> IO ()
unloadDroppedFiles FilePathList
files = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with FilePathList
files Ptr FilePathList -> IO ()
c'unloadDroppedFiles

foreign import ccall safe "raylib.h &UnloadDroppedFiles"
  p'unloadDroppedFiles ::
    FunPtr (Raylib.Types.FilePathList -> IO ())

foreign import ccall safe "raylib.h GetFileModTime"
  c'getFileModTime ::
    CString -> IO CLong

getFileModTime :: String -> IO Integer
getFileModTime :: String -> IO Integer
getFileModTime String
fileName = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO CLong
c'getFileModTime

foreign import ccall safe "raylib.h &GetFileModTime"
  p'getFileModTime ::
    FunPtr (CString -> IO CLong)

foreign import ccall safe "raylib.h CompressData"
  c'compressData ::
    Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)

compressData :: [Integer] -> IO [Integer]
compressData :: [Integer] -> IO [Integer]
compressData [Integer]
contents = do
  forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
contents)
    ( \Int
size Ptr CUChar
c -> do
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
ptr -> do
              Ptr CUChar
compressed <- Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)
c'compressData Ptr CUChar
c (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)) Ptr CInt
ptr
              Int
compressedSize <- 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
ptr
              [CUChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
compressedSize Ptr CUChar
compressed
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

foreign import ccall safe "raylib.h &CompressData"
  p'compressData ::
    FunPtr (Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar))

foreign import ccall safe "raylib.h DecompressData"
  c'decompressData ::
    Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)

decompressData :: [Integer] -> IO [Integer]
decompressData :: [Integer] -> IO [Integer]
decompressData [Integer]
compressedData = do
  forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
compressedData)
    ( \Int
size Ptr CUChar
c -> do
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
ptr -> do
              Ptr CUChar
decompressed <- Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)
c'decompressData Ptr CUChar
c (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)) Ptr CInt
ptr
              Int
decompressedSize <- 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
ptr
              [CUChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
decompressedSize Ptr CUChar
decompressed
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

foreign import ccall safe "raylib.h &DecompressData"
  p'decompressData ::
    FunPtr (Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar))

foreign import ccall safe "raylib.h EncodeDataBase64"
  c'encodeDataBase64 ::
    Ptr CUChar -> CInt -> Ptr CInt -> IO CString

encodeDataBase64 :: [Integer] -> IO [Integer]
encodeDataBase64 :: [Integer] -> IO [Integer]
encodeDataBase64 [Integer]
contents = do
  forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
contents)
    ( \Int
size Ptr CUChar
c -> do
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
ptr -> do
              CString
encoded <- Ptr CUChar -> CInt -> Ptr CInt -> IO CString
c'encodeDataBase64 Ptr CUChar
c (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)) Ptr CInt
ptr
              Int
encodedSize <- 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
ptr
              [CChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
encodedSize CString
encoded
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CChar]
arr
          )
    )

foreign import ccall safe "raylib.h &EncodeDataBase64"
  p'encodeDataBase64 ::
    FunPtr (Ptr CUChar -> CInt -> Ptr CInt -> IO CString)

foreign import ccall safe "raylib.h DecodeDataBase64"
  c'decodeDataBase64 ::
    Ptr CUChar -> Ptr CInt -> IO (Ptr CUChar)

decodeDataBase64 :: [Integer] -> IO [Integer]
decodeDataBase64 :: [Integer] -> IO [Integer]
decodeDataBase64 [Integer]
encodedData = do
  forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
encodedData)
    ( \Ptr CUChar
c -> do
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
ptr -> do
              Ptr CUChar
decoded <- Ptr CUChar -> Ptr CInt -> IO (Ptr CUChar)
c'decodeDataBase64 Ptr CUChar
c Ptr CInt
ptr
              Int
decodedSize <- 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
ptr
              [CUChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
decodedSize Ptr CUChar
decoded
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

foreign import ccall safe "raylib.h &DecodeDataBase64"
  p'decodeDataBase64 ::
    FunPtr (Ptr CUChar -> Ptr CInt -> IO (Ptr CUChar))

foreign import ccall safe "raylib.h IsKeyPressed"
  c'isKeyPressed ::
    CInt -> IO CBool

isKeyPressed :: KeyboardKey -> IO Bool
isKeyPressed :: KeyboardKey -> IO Bool
isKeyPressed KeyboardKey
key = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isKeyPressed (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum KeyboardKey
key)

foreign import ccall safe "raylib.h &IsKeyPressed"
  p'isKeyPressed ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsKeyDown"
  c'isKeyDown ::
    CInt -> IO CBool

isKeyDown :: KeyboardKey -> IO Bool
isKeyDown :: KeyboardKey -> IO Bool
isKeyDown KeyboardKey
key = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isKeyDown (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum KeyboardKey
key)

foreign import ccall safe "raylib.h &IsKeyDown"
  p'isKeyDown ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsKeyReleased"
  c'isKeyReleased ::
    CInt -> IO CBool

isKeyReleased :: KeyboardKey -> IO Bool
isKeyReleased :: KeyboardKey -> IO Bool
isKeyReleased KeyboardKey
key = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isKeyReleased (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum KeyboardKey
key)

foreign import ccall safe "raylib.h &IsKeyReleased"
  p'isKeyReleased ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsKeyUp"
  c'isKeyUp ::
    CInt -> IO CBool

isKeyUp :: KeyboardKey -> IO Bool
isKeyUp :: KeyboardKey -> IO Bool
isKeyUp KeyboardKey
key = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isKeyUp (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum KeyboardKey
key)

foreign import ccall safe "raylib.h &IsKeyUp"
  p'isKeyUp ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h SetExitKey"
  c'setExitKey ::
    CInt -> IO ()

setExitKey :: KeyboardKey -> IO ()
setExitKey :: KeyboardKey -> IO ()
setExitKey = CInt -> IO ()
c'setExitKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "raylib.h &SetExitKey"
  p'setExitKey ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h GetKeyPressed"
  c'getKeyPressed ::
    IO CInt

getKeyPressed :: IO KeyboardKey
getKeyPressed :: IO KeyboardKey
getKeyPressed = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getKeyPressed

foreign import ccall safe "raylib.h &GetKeyPressed"
  p'getKeyPressed ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetCharPressed"
  c'getCharPressed ::
    IO CInt

getCharPressed :: IO Int
getCharPressed :: IO Int
getCharPressed = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getCharPressed

foreign import ccall safe "raylib.h &GetCharPressed"
  p'getCharPressed ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h IsGamepadAvailable"
  c'isGamepadAvailable ::
    CInt -> IO CBool

isGamepadAvailable :: Int -> IO Bool
isGamepadAvailable :: Int -> IO Bool
isGamepadAvailable Int
gamepad = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isGamepadAvailable (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad)

foreign import ccall safe "raylib.h &IsGamepadAvailable"
  p'isGamepadAvailable ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetGamepadName"
  c'getGamepadName ::
    CInt -> IO CString

getGamepadName :: Int -> IO String
getGamepadName :: Int -> IO String
getGamepadName Int
gamepad = CInt -> IO CString
c'getGamepadName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &GetGamepadName"
  p'getGamepadName ::
    FunPtr (CInt -> IO CString)

foreign import ccall safe "raylib.h IsGamepadButtonPressed"
  c'isGamepadButtonPressed ::
    CInt -> CInt -> IO CBool

isGamepadButtonPressed :: Int -> GamepadButton -> IO Bool
isGamepadButtonPressed :: Int -> GamepadButton -> IO Bool
isGamepadButtonPressed Int
gamepad GamepadButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CBool
c'isGamepadButtonPressed (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum GamepadButton
button)

foreign import ccall safe "raylib.h &IsGamepadButtonPressed"
  p'isGamepadButtonPressed ::
    FunPtr (CInt -> CInt -> IO CInt)

foreign import ccall safe "raylib.h IsGamepadButtonDown"
  c'isGamepadButtonDown ::
    CInt -> CInt -> IO CBool

isGamepadButtonDown :: Int -> GamepadButton -> IO Bool
isGamepadButtonDown :: Int -> GamepadButton -> IO Bool
isGamepadButtonDown Int
gamepad GamepadButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CBool
c'isGamepadButtonDown (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum GamepadButton
button)

foreign import ccall safe "raylib.h &IsGamepadButtonDown"
  p'isGamepadButtonDown ::
    FunPtr (CInt -> CInt -> IO CInt)

foreign import ccall safe "raylib.h IsGamepadButtonReleased"
  c'isGamepadButtonReleased ::
    CInt -> CInt -> IO CBool

isGamepadButtonReleased :: Int -> GamepadButton -> IO Bool
isGamepadButtonReleased :: Int -> GamepadButton -> IO Bool
isGamepadButtonReleased Int
gamepad GamepadButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CBool
c'isGamepadButtonReleased (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum GamepadButton
button)

foreign import ccall safe "raylib.h &IsGamepadButtonReleased"
  p'isGamepadButtonReleased ::
    FunPtr (CInt -> CInt -> IO CInt)

foreign import ccall safe "raylib.h IsGamepadButtonUp"
  c'isGamepadButtonUp ::
    CInt -> CInt -> IO CBool

isGamepadButtonUp :: Int -> GamepadButton -> IO Bool
isGamepadButtonUp :: Int -> GamepadButton -> IO Bool
isGamepadButtonUp Int
gamepad GamepadButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CBool
c'isGamepadButtonUp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum GamepadButton
button)

foreign import ccall safe "raylib.h &IsGamepadButtonUp"
  p'isGamepadButtonUp ::
    FunPtr (CInt -> CInt -> IO CInt)

foreign import ccall safe "raylib.h GetGamepadButtonPressed"
  c'getGamepadButtonPressed ::
    IO CInt

getGamepadButtonPressed :: IO GamepadButton
getGamepadButtonPressed :: IO GamepadButton
getGamepadButtonPressed = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getGamepadButtonPressed

foreign import ccall safe "raylib.h &GetGamepadButtonPressed"
  p'getGamepadButtonPressed ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetGamepadAxisCount"
  c'getGamepadAxisCount ::
    CInt -> IO CInt

getGamepadAxisCount :: Int -> IO Int
getGamepadAxisCount :: Int -> IO Int
getGamepadAxisCount Int
gamepad = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getGamepadAxisCount (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad)

foreign import ccall safe "raylib.h &GetGamepadAxisCount"
  p'getGamepadAxisCount ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetGamepadAxisMovement"
  c'getGamepadAxisMovement ::
    CInt -> CInt -> IO CFloat

getGamepadAxisMovement :: Int -> GamepadAxis -> IO Float
getGamepadAxisMovement :: Int -> GamepadAxis -> IO Float
getGamepadAxisMovement Int
gamepad GamepadAxis
axis = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> IO CFloat
c'getGamepadAxisMovement (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum GamepadAxis
axis)

foreign import ccall safe "raylib.h &GetGamepadAxisMovement"
  p'getGamepadAxisMovement ::
    FunPtr (CInt -> CInt -> IO CFloat)

foreign import ccall safe "raylib.h SetGamepadMappings"
  c'setGamepadMappings ::
    CString -> IO CInt

setGamepadMappings :: String -> IO Int
setGamepadMappings :: String -> IO Int
setGamepadMappings String
mappings = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
mappings CString -> IO CInt
c'setGamepadMappings

foreign import ccall safe "raylib.h &SetGamepadMappings"
  p'setGamepadMappings ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "raylib.h IsMouseButtonPressed"
  c'isMouseButtonPressed ::
    CInt -> IO CBool

isMouseButtonPressed :: MouseButton -> IO Bool
isMouseButtonPressed :: MouseButton -> IO Bool
isMouseButtonPressed MouseButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isMouseButtonPressed (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum MouseButton
button)

foreign import ccall safe "raylib.h &IsMouseButtonPressed"
  p'isMouseButtonPressed ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsMouseButtonDown"
  c'isMouseButtonDown ::
    CInt -> IO CBool

isMouseButtonDown :: MouseButton -> IO Bool
isMouseButtonDown :: MouseButton -> IO Bool
isMouseButtonDown MouseButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isMouseButtonDown (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum MouseButton
button)

foreign import ccall safe "raylib.h &IsMouseButtonDown"
  p'isMouseButtonDown ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsMouseButtonReleased"
  c'isMouseButtonReleased ::
    CInt -> IO CBool

isMouseButtonReleased :: MouseButton -> IO Bool
isMouseButtonReleased :: MouseButton -> IO Bool
isMouseButtonReleased MouseButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isMouseButtonReleased (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum MouseButton
button)

foreign import ccall safe "raylib.h &IsMouseButtonReleased"
  p'isMouseButtonReleased ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h IsMouseButtonUp"
  c'isMouseButtonUp ::
    CInt -> IO CBool

isMouseButtonUp :: MouseButton -> IO Bool
isMouseButtonUp :: MouseButton -> IO Bool
isMouseButtonUp MouseButton
button = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isMouseButtonUp (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum MouseButton
button)

foreign import ccall safe "raylib.h &IsMouseButtonUp"
  p'isMouseButtonUp ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetMouseX"
  c'getMouseX ::
    IO CInt

getMouseX :: IO Int
getMouseX :: IO Int
getMouseX = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getMouseX

foreign import ccall safe "raylib.h &GetMouseX"
  p'getMouseX ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetMouseY"
  c'getMouseY ::
    IO CInt

getMouseY :: IO Int
getMouseY :: IO Int
getMouseY = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getMouseY

foreign import ccall safe "raylib.h &GetMouseY"
  p'getMouseY ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h GetMousePosition_" c'getMousePosition :: IO (Ptr Raylib.Types.Vector2)

getMousePosition :: IO Raylib.Types.Vector2
getMousePosition :: IO Vector2
getMousePosition = IO (Ptr Vector2)
c'getMousePosition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMousePosition"
  p'getMousePosition ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetMouseDelta_" c'getMouseDelta :: IO (Ptr Raylib.Types.Vector2)

getMouseDelta :: IO Raylib.Types.Vector2
getMouseDelta :: IO Vector2
getMouseDelta = IO (Ptr Vector2)
c'getMouseDelta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMouseDelta"
  p'getMouseDelta ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h SetMousePosition"
  c'setMousePosition ::
    CInt -> CInt -> IO ()

setMousePosition :: Int -> Int -> IO ()
setMousePosition :: Int -> Int -> IO ()
setMousePosition Int
x Int
y = CInt -> CInt -> IO ()
c'setMousePosition (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &SetMousePosition"
  p'setMousePosition ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h SetMouseOffset"
  c'setMouseOffset ::
    CInt -> CInt -> IO ()

setMouseOffset :: Int -> Int -> IO ()
setMouseOffset :: Int -> Int -> IO ()
setMouseOffset Int
x Int
y = CInt -> CInt -> IO ()
c'setMouseOffset (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &SetMouseOffset"
  p'setMouseOffset ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h SetMouseScale"
  c'setMouseScale ::
    CFloat -> CFloat -> IO ()

setMouseScale :: Float -> Float -> IO ()
setMouseScale :: Float -> Float -> IO ()
setMouseScale Float
x Float
y = CFloat -> CFloat -> IO ()
c'setMouseScale (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y)

foreign import ccall safe "raylib.h &SetMouseScale"
  p'setMouseScale ::
    FunPtr (CFloat -> CFloat -> IO ())

foreign import ccall safe "raylib.h GetMouseWheelMove"
  c'getMouseWheelMove ::
    IO CFloat

getMouseWheelMove :: IO Float
getMouseWheelMove :: IO Float
getMouseWheelMove = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getMouseWheelMove

foreign import ccall safe "raylib.h &GetMouseWheelMove"
  p'getMouseWheelMove ::
    FunPtr (IO CFloat)

foreign import ccall safe "bindings.h GetMouseWheelMoveV_" c'getMouseWheelMoveV :: IO (Ptr Raylib.Types.Vector2)

getMouseWheelMoveV :: IO Raylib.Types.Vector2
getMouseWheelMoveV :: IO Vector2
getMouseWheelMoveV = IO (Ptr Vector2)
c'getMouseWheelMoveV forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMouseWheelMoveV"
  p'getMouseWheelMoveV ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h SetMouseCursor"
  c'setMouseCursor ::
    CInt -> IO ()

setMouseCursor :: MouseCursor -> IO ()
setMouseCursor :: MouseCursor -> IO ()
setMouseCursor MouseCursor
cursor = CInt -> IO ()
c'setMouseCursor forall b c a. (b -> c) -> (a -> b) -> a -> 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 MouseCursor
cursor

foreign import ccall safe "raylib.h &SetMouseCursor"
  p'setMouseCursor ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h GetTouchX"
  c'getTouchX ::
    IO CInt

getTouchX :: IO Int
getTouchX :: IO Int
getTouchX = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getTouchX

foreign import ccall safe "raylib.h &GetTouchX"
  p'getTouchX ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetTouchY"
  c'getTouchY ::
    IO CInt

getTouchY :: IO Int
getTouchY :: IO Int
getTouchY = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getTouchY

foreign import ccall safe "raylib.h &GetTouchY"
  p'getTouchY ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h GetTouchPosition_" c'getTouchPosition :: CInt -> IO (Ptr Raylib.Types.Vector2)

getTouchPosition :: Int -> IO Raylib.Types.Vector2
getTouchPosition :: Int -> IO Vector2
getTouchPosition Int
index = CInt -> IO (Ptr Vector2)
c'getTouchPosition (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetTouchPosition"
  p'getTouchPosition ::
    FunPtr (CInt -> IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h GetTouchPointId"
  c'getTouchPointId ::
    CInt -> IO CInt

getTouchPointId :: Int -> IO Int
getTouchPointId :: Int -> IO Int
getTouchPointId Int
index = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CInt
c'getTouchPointId (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)

foreign import ccall safe "raylib.h &GetTouchPointId"
  p'getTouchPointId ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetTouchPointCount"
  c'getTouchPointCount ::
    IO CInt

getTouchPointCount :: IO Int
getTouchPointCount :: IO Int
getTouchPointCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getTouchPointCount

foreign import ccall safe "raylib.h &GetTouchPointCount"
  p'getTouchPointCount ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h SetGesturesEnabled"
  c'setGesturesEnabled ::
    CUInt -> IO ()

setGesturesEnabled :: Integer -> IO ()
setGesturesEnabled :: Integer -> IO ()
setGesturesEnabled Integer
flags = CUInt -> IO ()
c'setGesturesEnabled (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
flags)

foreign import ccall safe "raylib.h &SetGesturesEnabled"
  p'setGesturesEnabled ::
    FunPtr (CUInt -> IO ())

foreign import ccall safe "raylib.h IsGestureDetected"
  c'isGestureDetected ::
    CInt -> IO CBool

isGestureDetected :: Gesture -> IO Bool
isGestureDetected :: Gesture -> IO Bool
isGestureDetected Gesture
gesture = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> IO CBool
c'isGestureDetected (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Gesture
gesture)

foreign import ccall safe "raylib.h &IsGestureDetected"
  p'isGestureDetected ::
    FunPtr (CInt -> IO CInt)

foreign import ccall safe "raylib.h GetGestureDetected"
  c'getGestureDetected ::
    IO CInt

getGestureDetected :: IO Gesture
getGestureDetected :: IO Gesture
getGestureDetected = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getGestureDetected

foreign import ccall safe "raylib.h &GetGestureDetected"
  p'getGestureDetected ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h GetGestureHoldDuration"
  c'getGestureHoldDuration ::
    IO CFloat

getGestureHoldDuration :: IO Float
getGestureHoldDuration :: IO Float
getGestureHoldDuration = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getGestureHoldDuration

foreign import ccall safe "raylib.h &GetGestureHoldDuration"
  p'getGestureHoldDuration ::
    FunPtr (IO CFloat)

foreign import ccall safe "bindings.h GetGestureDragVector_" c'getGestureDragVector :: IO (Ptr Raylib.Types.Vector2)

getGestureDragVector :: IO Raylib.Types.Vector2
getGestureDragVector :: IO Vector2
getGestureDragVector = IO (Ptr Vector2)
c'getGestureDragVector forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetGestureDragVector"
  p'getGestureDragVector ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h GetGestureDragAngle"
  c'getGestureDragAngle ::
    IO CFloat

getGestureDragAngle :: IO Float
getGestureDragAngle :: IO Float
getGestureDragAngle = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getGestureDragAngle

foreign import ccall safe "raylib.h &GetGestureDragAngle"
  p'getGestureDragAngle ::
    FunPtr (IO CFloat)

foreign import ccall safe "bindings.h GetGesturePinchVector_" c'getGesturePinchVector :: IO (Ptr Raylib.Types.Vector2)

getGesturePinchVector :: IO Raylib.Types.Vector2
getGesturePinchVector :: IO Vector2
getGesturePinchVector = IO (Ptr Vector2)
c'getGesturePinchVector forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetGesturePinchVector"
  p'getGesturePinchVector ::
    FunPtr (IO Raylib.Types.Vector2)

foreign import ccall safe "raylib.h GetGesturePinchAngle"
  c'getGesturePinchAngle ::
    IO CFloat

getGesturePinchAngle :: IO Float
getGesturePinchAngle :: IO Float
getGesturePinchAngle = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CFloat
c'getGesturePinchAngle

foreign import ccall safe "raylib.h &GetGesturePinchAngle"
  p'getGesturePinchAngle ::
    FunPtr (IO CFloat)

foreign import ccall safe "bindings.h SetCameraMode_" c'setCameraMode :: Ptr Raylib.Types.Camera3D -> CInt -> IO ()

setCameraMode :: Raylib.Types.Camera3D -> CameraMode -> IO ()
setCameraMode :: Camera3D -> CameraMode -> IO ()
setCameraMode Camera3D
camera CameraMode
mode = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera (\Ptr Camera3D
c -> Ptr Camera3D -> CInt -> IO ()
c'setCameraMode Ptr Camera3D
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 CameraMode
mode))

foreign import ccall safe "raylib.h &SetCameraMode"
  p'setCameraMode ::
    FunPtr (Raylib.Types.Camera3D -> CInt -> IO ())

foreign import ccall safe "raylib.h UpdateCamera"
  c'updateCamera ::
    Ptr Raylib.Types.Camera3D -> IO ()

updateCamera :: Raylib.Types.Camera3D -> IO Raylib.Types.Camera3D
updateCamera :: Camera3D -> IO Camera3D
updateCamera Camera3D
camera =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Camera3D
camera
    ( \Ptr Camera3D
c -> do
        Ptr Camera3D -> IO ()
c'updateCamera Ptr Camera3D
c
        forall a. Storable a => Ptr a -> IO a
peek Ptr Camera3D
c
    )

foreign import ccall safe "raylib.h &UpdateCamera"
  p'updateCamera ::
    FunPtr (Ptr Raylib.Types.Camera3D -> IO ())

foreign import ccall safe "raylib.h SetCameraPanControl"
  c'setCameraPanControl ::
    CInt -> IO ()

setCameraPanControl :: Int -> IO ()
setCameraPanControl :: Int -> IO ()
setCameraPanControl Int
keyPan = CInt -> IO ()
c'setCameraPanControl forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyPan

foreign import ccall safe "raylib.h &SetCameraPanControl"
  p'setCameraPanControl ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h SetCameraAltControl"
  c'setCameraAltControl ::
    CInt -> IO ()

setCameraAltControl :: Int -> IO ()
setCameraAltControl :: Int -> IO ()
setCameraAltControl Int
keyAlt = CInt -> IO ()
c'setCameraAltControl forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyAlt

foreign import ccall safe "raylib.h &SetCameraAltControl"
  p'setCameraAltControl ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h SetCameraSmoothZoomControl"
  c'setCameraSmoothZoomControl ::
    CInt -> IO ()

setCameraSmoothZoomControl :: Int -> IO ()
setCameraSmoothZoomControl :: Int -> IO ()
setCameraSmoothZoomControl Int
keySmoothZoom = CInt -> IO ()
c'setCameraSmoothZoomControl forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keySmoothZoom

foreign import ccall safe "raylib.h &SetCameraSmoothZoomControl"
  p'setCameraSmoothZoomControl ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "raylib.h SetCameraMoveControls"
  c'setCameraMoveControls ::
    CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()

setCameraMoveControls :: Int -> Int -> Int -> Int -> Int -> Int -> IO ()
setCameraMoveControls :: Int -> Int -> Int -> Int -> Int -> Int -> IO ()
setCameraMoveControls Int
keyFront Int
keyBack Int
keyRight Int
keyLeft Int
keyUp Int
keyDown =
  CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
c'setCameraMoveControls
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyFront)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyBack)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyRight)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyLeft)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyUp)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyDown)

foreign import ccall safe "raylib.h &SetCameraMoveControls"
  p'setCameraMoveControls ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h SetShapesTexture_" c'setShapesTexture :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> IO ()

setShapesTexture :: Raylib.Types.Texture -> Raylib.Types.Rectangle -> IO ()
setShapesTexture :: Texture -> Rectangle -> IO ()
setShapesTexture Texture
tex Rectangle
source = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
tex (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Texture -> Ptr Rectangle -> IO ()
c'setShapesTexture)

foreign import ccall safe "raylib.h &SetShapesTexture"
  p'setShapesTexture ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Rectangle -> IO ())

foreign import ccall safe "bindings.h DrawPixel_" c'drawPixel :: CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawPixel :: Int -> Int -> Raylib.Types.Color -> IO ()
drawPixel :: Int -> Int -> Color -> IO ()
drawPixel Int
x Int
y Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Ptr Color -> IO ()
c'drawPixel (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &DrawPixel"
  p'drawPixel ::
    FunPtr (CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawPixelV_" c'drawPixelV :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawPixelV :: Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawPixelV :: Vector2 -> Color -> IO ()
drawPixelV Vector2
position Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Color -> IO ()
c'drawPixelV)

foreign import ccall safe "raylib.h &DrawPixelV"
  p'drawPixelV ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLine_" c'drawLine :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawLine :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO ()
drawLine :: Int -> Int -> Int -> Int -> Color -> IO ()
drawLine Int
startX Int
startY Int
endX Int
endY Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endY)

foreign import ccall safe "raylib.h &DrawLine"
  p'drawLine ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineV_" c'drawLineV :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawLineV :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawLineV :: Vector2 -> Vector2 -> Color -> IO ()
drawLineV Vector2
start Vector2
end Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start (\Ptr Vector2
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawLineV Ptr Vector2
s))

foreign import ccall safe "raylib.h &DrawLineV"
  p'drawLineV ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineEx_" c'drawLineEx :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawLineEx :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawLineEx :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineEx Vector2
start Vector2
end Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start (\Ptr Vector2
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end (\Ptr Vector2
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawLineEx Ptr Vector2
s Ptr Vector2
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

foreign import ccall safe "raylib.h &DrawLineEx"
  p'drawLineEx ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineBezier_" c'drawLineBezier :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawLineBezier :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezier Vector2
start Vector2
end Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start (\Ptr Vector2
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end (\Ptr Vector2
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawLineBezier Ptr Vector2
s Ptr Vector2
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

foreign import ccall safe "raylib.h &DrawLineBezier"
  p'drawLineBezier ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineBezierQuad_" c'drawLineBezierQuad :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawLineBezierQuad :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawLineBezierQuad :: Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierQuad Vector2
start Vector2
end Vector2
control Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start (\Ptr Vector2
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end (\Ptr Vector2
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
control (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector2
-> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawLineBezierQuad Ptr Vector2
s Ptr Vector2
e Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)))))

foreign import ccall safe "raylib.h &DrawLineBezierQuad"
  p'drawLineBezierQuad ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineBezierCubic_" c'drawLineBezierCubic :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawLineBezierCubic :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawLineBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierCubic Vector2
start Vector2
end Vector2
startControl Vector2
endControl Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
start
    ( \Ptr Vector2
s ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Vector2
end
          ( \Ptr Vector2
e ->
              forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
                Vector2
startControl
                ( \Ptr Vector2
sc ->
                    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
                      Vector2
endControl
                      ( \Ptr Vector2
ec ->
                          forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
                            Color
color
                            ( Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawLineBezierCubic Ptr Vector2
s Ptr Vector2
e Ptr Vector2
sc Ptr Vector2
ec (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)
                            )
                      )
                )
          )
    )

foreign import ccall safe "raylib.h &DrawLineBezierCubic"
  p'drawLineBezierCubic ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawLineStrip_" c'drawLineStrip :: Ptr Raylib.Types.Vector2 -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawLineStrip :: [Raylib.Types.Vector2] -> Raylib.Types.Color -> IO ()
drawLineStrip :: [Vector2] -> Color -> IO ()
drawLineStrip [Vector2]
points Color
color = forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Vector2]
points (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawLineStrip Ptr Vector2
p (forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

foreign import ccall safe "raylib.h &DrawLineStrip"
  p'drawLineStrip ::
    FunPtr (Ptr Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircle_" c'drawCircle :: CInt -> CInt -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCircle :: Int -> Int -> Float -> Raylib.Types.Color -> IO ()
drawCircle :: Int -> Int -> Float -> Color -> IO ()
drawCircle Int
centerX Int
centerY Float
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawCircle (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. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

foreign import ccall safe "raylib.h &DrawCircle"
  p'drawCircle ::
    FunPtr (CInt -> CInt -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircleSector_" c'drawCircleSector :: Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCircleSector :: Raylib.Types.Vector2 -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCircleSector :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSector Vector2
center Float
radius Float
startAngle Float
endAngle Int
segments Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Color
color
          ( Ptr Vector2
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCircleSector Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

foreign import ccall safe "raylib.h &DrawCircleSector"
  p'drawCircleSector ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircleSectorLines_" c'drawCircleSectorLines :: Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCircleSectorLines :: Raylib.Types.Vector2 -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCircleSectorLines :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSectorLines Vector2
center Float
radius Float
startAngle Float
endAngle Int
segments Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Color
color
          ( Ptr Vector2
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCircleSectorLines Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

foreign import ccall safe "raylib.h &DrawCircleSectorLines"
  p'drawCircleSectorLines ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircleGradient_" c'drawCircleGradient :: CInt -> CInt -> CFloat -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO ()

drawCircleGradient :: Int -> Int -> Float -> Raylib.Types.Color -> Raylib.Types.Color -> IO ()
drawCircleGradient :: Int -> Int -> Float -> Color -> Color -> IO ()
drawCircleGradient Int
centerX Int
centerY Float
radius Color
color1 Color
color2 =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color1 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CFloat -> Ptr Color -> Ptr Color -> IO ()
c'drawCircleGradient (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. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

foreign import ccall safe "raylib.h &DrawCircleGradient"
  p'drawCircleGradient ::
    FunPtr (CInt -> CInt -> CFloat -> Raylib.Types.Color -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircleV_" c'drawCircleV :: Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCircleV :: Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawCircleV :: Vector2 -> Float -> Color -> IO ()
drawCircleV Vector2
center Float
radius Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawCircleV Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

foreign import ccall safe "raylib.h &DrawCircleV"
  p'drawCircleV ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircleLines_" c'drawCircleLines :: CInt -> CInt -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCircleLines :: Int -> Int -> Float -> Raylib.Types.Color -> IO ()
drawCircleLines :: Int -> Int -> Float -> Color -> IO ()
drawCircleLines Int
centerX Int
centerY Float
radius Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawCircleLines (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. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

foreign import ccall safe "raylib.h &DrawCircleLines"
  p'drawCircleLines ::
    FunPtr (CInt -> CInt -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawEllipse_" c'drawEllipse :: CInt -> CInt -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawEllipse :: Int -> Int -> Float -> Float -> Raylib.Types.Color -> IO ()
drawEllipse :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipse Int
centerX Int
centerY Float
radiusH Float
radiusV Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawEllipse (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. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusV))

foreign import ccall safe "raylib.h &DrawEllipse"
  p'drawEllipse ::
    FunPtr (CInt -> CInt -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawEllipseLines_" c'drawEllipseLines :: CInt -> CInt -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawEllipseLines :: Int -> Int -> Float -> Float -> Raylib.Types.Color -> IO ()
drawEllipseLines :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipseLines Int
centerX Int
centerY Float
radiusH Float
radiusV Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawEllipseLines (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. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusV))

foreign import ccall safe "raylib.h &DrawEllipseLines"
  p'drawEllipseLines ::
    FunPtr (CInt -> CInt -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRing_" c'drawRing :: Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawRing :: Raylib.Types.Vector2 -> Float -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawRing :: Vector2
-> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRing Vector2
center Float
innerRadius Float
outerRadius Float
startAngle Float
endAngle Int
segments Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Color
color
          ( Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CInt
-> Ptr Color
-> IO ()
c'drawRing
              Ptr Vector2
c
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

foreign import ccall safe "raylib.h &DrawRing"
  p'drawRing ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRingLines_" c'drawRingLines :: Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawRingLines :: Raylib.Types.Vector2 -> Float -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawRingLines :: Vector2
-> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRingLines Vector2
center Float
innerRadius Float
outerRadius Float
startAngle Float
endAngle Int
segments Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Color
color
          ( Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CInt
-> Ptr Color
-> IO ()
c'drawRingLines
              Ptr Vector2
c
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

foreign import ccall safe "raylib.h &DrawRingLines"
  p'drawRingLines ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangle_" c'drawRectangle :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawRectangle :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO ()
drawRectangle :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangle Int
posX Int
posY Int
width Int
height Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawRectangle (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))

foreign import ccall safe "raylib.h &DrawRectangle"
  p'drawRectangle ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleV_" c'drawRectangleV :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawRectangleV :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawRectangleV :: Vector2 -> Vector2 -> Color -> IO ()
drawRectangleV Vector2
position Vector2
size Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawRectangleV Ptr Vector2
p))

foreign import ccall safe "raylib.h &DrawRectangleV"
  p'drawRectangleV ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleRec_" c'drawRectangleRec :: Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Color -> IO ()

drawRectangleRec :: Raylib.Types.Rectangle -> Raylib.Types.Color -> IO ()
drawRectangleRec :: Rectangle -> Color -> IO ()
drawRectangleRec Rectangle
rect Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Color -> IO ()
c'drawRectangleRec)

foreign import ccall safe "raylib.h &DrawRectangleRec"
  p'drawRectangleRec ::
    FunPtr (Raylib.Types.Rectangle -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectanglePro_" c'drawRectanglePro :: Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawRectanglePro :: Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawRectanglePro :: Rectangle -> Vector2 -> Float -> Color -> IO ()
drawRectanglePro Rectangle
rect Vector2
origin Float
rotation Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (\Ptr Color
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (\Ptr Rectangle
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
origin (\Ptr Vector2
o -> Ptr Rectangle -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawRectanglePro Ptr Rectangle
r Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation) Ptr Color
c)))

foreign import ccall safe "raylib.h &DrawRectanglePro"
  p'drawRectanglePro ::
    FunPtr (Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleGradientV_" c'drawRectangleGradientV :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO ()

drawRectangleGradientV :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> Raylib.Types.Color -> IO ()
drawRectangleGradientV :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientV Int
posX Int
posY Int
width Int
height Color
color1 Color
color2 =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Color
color1
    ( forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color2
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientV
          (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)
    )

foreign import ccall safe "raylib.h &DrawRectangleGradientV"
  p'drawRectangleGradientV ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleGradientH_" c'drawRectangleGradientH :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO ()

drawRectangleGradientH :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> Raylib.Types.Color -> IO ()
drawRectangleGradientH :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientH Int
posX Int
posY Int
width Int
height Color
color1 Color
color2 =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Color
color1
    ( forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color2
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientH
          (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)
    )

foreign import ccall safe "raylib.h &DrawRectangleGradientH"
  p'drawRectangleGradientH ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleGradientEx_" c'drawRectangleGradientEx :: Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO ()

drawRectangleGradientEx :: Raylib.Types.Rectangle -> Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> IO ()
drawRectangleGradientEx :: Rectangle -> Color -> Color -> Color -> Color -> IO ()
drawRectangleGradientEx Rectangle
rect Color
col1 Color
col2 Color
col3 Color
col4 =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Rectangle
rect
    ( \Ptr Rectangle
r ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Color
col1
          ( \Ptr Color
c1 ->
              forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
                Color
col2
                ( \Ptr Color
c2 ->
                    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
col3 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
col4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle
-> Ptr Color -> Ptr Color -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientEx Ptr Rectangle
r Ptr Color
c1 Ptr Color
c2)
                )
          )
    )

foreign import ccall safe "raylib.h &DrawRectangleGradientEx"
  p'drawRectangleGradientEx ::
    FunPtr (Raylib.Types.Rectangle -> Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleLines_" c'drawRectangleLines :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawRectangleLines :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO ()
drawRectangleLines :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangleLines Int
posX Int
posY Int
width Int
height Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawRectangleLines (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))

foreign import ccall safe "raylib.h &DrawRectangleLines"
  p'drawRectangleLines ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleLinesEx_" c'drawRectangleLinesEx :: Ptr Raylib.Types.Rectangle -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawRectangleLinesEx :: Raylib.Types.Rectangle -> Float -> Raylib.Types.Color -> IO ()
drawRectangleLinesEx :: Rectangle -> Float -> Color -> IO ()
drawRectangleLinesEx Rectangle
rect Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (\Ptr Color
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (\Ptr Rectangle
r -> Ptr Rectangle -> CFloat -> Ptr Color -> IO ()
c'drawRectangleLinesEx Ptr Rectangle
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness) Ptr Color
c))

foreign import ccall safe "raylib.h &DrawRectangleLinesEx"
  p'drawRectangleLinesEx ::
    FunPtr (Raylib.Types.Rectangle -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleRounded_" c'drawRectangleRounded :: Ptr Raylib.Types.Rectangle -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawRectangleRounded :: Raylib.Types.Rectangle -> Float -> Int -> Raylib.Types.Color -> IO ()
drawRectangleRounded :: Rectangle -> Float -> Int -> Color -> IO ()
drawRectangleRounded Rectangle
rect Float
roundness Int
segments Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (\Ptr Rectangle
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawRectangleRounded Ptr Rectangle
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments))

foreign import ccall safe "raylib.h &DrawRectangleRounded"
  p'drawRectangleRounded ::
    FunPtr (Raylib.Types.Rectangle -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRectangleRoundedLines_" c'drawRectangleRoundedLines :: Ptr Raylib.Types.Rectangle -> CFloat -> CInt -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawRectangleRoundedLines :: Raylib.Types.Rectangle -> Float -> Int -> Float -> Raylib.Types.Color -> IO ()
drawRectangleRoundedLines :: Rectangle -> Float -> Int -> Float -> Color -> IO ()
drawRectangleRoundedLines Rectangle
rect Float
roundness Int
segments Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (\Ptr Rectangle
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawRectangleRoundedLines Ptr Rectangle
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))

foreign import ccall safe "raylib.h &DrawRectangleRoundedLines"
  p'drawRectangleRoundedLines ::
    FunPtr (Raylib.Types.Rectangle -> CFloat -> CInt -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangle_" c'drawTriangle :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawTriangle :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawTriangle :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangle Vector2
v1 Vector2
v2 Vector2
v3 Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Vector2
v2
          ( \Ptr Vector2
p2 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
v3 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTriangle Ptr Vector2
p1 Ptr Vector2
p2)
          )
    )

foreign import ccall safe "raylib.h &DrawTriangle"
  p'drawTriangle ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangleLines_" c'drawTriangleLines :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawTriangleLines :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawTriangleLines :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangleLines Vector2
v1 Vector2
v2 Vector2
v3 Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          Vector2
v2
          ( \Ptr Vector2
p2 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
v3 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTriangleLines Ptr Vector2
p1 Ptr Vector2
p2)
          )
    )

foreign import ccall safe "raylib.h &DrawTriangleLines"
  p'drawTriangleLines ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangleFan_" c'drawTriangleFan :: Ptr Raylib.Types.Vector2 -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawTriangleFan :: [Raylib.Types.Vector2] -> Raylib.Types.Color -> IO ()
drawTriangleFan :: [Vector2] -> Color -> IO ()
drawTriangleFan [Vector2]
points Color
color = forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Vector2]
points (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleFan Ptr Vector2
p (forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

foreign import ccall safe "raylib.h &DrawTriangleFan"
  p'drawTriangleFan ::
    FunPtr (Ptr Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangleStrip_" c'drawTriangleStrip :: Ptr Raylib.Types.Vector2 -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawTriangleStrip :: [Raylib.Types.Vector2] -> Raylib.Types.Color -> IO ()
drawTriangleStrip :: [Vector2] -> Color -> IO ()
drawTriangleStrip [Vector2]
points Color
color =
  forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Vector2]
points (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleStrip Ptr Vector2
p (forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

foreign import ccall safe "raylib.h &DrawTriangleStrip"
  p'drawTriangleStrip ::
    FunPtr (Ptr Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawPoly_" c'drawPoly :: Ptr Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawPoly :: Raylib.Types.Vector2 -> Int -> Float -> Float -> Raylib.Types.Color -> IO ()
drawPoly :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPoly Vector2
center Int
sides Float
radius Float
rotation Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPoly Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))

foreign import ccall safe "raylib.h &DrawPoly"
  p'drawPoly ::
    FunPtr (Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawPolyLines_" c'drawPolyLines :: Ptr Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawPolyLines :: Raylib.Types.Vector2 -> Int -> Float -> Float -> Raylib.Types.Color -> IO ()
drawPolyLines :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPolyLines Vector2
center Int
sides Float
radius Float
rotation Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLines Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))

foreign import ccall safe "raylib.h &DrawPolyLines"
  p'drawPolyLines ::
    FunPtr (Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawPolyLinesEx_" c'drawPolyLinesEx :: Ptr Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawPolyLinesEx :: Raylib.Types.Vector2 -> Int -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawPolyLinesEx :: Vector2 -> Int -> Float -> Float -> Float -> Color -> IO ()
drawPolyLinesEx Vector2
center Int
sides Float
radius Float
rotation Float
thickness Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall a b. (a -> b) -> a -> b
$
          Ptr Vector2
-> CInt -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLinesEx
            Ptr Vector2
c
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)
    )

foreign import ccall safe "raylib.h &DrawPolyLinesEx"
  p'drawPolyLinesEx ::
    FunPtr (Raylib.Types.Vector2 -> CInt -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h CheckCollisionRecs_" c'checkCollisionRecs :: Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Rectangle -> IO CBool

checkCollisionRecs :: Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Bool
checkCollisionRecs :: Rectangle -> Rectangle -> Bool
checkCollisionRecs Rectangle
rec1 Rectangle
rec2 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rec1 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rec2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Rectangle -> IO CBool
c'checkCollisionRecs)

foreign import ccall safe "raylib.h &CheckCollisionRecs"
  p'checkCollisionRecs ::
    FunPtr (Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionCircles_" c'checkCollisionCircles :: Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Vector2 -> CFloat -> IO CBool

checkCollisionCircles :: Raylib.Types.Vector2 -> Float -> Raylib.Types.Vector2 -> Float -> Bool
checkCollisionCircles :: Vector2 -> Float -> Vector2 -> Float -> Bool
checkCollisionCircles Vector2
center1 Float
radius1 Vector2
center2 Float
radius2 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center1 (\Ptr Vector2
c1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center2 (\Ptr Vector2
c2 -> Ptr Vector2 -> CFloat -> Ptr Vector2 -> CFloat -> IO CBool
c'checkCollisionCircles Ptr Vector2
c1 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius1) Ptr Vector2
c2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius2)))

foreign import ccall safe "raylib.h &CheckCollisionCircles"
  p'checkCollisionCircles ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Vector2 -> CFloat -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionCircleRec_" c'checkCollisionCircleRec :: Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Rectangle -> IO CBool

checkCollisionCircleRec :: Raylib.Types.Vector2 -> Float -> Raylib.Types.Rectangle -> Bool
checkCollisionCircleRec :: Vector2 -> Float -> Rectangle -> Bool
checkCollisionCircleRec Vector2
center Float
radius Rectangle
rect =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CFloat -> Ptr Rectangle -> IO CBool
c'checkCollisionCircleRec Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

foreign import ccall safe "raylib.h &CheckCollisionCircleRec"
  p'checkCollisionCircleRec ::
    FunPtr (Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Rectangle -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionPointRec_" c'checkCollisionPointRec :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Rectangle -> IO CBool

checkCollisionPointRec :: Raylib.Types.Vector2 -> Raylib.Types.Rectangle -> Bool
checkCollisionPointRec :: Vector2 -> Rectangle -> Bool
checkCollisionPointRec Vector2
point Rectangle
rect =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
point (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Rectangle -> IO CBool
c'checkCollisionPointRec)

foreign import ccall safe "raylib.h &CheckCollisionPointRec"
  p'checkCollisionPointRec ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Rectangle -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionPointCircle_" c'checkCollisionPointCircle :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> IO CBool

checkCollisionPointCircle :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Bool
checkCollisionPointCircle :: Vector2 -> Vector2 -> Float -> Bool
checkCollisionPointCircle Vector2
point Vector2
center Float
radius =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
point (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO CBool
c'checkCollisionPointCircle Ptr Vector2
p Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

foreign import ccall safe "raylib.h &CheckCollisionPointCircle"
  p'checkCollisionPointCircle ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionPointTriangle_" c'checkCollisionPointTriangle :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> IO CBool

checkCollisionPointTriangle :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Bool
checkCollisionPointTriangle :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Bool
checkCollisionPointTriangle Vector2
point Vector2
p1 Vector2
p2 Vector2
p3 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
point (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
p1 (\Ptr Vector2
ptr1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
p2 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
p3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2
-> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> IO CBool
c'checkCollisionPointTriangle Ptr Vector2
p Ptr Vector2
ptr1)))

foreign import ccall safe "raylib.h &CheckCollisionPointTriangle"
  p'checkCollisionPointTriangle ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionLines_" c'checkCollisionLines :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> IO CBool

-- | If a collision is found, returns @Just collisionPoint@, otherwise returns @Nothing@

checkCollisionLines :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Maybe Raylib.Types.Vector2
checkCollisionLines :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Maybe Vector2
checkCollisionLines Vector2
start1 Vector2
end1 Vector2
start2 Vector2
end2 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
      (CFloat -> CFloat -> Vector2
Raylib.Types.Vector2 CFloat
0 CFloat
0)
      ( \Ptr Vector2
res -> do
          Bool
foundCollision <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start1 (\Ptr Vector2
s1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end1 (\Ptr Vector2
e1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start2 (\Ptr Vector2
s2 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end2 (\Ptr Vector2
e2 -> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> IO CBool
c'checkCollisionLines Ptr Vector2
s1 Ptr Vector2
e1 Ptr Vector2
s2 Ptr Vector2
e2 Ptr Vector2
res))))
          if Bool
foundCollision then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Vector2
res else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      )

foreign import ccall safe "raylib.h &CheckCollisionLines"
  p'checkCollisionLines ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionPointLine_" c'checkCollisionPointLine :: Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CInt -> IO CBool

checkCollisionPointLine :: Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Int -> Bool
checkCollisionPointLine :: Vector2 -> Vector2 -> Vector2 -> Int -> Bool
checkCollisionPointLine Vector2
point Vector2
p1 Vector2
p2 Int
threshold =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
point (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
p1 (\Ptr Vector2
ptr1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
p2 (\Ptr Vector2
ptr2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CInt -> IO CBool
c'checkCollisionPointLine Ptr Vector2
p Ptr Vector2
ptr1 Ptr Vector2
ptr2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
threshold))))

foreign import ccall safe "raylib.h &CheckCollisionPointLine"
  p'checkCollisionPointLine ::
    FunPtr (Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CInt -> IO CInt)

foreign import ccall safe "bindings.h GetCollisionRec_" c'getCollisionRec :: Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Rectangle -> IO (Ptr Raylib.Types.Rectangle)

getCollisionRec :: Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Raylib.Types.Rectangle
getCollisionRec :: Rectangle -> Rectangle -> Rectangle
getCollisionRec Rectangle
rec1 Rectangle
rec2 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rec1 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rec2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Rectangle -> IO (Ptr Rectangle)
c'getCollisionRec) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetCollisionRec"
  p'getCollisionRec ::
    FunPtr (Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> IO Raylib.Types.Rectangle)

foreign import ccall safe "bindings.h LoadImage_" c'loadImage :: CString -> IO (Ptr Raylib.Types.Image)

loadImage :: String -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadImage"
  p'loadImage ::
    FunPtr (CString -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h LoadImageRaw_" c'loadImageRaw :: CString -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Raylib.Types.Image)

loadImageRaw :: String -> Int -> Int -> Int -> Int -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadImageRaw"
  p'loadImageRaw ::
    FunPtr (CString -> CInt -> CInt -> CInt -> CInt -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h LoadImageAnim_" c'loadImageAnim :: CString -> Ptr CInt -> IO (Ptr Raylib.Types.Image)

-- | Returns the final image and the framees in a tuple, e.g. @(img, 18)@

loadImageAnim :: String -> IO (Raylib.Types.Image, Int)
loadImageAnim :: String -> IO (Image, Int)
loadImageAnim String
fileName =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    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. 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)
          )
    )

foreign import ccall safe "raylib.h &LoadImageAnim"
  p'loadImageAnim ::
    FunPtr (CString -> Ptr CInt -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h LoadImageFromMemory_" c'loadImageFromMemory :: CString -> Ptr CUChar -> CInt -> IO (Ptr Raylib.Types.Image)

loadImageFromMemory :: String -> [Integer] -> IO Raylib.Types.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. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadImageFromMemory"
  p'loadImageFromMemory ::
    FunPtr (CString -> Ptr CUChar -> CInt -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h LoadImageFromTexture_" c'loadImageFromTexture :: Ptr Raylib.Types.Texture -> IO (Ptr Raylib.Types.Image)

loadImageFromTexture :: Raylib.Types.Texture -> IO Raylib.Types.Image
loadImageFromTexture :: Texture -> IO Image
loadImageFromTexture Texture
tex = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
tex Ptr Texture -> IO (Ptr Image)
c'loadImageFromTexture forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadImageFromTexture"
  p'loadImageFromTexture ::
    FunPtr (Raylib.Types.Texture -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h LoadImageFromScreen_" c'loadImageFromScreen :: IO (Ptr Raylib.Types.Image)

loadImageFromScreen :: IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadImageFromScreen"
  p'loadImageFromScreen ::
    FunPtr (IO Raylib.Types.Image)

foreign import ccall safe "bindings.h UnloadImage_" c'unloadImage :: Ptr Raylib.Types.Image -> IO ()

unloadImage :: Raylib.Types.Image -> IO ()
unloadImage :: Image -> IO ()
unloadImage Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image Ptr Image -> IO ()
c'unloadImage

foreign import ccall safe "raylib.h &UnloadImage"
  p'unloadImage ::
    FunPtr (Raylib.Types.Image -> IO ())

foreign import ccall safe "bindings.h ExportImage_" c'exportImage :: Ptr Raylib.Types.Image -> CString -> IO CBool

exportImage :: Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ExportImage"
  p'exportImage ::
    FunPtr (Raylib.Types.Image -> CString -> IO CInt)

foreign import ccall safe "bindings.h ExportImageAsCode_" c'exportImageAsCode :: Ptr Raylib.Types.Image -> CString -> IO CBool

exportImageAsCode :: Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ExportImageAsCode"
  p'exportImageAsCode ::
    FunPtr (Raylib.Types.Image -> CString -> IO CInt)

foreign import ccall safe "bindings.h GenImageColor_" c'genImageColor :: CInt -> CInt -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

genImageColor :: Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
genImageColor :: Int -> Int -> Color -> IO Image
genImageColor Int
width Int
height Color
color =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageColor"
  p'genImageColor ::
    FunPtr (CInt -> CInt -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageGradientV_" c'genImageGradientV :: CInt -> CInt -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

genImageGradientV :: Int -> Int -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image
genImageGradientV :: Int -> Int -> Color -> Color -> IO Image
genImageGradientV Int
width Int
height Color
top Color
bottom =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
top (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageGradientV"
  p'genImageGradientV ::
    FunPtr (CInt -> CInt -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageGradientH_" c'genImageGradientH :: CInt -> CInt -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

genImageGradientH :: Int -> Int -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image
genImageGradientH :: Int -> Int -> Color -> Color -> IO Image
genImageGradientH Int
width Int
height Color
left Color
right =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
left (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageGradientH"
  p'genImageGradientH ::
    FunPtr (CInt -> CInt -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageGradientRadial_" c'genImageGradientRadial :: CInt -> CInt -> CFloat -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

genImageGradientRadial :: Int -> Int -> Float -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image
genImageGradientRadial :: Int -> Int -> Float -> Color -> Color -> IO Image
genImageGradientRadial Int
width Int
height Float
density Color
inner Color
outer =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
inner (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageGradientRadial"
  p'genImageGradientRadial ::
    FunPtr (CInt -> CInt -> CFloat -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageChecked_" c'genImageChecked :: CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

genImageChecked :: Int -> Int -> Int -> Int -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
col1 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageChecked"
  p'genImageChecked ::
    FunPtr (CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageWhiteNoise_" c'genImageWhiteNoise :: CInt -> CInt -> CFloat -> IO (Ptr Raylib.Types.Image)

genImageWhiteNoise :: Int -> Int -> Float -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageWhiteNoise"
  p'genImageWhiteNoise ::
    FunPtr (CInt -> CInt -> CFloat -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImagePerlinNoise_" c'genImagePerlinNoise :: CInt -> CInt -> CInt -> CInt -> CFloat -> IO (Ptr Raylib.Types.Image)

genImagePerlinNoise :: Int -> Int -> Int -> Int -> Float -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImagePerlinNoise" p'genImagePerlinNoise :: FunPtr (CInt -> CInt -> CInt -> CInt -> CFloat -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageCellular_" c'genImageCellular :: CInt -> CInt -> CInt -> IO (Ptr Raylib.Types.Image)

genImageCellular :: Int -> Int -> Int -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageCellular"
  p'genImageCellular ::
    FunPtr (CInt -> CInt -> CInt -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h GenImageText_" c'genImageText :: CInt -> CInt -> CString -> IO (Ptr Raylib.Types.Image)

genImageText :: Int -> Int -> String -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageText"
  p'genImageText ::
    FunPtr (CInt -> CInt -> CString -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h ImageCopy_" c'imageCopy :: Ptr Raylib.Types.Image -> IO (Ptr Raylib.Types.Image)

imageCopy :: Raylib.Types.Image -> IO Raylib.Types.Image
imageCopy :: Image -> IO Image
imageCopy Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image Ptr Image -> IO (Ptr Image)
c'imageCopy forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ImageCopy"
  p'imageCopy ::
    FunPtr (Raylib.Types.Image -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h ImageFromImage_" c'imageFromImage :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Rectangle -> IO (Ptr Raylib.Types.Image)

imageFromImage :: Raylib.Types.Image -> Raylib.Types.Rectangle -> IO Raylib.Types.Image
imageFromImage :: Image -> Rectangle -> IO Image
imageFromImage Image
image Rectangle
rect = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ImageFromImage"
  p'imageFromImage ::
    FunPtr (Raylib.Types.Image -> Raylib.Types.Rectangle -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h ImageText_" c'imageText :: CString -> CInt -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

imageText :: String -> Int -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ImageText"
  p'imageText ::
    FunPtr (CString -> CInt -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "bindings.h ImageTextEx_" c'imageTextEx :: Ptr Raylib.Types.Font -> CString -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Image)

imageTextEx :: Raylib.Types.Font -> String -> Float -> Float -> Raylib.Types.Color -> IO Raylib.Types.Image
imageTextEx :: Font -> String -> Float -> Float -> Color -> IO Image
imageTextEx Font
font String
text Float
fontSize Float
spacing Color
tint =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ImageTextEx"
  p'imageTextEx ::
    FunPtr (Raylib.Types.Font -> CString -> CFloat -> CFloat -> Raylib.Types.Color -> IO Raylib.Types.Image)

foreign import ccall safe "raylib.h ImageFormat"
  c'imageFormat ::
    Ptr Raylib.Types.Image -> CInt -> IO ()

imageFormat :: Raylib.Types.Image -> PixelFormat -> IO Raylib.Types.Image
imageFormat :: Image -> PixelFormat -> IO Image
imageFormat Image
image PixelFormat
newFormat =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageFormat"
  p'imageFormat ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> IO ())

foreign import ccall safe "bindings.h ImageToPOT_" c'imageToPOT :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> IO ()

imageToPOT :: Raylib.Types.Image -> Raylib.Types.Color -> IO Raylib.Types.Image
imageToPOT :: Image -> Color -> IO Image
imageToPOT Image
image Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageToPOT"
  p'imageToPOT ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageCrop_" c'imageCrop :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Rectangle -> IO ()

imageCrop :: Raylib.Types.Image -> Raylib.Types.Rectangle -> IO Raylib.Types.Image
imageCrop :: Image -> Rectangle -> IO Image
imageCrop Image
image Rectangle
crop = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageCrop"
  p'imageCrop ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Rectangle -> IO ())

foreign import ccall safe "raylib.h ImageAlphaCrop"
  c'imageAlphaCrop ::
    Ptr Raylib.Types.Image -> CFloat -> IO ()

imageAlphaCrop :: Raylib.Types.Image -> Float -> IO Raylib.Types.Image
imageAlphaCrop :: Image -> Float -> IO Image
imageAlphaCrop Image
image Float
threshold = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageAlphaCrop"
  p'imageAlphaCrop ::
    FunPtr (Ptr Raylib.Types.Image -> CFloat -> IO ())

foreign import ccall safe "bindings.h ImageAlphaClear_" c'imageAlphaClear :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> CFloat -> IO ()

imageAlphaClear :: Raylib.Types.Image -> Raylib.Types.Color -> Float -> IO Raylib.Types.Image
imageAlphaClear :: Image -> Color -> Float -> IO Image
imageAlphaClear Image
image Color
color Float
threshold = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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))

foreign import ccall safe "raylib.h &ImageAlphaClear"
  p'imageAlphaClear ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Color -> CFloat -> IO ())

foreign import ccall safe "bindings.h ImageAlphaMask_" c'imageAlphaMask :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Image -> IO ()

imageAlphaMask :: Raylib.Types.Image -> Raylib.Types.Image -> IO Raylib.Types.Image
imageAlphaMask :: Image -> Image -> IO Image
imageAlphaMask Image
image Image
alphaMask = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageAlphaMask"
  p'imageAlphaMask ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageAlphaPremultiply"
  c'imageAlphaPremultiply ::
    Ptr Raylib.Types.Image -> IO ()

imageAlphaPremultiply :: Raylib.Types.Image -> IO Raylib.Types.Image
imageAlphaPremultiply :: Image -> IO Image
imageAlphaPremultiply Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageAlphaPremultiply"
  p'imageAlphaPremultiply ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())


foreign import ccall safe "raylib.h ImageBlurGaussian"
  c'imageBlurGaussian ::
    Ptr Raylib.Types.Image -> CInt -> IO ()

imageBlurGaussian :: Raylib.Types.Image -> Int -> IO Raylib.Types.Image
imageBlurGaussian :: Image -> Int -> IO Image
imageBlurGaussian Image
image Int
blurSize = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageBlurGaussian"
  p'imageBlurGaussian ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> IO ())

foreign import ccall safe "raylib.h ImageResize"
  c'imageResize ::
    Ptr Raylib.Types.Image -> CInt -> CInt -> IO ()

imageResize :: Raylib.Types.Image -> Int -> Int -> IO Raylib.Types.Image
imageResize :: Image -> Int -> Int -> IO Image
imageResize Image
image Int
newWidth Int
newHeight = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageResize"
  p'imageResize ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h ImageResizeNN"
  c'imageResizeNN ::
    Ptr Raylib.Types.Image -> CInt -> CInt -> IO ()

imageResizeNN :: Raylib.Types.Image -> Int -> Int -> IO Raylib.Types.Image
imageResizeNN :: Image -> Int -> Int -> IO Image
imageResizeNN Image
image Int
newWidth Int
newHeight = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageResizeNN"
  p'imageResizeNN ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h ImageResizeCanvas_" c'imageResizeCanvas :: Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageResizeCanvas :: Raylib.Types.Image -> Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageResizeCanvas"
  p'imageResizeCanvas ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h ImageMipmaps"
  c'imageMipmaps ::
    Ptr Raylib.Types.Image -> IO ()

imageMipmaps :: Raylib.Types.Image -> IO Raylib.Types.Image
imageMipmaps :: Image -> IO Image
imageMipmaps Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageMipmaps"
  p'imageMipmaps ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageDither"
  c'imageDither ::
    Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> IO ()

imageDither :: Raylib.Types.Image -> Int -> Int -> Int -> Int -> IO Raylib.Types.Image
imageDither :: Image -> Int -> Int -> Int -> Int -> IO Image
imageDither Image
image Int
rBpp Int
gBpp Int
bBpp Int
aBpp = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDither"
  p'imageDither ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h ImageFlipVertical"
  c'imageFlipVertical ::
    Ptr Raylib.Types.Image -> IO ()

imageFlipVertical :: Raylib.Types.Image -> IO Raylib.Types.Image
imageFlipVertical :: Image -> IO Image
imageFlipVertical Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageFlipVertical"
  p'imageFlipVertical ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageFlipHorizontal"
  c'imageFlipHorizontal ::
    Ptr Raylib.Types.Image -> IO ()

imageFlipHorizontal :: Raylib.Types.Image -> IO Raylib.Types.Image
imageFlipHorizontal :: Image -> IO Image
imageFlipHorizontal Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageFlipHorizontal"
  p'imageFlipHorizontal ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageRotateCW"
  c'imageRotateCW ::
    Ptr Raylib.Types.Image -> IO ()

imageRotateCW :: Raylib.Types.Image -> IO Raylib.Types.Image
imageRotateCW :: Image -> IO Image
imageRotateCW Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageRotateCW"
  p'imageRotateCW ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageRotateCCW"
  c'imageRotateCCW ::
    Ptr Raylib.Types.Image -> IO ()

imageRotateCCW :: Raylib.Types.Image -> IO Raylib.Types.Image
imageRotateCCW :: Image -> IO Image
imageRotateCCW Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageRotateCCW"
  p'imageRotateCCW ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "bindings.h ImageColorTint_" c'imageColorTint :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> IO ()

imageColorTint :: Raylib.Types.Image -> Raylib.Types.Color -> IO Raylib.Types.Image
imageColorTint :: Image -> Color -> IO Image
imageColorTint Image
image Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorTint"
  p'imageColorTint ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h ImageColorInvert"
  c'imageColorInvert ::
    Ptr Raylib.Types.Image -> IO ()

imageColorInvert :: Raylib.Types.Image -> IO Raylib.Types.Image
imageColorInvert :: Image -> IO Image
imageColorInvert Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorInvert"
  p'imageColorInvert ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageColorGrayscale"
  c'imageColorGrayscale ::
    Ptr Raylib.Types.Image -> IO ()

imageColorGrayscale :: Raylib.Types.Image -> IO Raylib.Types.Image
imageColorGrayscale :: Image -> IO Image
imageColorGrayscale Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorGrayscale"
  p'imageColorGrayscale ::
    FunPtr (Ptr Raylib.Types.Image -> IO ())

foreign import ccall safe "raylib.h ImageColorContrast"
  c'imageColorContrast ::
    Ptr Raylib.Types.Image -> CFloat -> IO ()

imageColorContrast :: Raylib.Types.Image -> Float -> IO Raylib.Types.Image
imageColorContrast :: Image -> Float -> IO Image
imageColorContrast Image
image Float
contrast = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorContrast"
  p'imageColorContrast ::
    FunPtr (Ptr Raylib.Types.Image -> CFloat -> IO ())

foreign import ccall safe "raylib.h ImageColorBrightness"
  c'imageColorBrightness ::
    Ptr Raylib.Types.Image -> CInt -> IO ()

imageColorBrightness :: Raylib.Types.Image -> Int -> IO Raylib.Types.Image
imageColorBrightness :: Image -> Int -> IO Image
imageColorBrightness Image
image Int
brightness = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorBrightness"
  p'imageColorBrightness ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> IO ())

foreign import ccall safe "bindings.h ImageColorReplace_" c'imageColorReplace :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO ()

imageColorReplace :: Raylib.Types.Image -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Image
imageColorReplace :: Image -> Color -> Color -> IO Image
imageColorReplace Image
image Color
color Color
replace = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageColorReplace"
  p'imageColorReplace ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Color -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h LoadImageColors_" c'loadImageColors :: Ptr Raylib.Types.Image -> IO (Ptr Raylib.Types.Color)

loadImageColors :: Raylib.Types.Image -> IO [Raylib.Types.Color]
loadImageColors :: Image -> IO [Color]
loadImageColors Image
image =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Image
image
    ( \Ptr Image
i -> do
        Ptr Color
colors <- Ptr Image -> IO (Ptr Color)
c'loadImageColors Ptr Image
i
        [Color]
colArray <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Image -> CInt
Raylib.Types.image'width Image
image forall a. Num a => a -> a -> a
* Image -> CInt
Raylib.Types.image'height Image
image) Ptr Color
colors
        Ptr Color -> IO ()
unloadImageColors Ptr Color
colors
        forall (m :: * -> *) a. Monad m => a -> m a
return [Color]
colArray
    )

foreign import ccall safe "raylib.h &LoadImageColors"
  p'loadImageColors ::
    FunPtr (Raylib.Types.Image -> IO (Ptr Raylib.Types.Color))

foreign import ccall safe "bindings.h LoadImagePalette_" c'loadImagePalette :: Ptr Raylib.Types.Image -> CInt -> Ptr CInt -> IO (Ptr Raylib.Types.Color)

loadImagePalette :: Raylib.Types.Image -> Int -> IO [Raylib.Types.Color]
loadImagePalette :: Image -> Int -> IO [Color]
loadImagePalette Image
image Int
maxPaletteSize =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Image
image
    ( \Ptr Image
i -> do
        (Ptr Color
palette, CInt
num) <-
          forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
            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)
            )
        [Color]
colArray <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr Color
palette
        Ptr Color -> IO ()
unloadImagePalette Ptr Color
palette
        forall (m :: * -> *) a. Monad m => a -> m a
return [Color]
colArray
    )

foreign import ccall safe "raylib.h &LoadImagePalette"
  p'loadImagePalette ::
    FunPtr (Raylib.Types.Image -> CInt -> Ptr CInt -> IO (Ptr Raylib.Types.Color))

-- | NOTE: You usually won't need to use this. `loadImageColors` unloads the colors automatically. Only use this when you are using `c'loadImageColors` to load the colors.

foreign import ccall safe "raylib.h UnloadImageColors"
  unloadImageColors ::
    Ptr Raylib.Types.Color -> IO ()

foreign import ccall safe "raylib.h &UnloadImageColors"
  p'unloadImageColors ::
    FunPtr (Ptr Raylib.Types.Color -> IO ())

-- | NOTE: You usually won't need to use this. `loadImagePalette` unloads the colors automatically. Only use this when you are using `c'loadImagePalette` to load the colors.

foreign import ccall safe "raylib.h UnloadImagePalette"
  unloadImagePalette ::
    Ptr Raylib.Types.Color -> IO ()

foreign import ccall safe "raylib.h &UnloadImagePalette"
  p'unloadImagePalette ::
    FunPtr (Ptr Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h GetImageAlphaBorder_" c'getImageAlphaBorder :: Ptr Raylib.Types.Image -> CFloat -> IO (Ptr Raylib.Types.Rectangle)

getImageAlphaBorder :: Raylib.Types.Image -> Float -> IO Raylib.Types.Rectangle
getImageAlphaBorder :: Image -> Float -> IO Rectangle
getImageAlphaBorder Image
image Float
threshold = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetImageAlphaBorder"
  p'getImageAlphaBorder ::
    FunPtr (Raylib.Types.Image -> CFloat -> IO Raylib.Types.Rectangle)

foreign import ccall safe "bindings.h GetImageColor_" c'getImageColor :: Ptr Raylib.Types.Image -> CInt -> CInt -> IO (Ptr Raylib.Types.Color)

getImageColor :: Raylib.Types.Image -> Int -> Int -> IO Raylib.Types.Color
getImageColor :: Image -> Int -> Int -> IO Color
getImageColor Image
image Int
x Int
y = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetImageColor"
  p'getImageColor ::
    FunPtr (Raylib.Types.Image -> CInt -> CInt -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h ImageClearBackground_" c'imageClearBackground :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> IO ()

imageClearBackground :: Raylib.Types.Image -> Raylib.Types.Color -> IO Raylib.Types.Image
imageClearBackground :: Image -> Color -> IO Image
imageClearBackground Image
image Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageClearBackground"
  p'imageClearBackground ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawPixel_" c'imageDrawPixel :: Ptr Raylib.Types.Image -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawPixel :: Raylib.Types.Image -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawPixel :: Image -> Int -> Int -> Color -> IO Image
imageDrawPixel Image
image Int
x Int
y Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawPixel"
  p'imageDrawPixel ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawPixelV_" c'imageDrawPixelV :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

imageDrawPixelV :: Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawPixelV :: Image -> Vector2 -> Color -> IO Image
imageDrawPixelV Image
image Vector2
position Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawPixelV"
  p'imageDrawPixelV ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawLine_" c'imageDrawLine :: Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawLine :: Raylib.Types.Image -> Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawLine"
  p'imageDrawLine ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawLineV_" c'imageDrawLineV :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

imageDrawLineV :: Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawLineV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawLineV Image
image Vector2
start Vector2
end Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
start (\Ptr Vector2
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
end (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawLineV"
  p'imageDrawLineV ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawCircle_" c'imageDrawCircle :: Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawCircle :: Raylib.Types.Image -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawCircle :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircle Image
image Int
centerX Int
centerY Int
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawCircle"
  p'imageDrawCircle ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawCircleV_" c'imageDrawCircleV :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector2 -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawCircleV :: Raylib.Types.Image -> Raylib.Types.Vector2 -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawCircleV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleV Image
image Vector2
center Int
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawCircleV"
  p'imageDrawCircleV ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawCircleLines_" c'imageDrawCircleLines :: Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawCircleLines :: Raylib.Types.Image -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawCircleLines :: Image -> Int -> Int -> Int -> Color -> IO Image
imageDrawCircleLines Image
image Int
centerX Int
centerY Int
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawCircleLines"
  p'imageDrawCircleLines ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawCircleLinesV_" c'imageDrawCircleLinesV :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector2 -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawCircleLinesV :: Raylib.Types.Image -> Raylib.Types.Vector2 -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawCircleLinesV :: Image -> Vector2 -> Int -> Color -> IO Image
imageDrawCircleLinesV Image
image Vector2
center Int
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
center (\Ptr Vector2
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawCircleLinesV"
  p'imageDrawCircleLinesV ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawRectangle_" c'imageDrawRectangle :: Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawRectangle :: Raylib.Types.Image -> Int -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawRectangle"
  p'imageDrawRectangle ::
    FunPtr (Ptr Raylib.Types.Image -> CInt -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawRectangleV_" c'imageDrawRectangleV :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

imageDrawRectangleV :: Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawRectangleV :: Image -> Vector2 -> Vector2 -> Color -> IO Image
imageDrawRectangleV Image
image Vector2
position Vector2
size Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawRectangleV"
  p'imageDrawRectangleV ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawRectangleRec_" c'imageDrawRectangleRec :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Color -> IO ()

imageDrawRectangleRec :: Raylib.Types.Image -> Raylib.Types.Rectangle -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawRectangleRec :: Image -> Rectangle -> Color -> IO Image
imageDrawRectangleRec Image
image Rectangle
rectangle Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rectangle (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawRectangleRec"
  p'imageDrawRectangleRec ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Rectangle -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawRectangleLines_" c'imageDrawRectangleLines :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Rectangle -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawRectangleLines :: Raylib.Types.Image -> Raylib.Types.Rectangle -> Int -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDrawRectangleLines :: Image -> Rectangle -> Int -> Color -> IO Image
imageDrawRectangleLines Image
image Rectangle
rectangle Int
thickness Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rectangle (\Ptr Rectangle
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawRectangleLines"
  p'imageDrawRectangleLines ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Rectangle -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDraw_" c'imageDraw :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Image -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Color -> IO ()

imageDraw :: Raylib.Types.Image -> Raylib.Types.Image -> Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Raylib.Types.Color -> IO Raylib.Types.Image
imageDraw :: Image -> Image -> Rectangle -> Rectangle -> Color -> IO Image
imageDraw Image
image Image
source Rectangle
srcRec Rectangle
dstRec Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
source (\Ptr Image
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
srcRec (\Ptr Rectangle
sr -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
dstRec (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDraw"
  p'imageDraw ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Image -> Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawText_" c'imageDrawText :: Ptr Raylib.Types.Image -> CString -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

imageDrawText :: Raylib.Types.Image -> String -> Int -> Int -> Int -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawText"
  p'imageDrawText ::
    FunPtr (Ptr Raylib.Types.Image -> CString -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h ImageDrawTextEx_" c'imageDrawTextEx :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Font -> CString -> Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

imageDrawTextEx :: Raylib.Types.Image -> Raylib.Types.Font -> String -> Raylib.Types.Vector2 -> Float -> Float -> Raylib.Types.Color -> IO Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &ImageDrawTextEx"
  p'imageDrawTextEx ::
    FunPtr (Ptr Raylib.Types.Image -> Raylib.Types.Font -> CString -> Raylib.Types.Vector2 -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h LoadTexture_" c'loadTexture :: CString -> IO (Ptr Raylib.Types.Texture)

loadTexture :: String -> IO Raylib.Types.Texture
loadTexture :: String -> IO Texture
loadTexture String
fileName = 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadTexture"
  p'loadTexture ::
    FunPtr (CString -> IO Raylib.Types.Texture)

foreign import ccall safe "bindings.h LoadTextureFromImage_" c'loadTextureFromImage :: Ptr Raylib.Types.Image -> IO (Ptr Raylib.Types.Texture)

loadTextureFromImage :: Raylib.Types.Image -> IO Raylib.Types.Texture
loadTextureFromImage :: Image -> IO Texture
loadTextureFromImage Image
image = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image Ptr Image -> IO (Ptr Texture)
c'loadTextureFromImage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadTextureFromImage"
  p'loadTextureFromImage ::
    FunPtr (Raylib.Types.Image -> IO Raylib.Types.Texture)

foreign import ccall safe "bindings.h LoadTextureCubemap_" c'loadTextureCubemap :: Ptr Raylib.Types.Image -> CInt -> IO (Ptr Raylib.Types.Texture)

loadTextureCubemap :: Raylib.Types.Image -> CubemapLayout -> IO Raylib.Types.Texture
loadTextureCubemap :: Image -> CubemapLayout -> IO Texture
loadTextureCubemap Image
image CubemapLayout
layout = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadTextureCubemap"
  p'loadTextureCubemap ::
    FunPtr (Raylib.Types.Image -> CInt -> IO Raylib.Types.Texture)

foreign import ccall safe "bindings.h LoadRenderTexture_" c'loadRenderTexture :: CInt -> CInt -> IO (Ptr Raylib.Types.RenderTexture)

loadRenderTexture :: Int -> Int -> IO Raylib.Types.RenderTexture
loadRenderTexture :: Int -> Int -> IO RenderTexture
loadRenderTexture Int
width Int
height = 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadRenderTexture"
  p'loadRenderTexture ::
    FunPtr (CInt -> CInt -> IO Raylib.Types.RenderTexture)

foreign import ccall safe "bindings.h UnloadTexture_" c'unloadTexture :: Ptr Raylib.Types.Texture -> IO ()

unloadTexture :: Raylib.Types.Texture -> IO ()
unloadTexture :: Texture -> IO ()
unloadTexture Texture
texture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture Ptr Texture -> IO ()
c'unloadTexture

foreign import ccall safe "raylib.h &UnloadTexture"
  p'unloadTexture ::
    FunPtr (Raylib.Types.Texture -> IO ())

foreign import ccall safe "bindings.h UnloadRenderTexture_" c'unloadRenderTexture :: Ptr Raylib.Types.RenderTexture -> IO ()

unloadRenderTexture :: Raylib.Types.RenderTexture -> IO ()
unloadRenderTexture :: RenderTexture -> IO ()
unloadRenderTexture RenderTexture
target = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with RenderTexture
target Ptr RenderTexture -> IO ()
c'unloadRenderTexture

foreign import ccall safe "raylib.h &UnloadRenderTexture"
  p'unloadRenderTexture ::
    FunPtr (Raylib.Types.RenderTexture -> IO ())

foreign import ccall safe "bindings.h UpdateTexture_" c'updateTexture :: Ptr Raylib.Types.Texture -> Ptr () -> IO ()

updateTexture :: Raylib.Types.Texture -> Ptr () -> IO Raylib.Types.Texture
updateTexture :: Texture -> Ptr () -> IO Texture
updateTexture Texture
texture Ptr ()
pixels = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &UpdateTexture"
  p'updateTexture ::
    FunPtr (Raylib.Types.Texture -> Ptr () -> IO ())

foreign import ccall safe "bindings.h UpdateTextureRec_" c'updateTextureRec :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr () -> IO ()

updateTextureRec :: Raylib.Types.Texture -> Raylib.Types.Rectangle -> Ptr () -> IO Raylib.Types.Texture
updateTextureRec :: Texture -> Rectangle -> Ptr () -> IO Texture
updateTextureRec Texture
texture Rectangle
rect Ptr ()
pixels = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &UpdateTextureRec"
  p'updateTextureRec ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Rectangle -> Ptr () -> IO ())

foreign import ccall safe "raylib.h GenTextureMipmaps"
  c'genTextureMipmaps ::
    Ptr Raylib.Types.Texture -> IO ()

genTextureMipmaps :: Raylib.Types.Texture -> IO Raylib.Types.Texture
genTextureMipmaps :: Texture -> IO Texture
genTextureMipmaps Texture
texture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &GenTextureMipmaps"
  p'genTextureMipmaps ::
    FunPtr (Ptr Raylib.Types.Texture -> IO ())

foreign import ccall safe "bindings.h SetTextureFilter_" c'setTextureFilter :: Ptr Raylib.Types.Texture -> CInt -> IO ()

setTextureFilter :: Raylib.Types.Texture -> TextureFilter -> IO Raylib.Types.Texture
setTextureFilter :: Texture -> TextureFilter -> IO Texture
setTextureFilter Texture
texture TextureFilter
filterType = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &SetTextureFilter"
  p'setTextureFilter ::
    FunPtr (Raylib.Types.Texture -> CInt -> IO ())

foreign import ccall safe "bindings.h SetTextureWrap_" c'setTextureWrap :: Ptr Raylib.Types.Texture -> CInt -> IO ()

setTextureWrap :: Raylib.Types.Texture -> TextureWrap -> IO Raylib.Types.Texture
setTextureWrap :: Texture -> TextureWrap -> IO Texture
setTextureWrap Texture
texture TextureWrap
wrap = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)

foreign import ccall safe "raylib.h &SetTextureWrap"
  p'setTextureWrap ::
    FunPtr (Raylib.Types.Texture -> CInt -> IO ())

foreign import ccall safe "bindings.h DrawTexture_" c'drawTexture :: Ptr Raylib.Types.Texture -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawTexture :: Raylib.Types.Texture -> Int -> Int -> Raylib.Types.Color -> IO ()
drawTexture :: Texture -> Int -> Int -> Color -> IO ()
drawTexture Texture
texture Int
x Int
y Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)))

foreign import ccall safe "raylib.h &DrawTexture"
  p'drawTexture ::
    FunPtr (Raylib.Types.Texture -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextureV_" c'drawTextureV :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

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

foreign import ccall safe "raylib.h &DrawTextureV"
  p'drawTextureV ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextureEx_" c'drawTextureEx :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextureEx :: Raylib.Types.Texture -> Raylib.Types.Vector2 -> Float -> Float -> Raylib.Types.Color -> IO ()
drawTextureEx :: Texture -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextureEx Texture
texture Vector2
position Float
rotation Float
scale Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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))))

foreign import ccall safe "raylib.h &DrawTextureEx"
  p'drawTextureEx ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Vector2 -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextureRec_" c'drawTextureRec :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawTextureRec :: Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawTextureRec :: Texture -> Rectangle -> Vector2 -> Color -> IO ()
drawTextureRec Texture
texture Rectangle
source Vector2
position Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source (\Ptr Rectangle
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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)))

foreign import ccall safe "raylib.h &DrawTextureRec"
  p'drawTextureRec ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTexturePro_" c'drawTexturePro :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTexturePro :: Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> Float -> Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source (\Ptr Rectangle
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
dest (\Ptr Rectangle
d -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
origin (\Ptr Vector2
o -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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))))))

foreign import ccall safe "raylib.h &DrawTexturePro"
  p'drawTexturePro ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextureNPatch_" c'drawTextureNPatch :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.NPatchInfo -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextureNPatch :: Raylib.Types.Texture -> Raylib.Types.NPatchInfo -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> Float -> Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with NPatchInfo
nPatchInfo (\Ptr NPatchInfo
n -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
dest (\Ptr Rectangle
d -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
origin (\Ptr Vector2
o -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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))))))

foreign import ccall safe "raylib.h &DrawTextureNPatch"
  p'drawTextureNPatch ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.NPatchInfo -> Raylib.Types.Rectangle -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h Fade_" c'fade :: Ptr Raylib.Types.Color -> CFloat -> IO (Ptr Raylib.Types.Color)

fade :: Raylib.Types.Color -> Float -> Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &Fade"
  p'fade ::
    FunPtr (Raylib.Types.Color -> CFloat -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h ColorToInt_" c'colorToInt :: Ptr Raylib.Types.Color -> IO CInt

colorToInt :: Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color Ptr Color -> IO CInt
c'colorToInt

foreign import ccall safe "raylib.h &ColorToInt"
  p'colorToInt ::
    FunPtr (Raylib.Types.Color -> IO CInt)

foreign import ccall safe "bindings.h ColorNormalize_" c'colorNormalize :: Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Vector4)

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

foreign import ccall safe "raylib.h &ColorNormalize"
  p'colorNormalize ::
    FunPtr (Raylib.Types.Color -> IO Raylib.Types.Vector4)

foreign import ccall safe "bindings.h ColorFromNormalized_" c'colorFromNormalized :: Ptr Raylib.Types.Vector4 -> IO (Ptr Raylib.Types.Color)

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

foreign import ccall safe "raylib.h &ColorFromNormalized"
  p'colorFromNormalized ::
    FunPtr (Raylib.Types.Vector4 -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h ColorToHSV_" c'colorToHSV :: Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Vector3)

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

foreign import ccall safe "raylib.h &ColorToHSV"
  p'colorToHSV ::
    FunPtr (Raylib.Types.Color -> IO Raylib.Types.Vector3)

foreign import ccall safe "bindings.h ColorFromHSV_" c'colorFromHSV :: CFloat -> CFloat -> CFloat -> IO (Ptr Raylib.Types.Color)

colorFromHSV :: Float -> Float -> Float -> Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ColorFromHSV"
  p'colorFromHSV ::
    FunPtr (CFloat -> CFloat -> CFloat -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h ColorAlpha_" c'colorAlpha :: Ptr Raylib.Types.Color -> CFloat -> IO (Ptr Raylib.Types.Color)

colorAlpha :: Raylib.Types.Color -> Float -> Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ColorAlpha"
  p'colorAlpha ::
    FunPtr (Raylib.Types.Color -> CFloat -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h ColorAlphaBlend_" c'colorAlphaBlend :: Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> Ptr Raylib.Types.Color -> IO (Ptr Raylib.Types.Color)

colorAlphaBlend :: Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
dst (\Ptr Color
d -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
src (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &ColorAlphaBlend"
  p'colorAlphaBlend ::
    FunPtr (Raylib.Types.Color -> Raylib.Types.Color -> Raylib.Types.Color -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h GetColor_" c'getColor :: CUInt -> IO (Ptr Raylib.Types.Color)

getColor :: Integer -> Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetColor"
  p'getColor ::
    FunPtr (CUInt -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h GetPixelColor_" c'getPixelColor :: Ptr () -> CInt -> IO (Ptr Raylib.Types.Color)

getPixelColor :: Ptr () -> PixelFormat -> IO Raylib.Types.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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetPixelColor"
  p'getPixelColor ::
    FunPtr (Ptr () -> CInt -> IO Raylib.Types.Color)

foreign import ccall safe "bindings.h SetPixelColor_" c'setPixelColor :: Ptr () -> Ptr Raylib.Types.Color -> CInt -> IO ()

setPixelColor :: Ptr () -> Raylib.Types.Color -> PixelFormat -> IO ()
setPixelColor :: Ptr () -> Color -> PixelFormat -> IO ()
setPixelColor Ptr ()
dstPtr Color
color PixelFormat
format = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 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))

foreign import ccall safe "raylib.h &SetPixelColor"
  p'setPixelColor ::
    FunPtr (Ptr () -> Raylib.Types.Color -> CInt -> IO ())

foreign import ccall safe "raylib.h GetPixelDataSize"
  c'getPixelDataSize ::
    CInt -> CInt -> CInt -> IO CInt

getPixelDataSize :: Int -> Int -> PixelFormat -> Int
getPixelDataSize :: Int -> Int -> PixelFormat -> Int
getPixelDataSize Int
width Int
height PixelFormat
format = forall a. IO a -> a
unsafePerformIO (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> CInt -> IO CInt
c'getPixelDataSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum PixelFormat
format))

foreign import ccall safe "raylib.h &GetPixelDataSize"
  p'getPixelDataSize ::
    FunPtr (CInt -> CInt -> CInt -> IO CInt)

foreign import ccall safe "bindings.h GetFontDefault_" c'getFontDefault :: IO (Ptr Raylib.Types.Font)

getFontDefault :: IO Raylib.Types.Font
getFontDefault :: IO Font
getFontDefault = IO (Ptr Font)
c'getFontDefault forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetFontDefault"
  p'getFontDefault ::
    FunPtr (IO Raylib.Types.Font)

foreign import ccall safe "bindings.h LoadFont_" c'loadFont :: CString -> IO (Ptr Raylib.Types.Font)

loadFont :: String -> IO Raylib.Types.Font
loadFont :: String -> IO Font
loadFont String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Font)
c'loadFont forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadFont"
  p'loadFont ::
    FunPtr (CString -> IO Raylib.Types.Font)

foreign import ccall safe "bindings.h LoadFontEx_" c'loadFontEx :: CString -> CInt -> Ptr CInt -> CInt -> IO (Ptr Raylib.Types.Font)

loadFontEx :: String -> Int -> [Int] -> Int -> IO Raylib.Types.Font
loadFontEx :: String -> Int -> [Int] -> Int -> IO Font
loadFontEx String
fileName Int
fontSize [Int]
fontChars Int
glyphCount = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (\CString
f -> forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> CString -> CInt -> Ptr CInt -> CInt -> IO (Ptr Font)
c'loadFontEx CString
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadFontEx"
  p'loadFontEx ::
    FunPtr (CString -> CInt -> Ptr CInt -> CInt -> IO Raylib.Types.Font)

foreign import ccall safe "bindings.h LoadFontFromImage_" c'loadFontFromImage :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Color -> CInt -> IO (Ptr Raylib.Types.Font)

loadFontFromImage :: Raylib.Types.Image -> Raylib.Types.Color -> Int -> IO Raylib.Types.Font
loadFontFromImage :: Image -> Color -> Int -> IO Font
loadFontFromImage Image
image Color
key Int
firstChar = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
image (\Ptr Image
i -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
key (\Ptr Color
k -> Ptr Image -> Ptr Color -> CInt -> IO (Ptr Font)
c'loadFontFromImage Ptr Image
i Ptr Color
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
firstChar))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadFontFromImage"
  p'loadFontFromImage ::
    FunPtr (Raylib.Types.Image -> Raylib.Types.Color -> CInt -> IO Raylib.Types.Font)

foreign import ccall safe "bindings.h LoadFontFromMemory_" c'loadFontFromMemory :: CString -> Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> IO (Ptr Raylib.Types.Font)

loadFontFromMemory :: String -> [Integer] -> Int -> [Int] -> Int -> IO Raylib.Types.Font
loadFontFromMemory :: String -> [Integer] -> Int -> [Int] -> Int -> IO Font
loadFontFromMemory String
fileType [Integer]
fileData Int
fontSize [Int]
fontChars Int
glyphCount = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
t -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> CString
-> Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> IO (Ptr Font)
c'loadFontFromMemory CString
t Ptr CUChar
d (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 a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount)))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadFontFromMemory"
  p'loadFontFromMemory ::
    FunPtr (CString -> Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> IO Raylib.Types.Font)

foreign import ccall safe "raylib.h LoadFontData"
  c'loadFontData ::
    Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> CInt -> IO (Ptr Raylib.Types.GlyphInfo)

loadFontData :: [Integer] -> Int -> [Int] -> Int -> FontType -> IO Raylib.Types.GlyphInfo
loadFontData :: [Integer] -> Int -> [Int] -> Int -> FontType -> IO GlyphInfo
loadFontData [Integer]
fileData Int
fontSize [Int]
fontChars Int
glyphCount FontType
fontType = forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> Ptr CUChar
-> CInt -> CInt -> Ptr CInt -> CInt -> CInt -> IO (Ptr GlyphInfo)
c'loadFontData Ptr CUChar
d (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 a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum FontType
fontType))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadFontData"
  p'loadFontData ::
    FunPtr (Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> CInt -> IO (Ptr Raylib.Types.GlyphInfo))

foreign import ccall safe "bindings.h GenImageFontAtlas_" c'genImageFontAtlas :: Ptr Raylib.Types.GlyphInfo -> Ptr (Ptr Raylib.Types.Rectangle) -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Raylib.Types.Image)
genImageFontAtlas :: [Raylib.Types.GlyphInfo] -> [[Raylib.Types.Rectangle]] -> Int -> Int -> Int -> Int -> IO Raylib.Types.Image
genImageFontAtlas :: [GlyphInfo]
-> [[Rectangle]] -> Int -> Int -> Int -> Int -> IO Image
genImageFontAtlas [GlyphInfo]
chars [[Rectangle]]
recs Int
glyphCount Int
fontSize Int
padding Int
packMethod = forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GlyphInfo]
chars (\Ptr GlyphInfo
c -> forall a b. Storable a => [[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withArray2D [[Rectangle]]
recs (\Ptr (Ptr Rectangle)
r -> Ptr GlyphInfo
-> Ptr (Ptr Rectangle)
-> CInt
-> CInt
-> CInt
-> CInt
-> IO (Ptr Image)
c'genImageFontAtlas Ptr GlyphInfo
c Ptr (Ptr Rectangle)
r (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
packMethod))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenImageFontAtlas"
  p'genImageFontAtlas ::
    FunPtr (Ptr Raylib.Types.GlyphInfo -> Ptr (Ptr Raylib.Types.Rectangle) -> CInt -> CInt -> CInt -> CInt -> IO Raylib.Types.Image)

foreign import ccall safe "raylib.h UnloadFontData"
  c'unloadFontData ::
    Ptr Raylib.Types.GlyphInfo -> CInt -> IO ()

unloadFontData :: [Raylib.Types.GlyphInfo] -> IO ()
unloadFontData :: [GlyphInfo] -> IO ()
unloadFontData [GlyphInfo]
glyphs = forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [GlyphInfo]
glyphs (\Int
size Ptr GlyphInfo
g -> Ptr GlyphInfo -> CInt -> IO ()
c'unloadFontData Ptr GlyphInfo
g (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))

foreign import ccall safe "raylib.h &UnloadFontData"
  p'unloadFontData ::
    FunPtr (Ptr Raylib.Types.GlyphInfo -> CInt -> IO ())

foreign import ccall safe "bindings.h UnloadFont_" c'unloadFont :: Ptr Raylib.Types.Font -> IO ()

unloadFont :: Raylib.Types.Font -> IO ()
unloadFont :: Font -> IO ()
unloadFont Font
font = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font Ptr Font -> IO ()
c'unloadFont

foreign import ccall safe "raylib.h &UnloadFont"
  p'unloadFont ::
    FunPtr (Raylib.Types.Font -> IO ())

foreign import ccall safe "bindings.h ExportFontAsCode_" c'exportFontAsCode :: Ptr Raylib.Types.Font -> CString -> IO CBool

exportFontAsCode :: Raylib.Types.Font -> String -> IO Bool
exportFontAsCode :: Font -> String -> IO Bool
exportFontAsCode Font
font 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> CString -> IO CBool
c'exportFontAsCode)

foreign import ccall safe "raylib.h &ExportFontAsCode"
  p'exportFontAsCode ::
    FunPtr (Raylib.Types.Font -> CString -> IO CInt)

foreign import ccall safe "raylib.h DrawFPS"
  c'drawFPS ::
    CInt -> CInt -> IO ()

drawFPS :: Int -> Int -> IO ()
drawFPS :: Int -> Int -> IO ()
drawFPS Int
x Int
y = CInt -> CInt -> IO ()
c'drawFPS (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

foreign import ccall safe "raylib.h &DrawFPS"
  p'drawFPS ::
    FunPtr (CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h DrawText_" c'drawText :: CString -> CInt -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawText :: String -> Int -> Int -> Int -> Raylib.Types.Color -> IO ()
drawText :: String -> Int -> Int -> Int -> Color -> IO ()
drawText String
text Int
x Int
y Int
fontSize Color
color = forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (CString -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawText 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)))

foreign import ccall safe "raylib.h &DrawText"
  p'drawText ::
    FunPtr (CString -> CInt -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextEx_" c'drawTextEx :: Ptr Raylib.Types.Font -> CString -> Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextEx :: Raylib.Types.Font -> String -> Raylib.Types.Vector2 -> Float -> Float -> Raylib.Types.Color -> IO ()
drawTextEx :: Font -> String -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextEx Font
font String
text Vector2
position Float
fontSize Float
spacing Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Font
-> CString -> Ptr Vector2 -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawTextEx 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)))))

foreign import ccall safe "raylib.h &DrawTextEx"
  p'drawTextEx ::
    FunPtr (Raylib.Types.Font -> CString -> Raylib.Types.Vector2 -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextPro_" c'drawTextPro :: Ptr Raylib.Types.Font -> CString -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextPro :: Raylib.Types.Font -> String -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawTextPro :: Font
-> String
-> Vector2
-> Vector2
-> Float
-> Float
-> Float
-> Color
-> IO ()
drawTextPro Font
font String
text Vector2
position Vector2
origin Float
rotation Float
fontSize Float
spacing Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
origin (\Ptr Vector2
o -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Font
-> CString
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'drawTextPro Ptr Font
f CString
t Ptr Vector2
p Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing))))))

foreign import ccall safe "raylib.h &DrawTextPro"
  p'drawTextPro ::
    FunPtr (Raylib.Types.Font -> CString -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextCodepoint_" c'drawTextCodepoint :: Ptr Raylib.Types.Font -> CInt -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextCodepoint :: Raylib.Types.Font -> Int -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawTextCodepoint :: Font -> Int -> Vector2 -> Float -> Color -> IO ()
drawTextCodepoint Font
font Int
codepoint Vector2
position Float
fontSize Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Font -> CInt -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawTextCodepoint Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint) Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize))))

foreign import ccall safe "raylib.h &DrawTextCodepoint"
  p'drawTextCodepoint ::
    FunPtr (Raylib.Types.Font -> CInt -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTextCodepoints_" c'drawTextCodepoints :: Ptr Raylib.Types.Font -> Ptr CInt -> CInt -> Ptr Raylib.Types.Vector2 -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawTextCodepoints :: Raylib.Types.Font -> [Int] -> Raylib.Types.Vector2 -> Float -> Float -> Raylib.Types.Color -> IO ()
drawTextCodepoints :: Font -> [Int] -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextCodepoints Font
font [Int]
codepoints Vector2
position Float
fontSize Float
spacing Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
codepoints) (\Int
count Ptr CInt
cp -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
position (\Ptr Vector2
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Font
-> Ptr CInt
-> CInt
-> Ptr Vector2
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'drawTextCodepoints Ptr Font
f Ptr CInt
cp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count) 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)))))

foreign import ccall safe "raylib.h &DrawTextCodepoints"
  p'drawTextCodepoints ::
    FunPtr (Raylib.Types.Font -> Ptr CInt -> CInt -> Raylib.Types.Vector2 -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h MeasureText"
  c'measureText ::
    CString -> CInt -> IO CInt

measureText :: String -> Int -> IO Int
measureText :: String -> Int -> IO Int
measureText String
text Int
fontSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> CString -> CInt -> IO CInt
c'measureText CString
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize))

foreign import ccall safe "raylib.h &MeasureText"
  p'measureText ::
    FunPtr (CString -> CInt -> IO CInt)

foreign import ccall safe "bindings.h MeasureTextEx_" c'measureTextEx :: Ptr Raylib.Types.Font -> CString -> CFloat -> CFloat -> IO (Ptr Raylib.Types.Vector2)

measureTextEx :: Raylib.Types.Font -> String -> Float -> Float -> IO Raylib.Types.Vector2
measureTextEx :: Font -> String -> Float -> Float -> IO Vector2
measureTextEx Font
font String
text Float
fontSize Float
spacing = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> Ptr Font -> CString -> CFloat -> CFloat -> IO (Ptr Vector2)
c'measureTextEx 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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &MeasureTextEx"
  p'measureTextEx ::
    FunPtr (Raylib.Types.Font -> CString -> CFloat -> CFloat -> IO Raylib.Types.Vector2)

foreign import ccall safe "bindings.h GetGlyphIndex_" c'getGlyphIndex :: Ptr Raylib.Types.Font -> CInt -> IO CInt

getGlyphIndex :: Raylib.Types.Font -> Int -> IO Int
getGlyphIndex :: Font -> Int -> IO Int
getGlyphIndex Font
font Int
codepoint = 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO CInt
c'getGlyphIndex Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint))

foreign import ccall safe "raylib.h &GetGlyphIndex"
  p'getGlyphIndex ::
    FunPtr (Raylib.Types.Font -> CInt -> IO CInt)

foreign import ccall safe "bindings.h GetGlyphInfo_" c'getGlyphInfo :: Ptr Raylib.Types.Font -> CInt -> IO (Ptr Raylib.Types.GlyphInfo)

getGlyphInfo :: Raylib.Types.Font -> Int -> IO Raylib.Types.GlyphInfo
getGlyphInfo :: Font -> Int -> IO GlyphInfo
getGlyphInfo Font
font Int
codepoint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO (Ptr GlyphInfo)
c'getGlyphInfo Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetGlyphInfo"
  p'getGlyphInfo ::
    FunPtr (Raylib.Types.Font -> CInt -> IO Raylib.Types.GlyphInfo)

foreign import ccall safe "bindings.h GetGlyphAtlasRec_" c'getGlyphAtlasRec :: Ptr Raylib.Types.Font -> CInt -> IO (Ptr Raylib.Types.Rectangle)

getGlyphAtlasRec :: Raylib.Types.Font -> Int -> IO Raylib.Types.Rectangle
getGlyphAtlasRec :: Font -> Int -> IO Rectangle
getGlyphAtlasRec Font
font Int
codepoint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO (Ptr Rectangle)
c'getGlyphAtlasRec Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetGlyphAtlasRec"
  p'getGlyphAtlasRec ::
    FunPtr (Raylib.Types.Font -> CInt -> IO Raylib.Types.Rectangle)

foreign import ccall safe "raylib.h LoadUTF8"
  c'loadUTF8 ::
    Ptr CInt -> CInt -> IO CString

loadUTF8 :: [Integer] -> IO String
loadUTF8 :: [Integer] -> IO String
loadUTF8 [Integer]
codepoints =
  forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
codepoints)
    ( \Int
size Ptr CInt
c ->
        Ptr CInt -> CInt -> IO CString
c'loadUTF8 Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
    )
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \CString
s -> do
            String
val <- CString -> IO String
peekCString CString
s
            CString -> IO ()
unloadUTF8 CString
s
            forall (m :: * -> *) a. Monad m => a -> m a
return String
val
        )

foreign import ccall safe "raylib.h &LoadUTF8"
  p'loadUTF8 ::
    FunPtr (Ptr CInt -> CInt -> IO CString)

foreign import ccall safe "raylib.h UnloadUTF8"
  unloadUTF8 ::
    CString -> IO ()

foreign import ccall safe "raylib.h &UnloadUTF8"
  p'unloadUTF8 ::
    FunPtr (CString -> IO ())

foreign import ccall safe "raylib.h LoadCodepoints"
  c'loadCodepoints ::
    CString -> Ptr CInt -> IO (Ptr CInt)

loadCodepoints :: String -> IO [Int]
loadCodepoints :: String -> IO [Int]
loadCodepoints String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
n -> do
              Ptr CInt
res <- CString -> Ptr CInt -> IO (Ptr CInt)
c'loadCodepoints CString
t Ptr CInt
n
              CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
              [CInt]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr CInt
res
              Ptr CInt -> IO ()
unloadCodepoints Ptr CInt
res
              forall (m :: * -> *) a. Monad m => a -> m a
return 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
<$> [CInt]
arr
          )
    )

foreign import ccall safe "raylib.h &LoadCodepoints"
  p'loadCodepoints ::
    FunPtr (CString -> Ptr CInt -> IO (Ptr CInt))

foreign import ccall safe "raylib.h UnloadCodepoints"
  unloadCodepoints ::
    Ptr CInt -> IO ()

foreign import ccall safe "raylib.h &UnloadCodepoints"
  p'unloadCodepoints ::
    FunPtr (Ptr CInt -> IO ())

foreign import ccall safe "raylib.h GetCodepointCount"
  c'getCodepointCount ::
    CString -> IO CInt

getCodepointCount :: String -> IO Int
getCodepointCount :: String -> IO Int
getCodepointCount String
text = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
text CString -> IO CInt
c'getCodepointCount

foreign import ccall safe "raylib.h &GetCodepointCount"
  p'getCodepointCount ::
    FunPtr (CString -> IO CInt)

-- | Deprecated, use `getCodepointNext`

foreign import ccall safe "raylib.h GetCodepoint"
  getCodepoint ::
    CString -> Ptr CInt -> IO CInt

foreign import ccall safe "raylib.h &GetCodepoint"
  p'getCodepoint ::
    FunPtr (CString -> Ptr CInt -> IO CInt)

foreign import ccall safe "raylib.h GetCodepointNext"
  c'getCodepointNext ::
    CString -> Ptr CInt -> IO CInt

getCodepointNext :: String -> IO (Int, Int)
getCodepointNext :: String -> IO (Int, Int)
getCodepointNext String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
n ->
              do
                CInt
res <- CString -> Ptr CInt -> IO CInt
c'getCodepointNext CString
t Ptr CInt
n
                CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num)
          )
    )

foreign import ccall safe "raylib.h &GetCodepointNext"
  p'getCodepointNext ::
    FunPtr (CString -> Ptr CInt -> IO CInt)

foreign import ccall safe "raylib.h GetCodepointPrevious"
  c'getCodepointPrevious ::
    CString -> Ptr CInt -> IO CInt

getCodepointPrevious :: String -> IO (Int, Int)
getCodepointPrevious :: String -> IO (Int, Int)
getCodepointPrevious String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
n ->
              do
                CInt
res <- CString -> Ptr CInt -> IO CInt
c'getCodepointPrevious CString
t Ptr CInt
n
                CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num)
          )
    )

foreign import ccall safe "raylib.h &GetCodepointPrevious"
  p'getCodepointPrevious ::
    FunPtr (CString -> Ptr CInt -> IO CInt)

foreign import ccall safe "raylib.h CodepointToUTF8"
  c'codepointToUTF8 ::
    CInt -> Ptr CInt -> IO CString

codepointToUTF8 :: Int -> IO String
codepointToUTF8 :: Int -> IO String
codepointToUTF8 Int
codepoint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 (CInt -> Ptr CInt -> IO CString
c'codepointToUTF8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

foreign import ccall safe "raylib.h &CodepointToUTF8"
  p'codepointToUTF8 ::
    FunPtr (CInt -> Ptr CInt -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextCopy"
  textCopy ::
    CString -> CString -> IO CInt

foreign import ccall safe "raylib.h &TextCopy"
  p'textCopy ::
    FunPtr (CString -> CString -> IO CInt)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextIsEqual"
  textIsEqual ::
    CString -> CString -> IO CInt

foreign import ccall safe "raylib.h &TextIsEqual"
  p'textIsEqual ::
    FunPtr (CString -> CString -> IO CInt)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextLength"
  textLength ::
    CString -> IO CUInt

foreign import ccall safe "raylib.h &TextLength"
  p'textLength ::
    FunPtr (CString -> IO CUInt)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextFormat"
  textFormat ::
    CString -> IO CString

foreign import ccall safe "raylib.h &TextFormat"
  p'textFormat ::
    FunPtr (CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextSubtext"
  textSubtext ::
    CString -> CInt -> CInt -> IO CString

foreign import ccall safe "raylib.h &TextSubtext"
  p'textSubtext ::
    FunPtr (CString -> CInt -> CInt -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextReplace"
  textReplace ::
    CString -> CString -> CString -> IO CString

foreign import ccall safe "raylib.h &TextReplace"
  p'textReplace ::
    FunPtr (CString -> CString -> CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextInsert"
  textInsert ::
    CString -> CString -> CInt -> IO CString

foreign import ccall safe "raylib.h &TextInsert"
  p'textInsert ::
    FunPtr (CString -> CString -> CInt -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextJoin"
  textJoin ::
    Ptr CString -> CInt -> CString -> IO CString

foreign import ccall safe "raylib.h &TextJoin"
  p'textJoin ::
    FunPtr (Ptr CString -> CInt -> CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextSplit"
  textSplit ::
    CString -> CChar -> Ptr CInt -> IO (Ptr CString)

foreign import ccall safe "raylib.h &TextSplit"
  p'textSplit ::
    FunPtr (CString -> CChar -> Ptr CInt -> IO (Ptr CString))

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextAppend"
  textAppend ::
    CString -> CString -> Ptr CInt -> IO ()

foreign import ccall safe "raylib.h &TextAppend"
  p'textAppend ::
    FunPtr (CString -> CString -> Ptr CInt -> IO ())

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextFindIndex"
  textFindIndex ::
    CString -> CString -> IO CInt

foreign import ccall safe "raylib.h &TextFindIndex"
  p'textFindIndex ::
    FunPtr (CString -> CString -> IO CInt)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextToUpper"
  textToUpper ::
    CString -> IO CString

foreign import ccall safe "raylib.h &TextToUpper"
  p'textToUpper ::
    FunPtr (CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextToLower"
  textToLower ::
    CString -> IO CString

foreign import ccall safe "raylib.h &TextToLower"
  p'textToLower ::
    FunPtr (CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextToPascal"
  textToPascal ::
    CString -> IO CString

foreign import ccall safe "raylib.h &TextToPascal"
  p'textToPascal ::
    FunPtr (CString -> IO CString)

-- | Not required in Haskell

foreign import ccall safe "raylib.h TextToInteger"
  textToInteger ::
    CString -> IO CInt

foreign import ccall safe "raylib.h &TextToInteger"
  p'textToInteger ::
    FunPtr (CString -> IO CInt)

foreign import ccall safe "bindings.h DrawLine3D_" c'drawLine3D :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawLine3D :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawLine3D :: Vector3 -> Vector3 -> Color -> IO ()
drawLine3D Vector3
start Vector3
end Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
start (\Ptr Vector3
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
end (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawLine3D Ptr Vector3
s))

foreign import ccall safe "raylib.h &DrawLine3D"
  p'drawLine3D ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawPoint3D_" c'drawPoint3D :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawPoint3D :: Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawPoint3D :: Vector3 -> Color -> IO ()
drawPoint3D Vector3
point Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
point (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Color -> IO ()
c'drawPoint3D)

foreign import ccall safe "raylib.h &DrawPoint3D"
  p'drawPoint3D ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCircle3D_" c'drawCircle3D :: Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCircle3D :: Raylib.Types.Vector3 -> Float -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Color -> IO ()
drawCircle3D :: Vector3 -> Float -> Vector3 -> Float -> Color -> IO ()
drawCircle3D Vector3
center Float
radius Vector3
rotationAxis Float
rotationAngle Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center (\Ptr Vector3
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
rotationAxis (\Ptr Vector3
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> CFloat -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawCircle3D Ptr Vector3
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) Ptr Vector3
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotationAngle))))

foreign import ccall safe "raylib.h &DrawCircle3D"
  p'drawCircle3D ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangle3D_" c'drawTriangle3D :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawTriangle3D :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawTriangle3D :: Vector3 -> Vector3 -> Vector3 -> Color -> IO ()
drawTriangle3D Vector3
v1 Vector3
v2 Vector3
v3 Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v1 (\Ptr Vector3
p1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v2 (\Ptr Vector3
p2 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v3 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawTriangle3D Ptr Vector3
p1 Ptr Vector3
p2)))

foreign import ccall safe "raylib.h &DrawTriangle3D"
  p'drawTriangle3D ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawTriangleStrip3D_" c'drawTriangleStrip3D :: Ptr Raylib.Types.Vector3 -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawTriangleStrip3D :: [Raylib.Types.Vector3] -> Int -> Raylib.Types.Color -> IO ()
drawTriangleStrip3D :: [Vector3] -> Int -> Color -> IO ()
drawTriangleStrip3D [Vector3]
points Int
pointCount Color
color = forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Vector3]
points (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CInt -> Ptr Color -> IO ()
c'drawTriangleStrip3D Ptr Vector3
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pointCount)))

foreign import ccall safe "raylib.h &DrawTriangleStrip3D"
  p'drawTriangleStrip3D ::
    FunPtr (Ptr Raylib.Types.Vector3 -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCube_" c'drawCube :: Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCube :: Raylib.Types.Vector3 -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawCube :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCube Vector3
position Float
width Float
height Float
length Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawCube Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length)))

foreign import ccall safe "raylib.h &DrawCube"
  p'drawCube ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCubeV_" c'drawCubeV :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawCubeV :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawCubeV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeV Vector3
position Vector3
size Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawCubeV Ptr Vector3
p))

foreign import ccall safe "raylib.h &DrawCubeV"
  p'drawCubeV ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCubeWires_" c'drawCubeWires :: Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCubeWires :: Raylib.Types.Vector3 -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawCubeWires :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCubeWires Vector3
position Float
width Float
height Float
length Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawCubeWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length)))

foreign import ccall safe "raylib.h &DrawCubeWires"
  p'drawCubeWires ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCubeWiresV_" c'drawCubeWiresV :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawCubeWiresV :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawCubeWiresV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeWiresV Vector3
position Vector3
size Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawCubeWiresV Ptr Vector3
p))

foreign import ccall safe "raylib.h &DrawCubeWiresV"
  p'drawCubeWiresV ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCubeTexture_" c'drawCubeTexture :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCubeTexture :: Raylib.Types.Texture -> Raylib.Types.Vector3 -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawCubeTexture :: Texture -> Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCubeTexture Texture
texture Vector3
position Float
width Float
height Float
length Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Texture
-> Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawCubeTexture Ptr Texture
t Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length))))

foreign import ccall safe "raylib.h &DrawCubeTexture"
  p'drawCubeTexture ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCubeTextureRec_" c'drawCubeTextureRec :: Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawCubeTextureRec :: Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> Float -> Float -> Float -> Raylib.Types.Color -> IO ()
drawCubeTextureRec :: Texture
-> Rectangle
-> Vector3
-> Float
-> Float
-> Float
-> Color
-> IO ()
drawCubeTextureRec Texture
texture Rectangle
source Vector3
position Float
width Float
height Float
length Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source (\Ptr Rectangle
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Texture
-> Ptr Rectangle
-> Ptr Vector3
-> CFloat
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'drawCubeTextureRec Ptr Texture
t Ptr Rectangle
s Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length)))))

foreign import ccall safe "raylib.h &DrawCubeTextureRec"
  p'drawCubeTextureRec ::
    FunPtr (Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawSphere_" c'drawSphere :: Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawSphere :: Raylib.Types.Vector3 -> Float -> Raylib.Types.Color -> IO ()
drawSphere :: Vector3 -> Float -> Color -> IO ()
drawSphere Vector3
position Float
radius Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawSphere Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

foreign import ccall safe "raylib.h &DrawSphere"
  p'drawSphere ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawSphereEx_" c'drawSphereEx :: Ptr Raylib.Types.Vector3 -> CFloat -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawSphereEx :: Raylib.Types.Vector3 -> Float -> Int -> Int -> Raylib.Types.Color -> IO ()
drawSphereEx :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereEx Vector3
position Float
radius Int
rings Int
slices Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawSphereEx Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

foreign import ccall safe "raylib.h &DrawSphereEx"
  p'drawSphereEx ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawSphereWires_" c'drawSphereWires :: Ptr Raylib.Types.Vector3 -> CFloat -> CInt -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawSphereWires :: Raylib.Types.Vector3 -> Float -> Int -> Int -> Raylib.Types.Color -> IO ()
drawSphereWires :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereWires Vector3
position Float
radius Int
rings Int
slices Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawSphereWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

foreign import ccall safe "raylib.h &DrawSphereWires"
  p'drawSphereWires ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CInt -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCylinder_" c'drawCylinder :: Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCylinder :: Raylib.Types.Vector3 -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCylinder :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinder Vector3
position Float
radiusTop Float
radiusBottom Float
height Int
slices Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinder Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

foreign import ccall safe "raylib.h &DrawCylinder"
  p'drawCylinder ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCylinderEx_" c'drawCylinderEx :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCylinderEx :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCylinderEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderEx Vector3
start Vector3
end Float
startRadius Float
endRadius Int
sides Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
start (\Ptr Vector3
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
end (\Ptr Vector3
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderEx Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides))))

foreign import ccall safe "raylib.h &DrawCylinderEx"
  p'drawCylinderEx ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCylinderWires_" c'drawCylinderWires :: Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCylinderWires :: Raylib.Types.Vector3 -> Float -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCylinderWires :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWires Vector3
position Float
radiusTop Float
radiusBottom Float
height Int
slices Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

foreign import ccall safe "raylib.h &DrawCylinderWires"
  p'drawCylinderWires ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCylinderWiresEx_" c'drawCylinderWiresEx :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> CFloat -> CFloat -> CInt -> Ptr Raylib.Types.Color -> IO ()

drawCylinderWiresEx :: Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Float -> Float -> Int -> Raylib.Types.Color -> IO ()
drawCylinderWiresEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWiresEx Vector3
start Vector3
end Float
startRadius Float
endRadius Int
sides Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
start (\Ptr Vector3
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
end (\Ptr Vector3
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderWiresEx Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides))))

foreign import ccall safe "raylib.h &DrawCylinderWiresEx"
  p'drawCylinderWiresEx ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> CFloat -> CFloat -> CInt -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawCapsule_" c'drawCapsule :: Ptr Vector3 -> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()

drawCapsule :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsule :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsule Vector3
start Vector3
end CFloat
radius Int
slices Int
rings Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
start (\Ptr Vector3
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
end (\Ptr Vector3
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawCapsule Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings))))

foreign import ccall safe "raylib.h &DrawCapsule"
  p'drawCapsule ::
    FunPtr (Vector3 -> Vector3 -> CFloat -> CInt -> CInt -> Color -> IO ())

foreign import ccall safe "bindings.h DrawCapsuleWires_" c'drawCapsuleWires :: Ptr Vector3 -> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()

drawCapsuleWires :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsuleWires :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsuleWires Vector3
start Vector3
end CFloat
radius Int
slices Int
rings Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
start (\Ptr Vector3
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
end (\Ptr Vector3
e -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawCapsuleWires Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings))))

foreign import ccall safe "raylib.h &DrawCapsuleWires"
  p'drawCapsuleWires ::
    FunPtr (Vector3 -> Vector3 -> CFloat -> CInt -> CInt -> Color -> IO ())

foreign import ccall safe "bindings.h DrawPlane_" c'drawPlane :: Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawPlane :: Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawPlane :: Vector3 -> Vector2 -> Color -> IO ()
drawPlane Vector3
center Vector2
size Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center (\Ptr Vector3
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawPlane Ptr Vector3
c))

foreign import ccall safe "raylib.h &DrawPlane"
  p'drawPlane ::
    FunPtr (Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawRay_" c'drawRay :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.Color -> IO ()

drawRay :: Raylib.Types.Ray -> Raylib.Types.Color -> IO ()
drawRay :: Ray -> Color -> IO ()
drawRay Ray
ray Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr Color -> IO ()
c'drawRay)

foreign import ccall safe "raylib.h &DrawRay"
  p'drawRay ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h DrawGrid"
  c'drawGrid ::
    CInt -> CFloat -> IO ()

drawGrid :: Int -> Float -> IO ()
drawGrid :: Int -> Float -> IO ()
drawGrid Int
slices Float
spacing = CInt -> CFloat -> IO ()
c'drawGrid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing)

foreign import ccall safe "raylib.h &DrawGrid"
  p'drawGrid ::
    FunPtr (CInt -> CFloat -> IO ())

foreign import ccall safe "bindings.h LoadModel_" c'loadModel :: CString -> IO (Ptr Raylib.Types.Model)

loadModel :: String -> IO Raylib.Types.Model
loadModel :: String -> IO Model
loadModel String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Model)
c'loadModel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadModel"
  p'loadModel ::
    FunPtr (CString -> IO Raylib.Types.Model)

foreign import ccall safe "bindings.h LoadModelFromMesh_" c'loadModelFromMesh :: Ptr Raylib.Types.Mesh -> IO (Ptr Raylib.Types.Model)

loadModelFromMesh :: Raylib.Types.Mesh -> IO Raylib.Types.Model
loadModelFromMesh :: Mesh -> IO Model
loadModelFromMesh Mesh
mesh = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh Ptr Mesh -> IO (Ptr Model)
c'loadModelFromMesh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadModelFromMesh"
  p'loadModelFromMesh ::
    FunPtr (Raylib.Types.Mesh -> IO Raylib.Types.Model)

foreign import ccall safe "bindings.h UnloadModel_" c'unloadModel :: Ptr Raylib.Types.Model -> IO ()

unloadModel :: Raylib.Types.Model -> IO ()
unloadModel :: Model -> IO ()
unloadModel Model
model = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model Ptr Model -> IO ()
c'unloadModel

foreign import ccall safe "raylib.h &UnloadModel"
  p'unloadModel ::
    FunPtr (Raylib.Types.Model -> IO ())

foreign import ccall safe "bindings.h UnloadModelKeepMeshes_" c'unloadModelKeepMeshes :: Ptr Raylib.Types.Model -> IO ()

unloadModelKeepMeshes :: Raylib.Types.Model -> IO ()
unloadModelKeepMeshes :: Model -> IO ()
unloadModelKeepMeshes Model
model = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model Ptr Model -> IO ()
c'unloadModelKeepMeshes

foreign import ccall safe "raylib.h &UnloadModelKeepMeshes"
  p'unloadModelKeepMeshes ::
    FunPtr (Raylib.Types.Model -> IO ())

foreign import ccall safe "bindings.h GetModelBoundingBox_" c'getModelBoundingBox :: Ptr Raylib.Types.Model -> IO (Ptr Raylib.Types.BoundingBox)

getModelBoundingBox :: Raylib.Types.Model -> IO Raylib.Types.BoundingBox
getModelBoundingBox :: Model -> IO BoundingBox
getModelBoundingBox Model
model = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model Ptr Model -> IO (Ptr BoundingBox)
c'getModelBoundingBox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetModelBoundingBox"
  p'getModelBoundingBox ::
    FunPtr (Raylib.Types.Model -> IO Raylib.Types.BoundingBox)

foreign import ccall safe "bindings.h DrawModel_" c'drawModel :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawModel :: Raylib.Types.Model -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Color -> IO ()
drawModel :: Model -> Vector3 -> Float -> Color -> IO ()
drawModel Model
model Vector3
position Float
scale Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawModel Ptr Model
m Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale))))

foreign import ccall safe "raylib.h &DrawModel"
  p'drawModel ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawModelEx_" c'drawModelEx :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawModelEx :: Raylib.Types.Model -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawModelEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelEx Model
model Vector3
position Vector3
rotationAxis Float
rotationAngle Vector3
scale Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
rotationAxis (\Ptr Vector3
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
scale (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model
-> Ptr Vector3
-> Ptr Vector3
-> CFloat
-> Ptr Vector3
-> Ptr Color
-> IO ()
c'drawModelEx Ptr Model
m Ptr Vector3
p Ptr Vector3
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotationAngle)))))

foreign import ccall safe "raylib.h &DrawModelEx"
  p'drawModelEx ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawModelWires_" c'drawModelWires :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawModelWires :: Raylib.Types.Model -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Color -> IO ()
drawModelWires :: Model -> Vector3 -> Float -> Color -> IO ()
drawModelWires Model
model Vector3
position Float
scale Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawModelWires Ptr Model
m Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale))))

foreign import ccall safe "raylib.h &DrawModelWires"
  p'drawModelWires ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawModelWiresEx_" c'drawModelWiresEx :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Color -> IO ()

drawModelWiresEx :: Raylib.Types.Model -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ()
drawModelWiresEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelWiresEx Model
model Vector3
position Vector3
rotationAxis Float
rotationAngle Vector3
scale Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
rotationAxis (\Ptr Vector3
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
scale (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model
-> Ptr Vector3
-> Ptr Vector3
-> CFloat
-> Ptr Vector3
-> Ptr Color
-> IO ()
c'drawModelWiresEx Ptr Model
m Ptr Vector3
p Ptr Vector3
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotationAngle)))))

foreign import ccall safe "raylib.h &DrawModelWiresEx"
  p'drawModelWiresEx ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Vector3 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawBoundingBox_" c'drawBoundingBox :: Ptr Raylib.Types.BoundingBox -> Ptr Raylib.Types.Color -> IO ()

drawBoundingBox :: Raylib.Types.BoundingBox -> Raylib.Types.Color -> IO ()
drawBoundingBox :: BoundingBox -> Color -> IO ()
drawBoundingBox BoundingBox
box Color
color = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BoundingBox
box (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BoundingBox -> Ptr Color -> IO ()
c'drawBoundingBox)

foreign import ccall safe "raylib.h &DrawBoundingBox"
  p'drawBoundingBox ::
    FunPtr (Raylib.Types.BoundingBox -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawBillboard_" c'drawBillboard :: Ptr Raylib.Types.Camera3D -> Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawBillboard :: Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Vector3 -> Float -> Raylib.Types.Color -> IO ()
drawBillboard :: Camera3D -> Texture -> Vector3 -> Float -> Color -> IO ()
drawBillboard Camera3D
camera Texture
texture Vector3
position Float
size Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera (\Ptr Camera3D
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Camera3D
-> Ptr Texture -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawBillboard Ptr Camera3D
c Ptr Texture
t Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size)))))

foreign import ccall safe "raylib.h &DrawBillboard"
  p'drawBillboard ::
    FunPtr (Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawBillboardRec_" c'drawBillboardRec :: Ptr Raylib.Types.Camera3D -> Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Color -> IO ()

drawBillboardRec :: Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ()
drawBillboardRec :: Camera3D
-> Texture -> Rectangle -> Vector3 -> Vector2 -> Color -> IO ()
drawBillboardRec Camera3D
camera Texture
texture Rectangle
source Vector3
position Vector2
size Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera (\Ptr Camera3D
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source (\Ptr Rectangle
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
size (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Camera3D
-> Ptr Texture
-> Ptr Rectangle
-> Ptr Vector3
-> Ptr Vector2
-> Ptr Color
-> IO ()
c'drawBillboardRec Ptr Camera3D
c Ptr Texture
t Ptr Rectangle
s Ptr Vector3
p)))))

foreign import ccall safe "raylib.h &DrawBillboardRec"
  p'drawBillboardRec ::
    FunPtr (Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Color -> IO ())

foreign import ccall safe "bindings.h DrawBillboardPro_" c'drawBillboardPro :: Ptr Raylib.Types.Camera3D -> Ptr Raylib.Types.Texture -> Ptr Raylib.Types.Rectangle -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector2 -> Ptr Raylib.Types.Vector2 -> CFloat -> Ptr Raylib.Types.Color -> IO ()

drawBillboardPro :: Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> Float -> Raylib.Types.Color -> IO ()
drawBillboardPro :: Camera3D
-> Texture
-> Rectangle
-> Vector3
-> Vector3
-> Vector2
-> Vector2
-> Float
-> Color
-> IO ()
drawBillboardPro Camera3D
camera Texture
texture Rectangle
source Vector3
position Vector3
up Vector2
size Vector2
origin Float
rotation Color
tint = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Camera3D
camera (\Ptr Camera3D
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
source (\Ptr Rectangle
s -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
position (\Ptr Vector3
p -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
up (\Ptr Vector3
u -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
size (\Ptr Vector2
sz -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector2
origin (\Ptr Vector2
o -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
tint (Ptr Camera3D
-> Ptr Texture
-> Ptr Rectangle
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawBillboardPro Ptr Camera3D
c Ptr Texture
t Ptr Rectangle
s Ptr Vector3
p Ptr Vector3
u Ptr Vector2
sz Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation)))))))))

foreign import ccall safe "raylib.h &DrawBillboardPro"
  p'drawBillboardPro ::
    FunPtr (Raylib.Types.Camera3D -> Raylib.Types.Texture -> Raylib.Types.Rectangle -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector2 -> Raylib.Types.Vector2 -> CFloat -> Raylib.Types.Color -> IO ())

foreign import ccall safe "raylib.h UploadMesh"
  c'uploadMesh ::
    Ptr Raylib.Types.Mesh -> CInt -> IO ()

uploadMesh :: Raylib.Types.Mesh -> Bool -> IO Raylib.Types.Mesh
uploadMesh :: Mesh -> Bool -> IO Mesh
uploadMesh Mesh
mesh Bool
dynamic = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> CInt -> IO ()
c'uploadMesh Ptr Mesh
m (forall a. Num a => Bool -> a
fromBool Bool
dynamic) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Mesh
m)

foreign import ccall safe "raylib.h &UploadMesh"
  p'uploadMesh ::
    FunPtr (Ptr Raylib.Types.Mesh -> CInt -> IO ())

foreign import ccall safe "bindings.h UpdateMeshBuffer_" c'updateMeshBuffer :: Ptr Raylib.Types.Mesh -> CInt -> Ptr () -> CInt -> CInt -> IO ()

updateMeshBuffer :: Raylib.Types.Mesh -> Int -> Ptr () -> Int -> Int -> IO ()
updateMeshBuffer :: Mesh -> Int -> Ptr () -> Int -> Int -> IO ()
updateMeshBuffer Mesh
mesh Int
index Ptr ()
dataValue Int
dataSize Int
offset = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> CInt -> Ptr () -> CInt -> CInt -> IO ()
c'updateMeshBuffer Ptr Mesh
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Ptr ()
dataValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))

foreign import ccall safe "raylib.h &UpdateMeshBuffer"
  p'updateMeshBuffer ::
    FunPtr (Raylib.Types.Mesh -> CInt -> Ptr () -> CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h UnloadMesh_" c'unloadMesh :: Ptr Raylib.Types.Mesh -> IO ()

unloadMesh :: Raylib.Types.Mesh -> IO ()
unloadMesh :: Mesh -> IO ()
unloadMesh Mesh
mesh = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh Ptr Mesh -> IO ()
c'unloadMesh

foreign import ccall safe "raylib.h &UnloadMesh"
  p'unloadMesh ::
    FunPtr (Raylib.Types.Mesh -> IO ())

foreign import ccall safe "bindings.h DrawMesh_" c'drawMesh :: Ptr Raylib.Types.Mesh -> Ptr Raylib.Types.Material -> Ptr Raylib.Types.Matrix -> IO ()

drawMesh :: Raylib.Types.Mesh -> Raylib.Types.Material -> Raylib.Types.Matrix -> IO ()
drawMesh :: Mesh -> Material -> Matrix -> IO ()
drawMesh Mesh
mesh Material
material Matrix
transform = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (\Ptr Mesh
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Material
material (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Matrix
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> Ptr Material -> Ptr Matrix -> IO ()
c'drawMesh Ptr Mesh
m))

foreign import ccall safe "raylib.h &DrawMesh"
  p'drawMesh ::
    FunPtr (Raylib.Types.Mesh -> Raylib.Types.Material -> Raylib.Types.Matrix -> IO ())

foreign import ccall safe "bindings.h DrawMeshInstanced_" c'drawMeshInstanced :: Ptr Raylib.Types.Mesh -> Ptr Raylib.Types.Material -> Ptr Raylib.Types.Matrix -> CInt -> IO ()

drawMeshInstanced :: Raylib.Types.Mesh -> Raylib.Types.Material -> [Raylib.Types.Matrix] -> IO ()
drawMeshInstanced :: Mesh -> Material -> [Matrix] -> IO ()
drawMeshInstanced Mesh
mesh Material
material [Matrix]
transforms = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (\Ptr Mesh
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Material
material (\Ptr Material
mat -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Matrix]
transforms (\Int
size Ptr Matrix
t -> Ptr Mesh -> Ptr Material -> Ptr Matrix -> CInt -> IO ()
c'drawMeshInstanced Ptr Mesh
m Ptr Material
mat Ptr Matrix
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))))

foreign import ccall safe "raylib.h &DrawMeshInstanced"
  p'drawMeshInstanced ::
    FunPtr (Raylib.Types.Mesh -> Raylib.Types.Material -> Ptr Raylib.Types.Matrix -> CInt -> IO ())

foreign import ccall safe "bindings.h ExportMesh_" c'exportMesh :: Ptr Raylib.Types.Mesh -> CString -> IO CBool

exportMesh :: Raylib.Types.Mesh -> String -> IO Bool
exportMesh :: Mesh -> String -> IO Bool
exportMesh Mesh
mesh 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> CString -> IO CBool
c'exportMesh)

foreign import ccall safe "raylib.h &ExportMesh"
  p'exportMesh ::
    FunPtr (Raylib.Types.Mesh -> CString -> IO CInt)

foreign import ccall safe "bindings.h GetMeshBoundingBox_" c'getMeshBoundingBox :: Ptr Raylib.Types.Mesh -> IO (Ptr Raylib.Types.BoundingBox)

getMeshBoundingBox :: Raylib.Types.Mesh -> IO Raylib.Types.BoundingBox
getMeshBoundingBox :: Mesh -> IO BoundingBox
getMeshBoundingBox Mesh
mesh = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh Ptr Mesh -> IO (Ptr BoundingBox)
c'getMeshBoundingBox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetMeshBoundingBox"
  p'getMeshBoundingBox ::
    FunPtr (Raylib.Types.Mesh -> IO Raylib.Types.BoundingBox)

foreign import ccall safe "raylib.h GenMeshTangents"
  c'genMeshTangents ::
    Ptr Raylib.Types.Mesh -> IO ()

genMeshTangents :: Raylib.Types.Mesh -> IO Raylib.Types.Mesh
genMeshTangents :: Mesh -> IO Mesh
genMeshTangents Mesh
mesh = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> IO ()
c'genMeshTangents Ptr Mesh
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Mesh
m)

foreign import ccall safe "raylib.h &GenMeshTangents"
  p'genMeshTangents ::
    FunPtr (Ptr Raylib.Types.Mesh -> IO ())

foreign import ccall safe "bindings.h GenMeshPoly_" c'genMeshPoly :: CInt -> CFloat -> IO (Ptr Raylib.Types.Mesh)

genMeshPoly :: Int -> Float -> IO Raylib.Types.Mesh
genMeshPoly :: Int -> Float -> IO Mesh
genMeshPoly Int
sides Float
radius = CInt -> CFloat -> IO (Ptr Mesh)
c'genMeshPoly (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshPoly"
  p'genMeshPoly ::
    FunPtr (CInt -> CFloat -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshPlane_" c'genMeshPlane :: CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshPlane :: Float -> Float -> Int -> Int -> IO Raylib.Types.Mesh
genMeshPlane :: Float -> Float -> Int -> Int -> IO Mesh
genMeshPlane Float
width Float
length Int
resX Int
resZ = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshPlane (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resZ) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshPlane"
  p'genMeshPlane ::
    FunPtr (CFloat -> CFloat -> CInt -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshCube_" c'genMeshCube :: CFloat -> CFloat -> CFloat -> IO (Ptr Raylib.Types.Mesh)

genMeshCube :: Float -> Float -> Float -> IO Raylib.Types.Mesh
genMeshCube :: Float -> Float -> Float -> IO Mesh
genMeshCube Float
width Float
height Float
length = CFloat -> CFloat -> CFloat -> IO (Ptr Mesh)
c'genMeshCube (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshCube"
  p'genMeshCube ::
    FunPtr (CFloat -> CFloat -> CFloat -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshSphere_" c'genMeshSphere :: CFloat -> CInt -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshSphere :: Float -> Int -> Int -> IO Raylib.Types.Mesh
genMeshSphere :: Float -> Int -> Int -> IO Mesh
genMeshSphere Float
radius Int
rings Int
slices = CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshSphere (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshSphere"
  p'genMeshSphere ::
    FunPtr (CFloat -> CInt -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshHemiSphere_" c'genMeshHemiSphere :: CFloat -> CInt -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshHemiSphere :: Float -> Int -> Int -> IO Raylib.Types.Mesh
genMeshHemiSphere :: Float -> Int -> Int -> IO Mesh
genMeshHemiSphere Float
radius Int
rings Int
slices = CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshHemiSphere (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshHemiSphere"
  p'genMeshHemiSphere ::
    FunPtr (CFloat -> CInt -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshCylinder_" c'genMeshCylinder :: CFloat -> CFloat -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshCylinder :: Float -> Float -> Int -> IO Raylib.Types.Mesh
genMeshCylinder :: Float -> Float -> Int -> IO Mesh
genMeshCylinder Float
radius Float
height Int
slices = CFloat -> CFloat -> CInt -> IO (Ptr Mesh)
c'genMeshCylinder (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshCylinder"
  p'genMeshCylinder ::
    FunPtr (CFloat -> CFloat -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshCone_" c'genMeshCone :: CFloat -> CFloat -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshCone :: Float -> Float -> Int -> IO Raylib.Types.Mesh
genMeshCone :: Float -> Float -> Int -> IO Mesh
genMeshCone Float
radius Float
height Int
slices = CFloat -> CFloat -> CInt -> IO (Ptr Mesh)
c'genMeshCone (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshCone"
  p'genMeshCone ::
    FunPtr (CFloat -> CFloat -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshTorus_" c'genMeshTorus :: CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshTorus :: Float -> Float -> Int -> Int -> IO Raylib.Types.Mesh
genMeshTorus :: Float -> Float -> Int -> Int -> IO Mesh
genMeshTorus Float
radius Float
size Int
radSeg Int
sides = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshTorus (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshTorus"
  p'genMeshTorus ::
    FunPtr (CFloat -> CFloat -> CInt -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshKnot_" c'genMeshKnot :: CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Raylib.Types.Mesh)

genMeshKnot :: Float -> Float -> Int -> Int -> IO Raylib.Types.Mesh
genMeshKnot :: Float -> Float -> Int -> Int -> IO Mesh
genMeshKnot Float
radius Float
size Int
radSeg Int
sides = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshKnot (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshKnot"
  p'genMeshKnot ::
    FunPtr (CFloat -> CFloat -> CInt -> CInt -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshHeightmap_" c'genMeshHeightmap :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector3 -> IO (Ptr Raylib.Types.Mesh)

genMeshHeightmap :: Raylib.Types.Image -> Raylib.Types.Vector3 -> IO Raylib.Types.Mesh
genMeshHeightmap :: Image -> Vector3 -> IO Mesh
genMeshHeightmap Image
heightmap Vector3
size = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
heightmap (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshHeightmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshHeightmap"
  p'genMeshHeightmap ::
    FunPtr (Raylib.Types.Image -> Raylib.Types.Vector3 -> IO Raylib.Types.Mesh)

foreign import ccall safe "bindings.h GenMeshCubicmap_" c'genMeshCubicmap :: Ptr Raylib.Types.Image -> Ptr Raylib.Types.Vector3 -> IO (Ptr Raylib.Types.Mesh)

genMeshCubicmap :: Raylib.Types.Image -> Raylib.Types.Vector3 -> IO Raylib.Types.Mesh
genMeshCubicmap :: Image -> Vector3 -> IO Mesh
genMeshCubicmap Image
cubicmap Vector3
cubeSize = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Image
cubicmap (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
cubeSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshCubicmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GenMeshCubicmap"
  p'genMeshCubicmap ::
    FunPtr (Raylib.Types.Image -> Raylib.Types.Vector3 -> IO Raylib.Types.Mesh)

foreign import ccall safe "raylib.h LoadMaterials"
  c'loadMaterials ::
    CString -> Ptr CInt -> IO (Ptr Raylib.Types.Material)

loadMaterials :: String -> IO [Raylib.Types.Material]
loadMaterials :: String -> IO [Material]
loadMaterials String
fileName =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
fileName
    ( \CString
f ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CInt
0
          ( \Ptr CInt
n -> do
              Ptr Material
ptr <- CString -> Ptr CInt -> IO (Ptr Material)
c'loadMaterials CString
f Ptr CInt
n
              CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
              forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr Material
ptr
          )
    )

foreign import ccall safe "raylib.h &LoadMaterials"
  p'loadMaterials ::
    FunPtr (CString -> Ptr CInt -> IO (Ptr Raylib.Types.Material))

foreign import ccall safe "bindings.h LoadMaterialDefault_" c'loadMaterialDefault :: IO (Ptr Raylib.Types.Material)

loadMaterialDefault :: IO Raylib.Types.Material
loadMaterialDefault :: IO Material
loadMaterialDefault = IO (Ptr Material)
c'loadMaterialDefault forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadMaterialDefault"
  p'loadMaterialDefault ::
    FunPtr (IO Raylib.Types.Material)

foreign import ccall safe "bindings.h UnloadMaterial_" c'unloadMaterial :: Ptr Raylib.Types.Material -> IO ()

unloadMaterial :: Raylib.Types.Material -> IO ()
unloadMaterial :: Material -> IO ()
unloadMaterial Material
material = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Material
material Ptr Material -> IO ()
c'unloadMaterial

foreign import ccall safe "raylib.h &UnloadMaterial"
  p'unloadMaterial ::
    FunPtr (Raylib.Types.Material -> IO ())

foreign import ccall safe "bindings.h SetMaterialTexture_" c'setMaterialTexture :: Ptr Raylib.Types.Material -> CInt -> Ptr Raylib.Types.Texture -> IO ()

setMaterialTexture :: Raylib.Types.Material -> Int -> Raylib.Types.Texture -> IO Raylib.Types.Material
setMaterialTexture :: Material -> Int -> Texture -> IO Material
setMaterialTexture Material
material Int
mapType Texture
texture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Material
material (\Ptr Material
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (Ptr Material -> CInt -> Ptr Texture -> IO ()
c'setMaterialTexture Ptr Material
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mapType)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Material
m)

foreign import ccall safe "raylib.h &SetMaterialTexture"
  p'setMaterialTexture ::
    FunPtr (Ptr Raylib.Types.Material -> CInt -> Raylib.Types.Texture -> IO ())

foreign import ccall safe "raylib.h SetModelMeshMaterial"
  c'setModelMeshMaterial ::
    Ptr Raylib.Types.Model -> CInt -> CInt -> IO ()

setModelMeshMaterial :: Raylib.Types.Model -> Int -> Int -> IO Raylib.Types.Model
setModelMeshMaterial :: Model -> Int -> Int -> IO Model
setModelMeshMaterial Model
model Int
meshId Int
materialId = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> Ptr Model -> CInt -> CInt -> IO ()
c'setModelMeshMaterial Ptr Model
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
meshId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
materialId) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Model
m)

foreign import ccall safe "raylib.h &SetModelMeshMaterial"
  p'setModelMeshMaterial ::
    FunPtr (Ptr Raylib.Types.Model -> CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h LoadModelAnimations"
  c'loadModelAnimations ::
    CString -> Ptr CUInt -> IO (Ptr Raylib.Types.ModelAnimation)

loadModelAnimations :: String -> IO [Raylib.Types.ModelAnimation]
loadModelAnimations :: String -> IO [ModelAnimation]
loadModelAnimations String
fileName =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
fileName
    ( \CString
f ->
        forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
          CUInt
0
          ( \Ptr CUInt
n -> do
              Ptr ModelAnimation
ptr <- CString -> Ptr CUInt -> IO (Ptr ModelAnimation)
c'loadModelAnimations CString
f Ptr CUInt
n
              CUInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
n
              forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
num) Ptr ModelAnimation
ptr
          )
    )

foreign import ccall safe "raylib.h &LoadModelAnimations"
  p'loadModelAnimations ::
    FunPtr (CString -> Ptr CUInt -> IO (Ptr Raylib.Types.ModelAnimation))

foreign import ccall safe "bindings.h UpdateModelAnimation_" c'updateModelAnimation :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.ModelAnimation -> CInt -> IO ()

updateModelAnimation :: Raylib.Types.Model -> Raylib.Types.ModelAnimation -> Int -> IO ()
updateModelAnimation :: Model -> ModelAnimation -> Int -> IO ()
updateModelAnimation Model
model ModelAnimation
animation Int
frame = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (\Ptr Model
m -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ModelAnimation
animation (\Ptr ModelAnimation
a -> Ptr Model -> Ptr ModelAnimation -> CInt -> IO ()
c'updateModelAnimation Ptr Model
m Ptr ModelAnimation
a (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frame)))

foreign import ccall safe "raylib.h &UpdateModelAnimation"
  p'updateModelAnimation ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.ModelAnimation -> CInt -> IO ())

foreign import ccall safe "bindings.h UnloadModelAnimation_" c'unloadModelAnimation :: Ptr Raylib.Types.ModelAnimation -> IO ()

unloadModelAnimation :: ModelAnimation -> IO ()
unloadModelAnimation :: ModelAnimation -> IO ()
unloadModelAnimation ModelAnimation
animation = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ModelAnimation
animation Ptr ModelAnimation -> IO ()
c'unloadModelAnimation

foreign import ccall safe "raylib.h &UnloadModelAnimation"
  p'unloadModelAnimation ::
    FunPtr (Raylib.Types.ModelAnimation -> IO ())

foreign import ccall safe "raylib.h UnloadModelAnimations"
  c'unloadModelAnimations ::
    Ptr Raylib.Types.ModelAnimation -> CUInt -> IO ()

unloadModelAnimations :: [ModelAnimation] -> IO ()
unloadModelAnimations :: [ModelAnimation] -> IO ()
unloadModelAnimations [ModelAnimation]
animations = forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [ModelAnimation]
animations (\Int
num Ptr ModelAnimation
a -> Ptr ModelAnimation -> CUInt -> IO ()
c'unloadModelAnimations Ptr ModelAnimation
a (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num))

foreign import ccall safe "raylib.h &UnloadModelAnimations"
  p'unloadModelAnimations ::
    FunPtr (Ptr Raylib.Types.ModelAnimation -> CUInt -> IO ())

foreign import ccall safe "bindings.h IsModelAnimationValid_" c'isModelAnimationValid :: Ptr Raylib.Types.Model -> Ptr Raylib.Types.ModelAnimation -> IO CBool

isModelAnimationValid :: Model -> ModelAnimation -> IO Bool
isModelAnimationValid :: Model -> ModelAnimation -> IO Bool
isModelAnimationValid Model
model ModelAnimation
animation = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Model
model (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ModelAnimation
animation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model -> Ptr ModelAnimation -> IO CBool
c'isModelAnimationValid)

foreign import ccall safe "raylib.h &IsModelAnimationValid"
  p'isModelAnimationValid ::
    FunPtr (Raylib.Types.Model -> Raylib.Types.ModelAnimation -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionSpheres_" c'checkCollisionSpheres :: Ptr Raylib.Types.Vector3 -> CFloat -> Ptr Raylib.Types.Vector3 -> CFloat -> IO CBool

checkCollisionSpheres :: Vector3 -> Float -> Vector3 -> Float -> Bool
checkCollisionSpheres :: Vector3 -> Float -> Vector3 -> Float -> Bool
checkCollisionSpheres Vector3
center1 Float
radius1 Vector3
center2 Float
radius2 = forall a. (Eq a, Num a) => a -> Bool
toBool forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center1 (\Ptr Vector3
c1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center2 (\Ptr Vector3
c2 -> Ptr Vector3 -> CFloat -> Ptr Vector3 -> CFloat -> IO CBool
c'checkCollisionSpheres Ptr Vector3
c1 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius1) Ptr Vector3
c2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius2))))

foreign import ccall safe "raylib.h &CheckCollisionSpheres"
  p'checkCollisionSpheres ::
    FunPtr (Raylib.Types.Vector3 -> CFloat -> Raylib.Types.Vector3 -> CFloat -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionBoxes_" c'checkCollisionBoxes :: Ptr Raylib.Types.BoundingBox -> Ptr Raylib.Types.BoundingBox -> IO CBool

checkCollisionBoxes :: BoundingBox -> BoundingBox -> Bool
checkCollisionBoxes :: BoundingBox -> BoundingBox -> Bool
checkCollisionBoxes BoundingBox
box1 BoundingBox
box2 = forall a. (Eq a, Num a) => a -> Bool
toBool forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BoundingBox
box1 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BoundingBox
box2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BoundingBox -> Ptr BoundingBox -> IO CBool
c'checkCollisionBoxes))

foreign import ccall safe "raylib.h &CheckCollisionBoxes"
  p'checkCollisionBoxes ::
    FunPtr (Raylib.Types.BoundingBox -> Raylib.Types.BoundingBox -> IO CInt)

foreign import ccall safe "bindings.h CheckCollisionBoxSphere_" c'checkCollisionBoxSphere :: Ptr Raylib.Types.BoundingBox -> Ptr Raylib.Types.Vector3 -> CFloat -> IO CBool

checkCollisionBoxSphere :: BoundingBox -> Vector3 -> Float -> Bool
checkCollisionBoxSphere :: BoundingBox -> Vector3 -> Float -> Bool
checkCollisionBoxSphere BoundingBox
box Vector3
center Float
radius = forall a. (Eq a, Num a) => a -> Bool
toBool forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BoundingBox
box (\Ptr BoundingBox
b -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center (\Ptr Vector3
c -> Ptr BoundingBox -> Ptr Vector3 -> CFloat -> IO CBool
c'checkCollisionBoxSphere Ptr BoundingBox
b Ptr Vector3
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))))

foreign import ccall safe "raylib.h &CheckCollisionBoxSphere"
  p'checkCollisionBoxSphere ::
    FunPtr (Raylib.Types.BoundingBox -> Raylib.Types.Vector3 -> CFloat -> IO CInt)

foreign import ccall safe "bindings.h GetRayCollisionSphere_" c'getRayCollisionSphere :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.Vector3 -> CFloat -> IO (Ptr Raylib.Types.RayCollision)

getRayCollisionSphere :: Ray -> Vector3 -> Float -> RayCollision
getRayCollisionSphere :: Ray -> Vector3 -> Float -> RayCollision
getRayCollisionSphere Ray
ray Vector3
center Float
radius = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (\Ptr Ray
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
center (\Ptr Vector3
c -> Ptr Ray -> Ptr Vector3 -> CFloat -> IO (Ptr RayCollision)
c'getRayCollisionSphere Ptr Ray
r Ptr Vector3
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetRayCollisionSphere"
  p'getRayCollisionSphere ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.Vector3 -> CFloat -> IO Raylib.Types.RayCollision)

foreign import ccall safe "bindings.h GetRayCollisionBox_" c'getRayCollisionBox :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.BoundingBox -> IO (Ptr Raylib.Types.RayCollision)

getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox Ray
ray BoundingBox
box = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with BoundingBox
box forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr BoundingBox -> IO (Ptr RayCollision)
c'getRayCollisionBox) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetRayCollisionBox"
  p'getRayCollisionBox ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.BoundingBox -> IO Raylib.Types.RayCollision)

foreign import ccall safe "bindings.h GetRayCollisionMesh_" c'getRayCollisionMesh :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.Mesh -> Ptr Raylib.Types.Matrix -> IO (Ptr Raylib.Types.RayCollision)

getRayCollisionMesh :: Ray -> Mesh -> Matrix -> RayCollision
getRayCollisionMesh :: Ray -> Mesh -> Matrix -> RayCollision
getRayCollisionMesh Ray
ray Mesh
mesh Matrix
transform = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (\Ptr Ray
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Matrix
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr Mesh -> Ptr Matrix -> IO (Ptr RayCollision)
c'getRayCollisionMesh Ptr Ray
r)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetRayCollisionMesh"
  p'getRayCollisionMesh ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.Mesh -> Raylib.Types.Matrix -> IO Raylib.Types.RayCollision)

foreign import ccall safe "bindings.h GetRayCollisionTriangle_" c'getRayCollisionTriangle :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> IO (Ptr Raylib.Types.RayCollision)

getRayCollisionTriangle :: Ray -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionTriangle :: Ray -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionTriangle Ray
ray Vector3
v1 Vector3
v2 Vector3
v3 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (\Ptr Ray
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v1 (\Ptr Vector3
p1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v2 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> IO (Ptr RayCollision)
c'getRayCollisionTriangle Ptr Ray
r Ptr Vector3
p1))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetRayCollisionTriangle"
  p'getRayCollisionTriangle ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> IO Raylib.Types.RayCollision)

foreign import ccall safe "bindings.h GetRayCollisionQuad_" c'getRayCollisionQuad :: Ptr Raylib.Types.Ray -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> Ptr Raylib.Types.Vector3 -> IO (Ptr Raylib.Types.RayCollision)

getRayCollisionQuad :: Ray -> Vector3 -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionQuad :: Ray -> Vector3 -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionQuad Ray
ray Vector3
v1 Vector3
v2 Vector3
v3 Vector3
v4 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ray
ray (\Ptr Ray
r -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v1 (\Ptr Vector3
p1 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v2 (\Ptr Vector3
p2 -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v3 (forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vector3
v4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> IO (Ptr RayCollision)
c'getRayCollisionQuad Ptr Ray
r Ptr Vector3
p1 Ptr Vector3
p2)))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &GetRayCollisionQuad"
  p'getRayCollisionQuad ::
    FunPtr (Raylib.Types.Ray -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> Raylib.Types.Vector3 -> IO Raylib.Types.RayCollision)

type AudioCallback = FunPtr (Ptr () -> CUInt -> IO ())

foreign import ccall safe "wrapper"
  mk'audioCallback ::
    (Ptr () -> CUInt -> IO ()) -> IO AudioCallback

foreign import ccall safe "dynamic"
  mK'audioCallback ::
    AudioCallback -> (Ptr () -> CUInt -> IO ())

foreign import ccall safe "raylib.h InitAudioDevice"
  initAudioDevice ::
    IO ()

foreign import ccall safe "raylib.h &InitAudioDevice"
  p'initAudioDevice ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h CloseAudioDevice"
  closeAudioDevice ::
    IO ()

foreign import ccall safe "raylib.h &CloseAudioDevice"
  p'closeAudioDevice ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h IsAudioDeviceReady"
  c'isAudioDeviceReady ::
    IO CBool

isAudioDeviceReady :: IO Bool
isAudioDeviceReady :: IO Bool
isAudioDeviceReady = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CBool
c'isAudioDeviceReady

foreign import ccall safe "raylib.h &IsAudioDeviceReady"
  p'isAudioDeviceReady ::
    FunPtr (IO CInt)

foreign import ccall safe "raylib.h SetMasterVolume"
  c'setMasterVolume ::
    CFloat -> IO ()

setMasterVolume :: Float -> IO ()
setMasterVolume :: Float -> IO ()
setMasterVolume Float
volume = CFloat -> IO ()
c'setMasterVolume (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume)

foreign import ccall safe "raylib.h &SetMasterVolume"
  p'setMasterVolume ::
    FunPtr (CFloat -> IO ())

foreign import ccall safe "bindings.h LoadWave_" c'loadWave :: CString -> IO (Ptr Raylib.Types.Wave)

loadWave :: String -> IO Wave
loadWave :: String -> IO Wave
loadWave String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Wave)
c'loadWave forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadWave"
  p'loadWave ::
    FunPtr (CString -> IO Raylib.Types.Wave)

foreign import ccall safe "bindings.h LoadWaveFromMemory_" c'loadWaveFromMemory :: CString -> Ptr CUChar -> CInt -> IO (Ptr Raylib.Types.Wave)

loadWaveFromMemory :: String -> [Integer] -> IO Wave
loadWaveFromMemory :: String -> [Integer] -> IO Wave
loadWaveFromMemory String
fileType [Integer]
fileData = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
f -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> CString -> Ptr CUChar -> CInt -> IO (Ptr Wave)
c'loadWaveFromMemory CString
f Ptr CUChar
d (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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadWaveFromMemory"
  p'loadWaveFromMemory ::
    FunPtr (CString -> Ptr CUChar -> CInt -> IO Raylib.Types.Wave)

foreign import ccall safe "bindings.h LoadSound_" c'loadSound :: CString -> IO (Ptr Raylib.Types.Sound)

loadSound :: String -> IO Sound
loadSound :: String -> IO Sound
loadSound String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Sound)
c'loadSound forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadSound"
  p'loadSound ::
    FunPtr (CString -> IO Raylib.Types.Sound)

foreign import ccall safe "bindings.h LoadSoundFromWave_" c'loadSoundFromWave :: Ptr Raylib.Types.Wave -> IO (Ptr Raylib.Types.Sound)

loadSoundFromWave :: Wave -> IO Sound
loadSoundFromWave :: Wave -> IO Sound
loadSoundFromWave Wave
wave = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
wave Ptr Wave -> IO (Ptr Sound)
c'loadSoundFromWave forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadSoundFromWave"
  p'loadSoundFromWave ::
    FunPtr (Raylib.Types.Wave -> IO Raylib.Types.Sound)

foreign import ccall safe "bindings.h UpdateSound_" c'updateSound :: Ptr Raylib.Types.Sound -> Ptr () -> CInt -> IO ()

updateSound :: Sound -> Ptr () -> Int -> IO ()
updateSound :: Sound -> Ptr () -> Int -> IO ()
updateSound Sound
sound Ptr ()
dataValue Int
sampleCount = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound (\Ptr Sound
s -> Ptr Sound -> Ptr () -> CInt -> IO ()
c'updateSound Ptr Sound
s Ptr ()
dataValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleCount))

foreign import ccall safe "raylib.h &UpdateSound"
  p'updateSound ::
    FunPtr (Raylib.Types.Sound -> Ptr () -> CInt -> IO ())

foreign import ccall safe "bindings.h UnloadWave_" c'unloadWave :: Ptr Raylib.Types.Wave -> IO ()

unloadWave :: Wave -> IO ()
unloadWave :: Wave -> IO ()
unloadWave Wave
wave = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
wave Ptr Wave -> IO ()
c'unloadWave

foreign import ccall safe "raylib.h &UnloadWave"
  p'unloadWave ::
    FunPtr (Raylib.Types.Wave -> IO ())

foreign import ccall safe "bindings.h UnloadSound_" c'unloadSound :: Ptr Raylib.Types.Sound -> IO ()

unloadSound :: Sound -> IO ()
unloadSound :: Sound -> IO ()
unloadSound Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'unloadSound

foreign import ccall safe "raylib.h &UnloadSound"
  p'unloadSound ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "bindings.h ExportWave_" c'exportWave :: Ptr Raylib.Types.Wave -> CString -> IO CBool

exportWave :: Wave -> String -> IO Bool
exportWave :: Wave -> String -> IO Bool
exportWave Wave
wave 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
wave (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wave -> CString -> IO CBool
c'exportWave)

foreign import ccall safe "raylib.h &ExportWave"
  p'exportWave ::
    FunPtr (Raylib.Types.Wave -> CString -> IO CInt)

foreign import ccall safe "bindings.h ExportWaveAsCode_" c'exportWaveAsCode :: Ptr Raylib.Types.Wave -> CString -> IO CBool

exportWaveAsCode :: Wave -> String -> IO Bool
exportWaveAsCode :: Wave -> String -> IO Bool
exportWaveAsCode Wave
wave 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. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
wave (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wave -> CString -> IO CBool
c'exportWaveAsCode)

foreign import ccall safe "raylib.h &ExportWaveAsCode"
  p'exportWaveAsCode ::
    FunPtr (Raylib.Types.Wave -> CString -> IO CInt)

foreign import ccall safe "bindings.h PlaySound_" c'playSound :: Ptr Raylib.Types.Sound -> IO ()

playSound :: Sound -> IO ()
playSound :: Sound -> IO ()
playSound Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'playSound

foreign import ccall safe "raylib.h &PlaySound"
  p'playSound ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "bindings.h StopSound_" c'stopSound :: Ptr Raylib.Types.Sound -> IO ()

stopSound :: Sound -> IO ()
stopSound :: Sound -> IO ()
stopSound Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'stopSound

foreign import ccall safe "raylib.h &StopSound"
  p'stopSound ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "bindings.h PauseSound_" c'pauseSound :: Ptr Raylib.Types.Sound -> IO ()

pauseSound :: Sound -> IO ()
pauseSound :: Sound -> IO ()
pauseSound Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'pauseSound

foreign import ccall safe "raylib.h &PauseSound"
  p'pauseSound ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "bindings.h ResumeSound_" c'resumeSound :: Ptr Raylib.Types.Sound -> IO ()

resumeSound :: Sound -> IO ()
resumeSound :: Sound -> IO ()
resumeSound Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'resumeSound

foreign import ccall safe "raylib.h &ResumeSound"
  p'resumeSound ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "bindings.h PlaySoundMulti_" c'playSoundMulti :: Ptr Raylib.Types.Sound -> IO ()

playSoundMulti :: Sound -> IO ()
playSoundMulti :: Sound -> IO ()
playSoundMulti Sound
sound = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO ()
c'playSoundMulti

foreign import ccall safe "raylib.h &PlaySoundMulti"
  p'playSoundMulti ::
    FunPtr (Raylib.Types.Sound -> IO ())

foreign import ccall safe "raylib.h StopSoundMulti"
  stopSoundMulti ::
    IO ()

foreign import ccall safe "raylib.h &StopSoundMulti"
  p'stopSoundMulti ::
    FunPtr (IO ())

foreign import ccall safe "raylib.h GetSoundsPlaying"
  c'getSoundsPlaying ::
    IO CInt

getSoundsPlaying :: IO Int
getSoundsPlaying :: IO Int
getSoundsPlaying = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'getSoundsPlaying

foreign import ccall safe "raylib.h &GetSoundsPlaying"
  p'getSoundsPlaying ::
    FunPtr (IO CInt)

foreign import ccall safe "bindings.h IsSoundPlaying_" c'isSoundPlaying :: Ptr Raylib.Types.Sound -> IO CBool

isSoundPlaying :: Sound -> IO Bool
isSoundPlaying :: Sound -> IO Bool
isSoundPlaying Sound
sound = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound Ptr Sound -> IO CBool
c'isSoundPlaying

foreign import ccall safe "raylib.h &IsSoundPlaying"
  p'isSoundPlaying ::
    FunPtr (Raylib.Types.Sound -> IO CInt)

foreign import ccall safe "bindings.h SetSoundVolume_" c'setSoundVolume :: Ptr Raylib.Types.Sound -> CFloat -> IO ()

setSoundVolume :: Sound -> Float -> IO ()
setSoundVolume :: Sound -> Float -> IO ()
setSoundVolume Sound
sound Float
volume = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundVolume Ptr Sound
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

foreign import ccall safe "raylib.h &SetSoundVolume"
  p'setSoundVolume ::
    FunPtr (Raylib.Types.Sound -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetSoundPitch_" c'setSoundPitch :: Ptr Raylib.Types.Sound -> CFloat -> IO ()

setSoundPitch :: Sound -> Float -> IO ()
setSoundPitch :: Sound -> Float -> IO ()
setSoundPitch Sound
sound Float
pitch = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundPitch Ptr Sound
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

foreign import ccall safe "raylib.h &SetSoundPitch"
  p'setSoundPitch ::
    FunPtr (Raylib.Types.Sound -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetSoundPan_" c'setSoundPan :: Ptr Raylib.Types.Sound -> CFloat -> IO ()

setSoundPan :: Sound -> Float -> IO ()
setSoundPan :: Sound -> Float -> IO ()
setSoundPan Sound
sound Float
pan = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Sound
sound (\Ptr Sound
s -> Ptr Sound -> CFloat -> IO ()
c'setSoundPan Ptr Sound
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

foreign import ccall safe "raylib.h &SetSoundPan"
  p'setSoundPan ::
    FunPtr (Raylib.Types.Sound -> CFloat -> IO ())

foreign import ccall safe "bindings.h WaveCopy_" c'waveCopy :: Ptr Raylib.Types.Wave -> IO (Ptr Raylib.Types.Wave)

waveCopy :: Wave -> IO Wave
waveCopy :: Wave -> IO Wave
waveCopy Wave
wave = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
wave Ptr Wave -> IO (Ptr Wave)
c'waveCopy forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &WaveCopy"
  p'waveCopy ::
    FunPtr (Raylib.Types.Wave -> IO Raylib.Types.Wave)

foreign import ccall safe "raylib.h WaveCrop"
  c'waveCrop ::
    Ptr Raylib.Types.Wave -> CInt -> CInt -> IO ()

waveCrop :: Wave -> Int -> Int -> IO Wave
waveCrop :: Wave -> Int -> Int -> IO Wave
waveCrop Wave
wave Int
initSample Int
finalSample = do
  Wave
new <- Wave -> IO Wave
waveCopy Wave
wave
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
new (\Ptr Wave
w -> Ptr Wave -> CInt -> CInt -> IO ()
c'waveCrop Ptr Wave
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
initSample) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
finalSample) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Wave
w)

foreign import ccall safe "raylib.h &WaveCrop"
  p'waveCrop ::
    FunPtr (Ptr Raylib.Types.Wave -> CInt -> CInt -> IO ())

foreign import ccall safe "raylib.h WaveFormat"
  c'waveFormat ::
    Ptr Raylib.Types.Wave -> CInt -> CInt -> CInt -> IO ()

waveFormat :: Wave -> Int -> Int -> Int -> IO ()
waveFormat :: Wave -> Int -> Int -> Int -> IO ()
waveFormat Wave
wave Int
sampleRate Int
sampleSize Int
channels = do
  Wave
new <- Wave -> IO Wave
waveCopy Wave
wave
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Wave
new (\Ptr Wave
n -> Ptr Wave -> CInt -> CInt -> CInt -> IO ()
c'waveFormat Ptr Wave
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleRate) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sampleSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channels))

foreign import ccall safe "raylib.h &WaveFormat"
  p'waveFormat ::
    FunPtr (Ptr Raylib.Types.Wave -> CInt -> CInt -> CInt -> IO ())

foreign import ccall safe "bindings.h LoadWaveSamples_" c'loadWaveSamples :: Ptr Raylib.Types.Wave -> IO (Ptr CFloat)

loadWaveSamples :: Wave -> IO [Float]
loadWaveSamples :: Wave -> IO [Float]
loadWaveSamples Wave
wave =
  forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
    Wave
wave
    ( \Ptr Wave
w -> do
        Ptr CFloat
ptr <- Ptr Wave -> IO (Ptr CFloat)
c'loadWaveSamples Ptr Wave
w
        [CFloat]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Wave -> CUInt
wave'frameCount Wave
wave forall a. Num a => a -> a -> a
* Wave -> CUInt
wave'channels Wave
wave) Ptr CFloat
ptr
        Ptr CFloat -> IO ()
c'unloadWaveSamples Ptr CFloat
ptr
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [CFloat]
arr
    )

foreign import ccall safe "raylib.h &LoadWaveSamples"
  p'loadWaveSamples ::
    FunPtr (Raylib.Types.Wave -> IO (Ptr CFloat))

foreign import ccall safe "raylib.h UnloadWaveSamples"
  c'unloadWaveSamples ::
    Ptr CFloat -> IO ()

foreign import ccall safe "raylib.h &UnloadWaveSamples"
  p'unloadWaveSamples ::
    FunPtr (Ptr CFloat -> IO ())

foreign import ccall safe "bindings.h LoadMusicStream_" c'loadMusicStream :: CString -> IO (Ptr Raylib.Types.Music)

loadMusicStream :: String -> IO Music
loadMusicStream :: String -> IO Music
loadMusicStream String
fileName = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Music)
c'loadMusicStream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadMusicStream"
  p'loadMusicStream ::
    FunPtr (CString -> IO Raylib.Types.Music)

foreign import ccall safe "bindings.h LoadMusicStreamFromMemory_" c'loadMusicStreamFromMemory :: CString -> Ptr CUChar -> CInt -> IO (Ptr Raylib.Types.Music)

loadMusicStreamFromMemory :: String -> [Integer] -> IO Music
loadMusicStreamFromMemory :: String -> [Integer] -> IO Music
loadMusicStreamFromMemory String
fileType [Integer]
streamData = forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
t -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
streamData) (\Int
size Ptr CUChar
d -> CString -> Ptr CUChar -> CInt -> IO (Ptr Music)
c'loadMusicStreamFromMemory CString
t Ptr CUChar
d (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. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadMusicStreamFromMemory"
  p'loadMusicStreamFromMemory ::
    FunPtr (CString -> Ptr CUChar -> CInt -> IO Raylib.Types.Music)

foreign import ccall safe "bindings.h UnloadMusicStream_" c'unloadMusicStream :: Ptr Raylib.Types.Music -> IO ()

unloadMusicStream :: Music -> IO ()
unloadMusicStream :: Music -> IO ()
unloadMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'unloadMusicStream

foreign import ccall safe "raylib.h &UnloadMusicStream"
  p'unloadMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h PlayMusicStream_" c'playMusicStream :: Ptr Raylib.Types.Music -> IO ()

playMusicStream :: Music -> IO ()
playMusicStream :: Music -> IO ()
playMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'playMusicStream

foreign import ccall safe "raylib.h &PlayMusicStream"
  p'playMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h IsMusicStreamPlaying_" c'isMusicStreamPlaying :: Ptr Raylib.Types.Music -> IO CBool

isMusicStreamPlaying :: Music -> IO Bool
isMusicStreamPlaying :: Music -> IO Bool
isMusicStreamPlaying Music
music = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO CBool
c'isMusicStreamPlaying

foreign import ccall safe "raylib.h &IsMusicStreamPlaying"
  p'isMusicStreamPlaying ::
    FunPtr (Raylib.Types.Music -> IO CInt)

foreign import ccall safe "bindings.h UpdateMusicStream_" c'updateMusicStream :: Ptr Raylib.Types.Music -> IO ()

updateMusicStream :: Music -> IO ()
updateMusicStream :: Music -> IO ()
updateMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'updateMusicStream

foreign import ccall safe "raylib.h &UpdateMusicStream"
  p'updateMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h StopMusicStream_" c'stopMusicStream :: Ptr Raylib.Types.Music -> IO ()

stopMusicStream :: Music -> IO ()
stopMusicStream :: Music -> IO ()
stopMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'stopMusicStream

foreign import ccall safe "raylib.h &StopMusicStream"
  p'stopMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h PauseMusicStream_" c'pauseMusicStream :: Ptr Raylib.Types.Music -> IO ()

pauseMusicStream :: Music -> IO ()
pauseMusicStream :: Music -> IO ()
pauseMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'pauseMusicStream

foreign import ccall safe "raylib.h &PauseMusicStream"
  p'pauseMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h ResumeMusicStream_" c'resumeMusicStream :: Ptr Raylib.Types.Music -> IO ()

resumeMusicStream :: Music -> IO ()
resumeMusicStream :: Music -> IO ()
resumeMusicStream Music
music = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO ()
c'resumeMusicStream

foreign import ccall safe "raylib.h &ResumeMusicStream"
  p'resumeMusicStream ::
    FunPtr (Raylib.Types.Music -> IO ())

foreign import ccall safe "bindings.h SeekMusicStream_" c'seekMusicStream :: Ptr Raylib.Types.Music -> CFloat -> IO ()

seekMusicStream :: Music -> Float -> IO ()
seekMusicStream :: Music -> Float -> IO ()
seekMusicStream Music
music Float
position = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'seekMusicStream Ptr Music
m (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
position))

foreign import ccall safe "raylib.h &SeekMusicStream"
  p'seekMusicStream ::
    FunPtr (Raylib.Types.Music -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetMusicVolume_" c'setMusicVolume :: Ptr Raylib.Types.Music -> CFloat -> IO ()

setMusicVolume :: Music -> Float -> IO ()
setMusicVolume :: Music -> Float -> IO ()
setMusicVolume Music
music Float
volume = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicVolume Ptr Music
m (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

foreign import ccall safe "raylib.h &SetMusicVolume"
  p'setMusicVolume ::
    FunPtr (Raylib.Types.Music -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetMusicPitch_" c'setMusicPitch :: Ptr Raylib.Types.Music -> CFloat -> IO ()

setMusicPitch :: Music -> Float -> IO ()
setMusicPitch :: Music -> Float -> IO ()
setMusicPitch Music
music Float
pitch = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicPitch Ptr Music
m (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

foreign import ccall safe "raylib.h &SetMusicPitch"
  p'setMusicPitch ::
    FunPtr (Raylib.Types.Music -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetMusicPan_" c'setMusicPan :: Ptr Raylib.Types.Music -> CFloat -> IO ()

setMusicPan :: Music -> Float -> IO ()
setMusicPan :: Music -> Float -> IO ()
setMusicPan Music
music Float
pan = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music (\Ptr Music
m -> Ptr Music -> CFloat -> IO ()
c'setMusicPan Ptr Music
m (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

foreign import ccall safe "raylib.h &SetMusicPan"
  p'setMusicPan ::
    FunPtr (Raylib.Types.Music -> CFloat -> IO ())

foreign import ccall safe "bindings.h GetMusicTimeLength_" c'getMusicTimeLength :: Ptr Raylib.Types.Music -> IO CFloat

getMusicTimeLength :: Music -> IO Float
getMusicTimeLength :: Music -> IO Float
getMusicTimeLength Music
music = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO CFloat
c'getMusicTimeLength

foreign import ccall safe "raylib.h &GetMusicTimeLength"
  p'getMusicTimeLength ::
    FunPtr (Raylib.Types.Music -> IO CFloat)

foreign import ccall safe "bindings.h GetMusicTimePlayed_" c'getMusicTimePlayed :: Ptr Raylib.Types.Music -> IO CFloat

getMusicTimePlayed :: Music -> IO Float
getMusicTimePlayed :: Music -> IO Float
getMusicTimePlayed Music
music = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Music
music Ptr Music -> IO CFloat
c'getMusicTimePlayed

foreign import ccall safe "raylib.h &GetMusicTimePlayed"
  p'getMusicTimePlayed ::
    FunPtr (Raylib.Types.Music -> IO CFloat)

foreign import ccall safe "bindings.h LoadAudioStream_" c'loadAudioStream :: CUInt -> CUInt -> CUInt -> IO (Ptr Raylib.Types.AudioStream)

loadAudioStream :: Integer -> Integer -> Integer -> IO AudioStream
loadAudioStream :: Integer -> Integer -> Integer -> IO AudioStream
loadAudioStream Integer
sampleRate Integer
sampleSize Integer
channels = CUInt -> CUInt -> CUInt -> IO (Ptr AudioStream)
c'loadAudioStream (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleRate) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
channels) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> IO a
pop

foreign import ccall safe "raylib.h &LoadAudioStream"
  p'loadAudioStream ::
    FunPtr (CUInt -> CUInt -> CUInt -> IO Raylib.Types.AudioStream)

foreign import ccall safe "bindings.h UnloadAudioStream_" c'unloadAudioStream :: Ptr Raylib.Types.AudioStream -> IO ()

unloadAudioStream :: AudioStream -> IO ()
unloadAudioStream :: AudioStream -> IO ()
unloadAudioStream AudioStream
stream = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO ()
c'unloadAudioStream

foreign import ccall safe "raylib.h &UnloadAudioStream"
  p'unloadAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> IO ())

foreign import ccall safe "bindings.h UpdateAudioStream_" c'updateAudioStream :: Ptr Raylib.Types.AudioStream -> Ptr () -> CInt -> IO ()

updateAudioStream :: AudioStream -> Ptr () -> Int -> IO ()
updateAudioStream :: AudioStream -> Ptr () -> Int -> IO ()
updateAudioStream AudioStream
stream Ptr ()
value Int
frameCount = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> Ptr () -> CInt -> IO ()
c'updateAudioStream Ptr AudioStream
s Ptr ()
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameCount))

foreign import ccall safe "raylib.h &UpdateAudioStream"
  p'updateAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> Ptr () -> CInt -> IO ())

foreign import ccall safe "bindings.h IsAudioStreamProcessed_" c'isAudioStreamProcessed :: Ptr Raylib.Types.AudioStream -> IO CBool

isAudioStreamProcessed :: AudioStream -> IO Bool
isAudioStreamProcessed :: AudioStream -> IO Bool
isAudioStreamProcessed AudioStream
stream = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO CBool
c'isAudioStreamProcessed

foreign import ccall safe "raylib.h &IsAudioStreamProcessed"
  p'isAudioStreamProcessed ::
    FunPtr (Raylib.Types.AudioStream -> IO CInt)

foreign import ccall safe "bindings.h PlayAudioStream_" c'playAudioStream :: Ptr Raylib.Types.AudioStream -> IO ()

playAudioStream :: AudioStream -> IO ()
playAudioStream :: AudioStream -> IO ()
playAudioStream AudioStream
stream = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO ()
c'playAudioStream

foreign import ccall safe "raylib.h &PlayAudioStream"
  p'playAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> IO ())

foreign import ccall safe "bindings.h PauseAudioStream_" c'pauseAudioStream :: Ptr Raylib.Types.AudioStream -> IO ()

pauseAudioStream :: AudioStream -> IO ()
pauseAudioStream :: AudioStream -> IO ()
pauseAudioStream AudioStream
stream = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO ()
c'pauseAudioStream

foreign import ccall safe "raylib.h &PauseAudioStream"
  p'pauseAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> IO ())

foreign import ccall safe "bindings.h ResumeAudioStream_" c'resumeAudioStream :: Ptr Raylib.Types.AudioStream -> IO ()

resumeAudioStream :: AudioStream -> IO ()
resumeAudioStream :: AudioStream -> IO ()
resumeAudioStream AudioStream
stream = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO ()
c'resumeAudioStream

foreign import ccall safe "raylib.h &ResumeAudioStream"
  p'resumeAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> IO ())

foreign import ccall safe "bindings.h IsAudioStreamPlaying_" c'isAudioStreamPlaying :: Ptr Raylib.Types.AudioStream -> IO CBool

isAudioStreamPlaying :: AudioStream -> IO Bool
isAudioStreamPlaying :: AudioStream -> IO Bool
isAudioStreamPlaying AudioStream
stream = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO CBool
c'isAudioStreamPlaying

foreign import ccall safe "raylib.h &IsAudioStreamPlaying"
  p'isAudioStreamPlaying ::
    FunPtr (Raylib.Types.AudioStream -> IO CInt)

foreign import ccall safe "bindings.h StopAudioStream_" c'stopAudioStream :: Ptr Raylib.Types.AudioStream -> IO ()

stopAudioStream :: AudioStream -> IO ()
stopAudioStream :: AudioStream -> IO ()
stopAudioStream AudioStream
stream = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream Ptr AudioStream -> IO ()
c'stopAudioStream

foreign import ccall safe "raylib.h &StopAudioStream"
  p'stopAudioStream ::
    FunPtr (Raylib.Types.AudioStream -> IO ())

foreign import ccall safe "bindings.h SetAudioStreamVolume_" c'setAudioStreamVolume :: Ptr Raylib.Types.AudioStream -> CFloat -> IO ()

setAudioStreamVolume :: AudioStream -> Float -> IO ()
setAudioStreamVolume :: AudioStream -> Float -> IO ()
setAudioStreamVolume AudioStream
stream Float
volume = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamVolume Ptr AudioStream
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume))

foreign import ccall safe "raylib.h &SetAudioStreamVolume"
  p'setAudioStreamVolume ::
    FunPtr (Raylib.Types.AudioStream -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetAudioStreamPitch_" c'setAudioStreamPitch :: Ptr Raylib.Types.AudioStream -> CFloat -> IO ()

setAudioStreamPitch :: AudioStream -> Float -> IO ()
setAudioStreamPitch :: AudioStream -> Float -> IO ()
setAudioStreamPitch AudioStream
stream Float
pitch = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamPitch Ptr AudioStream
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch))

foreign import ccall safe "raylib.h &SetAudioStreamPitch"
  p'setAudioStreamPitch ::
    FunPtr (Raylib.Types.AudioStream -> CFloat -> IO ())

foreign import ccall safe "bindings.h SetAudioStreamPan_" c'setAudioStreamPan :: Ptr Raylib.Types.AudioStream -> CFloat -> IO ()

setAudioStreamPan :: AudioStream -> Float -> IO ()
setAudioStreamPan :: AudioStream -> Float -> IO ()
setAudioStreamPan AudioStream
stream Float
pan = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with AudioStream
stream (\Ptr AudioStream
s -> Ptr AudioStream -> CFloat -> IO ()
c'setAudioStreamPan Ptr AudioStream
s (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan))

foreign import ccall safe "raylib.h &SetAudioStreamPan"
  p'setAudioStreamPan ::
    FunPtr (Raylib.Types.AudioStream -> CFloat -> IO ())

foreign import ccall safe "raylib.h SetAudioStreamBufferSizeDefault"
  c'setAudioStreamBufferSizeDefault ::
    CInt -> IO ()

setAudioStreamBufferSizeDefault :: Int -> IO ()
setAudioStreamBufferSizeDefault :: Int -> IO ()
setAudioStreamBufferSizeDefault = Int -> IO ()
setAudioStreamBufferSizeDefault forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

foreign import ccall safe "raylib.h &SetAudioStreamBufferSizeDefault"
  p'setAudioStreamBufferSizeDefault ::
    FunPtr (CInt -> IO ())

foreign import ccall safe "bindings.h SetAudioStreamCallback_" c'setAudioStreamCallback :: Ptr Raylib.Types.AudioStream -> Ptr AudioCallback -> IO ()

foreign import ccall safe "raylib.h &SetAudioStreamCallback"
  p'setAudioStreamCallback ::
    FunPtr (Raylib.Types.AudioStream -> AudioCallback -> IO ())

foreign import ccall safe "bindings.h AttachAudioStreamProcessor_" c'attachAudioStreamProcessor :: Ptr Raylib.Types.AudioStream -> Ptr AudioCallback -> IO ()

foreign import ccall safe "raylib.h &AttachAudioStreamProcessor"
  p'attachAudioStreamProcessor ::
    FunPtr (Raylib.Types.AudioStream -> AudioCallback -> IO ())

foreign import ccall safe "bindings.h DetachAudioStreamProcessor_" c'detachAudioStreamProcessor :: Ptr Raylib.Types.AudioStream -> Ptr AudioCallback -> IO ()

foreign import ccall safe "raylib.h &DetachAudioStreamProcessor"
  p'detachAudioStreamProcessor ::
    FunPtr (Raylib.Types.AudioStream -> AudioCallback -> IO ())