module Raylib.ImGui
  ( rlImGuiSetup,
    rlImGuiBegin,
    rlImGuiEnd,
    rlImGuiShutdown,
    rlImGuiBeginInitImGui,
    rlImGuiEndInitImGui,
    rlImGuiReloadFonts,
    rlImGuiImage,
    rlImGuiImageButton,
    rlImGuiImageSize,
    rlImGuiImageRect,
  )
where

import Foreign (Ptr, with)
import Raylib.Types (Rectangle, Texture)

-- basic API

foreign import ccall safe "rlImGui.h rlImGuiSetup" rlImGuiSetup :: Bool -> IO ()

foreign import ccall safe "rlImGui.h rlImGuiBegin" rlImGuiBegin :: IO ()

foreign import ccall safe "rlImGui.h rlImGuiEnd" rlImGuiEnd :: IO ()

foreign import ccall safe "rlImGui.h rlImGuiShutdown" rlImGuiShutdown :: IO ()

-- Advanced StartupAPI

foreign import ccall safe "rlImGui.h rlImGuiBeginInitImGui" rlImGuiBeginInitImGui :: IO ()

foreign import ccall safe "rlImGui.h rlImGuiEndInitImGui" rlImGuiEndInitImGui :: IO ()

foreign import ccall safe "rlImGui.h rlImGuiReloadFonts" rlImGuiReloadFonts :: IO ()

-- image API

foreign import ccall safe "rlImGui.h rlImGuiImage" c'rlImGuiImage :: Ptr Texture -> IO ()

foreign import ccall safe "rlImGui.h rlImGuiImageButton" c'rlImGuiImageButton :: Ptr Texture -> IO Bool

foreign import ccall safe "rlImGui.h rlImGuiImageSize" c'rlImGuiImageSize :: Ptr Texture -> Int -> Int -> IO ()

foreign import ccall safe "wrapper.h rlImGuiImageRect_" c'rlImGuiImageRect :: Ptr Texture -> Int -> Int -> Ptr Rectangle -> IO ()

rlImGuiImage :: Texture -> IO ()
rlImGuiImage :: Texture -> IO ()
rlImGuiImage Texture
texture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture Ptr Texture -> IO ()
c'rlImGuiImage

rlImGuiImageButton :: Texture -> IO Bool
rlImGuiImageButton :: Texture -> IO Bool
rlImGuiImageButton Texture
texture = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture Ptr Texture -> IO Bool
c'rlImGuiImageButton

rlImGuiImageSize :: Texture -> Int -> Int -> IO ()
rlImGuiImageSize :: Texture -> Int -> Int -> IO ()
rlImGuiImageSize Texture
texture Int
width Int
height = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> Ptr Texture -> Int -> Int -> IO ()
c'rlImGuiImageSize Ptr Texture
t Int
width Int
height)

rlImGuiImageRect :: Texture -> Int -> Int -> Rectangle -> IO ()
rlImGuiImageRect :: Texture -> Int -> Int -> Rectangle -> IO ()
rlImGuiImageRect Texture
texture Int
width Int
height Rectangle
rect = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Texture
texture (\Ptr Texture
t -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect (Ptr Texture -> Int -> Int -> Ptr Rectangle -> IO ()
c'rlImGuiImageRect Ptr Texture
t Int
width Int
height))