{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

module DearImGui.Structs where

-- base
import Data.Word
  ( Word32
#ifndef IMGUI_USE_WCHAR32
  , Word16
#endif
  )

import Foreign
  ( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr )
import Foreign.C
  ( CInt, CBool )

import DearImGui.Enums
import Data.Bits ((.&.))

--------------------------------------------------------------------------------
data ImVec2 = ImVec2 { ImVec2 -> Float
x, ImVec2 -> Float
y :: {-# unpack #-} !Float }
  deriving (Int -> ImVec2 -> ShowS
[ImVec2] -> ShowS
ImVec2 -> String
(Int -> ImVec2 -> ShowS)
-> (ImVec2 -> String) -> ([ImVec2] -> ShowS) -> Show ImVec2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImVec2] -> ShowS
$cshowList :: [ImVec2] -> ShowS
show :: ImVec2 -> String
$cshow :: ImVec2 -> String
showsPrec :: Int -> ImVec2 -> ShowS
$cshowsPrec :: Int -> ImVec2 -> ShowS
Show)


instance Storable ImVec2 where
  sizeOf :: ImVec2 -> Int
sizeOf ~ImVec2{Float
x :: Float
$sel:x:ImVec2 :: ImVec2 -> Float
x, Float
y :: Float
$sel:y:ImVec2 :: ImVec2 -> Float
y} = Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
y

  alignment :: ImVec2 -> Int
alignment ImVec2
_ = Int
0

  poke :: Ptr ImVec2 -> ImVec2 -> IO ()
poke Ptr ImVec2
ptr ImVec2{ Float
x :: Float
$sel:x:ImVec2 :: ImVec2 -> Float
x, Float
y :: Float
$sel:y:ImVec2 :: ImVec2 -> Float
y } = do
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec2 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec2
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0)) Float
x
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec2 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec2
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)) Float
y

  peek :: Ptr ImVec2 -> IO ImVec2
peek Ptr ImVec2
ptr = do
    Float
x <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec2 -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec2
ptr                         )
    Float
y <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec2 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec2
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1))
    ImVec2 -> IO ImVec2
forall (m :: * -> *) a. Monad m => a -> m a
return ImVec2{ Float
x :: Float
$sel:x:ImVec2 :: Float
x, Float
y :: Float
$sel:y:ImVec2 :: Float
y  }


data ImVec3 = ImVec3 { ImVec3 -> Float
x, ImVec3 -> Float
y, ImVec3 -> Float
z :: {-# unpack #-} !Float }
  deriving (Int -> ImVec3 -> ShowS
[ImVec3] -> ShowS
ImVec3 -> String
(Int -> ImVec3 -> ShowS)
-> (ImVec3 -> String) -> ([ImVec3] -> ShowS) -> Show ImVec3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImVec3] -> ShowS
$cshowList :: [ImVec3] -> ShowS
show :: ImVec3 -> String
$cshow :: ImVec3 -> String
showsPrec :: Int -> ImVec3 -> ShowS
$cshowsPrec :: Int -> ImVec3 -> ShowS
Show)


instance Storable ImVec3 where
  sizeOf :: ImVec3 -> Int
sizeOf ~ImVec3{Float
x :: Float
$sel:x:ImVec3 :: ImVec3 -> Float
x, Float
y :: Float
$sel:y:ImVec3 :: ImVec3 -> Float
y, Float
z :: Float
$sel:z:ImVec3 :: ImVec3 -> Float
z} = Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
z

  alignment :: ImVec3 -> Int
alignment ImVec3
_ = Int
0

  poke :: Ptr ImVec3 -> ImVec3 -> IO ()
poke Ptr ImVec3
ptr ImVec3{ Float
x :: Float
$sel:x:ImVec3 :: ImVec3 -> Float
x, Float
y :: Float
$sel:y:ImVec3 :: ImVec3 -> Float
y, Float
z :: Float
$sel:z:ImVec3 :: ImVec3 -> Float
z } = do
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec3 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0)) Float
x
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec3 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)) Float
y
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec3 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)) Float
z

  peek :: Ptr ImVec3 -> IO ImVec3
peek Ptr ImVec3
ptr = do
    Float
x <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec3 -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr                         )
    Float
y <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec3 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1))
    Float
z <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec3 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec3
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
    ImVec3 -> IO ImVec3
forall (m :: * -> *) a. Monad m => a -> m a
return ImVec3{ Float
x :: Float
$sel:x:ImVec3 :: Float
x, Float
y :: Float
$sel:y:ImVec3 :: Float
y, Float
z :: Float
$sel:z:ImVec3 :: Float
z }


data ImVec4 = ImVec4 { ImVec4 -> Float
x, ImVec4 -> Float
y, ImVec4 -> Float
z, ImVec4 -> Float
w :: {-# unpack #-} !Float }
  deriving (Int -> ImVec4 -> ShowS
[ImVec4] -> ShowS
ImVec4 -> String
(Int -> ImVec4 -> ShowS)
-> (ImVec4 -> String) -> ([ImVec4] -> ShowS) -> Show ImVec4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImVec4] -> ShowS
$cshowList :: [ImVec4] -> ShowS
show :: ImVec4 -> String
$cshow :: ImVec4 -> String
showsPrec :: Int -> ImVec4 -> ShowS
$cshowsPrec :: Int -> ImVec4 -> ShowS
Show)


instance Storable ImVec4 where
  sizeOf :: ImVec4 -> Int
sizeOf ~ImVec4{Float
x :: Float
$sel:x:ImVec4 :: ImVec4 -> Float
x, Float
y :: Float
$sel:y:ImVec4 :: ImVec4 -> Float
y, Float
z :: Float
$sel:z:ImVec4 :: ImVec4 -> Float
z, Float
w :: Float
$sel:w:ImVec4 :: ImVec4 -> Float
w} = Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
w

  alignment :: ImVec4 -> Int
alignment ImVec4
_ = Int
0

  poke :: Ptr ImVec4 -> ImVec4 -> IO ()
poke Ptr ImVec4
ptr ImVec4{ Float
x :: Float
$sel:x:ImVec4 :: ImVec4 -> Float
x, Float
y :: Float
$sel:y:ImVec4 :: ImVec4 -> Float
y, Float
z :: Float
$sel:z:ImVec4 :: ImVec4 -> Float
z, Float
w :: Float
$sel:w:ImVec4 :: ImVec4 -> Float
w } = do
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0)) Float
x
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)) Float
y
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)) Float
z
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)) Float
w

  peek :: Ptr ImVec4 -> IO ImVec4
peek Ptr ImVec4
ptr = do
    Float
x <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec4 -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr                         )
    Float
y <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1))
    Float
z <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
    Float
w <- Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek (Ptr ImVec4 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImVec4
ptr Ptr Any -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Float -> Int
forall a. Storable a => a -> Int
sizeOf Float
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3))
    ImVec4 -> IO ImVec4
forall (m :: * -> *) a. Monad m => a -> m a
return ImVec4{ Float
x :: Float
$sel:x:ImVec4 :: Float
x, Float
y :: Float
$sel:y:ImVec4 :: Float
y, Float
z :: Float
$sel:z:ImVec4 :: Float
z, Float
w :: Float
$sel:w:ImVec4 :: Float
w }

--------------------------------------------------------------------------------

-- | DearImGui context handle.
data ImGuiContext

-- | Individual font handle.
data ImFont

-- | Font configuration handle.
data ImFontConfig

-- | Glyph ranges builder handle.
data ImFontGlyphRangesBuilder

-- | Opaque DrawList handle.
data ImDrawList

-- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag.
data ImGuiListClipper

-- | A unique ID used by widgets (typically the result of hashing a stack of string)
--   unsigned Integer (same as ImU32)
type ImGuiID = ImU32

-- | 32-bit unsigned integer (often used to store packed colors).
type ImU32 = Word32

type ImS16 = Int16

-- | Single wide character (used mostly in glyph management)
#ifdef IMGUI_USE_WCHAR32
type ImWchar = Word32
#else
type ImWchar = Word16
#endif

--------------------------------------------------------------------------------

-- | Sorting specifications for a table (often handling sort specs for a single column, occasionally more)
--   Obtained by calling TableGetSortSpecs().
--   When @SpecsDirty == true@ you can sort your data. It will be true with sorting specs have changed since last call, or the first time.
--   Make sure to set @SpecsDirty = false@ after sorting, else you may wastefully sort your data every frame!
data ImGuiTableSortSpecs = ImGuiTableSortSpecs
  { ImGuiTableSortSpecs -> Ptr ImGuiTableColumnSortSpecs
specs      :: Ptr ImGuiTableColumnSortSpecs
  , ImGuiTableSortSpecs -> CInt
specsCount :: CInt
  , ImGuiTableSortSpecs -> CBool
specsDirty :: CBool
  } deriving (Int -> ImGuiTableSortSpecs -> ShowS
[ImGuiTableSortSpecs] -> ShowS
ImGuiTableSortSpecs -> String
(Int -> ImGuiTableSortSpecs -> ShowS)
-> (ImGuiTableSortSpecs -> String)
-> ([ImGuiTableSortSpecs] -> ShowS)
-> Show ImGuiTableSortSpecs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImGuiTableSortSpecs] -> ShowS
$cshowList :: [ImGuiTableSortSpecs] -> ShowS
show :: ImGuiTableSortSpecs -> String
$cshow :: ImGuiTableSortSpecs -> String
showsPrec :: Int -> ImGuiTableSortSpecs -> ShowS
$cshowsPrec :: Int -> ImGuiTableSortSpecs -> ShowS
Show, ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool
(ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool)
-> (ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool)
-> Eq ImGuiTableSortSpecs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool
$c/= :: ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool
== :: ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool
$c== :: ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> Bool
Eq)

instance Storable ImGuiTableSortSpecs where
  sizeOf :: ImGuiTableSortSpecs -> Int
sizeOf ImGuiTableSortSpecs
_ =
    Ptr ImGuiTableColumnSortSpecs -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr ImGuiTableColumnSortSpecs
forall a. HasCallStack => a
undefined :: Ptr ImGuiTableColumnSortSpecs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
    CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
    CBool -> Int
forall a. Storable a => a -> Int
sizeOf (CBool
forall a. HasCallStack => a
undefined :: CBool)

  alignment :: ImGuiTableSortSpecs -> Int
alignment ImGuiTableSortSpecs
_ =
    Ptr Any -> Int
forall a. Storable a => a -> Int
alignment Ptr Any
forall a. Ptr a
nullPtr

  poke :: Ptr ImGuiTableSortSpecs -> ImGuiTableSortSpecs -> IO ()
poke Ptr ImGuiTableSortSpecs
ptr ImGuiTableSortSpecs{Ptr ImGuiTableColumnSortSpecs
CInt
CBool
specsDirty :: CBool
specsCount :: CInt
specs :: Ptr ImGuiTableColumnSortSpecs
$sel:specsDirty:ImGuiTableSortSpecs :: ImGuiTableSortSpecs -> CBool
$sel:specsCount:ImGuiTableSortSpecs :: ImGuiTableSortSpecs -> CInt
$sel:specs:ImGuiTableSortSpecs :: ImGuiTableSortSpecs -> Ptr ImGuiTableColumnSortSpecs
..} = do
    let specsPtr :: Ptr b
specsPtr = Ptr ImGuiTableSortSpecs -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ImGuiTableSortSpecs
ptr
    Ptr (Ptr ImGuiTableColumnSortSpecs)
-> Ptr ImGuiTableColumnSortSpecs -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr ImGuiTableColumnSortSpecs)
forall a. Ptr a
specsPtr Ptr ImGuiTableColumnSortSpecs
specs

    let specsCountPtr :: Ptr b
specsCountPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
specsPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr ImGuiTableColumnSortSpecs -> Int
forall a. Storable a => a -> Int
sizeOf Ptr ImGuiTableColumnSortSpecs
specs
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
forall a. Ptr a
specsCountPtr CInt
specsCount

    let specsDirtyPtr :: Ptr b
specsDirtyPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
specsCountPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
specsCount
    Ptr CBool -> CBool -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CBool
forall a. Ptr a
specsDirtyPtr CBool
specsDirty

  peek :: Ptr ImGuiTableSortSpecs -> IO ImGuiTableSortSpecs
peek Ptr ImGuiTableSortSpecs
ptr = do
    let specsPtr :: Ptr b
specsPtr = Ptr ImGuiTableSortSpecs -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ImGuiTableSortSpecs
ptr
    Ptr ImGuiTableColumnSortSpecs
specs <- Ptr (Ptr ImGuiTableColumnSortSpecs)
-> IO (Ptr ImGuiTableColumnSortSpecs)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ImGuiTableColumnSortSpecs)
forall a. Ptr a
specsPtr

    let specsCountPtr :: Ptr b
specsCountPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
specsPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr ImGuiTableColumnSortSpecs -> Int
forall a. Storable a => a -> Int
sizeOf Ptr ImGuiTableColumnSortSpecs
specs
    CInt
specsCount <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
forall a. Ptr a
specsCountPtr

    let specsDirtyPtr :: Ptr b
specsDirtyPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
specsCountPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
specsCount
    CBool
specsDirty <- Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
forall a. Ptr a
specsDirtyPtr

    ImGuiTableSortSpecs -> IO ImGuiTableSortSpecs
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImGuiTableSortSpecs{Ptr ImGuiTableColumnSortSpecs
CInt
CBool
specsDirty :: CBool
specsCount :: CInt
specs :: Ptr ImGuiTableColumnSortSpecs
$sel:specsDirty:ImGuiTableSortSpecs :: CBool
$sel:specsCount:ImGuiTableSortSpecs :: CInt
$sel:specs:ImGuiTableSortSpecs :: Ptr ImGuiTableColumnSortSpecs
..}

-- | Sorting specification for one column of a table
data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs
  { ImGuiTableColumnSortSpecs -> ImGuiID
columnUserID  :: ImGuiID            -- ^ User id of the column (if specified by a TableSetupColumn() call)
  , ImGuiTableColumnSortSpecs -> ImS16
columnIndex   :: ImS16              -- ^ Index of the column
  , ImGuiTableColumnSortSpecs -> ImS16
sortOrder     :: ImS16              -- ^ Index within parent ImGuiTableSortSpecs (always stored in order starting from 0, tables sorted on a single criteria will always have a 0 here)
  , ImGuiTableColumnSortSpecs -> ImGuiSortDirection
sortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending'
  } deriving (Int -> ImGuiTableColumnSortSpecs -> ShowS
[ImGuiTableColumnSortSpecs] -> ShowS
ImGuiTableColumnSortSpecs -> String
(Int -> ImGuiTableColumnSortSpecs -> ShowS)
-> (ImGuiTableColumnSortSpecs -> String)
-> ([ImGuiTableColumnSortSpecs] -> ShowS)
-> Show ImGuiTableColumnSortSpecs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImGuiTableColumnSortSpecs] -> ShowS
$cshowList :: [ImGuiTableColumnSortSpecs] -> ShowS
show :: ImGuiTableColumnSortSpecs -> String
$cshow :: ImGuiTableColumnSortSpecs -> String
showsPrec :: Int -> ImGuiTableColumnSortSpecs -> ShowS
$cshowsPrec :: Int -> ImGuiTableColumnSortSpecs -> ShowS
Show, ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool
(ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool)
-> (ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool)
-> Eq ImGuiTableColumnSortSpecs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool
$c/= :: ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool
== :: ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool
$c== :: ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> Bool
Eq)

instance Storable ImGuiTableColumnSortSpecs where
  sizeOf :: ImGuiTableColumnSortSpecs -> Int
sizeOf ImGuiTableColumnSortSpecs
_ = Int
12
  alignment :: ImGuiTableColumnSortSpecs -> Int
alignment ImGuiTableColumnSortSpecs
_ = Int
4

  poke :: Ptr ImGuiTableColumnSortSpecs -> ImGuiTableColumnSortSpecs -> IO ()
poke Ptr ImGuiTableColumnSortSpecs
ptr ImGuiTableColumnSortSpecs{ImS16
ImGuiID
ImGuiSortDirection
sortDirection :: ImGuiSortDirection
sortOrder :: ImS16
columnIndex :: ImS16
columnUserID :: ImGuiID
$sel:sortDirection:ImGuiTableColumnSortSpecs :: ImGuiTableColumnSortSpecs -> ImGuiSortDirection
$sel:sortOrder:ImGuiTableColumnSortSpecs :: ImGuiTableColumnSortSpecs -> ImS16
$sel:columnIndex:ImGuiTableColumnSortSpecs :: ImGuiTableColumnSortSpecs -> ImS16
$sel:columnUserID:ImGuiTableColumnSortSpecs :: ImGuiTableColumnSortSpecs -> ImGuiID
..} = do
    let columnUserIDPtr :: Ptr b
columnUserIDPtr = Ptr ImGuiTableColumnSortSpecs -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ImGuiTableColumnSortSpecs
ptr
    Ptr ImGuiID -> ImGuiID -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ImGuiID
forall a. Ptr a
columnUserIDPtr ImGuiID
columnUserID

    let columnIndexPtr :: Ptr b
columnIndexPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
columnUserIDPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImGuiID -> Int
forall a. Storable a => a -> Int
sizeOf ImGuiID
columnUserID
    Ptr ImS16 -> ImS16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ImS16
forall a. Ptr a
columnIndexPtr ImS16
columnIndex

    let sortOrderPtr :: Ptr b
sortOrderPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
columnIndexPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImS16 -> Int
forall a. Storable a => a -> Int
sizeOf ImS16
columnIndex
    Ptr ImS16 -> ImS16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ImS16
forall a. Ptr a
sortOrderPtr ImS16
sortOrder

    let sortDirectionPtr :: Ptr b
sortDirectionPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
sortOrderPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImS16 -> Int
forall a. Storable a => a -> Int
sizeOf ImS16
sortOrder
    Ptr ImGuiSortDirection -> ImGuiSortDirection -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ImGuiSortDirection
forall a. Ptr a
sortDirectionPtr ImGuiSortDirection
sortDirection

  peek :: Ptr ImGuiTableColumnSortSpecs -> IO ImGuiTableColumnSortSpecs
peek Ptr ImGuiTableColumnSortSpecs
ptr = do
    let columnUserIDPtr :: Ptr b
columnUserIDPtr = Ptr ImGuiTableColumnSortSpecs -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ImGuiTableColumnSortSpecs
ptr
    ImGuiID
columnUserID <- Ptr ImGuiID -> IO ImGuiID
forall a. Storable a => Ptr a -> IO a
peek Ptr ImGuiID
forall a. Ptr a
columnUserIDPtr

    let columnIndexPtr :: Ptr b
columnIndexPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
columnUserIDPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImGuiID -> Int
forall a. Storable a => a -> Int
sizeOf ImGuiID
columnUserID
    ImS16
columnIndex <- Ptr ImS16 -> IO ImS16
forall a. Storable a => Ptr a -> IO a
peek Ptr ImS16
forall a. Ptr a
columnIndexPtr

    let sortOrderPtr :: Ptr b
sortOrderPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
columnIndexPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImS16 -> Int
forall a. Storable a => a -> Int
sizeOf ImS16
columnIndex
    ImS16
sortOrder <- Ptr ImS16 -> IO ImS16
forall a. Storable a => Ptr a -> IO a
peek Ptr ImS16
forall a. Ptr a
sortOrderPtr

    let sortDirectionPtr :: Ptr b
sortDirectionPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr b) -> Ptr Any -> Ptr b
forall a b. (a -> b) -> a -> b
$ Ptr Any
forall a. Ptr a
sortOrderPtr Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ImS16 -> Int
forall a. Storable a => a -> Int
sizeOf ImS16
sortOrder
    CInt
sortDirection' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
forall a. Ptr a
sortDirectionPtr :: IO CInt
    -- XXX: Specs struct uses trimmed field: @SortDirection : 8@
    let sortDirection :: ImGuiSortDirection
sortDirection = case CInt
sortDirection' CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0xFF of
          CInt
0 ->
            ImGuiSortDirection
ImGuiSortDirection_None
          CInt
1 ->
            ImGuiSortDirection
ImGuiSortDirection_Ascending
          CInt
2 ->
            ImGuiSortDirection
ImGuiSortDirection_Descending
          CInt
_ ->
            String -> ImGuiSortDirection
forall a. HasCallStack => String -> a
error (String -> ImGuiSortDirection) -> String -> ImGuiSortDirection
forall a b. (a -> b) -> a -> b
$ String
"Unexpected value for ImGuiSortDirection: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ImGuiSortDirection -> String
forall a. Show a => a -> String
show ImGuiSortDirection
sortDirection

    ImGuiTableColumnSortSpecs -> IO ImGuiTableColumnSortSpecs
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImGuiTableColumnSortSpecs{ImS16
ImGuiID
ImGuiSortDirection
sortDirection :: ImGuiSortDirection
sortOrder :: ImS16
columnIndex :: ImS16
columnUserID :: ImGuiID
$sel:sortDirection:ImGuiTableColumnSortSpecs :: ImGuiSortDirection
$sel:sortOrder:ImGuiTableColumnSortSpecs :: ImS16
$sel:columnIndex:ImGuiTableColumnSortSpecs :: ImS16
$sel:columnUserID:ImGuiTableColumnSortSpecs :: ImGuiID
..}