{-# OPTIONS -Wall #-}
{-# LANGUAGE DeriveAnyClass #-}

-- | Bindings for types used in @raygui@
module Raylib.Types.Util.GUI
  ( -- * Enumerations
    GuiState (..),
    GuiTextAlignment (..),
    GuiTextAlignmentVertical (..),
    GuiTextWrapMode (..),
    GuiControl (..),
    GuiControlProperty (..),
    GuiDefaultProperty (..),
    GuiToggleProperty (..),
    GuiSliderProperty (..),
    GuiProgressBarProperty (..),
    GuiScrollBarProperty (..),
    GuiCheckBoxProperty (..),
    GuiComboBoxProperty (..),
    GuiDropdownBoxProperty (..),
    GuiTextBoxProperty (..),
    GuiSpinnerProperty (..),
    GuiListViewProperty (..),
    GuiColorPickerProperty (..),
    GuiIconName (..),

    -- * Structures
    GuiStyleProp (..),

    -- * Pointer utilities
    p'guiStyleProp'controlId,
    p'guiStyleProp'propertyId,
    p'guiStyleProp'propertyValue,
  )
where

import Foreign
  ( Ptr,
    Storable (alignment, peek, poke, sizeOf),
    Word16,
    castPtr,
    plusPtr,
  )
import Foreign.C
  ( CInt (..),
    CUShort,
  )
import Raylib.Internal.Foreign (Freeable)

---------------------------------------
-- raygui enums -----------------------
---------------------------------------

-- | Gui control state
data GuiState
  = StateNormal
  | StateFocused
  | StatePressed
  | StateDisabled
  deriving (GuiState -> GuiState -> Bool
(GuiState -> GuiState -> Bool)
-> (GuiState -> GuiState -> Bool) -> Eq GuiState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiState -> GuiState -> Bool
== :: GuiState -> GuiState -> Bool
$c/= :: GuiState -> GuiState -> Bool
/= :: GuiState -> GuiState -> Bool
Eq, Int -> GuiState -> ShowS
[GuiState] -> ShowS
GuiState -> String
(Int -> GuiState -> ShowS)
-> (GuiState -> String) -> ([GuiState] -> ShowS) -> Show GuiState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiState -> ShowS
showsPrec :: Int -> GuiState -> ShowS
$cshow :: GuiState -> String
show :: GuiState -> String
$cshowList :: [GuiState] -> ShowS
showList :: [GuiState] -> ShowS
Show)

instance Enum GuiState where
  fromEnum :: GuiState -> Int
fromEnum GuiState
x = case GuiState
x of
    GuiState
StateNormal -> Int
0
    GuiState
StateFocused -> Int
1
    GuiState
StatePressed -> Int
2
    GuiState
StateDisabled -> Int
3
  toEnum :: Int -> GuiState
toEnum Int
x = case Int
x of
    Int
0 -> GuiState
StateNormal
    Int
1 -> GuiState
StateFocused
    Int
2 -> GuiState
StatePressed
    Int
3 -> GuiState
StateDisabled
    Int
n -> String -> GuiState
forall a. HasCallStack => String -> a
error (String -> GuiState) -> String -> GuiState
forall a b. (a -> b) -> a -> b
$ String
"(GuiState.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiState where
  sizeOf :: GuiState -> Int
sizeOf GuiState
_ = Int
4
  alignment :: GuiState -> Int
alignment GuiState
_ = Int
4
  peek :: Ptr GuiState -> IO GuiState
peek Ptr GuiState
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiState -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiState
ptr)
    GuiState -> IO GuiState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiState -> IO GuiState) -> GuiState -> IO GuiState
forall a b. (a -> b) -> a -> b
$ Int -> GuiState
forall a. Enum a => Int -> a
toEnum (Int -> GuiState) -> Int -> GuiState
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiState -> GuiState -> IO ()
poke Ptr GuiState
ptr GuiState
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiState -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiState
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiState -> Int
forall a. Enum a => a -> Int
fromEnum GuiState
v) :: CInt)

-- | Gui control text alignment
data GuiTextAlignment
  = TextAlignLeft
  | TextAlignCenter
  | TextAlignRight
  deriving (GuiTextAlignment -> GuiTextAlignment -> Bool
(GuiTextAlignment -> GuiTextAlignment -> Bool)
-> (GuiTextAlignment -> GuiTextAlignment -> Bool)
-> Eq GuiTextAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiTextAlignment -> GuiTextAlignment -> Bool
== :: GuiTextAlignment -> GuiTextAlignment -> Bool
$c/= :: GuiTextAlignment -> GuiTextAlignment -> Bool
/= :: GuiTextAlignment -> GuiTextAlignment -> Bool
Eq, Int -> GuiTextAlignment -> ShowS
[GuiTextAlignment] -> ShowS
GuiTextAlignment -> String
(Int -> GuiTextAlignment -> ShowS)
-> (GuiTextAlignment -> String)
-> ([GuiTextAlignment] -> ShowS)
-> Show GuiTextAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiTextAlignment -> ShowS
showsPrec :: Int -> GuiTextAlignment -> ShowS
$cshow :: GuiTextAlignment -> String
show :: GuiTextAlignment -> String
$cshowList :: [GuiTextAlignment] -> ShowS
showList :: [GuiTextAlignment] -> ShowS
Show)

instance Enum GuiTextAlignment where
  fromEnum :: GuiTextAlignment -> Int
fromEnum GuiTextAlignment
x = case GuiTextAlignment
x of
    GuiTextAlignment
TextAlignLeft -> Int
0
    GuiTextAlignment
TextAlignCenter -> Int
1
    GuiTextAlignment
TextAlignRight -> Int
2
  toEnum :: Int -> GuiTextAlignment
toEnum Int
x = case Int
x of
    Int
0 -> GuiTextAlignment
TextAlignLeft
    Int
1 -> GuiTextAlignment
TextAlignCenter
    Int
2 -> GuiTextAlignment
TextAlignRight
    Int
n -> String -> GuiTextAlignment
forall a. HasCallStack => String -> a
error (String -> GuiTextAlignment) -> String -> GuiTextAlignment
forall a b. (a -> b) -> a -> b
$ String
"(GuiTextAlignment.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiTextAlignment where
  sizeOf :: GuiTextAlignment -> Int
sizeOf GuiTextAlignment
_ = Int
4
  alignment :: GuiTextAlignment -> Int
alignment GuiTextAlignment
_ = Int
4
  peek :: Ptr GuiTextAlignment -> IO GuiTextAlignment
peek Ptr GuiTextAlignment
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiTextAlignment -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextAlignment
ptr)
    GuiTextAlignment -> IO GuiTextAlignment
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiTextAlignment -> IO GuiTextAlignment)
-> GuiTextAlignment -> IO GuiTextAlignment
forall a b. (a -> b) -> a -> b
$ Int -> GuiTextAlignment
forall a. Enum a => Int -> a
toEnum (Int -> GuiTextAlignment) -> Int -> GuiTextAlignment
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiTextAlignment -> GuiTextAlignment -> IO ()
poke Ptr GuiTextAlignment
ptr GuiTextAlignment
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiTextAlignment -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextAlignment
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiTextAlignment -> Int
forall a. Enum a => a -> Int
fromEnum GuiTextAlignment
v) :: CInt)

-- | Gui control text alignment vertical
data GuiTextAlignmentVertical
  = TextAlignTop
  | TextAlignMiddle
  | TextAlignBottom
  deriving (GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool
(GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool)
-> (GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool)
-> Eq GuiTextAlignmentVertical
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool
== :: GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool
$c/= :: GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool
/= :: GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> Bool
Eq, Int -> GuiTextAlignmentVertical -> ShowS
[GuiTextAlignmentVertical] -> ShowS
GuiTextAlignmentVertical -> String
(Int -> GuiTextAlignmentVertical -> ShowS)
-> (GuiTextAlignmentVertical -> String)
-> ([GuiTextAlignmentVertical] -> ShowS)
-> Show GuiTextAlignmentVertical
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiTextAlignmentVertical -> ShowS
showsPrec :: Int -> GuiTextAlignmentVertical -> ShowS
$cshow :: GuiTextAlignmentVertical -> String
show :: GuiTextAlignmentVertical -> String
$cshowList :: [GuiTextAlignmentVertical] -> ShowS
showList :: [GuiTextAlignmentVertical] -> ShowS
Show)

instance Enum GuiTextAlignmentVertical where
  fromEnum :: GuiTextAlignmentVertical -> Int
fromEnum GuiTextAlignmentVertical
x = case GuiTextAlignmentVertical
x of
    GuiTextAlignmentVertical
TextAlignTop -> Int
0
    GuiTextAlignmentVertical
TextAlignMiddle -> Int
1
    GuiTextAlignmentVertical
TextAlignBottom -> Int
2
  toEnum :: Int -> GuiTextAlignmentVertical
toEnum Int
x = case Int
x of
    Int
0 -> GuiTextAlignmentVertical
TextAlignTop
    Int
1 -> GuiTextAlignmentVertical
TextAlignMiddle
    Int
2 -> GuiTextAlignmentVertical
TextAlignBottom
    Int
n -> String -> GuiTextAlignmentVertical
forall a. HasCallStack => String -> a
error (String -> GuiTextAlignmentVertical)
-> String -> GuiTextAlignmentVertical
forall a b. (a -> b) -> a -> b
$ String
"(GuiTextAlignmentVertical.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiTextAlignmentVertical where
  sizeOf :: GuiTextAlignmentVertical -> Int
sizeOf GuiTextAlignmentVertical
_ = Int
4
  alignment :: GuiTextAlignmentVertical -> Int
alignment GuiTextAlignmentVertical
_ = Int
4
  peek :: Ptr GuiTextAlignmentVertical -> IO GuiTextAlignmentVertical
peek Ptr GuiTextAlignmentVertical
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiTextAlignmentVertical -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextAlignmentVertical
ptr)
    GuiTextAlignmentVertical -> IO GuiTextAlignmentVertical
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiTextAlignmentVertical -> IO GuiTextAlignmentVertical)
-> GuiTextAlignmentVertical -> IO GuiTextAlignmentVertical
forall a b. (a -> b) -> a -> b
$ Int -> GuiTextAlignmentVertical
forall a. Enum a => Int -> a
toEnum (Int -> GuiTextAlignmentVertical)
-> Int -> GuiTextAlignmentVertical
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiTextAlignmentVertical -> GuiTextAlignmentVertical -> IO ()
poke Ptr GuiTextAlignmentVertical
ptr GuiTextAlignmentVertical
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiTextAlignmentVertical -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextAlignmentVertical
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiTextAlignmentVertical -> Int
forall a. Enum a => a -> Int
fromEnum GuiTextAlignmentVertical
v) :: CInt)

-- | Gui control text wrap mode
data GuiTextWrapMode
  = TextWrapNone
  | TextWrapChar
  | TextWrapWord
  deriving (GuiTextWrapMode -> GuiTextWrapMode -> Bool
(GuiTextWrapMode -> GuiTextWrapMode -> Bool)
-> (GuiTextWrapMode -> GuiTextWrapMode -> Bool)
-> Eq GuiTextWrapMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiTextWrapMode -> GuiTextWrapMode -> Bool
== :: GuiTextWrapMode -> GuiTextWrapMode -> Bool
$c/= :: GuiTextWrapMode -> GuiTextWrapMode -> Bool
/= :: GuiTextWrapMode -> GuiTextWrapMode -> Bool
Eq, Int -> GuiTextWrapMode -> ShowS
[GuiTextWrapMode] -> ShowS
GuiTextWrapMode -> String
(Int -> GuiTextWrapMode -> ShowS)
-> (GuiTextWrapMode -> String)
-> ([GuiTextWrapMode] -> ShowS)
-> Show GuiTextWrapMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiTextWrapMode -> ShowS
showsPrec :: Int -> GuiTextWrapMode -> ShowS
$cshow :: GuiTextWrapMode -> String
show :: GuiTextWrapMode -> String
$cshowList :: [GuiTextWrapMode] -> ShowS
showList :: [GuiTextWrapMode] -> ShowS
Show)

instance Enum GuiTextWrapMode where
  fromEnum :: GuiTextWrapMode -> Int
fromEnum GuiTextWrapMode
x = case GuiTextWrapMode
x of
    GuiTextWrapMode
TextWrapNone -> Int
0
    GuiTextWrapMode
TextWrapChar -> Int
1
    GuiTextWrapMode
TextWrapWord -> Int
2
  toEnum :: Int -> GuiTextWrapMode
toEnum Int
x = case Int
x of
    Int
0 -> GuiTextWrapMode
TextWrapNone
    Int
1 -> GuiTextWrapMode
TextWrapChar
    Int
2 -> GuiTextWrapMode
TextWrapWord
    Int
n -> String -> GuiTextWrapMode
forall a. HasCallStack => String -> a
error (String -> GuiTextWrapMode) -> String -> GuiTextWrapMode
forall a b. (a -> b) -> a -> b
$ String
"(GuiTextWrapMode.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiTextWrapMode where
  sizeOf :: GuiTextWrapMode -> Int
sizeOf GuiTextWrapMode
_ = Int
4
  alignment :: GuiTextWrapMode -> Int
alignment GuiTextWrapMode
_ = Int
4
  peek :: Ptr GuiTextWrapMode -> IO GuiTextWrapMode
peek Ptr GuiTextWrapMode
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiTextWrapMode -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextWrapMode
ptr)
    GuiTextWrapMode -> IO GuiTextWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiTextWrapMode -> IO GuiTextWrapMode)
-> GuiTextWrapMode -> IO GuiTextWrapMode
forall a b. (a -> b) -> a -> b
$ Int -> GuiTextWrapMode
forall a. Enum a => Int -> a
toEnum (Int -> GuiTextWrapMode) -> Int -> GuiTextWrapMode
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiTextWrapMode -> GuiTextWrapMode -> IO ()
poke Ptr GuiTextWrapMode
ptr GuiTextWrapMode
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiTextWrapMode -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextWrapMode
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiTextWrapMode -> Int
forall a. Enum a => a -> Int
fromEnum GuiTextWrapMode
v) :: CInt)

-- | Gui controls
data GuiControl
  = Default
  | -- | Used also for: LABELBUTTON
    Label
  | Button
  | -- | Used also for: TOGGLEGROUP
    Toggle
  | -- | Used also for: SLIDERBAR, TOGGLESLIDER
    Slider
  | Progressbar
  | Checkbox
  | Combobox
  | Dropdownbox
  | -- | Used also for: TEXTBOXMULTI
    Textbox
  | Valuebox
  | -- | Uses: BUTTON, VALUEBOX
    Spinner
  | Listview
  | Colorpicker
  | Scrollbar
  | Statusbar
  deriving (GuiControl -> GuiControl -> Bool
(GuiControl -> GuiControl -> Bool)
-> (GuiControl -> GuiControl -> Bool) -> Eq GuiControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiControl -> GuiControl -> Bool
== :: GuiControl -> GuiControl -> Bool
$c/= :: GuiControl -> GuiControl -> Bool
/= :: GuiControl -> GuiControl -> Bool
Eq, Int -> GuiControl -> ShowS
[GuiControl] -> ShowS
GuiControl -> String
(Int -> GuiControl -> ShowS)
-> (GuiControl -> String)
-> ([GuiControl] -> ShowS)
-> Show GuiControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiControl -> ShowS
showsPrec :: Int -> GuiControl -> ShowS
$cshow :: GuiControl -> String
show :: GuiControl -> String
$cshowList :: [GuiControl] -> ShowS
showList :: [GuiControl] -> ShowS
Show)

instance Enum GuiControl where
  fromEnum :: GuiControl -> Int
fromEnum GuiControl
x = case GuiControl
x of
    GuiControl
Default -> Int
0
    GuiControl
Label -> Int
1
    GuiControl
Button -> Int
2
    GuiControl
Toggle -> Int
3
    GuiControl
Slider -> Int
4
    GuiControl
Progressbar -> Int
5
    GuiControl
Checkbox -> Int
6
    GuiControl
Combobox -> Int
7
    GuiControl
Dropdownbox -> Int
8
    GuiControl
Textbox -> Int
9
    GuiControl
Valuebox -> Int
10
    GuiControl
Spinner -> Int
11
    GuiControl
Listview -> Int
12
    GuiControl
Colorpicker -> Int
13
    GuiControl
Scrollbar -> Int
14
    GuiControl
Statusbar -> Int
15
  toEnum :: Int -> GuiControl
toEnum Int
x = case Int
x of
    Int
0 -> GuiControl
Default
    Int
1 -> GuiControl
Label
    Int
2 -> GuiControl
Button
    Int
3 -> GuiControl
Toggle
    Int
4 -> GuiControl
Slider
    Int
5 -> GuiControl
Progressbar
    Int
6 -> GuiControl
Checkbox
    Int
7 -> GuiControl
Combobox
    Int
8 -> GuiControl
Dropdownbox
    Int
9 -> GuiControl
Textbox
    Int
10 -> GuiControl
Valuebox
    Int
11 -> GuiControl
Spinner
    Int
12 -> GuiControl
Listview
    Int
13 -> GuiControl
Colorpicker
    Int
14 -> GuiControl
Scrollbar
    Int
15 -> GuiControl
Statusbar
    Int
n -> String -> GuiControl
forall a. HasCallStack => String -> a
error (String -> GuiControl) -> String -> GuiControl
forall a b. (a -> b) -> a -> b
$ String
"(GuiControl.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiControl where
  sizeOf :: GuiControl -> Int
sizeOf GuiControl
_ = Int
4
  alignment :: GuiControl -> Int
alignment GuiControl
_ = Int
4
  peek :: Ptr GuiControl -> IO GuiControl
peek Ptr GuiControl
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiControl -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiControl
ptr)
    GuiControl -> IO GuiControl
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiControl -> IO GuiControl) -> GuiControl -> IO GuiControl
forall a b. (a -> b) -> a -> b
$ Int -> GuiControl
forall a. Enum a => Int -> a
toEnum (Int -> GuiControl) -> Int -> GuiControl
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiControl -> GuiControl -> IO ()
poke Ptr GuiControl
ptr GuiControl
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiControl -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiControl
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiControl -> Int
forall a. Enum a => a -> Int
fromEnum GuiControl
v) :: CInt)

-- | Gui base properties for every control
data GuiControlProperty
  = -- | Control border color in STATE_NORMAL
    BorderColorNormal
  | -- | Control base color in STATE_NORMAL
    BaseColorNormal
  | -- | Control text color in STATE_NORMAL
    TextColorNormal
  | -- | Control border color in STATE_FOCUSED
    BorderColorFocused
  | -- | Control base color in STATE_FOCUSED
    BaseColorFocused
  | -- | Control text color in STATE_FOCUSED
    TextColorFocused
  | -- | Control border color in STATE_PRESSED
    BorderColorPressed
  | -- | Control base color in STATE_PRESSED
    BaseColorPressed
  | -- | Control text color in STATE_PRESSED
    TextColorPressed
  | -- | Control border color in STATE_DISABLED
    BorderColorDisabled
  | -- | Control base color in STATE_DISABLED
    BaseColorDisabled
  | -- | Control text color in STATE_DISABLED
    TextColorDisabled
  | -- | Control border size, 0 for no border
    BorderWidth
  | -- | Control text padding, not considering border
    TextPadding
  | -- | Control text horizontal alignment inside control text bound (after border and padding)
    TextAlignment
  deriving (GuiControlProperty -> GuiControlProperty -> Bool
(GuiControlProperty -> GuiControlProperty -> Bool)
-> (GuiControlProperty -> GuiControlProperty -> Bool)
-> Eq GuiControlProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiControlProperty -> GuiControlProperty -> Bool
== :: GuiControlProperty -> GuiControlProperty -> Bool
$c/= :: GuiControlProperty -> GuiControlProperty -> Bool
/= :: GuiControlProperty -> GuiControlProperty -> Bool
Eq, Int -> GuiControlProperty -> ShowS
[GuiControlProperty] -> ShowS
GuiControlProperty -> String
(Int -> GuiControlProperty -> ShowS)
-> (GuiControlProperty -> String)
-> ([GuiControlProperty] -> ShowS)
-> Show GuiControlProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiControlProperty -> ShowS
showsPrec :: Int -> GuiControlProperty -> ShowS
$cshow :: GuiControlProperty -> String
show :: GuiControlProperty -> String
$cshowList :: [GuiControlProperty] -> ShowS
showList :: [GuiControlProperty] -> ShowS
Show)

instance Enum GuiControlProperty where
  fromEnum :: GuiControlProperty -> Int
fromEnum GuiControlProperty
x = case GuiControlProperty
x of
    GuiControlProperty
BorderColorNormal -> Int
0
    GuiControlProperty
BaseColorNormal -> Int
1
    GuiControlProperty
TextColorNormal -> Int
2
    GuiControlProperty
BorderColorFocused -> Int
3
    GuiControlProperty
BaseColorFocused -> Int
4
    GuiControlProperty
TextColorFocused -> Int
5
    GuiControlProperty
BorderColorPressed -> Int
6
    GuiControlProperty
BaseColorPressed -> Int
7
    GuiControlProperty
TextColorPressed -> Int
8
    GuiControlProperty
BorderColorDisabled -> Int
9
    GuiControlProperty
BaseColorDisabled -> Int
10
    GuiControlProperty
TextColorDisabled -> Int
11
    GuiControlProperty
BorderWidth -> Int
12
    GuiControlProperty
TextPadding -> Int
13
    GuiControlProperty
TextAlignment -> Int
14
  toEnum :: Int -> GuiControlProperty
toEnum Int
x = case Int
x of
    Int
0 -> GuiControlProperty
BorderColorNormal
    Int
1 -> GuiControlProperty
BaseColorNormal
    Int
2 -> GuiControlProperty
TextColorNormal
    Int
3 -> GuiControlProperty
BorderColorFocused
    Int
4 -> GuiControlProperty
BaseColorFocused
    Int
5 -> GuiControlProperty
TextColorFocused
    Int
6 -> GuiControlProperty
BorderColorPressed
    Int
7 -> GuiControlProperty
BaseColorPressed
    Int
8 -> GuiControlProperty
TextColorPressed
    Int
9 -> GuiControlProperty
BorderColorDisabled
    Int
10 -> GuiControlProperty
BaseColorDisabled
    Int
11 -> GuiControlProperty
TextColorDisabled
    Int
12 -> GuiControlProperty
BorderWidth
    Int
13 -> GuiControlProperty
TextPadding
    Int
14 -> GuiControlProperty
TextAlignment
    Int
n -> String -> GuiControlProperty
forall a. HasCallStack => String -> a
error (String -> GuiControlProperty) -> String -> GuiControlProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiControlProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiControlProperty where
  sizeOf :: GuiControlProperty -> Int
sizeOf GuiControlProperty
_ = Int
4
  alignment :: GuiControlProperty -> Int
alignment GuiControlProperty
_ = Int
4
  peek :: Ptr GuiControlProperty -> IO GuiControlProperty
peek Ptr GuiControlProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiControlProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiControlProperty
ptr)
    GuiControlProperty -> IO GuiControlProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiControlProperty -> IO GuiControlProperty)
-> GuiControlProperty -> IO GuiControlProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiControlProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiControlProperty) -> Int -> GuiControlProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiControlProperty -> GuiControlProperty -> IO ()
poke Ptr GuiControlProperty
ptr GuiControlProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiControlProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiControlProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiControlProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiControlProperty
v) :: CInt)

-- | DEFAULT extended properties
data GuiDefaultProperty
  = -- | Text size (glyphs max height)
    TextSize
  | -- | Text spacing between glyphs
    TextSpacing
  | -- | Line control color
    LineColor
  | -- | Background color
    BackgroundColor
  | -- | Text spacing between lines
    TextLineSpacing
  | -- | Text vertical alignment inside text bounds (after border and padding)
    TextAlignmentVertical
  | -- | Text wrap-mode inside text bounds
    TextWrapMode
  deriving (GuiDefaultProperty -> GuiDefaultProperty -> Bool
(GuiDefaultProperty -> GuiDefaultProperty -> Bool)
-> (GuiDefaultProperty -> GuiDefaultProperty -> Bool)
-> Eq GuiDefaultProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiDefaultProperty -> GuiDefaultProperty -> Bool
== :: GuiDefaultProperty -> GuiDefaultProperty -> Bool
$c/= :: GuiDefaultProperty -> GuiDefaultProperty -> Bool
/= :: GuiDefaultProperty -> GuiDefaultProperty -> Bool
Eq, Int -> GuiDefaultProperty -> ShowS
[GuiDefaultProperty] -> ShowS
GuiDefaultProperty -> String
(Int -> GuiDefaultProperty -> ShowS)
-> (GuiDefaultProperty -> String)
-> ([GuiDefaultProperty] -> ShowS)
-> Show GuiDefaultProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiDefaultProperty -> ShowS
showsPrec :: Int -> GuiDefaultProperty -> ShowS
$cshow :: GuiDefaultProperty -> String
show :: GuiDefaultProperty -> String
$cshowList :: [GuiDefaultProperty] -> ShowS
showList :: [GuiDefaultProperty] -> ShowS
Show)

instance Enum GuiDefaultProperty where
  fromEnum :: GuiDefaultProperty -> Int
fromEnum GuiDefaultProperty
x = case GuiDefaultProperty
x of
    GuiDefaultProperty
TextSize -> Int
16
    GuiDefaultProperty
TextSpacing -> Int
17
    GuiDefaultProperty
LineColor -> Int
18
    GuiDefaultProperty
BackgroundColor -> Int
19
    GuiDefaultProperty
TextLineSpacing -> Int
20
    GuiDefaultProperty
TextAlignmentVertical -> Int
21
    GuiDefaultProperty
TextWrapMode -> Int
22
  toEnum :: Int -> GuiDefaultProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiDefaultProperty
TextSize
    Int
17 -> GuiDefaultProperty
TextSpacing
    Int
18 -> GuiDefaultProperty
LineColor
    Int
19 -> GuiDefaultProperty
BackgroundColor
    Int
20 -> GuiDefaultProperty
TextLineSpacing
    Int
21 -> GuiDefaultProperty
TextAlignmentVertical
    Int
22 -> GuiDefaultProperty
TextWrapMode
    Int
n -> String -> GuiDefaultProperty
forall a. HasCallStack => String -> a
error (String -> GuiDefaultProperty) -> String -> GuiDefaultProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiDefaultProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiDefaultProperty where
  sizeOf :: GuiDefaultProperty -> Int
sizeOf GuiDefaultProperty
_ = Int
4
  alignment :: GuiDefaultProperty -> Int
alignment GuiDefaultProperty
_ = Int
4
  peek :: Ptr GuiDefaultProperty -> IO GuiDefaultProperty
peek Ptr GuiDefaultProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiDefaultProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiDefaultProperty
ptr)
    GuiDefaultProperty -> IO GuiDefaultProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiDefaultProperty -> IO GuiDefaultProperty)
-> GuiDefaultProperty -> IO GuiDefaultProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiDefaultProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiDefaultProperty) -> Int -> GuiDefaultProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiDefaultProperty -> GuiDefaultProperty -> IO ()
poke Ptr GuiDefaultProperty
ptr GuiDefaultProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiDefaultProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiDefaultProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiDefaultProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiDefaultProperty
v) :: CInt)

-- | Toggle/ToggleGroup
data GuiToggleProperty
  = -- | ToggleGroup separation between toggles
    GroupPadding
  deriving (GuiToggleProperty -> GuiToggleProperty -> Bool
(GuiToggleProperty -> GuiToggleProperty -> Bool)
-> (GuiToggleProperty -> GuiToggleProperty -> Bool)
-> Eq GuiToggleProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiToggleProperty -> GuiToggleProperty -> Bool
== :: GuiToggleProperty -> GuiToggleProperty -> Bool
$c/= :: GuiToggleProperty -> GuiToggleProperty -> Bool
/= :: GuiToggleProperty -> GuiToggleProperty -> Bool
Eq, Int -> GuiToggleProperty -> ShowS
[GuiToggleProperty] -> ShowS
GuiToggleProperty -> String
(Int -> GuiToggleProperty -> ShowS)
-> (GuiToggleProperty -> String)
-> ([GuiToggleProperty] -> ShowS)
-> Show GuiToggleProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiToggleProperty -> ShowS
showsPrec :: Int -> GuiToggleProperty -> ShowS
$cshow :: GuiToggleProperty -> String
show :: GuiToggleProperty -> String
$cshowList :: [GuiToggleProperty] -> ShowS
showList :: [GuiToggleProperty] -> ShowS
Show)

instance Enum GuiToggleProperty where
  fromEnum :: GuiToggleProperty -> Int
fromEnum GuiToggleProperty
x = case GuiToggleProperty
x of
    GuiToggleProperty
GroupPadding -> Int
16
  toEnum :: Int -> GuiToggleProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiToggleProperty
GroupPadding
    Int
n -> String -> GuiToggleProperty
forall a. HasCallStack => String -> a
error (String -> GuiToggleProperty) -> String -> GuiToggleProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiToggleProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiToggleProperty where
  sizeOf :: GuiToggleProperty -> Int
sizeOf GuiToggleProperty
_ = Int
4
  alignment :: GuiToggleProperty -> Int
alignment GuiToggleProperty
_ = Int
4
  peek :: Ptr GuiToggleProperty -> IO GuiToggleProperty
peek Ptr GuiToggleProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiToggleProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiToggleProperty
ptr)
    GuiToggleProperty -> IO GuiToggleProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiToggleProperty -> IO GuiToggleProperty)
-> GuiToggleProperty -> IO GuiToggleProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiToggleProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiToggleProperty) -> Int -> GuiToggleProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiToggleProperty -> GuiToggleProperty -> IO ()
poke Ptr GuiToggleProperty
ptr GuiToggleProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiToggleProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiToggleProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiToggleProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiToggleProperty
v) :: CInt)

-- | Slider/SliderBar
data GuiSliderProperty
  = -- | Slider size of internal bar
    SliderWidth
  | -- | Slider/SliderBar internal bar padding
    SliderPadding
  deriving (GuiSliderProperty -> GuiSliderProperty -> Bool
(GuiSliderProperty -> GuiSliderProperty -> Bool)
-> (GuiSliderProperty -> GuiSliderProperty -> Bool)
-> Eq GuiSliderProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiSliderProperty -> GuiSliderProperty -> Bool
== :: GuiSliderProperty -> GuiSliderProperty -> Bool
$c/= :: GuiSliderProperty -> GuiSliderProperty -> Bool
/= :: GuiSliderProperty -> GuiSliderProperty -> Bool
Eq, Int -> GuiSliderProperty -> ShowS
[GuiSliderProperty] -> ShowS
GuiSliderProperty -> String
(Int -> GuiSliderProperty -> ShowS)
-> (GuiSliderProperty -> String)
-> ([GuiSliderProperty] -> ShowS)
-> Show GuiSliderProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiSliderProperty -> ShowS
showsPrec :: Int -> GuiSliderProperty -> ShowS
$cshow :: GuiSliderProperty -> String
show :: GuiSliderProperty -> String
$cshowList :: [GuiSliderProperty] -> ShowS
showList :: [GuiSliderProperty] -> ShowS
Show)

instance Enum GuiSliderProperty where
  fromEnum :: GuiSliderProperty -> Int
fromEnum GuiSliderProperty
x = case GuiSliderProperty
x of
    GuiSliderProperty
SliderWidth -> Int
16
    GuiSliderProperty
SliderPadding -> Int
17
  toEnum :: Int -> GuiSliderProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiSliderProperty
SliderWidth
    Int
17 -> GuiSliderProperty
SliderPadding
    Int
n -> String -> GuiSliderProperty
forall a. HasCallStack => String -> a
error (String -> GuiSliderProperty) -> String -> GuiSliderProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiSliderProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiSliderProperty where
  sizeOf :: GuiSliderProperty -> Int
sizeOf GuiSliderProperty
_ = Int
4
  alignment :: GuiSliderProperty -> Int
alignment GuiSliderProperty
_ = Int
4
  peek :: Ptr GuiSliderProperty -> IO GuiSliderProperty
peek Ptr GuiSliderProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiSliderProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiSliderProperty
ptr)
    GuiSliderProperty -> IO GuiSliderProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiSliderProperty -> IO GuiSliderProperty)
-> GuiSliderProperty -> IO GuiSliderProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiSliderProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiSliderProperty) -> Int -> GuiSliderProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiSliderProperty -> GuiSliderProperty -> IO ()
poke Ptr GuiSliderProperty
ptr GuiSliderProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiSliderProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiSliderProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiSliderProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiSliderProperty
v) :: CInt)

-- | ProgressBar
data GuiProgressBarProperty
  = -- | ProgressBar internal padding
    ProgressPadding
  deriving (GuiProgressBarProperty -> GuiProgressBarProperty -> Bool
(GuiProgressBarProperty -> GuiProgressBarProperty -> Bool)
-> (GuiProgressBarProperty -> GuiProgressBarProperty -> Bool)
-> Eq GuiProgressBarProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiProgressBarProperty -> GuiProgressBarProperty -> Bool
== :: GuiProgressBarProperty -> GuiProgressBarProperty -> Bool
$c/= :: GuiProgressBarProperty -> GuiProgressBarProperty -> Bool
/= :: GuiProgressBarProperty -> GuiProgressBarProperty -> Bool
Eq, Int -> GuiProgressBarProperty -> ShowS
[GuiProgressBarProperty] -> ShowS
GuiProgressBarProperty -> String
(Int -> GuiProgressBarProperty -> ShowS)
-> (GuiProgressBarProperty -> String)
-> ([GuiProgressBarProperty] -> ShowS)
-> Show GuiProgressBarProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiProgressBarProperty -> ShowS
showsPrec :: Int -> GuiProgressBarProperty -> ShowS
$cshow :: GuiProgressBarProperty -> String
show :: GuiProgressBarProperty -> String
$cshowList :: [GuiProgressBarProperty] -> ShowS
showList :: [GuiProgressBarProperty] -> ShowS
Show)

instance Enum GuiProgressBarProperty where
  fromEnum :: GuiProgressBarProperty -> Int
fromEnum GuiProgressBarProperty
x = case GuiProgressBarProperty
x of
    GuiProgressBarProperty
ProgressPadding -> Int
16
  toEnum :: Int -> GuiProgressBarProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiProgressBarProperty
ProgressPadding
    Int
n -> String -> GuiProgressBarProperty
forall a. HasCallStack => String -> a
error (String -> GuiProgressBarProperty)
-> String -> GuiProgressBarProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiProgressBarProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiProgressBarProperty where
  sizeOf :: GuiProgressBarProperty -> Int
sizeOf GuiProgressBarProperty
_ = Int
4
  alignment :: GuiProgressBarProperty -> Int
alignment GuiProgressBarProperty
_ = Int
4
  peek :: Ptr GuiProgressBarProperty -> IO GuiProgressBarProperty
peek Ptr GuiProgressBarProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiProgressBarProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiProgressBarProperty
ptr)
    GuiProgressBarProperty -> IO GuiProgressBarProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiProgressBarProperty -> IO GuiProgressBarProperty)
-> GuiProgressBarProperty -> IO GuiProgressBarProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiProgressBarProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiProgressBarProperty) -> Int -> GuiProgressBarProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiProgressBarProperty -> GuiProgressBarProperty -> IO ()
poke Ptr GuiProgressBarProperty
ptr GuiProgressBarProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiProgressBarProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiProgressBarProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiProgressBarProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiProgressBarProperty
v) :: CInt)

-- | ScrollBar
data GuiScrollBarProperty
  = -- | ScrollBar arrows size
    ArrowsSize
  | -- | ScrollBar arrows visible
    ArrowsVisible
  | -- | ScrollBar slider internal padding
    ScrollSliderPadding
  | -- | ScrollBar slider size
    ScrollSliderSize
  | -- | ScrollBar scroll padding from arrows
    ScrollPadding
  | -- | ScrollBar scrolling speed
    ScrollSpeed
  deriving (GuiScrollBarProperty -> GuiScrollBarProperty -> Bool
(GuiScrollBarProperty -> GuiScrollBarProperty -> Bool)
-> (GuiScrollBarProperty -> GuiScrollBarProperty -> Bool)
-> Eq GuiScrollBarProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiScrollBarProperty -> GuiScrollBarProperty -> Bool
== :: GuiScrollBarProperty -> GuiScrollBarProperty -> Bool
$c/= :: GuiScrollBarProperty -> GuiScrollBarProperty -> Bool
/= :: GuiScrollBarProperty -> GuiScrollBarProperty -> Bool
Eq, Int -> GuiScrollBarProperty -> ShowS
[GuiScrollBarProperty] -> ShowS
GuiScrollBarProperty -> String
(Int -> GuiScrollBarProperty -> ShowS)
-> (GuiScrollBarProperty -> String)
-> ([GuiScrollBarProperty] -> ShowS)
-> Show GuiScrollBarProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiScrollBarProperty -> ShowS
showsPrec :: Int -> GuiScrollBarProperty -> ShowS
$cshow :: GuiScrollBarProperty -> String
show :: GuiScrollBarProperty -> String
$cshowList :: [GuiScrollBarProperty] -> ShowS
showList :: [GuiScrollBarProperty] -> ShowS
Show)

instance Enum GuiScrollBarProperty where
  fromEnum :: GuiScrollBarProperty -> Int
fromEnum GuiScrollBarProperty
x = case GuiScrollBarProperty
x of
    GuiScrollBarProperty
ArrowsSize -> Int
16
    GuiScrollBarProperty
ArrowsVisible -> Int
17
    GuiScrollBarProperty
ScrollSliderPadding -> Int
18
    GuiScrollBarProperty
ScrollSliderSize -> Int
19
    GuiScrollBarProperty
ScrollPadding -> Int
20
    GuiScrollBarProperty
ScrollSpeed -> Int
21
  toEnum :: Int -> GuiScrollBarProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiScrollBarProperty
ArrowsSize
    Int
17 -> GuiScrollBarProperty
ArrowsVisible
    Int
18 -> GuiScrollBarProperty
ScrollSliderPadding
    Int
19 -> GuiScrollBarProperty
ScrollSliderSize
    Int
20 -> GuiScrollBarProperty
ScrollPadding
    Int
21 -> GuiScrollBarProperty
ScrollSpeed
    Int
n -> String -> GuiScrollBarProperty
forall a. HasCallStack => String -> a
error (String -> GuiScrollBarProperty) -> String -> GuiScrollBarProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiScrollBarProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiScrollBarProperty where
  sizeOf :: GuiScrollBarProperty -> Int
sizeOf GuiScrollBarProperty
_ = Int
4
  alignment :: GuiScrollBarProperty -> Int
alignment GuiScrollBarProperty
_ = Int
4
  peek :: Ptr GuiScrollBarProperty -> IO GuiScrollBarProperty
peek Ptr GuiScrollBarProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiScrollBarProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiScrollBarProperty
ptr)
    GuiScrollBarProperty -> IO GuiScrollBarProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiScrollBarProperty -> IO GuiScrollBarProperty)
-> GuiScrollBarProperty -> IO GuiScrollBarProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiScrollBarProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiScrollBarProperty) -> Int -> GuiScrollBarProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiScrollBarProperty -> GuiScrollBarProperty -> IO ()
poke Ptr GuiScrollBarProperty
ptr GuiScrollBarProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiScrollBarProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiScrollBarProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiScrollBarProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiScrollBarProperty
v) :: CInt)

-- | CheckBox
data GuiCheckBoxProperty
  = -- | CheckBox internal check padding
    CheckPadding
  deriving (GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool
(GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool)
-> (GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool)
-> Eq GuiCheckBoxProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool
== :: GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool
$c/= :: GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool
/= :: GuiCheckBoxProperty -> GuiCheckBoxProperty -> Bool
Eq, Int -> GuiCheckBoxProperty -> ShowS
[GuiCheckBoxProperty] -> ShowS
GuiCheckBoxProperty -> String
(Int -> GuiCheckBoxProperty -> ShowS)
-> (GuiCheckBoxProperty -> String)
-> ([GuiCheckBoxProperty] -> ShowS)
-> Show GuiCheckBoxProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiCheckBoxProperty -> ShowS
showsPrec :: Int -> GuiCheckBoxProperty -> ShowS
$cshow :: GuiCheckBoxProperty -> String
show :: GuiCheckBoxProperty -> String
$cshowList :: [GuiCheckBoxProperty] -> ShowS
showList :: [GuiCheckBoxProperty] -> ShowS
Show)

instance Enum GuiCheckBoxProperty where
  fromEnum :: GuiCheckBoxProperty -> Int
fromEnum GuiCheckBoxProperty
x = case GuiCheckBoxProperty
x of
    GuiCheckBoxProperty
CheckPadding -> Int
16
  toEnum :: Int -> GuiCheckBoxProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiCheckBoxProperty
CheckPadding
    Int
n -> String -> GuiCheckBoxProperty
forall a. HasCallStack => String -> a
error (String -> GuiCheckBoxProperty) -> String -> GuiCheckBoxProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiCheckBoxProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiCheckBoxProperty where
  sizeOf :: GuiCheckBoxProperty -> Int
sizeOf GuiCheckBoxProperty
_ = Int
4
  alignment :: GuiCheckBoxProperty -> Int
alignment GuiCheckBoxProperty
_ = Int
4
  peek :: Ptr GuiCheckBoxProperty -> IO GuiCheckBoxProperty
peek Ptr GuiCheckBoxProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiCheckBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiCheckBoxProperty
ptr)
    GuiCheckBoxProperty -> IO GuiCheckBoxProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiCheckBoxProperty -> IO GuiCheckBoxProperty)
-> GuiCheckBoxProperty -> IO GuiCheckBoxProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiCheckBoxProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiCheckBoxProperty) -> Int -> GuiCheckBoxProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiCheckBoxProperty -> GuiCheckBoxProperty -> IO ()
poke Ptr GuiCheckBoxProperty
ptr GuiCheckBoxProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiCheckBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiCheckBoxProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiCheckBoxProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiCheckBoxProperty
v) :: CInt)

-- | ComboBox
data GuiComboBoxProperty
  = -- | ComboBox right button width
    ComboButtonWidth
  | -- | ComboBox button separation
    ComboButtonSpacing
  deriving (GuiComboBoxProperty -> GuiComboBoxProperty -> Bool
(GuiComboBoxProperty -> GuiComboBoxProperty -> Bool)
-> (GuiComboBoxProperty -> GuiComboBoxProperty -> Bool)
-> Eq GuiComboBoxProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiComboBoxProperty -> GuiComboBoxProperty -> Bool
== :: GuiComboBoxProperty -> GuiComboBoxProperty -> Bool
$c/= :: GuiComboBoxProperty -> GuiComboBoxProperty -> Bool
/= :: GuiComboBoxProperty -> GuiComboBoxProperty -> Bool
Eq, Int -> GuiComboBoxProperty -> ShowS
[GuiComboBoxProperty] -> ShowS
GuiComboBoxProperty -> String
(Int -> GuiComboBoxProperty -> ShowS)
-> (GuiComboBoxProperty -> String)
-> ([GuiComboBoxProperty] -> ShowS)
-> Show GuiComboBoxProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiComboBoxProperty -> ShowS
showsPrec :: Int -> GuiComboBoxProperty -> ShowS
$cshow :: GuiComboBoxProperty -> String
show :: GuiComboBoxProperty -> String
$cshowList :: [GuiComboBoxProperty] -> ShowS
showList :: [GuiComboBoxProperty] -> ShowS
Show)

instance Enum GuiComboBoxProperty where
  fromEnum :: GuiComboBoxProperty -> Int
fromEnum GuiComboBoxProperty
x = case GuiComboBoxProperty
x of
    GuiComboBoxProperty
ComboButtonWidth -> Int
16
    GuiComboBoxProperty
ComboButtonSpacing -> Int
17
  toEnum :: Int -> GuiComboBoxProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiComboBoxProperty
ComboButtonWidth
    Int
17 -> GuiComboBoxProperty
ComboButtonSpacing
    Int
n -> String -> GuiComboBoxProperty
forall a. HasCallStack => String -> a
error (String -> GuiComboBoxProperty) -> String -> GuiComboBoxProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiComboBoxProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiComboBoxProperty where
  sizeOf :: GuiComboBoxProperty -> Int
sizeOf GuiComboBoxProperty
_ = Int
4
  alignment :: GuiComboBoxProperty -> Int
alignment GuiComboBoxProperty
_ = Int
4
  peek :: Ptr GuiComboBoxProperty -> IO GuiComboBoxProperty
peek Ptr GuiComboBoxProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiComboBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiComboBoxProperty
ptr)
    GuiComboBoxProperty -> IO GuiComboBoxProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiComboBoxProperty -> IO GuiComboBoxProperty)
-> GuiComboBoxProperty -> IO GuiComboBoxProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiComboBoxProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiComboBoxProperty) -> Int -> GuiComboBoxProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiComboBoxProperty -> GuiComboBoxProperty -> IO ()
poke Ptr GuiComboBoxProperty
ptr GuiComboBoxProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiComboBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiComboBoxProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiComboBoxProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiComboBoxProperty
v) :: CInt)

-- | DropdownBox
data GuiDropdownBoxProperty
  = -- | DropdownBox arrow separation from border and items
    ArrowPadding
  | -- | DropdownBox items separation
    DropdownItemsSpacing
  deriving (GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool
(GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool)
-> (GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool)
-> Eq GuiDropdownBoxProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool
== :: GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool
$c/= :: GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool
/= :: GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> Bool
Eq, Int -> GuiDropdownBoxProperty -> ShowS
[GuiDropdownBoxProperty] -> ShowS
GuiDropdownBoxProperty -> String
(Int -> GuiDropdownBoxProperty -> ShowS)
-> (GuiDropdownBoxProperty -> String)
-> ([GuiDropdownBoxProperty] -> ShowS)
-> Show GuiDropdownBoxProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiDropdownBoxProperty -> ShowS
showsPrec :: Int -> GuiDropdownBoxProperty -> ShowS
$cshow :: GuiDropdownBoxProperty -> String
show :: GuiDropdownBoxProperty -> String
$cshowList :: [GuiDropdownBoxProperty] -> ShowS
showList :: [GuiDropdownBoxProperty] -> ShowS
Show)

instance Enum GuiDropdownBoxProperty where
  fromEnum :: GuiDropdownBoxProperty -> Int
fromEnum GuiDropdownBoxProperty
x = case GuiDropdownBoxProperty
x of
    GuiDropdownBoxProperty
ArrowPadding -> Int
16
    GuiDropdownBoxProperty
DropdownItemsSpacing -> Int
17
  toEnum :: Int -> GuiDropdownBoxProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiDropdownBoxProperty
ArrowPadding
    Int
17 -> GuiDropdownBoxProperty
DropdownItemsSpacing
    Int
n -> String -> GuiDropdownBoxProperty
forall a. HasCallStack => String -> a
error (String -> GuiDropdownBoxProperty)
-> String -> GuiDropdownBoxProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiDropdownBoxProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiDropdownBoxProperty where
  sizeOf :: GuiDropdownBoxProperty -> Int
sizeOf GuiDropdownBoxProperty
_ = Int
4
  alignment :: GuiDropdownBoxProperty -> Int
alignment GuiDropdownBoxProperty
_ = Int
4
  peek :: Ptr GuiDropdownBoxProperty -> IO GuiDropdownBoxProperty
peek Ptr GuiDropdownBoxProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiDropdownBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiDropdownBoxProperty
ptr)
    GuiDropdownBoxProperty -> IO GuiDropdownBoxProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiDropdownBoxProperty -> IO GuiDropdownBoxProperty)
-> GuiDropdownBoxProperty -> IO GuiDropdownBoxProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiDropdownBoxProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiDropdownBoxProperty) -> Int -> GuiDropdownBoxProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiDropdownBoxProperty -> GuiDropdownBoxProperty -> IO ()
poke Ptr GuiDropdownBoxProperty
ptr GuiDropdownBoxProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiDropdownBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiDropdownBoxProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiDropdownBoxProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiDropdownBoxProperty
v) :: CInt)

-- | TextBox/TextBoxMulti/ValueBox/Spinner
data GuiTextBoxProperty
  = -- | TextBox in read-only mode: 0-text editable, 1-text no-editable
    TextReadonly
  deriving (GuiTextBoxProperty -> GuiTextBoxProperty -> Bool
(GuiTextBoxProperty -> GuiTextBoxProperty -> Bool)
-> (GuiTextBoxProperty -> GuiTextBoxProperty -> Bool)
-> Eq GuiTextBoxProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiTextBoxProperty -> GuiTextBoxProperty -> Bool
== :: GuiTextBoxProperty -> GuiTextBoxProperty -> Bool
$c/= :: GuiTextBoxProperty -> GuiTextBoxProperty -> Bool
/= :: GuiTextBoxProperty -> GuiTextBoxProperty -> Bool
Eq, Int -> GuiTextBoxProperty -> ShowS
[GuiTextBoxProperty] -> ShowS
GuiTextBoxProperty -> String
(Int -> GuiTextBoxProperty -> ShowS)
-> (GuiTextBoxProperty -> String)
-> ([GuiTextBoxProperty] -> ShowS)
-> Show GuiTextBoxProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiTextBoxProperty -> ShowS
showsPrec :: Int -> GuiTextBoxProperty -> ShowS
$cshow :: GuiTextBoxProperty -> String
show :: GuiTextBoxProperty -> String
$cshowList :: [GuiTextBoxProperty] -> ShowS
showList :: [GuiTextBoxProperty] -> ShowS
Show)

instance Enum GuiTextBoxProperty where
  fromEnum :: GuiTextBoxProperty -> Int
fromEnum GuiTextBoxProperty
x = case GuiTextBoxProperty
x of
    GuiTextBoxProperty
TextReadonly -> Int
16
  toEnum :: Int -> GuiTextBoxProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiTextBoxProperty
TextReadonly
    Int
n -> String -> GuiTextBoxProperty
forall a. HasCallStack => String -> a
error (String -> GuiTextBoxProperty) -> String -> GuiTextBoxProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiTextBoxProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiTextBoxProperty where
  sizeOf :: GuiTextBoxProperty -> Int
sizeOf GuiTextBoxProperty
_ = Int
4
  alignment :: GuiTextBoxProperty -> Int
alignment GuiTextBoxProperty
_ = Int
4
  peek :: Ptr GuiTextBoxProperty -> IO GuiTextBoxProperty
peek Ptr GuiTextBoxProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiTextBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextBoxProperty
ptr)
    GuiTextBoxProperty -> IO GuiTextBoxProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiTextBoxProperty -> IO GuiTextBoxProperty)
-> GuiTextBoxProperty -> IO GuiTextBoxProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiTextBoxProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiTextBoxProperty) -> Int -> GuiTextBoxProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiTextBoxProperty -> GuiTextBoxProperty -> IO ()
poke Ptr GuiTextBoxProperty
ptr GuiTextBoxProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiTextBoxProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiTextBoxProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiTextBoxProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiTextBoxProperty
v) :: CInt)

-- | Spinner
data GuiSpinnerProperty
  = -- | Spinner left/right buttons width
    SpinButtonWidth
  | -- | Spinner buttons separation
    SpinButtonSpacing
  deriving (GuiSpinnerProperty -> GuiSpinnerProperty -> Bool
(GuiSpinnerProperty -> GuiSpinnerProperty -> Bool)
-> (GuiSpinnerProperty -> GuiSpinnerProperty -> Bool)
-> Eq GuiSpinnerProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiSpinnerProperty -> GuiSpinnerProperty -> Bool
== :: GuiSpinnerProperty -> GuiSpinnerProperty -> Bool
$c/= :: GuiSpinnerProperty -> GuiSpinnerProperty -> Bool
/= :: GuiSpinnerProperty -> GuiSpinnerProperty -> Bool
Eq, Int -> GuiSpinnerProperty -> ShowS
[GuiSpinnerProperty] -> ShowS
GuiSpinnerProperty -> String
(Int -> GuiSpinnerProperty -> ShowS)
-> (GuiSpinnerProperty -> String)
-> ([GuiSpinnerProperty] -> ShowS)
-> Show GuiSpinnerProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiSpinnerProperty -> ShowS
showsPrec :: Int -> GuiSpinnerProperty -> ShowS
$cshow :: GuiSpinnerProperty -> String
show :: GuiSpinnerProperty -> String
$cshowList :: [GuiSpinnerProperty] -> ShowS
showList :: [GuiSpinnerProperty] -> ShowS
Show)

instance Enum GuiSpinnerProperty where
  fromEnum :: GuiSpinnerProperty -> Int
fromEnum GuiSpinnerProperty
x = case GuiSpinnerProperty
x of
    GuiSpinnerProperty
SpinButtonWidth -> Int
16
    GuiSpinnerProperty
SpinButtonSpacing -> Int
17
  toEnum :: Int -> GuiSpinnerProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiSpinnerProperty
SpinButtonWidth
    Int
17 -> GuiSpinnerProperty
SpinButtonSpacing
    Int
n -> String -> GuiSpinnerProperty
forall a. HasCallStack => String -> a
error (String -> GuiSpinnerProperty) -> String -> GuiSpinnerProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiSpinnerProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiSpinnerProperty where
  sizeOf :: GuiSpinnerProperty -> Int
sizeOf GuiSpinnerProperty
_ = Int
4
  alignment :: GuiSpinnerProperty -> Int
alignment GuiSpinnerProperty
_ = Int
4
  peek :: Ptr GuiSpinnerProperty -> IO GuiSpinnerProperty
peek Ptr GuiSpinnerProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiSpinnerProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiSpinnerProperty
ptr)
    GuiSpinnerProperty -> IO GuiSpinnerProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiSpinnerProperty -> IO GuiSpinnerProperty)
-> GuiSpinnerProperty -> IO GuiSpinnerProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiSpinnerProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiSpinnerProperty) -> Int -> GuiSpinnerProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiSpinnerProperty -> GuiSpinnerProperty -> IO ()
poke Ptr GuiSpinnerProperty
ptr GuiSpinnerProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiSpinnerProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiSpinnerProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiSpinnerProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiSpinnerProperty
v) :: CInt)

-- | ListView
data GuiListViewProperty
  = -- | ListView items height
    ListItemsHeight
  | -- | ListView items separation
    ListItemsSpacing
  | -- | ListView scrollbar size (usually width)
    ScrollbarWidth
  | -- | ListView scrollbar side (0-SCROLLBAR_LEFT_SIDE, 1-SCROLLBAR_RIGHT_SIDE)
    ScrollbarSide
  deriving (GuiListViewProperty -> GuiListViewProperty -> Bool
(GuiListViewProperty -> GuiListViewProperty -> Bool)
-> (GuiListViewProperty -> GuiListViewProperty -> Bool)
-> Eq GuiListViewProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiListViewProperty -> GuiListViewProperty -> Bool
== :: GuiListViewProperty -> GuiListViewProperty -> Bool
$c/= :: GuiListViewProperty -> GuiListViewProperty -> Bool
/= :: GuiListViewProperty -> GuiListViewProperty -> Bool
Eq, Int -> GuiListViewProperty -> ShowS
[GuiListViewProperty] -> ShowS
GuiListViewProperty -> String
(Int -> GuiListViewProperty -> ShowS)
-> (GuiListViewProperty -> String)
-> ([GuiListViewProperty] -> ShowS)
-> Show GuiListViewProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiListViewProperty -> ShowS
showsPrec :: Int -> GuiListViewProperty -> ShowS
$cshow :: GuiListViewProperty -> String
show :: GuiListViewProperty -> String
$cshowList :: [GuiListViewProperty] -> ShowS
showList :: [GuiListViewProperty] -> ShowS
Show)

instance Enum GuiListViewProperty where
  fromEnum :: GuiListViewProperty -> Int
fromEnum GuiListViewProperty
x = case GuiListViewProperty
x of
    GuiListViewProperty
ListItemsHeight -> Int
16
    GuiListViewProperty
ListItemsSpacing -> Int
17
    GuiListViewProperty
ScrollbarWidth -> Int
18
    GuiListViewProperty
ScrollbarSide -> Int
19
  toEnum :: Int -> GuiListViewProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiListViewProperty
ListItemsHeight
    Int
17 -> GuiListViewProperty
ListItemsSpacing
    Int
18 -> GuiListViewProperty
ScrollbarWidth
    Int
19 -> GuiListViewProperty
ScrollbarSide
    Int
n -> String -> GuiListViewProperty
forall a. HasCallStack => String -> a
error (String -> GuiListViewProperty) -> String -> GuiListViewProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiListViewProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiListViewProperty where
  sizeOf :: GuiListViewProperty -> Int
sizeOf GuiListViewProperty
_ = Int
4
  alignment :: GuiListViewProperty -> Int
alignment GuiListViewProperty
_ = Int
4
  peek :: Ptr GuiListViewProperty -> IO GuiListViewProperty
peek Ptr GuiListViewProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiListViewProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiListViewProperty
ptr)
    GuiListViewProperty -> IO GuiListViewProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiListViewProperty -> IO GuiListViewProperty)
-> GuiListViewProperty -> IO GuiListViewProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiListViewProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiListViewProperty) -> Int -> GuiListViewProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiListViewProperty -> GuiListViewProperty -> IO ()
poke Ptr GuiListViewProperty
ptr GuiListViewProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiListViewProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiListViewProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiListViewProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiListViewProperty
v) :: CInt)

-- | ColorPicker
data GuiColorPickerProperty
  = ColorSelectorSize
  | -- | ColorPicker right hue bar width
    HuebarWidth
  | -- | ColorPicker right hue bar separation from panel
    HuebarPadding
  | -- | ColorPicker right hue bar selector height
    HuebarSelectorHeight
  | -- | ColorPicker right hue bar selector overflow
    HuebarSelectorOverflow
  deriving (GuiColorPickerProperty -> GuiColorPickerProperty -> Bool
(GuiColorPickerProperty -> GuiColorPickerProperty -> Bool)
-> (GuiColorPickerProperty -> GuiColorPickerProperty -> Bool)
-> Eq GuiColorPickerProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiColorPickerProperty -> GuiColorPickerProperty -> Bool
== :: GuiColorPickerProperty -> GuiColorPickerProperty -> Bool
$c/= :: GuiColorPickerProperty -> GuiColorPickerProperty -> Bool
/= :: GuiColorPickerProperty -> GuiColorPickerProperty -> Bool
Eq, Int -> GuiColorPickerProperty -> ShowS
[GuiColorPickerProperty] -> ShowS
GuiColorPickerProperty -> String
(Int -> GuiColorPickerProperty -> ShowS)
-> (GuiColorPickerProperty -> String)
-> ([GuiColorPickerProperty] -> ShowS)
-> Show GuiColorPickerProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiColorPickerProperty -> ShowS
showsPrec :: Int -> GuiColorPickerProperty -> ShowS
$cshow :: GuiColorPickerProperty -> String
show :: GuiColorPickerProperty -> String
$cshowList :: [GuiColorPickerProperty] -> ShowS
showList :: [GuiColorPickerProperty] -> ShowS
Show)

instance Enum GuiColorPickerProperty where
  fromEnum :: GuiColorPickerProperty -> Int
fromEnum GuiColorPickerProperty
x = case GuiColorPickerProperty
x of
    GuiColorPickerProperty
ColorSelectorSize -> Int
16
    GuiColorPickerProperty
HuebarWidth -> Int
17
    GuiColorPickerProperty
HuebarPadding -> Int
18
    GuiColorPickerProperty
HuebarSelectorHeight -> Int
19
    GuiColorPickerProperty
HuebarSelectorOverflow -> Int
20
  toEnum :: Int -> GuiColorPickerProperty
toEnum Int
x = case Int
x of
    Int
16 -> GuiColorPickerProperty
ColorSelectorSize
    Int
17 -> GuiColorPickerProperty
HuebarWidth
    Int
18 -> GuiColorPickerProperty
HuebarPadding
    Int
19 -> GuiColorPickerProperty
HuebarSelectorHeight
    Int
20 -> GuiColorPickerProperty
HuebarSelectorOverflow
    Int
n -> String -> GuiColorPickerProperty
forall a. HasCallStack => String -> a
error (String -> GuiColorPickerProperty)
-> String -> GuiColorPickerProperty
forall a b. (a -> b) -> a -> b
$ String
"(GuiColorPickerProperty.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiColorPickerProperty where
  sizeOf :: GuiColorPickerProperty -> Int
sizeOf GuiColorPickerProperty
_ = Int
4
  alignment :: GuiColorPickerProperty -> Int
alignment GuiColorPickerProperty
_ = Int
4
  peek :: Ptr GuiColorPickerProperty -> IO GuiColorPickerProperty
peek Ptr GuiColorPickerProperty
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiColorPickerProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiColorPickerProperty
ptr)
    GuiColorPickerProperty -> IO GuiColorPickerProperty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiColorPickerProperty -> IO GuiColorPickerProperty)
-> GuiColorPickerProperty -> IO GuiColorPickerProperty
forall a b. (a -> b) -> a -> b
$ Int -> GuiColorPickerProperty
forall a. Enum a => Int -> a
toEnum (Int -> GuiColorPickerProperty) -> Int -> GuiColorPickerProperty
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiColorPickerProperty -> GuiColorPickerProperty -> IO ()
poke Ptr GuiColorPickerProperty
ptr GuiColorPickerProperty
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiColorPickerProperty -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiColorPickerProperty
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiColorPickerProperty -> Int
forall a. Enum a => a -> Int
fromEnum GuiColorPickerProperty
v) :: CInt)

data GuiIconName
  = IconNone
  | IconFolderFileOpen
  | IconFileSaveClassic
  | IconFolderOpen
  | IconFolderSave
  | IconFileOpen
  | IconFileSave
  | IconFileExport
  | IconFileAdd
  | IconFileDelete
  | IconFiletypeText
  | IconFiletypeAudio
  | IconFiletypeImage
  | IconFiletypePlay
  | IconFiletypeVideo
  | IconFiletypeInfo
  | IconFileCopy
  | IconFileCut
  | IconFilePaste
  | IconCursorHand
  | IconCursorPointer
  | IconCursorClassic
  | IconPencil
  | IconPencilBig
  | IconBrushClassic
  | IconBrushPainter
  | IconWaterDrop
  | IconColorPicker
  | IconRubber
  | IconColorBucket
  | IconTextT
  | IconTextA
  | IconScale
  | IconResize
  | IconFilterPoint
  | IconFilterBilinear
  | IconCrop
  | IconCropAlpha
  | IconSquareToggle
  | IconSymmetry
  | IconSymmetryHorizontal
  | IconSymmetryVertical
  | IconLens
  | IconLensBig
  | IconEyeOn
  | IconEyeOff
  | IconFilterTop
  | IconFilter
  | IconTargetPoint
  | IconTargetSmall
  | IconTargetBig
  | IconTargetMove
  | IconCursorMove
  | IconCursorScale
  | IconCursorScaleRight
  | IconCursorScaleLeft
  | IconUndo
  | IconRedo
  | IconReredo
  | IconMutate
  | IconRotate
  | IconRepeat
  | IconShuffle
  | IconEmptybox
  | IconTarget
  | IconTargetSmallFill
  | IconTargetBigFill
  | IconTargetMoveFill
  | IconCursorMoveFill
  | IconCursorScaleFill
  | IconCursorScaleRightFill
  | IconCursorScaleLeftFill
  | IconUndoFill
  | IconRedoFill
  | IconReredoFill
  | IconMutateFill
  | IconRotateFill
  | IconRepeatFill
  | IconShuffleFill
  | IconEmptyboxSmall
  | IconBox
  | IconBoxTop
  | IconBoxTopRight
  | IconBoxRight
  | IconBoxBottomRight
  | IconBoxBottom
  | IconBoxBottomLeft
  | IconBoxLeft
  | IconBoxTopLeft
  | IconBoxCenter
  | IconBoxCircleMask
  | IconPot
  | IconAlphaMultiply
  | IconAlphaClear
  | IconDithering
  | IconMipmaps
  | IconBoxGrid
  | IconGrid
  | IconBoxCornersSmall
  | IconBoxCornersBig
  | IconFourBoxes
  | IconGridFill
  | IconBoxMultisize
  | IconZoomSmall
  | IconZoomMedium
  | IconZoomBig
  | IconZoomAll
  | IconZoomCenter
  | IconBoxDotsSmall
  | IconBoxDotsBig
  | IconBoxConcentric
  | IconBoxGridBig
  | IconOkTick
  | IconCross
  | IconArrowLeft
  | IconArrowRight
  | IconArrowDown
  | IconArrowUp
  | IconArrowLeftFill
  | IconArrowRightFill
  | IconArrowDownFill
  | IconArrowUpFill
  | IconAudio
  | IconFx
  | IconWave
  | IconWaveSinus
  | IconWaveSquare
  | IconWaveTriangular
  | IconCrossSmall
  | IconPlayerPrevious
  | IconPlayerPlayBack
  | IconPlayerPlay
  | IconPlayerPause
  | IconPlayerStop
  | IconPlayerNext
  | IconPlayerRecord
  | IconMagnet
  | IconLockClose
  | IconLockOpen
  | IconClock
  | IconTools
  | IconGear
  | IconGearBig
  | IconBin
  | IconHandPointer
  | IconLaser
  | IconCoin
  | IconExplosion
  | Icon1up
  | IconPlayer
  | IconPlayerJump
  | IconKey
  | IconDemon
  | IconTextPopup
  | IconGearEx
  | IconCrack
  | IconCrackPoints
  | IconStar
  | IconDoor
  | IconExit
  | IconMode2d
  | IconMode3d
  | IconCube
  | IconCubeFaceTop
  | IconCubeFaceLeft
  | IconCubeFaceFront
  | IconCubeFaceBottom
  | IconCubeFaceRight
  | IconCubeFaceBack
  | IconCamera
  | IconSpecial
  | IconLinkNet
  | IconLinkBoxes
  | IconLinkMulti
  | IconLink
  | IconLinkBroke
  | IconTextNotes
  | IconNotebook
  | IconSuitcase
  | IconSuitcaseZip
  | IconMailbox
  | IconMonitor
  | IconPrinter
  | IconPhotoCamera
  | IconPhotoCameraFlash
  | IconHouse
  | IconHeart
  | IconCorner
  | IconVerticalBars
  | IconVerticalBarsFill
  | IconLifeBars
  | IconInfo
  | IconCrossline
  | IconHelp
  | IconFiletypeAlpha
  | IconFiletypeHome
  | IconLayersVisible
  | IconLayers
  | IconWindow
  | IconHidpi
  | IconFiletypeBinary
  | IconHex
  | IconShield
  | IconFileNew
  | IconFolderAdd
  | IconAlarm
  | IconCpu
  | IconRom
  | IconStepOver
  | IconStepInto
  | IconStepOut
  | IconRestart
  | IconBreakpointOn
  | IconBreakpointOff
  | IconBurgerMenu
  | IconCaseSensitive
  | IconRegExp
  | IconFolder
  | IconFile
  | IconSandTimer
  | IconWarning
  | IconHelpBox
  | IconInfoBox
  | Icon223
  | Icon224
  | Icon225
  | Icon226
  | Icon227
  | Icon228
  | Icon229
  | Icon230
  | Icon231
  | Icon232
  | Icon233
  | Icon234
  | Icon235
  | Icon236
  | Icon237
  | Icon238
  | Icon239
  | Icon240
  | Icon241
  | Icon242
  | Icon243
  | Icon244
  | Icon245
  | Icon246
  | Icon247
  | Icon248
  | Icon249
  | Icon250
  | Icon251
  | Icon252
  | Icon253
  | Icon254
  | Icon255
  deriving (GuiIconName -> GuiIconName -> Bool
(GuiIconName -> GuiIconName -> Bool)
-> (GuiIconName -> GuiIconName -> Bool) -> Eq GuiIconName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiIconName -> GuiIconName -> Bool
== :: GuiIconName -> GuiIconName -> Bool
$c/= :: GuiIconName -> GuiIconName -> Bool
/= :: GuiIconName -> GuiIconName -> Bool
Eq, Int -> GuiIconName -> ShowS
[GuiIconName] -> ShowS
GuiIconName -> String
(Int -> GuiIconName -> ShowS)
-> (GuiIconName -> String)
-> ([GuiIconName] -> ShowS)
-> Show GuiIconName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiIconName -> ShowS
showsPrec :: Int -> GuiIconName -> ShowS
$cshow :: GuiIconName -> String
show :: GuiIconName -> String
$cshowList :: [GuiIconName] -> ShowS
showList :: [GuiIconName] -> ShowS
Show)

instance Enum GuiIconName where
  fromEnum :: GuiIconName -> Int
fromEnum GuiIconName
x = case GuiIconName
x of
    GuiIconName
IconNone -> Int
0
    GuiIconName
IconFolderFileOpen -> Int
1
    GuiIconName
IconFileSaveClassic -> Int
2
    GuiIconName
IconFolderOpen -> Int
3
    GuiIconName
IconFolderSave -> Int
4
    GuiIconName
IconFileOpen -> Int
5
    GuiIconName
IconFileSave -> Int
6
    GuiIconName
IconFileExport -> Int
7
    GuiIconName
IconFileAdd -> Int
8
    GuiIconName
IconFileDelete -> Int
9
    GuiIconName
IconFiletypeText -> Int
10
    GuiIconName
IconFiletypeAudio -> Int
11
    GuiIconName
IconFiletypeImage -> Int
12
    GuiIconName
IconFiletypePlay -> Int
13
    GuiIconName
IconFiletypeVideo -> Int
14
    GuiIconName
IconFiletypeInfo -> Int
15
    GuiIconName
IconFileCopy -> Int
16
    GuiIconName
IconFileCut -> Int
17
    GuiIconName
IconFilePaste -> Int
18
    GuiIconName
IconCursorHand -> Int
19
    GuiIconName
IconCursorPointer -> Int
20
    GuiIconName
IconCursorClassic -> Int
21
    GuiIconName
IconPencil -> Int
22
    GuiIconName
IconPencilBig -> Int
23
    GuiIconName
IconBrushClassic -> Int
24
    GuiIconName
IconBrushPainter -> Int
25
    GuiIconName
IconWaterDrop -> Int
26
    GuiIconName
IconColorPicker -> Int
27
    GuiIconName
IconRubber -> Int
28
    GuiIconName
IconColorBucket -> Int
29
    GuiIconName
IconTextT -> Int
30
    GuiIconName
IconTextA -> Int
31
    GuiIconName
IconScale -> Int
32
    GuiIconName
IconResize -> Int
33
    GuiIconName
IconFilterPoint -> Int
34
    GuiIconName
IconFilterBilinear -> Int
35
    GuiIconName
IconCrop -> Int
36
    GuiIconName
IconCropAlpha -> Int
37
    GuiIconName
IconSquareToggle -> Int
38
    GuiIconName
IconSymmetry -> Int
39
    GuiIconName
IconSymmetryHorizontal -> Int
40
    GuiIconName
IconSymmetryVertical -> Int
41
    GuiIconName
IconLens -> Int
42
    GuiIconName
IconLensBig -> Int
43
    GuiIconName
IconEyeOn -> Int
44
    GuiIconName
IconEyeOff -> Int
45
    GuiIconName
IconFilterTop -> Int
46
    GuiIconName
IconFilter -> Int
47
    GuiIconName
IconTargetPoint -> Int
48
    GuiIconName
IconTargetSmall -> Int
49
    GuiIconName
IconTargetBig -> Int
50
    GuiIconName
IconTargetMove -> Int
51
    GuiIconName
IconCursorMove -> Int
52
    GuiIconName
IconCursorScale -> Int
53
    GuiIconName
IconCursorScaleRight -> Int
54
    GuiIconName
IconCursorScaleLeft -> Int
55
    GuiIconName
IconUndo -> Int
56
    GuiIconName
IconRedo -> Int
57
    GuiIconName
IconReredo -> Int
58
    GuiIconName
IconMutate -> Int
59
    GuiIconName
IconRotate -> Int
60
    GuiIconName
IconRepeat -> Int
61
    GuiIconName
IconShuffle -> Int
62
    GuiIconName
IconEmptybox -> Int
63
    GuiIconName
IconTarget -> Int
64
    GuiIconName
IconTargetSmallFill -> Int
65
    GuiIconName
IconTargetBigFill -> Int
66
    GuiIconName
IconTargetMoveFill -> Int
67
    GuiIconName
IconCursorMoveFill -> Int
68
    GuiIconName
IconCursorScaleFill -> Int
69
    GuiIconName
IconCursorScaleRightFill -> Int
70
    GuiIconName
IconCursorScaleLeftFill -> Int
71
    GuiIconName
IconUndoFill -> Int
72
    GuiIconName
IconRedoFill -> Int
73
    GuiIconName
IconReredoFill -> Int
74
    GuiIconName
IconMutateFill -> Int
75
    GuiIconName
IconRotateFill -> Int
76
    GuiIconName
IconRepeatFill -> Int
77
    GuiIconName
IconShuffleFill -> Int
78
    GuiIconName
IconEmptyboxSmall -> Int
79
    GuiIconName
IconBox -> Int
80
    GuiIconName
IconBoxTop -> Int
81
    GuiIconName
IconBoxTopRight -> Int
82
    GuiIconName
IconBoxRight -> Int
83
    GuiIconName
IconBoxBottomRight -> Int
84
    GuiIconName
IconBoxBottom -> Int
85
    GuiIconName
IconBoxBottomLeft -> Int
86
    GuiIconName
IconBoxLeft -> Int
87
    GuiIconName
IconBoxTopLeft -> Int
88
    GuiIconName
IconBoxCenter -> Int
89
    GuiIconName
IconBoxCircleMask -> Int
90
    GuiIconName
IconPot -> Int
91
    GuiIconName
IconAlphaMultiply -> Int
92
    GuiIconName
IconAlphaClear -> Int
93
    GuiIconName
IconDithering -> Int
94
    GuiIconName
IconMipmaps -> Int
95
    GuiIconName
IconBoxGrid -> Int
96
    GuiIconName
IconGrid -> Int
97
    GuiIconName
IconBoxCornersSmall -> Int
98
    GuiIconName
IconBoxCornersBig -> Int
99
    GuiIconName
IconFourBoxes -> Int
100
    GuiIconName
IconGridFill -> Int
101
    GuiIconName
IconBoxMultisize -> Int
102
    GuiIconName
IconZoomSmall -> Int
103
    GuiIconName
IconZoomMedium -> Int
104
    GuiIconName
IconZoomBig -> Int
105
    GuiIconName
IconZoomAll -> Int
106
    GuiIconName
IconZoomCenter -> Int
107
    GuiIconName
IconBoxDotsSmall -> Int
108
    GuiIconName
IconBoxDotsBig -> Int
109
    GuiIconName
IconBoxConcentric -> Int
110
    GuiIconName
IconBoxGridBig -> Int
111
    GuiIconName
IconOkTick -> Int
112
    GuiIconName
IconCross -> Int
113
    GuiIconName
IconArrowLeft -> Int
114
    GuiIconName
IconArrowRight -> Int
115
    GuiIconName
IconArrowDown -> Int
116
    GuiIconName
IconArrowUp -> Int
117
    GuiIconName
IconArrowLeftFill -> Int
118
    GuiIconName
IconArrowRightFill -> Int
119
    GuiIconName
IconArrowDownFill -> Int
120
    GuiIconName
IconArrowUpFill -> Int
121
    GuiIconName
IconAudio -> Int
122
    GuiIconName
IconFx -> Int
123
    GuiIconName
IconWave -> Int
124
    GuiIconName
IconWaveSinus -> Int
125
    GuiIconName
IconWaveSquare -> Int
126
    GuiIconName
IconWaveTriangular -> Int
127
    GuiIconName
IconCrossSmall -> Int
128
    GuiIconName
IconPlayerPrevious -> Int
129
    GuiIconName
IconPlayerPlayBack -> Int
130
    GuiIconName
IconPlayerPlay -> Int
131
    GuiIconName
IconPlayerPause -> Int
132
    GuiIconName
IconPlayerStop -> Int
133
    GuiIconName
IconPlayerNext -> Int
134
    GuiIconName
IconPlayerRecord -> Int
135
    GuiIconName
IconMagnet -> Int
136
    GuiIconName
IconLockClose -> Int
137
    GuiIconName
IconLockOpen -> Int
138
    GuiIconName
IconClock -> Int
139
    GuiIconName
IconTools -> Int
140
    GuiIconName
IconGear -> Int
141
    GuiIconName
IconGearBig -> Int
142
    GuiIconName
IconBin -> Int
143
    GuiIconName
IconHandPointer -> Int
144
    GuiIconName
IconLaser -> Int
145
    GuiIconName
IconCoin -> Int
146
    GuiIconName
IconExplosion -> Int
147
    GuiIconName
Icon1up -> Int
148
    GuiIconName
IconPlayer -> Int
149
    GuiIconName
IconPlayerJump -> Int
150
    GuiIconName
IconKey -> Int
151
    GuiIconName
IconDemon -> Int
152
    GuiIconName
IconTextPopup -> Int
153
    GuiIconName
IconGearEx -> Int
154
    GuiIconName
IconCrack -> Int
155
    GuiIconName
IconCrackPoints -> Int
156
    GuiIconName
IconStar -> Int
157
    GuiIconName
IconDoor -> Int
158
    GuiIconName
IconExit -> Int
159
    GuiIconName
IconMode2d -> Int
160
    GuiIconName
IconMode3d -> Int
161
    GuiIconName
IconCube -> Int
162
    GuiIconName
IconCubeFaceTop -> Int
163
    GuiIconName
IconCubeFaceLeft -> Int
164
    GuiIconName
IconCubeFaceFront -> Int
165
    GuiIconName
IconCubeFaceBottom -> Int
166
    GuiIconName
IconCubeFaceRight -> Int
167
    GuiIconName
IconCubeFaceBack -> Int
168
    GuiIconName
IconCamera -> Int
169
    GuiIconName
IconSpecial -> Int
170
    GuiIconName
IconLinkNet -> Int
171
    GuiIconName
IconLinkBoxes -> Int
172
    GuiIconName
IconLinkMulti -> Int
173
    GuiIconName
IconLink -> Int
174
    GuiIconName
IconLinkBroke -> Int
175
    GuiIconName
IconTextNotes -> Int
176
    GuiIconName
IconNotebook -> Int
177
    GuiIconName
IconSuitcase -> Int
178
    GuiIconName
IconSuitcaseZip -> Int
179
    GuiIconName
IconMailbox -> Int
180
    GuiIconName
IconMonitor -> Int
181
    GuiIconName
IconPrinter -> Int
182
    GuiIconName
IconPhotoCamera -> Int
183
    GuiIconName
IconPhotoCameraFlash -> Int
184
    GuiIconName
IconHouse -> Int
185
    GuiIconName
IconHeart -> Int
186
    GuiIconName
IconCorner -> Int
187
    GuiIconName
IconVerticalBars -> Int
188
    GuiIconName
IconVerticalBarsFill -> Int
189
    GuiIconName
IconLifeBars -> Int
190
    GuiIconName
IconInfo -> Int
191
    GuiIconName
IconCrossline -> Int
192
    GuiIconName
IconHelp -> Int
193
    GuiIconName
IconFiletypeAlpha -> Int
194
    GuiIconName
IconFiletypeHome -> Int
195
    GuiIconName
IconLayersVisible -> Int
196
    GuiIconName
IconLayers -> Int
197
    GuiIconName
IconWindow -> Int
198
    GuiIconName
IconHidpi -> Int
199
    GuiIconName
IconFiletypeBinary -> Int
200
    GuiIconName
IconHex -> Int
201
    GuiIconName
IconShield -> Int
202
    GuiIconName
IconFileNew -> Int
203
    GuiIconName
IconFolderAdd -> Int
204
    GuiIconName
IconAlarm -> Int
205
    GuiIconName
IconCpu -> Int
206
    GuiIconName
IconRom -> Int
207
    GuiIconName
IconStepOver -> Int
208
    GuiIconName
IconStepInto -> Int
209
    GuiIconName
IconStepOut -> Int
210
    GuiIconName
IconRestart -> Int
211
    GuiIconName
IconBreakpointOn -> Int
212
    GuiIconName
IconBreakpointOff -> Int
213
    GuiIconName
IconBurgerMenu -> Int
214
    GuiIconName
IconCaseSensitive -> Int
215
    GuiIconName
IconRegExp -> Int
216
    GuiIconName
IconFolder -> Int
217
    GuiIconName
IconFile -> Int
218
    GuiIconName
IconSandTimer -> Int
219
    GuiIconName
IconWarning -> Int
220
    GuiIconName
IconHelpBox -> Int
221
    GuiIconName
IconInfoBox -> Int
222
    GuiIconName
Icon223 -> Int
223
    GuiIconName
Icon224 -> Int
224
    GuiIconName
Icon225 -> Int
225
    GuiIconName
Icon226 -> Int
226
    GuiIconName
Icon227 -> Int
227
    GuiIconName
Icon228 -> Int
228
    GuiIconName
Icon229 -> Int
229
    GuiIconName
Icon230 -> Int
230
    GuiIconName
Icon231 -> Int
231
    GuiIconName
Icon232 -> Int
232
    GuiIconName
Icon233 -> Int
233
    GuiIconName
Icon234 -> Int
234
    GuiIconName
Icon235 -> Int
235
    GuiIconName
Icon236 -> Int
236
    GuiIconName
Icon237 -> Int
237
    GuiIconName
Icon238 -> Int
238
    GuiIconName
Icon239 -> Int
239
    GuiIconName
Icon240 -> Int
240
    GuiIconName
Icon241 -> Int
241
    GuiIconName
Icon242 -> Int
242
    GuiIconName
Icon243 -> Int
243
    GuiIconName
Icon244 -> Int
244
    GuiIconName
Icon245 -> Int
245
    GuiIconName
Icon246 -> Int
246
    GuiIconName
Icon247 -> Int
247
    GuiIconName
Icon248 -> Int
248
    GuiIconName
Icon249 -> Int
249
    GuiIconName
Icon250 -> Int
250
    GuiIconName
Icon251 -> Int
251
    GuiIconName
Icon252 -> Int
252
    GuiIconName
Icon253 -> Int
253
    GuiIconName
Icon254 -> Int
254
    GuiIconName
Icon255 -> Int
255
  toEnum :: Int -> GuiIconName
toEnum Int
x = case Int
x of
    Int
0 -> GuiIconName
IconNone
    Int
1 -> GuiIconName
IconFolderFileOpen
    Int
2 -> GuiIconName
IconFileSaveClassic
    Int
3 -> GuiIconName
IconFolderOpen
    Int
4 -> GuiIconName
IconFolderSave
    Int
5 -> GuiIconName
IconFileOpen
    Int
6 -> GuiIconName
IconFileSave
    Int
7 -> GuiIconName
IconFileExport
    Int
8 -> GuiIconName
IconFileAdd
    Int
9 -> GuiIconName
IconFileDelete
    Int
10 -> GuiIconName
IconFiletypeText
    Int
11 -> GuiIconName
IconFiletypeAudio
    Int
12 -> GuiIconName
IconFiletypeImage
    Int
13 -> GuiIconName
IconFiletypePlay
    Int
14 -> GuiIconName
IconFiletypeVideo
    Int
15 -> GuiIconName
IconFiletypeInfo
    Int
16 -> GuiIconName
IconFileCopy
    Int
17 -> GuiIconName
IconFileCut
    Int
18 -> GuiIconName
IconFilePaste
    Int
19 -> GuiIconName
IconCursorHand
    Int
20 -> GuiIconName
IconCursorPointer
    Int
21 -> GuiIconName
IconCursorClassic
    Int
22 -> GuiIconName
IconPencil
    Int
23 -> GuiIconName
IconPencilBig
    Int
24 -> GuiIconName
IconBrushClassic
    Int
25 -> GuiIconName
IconBrushPainter
    Int
26 -> GuiIconName
IconWaterDrop
    Int
27 -> GuiIconName
IconColorPicker
    Int
28 -> GuiIconName
IconRubber
    Int
29 -> GuiIconName
IconColorBucket
    Int
30 -> GuiIconName
IconTextT
    Int
31 -> GuiIconName
IconTextA
    Int
32 -> GuiIconName
IconScale
    Int
33 -> GuiIconName
IconResize
    Int
34 -> GuiIconName
IconFilterPoint
    Int
35 -> GuiIconName
IconFilterBilinear
    Int
36 -> GuiIconName
IconCrop
    Int
37 -> GuiIconName
IconCropAlpha
    Int
38 -> GuiIconName
IconSquareToggle
    Int
39 -> GuiIconName
IconSymmetry
    Int
40 -> GuiIconName
IconSymmetryHorizontal
    Int
41 -> GuiIconName
IconSymmetryVertical
    Int
42 -> GuiIconName
IconLens
    Int
43 -> GuiIconName
IconLensBig
    Int
44 -> GuiIconName
IconEyeOn
    Int
45 -> GuiIconName
IconEyeOff
    Int
46 -> GuiIconName
IconFilterTop
    Int
47 -> GuiIconName
IconFilter
    Int
48 -> GuiIconName
IconTargetPoint
    Int
49 -> GuiIconName
IconTargetSmall
    Int
50 -> GuiIconName
IconTargetBig
    Int
51 -> GuiIconName
IconTargetMove
    Int
52 -> GuiIconName
IconCursorMove
    Int
53 -> GuiIconName
IconCursorScale
    Int
54 -> GuiIconName
IconCursorScaleRight
    Int
55 -> GuiIconName
IconCursorScaleLeft
    Int
56 -> GuiIconName
IconUndo
    Int
57 -> GuiIconName
IconRedo
    Int
58 -> GuiIconName
IconReredo
    Int
59 -> GuiIconName
IconMutate
    Int
60 -> GuiIconName
IconRotate
    Int
61 -> GuiIconName
IconRepeat
    Int
62 -> GuiIconName
IconShuffle
    Int
63 -> GuiIconName
IconEmptybox
    Int
64 -> GuiIconName
IconTarget
    Int
65 -> GuiIconName
IconTargetSmallFill
    Int
66 -> GuiIconName
IconTargetBigFill
    Int
67 -> GuiIconName
IconTargetMoveFill
    Int
68 -> GuiIconName
IconCursorMoveFill
    Int
69 -> GuiIconName
IconCursorScaleFill
    Int
70 -> GuiIconName
IconCursorScaleRightFill
    Int
71 -> GuiIconName
IconCursorScaleLeftFill
    Int
72 -> GuiIconName
IconUndoFill
    Int
73 -> GuiIconName
IconRedoFill
    Int
74 -> GuiIconName
IconReredoFill
    Int
75 -> GuiIconName
IconMutateFill
    Int
76 -> GuiIconName
IconRotateFill
    Int
77 -> GuiIconName
IconRepeatFill
    Int
78 -> GuiIconName
IconShuffleFill
    Int
79 -> GuiIconName
IconEmptyboxSmall
    Int
80 -> GuiIconName
IconBox
    Int
81 -> GuiIconName
IconBoxTop
    Int
82 -> GuiIconName
IconBoxTopRight
    Int
83 -> GuiIconName
IconBoxRight
    Int
84 -> GuiIconName
IconBoxBottomRight
    Int
85 -> GuiIconName
IconBoxBottom
    Int
86 -> GuiIconName
IconBoxBottomLeft
    Int
87 -> GuiIconName
IconBoxLeft
    Int
88 -> GuiIconName
IconBoxTopLeft
    Int
89 -> GuiIconName
IconBoxCenter
    Int
90 -> GuiIconName
IconBoxCircleMask
    Int
91 -> GuiIconName
IconPot
    Int
92 -> GuiIconName
IconAlphaMultiply
    Int
93 -> GuiIconName
IconAlphaClear
    Int
94 -> GuiIconName
IconDithering
    Int
95 -> GuiIconName
IconMipmaps
    Int
96 -> GuiIconName
IconBoxGrid
    Int
97 -> GuiIconName
IconGrid
    Int
98 -> GuiIconName
IconBoxCornersSmall
    Int
99 -> GuiIconName
IconBoxCornersBig
    Int
100 -> GuiIconName
IconFourBoxes
    Int
101 -> GuiIconName
IconGridFill
    Int
102 -> GuiIconName
IconBoxMultisize
    Int
103 -> GuiIconName
IconZoomSmall
    Int
104 -> GuiIconName
IconZoomMedium
    Int
105 -> GuiIconName
IconZoomBig
    Int
106 -> GuiIconName
IconZoomAll
    Int
107 -> GuiIconName
IconZoomCenter
    Int
108 -> GuiIconName
IconBoxDotsSmall
    Int
109 -> GuiIconName
IconBoxDotsBig
    Int
110 -> GuiIconName
IconBoxConcentric
    Int
111 -> GuiIconName
IconBoxGridBig
    Int
112 -> GuiIconName
IconOkTick
    Int
113 -> GuiIconName
IconCross
    Int
114 -> GuiIconName
IconArrowLeft
    Int
115 -> GuiIconName
IconArrowRight
    Int
116 -> GuiIconName
IconArrowDown
    Int
117 -> GuiIconName
IconArrowUp
    Int
118 -> GuiIconName
IconArrowLeftFill
    Int
119 -> GuiIconName
IconArrowRightFill
    Int
120 -> GuiIconName
IconArrowDownFill
    Int
121 -> GuiIconName
IconArrowUpFill
    Int
122 -> GuiIconName
IconAudio
    Int
123 -> GuiIconName
IconFx
    Int
124 -> GuiIconName
IconWave
    Int
125 -> GuiIconName
IconWaveSinus
    Int
126 -> GuiIconName
IconWaveSquare
    Int
127 -> GuiIconName
IconWaveTriangular
    Int
128 -> GuiIconName
IconCrossSmall
    Int
129 -> GuiIconName
IconPlayerPrevious
    Int
130 -> GuiIconName
IconPlayerPlayBack
    Int
131 -> GuiIconName
IconPlayerPlay
    Int
132 -> GuiIconName
IconPlayerPause
    Int
133 -> GuiIconName
IconPlayerStop
    Int
134 -> GuiIconName
IconPlayerNext
    Int
135 -> GuiIconName
IconPlayerRecord
    Int
136 -> GuiIconName
IconMagnet
    Int
137 -> GuiIconName
IconLockClose
    Int
138 -> GuiIconName
IconLockOpen
    Int
139 -> GuiIconName
IconClock
    Int
140 -> GuiIconName
IconTools
    Int
141 -> GuiIconName
IconGear
    Int
142 -> GuiIconName
IconGearBig
    Int
143 -> GuiIconName
IconBin
    Int
144 -> GuiIconName
IconHandPointer
    Int
145 -> GuiIconName
IconLaser
    Int
146 -> GuiIconName
IconCoin
    Int
147 -> GuiIconName
IconExplosion
    Int
148 -> GuiIconName
Icon1up
    Int
149 -> GuiIconName
IconPlayer
    Int
150 -> GuiIconName
IconPlayerJump
    Int
151 -> GuiIconName
IconKey
    Int
152 -> GuiIconName
IconDemon
    Int
153 -> GuiIconName
IconTextPopup
    Int
154 -> GuiIconName
IconGearEx
    Int
155 -> GuiIconName
IconCrack
    Int
156 -> GuiIconName
IconCrackPoints
    Int
157 -> GuiIconName
IconStar
    Int
158 -> GuiIconName
IconDoor
    Int
159 -> GuiIconName
IconExit
    Int
160 -> GuiIconName
IconMode2d
    Int
161 -> GuiIconName
IconMode3d
    Int
162 -> GuiIconName
IconCube
    Int
163 -> GuiIconName
IconCubeFaceTop
    Int
164 -> GuiIconName
IconCubeFaceLeft
    Int
165 -> GuiIconName
IconCubeFaceFront
    Int
166 -> GuiIconName
IconCubeFaceBottom
    Int
167 -> GuiIconName
IconCubeFaceRight
    Int
168 -> GuiIconName
IconCubeFaceBack
    Int
169 -> GuiIconName
IconCamera
    Int
170 -> GuiIconName
IconSpecial
    Int
171 -> GuiIconName
IconLinkNet
    Int
172 -> GuiIconName
IconLinkBoxes
    Int
173 -> GuiIconName
IconLinkMulti
    Int
174 -> GuiIconName
IconLink
    Int
175 -> GuiIconName
IconLinkBroke
    Int
176 -> GuiIconName
IconTextNotes
    Int
177 -> GuiIconName
IconNotebook
    Int
178 -> GuiIconName
IconSuitcase
    Int
179 -> GuiIconName
IconSuitcaseZip
    Int
180 -> GuiIconName
IconMailbox
    Int
181 -> GuiIconName
IconMonitor
    Int
182 -> GuiIconName
IconPrinter
    Int
183 -> GuiIconName
IconPhotoCamera
    Int
184 -> GuiIconName
IconPhotoCameraFlash
    Int
185 -> GuiIconName
IconHouse
    Int
186 -> GuiIconName
IconHeart
    Int
187 -> GuiIconName
IconCorner
    Int
188 -> GuiIconName
IconVerticalBars
    Int
189 -> GuiIconName
IconVerticalBarsFill
    Int
190 -> GuiIconName
IconLifeBars
    Int
191 -> GuiIconName
IconInfo
    Int
192 -> GuiIconName
IconCrossline
    Int
193 -> GuiIconName
IconHelp
    Int
194 -> GuiIconName
IconFiletypeAlpha
    Int
195 -> GuiIconName
IconFiletypeHome
    Int
196 -> GuiIconName
IconLayersVisible
    Int
197 -> GuiIconName
IconLayers
    Int
198 -> GuiIconName
IconWindow
    Int
199 -> GuiIconName
IconHidpi
    Int
200 -> GuiIconName
IconFiletypeBinary
    Int
201 -> GuiIconName
IconHex
    Int
202 -> GuiIconName
IconShield
    Int
203 -> GuiIconName
IconFileNew
    Int
204 -> GuiIconName
IconFolderAdd
    Int
205 -> GuiIconName
IconAlarm
    Int
206 -> GuiIconName
IconCpu
    Int
207 -> GuiIconName
IconRom
    Int
208 -> GuiIconName
IconStepOver
    Int
209 -> GuiIconName
IconStepInto
    Int
210 -> GuiIconName
IconStepOut
    Int
211 -> GuiIconName
IconRestart
    Int
212 -> GuiIconName
IconBreakpointOn
    Int
213 -> GuiIconName
IconBreakpointOff
    Int
214 -> GuiIconName
IconBurgerMenu
    Int
215 -> GuiIconName
IconCaseSensitive
    Int
216 -> GuiIconName
IconRegExp
    Int
217 -> GuiIconName
IconFolder
    Int
218 -> GuiIconName
IconFile
    Int
219 -> GuiIconName
IconSandTimer
    Int
220 -> GuiIconName
IconWarning
    Int
221 -> GuiIconName
IconHelpBox
    Int
222 -> GuiIconName
IconInfoBox
    Int
223 -> GuiIconName
Icon223
    Int
224 -> GuiIconName
Icon224
    Int
225 -> GuiIconName
Icon225
    Int
226 -> GuiIconName
Icon226
    Int
227 -> GuiIconName
Icon227
    Int
228 -> GuiIconName
Icon228
    Int
229 -> GuiIconName
Icon229
    Int
230 -> GuiIconName
Icon230
    Int
231 -> GuiIconName
Icon231
    Int
232 -> GuiIconName
Icon232
    Int
233 -> GuiIconName
Icon233
    Int
234 -> GuiIconName
Icon234
    Int
235 -> GuiIconName
Icon235
    Int
236 -> GuiIconName
Icon236
    Int
237 -> GuiIconName
Icon237
    Int
238 -> GuiIconName
Icon238
    Int
239 -> GuiIconName
Icon239
    Int
240 -> GuiIconName
Icon240
    Int
241 -> GuiIconName
Icon241
    Int
242 -> GuiIconName
Icon242
    Int
243 -> GuiIconName
Icon243
    Int
244 -> GuiIconName
Icon244
    Int
245 -> GuiIconName
Icon245
    Int
246 -> GuiIconName
Icon246
    Int
247 -> GuiIconName
Icon247
    Int
248 -> GuiIconName
Icon248
    Int
249 -> GuiIconName
Icon249
    Int
250 -> GuiIconName
Icon250
    Int
251 -> GuiIconName
Icon251
    Int
252 -> GuiIconName
Icon252
    Int
253 -> GuiIconName
Icon253
    Int
254 -> GuiIconName
Icon254
    Int
255 -> GuiIconName
Icon255
    Int
n -> String -> GuiIconName
forall a. HasCallStack => String -> a
error (String -> GuiIconName) -> String -> GuiIconName
forall a b. (a -> b) -> a -> b
$ String
"(GuiIconName.toEnum) Invalid value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance Storable GuiIconName where
  sizeOf :: GuiIconName -> Int
sizeOf GuiIconName
_ = Int
4
  alignment :: GuiIconName -> Int
alignment GuiIconName
_ = Int
4
  peek :: Ptr GuiIconName -> IO GuiIconName
peek Ptr GuiIconName
ptr = do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiIconName -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiIconName
ptr)
    GuiIconName -> IO GuiIconName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiIconName -> IO GuiIconName) -> GuiIconName -> IO GuiIconName
forall a b. (a -> b) -> a -> b
$ Int -> GuiIconName
forall a. Enum a => Int -> a
toEnum (Int -> GuiIconName) -> Int -> GuiIconName
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr GuiIconName -> GuiIconName -> IO ()
poke Ptr GuiIconName
ptr GuiIconName
v = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiIconName -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr GuiIconName
ptr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GuiIconName -> Int
forall a. Enum a => a -> Int
fromEnum GuiIconName
v) :: CInt)

---------------------------------------
-- raygui structures ------------------
---------------------------------------

-- | Style property
--
-- NOTE: Used when exporting style as code for convenience
data GuiStyleProp = GuiStyleProp
  { -- | Control identifier
    GuiStyleProp -> Word16
guiStyleProp'controlId :: Word16,
    -- | Property identifier
    GuiStyleProp -> Word16
guiStyleProp'propertyId :: Word16,
    -- | Property value
    GuiStyleProp -> Int
guiStyleProp'propertyValue :: Int
  }
  deriving (GuiStyleProp -> GuiStyleProp -> Bool
(GuiStyleProp -> GuiStyleProp -> Bool)
-> (GuiStyleProp -> GuiStyleProp -> Bool) -> Eq GuiStyleProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuiStyleProp -> GuiStyleProp -> Bool
== :: GuiStyleProp -> GuiStyleProp -> Bool
$c/= :: GuiStyleProp -> GuiStyleProp -> Bool
/= :: GuiStyleProp -> GuiStyleProp -> Bool
Eq, Int -> GuiStyleProp -> ShowS
[GuiStyleProp] -> ShowS
GuiStyleProp -> String
(Int -> GuiStyleProp -> ShowS)
-> (GuiStyleProp -> String)
-> ([GuiStyleProp] -> ShowS)
-> Show GuiStyleProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuiStyleProp -> ShowS
showsPrec :: Int -> GuiStyleProp -> ShowS
$cshow :: GuiStyleProp -> String
show :: GuiStyleProp -> String
$cshowList :: [GuiStyleProp] -> ShowS
showList :: [GuiStyleProp] -> ShowS
Show, GuiStyleProp -> Ptr GuiStyleProp -> IO ()
(GuiStyleProp -> Ptr GuiStyleProp -> IO ())
-> (GuiStyleProp -> Ptr GuiStyleProp -> IO ())
-> Freeable GuiStyleProp
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
$crlFreeDependents :: GuiStyleProp -> Ptr GuiStyleProp -> IO ()
rlFreeDependents :: GuiStyleProp -> Ptr GuiStyleProp -> IO ()
$crlFree :: GuiStyleProp -> Ptr GuiStyleProp -> IO ()
rlFree :: GuiStyleProp -> Ptr GuiStyleProp -> IO ()
Freeable)

instance Storable GuiStyleProp where
  sizeOf :: GuiStyleProp -> Int
sizeOf GuiStyleProp
_ = Int
8
  alignment :: GuiStyleProp -> Int
alignment GuiStyleProp
_ = Int
4
  peek :: Ptr GuiStyleProp -> IO GuiStyleProp
peek Ptr GuiStyleProp
_p = do
    Word16
controlId <- CUShort -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUShort -> Word16) -> IO CUShort -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUShort -> IO CUShort
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'controlId Ptr GuiStyleProp
_p)
    Word16
propertyId <- CUShort -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUShort -> Word16) -> IO CUShort -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUShort -> IO CUShort
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'propertyId Ptr GuiStyleProp
_p)
    Int
propertyValue <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GuiStyleProp -> Ptr CInt
p'guiStyleProp'propertyValue Ptr GuiStyleProp
_p)
    GuiStyleProp -> IO GuiStyleProp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GuiStyleProp -> IO GuiStyleProp)
-> GuiStyleProp -> IO GuiStyleProp
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Int -> GuiStyleProp
GuiStyleProp Word16
controlId Word16
propertyId Int
propertyValue
  poke :: Ptr GuiStyleProp -> GuiStyleProp -> IO ()
poke Ptr GuiStyleProp
_p (GuiStyleProp Word16
controlId Word16
propertyId Int
propertyValue) = do
    Ptr CUShort -> CUShort -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'controlId Ptr GuiStyleProp
_p) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
controlId)
    Ptr CUShort -> CUShort -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'propertyId Ptr GuiStyleProp
_p) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
propertyId)
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GuiStyleProp -> Ptr CInt
p'guiStyleProp'propertyValue Ptr GuiStyleProp
_p) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
propertyValue)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

p'guiStyleProp'controlId :: Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'controlId :: Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'controlId = (Ptr GuiStyleProp -> Int -> Ptr CUShort
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0)

p'guiStyleProp'propertyId :: Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'propertyId :: Ptr GuiStyleProp -> Ptr CUShort
p'guiStyleProp'propertyId = (Ptr GuiStyleProp -> Int -> Ptr CUShort
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)

p'guiStyleProp'propertyValue :: Ptr GuiStyleProp -> Ptr CInt
p'guiStyleProp'propertyValue :: Ptr GuiStyleProp -> Ptr CInt
p'guiStyleProp'propertyValue = (Ptr GuiStyleProp -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)