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

-- | Bindings to @rcore@
module Raylib.Core
  ( -- * High level
    initWindow,
    windowShouldClose,
    closeWindow,
    isWindowReady,
    isWindowFullscreen,
    isWindowHidden,
    isWindowMinimized,
    isWindowMaximized,
    isWindowFocused,
    isWindowResized,
    isWindowState,
    setWindowState,
    clearWindowState,
    toggleFullscreen,
    toggleBorderlessWindowed,
    maximizeWindow,
    minimizeWindow,
    restoreWindow,
    setWindowIcon,
    setWindowIcons,
    setWindowTitle,
    setWindowPosition,
    setWindowMonitor,
    setWindowMinSize,
    setWindowMaxSize,
    setWindowSize,
    setWindowOpacity,
    setWindowFocused,
    getWindowHandle,
    getScreenWidth,
    getScreenHeight,
    getRenderWidth,
    getRenderHeight,
    getMonitorCount,
    getCurrentMonitor,
    getMonitorPosition,
    getMonitorWidth,
    getMonitorHeight,
    getMonitorPhysicalWidth,
    getMonitorPhysicalHeight,
    getMonitorRefreshRate,
    getWindowPosition,
    getWindowScaleDPI,
    getMonitorName,
    setClipboardText,
    getClipboardText,
    enableEventWaiting,
    disableEventWaiting,
    swapScreenBuffer,
    pollInputEvents,
    waitTime,
    showCursor,
    hideCursor,
    isCursorHidden,
    enableCursor,
    disableCursor,
    isCursorOnScreen,
    clearBackground,
    beginDrawing,
    endDrawing,
    beginMode2D,
    endMode2D,
    beginMode3D,
    endMode3D,
    beginTextureMode,
    endTextureMode,
    beginShaderMode,
    endShaderMode,
    beginBlendMode,
    endBlendMode,
    beginScissorMode,
    endScissorMode,
    beginVrStereoMode,
    endVrStereoMode,
    loadVrStereoConfig,
    loadShader,
    loadShaderFromMemory,
    isShaderReady,
    getShaderLocation,
    getShaderLocationAttrib,
    setShaderValue,
    setShaderValueV,
    nativeSetShaderValue,
    nativeSetShaderValueV,
    setShaderValueMatrix,
    setShaderValueTexture,
    unloadShader,
    getScreenToWorldRay,
    getScreenToWorldRayEx,
    getCameraMatrix,
    getCameraMatrix2D,
    getWorldToScreen,
    getWorldToScreenEx,
    getWorldToScreen2D,
    getScreenToWorld2D,
    setTargetFPS,
    getFPS,
    getFrameTime,
    getTime,
    setRandomSeed,
    getRandomValue,
    loadRandomSequence,
    takeScreenshot,
    setConfigFlags,
    traceLog,
    setTraceLogLevel,
    openURL,
    setLoadFileDataCallback,
    setSaveFileDataCallback,
    setLoadFileTextCallback,
    setSaveFileTextCallback,
    loadFileData,
    saveFileData,
    exportDataAsCode,
    loadFileText,
    saveFileText,
    fileExists,
    directoryExists,
    isFileExtension,
    getFileLength,
    getFileExtension,
    getFileName,
    getFileNameWithoutExt,
    getDirectoryPath,
    getPrevDirectoryPath,
    getWorkingDirectory,
    getApplicationDirectory,
    changeDirectory,
    isPathFile,
    loadDirectoryFiles,
    loadDirectoryFilesEx,
    isFileDropped,
    loadDroppedFiles,
    getFileModTime,
    compressData,
    decompressData,
    encodeDataBase64,
    decodeDataBase64,
    loadAutomationEventList,
    newAutomationEventList,
    exportAutomationEventList,
    setAutomationEventList,
    setAutomationEventBaseFrame,
    startAutomationEventRecording,
    stopAutomationEventRecording,
    playAutomationEvent,
    peekAutomationEventList,
    freeAutomationEventList,
    isKeyPressed,
    isKeyPressedRepeat,
    isKeyDown,
    isKeyReleased,
    isKeyUp,
    setExitKey,
    getKeyPressed,
    getCharPressed,
    isGamepadAvailable,
    getGamepadName,
    isGamepadButtonPressed,
    isGamepadButtonDown,
    isGamepadButtonReleased,
    isGamepadButtonUp,
    getGamepadButtonPressed,
    getGamepadAxisCount,
    getGamepadAxisMovement,
    setGamepadMappings,
    setGamepadVibration,
    isMouseButtonPressed,
    isMouseButtonDown,
    isMouseButtonReleased,
    isMouseButtonUp,
    getMouseX,
    getMouseY,
    getMousePosition,
    getMouseDelta,
    setMousePosition,
    setMouseOffset,
    setMouseScale,
    getMouseWheelMove,
    getMouseWheelMoveV,
    setMouseCursor,
    getTouchX,
    getTouchY,
    getTouchPosition,
    getTouchPointId,
    getTouchPointCount,
    setGesturesEnabled,
    isGestureDetected,
    getGestureDetected,
    getGestureHoldDuration,
    getGestureDragVector,
    getGestureDragAngle,
    getGesturePinchVector,
    getGesturePinchAngle,

    -- * Native
    c'initWindow,
    c'windowShouldClose,
    c'closeWindow,
    c'isWindowReady,
    c'isWindowFullscreen,
    c'isWindowHidden,
    c'isWindowMinimized,
    c'isWindowMaximized,
    c'isWindowFocused,
    c'isWindowResized,
    c'isWindowState,
    c'setWindowState,
    c'clearWindowState,
    c'toggleFullscreen,
    c'toggleBorderlessWindowed,
    c'maximizeWindow,
    c'minimizeWindow,
    c'restoreWindow,
    c'setWindowIcon,
    c'setWindowIcons,
    c'setWindowTitle,
    c'setWindowPosition,
    c'setWindowMonitor,
    c'setWindowMinSize,
    c'setWindowMaxSize,
    c'setWindowSize,
    c'setWindowOpacity,
    c'setWindowFocused,
    c'getWindowHandle,
    c'getScreenWidth,
    c'getScreenHeight,
    c'getRenderWidth,
    c'getRenderHeight,
    c'getMonitorCount,
    c'getCurrentMonitor,
    c'getMonitorPosition,
    c'getMonitorWidth,
    c'getMonitorHeight,
    c'getMonitorPhysicalWidth,
    c'getMonitorPhysicalHeight,
    c'getMonitorRefreshRate,
    c'getWindowPosition,
    c'getWindowScaleDPI,
    c'getMonitorName,
    c'setClipboardText,
    c'getClipboardText,
    c'enableEventWaiting,
    c'disableEventWaiting,
    c'swapScreenBuffer,
    c'pollInputEvents,
    c'waitTime,
    c'showCursor,
    c'hideCursor,
    c'isCursorHidden,
    c'enableCursor,
    c'disableCursor,
    c'isCursorOnScreen,
    c'clearBackground,
    c'beginDrawing,
    c'endDrawing,
    c'beginMode2D,
    c'endMode2D,
    c'beginMode3D,
    c'endMode3D,
    c'beginTextureMode,
    c'endTextureMode,
    c'beginShaderMode,
    c'endShaderMode,
    c'beginBlendMode,
    c'endBlendMode,
    c'beginScissorMode,
    c'endScissorMode,
    c'beginVrStereoMode,
    c'endVrStereoMode,
    c'loadVrStereoConfig,
    c'unloadVrStereoConfig,
    c'loadShader,
    c'loadShaderFromMemory,
    c'isShaderReady,
    c'getShaderLocation,
    c'getShaderLocationAttrib,
    c'setShaderValue,
    c'setShaderValueV,
    c'setShaderValueMatrix,
    c'setShaderValueTexture,
    c'unloadShader,
    c'getScreenToWorldRay,
    c'getScreenToWorldRayEx,
    c'getCameraMatrix,
    c'getCameraMatrix2D,
    c'getWorldToScreen,
    c'getScreenToWorld2D,
    c'getWorldToScreenEx,
    c'getWorldToScreen2D,
    c'setTargetFPS,
    c'getFPS,
    c'getFrameTime,
    c'getTime,
    c'setRandomSeed,
    c'getRandomValue,
    c'loadRandomSequence,
    c'takeScreenshot,
    c'setConfigFlags,
    c'traceLog,
    c'setTraceLogLevel,
    c'memAlloc,
    c'memRealloc,
    c'memFree,
    c'openURL,
    c'setLoadFileDataCallback,
    c'setSaveFileDataCallback,
    c'setLoadFileTextCallback,
    c'setSaveFileTextCallback,
    c'loadFileData,
    c'unloadFileData,
    c'saveFileData,
    c'exportDataAsCode,
    c'loadFileText,
    c'unloadFileText,
    c'saveFileText,
    c'fileExists,
    c'directoryExists,
    c'isFileExtension,
    c'getFileLength,
    c'getFileExtension,
    c'getFileName,
    c'getFileNameWithoutExt,
    c'getDirectoryPath,
    c'getPrevDirectoryPath,
    c'getWorkingDirectory,
    c'getApplicationDirectory,
    c'changeDirectory,
    c'isPathFile,
    c'loadDirectoryFiles,
    c'loadDirectoryFilesEx,
    c'unloadDirectoryFiles,
    c'isFileDropped,
    c'loadDroppedFiles,
    c'unloadDroppedFiles,
    c'getFileModTime,
    c'compressData,
    c'decompressData,
    c'encodeDataBase64,
    c'decodeDataBase64,
    c'loadAutomationEventList,
    c'exportAutomationEventList,
    c'setAutomationEventList,
    c'setAutomationEventBaseFrame,
    c'startAutomationEventRecording,
    c'stopAutomationEventRecording,
    c'playAutomationEvent,
    c'isKeyPressed,
    c'isKeyPressedRepeat,
    c'isKeyDown,
    c'isKeyReleased,
    c'isKeyUp,
    c'setExitKey,
    c'getKeyPressed,
    c'getCharPressed,
    c'isGamepadAvailable,
    c'getGamepadName,
    c'isGamepadButtonPressed,
    c'isGamepadButtonDown,
    c'isGamepadButtonReleased,
    c'isGamepadButtonUp,
    c'getGamepadButtonPressed,
    c'getGamepadAxisCount,
    c'getGamepadAxisMovement,
    c'setGamepadMappings,
    c'setGamepadVibration,
    c'isMouseButtonPressed,
    c'isMouseButtonDown,
    c'isMouseButtonReleased,
    c'isMouseButtonUp,
    c'getMouseX,
    c'getMouseY,
    c'getMousePosition,
    c'getMouseDelta,
    c'setMousePosition,
    c'setMouseOffset,
    c'setMouseScale,
    c'getMouseWheelMove,
    c'getMouseWheelMoveV,
    c'setMouseCursor,
    c'getTouchX,
    c'getTouchY,
    c'getTouchPosition,
    c'getTouchPointId,
    c'getTouchPointCount,
    c'setGesturesEnabled,
    c'isGestureDetected,
    c'getGestureDetected,
    c'getGestureHoldDuration,
    c'getGestureDragVector,
    c'getGestureDragAngle,
    c'getGesturePinchVector,
    c'getGesturePinchAngle,

    -- * Callbacks
    mk'loadFileDataCallback,
    mk'saveFileDataCallback,
    mk'loadFileTextCallback,
    mk'saveFileTextCallback,
    createLoadFileDataCallback,
    createSaveFileDataCallback,
    createLoadFileTextCallback,
    createSaveFileTextCallback,
  )
where

import Data.IORef (modifyIORef', readIORef)
import qualified Data.Map as Map
import Foreign
  ( Ptr,
    Storable (peek, poke, sizeOf),
    castFunPtr,
    castPtr,
    finalizeForeignPtr,
    fromBool,
    malloc,
    newArray,
    peekArray,
    toBool,
    withForeignPtr,
  )
import Foreign.C
  ( CBool (..),
    CDouble (..),
    CFloat (..),
    CInt (..),
    CLong (..),
    CString,
    CUChar (..),
    CUInt (..),
    newCString,
    peekCString,
    withCString,
  )
import Foreign.Ptr (nullPtr)
import Raylib.Internal (WindowResources, addAutomationEventList, addFunPtr, addShaderId, defaultWindowResources, shaderLocations, unloadAutomationEventLists, unloadFrameBuffers, unloadFunPtrs, unloadShaders, unloadSingleAutomationEventList, unloadSingleShader, unloadTextures, unloadVaoIds, unloadVboIds)
import Raylib.Internal.Foreign (configsToBitflag, pop, popCArray, popCString, withFreeable, withFreeableArray, withFreeableArrayLen, withMaybeCString)
import Raylib.Internal.TH (genNative)
import Raylib.Types
  ( AutomationEvent,
    AutomationEventList,
    AutomationEventListRef,
    BlendMode,
    C'LoadFileDataCallback,
    C'LoadFileTextCallback,
    C'SaveFileDataCallback,
    C'SaveFileTextCallback,
    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,
  )
import GHC.IO (unsafePerformIO)

$( genNative
     [ ("c'initWindow", "InitWindow_", "rl_bindings.h", [t|CInt -> CInt -> CString -> IO ()|], False),
       ("c'windowShouldClose", "WindowShouldClose_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'closeWindow", "CloseWindow_", "rl_bindings.h", [t|IO ()|], False),
       ("c'isWindowReady", "IsWindowReady_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowFullscreen", "IsWindowFullscreen_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowHidden", "IsWindowHidden_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowMinimized", "IsWindowMinimized_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowMaximized", "IsWindowMaximized_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowFocused", "IsWindowFocused_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowResized", "IsWindowResized_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'isWindowState", "IsWindowState_", "rl_bindings.h", [t|CUInt -> IO CBool|], False),
       ("c'setWindowState", "SetWindowState_", "rl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'clearWindowState", "ClearWindowState_", "rl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'toggleFullscreen", "ToggleFullscreen_", "rl_bindings.h", [t|IO ()|], False),
       ("c'toggleBorderlessWindowed", "ToggleBorderlessWindowed_", "rl_bindings.h", [t|IO ()|], False),
       ("c'maximizeWindow", "MaximizeWindow_", "rl_bindings.h", [t|IO ()|], False),
       ("c'minimizeWindow", "MinimizeWindow_", "rl_bindings.h", [t|IO ()|], False),
       ("c'restoreWindow", "RestoreWindow_", "rl_bindings.h", [t|IO ()|], False),
       ("c'setWindowIcon", "SetWindowIcon_", "rl_bindings.h", [t|Ptr Image -> IO ()|], False),
       ("c'setWindowIcons", "SetWindowIcons_", "rl_bindings.h", [t|Ptr Image -> CInt -> IO ()|], False),
       ("c'setWindowTitle", "SetWindowTitle_", "rl_bindings.h", [t|CString -> IO ()|], False),
       ("c'setWindowPosition", "SetWindowPosition_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setWindowMonitor", "SetWindowMonitor_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'setWindowMinSize", "SetWindowMinSize_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setWindowMaxSize", "SetWindowMaxSize_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setWindowSize", "SetWindowSize_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setWindowOpacity", "SetWindowOpacity_", "rl_bindings.h", [t|CFloat -> IO ()|], False),
       ("c'setWindowFocused", "SetWindowFocused_", "rl_bindings.h", [t|IO ()|], False),
       ("c'getWindowHandle", "GetWindowHandle_", "rl_bindings.h", [t|IO (Ptr ())|], False),
       ("c'getScreenWidth", "GetScreenWidth_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getScreenHeight", "GetScreenHeight_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getRenderWidth", "GetRenderWidth_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getRenderHeight", "GetRenderHeight_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getMonitorCount", "GetMonitorCount_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getCurrentMonitor", "GetCurrentMonitor_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getMonitorPosition", "GetMonitorPosition_", "rl_bindings.h", [t|CInt -> IO (Ptr Vector2)|], False),
       ("c'getMonitorWidth", "GetMonitorWidth_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getMonitorHeight", "GetMonitorHeight_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getMonitorPhysicalWidth", "GetMonitorPhysicalWidth_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getMonitorPhysicalHeight", "GetMonitorPhysicalHeight_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getMonitorRefreshRate", "GetMonitorRefreshRate_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getWindowPosition", "GetWindowPosition_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'getWindowScaleDPI", "GetWindowScaleDPI_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'getMonitorName", "GetMonitorName_", "rl_bindings.h", [t|CInt -> IO CString|], False),
       ("c'setClipboardText", "SetClipboardText_", "rl_bindings.h", [t|CString -> IO ()|], False),
       ("c'getClipboardText", "GetClipboardText_", "rl_bindings.h", [t|IO CString|], False),
       ("c'enableEventWaiting", "EnableEventWaiting_", "rl_bindings.h", [t|IO ()|], False),
       ("c'disableEventWaiting", "DisableEventWaiting_", "rl_bindings.h", [t|IO ()|], False),
       ("c'swapScreenBuffer", "SwapScreenBuffer_", "rl_bindings.h", [t|IO ()|], False),
       ("c'pollInputEvents", "PollInputEvents_", "rl_bindings.h", [t|IO ()|], False),
       ("c'waitTime", "WaitTime_", "rl_bindings.h", [t|CDouble -> IO ()|], False),
       ("c'showCursor", "ShowCursor_", "rl_bindings.h", [t|IO ()|], False),
       ("c'hideCursor", "HideCursor_", "rl_bindings.h", [t|IO ()|], False),
       ("c'isCursorHidden", "IsCursorHidden_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'enableCursor", "EnableCursor_", "rl_bindings.h", [t|IO ()|], False),
       ("c'disableCursor", "DisableCursor_", "rl_bindings.h", [t|IO ()|], False),
       ("c'isCursorOnScreen", "IsCursorOnScreen_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'clearBackground", "ClearBackground_", "rl_bindings.h", [t|Ptr Color -> IO ()|], False),
       ("c'beginDrawing", "BeginDrawing_", "rl_bindings.h", [t|IO ()|], False),
       ("c'endDrawing", "EndDrawing_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginMode2D", "BeginMode2D_", "rl_bindings.h", [t|Ptr Camera2D -> IO ()|], False),
       ("c'endMode2D", "EndMode2D_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginMode3D", "BeginMode3D_", "rl_bindings.h", [t|Ptr Camera3D -> IO ()|], False),
       ("c'endMode3D", "EndMode3D_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginTextureMode", "BeginTextureMode_", "rl_bindings.h", [t|Ptr RenderTexture -> IO ()|], False),
       ("c'endTextureMode", "EndTextureMode_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginShaderMode", "BeginShaderMode_", "rl_bindings.h", [t|Ptr Shader -> IO ()|], False),
       ("c'endShaderMode", "EndShaderMode_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginBlendMode", "BeginBlendMode_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'endBlendMode", "EndBlendMode_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginScissorMode", "BeginScissorMode_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> IO ()|], False),
       ("c'endScissorMode", "EndScissorMode_", "rl_bindings.h", [t|IO ()|], False),
       ("c'beginVrStereoMode", "BeginVrStereoMode_", "rl_bindings.h", [t|Ptr VrStereoConfig -> IO ()|], False),
       ("c'endVrStereoMode", "EndVrStereoMode_", "rl_bindings.h", [t|IO ()|], False),
       ("c'loadVrStereoConfig", "LoadVrStereoConfig_", "rl_bindings.h", [t|Ptr VrDeviceInfo -> IO (Ptr VrStereoConfig)|], False),
       ("c'unloadVrStereoConfig", "UnloadVrStereoConfig_", "rl_bindings.h", [t|Ptr VrStereoConfig -> IO ()|], False),
       ("c'loadShader", "LoadShader_", "rl_bindings.h", [t|CString -> CString -> IO (Ptr Shader)|], False),
       ("c'loadShaderFromMemory", "LoadShaderFromMemory_", "rl_bindings.h", [t|CString -> CString -> IO (Ptr Shader)|], False),
       ("c'isShaderReady", "IsShaderReady_", "rl_bindings.h", [t|Ptr Shader -> IO CBool|], False),
       ("c'getShaderLocation", "GetShaderLocation_", "rl_bindings.h", [t|Ptr Shader -> CString -> IO CInt|], False),
       ("c'getShaderLocationAttrib", "GetShaderLocationAttrib_", "rl_bindings.h", [t|Ptr Shader -> CString -> IO CInt|], False),
       ("c'setShaderValue", "SetShaderValue_", "rl_bindings.h", [t|Ptr Shader -> CInt -> Ptr () -> CInt -> IO ()|], False),
       ("c'setShaderValueV", "SetShaderValueV_", "rl_bindings.h", [t|Ptr Shader -> CInt -> Ptr () -> CInt -> CInt -> IO ()|], False),
       ("c'setShaderValueMatrix", "SetShaderValueMatrix_", "rl_bindings.h", [t|Ptr Shader -> CInt -> Ptr Matrix -> IO ()|], False),
       ("c'setShaderValueTexture", "SetShaderValueTexture_", "rl_bindings.h", [t|Ptr Shader -> CInt -> Ptr Texture -> IO ()|], False),
       ("c'unloadShader", "UnloadShader_", "rl_bindings.h", [t|Ptr Shader -> IO ()|], False),
       ("c'getScreenToWorldRay", "GetScreenToWorldRay_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Camera3D -> IO (Ptr Ray)|], False),
       ("c'getScreenToWorldRayEx", "GetScreenToWorldRayEx_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Camera3D -> CFloat -> CFloat -> IO (Ptr Ray)|], False),
       ("c'getCameraMatrix", "GetCameraMatrix_", "rl_bindings.h", [t|Ptr Camera3D -> IO (Ptr Matrix)|], False),
       ("c'getCameraMatrix2D", "GetCameraMatrix2D_", "rl_bindings.h", [t|Ptr Camera2D -> IO (Ptr Matrix)|], False),
       ("c'getWorldToScreen", "GetWorldToScreen_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Camera3D -> IO (Ptr Vector2)|], False),
       ("c'getScreenToWorld2D", "GetScreenToWorld2D_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Camera2D -> IO (Ptr Vector2)|], False),
       ("c'getWorldToScreenEx", "GetWorldToScreenEx_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Camera3D -> CInt -> CInt -> IO (Ptr Vector2)|], False),
       ("c'getWorldToScreen2D", "GetWorldToScreen2D_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Camera2D -> IO (Ptr Vector2)|], False),
       ("c'setTargetFPS", "SetTargetFPS_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'getFPS", "GetFPS_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getFrameTime", "GetFrameTime_", "rl_bindings.h", [t|IO CFloat|], False),
       ("c'getTime", "GetTime_", "rl_bindings.h", [t|IO CDouble|], False),
       ("c'setRandomSeed", "SetRandomSeed_", "rl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'getRandomValue", "GetRandomValue_", "rl_bindings.h", [t|CInt -> CInt -> IO CInt|], False),
       ("c'loadRandomSequence", "LoadRandomSequence_", "rl_bindings.h", [t|CUInt -> CInt -> CInt -> IO (Ptr CInt)|], False),
       ("c'takeScreenshot", "TakeScreenshot_", "rl_bindings.h", [t|CString -> IO ()|], False),
       ("c'setConfigFlags", "SetConfigFlags_", "rl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'traceLog", "TraceLog_", "rl_bindings.h", [t|CInt -> CString -> IO ()|], False), -- Uses varags, can't implement complete functionality
       ("c'setTraceLogLevel", "SetTraceLogLevel_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'memAlloc", "MemAlloc_", "rl_bindings.h", [t|CInt -> IO (Ptr ())|], False),
       ("c'memRealloc", "MemRealloc_", "rl_bindings.h", [t|Ptr () -> CInt -> IO (Ptr ())|], False),
       ("c'memFree", "MemFree_", "rl_bindings.h", [t|Ptr () -> IO ()|], False),
       ("c'openURL", "OpenURL_", "rl_bindings.h", [t|CString -> IO ()|], False),
       ("c'setLoadFileDataCallback", "SetLoadFileDataCallback_", "rl_bindings.h", [t|C'LoadFileDataCallback -> IO ()|], False),
       ("c'setSaveFileDataCallback", "SetSaveFileDataCallback_", "rl_bindings.h", [t|C'SaveFileDataCallback -> IO ()|], False),
       ("c'setLoadFileTextCallback", "SetLoadFileTextCallback_", "rl_bindings.h", [t|C'LoadFileTextCallback -> IO ()|], False),
       ("c'setSaveFileTextCallback", "SetSaveFileTextCallback_", "rl_bindings.h", [t|C'SaveFileTextCallback -> IO ()|], False),
       ("c'loadFileData", "LoadFileData_", "rl_bindings.h", [t|CString -> Ptr CInt -> IO (Ptr CUChar)|], True),
       ("c'unloadFileData", "UnloadFileData_", "rl_bindings.h", [t|Ptr CUChar -> IO ()|], False),
       ("c'saveFileData", "SaveFileData_", "rl_bindings.h", [t|CString -> Ptr () -> CInt -> IO CBool|], True),
       ("c'exportDataAsCode", "ExportDataAsCode_", "rl_bindings.h", [t|Ptr CUChar -> CInt -> CString -> IO CBool|], False),
       ("c'loadFileText", "LoadFileText_", "rl_bindings.h", [t|CString -> IO CString|], True),
       ("c'unloadFileText", "UnloadFileText_", "rl_bindings.h", [t|CString -> IO ()|], False),
       ("c'saveFileText", "SaveFileText_", "rl_bindings.h", [t|CString -> CString -> IO CBool|], True),
       ("c'fileExists", "FileExists_", "rl_bindings.h", [t|CString -> IO CBool|], False),
       ("c'directoryExists", "DirectoryExists_", "rl_bindings.h", [t|CString -> IO CBool|], False),
       ("c'isFileExtension", "IsFileExtension_", "rl_bindings.h", [t|CString -> CString -> IO CBool|], False),
       ("c'getFileLength", "GetFileLength_", "rl_bindings.h", [t|CString -> IO CBool|], False),
       ("c'getFileExtension", "GetFileExtension_", "rl_bindings.h", [t|CString -> IO CString|], False),
       ("c'getFileName", "GetFileName_", "rl_bindings.h", [t|CString -> IO CString|], False),
       ("c'getFileNameWithoutExt", "GetFileNameWithoutExt_", "rl_bindings.h", [t|CString -> IO CString|], False),
       ("c'getDirectoryPath", "GetDirectoryPath_", "rl_bindings.h", [t|CString -> IO CString|], False),
       ("c'getPrevDirectoryPath", "GetPrevDirectoryPath_", "rl_bindings.h", [t|CString -> IO CString|], False),
       ("c'getWorkingDirectory", "GetWorkingDirectory_", "rl_bindings.h", [t|IO CString|], False),
       ("c'getApplicationDirectory", "GetApplicationDirectory_", "rl_bindings.h", [t|IO CString|], False),
       ("c'changeDirectory", "ChangeDirectory_", "rl_bindings.h", [t|CString -> IO CBool|], False),
       ("c'isPathFile", "IsPathFile_", "rl_bindings.h", [t|CString -> IO CBool|], False),
       ("c'loadDirectoryFiles", "LoadDirectoryFiles_", "rl_bindings.h", [t|CString -> IO (Ptr FilePathList)|], False),
       ("c'loadDirectoryFilesEx", "LoadDirectoryFilesEx_", "rl_bindings.h", [t|CString -> CString -> CInt -> IO (Ptr FilePathList)|], False),
       ("c'unloadDirectoryFiles", "UnloadDirectoryFiles_", "rl_bindings.h", [t|Ptr FilePathList -> IO ()|], False),
       ("c'isFileDropped", "IsFileDropped_", "rl_bindings.h", [t|IO CBool|], False),
       ("c'loadDroppedFiles", "LoadDroppedFiles_", "rl_bindings.h", [t|IO (Ptr FilePathList)|], False),
       ("c'unloadDroppedFiles", "UnloadDroppedFiles_", "rl_bindings.h", [t|Ptr FilePathList -> IO ()|], False),
       ("c'getFileModTime", "GetFileModTime_", "rl_bindings.h", [t|CString -> IO CLong|], False),
       ("c'compressData", "CompressData_", "rl_bindings.h", [t|Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)|], False),
       ("c'decompressData", "DecompressData_", "rl_bindings.h", [t|Ptr CUChar -> CInt -> Ptr CInt -> IO (Ptr CUChar)|], False),
       ("c'encodeDataBase64", "EncodeDataBase64_", "rl_bindings.h", [t|Ptr CUChar -> CInt -> Ptr CInt -> IO CString|], False),
       ("c'decodeDataBase64", "DecodeDataBase64_", "rl_bindings.h", [t|Ptr CUChar -> Ptr CInt -> IO (Ptr CUChar)|], False),
       ("c'loadAutomationEventList", "LoadAutomationEventList_", "rl_bindings.h", [t|CString -> IO (Ptr AutomationEventList)|], False),
       ("c'exportAutomationEventList", "ExportAutomationEventList_", "rl_bindings.h", [t|Ptr AutomationEventList -> CString -> IO CBool|], False),
       ("c'setAutomationEventList", "SetAutomationEventList_", "rl_bindings.h", [t|Ptr AutomationEventList -> IO ()|], False),
       ("c'setAutomationEventBaseFrame", "SetAutomationEventBaseFrame_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'startAutomationEventRecording", "StartAutomationEventRecording_", "rl_bindings.h", [t|IO ()|], False),
       ("c'stopAutomationEventRecording", "StopAutomationEventRecording_", "rl_bindings.h", [t|IO ()|], False),
       ("c'playAutomationEvent", "PlayAutomationEvent", "rl_bindings.h", [t|Ptr AutomationEvent -> IO ()|], False),
       ("c'isKeyPressed", "IsKeyPressed_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isKeyPressedRepeat", "IsKeyPressedRepeat_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isKeyDown", "IsKeyDown_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isKeyReleased", "IsKeyReleased_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isKeyUp", "IsKeyUp_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'setExitKey", "SetExitKey_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'getKeyPressed", "GetKeyPressed_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getCharPressed", "GetCharPressed_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'isGamepadAvailable", "IsGamepadAvailable_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'getGamepadName", "GetGamepadName_", "rl_bindings.h", [t|CInt -> IO CString|], False),
       ("c'isGamepadButtonPressed", "IsGamepadButtonPressed_", "rl_bindings.h", [t|CInt -> CInt -> IO CBool|], False),
       ("c'isGamepadButtonDown", "IsGamepadButtonDown_", "rl_bindings.h", [t|CInt -> CInt -> IO CBool|], False),
       ("c'isGamepadButtonReleased", "IsGamepadButtonReleased_", "rl_bindings.h", [t|CInt -> CInt -> IO CBool|], False),
       ("c'isGamepadButtonUp", "IsGamepadButtonUp_", "rl_bindings.h", [t|CInt -> CInt -> IO CBool|], False),
       ("c'getGamepadButtonPressed", "GetGamepadButtonPressed_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getGamepadAxisCount", "GetGamepadAxisCount_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getGamepadAxisMovement", "GetGamepadAxisMovement_", "rl_bindings.h", [t|CInt -> CInt -> IO CFloat|], False),
       ("c'setGamepadMappings", "SetGamepadMappings_", "rl_bindings.h", [t|CString -> IO CInt|], False),
       ("c'setGamepadVibration", "SetGamepadVibration_", "rl_bindings.h", [t|CInt -> CFloat -> CFloat -> IO ()|], False),
       ("c'isMouseButtonPressed", "IsMouseButtonPressed_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isMouseButtonDown", "IsMouseButtonDown_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isMouseButtonReleased", "IsMouseButtonReleased_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'isMouseButtonUp", "IsMouseButtonUp_", "rl_bindings.h", [t|CInt -> IO CBool|], False),
       ("c'getMouseX", "GetMouseX_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getMouseY", "GetMouseY_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getMousePosition", "GetMousePosition_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'getMouseDelta", "GetMouseDelta_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'setMousePosition", "SetMousePosition_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setMouseOffset", "SetMouseOffset_", "rl_bindings.h", [t|CInt -> CInt -> IO ()|], False),
       ("c'setMouseScale", "SetMouseScale_", "rl_bindings.h", [t|CFloat -> CFloat -> IO ()|], False),
       ("c'getMouseWheelMove", "GetMouseWheelMove_", "rl_bindings.h", [t|IO CFloat|], False),
       ("c'getMouseWheelMoveV", "GetMouseWheelMoveV_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'setMouseCursor", "SetMouseCursor_", "rl_bindings.h", [t|CInt -> IO ()|], False),
       ("c'getTouchX", "GetTouchX_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getTouchY", "GetTouchY_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getTouchPosition", "GetTouchPosition_", "rl_bindings.h", [t|CInt -> IO (Ptr Vector2)|], False),
       ("c'getTouchPointId", "GetTouchPointId_", "rl_bindings.h", [t|CInt -> IO CInt|], False),
       ("c'getTouchPointCount", "GetTouchPointCount_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'setGesturesEnabled", "SetGesturesEnabled_", "rl_bindings.h", [t|CUInt -> IO ()|], False),
       ("c'isGestureDetected", "IsGestureDetected_", "rl_bindings.h", [t|CUInt -> IO CBool|], False),
       ("c'getGestureDetected", "GetGestureDetected_", "rl_bindings.h", [t|IO CInt|], False),
       ("c'getGestureHoldDuration", "GetGestureHoldDuration_", "rl_bindings.h", [t|IO CFloat|], False),
       ("c'getGestureDragVector", "GetGestureDragVector_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'getGestureDragAngle", "GetGestureDragAngle_", "rl_bindings.h", [t|IO CFloat|], False),
       ("c'getGesturePinchVector", "GetGesturePinchVector_", "rl_bindings.h", [t|IO (Ptr Vector2)|], False),
       ("c'getGesturePinchAngle", "GetGesturePinchAngle_", "rl_bindings.h", [t|IO CFloat|], False)
     ]
 )

initWindow ::
  Int ->
  Int ->
  String ->
  -- | This value must be passed to some @load*@ and @unload*@ functions for
  --   automatic memory management.
  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
  WindowResources -> IO ()
unloadFunPtrs 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

toggleFullscreen :: IO ()
toggleFullscreen :: IO ()
toggleFullscreen = IO ()
c'toggleFullscreen

toggleBorderlessWindowed :: IO ()
toggleBorderlessWindowed :: IO ()
toggleBorderlessWindowed = IO ()
c'toggleBorderlessWindowed

maximizeWindow :: IO ()
maximizeWindow :: IO ()
maximizeWindow = IO ()
c'maximizeWindow

minimizeWindow :: IO ()
minimizeWindow :: IO ()
minimizeWindow = IO ()
c'minimizeWindow

restoreWindow :: IO ()
restoreWindow :: IO ()
restoreWindow = IO ()
c'restoreWindow

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

setWindowFocused :: IO ()
setWindowFocused :: IO ()
setWindowFocused = IO ()
c'setWindowFocused

getWindowHandle :: IO (Ptr ())
getWindowHandle :: IO (Ptr ())
getWindowHandle = IO (Ptr ())
c'getWindowHandle

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

enableEventWaiting :: IO ()
enableEventWaiting :: IO ()
enableEventWaiting = IO ()
c'enableEventWaiting

disableEventWaiting :: IO ()
disableEventWaiting :: IO ()
disableEventWaiting = IO ()
c'disableEventWaiting

swapScreenBuffer :: IO ()
swapScreenBuffer :: IO ()
swapScreenBuffer = IO ()
c'swapScreenBuffer

pollInputEvents :: IO ()
pollInputEvents :: IO ()
pollInputEvents = IO ()
c'pollInputEvents

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

showCursor :: IO ()
showCursor :: IO ()
showCursor = IO ()
c'showCursor

hideCursor :: IO ()
hideCursor :: IO ()
hideCursor = IO ()
c'hideCursor

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

enableCursor :: IO ()
enableCursor :: IO ()
enableCursor = IO ()
c'enableCursor

disableCursor :: IO ()
disableCursor :: IO ()
disableCursor = IO ()
c'disableCursor

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

beginDrawing :: IO ()
beginDrawing :: IO ()
beginDrawing = IO ()
c'beginDrawing

endDrawing :: IO ()
endDrawing :: IO ()
endDrawing = IO ()
c'endDrawing

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

endMode2D :: IO ()
endMode2D :: IO ()
endMode2D = IO ()
c'endMode2D

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

endMode3D :: IO ()
endMode3D :: IO ()
endMode3D = IO ()
c'endMode3D

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

endTextureMode :: IO ()
endTextureMode :: IO ()
endTextureMode = IO ()
c'endTextureMode

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

endShaderMode :: IO ()
endShaderMode :: IO ()
endShaderMode = IO ()
c'endShaderMode

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

endBlendMode :: IO ()
endBlendMode :: IO ()
endBlendMode = IO ()
c'endBlendMode

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)

endScissorMode :: IO ()
endScissorMode :: IO ()
endScissorMode = IO ()
c'endScissorMode

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

endVrStereoMode :: IO ()
endVrStereoMode :: IO ()
endVrStereoMode = IO ()
c'endVrStereoMode

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
  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, ForeignPtr ()
fptr) <- ShaderUniformData -> IO (ShaderUniformDataType, ForeignPtr ())
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 -> ForeignPtr () -> (Ptr () -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr (\Ptr ()
ptr -> 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)))
  ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fptr

nativeSetShaderValueV :: Shader -> Int -> ShaderUniformDataV -> IO ()
nativeSetShaderValueV :: Shader -> Int -> ShaderUniformDataV -> IO ()
nativeSetShaderValueV Shader
shader Int
locIndex ShaderUniformDataV
values = do
  (ShaderUniformDataType
uniformType, ForeignPtr ()
fptr, Int
l) <- ShaderUniformDataV
-> IO (ShaderUniformDataType, ForeignPtr (), 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 -> ForeignPtr () -> (Ptr () -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr (\Ptr ()
ptr -> 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)))
  ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fptr

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)

getScreenToWorldRay :: Vector2 -> Camera3D -> IO Ray
getScreenToWorldRay :: Vector2 -> Camera3D -> IO Ray
getScreenToWorldRay Vector2
position 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
position (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'getScreenToWorldRay) 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

getScreenToWorldRayEx :: Vector2 -> Camera3D -> Float -> Float -> Ray
getScreenToWorldRayEx :: Vector2 -> Camera3D -> Float -> Float -> Ray
getScreenToWorldRayEx Vector2
position Camera3D
camera Float
width Float
height = IO Ray -> Ray
forall a. IO a -> a
unsafePerformIO (IO Ray -> Ray) -> IO Ray -> Ray
forall a b. (a -> b) -> a -> b
$ 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
position (\Ptr Vector2
p -> 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
c -> Ptr Vector2 -> Ptr Camera3D -> CFloat -> CFloat -> IO (Ptr Ray)
c'getScreenToWorldRayEx Ptr Vector2
p Ptr Camera3D
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height))) 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 -> Matrix
getCameraMatrix :: Camera3D -> Matrix
getCameraMatrix Camera3D
camera = IO Matrix -> Matrix
forall a. IO a -> a
unsafePerformIO (IO Matrix -> Matrix) -> IO Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ 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 -> Matrix
getCameraMatrix2D :: Camera2D -> Matrix
getCameraMatrix2D Camera2D
camera = IO Matrix -> Matrix
forall a. IO a -> a
unsafePerformIO (IO Matrix -> Matrix) -> IO Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ 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

getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> Vector2
getWorldToScreenEx :: Vector3 -> Camera3D -> Int -> Int -> Vector2
getWorldToScreenEx Vector3
position Camera3D
camera Int
width Int
height = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ 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 -> Vector2
getWorldToScreen2D :: Vector2 -> Camera2D -> Vector2
getWorldToScreen2D Vector2
position Camera2D
camera = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ 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

getScreenToWorld2D :: Vector2 -> Camera2D -> Vector2
getScreenToWorld2D :: Vector2 -> Camera2D -> Vector2
getScreenToWorld2D Vector2
position Camera2D
camera = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ 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

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

setLoadFileDataCallback :: LoadFileDataCallback -> WindowResources -> IO C'LoadFileDataCallback
setLoadFileDataCallback :: LoadFileDataCallback
-> WindowResources -> IO C'LoadFileDataCallback
setLoadFileDataCallback LoadFileDataCallback
callback WindowResources
window = do
  C'LoadFileDataCallback
c <- LoadFileDataCallback -> IO C'LoadFileDataCallback
createLoadFileDataCallback LoadFileDataCallback
callback
  FunPtr () -> WindowResources -> IO ()
addFunPtr (C'LoadFileDataCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'LoadFileDataCallback
c) WindowResources
window
  C'LoadFileDataCallback -> IO ()
c'setLoadFileDataCallback C'LoadFileDataCallback
c
  C'LoadFileDataCallback -> IO C'LoadFileDataCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'LoadFileDataCallback
c

setSaveFileDataCallback :: (Storable a) => SaveFileDataCallback a -> WindowResources -> IO C'SaveFileDataCallback
setSaveFileDataCallback :: forall a.
Storable a =>
SaveFileDataCallback a
-> WindowResources -> IO C'SaveFileDataCallback
setSaveFileDataCallback SaveFileDataCallback a
callback WindowResources
window = do
  C'SaveFileDataCallback
c <- SaveFileDataCallback a -> IO C'SaveFileDataCallback
forall a.
Storable a =>
SaveFileDataCallback a -> IO C'SaveFileDataCallback
createSaveFileDataCallback SaveFileDataCallback a
callback
  FunPtr () -> WindowResources -> IO ()
addFunPtr (C'SaveFileDataCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'SaveFileDataCallback
c) WindowResources
window
  C'SaveFileDataCallback -> IO ()
c'setSaveFileDataCallback C'SaveFileDataCallback
c
  C'SaveFileDataCallback -> IO C'SaveFileDataCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'SaveFileDataCallback
c

setLoadFileTextCallback :: LoadFileTextCallback -> WindowResources -> IO C'LoadFileTextCallback
setLoadFileTextCallback :: LoadFileTextCallback
-> WindowResources -> IO C'LoadFileTextCallback
setLoadFileTextCallback LoadFileTextCallback
callback WindowResources
window = do
  C'LoadFileTextCallback
c <- LoadFileTextCallback -> IO C'LoadFileTextCallback
createLoadFileTextCallback LoadFileTextCallback
callback
  FunPtr () -> WindowResources -> IO ()
addFunPtr (C'LoadFileTextCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'LoadFileTextCallback
c) WindowResources
window
  C'LoadFileTextCallback -> IO ()
c'setLoadFileTextCallback C'LoadFileTextCallback
c
  C'LoadFileTextCallback -> IO C'LoadFileTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'LoadFileTextCallback
c

setSaveFileTextCallback :: SaveFileTextCallback -> WindowResources -> IO C'SaveFileTextCallback
setSaveFileTextCallback :: SaveFileTextCallback
-> WindowResources -> IO C'SaveFileTextCallback
setSaveFileTextCallback SaveFileTextCallback
callback WindowResources
window = do
  C'SaveFileTextCallback
c <- SaveFileTextCallback -> IO C'SaveFileTextCallback
createSaveFileTextCallback SaveFileTextCallback
callback
  FunPtr () -> WindowResources -> IO ()
addFunPtr (C'SaveFileTextCallback -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr C'SaveFileTextCallback
c) WindowResources
window
  C'SaveFileTextCallback -> IO ()
c'setSaveFileTextCallback C'SaveFileTextCallback
c
  C'SaveFileTextCallback -> IO C'SaveFileTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return C'SaveFileTextCallback
c

loadFileData :: String -> IO [Integer]
loadFileData :: LoadFileDataCallback
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 :: LoadFileTextCallback
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 :: SaveFileTextCallback
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 :: SaveFileTextCallback
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 :: LoadFileTextCallback
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 :: LoadFileTextCallback
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 :: LoadFileTextCallback
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 :: LoadFileTextCallback
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 :: LoadFileTextCallback
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 = do
  Ptr FilePathList
ptr <- IO (Ptr FilePathList)
c'loadDroppedFiles
  FilePathList
val <- Ptr FilePathList -> IO FilePathList
forall a. Storable a => Ptr a -> IO a
peek Ptr FilePathList
ptr
  Ptr FilePathList -> IO ()
c'unloadDroppedFiles Ptr FilePathList
ptr
  FilePathList -> IO FilePathList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathList
val

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

setGamepadVibration :: Int -> Float -> Float -> IO ()
setGamepadVibration :: Int -> Float -> Float -> IO ()
setGamepadVibration Int
gamepad Float
leftMotor Float
rightMotor = CInt -> CFloat -> CFloat -> IO ()
c'setGamepadVibration (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gamepad) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
leftMotor) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rightMotor)

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

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

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

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

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

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

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

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

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

createLoadFileDataCallback :: LoadFileDataCallback -> IO C'LoadFileDataCallback
createLoadFileDataCallback :: LoadFileDataCallback -> IO C'LoadFileDataCallback
createLoadFileDataCallback LoadFileDataCallback
callback =
  (CString -> Ptr CUInt -> IO (Ptr CUChar))
-> IO C'LoadFileDataCallback
mk'loadFileDataCallback
    ( \CString
fileName Ptr CUInt
dataSize ->
        do
          String
fn <- CString -> IO String
peekCString CString
fileName
          [Integer]
arr <- LoadFileDataCallback
callback String
fn
          Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
dataSize (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
arr) :: CUInt)
          [CUChar] -> IO (Ptr CUChar)
forall a. Storable a => [a] -> IO (Ptr a)
newArray ((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]
arr :: [CUChar])
    )

createSaveFileDataCallback :: (Storable a) => SaveFileDataCallback a -> IO C'SaveFileDataCallback
createSaveFileDataCallback :: forall a.
Storable a =>
SaveFileDataCallback a -> IO C'SaveFileDataCallback
createSaveFileDataCallback SaveFileDataCallback a
callback =
  (CString -> Ptr () -> CUInt -> IO CInt)
-> IO C'SaveFileDataCallback
mk'saveFileDataCallback
    ( \CString
fileName Ptr ()
contents CUInt
bytesToWrite ->
        do
          String
fn <- CString -> IO String
peekCString CString
fileName
          Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SaveFileDataCallback a
callback String
fn (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
contents) (CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
bytesToWrite)
    )

createLoadFileTextCallback :: LoadFileTextCallback -> IO C'LoadFileTextCallback
createLoadFileTextCallback :: LoadFileTextCallback -> IO C'LoadFileTextCallback
createLoadFileTextCallback LoadFileTextCallback
callback =
  (CString -> IO CString) -> IO C'LoadFileTextCallback
mk'loadFileTextCallback
    (\CString
fileName -> CString -> IO String
peekCString CString
fileName IO String -> LoadFileTextCallback -> 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
>>= LoadFileTextCallback
callback IO String -> (String -> IO CString) -> IO CString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO CString
newCString)

createSaveFileTextCallback :: SaveFileTextCallback -> IO C'SaveFileTextCallback
createSaveFileTextCallback :: SaveFileTextCallback -> IO C'SaveFileTextCallback
createSaveFileTextCallback SaveFileTextCallback
callback =
  (CString -> CString -> IO CInt) -> IO C'SaveFileTextCallback
mk'saveFileTextCallback
    ( \CString
fileName CString
content -> do
        String
fn <- CString -> IO String
peekCString CString
fileName
        String
c <- CString -> IO String
peekCString CString
content
        Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> IO Bool -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SaveFileTextCallback
callback String
fn String
c
    )