diff --git a/examples/glfw/Main.hs b/examples/glfw/Main.hs index 08148d8..5f0f8ee 100644 --- a/examples/glfw/Main.hs +++ b/examples/glfw/Main.hs @@ -1,6 +1,7 @@ {-# language BlockArguments #-} {-# language LambdaCase #-} {-# language OverloadedStrings #-} +{-# language RecordWildCards #-} module Main ( main ) where @@ -8,6 +9,11 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.Managed +import Data.Bits ((.|.)) +import Data.IORef +import Data.List (sortBy) +import Data.Foldable (traverse_) + import DearImGui import DearImGui.OpenGL2 import DearImGui.GLFW @@ -40,14 +46,23 @@ main = do -- Initialize ImGui's OpenGL backend _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown - liftIO $ mainLoop win + tableRef <- liftIO $ newIORef + [ (1, "foo") + , (2, "bar") + , (3, "baz") + , (10, "spam") + , (11, "spam") + , (12, "spam") + ] + + liftIO $ mainLoop win tableRef Nothing -> do error "GLFW createWindow failed" GLFW.terminate -mainLoop :: Window -> IO () -mainLoop win = do +mainLoop :: Window -> IORef [(Integer, String)] -> IO () +mainLoop win tableRef = do -- Process the event loop GLFW.pollEvents close <- GLFW.windowShouldClose win @@ -73,8 +88,9 @@ mainLoop win = do when clicked $ closeCurrentPopup - -- Show the ImGui demo window - showDemoWindow + newLine + + mkTable tableRef -- Render glClear GL_COLOR_BUFFER_BIT @@ -84,4 +100,41 @@ mainLoop win = do GLFW.swapBuffers win - mainLoop win + mainLoop win tableRef + +mkTable :: IORef [(Integer, String)] -> IO () +mkTable tableRef = + withTableOpen sortable "MyTable" 3 $ do + tableSetupColumn "Hello" + tableSetupColumnWith defTableColumnOptions "World" + + withSortableTable \isDirty sortSpecs -> + when (isDirty && not (null sortSpecs)) do + -- XXX: do your sorting & cache it. Dont sort every frame. + putStrLn "So dirty!" + print sortSpecs + modifyIORef' tableRef . sortBy $ + foldMap mkCompare sortSpecs + + tableHeadersRow + readIORef tableRef >>= + traverse_ \(ix, title) -> do + tableNextRow + tableNextColumn $ text (show ix) + tableNextColumn $ text title + tableNextColumn $ void (button "♥") + where + mkCompare TableSortingSpecs{..} a b = + let + dir = if tableSortingReverse then flip else id + in + case tableSortingColumn of + 0 -> dir compare (fst a) (fst b) + 1 -> dir compare (snd a) (snd b) + _ -> EQ + + sortable = defTableOptions + { tableFlags = + ImGuiTableFlags_Sortable .|. + ImGuiTableFlags_SortMulti + } diff --git a/src/DearImGui.hs b/src/DearImGui.hs index b9407ec..86add16 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -8,6 +8,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-| @@ -184,28 +185,38 @@ module DearImGui , colorButton -- ** Tables - , beginTable - , Raw.endTable , withTable + , withTableOpen , TableOptions(..) , defTableOptions + , beginTable + , Raw.endTable + + -- *** Setup + , tableSetupColumn + , tableSetupColumnWith + , TableColumnOptions(..) + , defTableColumnOptions + + , Raw.tableHeadersRow + , Raw.tableHeader + , tableSetupScrollFreeze + + -- *** Rows , tableNextRow , tableNextRowWith , TableRowOptions(..) , defTableRowOptions - , Raw.tableNextColumn + + -- *** Columns + , tableNextColumn , tableSetColumnIndex - , tableSetupColumn - , TableColumnOptions(..) - , defTableColumnOptions - , tableSetupScrollFreeze - , Raw.tableHeadersRow - , Raw.tableHeader - + -- *** Sorting , withSortableTable , TableSortingSpecs(..) + -- *** Queries , tableGetColumnCount , tableGetColumnIndex , tableGetRowIndex @@ -1306,20 +1317,23 @@ colorButton desc ref = liftIO do return changed data TableOptions = TableOptions - { tableFlags :: ImGuiTableFlags - , outerSize :: ImVec2 - , innerWidth :: Float - } deriving Show + { tableFlags :: ImGuiTableFlags + , tableOuterSize :: ImVec2 + , tableInnerWidth :: Float + } deriving Show defTableOptions :: TableOptions -defTableOptions = TableOptions (ImGuiTableFlags 0) (ImVec2 0 0) 0 - +defTableOptions = TableOptions + { tableFlags = ImGuiTableFlags_None + , tableOuterSize = ImVec2 0 0 + , tableInnerWidth = 0 + } -- | Wraps @ImGui::BeginTable()@. beginTable :: MonadIO m => TableOptions -> String -> Int -> m Bool -beginTable (TableOptions flags outer inner) label columns = liftIO do - withCString label $ \l -> - with outer $ \o -> - Raw.beginTable l (fromIntegral columns) flags o (CFloat inner) +beginTable TableOptions{..} label columns = liftIO do + withCString label \labelPtr -> + with tableOuterSize \outerSizePtr -> + Raw.beginTable labelPtr (fromIntegral columns) tableFlags outerSizePtr (CFloat tableInnerWidth) -- | Create a table. -- @@ -1327,16 +1341,15 @@ beginTable (TableOptions flags outer inner) label columns = liftIO do -- -- ==== __Example usage:__ -- --- > withTable defTableOptions "MyTable" 2 $ \case --- > False -> return () --- > True -> do --- > tableSetupColumn "Hello" --- > tableSetupColumn "World" --- > tableHeadersRow --- > forM_ [("a","1"),("b","2")] $\(a,b) --- > tableNextRow --- > whenM tableNextColumn (text a) --- > whenM tableNextColumn (text b) +-- > withTableOpen defTableOptions "MyTable" do +-- > tableSetupColumn "Hello" +-- > tableSetupColumn "World" +-- > tableHeadersRow +-- > +-- > for_ [("a","1"),("b","2")] \(a,b) -> do +-- > tableNextRow +-- > tableNextColumn (text a) +-- > tableNextColumn (text b) -- -- Displays: -- @@ -1351,23 +1364,33 @@ withTable :: MonadUnliftIO m => TableOptions -> String -> Int -> (Bool -> m a) - withTable options label columns = bracket (beginTable options label columns) (`when` Raw.endTable) +withTableOpen :: MonadUnliftIO m => TableOptions -> String -> Int -> m () -> m () +withTableOpen options label columns action = + withTable options label columns (`when` action) + -- | Wraps @ImGui::TableNextRow()@ with 'defTableRowOptions'. -- append into the first cell of a new row. tableNextRow :: MonadIO m => m () tableNextRow = tableNextRowWith defTableRowOptions data TableRowOptions = TableRowOptions - { tableRowFlags :: ImGuiTableRowFlags - , minRowHeight :: Float - } deriving Show + { tableRowFlags :: ImGuiTableRowFlags + , tableRowMinHeight :: Float + } deriving Show defTableRowOptions :: TableRowOptions -defTableRowOptions = TableRowOptions (ImGuiTableRowFlags 0) 0 +defTableRowOptions = TableRowOptions + { tableRowFlags = ImGuiTableRowFlags_None + , tableRowMinHeight = 0 + } -- | Wraps @ImGui::TableNextRow()@ with explicit options. tableNextRowWith :: MonadIO m => TableRowOptions -> m () -tableNextRowWith (TableRowOptions flags minHeight) = liftIO do - Raw.tableNextRow flags (CFloat minHeight) +tableNextRowWith TableRowOptions{..} = liftIO do + Raw.tableNextRow tableRowFlags (CFloat tableRowMinHeight) + +tableNextColumn :: MonadIO m => m () -> m () +tableNextColumn action = Raw.tableNextColumn >>= (`when` action) -- | Wraps @ImGui::TableSetColumnIndex()@. -- append into the specified column. Return true when column is visible. @@ -1375,15 +1398,18 @@ tableSetColumnIndex :: MonadIO m => Int -> m Bool tableSetColumnIndex column = liftIO do Raw.tableSetColumnIndex (fromIntegral column) - data TableColumnOptions = TableColumnOptions - { tableColumnFlags :: ImGuiTableColumnFlags - , initWidthOrWeight :: Float - , userId :: ImGuiID - } deriving Show + { tableColumnFlags :: ImGuiTableColumnFlags + , tableColumnInitWidthOrWeight :: Float + , tableColumnUserId :: ImGuiID + } deriving Show defTableColumnOptions :: TableColumnOptions -defTableColumnOptions = TableColumnOptions (ImGuiTableColumnFlags 0) 0 0 +defTableColumnOptions = TableColumnOptions + { tableColumnFlags = ImGuiTableColumnFlags_None + , tableColumnInitWidthOrWeight = 0 + , tableColumnUserId = 0 + } -- | Wraps @ImGui::TableSetupColumn()@ using 'defTableColumnOptions'. tableSetupColumn :: MonadIO m => String -> m () @@ -1391,9 +1417,9 @@ tableSetupColumn = tableSetupColumnWith defTableColumnOptions -- | Wraps @ImGui::TableSetupColumn() with explicit options@. tableSetupColumnWith :: MonadIO m => TableColumnOptions -> String -> m () -tableSetupColumnWith (TableColumnOptions flags weight userId) label = liftIO do - withCString label $ \l -> - Raw.tableSetupColumn l flags (CFloat weight) userId +tableSetupColumnWith TableColumnOptions{..} label = liftIO do + withCString label \labelPtr -> + Raw.tableSetupColumn labelPtr tableColumnFlags (CFloat tableColumnInitWidthOrWeight) tableColumnUserId -- | Wraps @ImGui::TableSetupScrollFreeze()@. -- lock columns/rows so they stay visible when scrolled. @@ -1402,12 +1428,18 @@ tableSetupScrollFreeze cols rows = liftIO do Raw.tableSetupScrollFreeze (fromIntegral cols) (fromIntegral rows) data TableSortingSpecs = TableSortingSpecs - { tableSortingId :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call) - , tableSortingColumn :: Int -- ^ Index of the column, starting at 0 - , dableSortingOrder :: Int -- ^ Index within parent ImGuiTableSortSpecs (always stored in order starting from 0, tables sorted on a single criteria will always have a 0 here). - -- On 'ImGuiTableFlags_SortMulti' this is the order in which should be sorted. - , tableSortingDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending'. Should not be 'ImGuiSortDirection_None' - } deriving (Show, Eq) + { tableSortingColumn :: Int -- ^ Index of the column, starting at 0 + , tableSortingReverse :: Bool + , tableSortingUserId :: ImGuiID -- ^ User id of the column (if specified by a 'tableSetupColumn' call). + } deriving (Eq, Ord, Show) + +convertTableSortingSpecs :: ImGuiTableColumnSortSpecs -> TableSortingSpecs +convertTableSortingSpecs ImGuiTableColumnSortSpecs{..} = + TableSortingSpecs + { tableSortingColumn = fromIntegral columnIndex + , tableSortingReverse = sortDirection == ImGuiSortDirection_Descending + , tableSortingUserId = columnUserID + } -- | High-Level sorting. Returns of the underlying data should be sorted -- and to what specification. Number of Specifications is mostly 0 or 1, but @@ -1423,46 +1455,50 @@ data TableSortingSpecs = TableSortingSpecs -- -- ==== __Example usage:__ -- --- > withTable defTableOptions "MyTable" 2 $ \case --- > False -> return () --- > True -> do --- > tableSetupColumn "Hello" --- > tableSetupColumn "World" --- > withSortableTable $ \(mustSort, sortSpecs) do --- > when mustSort $ --- > -- ... do your sorting here & cache it. Dont sort every frame. +-- > sortedData <- newIORef [("a","1"), ("b","2")] +-- > +-- > let sortable = defTableOptions { tableFlags = ImGuiTableFlags_Sortable } +-- > withTableOpen sortable "MyTable" 2 $ do +-- > tableSetupColumn "Hello" +-- > tableSetupColumn "World" +-- > +-- > withSortableTable \isDirty sortSpecs -> do +-- > when isDirty $ +-- > -- XXX: do your sorting & cache it. Dont sort every frame. +-- > modifyIORef' sortedData . sortBy $ +-- > foldMap columnSorter sortSpecs +-- > -- > tableHeadersRow --- > forM_ [("a","1"),("b","2")] $\(a,b) -- use sorted data here. +-- > for_ sortedData \(a, b) -> do -- > tableNextRow --- > whenM tableNextColumn (text a) --- > whenM tableNextColumn (text b) -withSortableTable :: MonadIO m => ((Bool,[TableSortingSpecs]) -> m a) -> m a +-- > tableNextColumn $ text a +-- > tableNextColumn $ text b +withSortableTable :: MonadIO m => (Bool -> [TableSortingSpecs] -> m ()) -> m () withSortableTable action = do - specsPtr <- liftIO $ Raw.tableGetSortSpecs - case specsPtr of - Nothing -> action (False, []) - Just ptr -> do - specs <- liftIO $ peek ptr - cSpecs <- liftIO $ peekArray (fromIntegral $ imGuiTableSortSpecsCount specs) (imGuiTableColumnSortSpecs specs) + liftIO Raw.tableGetSortSpecs >>= \case + Nothing -> + -- XXX: The table is not sortable + pure () - -- just map singed 16-bit-int to something nice for the end-user - let cSpecs' = (\(ImGuiTableColumnSortSpecs a b c d) -> TableSortingSpecs a (fromIntegral b) (fromIntegral c) d) <$> cSpecs + Just specsPtr -> do + ImGuiTableSortSpecs{..} <- liftIO $ peek specsPtr + let isDirty = 0 /= specsDirty + columns <- liftIO $ peekArray (fromIntegral specsCount) specs - result <- action (imGuiTableSortSpecsDirty specs /= 0, cSpecs') - -- set dirty to 0 after everything is done. - liftIO $ poke (ptr `plusPtr` (sizeOf (imGuiTableColumnSortSpecs specs)) `plusPtr` (sizeOf (imGuiTableSortSpecsCount specs))) (0 :: CInt) - return result + action isDirty (map convertTableSortingSpecs columns) + when isDirty $ + Raw.tableClearSortSpecsDirty specsPtr -- | Wraps @ImGui::TableGetColumnCount()@. -- return number of columns (value passed to BeginTable) tableGetColumnCount :: MonadIO m => m Int -tableGetColumnCount = +tableGetColumnCount = fromIntegral <$> Raw.tableGetColumnCount -- | Wraps @ImGui::TableGetColumnIndex()@. -- return current column index. tableGetColumnIndex :: MonadIO m => m Int -tableGetColumnIndex = +tableGetColumnIndex = fromIntegral <$> Raw.tableGetColumnIndex -- | Wraps @ImGui::TableGetRowIndex()@. @@ -1520,19 +1556,23 @@ selectable :: MonadIO m => String -> m Bool selectable = selectableWith defSelectableOptions data SelectableOptions = SelectableOptions - { selected :: Bool - , flags :: ImGuiSelectableFlags - , size :: ImVec2 - } deriving Show + { selected :: Bool + , flags :: ImGuiSelectableFlags + , size :: ImVec2 + } deriving Show defSelectableOptions :: SelectableOptions -defSelectableOptions = SelectableOptions False (ImGuiSelectableFlags 0) (ImVec2 0 0) +defSelectableOptions = SelectableOptions + { selected = False + , flags = ImGuiSelectableFlags_None + , size = ImVec2 0 0 + } -- | Wraps @ImGui::Selectable()@ with explicit options. selectableWith :: MonadIO m => SelectableOptions -> String -> m Bool selectableWith (SelectableOptions selected flags size) label = liftIO do - with size $ \sizePtr -> - withCString label $ \labelPtr -> + with size \sizePtr -> + withCString label \labelPtr -> Raw.selectable labelPtr (bool 0 1 selected) flags sizePtr diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs index 86a8795..72e2cd1 100644 --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} @@ -163,13 +164,14 @@ module DearImGui.Raw , tableNextRow , tableNextColumn , tableSetColumnIndex - + , tableSetupColumn , tableSetupScrollFreeze , tableHeadersRow , tableHeader - + , tableGetSortSpecs + , tableClearSortSpecsDirty , tableGetColumnCount , tableGetColumnIndex @@ -1096,7 +1098,7 @@ beginTable labelPtr column flags outerSizePtr innerWidth = liftIO do (0 /=) <$> [C.exp| bool { BeginTable($(char* labelPtr), $(int column), $(ImGuiTableFlags flags), *$(ImVec2* outerSizePtr), $(float innerWidth)) } |] -- | Only call 'endTable' if 'beginTable' returns true! --- +-- -- Wraps @ImGui::EndTable()@. endTable :: MonadIO m => m () endTable = liftIO do @@ -1165,6 +1167,12 @@ tableGetSortSpecs = liftIO do else return $ Just ptr +tableClearSortSpecsDirty :: MonadIO m => Ptr ImGuiTableSortSpecs -> m () +tableClearSortSpecsDirty specsPtr = liftIO do + [C.block| void { + $(ImGuiTableSortSpecs* specsPtr)->SpecsDirty = false; + } |] + -- | Wraps @ImGui::TableGetColumnCount()@. tableGetColumnCount :: MonadIO m => m CInt tableGetColumnCount = liftIO do diff --git a/src/DearImGui/Structs.hs b/src/DearImGui/Structs.hs index 17b02cb..15a086b 100644 --- a/src/DearImGui/Structs.hs +++ b/src/DearImGui/Structs.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module DearImGui.Structs where @@ -13,11 +14,12 @@ import Data.Word ) import Foreign - ( Storable(..), castPtr, plusPtr, Ptr, Int16 ) + ( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr ) import Foreign.C ( CInt, CBool ) import DearImGui.Enums +import Data.Bits ((.&.)) -------------------------------------------------------------------------------- data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float } @@ -104,7 +106,7 @@ data ImGuiListClipper -- | A unique ID used by widgets (typically the result of hashing a stack of string) -- unsigned Integer (same as ImU32) -type ImGuiID = Word32 +type ImGuiID = ImU32 -- | 32-bit unsigned integer (often used to store packed colors). type ImU32 = Word32 @@ -125,62 +127,88 @@ type ImWchar = Word16 -- 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 - { imGuiTableColumnSortSpecs :: Ptr ImGuiTableColumnSortSpecs - , imGuiTableSortSpecsCount :: CInt - , imGuiTableSortSpecsDirty :: CBool - } + { specs :: Ptr ImGuiTableColumnSortSpecs + , specsCount :: CInt + , specsDirty :: CBool + } deriving (Show, Eq) instance Storable ImGuiTableSortSpecs where - sizeOf _ = sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) - + sizeOf (undefined :: CInt) - + sizeOf (undefined :: CBool) + sizeOf _ = + sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) + + sizeOf (undefined :: CInt) + + sizeOf (undefined :: CBool) - alignment _ = 0 + alignment _ = + alignment nullPtr - poke ptr (ImGuiTableSortSpecs s c d) = do - poke ( castPtr ptr ) s - poke ( castPtr ptr `plusPtr` sizeOf s) c - poke ((castPtr ptr `plusPtr` sizeOf s) - `plusPtr` sizeOf c) d + poke ptr ImGuiTableSortSpecs{..} = do + let specsPtr = castPtr ptr + poke specsPtr specs + + let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs + poke specsCountPtr specsCount + + let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount + poke specsDirtyPtr specsDirty peek ptr = do - s <- peek ( castPtr ptr ) - c <- peek ( castPtr ptr `plusPtr` sizeOf s) - d <- peek ((castPtr ptr `plusPtr` sizeOf s) - `plusPtr` sizeOf c) - return (ImGuiTableSortSpecs s c d) + let specsPtr = castPtr ptr + specs <- peek specsPtr + + let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs + specsCount <- peek specsCountPtr + + let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount + specsDirty <- peek specsDirtyPtr + + pure ImGuiTableSortSpecs{..} -- | Sorting specification for one column of a table data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs - { imGuiTableColumnSortUserID :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call) - , imGuiTableColumnSortColumnIndex :: ImS16 -- ^ Index of the column - , imGuiTableColumnSortOrder :: ImS16 -- ^ Index within parent ImGuiTableSortSpecs (always stored in order starting from 0, tables sorted on a single criteria will always have a 0 here) - , imGuiTableColumnSortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending' - } deriving (Show, Eq) + { columnUserID :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call) + , columnIndex :: ImS16 -- ^ Index of the column + , 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) + , sortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending' + } deriving (Show, Eq) instance Storable ImGuiTableColumnSortSpecs where - sizeOf _ = sizeOf (undefined :: ImGuiID) - + sizeOf (undefined :: ImS16) - + sizeOf (undefined :: ImS16) - + sizeOf (undefined :: ImGuiSortDirection) + sizeOf _ = 12 + alignment _ = 4 - alignment _ = 0 + poke ptr ImGuiTableColumnSortSpecs{..} = do + let columnUserIDPtr = castPtr ptr + poke columnUserIDPtr columnUserID - poke ptr (ImGuiTableColumnSortSpecs a b c d) = do - poke ( castPtr ptr ) a - poke ( castPtr ptr `plusPtr` sizeOf a) b - poke (( castPtr ptr `plusPtr` sizeOf a) - `plusPtr` sizeOf b) c - poke (((castPtr ptr `plusPtr` sizeOf a) - `plusPtr` sizeOf b) - `plusPtr` sizeOf c) d + let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID + poke columnIndexPtr columnIndex + + let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex + poke sortOrderPtr sortOrder + + let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder + poke sortDirectionPtr sortDirection peek ptr = do - a <- peek ( castPtr ptr ) - b <- peek ( castPtr ptr `plusPtr` sizeOf a) - c <- peek (( castPtr ptr `plusPtr` sizeOf a) - `plusPtr` sizeOf b) - d <- peek (((castPtr ptr `plusPtr` sizeOf a) - `plusPtr` sizeOf b) - `plusPtr` sizeOf c) - return (ImGuiTableColumnSortSpecs a b c d) + let columnUserIDPtr = castPtr ptr + columnUserID <- peek columnUserIDPtr + + let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID + columnIndex <- peek columnIndexPtr + + let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex + sortOrder <- peek sortOrderPtr + + let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder + sortDirection' <- peek sortDirectionPtr :: IO CInt + -- XXX: Specs struct uses trimmed field: @SortDirection : 8@ + let sortDirection = case sortDirection' .&. 0xFF of + 0 -> + ImGuiSortDirection_None + 1 -> + ImGuiSortDirection_Ascending + 2 -> + ImGuiSortDirection_Descending + _ -> + error $ "Unexpected value for ImGuiSortDirection: " <> show sortDirection + + pure ImGuiTableColumnSortSpecs{..}