{-# OPTIONS -Wall #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Raylib.Core where

import Data.IORef (modifyIORef', readIORef)
import qualified Data.Map as Map
import Foreign
  ( Ptr,
    Storable (peek, sizeOf, poke),
    castPtr,
    fromBool,
    peekArray,
    toBool, malloc
  )
import Foreign.C
  ( CInt (CInt),
    CUChar,
    CUInt (CUInt),
    peekCString,
    withCString,
  )
import Raylib.ForeignUtil (c'free, configsToBitflag, pop, popCArray, popCString, withFreeable, withFreeableArray, withFreeableArrayLen, withMaybeCString)
import Raylib.Internal (addShaderId, unloadFrameBuffers, unloadShaders, unloadSingleShader, unloadTextures, unloadVaoIds, unloadVboIds, WindowResources, shaderLocations, defaultWindowResources, addAutomationEventList, unloadSingleAutomationEventList, unloadAutomationEventLists)
import Raylib.Native
  ( c'beginBlendMode,
    c'beginMode2D,
    c'beginMode3D,
    c'beginScissorMode,
    c'beginShaderMode,
    c'beginTextureMode,
    c'beginVrStereoMode,
    c'changeDirectory,
    c'clearBackground,
    c'clearWindowState,
    c'closeWindow,
    c'compressData,
    c'decodeDataBase64,
    c'decompressData,
    c'directoryExists,
    c'encodeDataBase64,
    c'exportDataAsCode,
    c'fileExists,
    c'getApplicationDirectory,
    c'getCameraMatrix,
    c'getCameraMatrix2D,
    c'getCharPressed,
    c'getClipboardText,
    c'getCurrentMonitor,
    c'getDirectoryPath,
    c'getFPS,
    c'getFileExtension,
    c'getFileLength,
    c'getFileModTime,
    c'getFileName,
    c'getFileNameWithoutExt,
    c'getFrameTime,
    c'getGamepadAxisCount,
    c'getGamepadAxisMovement,
    c'getGamepadButtonPressed,
    c'getGamepadName,
    c'getGestureDetected,
    c'getGestureDragAngle,
    c'getGestureDragVector,
    c'getGestureHoldDuration,
    c'getGesturePinchAngle,
    c'getGesturePinchVector,
    c'getKeyPressed,
    c'getMonitorCount,
    c'getMonitorHeight,
    c'getMonitorName,
    c'getMonitorPhysicalHeight,
    c'getMonitorPhysicalWidth,
    c'getMonitorPosition,
    c'getMonitorRefreshRate,
    c'getMonitorWidth,
    c'getMouseDelta,
    c'getMousePosition,
    c'getMouseRay,
    c'getMouseWheelMove,
    c'getMouseWheelMoveV,
    c'getMouseX,
    c'getMouseY,
    c'getPrevDirectoryPath,
    c'getRandomValue,
    c'getRenderHeight,
    c'getRenderWidth,
    c'getScreenHeight,
    c'getScreenToWorld2D,
    c'getScreenWidth,
    c'getShaderLocation,
    c'getShaderLocationAttrib,
    c'getTime,
    c'getTouchPointCount,
    c'getTouchPointId,
    c'getTouchPosition,
    c'getTouchX,
    c'getTouchY,
    c'getWindowPosition,
    c'getWindowScaleDPI,
    c'getWorkingDirectory,
    c'getWorldToScreen,
    c'getWorldToScreen2D,
    c'getWorldToScreenEx,
    c'initWindow,
    c'isCursorHidden,
    c'isCursorOnScreen,
    c'isFileDropped,
    c'isFileExtension,
    c'isGamepadAvailable,
    c'isGamepadButtonDown,
    c'isGamepadButtonPressed,
    c'isGamepadButtonReleased,
    c'isGamepadButtonUp,
    c'isGestureDetected,
    c'isKeyDown,
    c'isKeyPressed,
    c'isKeyReleased,
    c'isKeyUp,
    c'isMouseButtonDown,
    c'isMouseButtonPressed,
    c'isMouseButtonReleased,
    c'isMouseButtonUp,
    c'isPathFile,
    c'isShaderReady,
    c'isWindowFocused,
    c'isWindowFullscreen,
    c'isWindowHidden,
    c'isWindowMaximized,
    c'isWindowMinimized,
    c'isWindowReady,
    c'isWindowResized,
    c'isWindowState,
    c'loadDirectoryFiles,
    c'loadDirectoryFilesEx,
    c'loadDroppedFiles,
    c'loadFileData,
    c'loadFileText,
    c'loadShader,
    c'loadShaderFromMemory,
    c'loadVrStereoConfig,
    c'openURL,
    c'saveFileData,
    c'saveFileText,
    c'setClipboardText,
    c'setConfigFlags,
    c'setExitKey,
    c'setGamepadMappings,
    c'setGesturesEnabled,
    c'setMouseCursor,
    c'setMouseOffset,
    c'setMousePosition,
    c'setMouseScale,
    c'setRandomSeed,
    c'setShaderValue,
    c'setShaderValueMatrix,
    c'setShaderValueTexture,
    c'setShaderValueV,
    c'setTargetFPS,
    c'setTraceLogLevel,
    c'setWindowIcon,
    c'setWindowIcons,
    c'setWindowMinSize,
    c'setWindowMaxSize,
    c'setWindowMonitor,
    c'setWindowOpacity,
    c'setWindowPosition,
    c'setWindowSize,
    c'setWindowState,
    c'setWindowTitle,
    c'takeScreenshot,
    c'traceLog,
    c'waitTime,
    c'windowShouldClose, c'isKeyPressedRepeat, c'loadRandomSequence, c'loadAutomationEventList, c'exportAutomationEventList, c'setAutomationEventList, c'setAutomationEventBaseFrame, c'startAutomationEventRecording, c'stopAutomationEventRecording, c'playAutomationEvent,
  )
import Raylib.Types
  ( BlendMode,
    Camera2D,
    Camera3D,
    Color,
    ConfigFlag,
    FilePathList,
    GamepadAxis,
    GamepadButton,
    Gesture,
    Image,
    KeyboardKey,
    LoadFileDataCallback,
    LoadFileTextCallback,
    Matrix,
    MouseButton,
    MouseCursor,
    Ray,
    RenderTexture,
    SaveFileDataCallback,
    SaveFileTextCallback,
    Shader (shader'id),
    ShaderUniformData,
    ShaderUniformDataV,
    Texture,
    TraceLogLevel,
    Vector2,
    Vector3,
    VrDeviceInfo,
    VrStereoConfig,
    unpackShaderUniformData,
    unpackShaderUniformDataV, AutomationEventList, AutomationEventListRef, AutomationEvent,
  )
import Foreign.Ptr (nullPtr)

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

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

closeWindow :: WindowResources -> IO ()
closeWindow :: WindowResources -> IO ()
closeWindow WindowResources
wr = do
  WindowResources -> IO ()
unloadShaders WindowResources
wr
  WindowResources -> IO ()
unloadTextures WindowResources
wr
  WindowResources -> IO ()
unloadFrameBuffers WindowResources
wr
  WindowResources -> IO ()
unloadVaoIds WindowResources
wr
  WindowResources -> IO ()
unloadVboIds WindowResources
wr
  WindowResources -> IO ()
unloadAutomationEventLists WindowResources
wr
  IO ()
c'closeWindow

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "raylib.h ToggleBorderlessWindowed"
  toggleBorderlessWindowed ::
    IO ()

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

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

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

setWindowIcon :: Image -> IO ()
setWindowIcon :: Image -> IO ()
setWindowIcon Image
image = Image -> (Ptr Image -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image Ptr Image -> IO ()
c'setWindowIcon

setWindowIcons :: [Image] -> IO ()
setWindowIcons :: [Image] -> IO ()
setWindowIcons [Image]
images = [Image] -> (Int -> Ptr Image -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Image]
images (\Int
l Ptr Image
ptr -> Ptr Image -> CInt -> IO ()
c'setWindowIcons Ptr Image
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l))

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

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

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

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

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

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

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

foreign import ccall safe "raylib.h SetWindowFocused"
  setWindowFocused ::
    IO ()

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

clearBackground :: Color -> IO ()
clearBackground :: Color -> IO ()
clearBackground Color
color = Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color Ptr Color -> IO ()
c'clearBackground

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

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

beginMode2D :: Camera2D -> IO ()
beginMode2D :: Camera2D -> IO ()
beginMode2D Camera2D
camera = Camera2D -> (Ptr Camera2D -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera2D
camera Ptr Camera2D -> IO ()
c'beginMode2D

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

beginMode3D :: Camera3D -> IO ()
beginMode3D :: Camera3D -> IO ()
beginMode3D Camera3D
camera = Camera3D -> (Ptr Camera3D -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera Ptr Camera3D -> IO ()
c'beginMode3D

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

beginTextureMode :: RenderTexture -> IO ()
beginTextureMode :: RenderTexture -> IO ()
beginTextureMode RenderTexture
renderTexture = RenderTexture -> (Ptr RenderTexture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable RenderTexture
renderTexture Ptr RenderTexture -> IO ()
c'beginTextureMode

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

beginShaderMode :: Shader -> IO ()
beginShaderMode :: Shader -> IO ()
beginShaderMode Shader
shader = Shader -> (Ptr Shader -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader Ptr Shader -> IO ()
c'beginShaderMode

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

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

foreign import ccall safe "raylib.h EndBlendMode"
  endBlendMode ::
    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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

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

beginVrStereoMode :: VrStereoConfig -> IO ()
beginVrStereoMode :: VrStereoConfig -> IO ()
beginVrStereoMode VrStereoConfig
config = VrStereoConfig -> (Ptr VrStereoConfig -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable VrStereoConfig
config Ptr VrStereoConfig -> IO ()
c'beginVrStereoMode

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

loadVrStereoConfig :: VrDeviceInfo -> IO VrStereoConfig
loadVrStereoConfig :: VrDeviceInfo -> IO VrStereoConfig
loadVrStereoConfig VrDeviceInfo
deviceInfo = VrDeviceInfo
-> (Ptr VrDeviceInfo -> IO (Ptr VrStereoConfig))
-> IO (Ptr VrStereoConfig)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable VrDeviceInfo
deviceInfo Ptr VrDeviceInfo -> IO (Ptr VrStereoConfig)
c'loadVrStereoConfig IO (Ptr VrStereoConfig)
-> (Ptr VrStereoConfig -> IO VrStereoConfig) -> IO VrStereoConfig
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr VrStereoConfig -> IO VrStereoConfig
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadShader :: Maybe String -> Maybe String -> WindowResources -> IO Shader
loadShader :: Maybe String -> Maybe String -> WindowResources -> IO Shader
loadShader Maybe String
vsFileName Maybe String
fsFileName WindowResources
wr = do
  Shader
shader <- Maybe String -> (CString -> IO (Ptr Shader)) -> IO (Ptr Shader)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
vsFileName (Maybe String -> (CString -> IO (Ptr Shader)) -> IO (Ptr Shader)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
fsFileName ((CString -> IO (Ptr Shader)) -> IO (Ptr Shader))
-> (CString -> CString -> IO (Ptr Shader))
-> CString
-> IO (Ptr Shader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO (Ptr Shader)
c'loadShader) IO (Ptr Shader) -> (Ptr Shader -> IO Shader) -> IO Shader
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Shader -> IO Shader
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
addShaderId (Shader -> Integer
shader'id Shader
shader) WindowResources
wr
  Shader -> IO Shader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Shader
shader

loadShaderFromMemory :: Maybe String -> Maybe String -> WindowResources -> IO Shader
loadShaderFromMemory :: Maybe String -> Maybe String -> WindowResources -> IO Shader
loadShaderFromMemory Maybe String
vsCode Maybe String
fsCode WindowResources
wr = do
  Shader
shader <- Maybe String -> (CString -> IO (Ptr Shader)) -> IO (Ptr Shader)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
vsCode (Maybe String -> (CString -> IO (Ptr Shader)) -> IO (Ptr Shader)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
fsCode ((CString -> IO (Ptr Shader)) -> IO (Ptr Shader))
-> (CString -> CString -> IO (Ptr Shader))
-> CString
-> IO (Ptr Shader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO (Ptr Shader)
c'loadShaderFromMemory) IO (Ptr Shader) -> (Ptr Shader -> IO Shader) -> IO Shader
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Shader -> IO Shader
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
addShaderId (Shader -> Integer
shader'id Shader
shader) WindowResources
wr
  Shader -> IO Shader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Shader
shader

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

getShaderLocation :: Shader -> String -> WindowResources -> IO Int
getShaderLocation :: Shader -> String -> WindowResources -> IO Int
getShaderLocation Shader
shader String
uniformName WindowResources
wr = do
  let sId :: Integer
sId = Shader -> Integer
shader'id Shader
shader
  let sLocs :: IORef (Map Integer (Map String Int))
sLocs = WindowResources -> IORef (Map Integer (Map String Int))
shaderLocations WindowResources
wr
  Map Integer (Map String Int)
locs <- IORef (Map Integer (Map String Int))
-> IO (Map Integer (Map String Int))
forall a. IORef a -> IO a
readIORef IORef (Map Integer (Map String Int))
sLocs
  -- TODO: Clean this up if possible

  case Integer -> Map Integer (Map String Int) -> Maybe (Map String Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Integer
sId Map Integer (Map String Int)
locs of
    Maybe (Map String Int)
Nothing -> do
      Int
idx <- IO Int
locIdx
      let newMap :: Map String Int
newMap = [(String, Int)] -> Map String Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
uniformName, Int
idx)]
      IORef (Map Integer (Map String Int))
-> (Map Integer (Map String Int) -> Map Integer (Map String Int))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map Integer (Map String Int))
sLocs (Integer
-> Map String Int
-> Map Integer (Map String Int)
-> Map Integer (Map String Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Integer
sId Map String Int
newMap)
      Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
    Just Map String Int
m -> case String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
uniformName Map String Int
m of
      Maybe Int
Nothing -> do
        Int
idx <- IO Int
locIdx
        let newMap :: Map String Int
newMap = String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
uniformName Int
idx Map String Int
m
        IORef (Map Integer (Map String Int))
-> (Map Integer (Map String Int) -> Map Integer (Map String Int))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map Integer (Map String Int))
sLocs (Integer
-> Map String Int
-> Map Integer (Map String Int)
-> Map Integer (Map String Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Integer
sId Map String Int
newMap)
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
      Just Int
val -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
val
  where
    locIdx :: IO Int
locIdx = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shader -> (Ptr Shader -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
uniformName ((CString -> IO CInt) -> IO CInt)
-> (Ptr Shader -> CString -> IO CInt) -> Ptr Shader -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shader -> CString -> IO CInt
c'getShaderLocation)

getShaderLocationAttrib :: Shader -> String -> IO Int
getShaderLocationAttrib :: Shader -> String -> IO Int
getShaderLocationAttrib Shader
shader String
attribName = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shader -> (Ptr Shader -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
attribName ((CString -> IO CInt) -> IO CInt)
-> (Ptr Shader -> CString -> IO CInt) -> Ptr Shader -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shader -> CString -> IO CInt
c'getShaderLocationAttrib)

setShaderValue :: Shader -> String -> ShaderUniformData -> WindowResources -> IO ()
setShaderValue :: Shader -> String -> ShaderUniformData -> WindowResources -> IO ()
setShaderValue Shader
shader String
uniformName ShaderUniformData
value WindowResources
wr = do
  Int
idx <- Shader -> String -> WindowResources -> IO Int
getShaderLocation Shader
shader String
uniformName WindowResources
wr
  Shader -> Int -> ShaderUniformData -> IO ()
nativeSetShaderValue Shader
shader Int
idx ShaderUniformData
value

setShaderValueV :: Shader -> String -> ShaderUniformDataV -> WindowResources -> IO ()
setShaderValueV :: Shader -> String -> ShaderUniformDataV -> WindowResources -> IO ()
setShaderValueV Shader
shader String
uniformName ShaderUniformDataV
values WindowResources
wr = do
  Int
idx <- Shader -> String -> WindowResources -> IO Int
getShaderLocation Shader
shader String
uniformName WindowResources
wr
  Shader -> Int -> ShaderUniformDataV -> IO ()
nativeSetShaderValueV Shader
shader Int
idx ShaderUniformDataV
values

nativeSetShaderValue :: Shader -> Int -> ShaderUniformData -> IO ()
nativeSetShaderValue :: Shader -> Int -> ShaderUniformData -> IO ()
nativeSetShaderValue Shader
shader Int
locIndex ShaderUniformData
value = do
  (ShaderUniformDataType
uniformType, Ptr ()
ptr) <- ShaderUniformData -> IO (ShaderUniformDataType, Ptr ())
unpackShaderUniformData ShaderUniformData
value
  Shader -> (Ptr Shader -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (\Ptr Shader
s -> Ptr Shader -> CInt -> Ptr () -> CInt -> IO ()
c'setShaderValue Ptr Shader
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ ShaderUniformDataType -> Int
forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
uniformType))
  Ptr () -> IO ()
c'free (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr

nativeSetShaderValueV :: Shader -> Int -> ShaderUniformDataV -> IO ()
nativeSetShaderValueV :: Shader -> Int -> ShaderUniformDataV -> IO ()
nativeSetShaderValueV Shader
shader Int
locIndex ShaderUniformDataV
values = do
  (ShaderUniformDataType
uniformType, Ptr ()
ptr, Int
l) <- ShaderUniformDataV -> IO (ShaderUniformDataType, Ptr (), Int)
unpackShaderUniformDataV ShaderUniformDataV
values
  Shader -> (Ptr Shader -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (\Ptr Shader
s -> Ptr Shader -> CInt -> Ptr () -> CInt -> CInt -> IO ()
c'setShaderValueV Ptr Shader
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex) Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ ShaderUniformDataType -> Int
forall a. Enum a => a -> Int
fromEnum ShaderUniformDataType
uniformType) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l))
  Ptr () -> IO ()
c'free (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr

setShaderValueMatrix :: Shader -> Int -> Matrix -> IO ()
setShaderValueMatrix :: Shader -> Int -> Matrix -> IO ()
setShaderValueMatrix Shader
shader Int
locIndex Matrix
mat = Shader -> (Ptr Shader -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (\Ptr Shader
s -> Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
mat (Ptr Shader -> CInt -> Ptr Matrix -> IO ()
c'setShaderValueMatrix Ptr Shader
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex)))

setShaderValueTexture :: Shader -> Int -> Texture -> IO ()
setShaderValueTexture :: Shader -> Int -> Texture -> IO ()
setShaderValueTexture Shader
shader Int
locIndex Texture
tex = Shader -> (Ptr Shader -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Shader
shader (\Ptr Shader
s -> Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
tex (Ptr Shader -> CInt -> Ptr Texture -> IO ()
c'setShaderValueTexture Ptr Shader
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
locIndex)))

-- | Unloads a shader from GPU memory (VRAM). Shaders are automatically unloaded

-- when `closeWindow` is called, so manually unloading shaders is not required.

-- In larger projects, you may want to manually unload shaders to avoid having

-- them in VRAM for too long.

unloadShader :: Shader -> WindowResources -> IO ()
unloadShader :: Shader -> WindowResources -> IO ()
unloadShader Shader
shader = Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleShader (Shader -> Integer
shader'id Shader
shader)

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

getCameraMatrix :: Camera3D -> IO Matrix
getCameraMatrix :: Camera3D -> IO Matrix
getCameraMatrix Camera3D
camera = Camera3D -> (Ptr Camera3D -> IO (Ptr Matrix)) -> IO (Ptr Matrix)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera Ptr Camera3D -> IO (Ptr Matrix)
c'getCameraMatrix IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getCameraMatrix2D :: Camera2D -> IO Matrix
getCameraMatrix2D :: Camera2D -> IO Matrix
getCameraMatrix2D Camera2D
camera = Camera2D -> (Ptr Camera2D -> IO (Ptr Matrix)) -> IO (Ptr Matrix)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera2D
camera Ptr Camera2D -> IO (Ptr Matrix)
c'getCameraMatrix2D IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Matrix -> IO Matrix
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

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

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

getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> IO Vector2
getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> IO Vector2
getWorldToScreenEx Vector3
position Camera3D
camera Int
width Int
height = Vector3 -> (Ptr Vector3 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Camera3D -> (Ptr Camera3D -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> Ptr Vector3 -> Ptr Camera3D -> CInt -> CInt -> IO (Ptr Vector2)
c'getWorldToScreenEx Ptr Vector3
p Ptr Camera3D
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

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

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

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

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

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

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

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

loadRandomSequence :: Integer -> Int -> Int -> IO [Int]
loadRandomSequence :: Integer -> Int -> Int -> IO [Int]
loadRandomSequence Integer
count Int
rMin Int
rMax = (CInt -> Int) -> [CInt] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CInt] -> [Int]) -> IO [CInt] -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Ptr CInt -> IO [CInt]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count) (Ptr CInt -> IO [CInt]) -> IO (Ptr CInt) -> IO [CInt]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CUInt -> CInt -> CInt -> IO (Ptr CInt)
c'loadRandomSequence (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rMin) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rMax))

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

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

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

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

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

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

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

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

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

loadFileData :: String -> IO [Integer]
loadFileData :: String -> IO [Integer]
loadFileData String
fileName =
  CInt -> (Ptr CInt -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    CInt
0
    ( \Ptr CInt
size -> do
        String -> (CString -> IO [Integer]) -> IO [Integer]
forall a. String -> (CString -> IO a) -> IO a
withCString
          String
fileName
          ( \CString
path -> do
              Ptr CUChar
ptr <- CString -> Ptr CInt -> IO (Ptr CUChar)
c'loadFileData CString
path Ptr CInt
size
              Int
arrSize <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
size
              (CUChar -> Integer) -> [CUChar] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CUChar] -> [Integer]) -> IO [CUChar] -> IO [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CUChar -> IO [CUChar]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
arrSize Ptr CUChar
ptr
          )
    )

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

exportDataAsCode :: [Integer] -> Integer -> String -> IO Bool
exportDataAsCode :: [Integer] -> Integer -> String -> IO Bool
exportDataAsCode [Integer]
contents Integer
size String
fileName =
  CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CUChar] -> (Ptr CUChar -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a. Num a => Integer -> a
fromInteger [Integer]
contents) (\Ptr CUChar
c -> String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (Ptr CUChar -> CInt -> CString -> IO CBool
c'exportDataAsCode Ptr CUChar
c (Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

loadDirectoryFilesEx :: String -> String -> Bool -> IO FilePathList
loadDirectoryFilesEx :: String -> String -> Bool -> IO FilePathList
loadDirectoryFilesEx String
basePath String
filterStr Bool
scanSubdirs =
  String
-> (CString -> IO (Ptr FilePathList)) -> IO (Ptr FilePathList)
forall a. String -> (CString -> IO a) -> IO a
withCString String
basePath (\CString
b -> String
-> (CString -> IO (Ptr FilePathList)) -> IO (Ptr FilePathList)
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 (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
scanSubdirs))) IO (Ptr FilePathList)
-> (Ptr FilePathList -> IO FilePathList) -> IO FilePathList
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr FilePathList -> IO FilePathList
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

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

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

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

compressData :: [Integer] -> IO [Integer]
compressData :: [Integer] -> IO [Integer]
compressData [Integer]
contents = do
  [CUChar] -> (Int -> Ptr CUChar -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
    ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
contents)
    ( \Int
size Ptr CUChar
c -> do
        CInt -> (Ptr CInt -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
ptr -> do
              Ptr CUChar
compressed <- Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)
c'compressData Ptr CUChar
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUChar -> Int
forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)) Ptr CInt
ptr
              Int
compressedSize <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
              [CUChar]
arr <- Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
compressedSize Ptr CUChar
compressed
              [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer] -> IO [Integer]) -> [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (CUChar -> Integer) -> [CUChar] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

decompressData :: [Integer] -> IO [Integer]
decompressData :: [Integer] -> IO [Integer]
decompressData [Integer]
compressedData = do
  [CUChar] -> (Int -> Ptr CUChar -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
    ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
compressedData)
    ( \Int
size Ptr CUChar
c -> do
        CInt -> (Ptr CInt -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
ptr -> do
              Ptr CUChar
decompressed <- Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)
c'decompressData Ptr CUChar
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUChar -> Int
forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)) Ptr CInt
ptr
              Int
decompressedSize <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
              [CUChar]
arr <- Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
decompressedSize Ptr CUChar
decompressed
              [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer] -> IO [Integer]) -> [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (CUChar -> Integer) -> [CUChar] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr
          )
    )

encodeDataBase64 :: [Integer] -> IO [Integer]
encodeDataBase64 :: [Integer] -> IO [Integer]
encodeDataBase64 [Integer]
contents = do
  [CUChar] -> (Int -> Ptr CUChar -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
    ((Integer -> CUChar) -> [Integer] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
contents)
    ( \Int
size Ptr CUChar
c -> do
        CInt -> (Ptr CInt -> IO [Integer]) -> IO [Integer]
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
ptr -> do
              CString
encoded <- Ptr CUChar -> CInt -> Ptr CInt -> IO CString
c'encodeDataBase64 Ptr CUChar
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* CUChar -> Int
forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)) Ptr CInt
ptr
              Int
encodedSize <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
              [CChar]
arr <- Int -> CString -> IO [CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
encodedSize CString
encoded
              [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer] -> IO [Integer]) -> [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (CChar -> Integer) -> [CChar] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [CChar]
arr
          )
    )

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

loadAutomationEventList :: String -> IO AutomationEventList
loadAutomationEventList :: String -> IO AutomationEventList
loadAutomationEventList String
fileName = String
-> (CString -> IO (Ptr AutomationEventList))
-> IO (Ptr AutomationEventList)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr AutomationEventList)
c'loadAutomationEventList IO (Ptr AutomationEventList)
-> (Ptr AutomationEventList -> IO AutomationEventList)
-> IO AutomationEventList
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr AutomationEventList -> IO AutomationEventList
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

newAutomationEventList :: IO AutomationEventList
newAutomationEventList :: IO AutomationEventList
newAutomationEventList = CString -> IO (Ptr AutomationEventList)
c'loadAutomationEventList CString
forall a. Ptr a
nullPtr IO (Ptr AutomationEventList)
-> (Ptr AutomationEventList -> IO AutomationEventList)
-> IO AutomationEventList
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr AutomationEventList -> IO AutomationEventList
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

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

setAutomationEventList :: AutomationEventList -> WindowResources -> IO AutomationEventListRef
setAutomationEventList :: AutomationEventList
-> WindowResources -> IO (Ptr AutomationEventList)
setAutomationEventList AutomationEventList
list WindowResources
wr = do
  Ptr AutomationEventList
ptr <- IO (Ptr AutomationEventList)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr AutomationEventList -> AutomationEventList -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AutomationEventList
ptr AutomationEventList
list
  Ptr AutomationEventList -> IO ()
c'setAutomationEventList Ptr AutomationEventList
ptr
  Ptr () -> WindowResources -> IO ()
addAutomationEventList (Ptr AutomationEventList -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AutomationEventList
ptr) WindowResources
wr
  Ptr AutomationEventList -> IO (Ptr AutomationEventList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AutomationEventList
ptr

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

startAutomationEventRecording :: IO ()
startAutomationEventRecording :: IO ()
startAutomationEventRecording = IO ()
c'startAutomationEventRecording

stopAutomationEventRecording :: IO ()
stopAutomationEventRecording :: IO ()
stopAutomationEventRecording = IO ()
c'stopAutomationEventRecording

playAutomationEvent :: AutomationEvent -> IO ()
playAutomationEvent :: AutomationEvent -> IO ()
playAutomationEvent AutomationEvent
event = AutomationEvent -> (Ptr AutomationEvent -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable AutomationEvent
event Ptr AutomationEvent -> IO ()
c'playAutomationEvent

peekAutomationEventList :: AutomationEventListRef -> IO AutomationEventList
peekAutomationEventList :: Ptr AutomationEventList -> IO AutomationEventList
peekAutomationEventList = Ptr AutomationEventList -> IO AutomationEventList
forall a. Storable a => Ptr a -> IO a
peek

freeAutomationEventList :: AutomationEventListRef -> WindowResources -> IO ()
freeAutomationEventList :: Ptr AutomationEventList -> WindowResources -> IO ()
freeAutomationEventList Ptr AutomationEventList
list = Ptr () -> WindowResources -> IO ()
unloadSingleAutomationEventList (Ptr AutomationEventList -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AutomationEventList
list)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

setMouseCursor :: MouseCursor -> IO ()
setMouseCursor :: MouseCursor -> IO ()
setMouseCursor MouseCursor
cursor = CInt -> IO ()
c'setMouseCursor (CInt -> IO ()) -> (Int -> CInt) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ MouseCursor -> Int
forall a. Enum a => a -> Int
fromEnum MouseCursor
cursor

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

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

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

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

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

setGesturesEnabled :: [Gesture] -> IO ()
setGesturesEnabled :: [Gesture] -> IO ()
setGesturesEnabled [Gesture]
flags = CUInt -> IO ()
c'setGesturesEnabled (Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CUInt) -> Integer -> CUInt
forall a b. (a -> b) -> a -> b
$ [Gesture] -> Integer
forall a. Enum a => [a] -> Integer
configsToBitflag [Gesture]
flags)

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

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

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

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

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

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

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