{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

module DearImGui.Structs where

-- base
import Data.Word
  ( Word32, Word16 )
import Foreign
  ( Storable(..), castPtr, plusPtr )

--------------------------------------------------------------------------------
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 -> Float -> ImVec2
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 -> Float -> Float -> ImVec3
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 -> Float -> Float -> Float -> ImVec4
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

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

-- | Single wide character (used mostly in glyph management)
type ImWchar = Word16
-- FIXME: consider IMGUI_USE_WCHAR32