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

-- |
-- Bindings to @raygui@
--
-- [raygui](https://github.com/raysan5/raygui) is an immediate-mode GUI library
-- built on top of raylib. The C version of raygui involves a lot of pointers
-- because of the way it is designed. Unfortunately, this is problematic when
-- binding it to Haskell, as Haskell's immutability makes it difficult to
-- represent pointers properly. This means many functions will take the previous
-- state of a control as an argument and return the updated state of that control.
--
-- Keep in mind that raygui is an immediate mode GUI, so it is designed mostly for
-- debugging and development and not for actual game GUIs. To this end, it is not
-- very customizable and the features are quite limited. For a real game, you
-- should make your own retained mode GUI.
module Raylib.Util.GUI
  ( -- * High level
    -- ** Global gui state control functions
    guiEnable,
    guiDisable,
    guiLock,
    guiUnlock,
    guiIsLocked,
    guiSetAlpha,
    guiSetState,
    guiGetState,

    -- ** Font set/get functions
    guiSetFont,
    guiGetFont,

    -- * Style set/get functions

    -- | In the native C code, there is just one @guiSetStyle@ function and one
    --   @guiGetStyle@ function, which take a property type and an @int@ as the
    --   property value. This @int@ can represent a plain integer, a `Color`,
    --   or an enum, depending on the property type. This is very un-Haskelly
    --   behavior and not very user friendly (as it requires the use of
    --   `colorToInt` and such), so they have been split into 3 setters and
    --   getters, one for regular `Int`s, one for `Color`s, and one for
    --   `Enum`s. There are also a bunch of specialized getters and setters for
    --   commonly used properties.

    -- *** Set style
    guiSetStyle,
    guiSetStyleC,
    guiSetStyleE,
    guiSetStyleBorderColorNormal,
    guiSetStyleBaseColorNormal,
    guiSetStyleTextColorNormal,
    guiSetStyleBorderColorFocused,
    guiSetStyleBaseColorFocused,
    guiSetStyleTextColorFocused,
    guiSetStyleBorderColorPressed,
    guiSetStyleBaseColorPressed,
    guiSetStyleTextColorPressed,
    guiSetStyleBorderColorDisabled,
    guiSetStyleBaseColorDisabled,
    guiSetStyleTextColorDisabled,
    guiSetStyleBorderWidth,
    guiSetStyleTextPadding,
    guiSetStyleTextAlignment,
    guiSetStyleTextSize,
    guiSetStyleTextSpacing,
    guiSetStyleLineColor,
    guiSetStyleBackgroundColor,
    guiSetStyleTextLineSpacing,
    guiSetStyleTextAlignmentVertical,
    guiSetStyleTextWrapMode,

    -- *** Get style
    guiGetStyle,
    guiGetStyleC,
    guiGetStyleE,
    guiGetStyleBorderColorNormal,
    guiGetStyleBaseColorNormal,
    guiGetStyleTextColorNormal,
    guiGetStyleBorderColorFocused,
    guiGetStyleBaseColorFocused,
    guiGetStyleTextColorFocused,
    guiGetStyleBorderColorPressed,
    guiGetStyleBaseColorPressed,
    guiGetStyleTextColorPressed,
    guiGetStyleBorderColorDisabled,
    guiGetStyleBaseColorDisabled,
    guiGetStyleTextColorDisabled,
    guiGetStyleBorderWidth,
    guiGetStyleTextPadding,
    guiGetStyleTextAlignment,
    guiGetStyleTextSize,
    guiGetStyleTextSpacing,
    guiGetStyleLineColor,
    guiGetStyleBackgroundColor,
    guiGetStyleTextLineSpacing,
    guiGetStyleTextAlignmentVertical,
    guiGetStyleTextWrapMode,

    -- ** Styles loading functions
    guiLoadStyle,
    guiLoadStyleDefault,

    -- ** Tooltips management functions
    guiEnableTooltip,
    guiDisableTooltip,
    guiSetTooltip,

    -- ** Icons functionality
    guiIconText,
    guiSetIconScale,
    guiGetIcons,
    guiLoadIcons,
    guiDrawIcon,

    -- ** Controls

    -- *** Container/separator controls, useful for controls organization
    guiWindowBox,
    guiGroupBox,
    guiLine,
    guiPanel,
    guiTabBar,
    guiScrollPanel,

    -- *** Basic controls set
    guiLabel,
    guiButton,
    guiLabelButton,
    guiToggle,
    guiToggleGroup,
    guiToggleSlider,
    guiCheckBox,
    guiComboBox,
    guiDropdownBox,
    guiSpinner,
    guiValueBox,
    guiTextBox,
    guiSlider,
    guiSliderBar,
    guiProgressBar,
    guiStatusBar,
    guiDummyRec,
    guiGrid,

    -- *** Advanced controls set
    guiListView,
    guiListViewEx,
    guiMessageBox,
    guiTextInputBox,
    guiColorPicker,
    guiColorPanel,
    guiColorBarAlpha,
    guiColorBarHue,
    guiColorPickerHSV,
    guiColorPanelHSV,

    -- * Native
    c'guiEnable,
    c'guiDisable,
    c'guiLock,
    c'guiUnlock,
    c'guiIsLocked,
    c'guiSetAlpha,
    c'guiSetState,
    c'guiGetState,
    c'guiSetFont,
    c'guiGetFont,
    c'guiSetStyle,
    c'guiGetStyle,
    c'guiLoadStyle,
    c'guiLoadStyleDefault,
    c'guiEnableTooltip,
    c'guiDisableTooltip,
    c'guiSetTooltip,
    c'guiIconText,
    c'guiSetIconScale,
    c'guiGetIcons,
    c'guiLoadIcons,
    c'guiDrawIcon,
    c'guiWindowBox,
    c'guiGroupBox,
    c'guiLine,
    c'guiPanel,
    c'guiTabBar,
    c'guiScrollPanel,
    c'guiLabel,
    c'guiButton,
    c'guiLabelButton,
    c'guiToggle,
    c'guiToggleGroup,
    c'guiToggleSlider,
    c'guiCheckBox,
    c'guiComboBox,
    c'guiDropdownBox,
    c'guiSpinner,
    c'guiValueBox,
    c'guiTextBox,
    c'guiSlider,
    c'guiSliderBar,
    c'guiProgressBar,
    c'guiStatusBar,
    c'guiDummyRec,
    c'guiGrid,
    c'guiListView,
    c'guiListViewEx,
    c'guiMessageBox,
    c'guiTextInputBox,
    c'guiColorPicker,
    c'guiColorPanel,
    c'guiColorBarAlpha,
    c'guiColorBarHue,
    c'guiColorPickerHSV,
    c'guiColorPanelHSV
  )
where

import Control.Monad (void, (>=>))
import Data.Maybe (fromMaybe)
import Foreign (Ptr, Storable (peek), fromBool, nullPtr, toBool)
import Foreign.C
  ( CBool (..),
    CFloat (..),
    CInt (..),
    CString,
    CUInt (..),
    newCString,
    peekCString,
    withCString,
  )
import Raylib.Core.Textures (colorToInt, getColor)
import Raylib.Internal.Foreign (pop, popCArray, popCString, withCStringBuffer, withFreeable, withFreeableArrayLen, withMaybe, withMaybeCString)
import Raylib.Internal.TH (genNative)
import Raylib.Types (Color (Color), Font, GuiControl (Default), GuiControlProperty (..), GuiDefaultProperty (..), GuiIconName, GuiState, GuiTextAlignment, GuiTextAlignmentVertical, GuiTextWrapMode, Rectangle (Rectangle), Vector2 (Vector2), Vector3 (Vector3))

$( genNative
     [ ("c'guiEnable", "GuiEnable_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiDisable", "GuiDisable_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiLock", "GuiLock_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiUnlock", "GuiUnlock_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiIsLocked", "GuiIsLocked_", "rgui_bindings.h", [t|IO CBool|], False),
       ("c'guiSetAlpha", "GuiSetAlpha_", "rgui_bindings.h", [t|CFloat -> IO ()|], False),
       ("c'guiSetState", "GuiSetState_", "rgui_bindings.h", [t|CInt -> IO ()|], False),
       ("c'guiGetState", "GuiGetState_", "rgui_bindings.h", [t|IO CInt|], False),
       ("c'guiSetFont", "GuiSetFont_", "rgui_bindings.h", [t|Ptr Font -> IO ()|], False),
       ("c'guiGetFont", "GuiGetFont_", "rgui_bindings.h", [t|IO (Ptr Font)|], False),
       ("c'guiSetStyle", "GuiSetStyle_", "rgui_bindings.h", [t|CInt -> CInt -> CInt -> IO ()|], False),
       ("c'guiGetStyle", "GuiGetStyle_", "rgui_bindings.h", [t|CInt -> CInt -> IO CInt|], False),
       ("c'guiLoadStyle", "GuiLoadStyle_", "rgui_bindings.h", [t|CString -> IO ()|], False),
       ("c'guiLoadStyleDefault", "GuiLoadStyleDefault_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiEnableTooltip", "GuiEnableTooltip_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiDisableTooltip", "GuiDisableTooltip_", "rgui_bindings.h", [t|IO ()|], False),
       ("c'guiSetTooltip", "GuiSetTooltip_", "rgui_bindings.h", [t|CString -> IO ()|], False),
       ("c'guiIconText", "GuiIconText_", "rgui_bindings.h", [t|CInt -> CString -> IO CString|], False),
       ("c'guiSetIconScale", "GuiSetIconScale_", "rgui_bindings.h", [t|CInt -> IO ()|], False),
       ("c'guiGetIcons", "GuiGetIcons_", "rgui_bindings.h", [t|IO (Ptr CUInt)|], False),
       ("c'guiLoadIcons", "GuiLoadIcons_", "rgui_bindings.h", [t|CString -> CBool -> IO (Ptr CString)|], False),
       ("c'guiDrawIcon", "GuiDrawIcon_", "rgui_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'guiWindowBox", "GuiWindowBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiGroupBox", "GuiGroupBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiLine", "GuiLine_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiPanel", "GuiPanel_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiTabBar", "GuiTabBar_", "rgui_bindings.h", [t|Ptr Rectangle -> Ptr CString -> CInt -> Ptr CInt -> IO CInt|], False),
       ("c'guiScrollPanel", "GuiScrollPanel_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr Rectangle -> Ptr Vector2 -> Ptr Rectangle -> IO CInt|], False),
       ("c'guiLabel", "GuiLabel_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiButton", "GuiButton_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiLabelButton", "GuiLabelButton_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiToggle", "GuiToggle_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CBool -> IO CInt|], False),
       ("c'guiToggleGroup", "GuiToggleGroup_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> IO CInt|], False),
       ("c'guiToggleSlider", "GuiToggleSlider_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> IO CInt|], False),
       ("c'guiCheckBox", "GuiCheckBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CBool -> IO CInt|], False),
       ("c'guiComboBox", "GuiComboBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> IO CInt|], False),
       ("c'guiDropdownBox", "GuiDropdownBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> CBool -> IO CInt|], False),
       ("c'guiSpinner", "GuiSpinner_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> CInt -> CInt -> CBool -> IO CInt|], False),
       ("c'guiValueBox", "GuiValueBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> CInt -> CInt -> CBool -> IO CInt|], False),
       ("c'guiTextBox", "GuiTextBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CInt -> CBool -> IO CInt|], False),
       ("c'guiSlider", "GuiSlider_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt|], False),
       ("c'guiSliderBar", "GuiSliderBar_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt|], False),
       ("c'guiProgressBar", "GuiProgressBar_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt|], False),
       ("c'guiStatusBar", "GuiStatusBar_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiDummyRec", "GuiDummyRec_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> IO CInt|], False),
       ("c'guiGrid", "GuiGrid_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CFloat -> CInt -> Ptr Vector2 -> IO CInt|], False),
       ("c'guiListView", "GuiListView_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CInt -> Ptr CInt -> IO CInt|], False),
       ("c'guiListViewEx", "GuiListViewEx_", "rgui_bindings.h", [t|Ptr Rectangle -> Ptr CString -> CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt|], False),
       ("c'guiMessageBox", "GuiMessageBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CString -> CString -> IO CInt|], False),
       ("c'guiTextInputBox", "GuiTextInputBox_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> CString -> CString -> CString -> CInt -> Ptr CBool -> IO CInt|], False),
       ("c'guiColorPicker", "GuiColorPicker_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr Color -> IO CInt|], False),
       ("c'guiColorPanel", "GuiColorPanel_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr Color -> IO CInt|], False),
       ("c'guiColorBarAlpha", "GuiColorBarAlpha_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CFloat -> IO CInt|], False),
       ("c'guiColorBarHue", "GuiColorBarHue_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr CFloat -> IO CInt|], False),
       ("c'guiColorPickerHSV", "GuiColorPickerHSV_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr Vector3 -> IO CInt|], False),
       ("c'guiColorPanelHSV", "GuiColorPanelHSV_", "rgui_bindings.h", [t|Ptr Rectangle -> CString -> Ptr Vector3 -> IO CInt|], False)
     ]
 )

-- | Enable gui controls (global state)
guiEnable :: IO ()
guiEnable :: IO ()
guiEnable = IO ()
c'guiEnable

-- | Disable gui controls (global state)
guiDisable :: IO ()
guiDisable :: IO ()
guiDisable = IO ()
c'guiDisable

-- | Lock gui controls (global state)
guiLock :: IO ()
guiLock :: IO ()
guiLock = IO ()
c'guiLock

-- | Unlock gui controls (global state)
guiUnlock :: IO ()
guiUnlock :: IO ()
guiUnlock = IO ()
c'guiUnlock

-- | Check if gui is locked (global state)
guiIsLocked :: IO Bool
guiIsLocked :: IO Bool
guiIsLocked = 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'guiIsLocked

-- | Set gui controls alpha (global state), alpha goes from 0.0f to 1.0f
guiSetAlpha :: Float -> IO ()
guiSetAlpha :: Float -> IO ()
guiSetAlpha = CFloat -> IO ()
c'guiSetAlpha (CFloat -> IO ()) -> (Float -> CFloat) -> Float -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Set gui state (global state)
guiSetState :: GuiState -> IO ()
guiSetState :: GuiState -> IO ()
guiSetState = CInt -> IO ()
c'guiSetState (CInt -> IO ()) -> (GuiState -> CInt) -> GuiState -> 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) -> (GuiState -> Int) -> GuiState -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuiState -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Get gui state (global state)
guiGetState :: IO GuiState
guiGetState :: IO GuiState
guiGetState = Int -> GuiState
forall a. Enum a => Int -> a
toEnum (Int -> GuiState) -> (CInt -> Int) -> CInt -> GuiState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> GuiState) -> IO CInt -> IO GuiState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'guiGetState

-- | Set gui custom font (global state)
guiSetFont :: Font -> IO ()
guiSetFont :: Font -> IO ()
guiSetFont Font
font = Font -> (Ptr Font -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font Ptr Font -> IO ()
c'guiSetFont

-- | Get gui custom font (global state)
guiGetFont :: IO Font
guiGetFont :: IO Font
guiGetFont = IO (Ptr Font)
c'guiGetFont IO (Ptr Font) -> (Ptr Font -> IO Font) -> IO Font
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Font -> IO Font
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Set style property as `Int`
guiSetStyle :: (Enum e) => GuiControl -> e -> Int -> IO ()
guiSetStyle :: forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
control e
property Int
value = CInt -> CInt -> CInt -> IO ()
c'guiSetStyle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiControl -> Int
forall a. Enum a => a -> Int
fromEnum GuiControl
control)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Int
forall a. Enum a => a -> Int
fromEnum e
property)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)

-- | Set style property as `Color`
guiSetStyleC :: (Enum e) => GuiControl -> e -> Color -> IO ()
guiSetStyleC :: forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control e
property Color
color = GuiControl -> e -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
control e
property (Color -> Int
colorToInt Color
color)

-- | Set style property as `Enum`
guiSetStyleE :: (Enum e, Enum v) => GuiControl -> e -> v -> IO ()
guiSetStyleE :: forall e v. (Enum e, Enum v) => GuiControl -> e -> v -> IO ()
guiSetStyleE GuiControl
control e
property v
value = GuiControl -> e -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
control e
property (v -> Int
forall a. Enum a => a -> Int
fromEnum v
value)

-- | Set BORDER_COLOR_NORMAL style property
-- | Control border color in STATE_NORMAL
guiSetStyleBorderColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BorderColorNormal

-- | Set BASE_COLOR_NORMAL style property
-- | Control base color in STATE_NORMAL
guiSetStyleBaseColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BaseColorNormal

-- | Set TEXT_COLOR_NORMAL style property
-- | Control text color in STATE_NORMAL
guiSetStyleTextColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleTextColorNormal :: GuiControl -> Color -> IO ()
guiSetStyleTextColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
TextColorNormal

-- | Set BORDER_COLOR_FOCUSED style property
-- | Control border color in STATE_FOCUSED
guiSetStyleBorderColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BorderColorFocused

-- | Set BASE_COLOR_FOCUSED style property
-- | Control base color in STATE_FOCUSED
guiSetStyleBaseColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BaseColorFocused

-- | Set TEXT_COLOR_FOCUSED style property
-- | Control text color in STATE_FOCUSED
guiSetStyleTextColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleTextColorFocused :: GuiControl -> Color -> IO ()
guiSetStyleTextColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
TextColorFocused

-- | Set BORDER_COLOR_PRESSED style property
-- | Control border color in STATE_PRESSED
guiSetStyleBorderColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BorderColorPressed

-- | Set BASE_COLOR_PRESSED style property
-- | Control base color in STATE_PRESSED
guiSetStyleBaseColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BaseColorPressed

-- | Set TEXT_COLOR_PRESSED style property
-- | Control text color in STATE_PRESSED
guiSetStyleTextColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleTextColorPressed :: GuiControl -> Color -> IO ()
guiSetStyleTextColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
TextColorPressed

-- | Set BORDER_COLOR_DISABLED style property
-- | Control border color in STATE_DISABLED
guiSetStyleBorderColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleBorderColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BorderColorDisabled

-- | Set BASE_COLOR_DISABLED style property
-- | Control base color in STATE_DISABLED
guiSetStyleBaseColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleBaseColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
BaseColorDisabled

-- | Set TEXT_COLOR_DISABLED style property
-- | Control text color in STATE_DISABLED
guiSetStyleTextColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleTextColorDisabled :: GuiControl -> Color -> IO ()
guiSetStyleTextColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
control GuiControlProperty
TextColorDisabled

-- | Set BORDER_WIDTH style property
-- | Control border size, 0 for no border
guiSetStyleBorderWidth :: GuiControl -> Int -> IO ()
guiSetStyleBorderWidth :: GuiControl -> Int -> IO ()
guiSetStyleBorderWidth GuiControl
control = GuiControl -> GuiControlProperty -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
control GuiControlProperty
BorderWidth

-- | Set TEXT_PADDING style property
-- | Control text padding, not considering border
guiSetStyleTextPadding :: GuiControl -> Int -> IO ()
guiSetStyleTextPadding :: GuiControl -> Int -> IO ()
guiSetStyleTextPadding GuiControl
control = GuiControl -> GuiControlProperty -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
control GuiControlProperty
TextPadding

-- | Set TEXT_ALIGNMENT style property
-- | Control text horizontal alignment inside control text bound (after border and padding)
guiSetStyleTextAlignment :: GuiControl -> GuiTextAlignment -> IO ()
guiSetStyleTextAlignment :: GuiControl -> GuiTextAlignment -> IO ()
guiSetStyleTextAlignment GuiControl
control = GuiControl -> GuiControlProperty -> GuiTextAlignment -> IO ()
forall e v. (Enum e, Enum v) => GuiControl -> e -> v -> IO ()
guiSetStyleE GuiControl
control GuiControlProperty
TextAlignment

-- | Set TEXT_SIZE default style property
-- | Text size (glyphs max height)
guiSetStyleTextSize :: Int -> IO ()
guiSetStyleTextSize :: Int -> IO ()
guiSetStyleTextSize = GuiControl -> GuiDefaultProperty -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
Default GuiDefaultProperty
TextSize

-- | Set TEXT_SPACING default style property
-- | Text spacing between glyphs
guiSetStyleTextSpacing :: Int -> IO ()
guiSetStyleTextSpacing :: Int -> IO ()
guiSetStyleTextSpacing = GuiControl -> GuiDefaultProperty -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
Default GuiDefaultProperty
TextSpacing

-- | Set LINE_COLOR default style property
-- | Line control color
guiSetStyleLineColor :: Color -> IO ()
guiSetStyleLineColor :: Color -> IO ()
guiSetStyleLineColor = GuiControl -> GuiDefaultProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
Default GuiDefaultProperty
LineColor

-- | Set BACKGROUND_COLOR default style property
-- | Background color
guiSetStyleBackgroundColor :: Color -> IO ()
guiSetStyleBackgroundColor :: Color -> IO ()
guiSetStyleBackgroundColor = GuiControl -> GuiDefaultProperty -> Color -> IO ()
forall e. Enum e => GuiControl -> e -> Color -> IO ()
guiSetStyleC GuiControl
Default GuiDefaultProperty
BackgroundColor

-- | Set TEXT_LINE_SPACING default style property
-- | Text spacing between lines
guiSetStyleTextLineSpacing :: Int -> IO ()
guiSetStyleTextLineSpacing :: Int -> IO ()
guiSetStyleTextLineSpacing = GuiControl -> GuiDefaultProperty -> Int -> IO ()
forall e. Enum e => GuiControl -> e -> Int -> IO ()
guiSetStyle GuiControl
Default GuiDefaultProperty
TextLineSpacing

-- | Set TEXT_ALIGNMENT_VERTICAL default style property
-- | Text vertical alignment inside text bounds (after border and padding)
guiSetStyleTextAlignmentVertical :: GuiTextAlignmentVertical -> IO ()
guiSetStyleTextAlignmentVertical :: GuiTextAlignmentVertical -> IO ()
guiSetStyleTextAlignmentVertical = GuiControl
-> GuiDefaultProperty -> GuiTextAlignmentVertical -> IO ()
forall e v. (Enum e, Enum v) => GuiControl -> e -> v -> IO ()
guiSetStyleE GuiControl
Default GuiDefaultProperty
TextAlignmentVertical

-- | Set TEXT_WRAP_MODE default style property
-- | Text wrap-mode inside text bounds
guiSetStyleTextWrapMode :: GuiTextWrapMode -> IO ()
guiSetStyleTextWrapMode :: GuiTextWrapMode -> IO ()
guiSetStyleTextWrapMode = GuiControl -> GuiDefaultProperty -> GuiTextWrapMode -> IO ()
forall e v. (Enum e, Enum v) => GuiControl -> e -> v -> IO ()
guiSetStyleE GuiControl
Default GuiDefaultProperty
TextWrapMode

-- | Get style property as `Int`
guiGetStyle :: (Enum e) => GuiControl -> e -> IO Int
guiGetStyle :: forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
control e
property = 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'guiGetStyle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiControl -> Int
forall a. Enum a => a -> Int
fromEnum GuiControl
control)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Int
forall a. Enum a => a -> Int
fromEnum e
property))

-- | Set style property as `Color`
guiGetStyleC :: (Enum e) => GuiControl -> e -> IO Color
guiGetStyleC :: forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control e
property = Integer -> Color
getColor (Integer -> Color) -> (Int -> Integer) -> Int -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Color) -> IO Int -> IO Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GuiControl -> e -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
control e
property

-- | Set style property as `Enum`
guiGetStyleE :: (Enum e, Enum v) => GuiControl -> e -> IO v
guiGetStyleE :: forall e v. (Enum e, Enum v) => GuiControl -> e -> IO v
guiGetStyleE GuiControl
control e
property = Int -> v
forall a. Enum a => Int -> a
toEnum (Int -> v) -> IO Int -> IO v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GuiControl -> e -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
control e
property

-- | Get BORDER_COLOR_NORMAL style property
-- | Control border color in STATE_NORMAL
guiGetStyleBorderColorNormal :: GuiControl -> IO Color
guiGetStyleBorderColorNormal :: GuiControl -> IO Color
guiGetStyleBorderColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BorderColorNormal

-- | Get BASE_COLOR_NORMAL style property
-- | Control base color in STATE_NORMAL
guiGetStyleBaseColorNormal :: GuiControl -> IO Color
guiGetStyleBaseColorNormal :: GuiControl -> IO Color
guiGetStyleBaseColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BaseColorNormal

-- | Get TEXT_COLOR_NORMAL style property
-- | Control text color in STATE_NORMAL
guiGetStyleTextColorNormal :: GuiControl -> IO Color
guiGetStyleTextColorNormal :: GuiControl -> IO Color
guiGetStyleTextColorNormal GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
TextColorNormal

-- | Get BORDER_COLOR_FOCUSED style property
-- | Control border color in STATE_FOCUSED
guiGetStyleBorderColorFocused :: GuiControl -> IO Color
guiGetStyleBorderColorFocused :: GuiControl -> IO Color
guiGetStyleBorderColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BorderColorFocused

-- | Get BASE_COLOR_FOCUSED style property
-- | Control base color in STATE_FOCUSED
guiGetStyleBaseColorFocused :: GuiControl -> IO Color
guiGetStyleBaseColorFocused :: GuiControl -> IO Color
guiGetStyleBaseColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BaseColorFocused

-- | Get TEXT_COLOR_FOCUSED style property
-- | Control text color in STATE_FOCUSED
guiGetStyleTextColorFocused :: GuiControl -> IO Color
guiGetStyleTextColorFocused :: GuiControl -> IO Color
guiGetStyleTextColorFocused GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
TextColorFocused

-- | Get BORDER_COLOR_PRESSED style property
-- | Control border color in STATE_PRESSED
guiGetStyleBorderColorPressed :: GuiControl -> IO Color
guiGetStyleBorderColorPressed :: GuiControl -> IO Color
guiGetStyleBorderColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BorderColorPressed

-- | Get BASE_COLOR_PRESSED style property
-- | Control base color in STATE_PRESSED
guiGetStyleBaseColorPressed :: GuiControl -> IO Color
guiGetStyleBaseColorPressed :: GuiControl -> IO Color
guiGetStyleBaseColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BaseColorPressed

-- | Get TEXT_COLOR_PRESSED style property
-- | Control text color in STATE_PRESSED
guiGetStyleTextColorPressed :: GuiControl -> IO Color
guiGetStyleTextColorPressed :: GuiControl -> IO Color
guiGetStyleTextColorPressed GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
TextColorPressed

-- | Get BORDER_COLOR_DISABLED style property
-- | Control border color in STATE_DISABLED
guiGetStyleBorderColorDisabled :: GuiControl -> IO Color
guiGetStyleBorderColorDisabled :: GuiControl -> IO Color
guiGetStyleBorderColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BorderColorDisabled

-- | Get BASE_COLOR_DISABLED style property
-- | Control base color in STATE_DISABLED
guiGetStyleBaseColorDisabled :: GuiControl -> IO Color
guiGetStyleBaseColorDisabled :: GuiControl -> IO Color
guiGetStyleBaseColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
BaseColorDisabled

-- | Get TEXT_COLOR_DISABLED style property
-- | Control text color in STATE_DISABLED
guiGetStyleTextColorDisabled :: GuiControl -> IO Color
guiGetStyleTextColorDisabled :: GuiControl -> IO Color
guiGetStyleTextColorDisabled GuiControl
control = GuiControl -> GuiControlProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
control GuiControlProperty
TextColorDisabled

-- | Get BORDER_WIDTH style property
-- | Control border size, 0 for no border
guiGetStyleBorderWidth :: GuiControl -> IO Int
guiGetStyleBorderWidth :: GuiControl -> IO Int
guiGetStyleBorderWidth GuiControl
control = GuiControl -> GuiControlProperty -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
control GuiControlProperty
BorderWidth

-- | Get TEXT_PADDING style property
-- | Control text padding, not considering border
guiGetStyleTextPadding :: GuiControl -> IO Int
guiGetStyleTextPadding :: GuiControl -> IO Int
guiGetStyleTextPadding GuiControl
control = GuiControl -> GuiControlProperty -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
control GuiControlProperty
TextPadding

-- | Get TEXT_ALIGNMENT style property
-- | Control text horizontal alignment inside control text bound (after border and padding)
guiGetStyleTextAlignment :: GuiControl -> IO GuiTextAlignment
guiGetStyleTextAlignment :: GuiControl -> IO GuiTextAlignment
guiGetStyleTextAlignment GuiControl
control = GuiControl -> GuiControlProperty -> IO GuiTextAlignment
forall e v. (Enum e, Enum v) => GuiControl -> e -> IO v
guiGetStyleE GuiControl
control GuiControlProperty
TextAlignment

-- | Get TEXT_SIZE default style property
-- | Text size (glyphs max height)
guiGetStyleTextSize :: IO Int
guiGetStyleTextSize :: IO Int
guiGetStyleTextSize = GuiControl -> GuiDefaultProperty -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
Default GuiDefaultProperty
TextSize

-- | Get TEXT_SPACING default style property
-- | Text spacing between glyphs
guiGetStyleTextSpacing :: IO Int
guiGetStyleTextSpacing :: IO Int
guiGetStyleTextSpacing = GuiControl -> GuiDefaultProperty -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
Default GuiDefaultProperty
TextSpacing

-- | Get LINE_COLOR default style property
-- | Line control color
guiGetStyleLineColor :: IO Color
guiGetStyleLineColor :: IO Color
guiGetStyleLineColor = GuiControl -> GuiDefaultProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
Default GuiDefaultProperty
LineColor

-- | Get BACKGROUND_COLOR default style property
-- | Background color
guiGetStyleBackgroundColor :: IO Color
guiGetStyleBackgroundColor :: IO Color
guiGetStyleBackgroundColor = GuiControl -> GuiDefaultProperty -> IO Color
forall e. Enum e => GuiControl -> e -> IO Color
guiGetStyleC GuiControl
Default GuiDefaultProperty
BackgroundColor

-- | Get TEXT_LINE_SPACING default style property
-- | Text spacing between lines
guiGetStyleTextLineSpacing :: IO Int
guiGetStyleTextLineSpacing :: IO Int
guiGetStyleTextLineSpacing = GuiControl -> GuiDefaultProperty -> IO Int
forall e. Enum e => GuiControl -> e -> IO Int
guiGetStyle GuiControl
Default GuiDefaultProperty
TextLineSpacing

-- | Get TEXT_ALIGNMENT_VERTICAL default style property
-- | Text vertical alignment inside text bounds (after border and padding)
guiGetStyleTextAlignmentVertical :: IO GuiTextAlignmentVertical
guiGetStyleTextAlignmentVertical :: IO GuiTextAlignmentVertical
guiGetStyleTextAlignmentVertical = GuiControl -> GuiDefaultProperty -> IO GuiTextAlignmentVertical
forall e v. (Enum e, Enum v) => GuiControl -> e -> IO v
guiGetStyleE GuiControl
Default GuiDefaultProperty
TextAlignmentVertical

-- | Get TEXT_WRAP_MODE default style property
-- | Text wrap-mode inside text bounds
guiGetStyleTextWrapMode :: IO GuiTextWrapMode
guiGetStyleTextWrapMode :: IO GuiTextWrapMode
guiGetStyleTextWrapMode = GuiControl -> GuiDefaultProperty -> IO GuiTextWrapMode
forall e v. (Enum e, Enum v) => GuiControl -> e -> IO v
guiGetStyleE GuiControl
Default GuiDefaultProperty
TextWrapMode

-- | Load style file over global style variable (.rgs)
guiLoadStyle :: String -> IO ()
guiLoadStyle :: String -> IO ()
guiLoadStyle String
fileName = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO ()
c'guiLoadStyle

-- | Load style default over global style
guiLoadStyleDefault :: IO ()
guiLoadStyleDefault :: IO ()
guiLoadStyleDefault = IO ()
c'guiLoadStyleDefault

-- | Enable gui tooltips (global state)
guiEnableTooltip :: IO ()
guiEnableTooltip :: IO ()
guiEnableTooltip = IO ()
c'guiEnableTooltip

-- | Disable gui tooltips (global state)
guiDisableTooltip :: IO ()
guiDisableTooltip :: IO ()
guiDisableTooltip = IO ()
c'guiDisableTooltip

-- | Set tooltip string
guiSetTooltip :: String -> IO ()
guiSetTooltip :: String -> IO ()
guiSetTooltip String
tooltip = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
tooltip CString -> IO ()
c'guiSetTooltip

-- | Get text with icon id prepended (if supported)
guiIconText :: GuiIconName -> String -> IO String
guiIconText :: GuiIconName -> String -> IO String
guiIconText GuiIconName
icon String
text = String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
text (CInt -> CString -> IO CString
c'guiIconText (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiIconName -> Int
forall a. Enum a => a -> Int
fromEnum GuiIconName
icon)) (CString -> IO CString)
-> (CString -> IO String) -> CString -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO String
peekCString)

-- | Set default icon drawing size
guiSetIconScale :: Int -> IO ()
guiSetIconScale :: Int -> IO ()
guiSetIconScale = CInt -> IO ()
c'guiSetIconScale (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

-- | Get raygui icons raw pointer (8192 bytes)
guiGetIcons :: IO (Ptr CUInt)
guiGetIcons :: IO (Ptr CUInt)
guiGetIcons = IO (Ptr CUInt)
c'guiGetIcons

-- | Load raygui icons file (.rgi) into internal icons data
guiLoadIcons ::
  String ->
  Bool ->
  -- | The number of icons in the file
  Int ->
  IO [String]
guiLoadIcons :: String -> Bool -> Int -> IO [String]
guiLoadIcons String
fileName Bool
loadIconsName Int
count = do
  Ptr CString
raw <- String -> (CString -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (\CString
f -> CString -> CBool -> IO (Ptr CString)
c'guiLoadIcons CString
f (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
loadIconsName))
  [CString]
cStrings <- Int -> Ptr CString -> IO [CString]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
count Ptr CString
raw
  (CString -> IO String) -> [CString] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CString -> IO String
popCString [CString]
cStrings

-- | Draw icon using pixel size at specified position
guiDrawIcon :: GuiIconName -> Int -> Int -> Int -> Color -> IO ()
guiDrawIcon :: GuiIconName -> Int -> Int -> Int -> Color -> IO ()
guiDrawIcon GuiIconName
icon Int
posX Int
posY Int
pixelSize Color
color = Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'guiDrawIcon (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiIconName -> Int
forall a. Enum a => a -> Int
fromEnum GuiIconName
icon)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pixelSize))

-- | Window Box control, shows a window that can be closed
guiWindowBox ::
  Rectangle ->
  Maybe String ->
  -- | `True` if the close button is clicked
  IO Bool
guiWindowBox :: Rectangle -> Maybe String -> IO Bool
guiWindowBox Rectangle
bounds Maybe String
title = CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
title ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiWindowBox)

-- | Group Box control with text name
guiGroupBox :: Rectangle -> Maybe String -> IO ()
guiGroupBox :: Rectangle -> Maybe String -> IO ()
guiGroupBox Rectangle
bounds Maybe String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiGroupBox))

-- | Line separator control, could contain text
guiLine :: Rectangle -> Maybe String -> IO ()
guiLine :: Rectangle -> Maybe String -> IO ()
guiLine Rectangle
bounds Maybe String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiLine))

-- | Panel control, useful to group controls
guiPanel :: Rectangle -> Maybe String -> IO ()
guiPanel :: Rectangle -> Maybe String -> IO ()
guiPanel Rectangle
bounds Maybe String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiPanel))

-- | Tab Bar control
guiTabBar ::
  Rectangle ->
  [String] ->
  -- | The currently active tab's index, use `Nothing` if creating the tab bar
  --   for the first time
  Maybe Int ->
  -- | A tuple, the first element is the index of the active tab, the second
  --   element is the tab whose close button is pressed (if any)
  IO (Int, Maybe Int)
guiTabBar :: Rectangle -> [String] -> Maybe Int -> IO (Int, Maybe Int)
guiTabBar Rectangle
bounds [String]
tabNames Maybe Int
active = do
  [CString]
cStrings <- (String -> IO CString) -> [String] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO CString
newCString [String]
tabNames
  Rectangle
-> (Ptr Rectangle -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        [CString]
-> (Int -> Ptr CString -> IO (Int, Maybe Int))
-> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
          [CString]
cStrings
          ( \Int
l Ptr CString
t ->
              CInt -> (Ptr CInt -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
active))
                ( \Ptr CInt
a -> do
                    CInt
close <- Ptr Rectangle -> Ptr CString -> CInt -> Ptr CInt -> IO CInt
c'guiTabBar Ptr Rectangle
b Ptr CString
t (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) Ptr CInt
a
                    CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a
                    (Int, Maybe Int) -> IO (Int, Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
active', if CInt
close CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
close))
                )
          )
    )

-- | Scroll Panel control
guiScrollPanel ::
  Rectangle ->
  Maybe String ->
  Rectangle ->
  -- | The panel's scroll vector, use `Nothing` if creating the panel for the
  --   first time
  Maybe Vector2 ->
  -- | The panel's view rectangle, use `Nothing` if creating the panel for the
  --   first time
  Maybe Rectangle ->
  -- | The panel's updated scroll vector and view rectangle as a tuple
  IO (Vector2, Rectangle)
guiScrollPanel :: Rectangle
-> Maybe String
-> Rectangle
-> Maybe Vector2
-> Maybe Rectangle
-> IO (Vector2, Rectangle)
guiScrollPanel Rectangle
bounds Maybe String
text Rectangle
content Maybe Vector2
scroll Maybe Rectangle
view =
  Rectangle
-> (Ptr Rectangle -> IO (Vector2, Rectangle))
-> IO (Vector2, Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String
-> (CString -> IO (Vector2, Rectangle)) -> IO (Vector2, Rectangle)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
text
          ( \CString
t ->
              Rectangle
-> (Ptr Rectangle -> IO (Vector2, Rectangle))
-> IO (Vector2, Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                Rectangle
content
                ( \Ptr Rectangle
c ->
                    Vector2
-> (Ptr Vector2 -> IO (Vector2, Rectangle))
-> IO (Vector2, Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      (Vector2 -> Maybe Vector2 -> Vector2
forall a. a -> Maybe a -> a
fromMaybe (Float -> Float -> Vector2
Vector2 Float
0 Float
0) Maybe Vector2
scroll)
                      ( \Ptr Vector2
s ->
                          Rectangle
-> (Ptr Rectangle -> IO (Vector2, Rectangle))
-> IO (Vector2, Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                            (Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Float -> Float -> Float -> Float -> Rectangle
Rectangle Float
0 Float
0 Float
0 Float
0) Maybe Rectangle
view)
                            ( \Ptr Rectangle
v -> do
                                CInt
_ <- Ptr Rectangle
-> CString
-> Ptr Rectangle
-> Ptr Vector2
-> Ptr Rectangle
-> IO CInt
c'guiScrollPanel Ptr Rectangle
b CString
t Ptr Rectangle
c Ptr Vector2
s Ptr Rectangle
v
                                Vector2
scroll' <- Ptr Vector2 -> IO Vector2
forall a. Storable a => Ptr a -> IO a
peek Ptr Vector2
s
                                Rectangle
view' <- Ptr Rectangle -> IO Rectangle
forall a. Storable a => Ptr a -> IO a
peek Ptr Rectangle
v
                                (Vector2, Rectangle) -> IO (Vector2, Rectangle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector2
scroll', Rectangle
view')
                            )
                      )
                )
          )
    )

-- | Label control
guiLabel :: Rectangle -> String -> IO ()
guiLabel :: Rectangle -> String -> IO ()
guiLabel Rectangle
bounds String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiLabel))

-- | Button control, returns true when clicked
guiButton :: Rectangle -> Maybe String -> IO Bool
guiButton :: Rectangle -> Maybe String -> IO Bool
guiButton Rectangle
bounds Maybe String
text = CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiButton)

-- | Label button control, returns true when clicked
guiLabelButton :: Rectangle -> Maybe String -> IO Bool
guiLabelButton :: Rectangle -> Maybe String -> IO Bool
guiLabelButton Rectangle
bounds Maybe String
text = CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (Maybe String -> (CString -> IO CInt) -> IO CInt
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiLabelButton)

-- | Toggle Button control
guiToggle :: Rectangle -> Maybe String -> Bool -> IO Bool
guiToggle :: Rectangle -> Maybe String -> Bool -> IO Bool
guiToggle Rectangle
bounds Maybe String
text Bool
active = 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
<$> Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (\Ptr Rectangle
b -> Maybe String -> (CString -> IO CBool) -> IO CBool
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text (\CString
t -> CBool -> (Ptr CBool -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
active :: CBool) (\Ptr CBool
a -> Ptr Rectangle -> CString -> Ptr CBool -> IO CInt
c'guiToggle Ptr Rectangle
b CString
t Ptr CBool
a IO CInt -> IO CBool -> IO CBool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
a)))

-- | Toggle Group control
guiToggleGroup ::
  Rectangle ->
  -- | The names of the toggles, separated with semicolons
  String ->
  -- | The currently active toggle's index, use `Nothing` if creating the
  --   toggle group for the first time
  Maybe Int ->
  -- | The updated active toggle index
  IO Int
guiToggleGroup :: Rectangle -> String -> Maybe Int -> IO Int
guiToggleGroup Rectangle
bounds String
text Maybe Int
active = 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
<$> Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (\Ptr Rectangle
b -> String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> CInt -> (Ptr CInt -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
active)) (\Ptr CInt
a -> Ptr Rectangle -> CString -> Ptr CInt -> IO CInt
c'guiToggleGroup Ptr Rectangle
b CString
t Ptr CInt
a IO CInt -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a)))

-- | Toggle Slider control
guiToggleSlider ::
  Rectangle ->
  -- | The names of the toggles, separated with semicolons
  String ->
  -- | The currently active toggle's index, use `Nothing` if creating the
  --   toggle slider for the first time
  Maybe Int ->
  -- | A tuple, the first element is whether the slider was clicked, the second
  --   element is the updated toggle index
  IO (Bool, Int)
guiToggleSlider :: Rectangle -> String -> Maybe Int -> IO (Bool, Int)
guiToggleSlider Rectangle
bounds String
text Maybe Int
active =
  Rectangle -> (Ptr Rectangle -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        String -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. String -> (CString -> IO a) -> IO a
withCString
          String
text
          ( \CString
t ->
              CInt -> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
active))
                ( \Ptr CInt
a -> do
                    CInt
clicked <- Ptr Rectangle -> CString -> Ptr CInt -> IO CInt
c'guiToggleSlider Ptr Rectangle
b CString
t Ptr CInt
a
                    CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a
                    (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
clicked, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
active')
                )
          )
    )

-- | Check Box control
guiCheckBox ::
  Rectangle ->
  Maybe String ->
  -- | The current checkbox state (checked/unchecked)
  Bool ->
  -- | The updated checkbox state (checked/unchecked)
  IO Bool
guiCheckBox :: Rectangle -> Maybe String -> Bool -> IO Bool
guiCheckBox Rectangle
bounds Maybe String
text Bool
checked = 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
<$> Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (\Ptr Rectangle
b -> Maybe String -> (CString -> IO CBool) -> IO CBool
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
text (\CString
t -> CBool -> (Ptr CBool -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
checked :: CBool) (\Ptr CBool
c -> Ptr Rectangle -> CString -> Ptr CBool -> IO CInt
c'guiCheckBox Ptr Rectangle
b CString
t Ptr CBool
c IO CInt -> IO CBool -> IO CBool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
c)))

-- | Combo Box control
guiComboBox ::
  Rectangle ->
  -- | The names of the combobox options, separated with semicolons
  String ->
  -- | The currently active option's index, use `Nothing` if creating the
  --   combobox for the first time
  Maybe Int ->
  -- | The updated active option index
  IO Int
guiComboBox :: Rectangle -> String -> Maybe Int -> IO Int
guiComboBox Rectangle
bounds String
text Maybe Int
active = 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
<$> Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (\Ptr Rectangle
b -> String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> CInt -> (Ptr CInt -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
active)) (\Ptr CInt
a -> Ptr Rectangle -> CString -> Ptr CInt -> IO CInt
c'guiComboBox Ptr Rectangle
b CString
t Ptr CInt
a IO CInt -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a)))

-- | Dropdown Box control
guiDropdownBox ::
  Rectangle ->
  -- | The names of the dropdown options, separated with semicolons
  String ->
  -- | The currently active option's index, use `Nothing` if creating the
  --   dropdown for the first time
  Maybe Int ->
  -- | `True` if the dropdown should be open (editable), false otherwise
  Bool ->
  -- | A tuple, the first element is whether the dropdown was clicked (i.e.
  --   the open/closed mode should be toggled), the second element is the
  --   updated toggle index
  IO (Bool, Int)
guiDropdownBox :: Rectangle -> String -> Maybe Int -> Bool -> IO (Bool, Int)
guiDropdownBox Rectangle
bounds String
text Maybe Int
active Bool
editMode =
  Rectangle -> (Ptr Rectangle -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        String -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. String -> (CString -> IO a) -> IO a
withCString
          String
text
          ( \CString
t ->
              CInt -> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
active))
                ( \Ptr CInt
a -> do
                    CInt
toggle <- Ptr Rectangle -> CString -> Ptr CInt -> CBool -> IO CInt
c'guiDropdownBox Ptr Rectangle
b CString
t Ptr CInt
a (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
editMode)
                    CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a
                    (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
toggle, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
active')
                )
          )
    )

-- | Spinner control
guiSpinner ::
  Rectangle ->
  Maybe String ->
  -- | The current value
  Int ->
  Int ->
  Int ->
  -- | `True` if the spinner should be editable, `False` otherwise
  Bool ->
  -- | A tuple, the first element is whether the spinner was toggled (i.e.
  --   the edit mode should be toggled), the second element is the updated
  --   value
  IO (Bool, Int)
guiSpinner :: Rectangle
-> Maybe String -> Int -> Int -> Int -> Bool -> IO (Bool, Int)
guiSpinner Rectangle
bounds Maybe String
text Int
value Int
minValue Int
maxValue Bool
editMode =
  Rectangle -> (Ptr Rectangle -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
text
          ( \CString
t ->
              CInt -> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)
                ( \Ptr CInt
v -> do
                    CInt
changed <- Ptr Rectangle
-> CString -> Ptr CInt -> CInt -> CInt -> CBool -> IO CInt
c'guiSpinner Ptr Rectangle
b CString
t Ptr CInt
v (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
editMode)
                    CInt
value' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
v
                    (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
changed, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
value')
                )
          )
    )

-- | Value Box control, updates input text with numbers
guiValueBox ::
  Rectangle ->
  Maybe String ->
  -- | The current value
  Int ->
  Int ->
  Int ->
  -- | `True` if the value box should be editable, `False` otherwise
  Bool ->
  -- | A tuple, the first element is whether the value box was toggled (i.e.
  --   the edit mode should be toggled), the second element is the updated
  --   value
  IO (Bool, Int)
guiValueBox :: Rectangle
-> Maybe String -> Int -> Int -> Int -> Bool -> IO (Bool, Int)
guiValueBox Rectangle
bounds Maybe String
text Int
value Int
minValue Int
maxValue Bool
editMode =
  Rectangle -> (Ptr Rectangle -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
text
          ( \CString
t ->
              CInt -> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)
                ( \Ptr CInt
v -> do
                    CInt
changed <- Ptr Rectangle
-> CString -> Ptr CInt -> CInt -> CInt -> CBool -> IO CInt
c'guiValueBox Ptr Rectangle
b CString
t Ptr CInt
v (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
editMode)
                    CInt
value' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
v
                    (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
changed, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
value')
                )
          )
    )

-- | Text Box control, updates input text
guiTextBox ::
  Rectangle ->
  String ->
  -- | Text box buffer size; if `Nothing`, then it will automatically allocate
  --   a buffer large enough to fit the text
  Maybe Int ->
  -- | `True` if the text box should be editable, `False` otherwise
  Bool ->
  -- | A tuple, the first element is whether the text box was toggled (i.e.
  --   the edit mode should be toggled), the second element is the updated
  --   text box value
  IO (Bool, String)
guiTextBox :: Rectangle -> String -> Maybe Int -> Bool -> IO (Bool, String)
guiTextBox Rectangle
bounds String
text Maybe Int
bufferSize Bool
editMode =
  Rectangle
-> (Ptr Rectangle -> IO (Bool, String)) -> IO (Bool, String)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        String
-> Maybe Int -> (Int -> CString -> IO Bool) -> IO (Bool, String)
forall b.
String -> Maybe Int -> (Int -> CString -> IO b) -> IO (b, String)
withCStringBuffer
          String
text
          Maybe Int
bufferSize
          ( \Int
s CString
t -> CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Rectangle -> CString -> CInt -> CBool -> IO CInt
c'guiTextBox Ptr Rectangle
b CString
t (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
editMode)
          )
    )

-- | Slider control
guiSlider ::
  Rectangle ->
  Maybe String ->
  Maybe String ->
  -- | The current value
  Float ->
  Float ->
  Float ->
  -- | A tuple, the first element is whether the slider was edited, the
  --   second element is the updated value
  IO (Bool, Float)
guiSlider :: Rectangle
-> Maybe String
-> Maybe String
-> Float
-> Float
-> Float
-> IO (Bool, Float)
guiSlider Rectangle
bounds Maybe String
textLeft Maybe String
textRight Float
value Float
minValue Float
maxValue =
  Rectangle
-> (Ptr Rectangle -> IO (Bool, Float)) -> IO (Bool, Float)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String -> (CString -> IO (Bool, Float)) -> IO (Bool, Float)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
textLeft
          ( \CString
l ->
              Maybe String -> (CString -> IO (Bool, Float)) -> IO (Bool, Float)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
                Maybe String
textRight
                ( \CString
r ->
                    CFloat -> (Ptr CFloat -> IO (Bool, Float)) -> IO (Bool, Float)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value)
                      ( \Ptr CFloat
v -> do
                          CInt
edited <- Ptr Rectangle
-> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt
c'guiSlider Ptr Rectangle
b CString
l CString
r Ptr CFloat
v (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
minValue) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
maxValue)
                          CFloat
value' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
v
                          (Bool, Float) -> IO (Bool, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
edited, CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
value')
                      )
                )
          )
    )

-- | Slider Bar control
guiSliderBar ::
  Rectangle ->
  Maybe String ->
  Maybe String ->
  -- | The current value
  Float ->
  Float ->
  Float ->
  -- | A tuple, the first element is whether the slider bar was edited, the
  --   second element is the updated value
  IO (Bool, Float)
guiSliderBar :: Rectangle
-> Maybe String
-> Maybe String
-> Float
-> Float
-> Float
-> IO (Bool, Float)
guiSliderBar Rectangle
bounds Maybe String
textLeft Maybe String
textRight Float
value Float
minValue Float
maxValue =
  Rectangle
-> (Ptr Rectangle -> IO (Bool, Float)) -> IO (Bool, Float)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String -> (CString -> IO (Bool, Float)) -> IO (Bool, Float)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
textLeft
          ( \CString
l ->
              Maybe String -> (CString -> IO (Bool, Float)) -> IO (Bool, Float)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
                Maybe String
textRight
                ( \CString
r ->
                    CFloat -> (Ptr CFloat -> IO (Bool, Float)) -> IO (Bool, Float)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value)
                      ( \Ptr CFloat
v -> do
                          CInt
edited <- Ptr Rectangle
-> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt
c'guiSliderBar Ptr Rectangle
b CString
l CString
r Ptr CFloat
v (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
minValue) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
maxValue)
                          CFloat
value' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
v
                          (Bool, Float) -> IO (Bool, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
edited, CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
value')
                      )
                )
          )
    )

-- | Progress Bar control
guiProgressBar ::
  Rectangle ->
  Maybe String ->
  Maybe String ->
  -- | The current value
  Float ->
  Float ->
  Float ->
  -- | The updated value (clamped to min/max range)
  IO Float
guiProgressBar :: Rectangle
-> Maybe String
-> Maybe String
-> Float
-> Float
-> Float
-> IO Float
guiProgressBar Rectangle
bounds Maybe String
textLeft Maybe String
textRight Float
value Float
minValue Float
maxValue =
  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
<$> Rectangle -> (Ptr Rectangle -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
      Rectangle
bounds
      ( \Ptr Rectangle
b ->
          Maybe String -> (CString -> IO CFloat) -> IO CFloat
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
            Maybe String
textLeft
            ( \CString
l ->
                Maybe String -> (CString -> IO CFloat) -> IO CFloat
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
                  Maybe String
textRight
                  ( \CString
r ->
                      CFloat -> (Ptr CFloat -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                        (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value)
                        ( \Ptr CFloat
v -> do
                            Ptr Rectangle
-> CString -> CString -> Ptr CFloat -> CFloat -> CFloat -> IO CInt
c'guiProgressBar Ptr Rectangle
b CString
l CString
r Ptr CFloat
v (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
minValue) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
maxValue) IO CInt -> IO CFloat -> IO CFloat
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
v
                        )
                  )
            )
      )

-- | Status Bar control, shows info text
guiStatusBar :: Rectangle -> String -> IO ()
guiStatusBar :: Rectangle -> String -> IO ()
guiStatusBar Rectangle
bounds String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiStatusBar))

-- | Dummy control for placeholders
guiDummyRec :: Rectangle -> String -> IO ()
guiDummyRec :: Rectangle -> String -> IO ()
guiDummyRec Rectangle
bounds String
text = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
bounds (String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
text ((CString -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> CString -> IO CInt)
-> Ptr Rectangle
-> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> CString -> IO CInt
c'guiDummyRec))

-- | Grid control
guiGrid ::
  Rectangle ->
  Float ->
  Int ->
  -- | The cell the mouse is currently in
  IO (Maybe Vector2)
guiGrid :: Rectangle -> Float -> Int -> IO (Maybe Vector2)
guiGrid Rectangle
bounds Float
spacing Int
subdivs =
  Rectangle
-> (Ptr Rectangle -> IO (Maybe Vector2)) -> IO (Maybe Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Vector2
-> (Ptr Vector2 -> IO (Maybe Vector2)) -> IO (Maybe Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (Float -> Float -> Vector2
Vector2 (-Float
1) (-Float
1))
          ( \Ptr Vector2
v ->
              ( \Vector2
cell -> if Vector2
cell Vector2 -> Vector2 -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Float -> Vector2
Vector2 (-Float
1) (-Float
1) then Maybe Vector2
forall a. Maybe a
Nothing else Vector2 -> Maybe Vector2
forall a. a -> Maybe a
Just Vector2
cell
              )
                (Vector2 -> Maybe Vector2) -> IO Vector2 -> IO (Maybe Vector2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Ptr Rectangle
-> CString -> CFloat -> CInt -> Ptr Vector2 -> IO CInt
c'guiGrid Ptr Rectangle
b CString
forall a. Ptr a
nullPtr (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
subdivs) Ptr Vector2
v
                        IO CInt -> IO Vector2 -> IO Vector2
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Vector2 -> IO Vector2
forall a. Storable a => Ptr a -> IO a
peek Ptr Vector2
v
                    )
          )
    )

-- | List View control
guiListView ::
  Rectangle ->
  -- | The names of the list options, separated with semicolons
  String ->
  -- | Current scroll index
  Int ->
  -- | Currently selected option index (active index)
  Maybe Int ->
  -- | A tuple, the first element is the updated scroll index, the second
  --   element is the updated active index
  IO (Int, Maybe Int)
guiListView :: Rectangle -> String -> Int -> Maybe Int -> IO (Int, Maybe Int)
guiListView Rectangle
bounds String
text Int
scrollIndex Maybe Int
active =
  Rectangle
-> (Ptr Rectangle -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        String -> (CString -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a. String -> (CString -> IO a) -> IO a
withCString
          String
text
          ( \CString
t ->
              CInt -> (Ptr CInt -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scrollIndex)
                ( \Ptr CInt
s ->
                    CInt -> (Ptr CInt -> IO (Int, Maybe Int)) -> IO (Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
active))
                      ( \Ptr CInt
a -> do
                          CInt
_ <- Ptr Rectangle -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
c'guiListView Ptr Rectangle
b CString
t Ptr CInt
s Ptr CInt
a
                          CInt
scrollIndex' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
s
                          CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a
                          (Int, Maybe Int) -> IO (Int, Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
scrollIndex', if CInt
active' CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
active'))
                      )
                )
          )
    )

-- | List View with extended parameters
guiListViewEx ::
  Rectangle ->
  -- | The names of the list options
  [String] ->
  -- | Current scroll index
  Int ->
  -- | Currently selected option index (active index)
  Maybe Int ->
  -- | Currently focused option index
  Maybe Int ->
  -- | A tuple, the first element is the updated scroll index, the second
  --   element is the updated active index, the third element is the updated
  --   focus index
  IO (Int, Maybe Int, Maybe Int)
guiListViewEx :: Rectangle
-> [String]
-> Int
-> Maybe Int
-> Maybe Int
-> IO (Int, Maybe Int, Maybe Int)
guiListViewEx Rectangle
bounds [String]
text Int
scrollIndex Maybe Int
active Maybe Int
focus = do
  [CString]
cStrings <- (String -> IO CString) -> [String] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO CString
newCString [String]
text
  Rectangle
-> (Ptr Rectangle -> IO (Int, Maybe Int, Maybe Int))
-> IO (Int, Maybe Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        [CString]
-> (Int -> Ptr CString -> IO (Int, Maybe Int, Maybe Int))
-> IO (Int, Maybe Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
          [CString]
cStrings
          ( \Int
c Ptr CString
t ->
              CInt
-> (Ptr CInt -> IO (Int, Maybe Int, Maybe Int))
-> IO (Int, Maybe Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scrollIndex)
                ( \Ptr CInt
s ->
                    CInt
-> (Ptr CInt -> IO (Int, Maybe Int, Maybe Int))
-> IO (Int, Maybe Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
active))
                      ( \Ptr CInt
a ->
                          CInt
-> (Ptr CInt -> IO (Int, Maybe Int, Maybe Int))
-> IO (Int, Maybe Int, Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
focus))
                            ( \Ptr CInt
f -> do
                                CInt
_ <- Ptr Rectangle
-> Ptr CString
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
c'guiListViewEx Ptr Rectangle
b Ptr CString
t (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) Ptr CInt
s Ptr CInt
a Ptr CInt
f
                                CInt
scrollIndex' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
s
                                CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
a
                                CInt
focus' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
f
                                (Int, Maybe Int, Maybe Int) -> IO (Int, Maybe Int, Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
scrollIndex', if CInt
active' CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
active'), if CInt
focus' CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
focus'))
                            )
                      )
                )
          )
    )

-- | Message Box control, displays a message
guiMessageBox ::
  Rectangle ->
  Maybe String ->
  String ->
  -- | Button labels separated by semicolons
  String ->
  -- | The index of the clicked button, if any (0 = close message box,
  --   1,2,... = custom button)
  IO (Maybe Int)
guiMessageBox :: Rectangle -> Maybe String -> String -> String -> IO (Maybe Int)
guiMessageBox Rectangle
bounds Maybe String
title String
message String
buttons =
  Rectangle -> (Ptr Rectangle -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Maybe String -> (CString -> IO (Maybe Int)) -> IO (Maybe Int)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
          Maybe String
title
          ( \CString
t ->
              String -> (CString -> IO (Maybe Int)) -> IO (Maybe Int)
forall a. String -> (CString -> IO a) -> IO a
withCString
                String
message
                ( \CString
m ->
                    String -> (CString -> IO (Maybe Int)) -> IO (Maybe Int)
forall a. String -> (CString -> IO a) -> IO a
withCString
                      String
buttons
                      ( \CString
bu -> do
                          CInt
res <- Ptr Rectangle -> CString -> CString -> CString -> IO CInt
c'guiMessageBox Ptr Rectangle
b CString
t CString
m CString
bu
                          if CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing else Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res))
                      )
                )
          )
    )

-- | Text Input Box control, ask for text, supports secret
guiTextInputBox ::
  Rectangle ->
  Maybe String ->
  String ->
  -- | Button names, separated by semicolons
  String ->
  -- | Current text box value
  String ->
  -- | Text box buffer size; if `Nothing`, then it will automatically allocate
  --   a buffer large enough to fit the text
  Maybe Int ->
  -- | Secret (password) mode; `Just True` if the value should be censored;
  --   `Just False` if it should not be censored but there should still be a
  --   button to hide it; `Nothing` if the value should not be censored at all
  Maybe Bool ->
  -- | A tuple, the first element is the updated secret mode, the second
  --   element is the updated text box value, the third element is the index
  --   of the clicked button, if any (0 = close input box, 1,2,... = custom
  --   button)
  IO (Maybe Bool, String, Maybe Int)
guiTextInputBox :: Rectangle
-> Maybe String
-> String
-> String
-> String
-> Maybe Int
-> Maybe Bool
-> IO (Maybe Bool, String, Maybe Int)
guiTextInputBox Rectangle
bounds Maybe String
title String
message String
buttons String
value Maybe Int
bufferSize Maybe Bool
secret = do
  ((Maybe Int
clicked, Maybe Bool
secret'), String
value') <-
    Rectangle
-> (Ptr Rectangle -> IO ((Maybe Int, Maybe Bool), String))
-> IO ((Maybe Int, Maybe Bool), String)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
      Rectangle
bounds
      ( \Ptr Rectangle
b ->
          Maybe String
-> (CString -> IO ((Maybe Int, Maybe Bool), String))
-> IO ((Maybe Int, Maybe Bool), String)
forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString
            Maybe String
title
            ( \CString
t ->
                String
-> (CString -> IO ((Maybe Int, Maybe Bool), String))
-> IO ((Maybe Int, Maybe Bool), String)
forall a. String -> (CString -> IO a) -> IO a
withCString
                  String
message
                  ( \CString
m ->
                      String
-> (CString -> IO ((Maybe Int, Maybe Bool), String))
-> IO ((Maybe Int, Maybe Bool), String)
forall a. String -> (CString -> IO a) -> IO a
withCString
                        String
buttons
                        ( \CString
bu ->
                            String
-> Maybe Int
-> (Int -> CString -> IO (Maybe Int, Maybe Bool))
-> IO ((Maybe Int, Maybe Bool), String)
forall b.
String -> Maybe Int -> (Int -> CString -> IO b) -> IO (b, String)
withCStringBuffer
                              String
value
                              Maybe Int
bufferSize
                              ( \Int
s CString
te ->
                                  Maybe CBool
-> (Ptr CBool -> IO (Maybe Int, Maybe Bool))
-> IO (Maybe Int, Maybe Bool)
forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe
                                    (Bool -> CBool
forall a. Num a => Bool -> a
fromBool (Bool -> CBool) -> Maybe Bool -> Maybe CBool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
secret)
                                    ( \Ptr CBool
sec -> do
                                        CInt
clicked <- Ptr Rectangle
-> CString
-> CString
-> CString
-> CString
-> CInt
-> Ptr CBool
-> IO CInt
c'guiTextInputBox Ptr Rectangle
b CString
t CString
m CString
bu CString
te (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) Ptr CBool
sec
                                        Maybe Bool
secret' <- if Ptr CBool
sec Ptr CBool -> Ptr CBool -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CBool
forall a. Ptr a
nullPtr then Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing else Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (CBool -> Bool) -> CBool -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Maybe Bool) -> IO CBool -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
sec
                                        (Maybe Int, Maybe Bool) -> IO (Maybe Int, Maybe Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if CInt
clicked CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
clicked), Maybe Bool
secret')
                                    )
                              )
                        )
                  )
            )
      )
  (Maybe Bool, String, Maybe Int)
-> IO (Maybe Bool, String, Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool
secret', String
value', Maybe Int
clicked)

-- | Color Picker control (multiple color controls)
guiColorPicker ::
  Rectangle ->
  -- | Currently selected color, use `Nothing` if creating the color picker for
  --   the first time
  Maybe Color ->
  -- | Updated color
  IO Color
guiColorPicker :: Rectangle -> Maybe Color -> IO Color
guiColorPicker Rectangle
bounds Maybe Color
color =
  Rectangle -> (Ptr Rectangle -> IO Color) -> IO Color
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Color -> (Ptr Color -> IO Color) -> IO Color
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (Color -> Maybe Color -> Color
forall a. a -> Maybe a -> a
fromMaybe (Word8 -> Word8 -> Word8 -> Word8 -> Color
Color Word8
200 Word8
0 Word8
0 Word8
255) Maybe Color
color)
          ( \Ptr Color
c -> Ptr Rectangle -> CString -> Ptr Color -> IO CInt
c'guiColorPicker Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr Color
c IO CInt -> IO Color -> IO Color
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
c
          )
    )

-- | Color Panel control
guiColorPanel ::
  Rectangle ->
  -- | Currently selected color, use `Nothing` if creating the color panel for
  --   the first time
  Maybe Color ->
  -- | Updated color
  IO Color
guiColorPanel :: Rectangle -> Maybe Color -> IO Color
guiColorPanel Rectangle
bounds Maybe Color
color =
  Rectangle -> (Ptr Rectangle -> IO Color) -> IO Color
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Color -> (Ptr Color -> IO Color) -> IO Color
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (Color -> Maybe Color -> Color
forall a. a -> Maybe a -> a
fromMaybe (Word8 -> Word8 -> Word8 -> Word8 -> Color
Color Word8
200 Word8
0 Word8
0 Word8
255) Maybe Color
color)
          ( \Ptr Color
c -> Ptr Rectangle -> CString -> Ptr Color -> IO CInt
c'guiColorPanel Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr Color
c IO CInt -> IO Color -> IO Color
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
c
          )
    )

-- | Color Bar Alpha control
guiColorBarAlpha ::
  Rectangle ->
  -- | Currently selected alpha
  Float ->
  -- | Updated alpha
  IO Float
guiColorBarAlpha :: Rectangle -> Float -> IO Float
guiColorBarAlpha Rectangle
bounds Float
alpha =
  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
<$> Rectangle -> (Ptr Rectangle -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
      Rectangle
bounds
      ( \Ptr Rectangle
b ->
          CFloat -> (Ptr CFloat -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
            (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha)
            ( \Ptr CFloat
a -> Ptr Rectangle -> CString -> Ptr CFloat -> IO CInt
c'guiColorBarAlpha Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr CFloat
a IO CInt -> IO CFloat -> IO CFloat
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
a
            )
      )

-- | Color Bar Hue control
guiColorBarHue ::
  Rectangle ->
  -- | Currently selected hue
  Float ->
  -- | Updated hue
  IO Float
guiColorBarHue :: Rectangle -> Float -> IO Float
guiColorBarHue Rectangle
bounds Float
hue =
  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
<$> Rectangle -> (Ptr Rectangle -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
      Rectangle
bounds
      ( \Ptr Rectangle
b ->
          CFloat -> (Ptr CFloat -> IO CFloat) -> IO CFloat
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
            (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hue)
            ( \Ptr CFloat
h -> Ptr Rectangle -> CString -> Ptr CFloat -> IO CInt
c'guiColorBarHue Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr CFloat
h IO CInt -> IO CFloat -> IO CFloat
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
h
            )
      )

-- | Color Picker control that avoids conversion to RGB on each call (multiple color controls)
guiColorPickerHSV ::
  Rectangle ->
  -- | Currently selected color, use `Nothing` if creating the color picker for
  --   the first time
  Maybe Vector3 ->
  -- | Updated color
  IO Vector3
guiColorPickerHSV :: Rectangle -> Maybe Vector3 -> IO Vector3
guiColorPickerHSV Rectangle
bounds Maybe Vector3
color =
  Rectangle -> (Ptr Rectangle -> IO Vector3) -> IO Vector3
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Vector3 -> (Ptr Vector3 -> IO Vector3) -> IO Vector3
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (Vector3 -> Maybe Vector3 -> Vector3
forall a. a -> Maybe a -> a
fromMaybe (Float -> Float -> Float -> Vector3
Vector3 (Float
200.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0) Float
0 Float
0) Maybe Vector3
color)
          ( \Ptr Vector3
c -> Ptr Rectangle -> CString -> Ptr Vector3 -> IO CInt
c'guiColorPickerHSV Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr Vector3
c IO CInt -> IO Vector3 -> IO Vector3
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Vector3 -> IO Vector3
forall a. Storable a => Ptr a -> IO a
peek Ptr Vector3
c
          )
    )

-- | Color Panel control that updates Hue-Saturation-Value color value, used by guiColorPickerHSV
guiColorPanelHSV ::
  Rectangle ->
  -- | Currently selected color, use `Nothing` if creating the color panel for
  --   the first time
  Maybe Vector3 ->
  -- | Updated color
  IO Vector3
guiColorPanelHSV :: Rectangle -> Maybe Vector3 -> IO Vector3
guiColorPanelHSV Rectangle
bounds Maybe Vector3
color =
  Rectangle -> (Ptr Rectangle -> IO Vector3) -> IO Vector3
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
bounds
    ( \Ptr Rectangle
b ->
        Vector3 -> (Ptr Vector3 -> IO Vector3) -> IO Vector3
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          (Vector3 -> Maybe Vector3 -> Vector3
forall a. a -> Maybe a -> a
fromMaybe (Float -> Float -> Float -> Vector3
Vector3 (Float
200.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0) Float
0 Float
0) Maybe Vector3
color)
          ( \Ptr Vector3
c -> Ptr Rectangle -> CString -> Ptr Vector3 -> IO CInt
c'guiColorPanelHSV Ptr Rectangle
b CString
forall a. Ptr a
nullPtr Ptr Vector3
c IO CInt -> IO Vector3 -> IO Vector3
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Vector3 -> IO Vector3
forall a. Storable a => Ptr a -> IO a
peek Ptr Vector3
c
          )
    )