From e5969f6b358dab01d9e2bea8d3538fdfbee0c2f1 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 11 Mar 2022 14:48:11 +0100 Subject: [PATCH] implementation of ImGui Tables (#135) --- src/DearImGui.hs | 228 +++++++++++++++++++++++++++++++++++++++ src/DearImGui/Context.hs | 2 + src/DearImGui/Raw.hs | 138 ++++++++++++++++++++++++ src/DearImGui/Structs.hs | 79 +++++++++++++- 4 files changed, 446 insertions(+), 1 deletion(-) diff --git a/src/DearImGui.hs b/src/DearImGui.hs index e4e15cc..b9407ec 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -183,6 +183,37 @@ module DearImGui , colorPicker3 , colorButton + -- ** Tables + , beginTable + , Raw.endTable + , withTable + , TableOptions(..) + , defTableOptions + , tableNextRow + , tableNextRowWith + , TableRowOptions(..) + , defTableRowOptions + , Raw.tableNextColumn + , tableSetColumnIndex + + , tableSetupColumn + , TableColumnOptions(..) + , defTableColumnOptions + , tableSetupScrollFreeze + , Raw.tableHeadersRow + , Raw.tableHeader + + , withSortableTable + , TableSortingSpecs(..) + + , tableGetColumnCount + , tableGetColumnIndex + , tableGetRowIndex + , tableGetColumnName + , tableGetColumnFlags + , tableSetColumnEnabled + , tableSetBgColor + -- ** Trees , treeNode , treePush @@ -1274,6 +1305,203 @@ colorButton desc ref = liftIO do return changed +data TableOptions = TableOptions + { tableFlags :: ImGuiTableFlags + , outerSize :: ImVec2 + , innerWidth :: Float + } deriving Show + +defTableOptions :: TableOptions +defTableOptions = TableOptions (ImGuiTableFlags 0) (ImVec2 0 0) 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) + +-- | Create a table. +-- +-- The action will get 'False' if the entry is not visible. +-- +-- ==== __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) +-- +-- Displays: +-- +-- @ +-- | Hello | World | +-- +-------+-------+ +-- | a | 1 | +-- | b | 2 | +-- @ +-- +withTable :: MonadUnliftIO m => TableOptions -> String -> Int -> (Bool -> m a) -> m a +withTable options label columns = + bracket (beginTable options label columns) (`when` Raw.endTable) + +-- | 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 + +defTableRowOptions :: TableRowOptions +defTableRowOptions = TableRowOptions (ImGuiTableRowFlags 0) 0 + +-- | Wraps @ImGui::TableNextRow()@ with explicit options. +tableNextRowWith :: MonadIO m => TableRowOptions -> m () +tableNextRowWith (TableRowOptions flags minHeight) = liftIO do + Raw.tableNextRow flags (CFloat minHeight) + +-- | Wraps @ImGui::TableSetColumnIndex()@. +-- append into the specified column. Return true when column is visible. +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 + +defTableColumnOptions :: TableColumnOptions +defTableColumnOptions = TableColumnOptions (ImGuiTableColumnFlags 0) 0 0 + +-- | Wraps @ImGui::TableSetupColumn()@ using 'defTableColumnOptions'. +tableSetupColumn :: MonadIO m => String -> m () +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 + +-- | Wraps @ImGui::TableSetupScrollFreeze()@. +-- lock columns/rows so they stay visible when scrolled. +tableSetupScrollFreeze :: MonadIO m => Int -> Int -> m () +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) + +-- | High-Level sorting. Returns of the underlying data should be sorted +-- and to what specification. Number of Specifications is mostly 0 or 1, but +-- can be more if 'ImGuiTableFlags_SortMulti' is enabled on the table. +-- +-- The Bool only fires true for one frame on each sorting event and resets +-- automatically. +-- +-- Must be called AFTER all columns are set up with 'tableSetupColumn' +-- +-- Hint: Don't forget to set 'ImGuiTableFlags_Sortable' to enable sorting +-- on tables. +-- +-- ==== __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. +-- > tableHeadersRow +-- > forM_ [("a","1"),("b","2")] $\(a,b) -- use sorted data here. +-- > tableNextRow +-- > whenM tableNextColumn (text a) +-- > whenM tableNextColumn (text b) +withSortableTable :: MonadIO m => ((Bool,[TableSortingSpecs]) -> m a) -> m a +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) + + -- 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 + + 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 + +-- | Wraps @ImGui::TableGetColumnCount()@. +-- return number of columns (value passed to BeginTable) +tableGetColumnCount :: MonadIO m => m Int +tableGetColumnCount = + fromIntegral <$> Raw.tableGetColumnCount + +-- | Wraps @ImGui::TableGetColumnIndex()@. +-- return current column index. +tableGetColumnIndex :: MonadIO m => m Int +tableGetColumnIndex = + fromIntegral <$> Raw.tableGetColumnIndex + +-- | Wraps @ImGui::TableGetRowIndex()@. +-- return current row index +tableGetRowIndex :: MonadIO m => m Int +tableGetRowIndex = + fromIntegral <$> Raw.tableGetRowIndex + +-- | Wraps @ImGui::TableGetColumnName +-- returns "" if column didn't have a name declared by TableSetupColumn +-- 'Nothing' returns the current column name +tableGetColumnName :: MonadIO m => Maybe Int -> m String +tableGetColumnName c = liftIO do + Raw.tableGetColumnName (fromIntegral <$> c) >>= peekCString + +-- | Wraps @ImGui::TableGetRowIndex()@. +-- return column flags so you can query their Enabled/Visible/Sorted/Hovered +-- status flags. +-- 'Nothing' returns the current column flags +tableGetColumnFlags :: MonadIO m => Maybe Int -> m ImGuiTableColumnFlags +tableGetColumnFlags = + Raw.tableGetColumnFlags . fmap fromIntegral + +-- | Wraps @ImGui::TableSetColumnEnabled()@. +-- change user accessible enabled/disabled state of a column. Set to false to +-- hide the column. User can use the context menu to change this themselves +-- (right-click in headers, or right-click in columns body with +-- 'ImGuiTableFlags_ContextMenuInBody') +tableSetColumnEnabled :: MonadIO m => Int -> Bool -> m () +tableSetColumnEnabled column_n v = + Raw.tableSetColumnEnabled (fromIntegral column_n) (bool 0 1 v) + +-- | Wraps @ImGui::TableSetBgColor()@. +-- change the color of a cell, row, or column. +-- See 'ImGuiTableBgTarget' flags for details. +-- 'Nothing' sets the current row/column color +tableSetBgColor :: MonadIO m => ImGuiTableBgTarget -> ImU32 -> Maybe Int -> m () +tableSetBgColor target color column_n = + Raw.tableSetBgColor target color (fromIntegral <$> column_n) -- | Wraps @ImGui::TreeNode()@. treeNode :: MonadIO m => String -> m Bool diff --git a/src/DearImGui/Context.hs b/src/DearImGui/Context.hs index 1c91a60..bd32724 100644 --- a/src/DearImGui/Context.hs +++ b/src/DearImGui/Context.hs @@ -34,6 +34,7 @@ imguiContext = mempty , ( TypeName "ImVec3", [t| ImVec3 |] ) , ( TypeName "ImVec4", [t| ImVec4 |] ) , ( TypeName "ImU32", [t| ImU32 |] ) + , ( TypeName "ImGuiID", [t| ImGuiID |] ) , ( TypeName "ImWchar", [t| ImWchar |] ) , ( TypeName "ImDrawList", [t| ImDrawList |] ) , ( TypeName "ImGuiContext", [t| ImGuiContext |] ) @@ -41,5 +42,6 @@ imguiContext = mempty , ( TypeName "ImFontConfig", [t| ImFontConfig |] ) , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] ) , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] ) + , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] ) ] } diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs index 3743eb9..86a8795 100644 --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -157,6 +157,28 @@ module DearImGui.Raw , colorPicker3 , colorButton + -- * Tables + , beginTable + , endTable + , tableNextRow + , tableNextColumn + , tableSetColumnIndex + + , tableSetupColumn + , tableSetupScrollFreeze + , tableHeadersRow + , tableHeader + + , tableGetSortSpecs + + , tableGetColumnCount + , tableGetColumnIndex + , tableGetRowIndex + , tableGetColumnName + , tableGetColumnFlags + , tableSetColumnEnabled + , tableSetBgColor + -- * Trees , treeNode , treePush @@ -1068,6 +1090,122 @@ colorButton descPtr refPtr = liftIO do (0 /=) <$> [C.exp| bool { ColorButton( $(char* descPtr), *$(ImVec4* refPtr) ) } |] +-- | Wraps @ImGui::BeginTable()@. +beginTable :: MonadIO m => CString -> CInt -> ImGuiTableFlags -> Ptr ImVec2 -> CFloat -> m Bool +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 + [C.exp| void { EndTable() } |] + +-- | Wraps @ImGui::TableNextRow()@. +-- append into the first cell of a new row. +tableNextRow :: MonadIO m => ImGuiTableRowFlags -> CFloat -> m () +tableNextRow flags minRowHeight = liftIO do + [C.exp| void { TableNextRow($(ImGuiTableRowFlags flags), $(float minRowHeight)) } |] + +-- | Wraps @ImGui::TableNextColumn()@. +-- append into the next column (or first column of next row if currently in +-- last column). Return true when column is visible. +tableNextColumn :: MonadIO m => m Bool +tableNextColumn = liftIO do + (0 /=) <$> [C.exp| bool { TableNextColumn() } |] + +-- | Wraps @ImGui::TableSetColumnIndex()@. +-- append into the specified column. Return true when column is visible. +tableSetColumnIndex :: MonadIO m => CInt -> m Bool +tableSetColumnIndex column= liftIO do + (0 /=) <$> [C.exp| bool { TableSetColumnIndex($(int column)) } |] + +-- | Wraps @ImGui::TableSetupColumn()@. +tableSetupColumn :: MonadIO m => CString -> ImGuiTableColumnFlags -> CFloat -> ImGuiID-> m () +tableSetupColumn labelPtr flags initWidthOrWeight userId = liftIO do + [C.exp| void { TableSetupColumn($(char* labelPtr), $(ImGuiTableColumnFlags flags), $(float initWidthOrWeight), $(ImGuiID userId)) } |] + +-- | Wraps @ImGui::TableSetupScrollFreeze()@. +tableSetupScrollFreeze :: MonadIO m => CInt -> CInt -> m () +tableSetupScrollFreeze cols rows = liftIO do + [C.exp| void { TableSetupScrollFreeze($(int cols), $(int rows)) } |] + +-- | Wraps @ImGui::TableHeadersRow()@. +-- submit all headers cells based on data provided to 'tableSetupColumn' +-- + submit context menu +tableHeadersRow :: MonadIO m => m () +tableHeadersRow = liftIO do + [C.exp| void { TableHeadersRow() } |] + +-- | Wraps @ImGui::TableHeader()@. +-- submit one header cell manually (rarely used) +tableHeader :: MonadIO m => CString -> m () +tableHeader labelPtr = liftIO do + [C.exp| void { TableHeader($(char* labelPtr)) } |] + +-- | Wraps @ImGui::TableGetSortSpecs()@. +-- Low-level-Function. Better use the wrapper that outomatically conform +-- to the things described below +-- +-- Tables: Sorting +-- - Call TableGetSortSpecs() to retrieve latest sort specs for the table. +-- NULL when not sorting. +-- - When 'SpecsDirty == true' you should sort your data. It will be true when +-- 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! +-- - Lifetime: don't hold on this pointer over multiple frames or past any +-- subsequent call to BeginTable(). +tableGetSortSpecs :: MonadIO m => m (Maybe (Ptr ImGuiTableSortSpecs)) +tableGetSortSpecs = liftIO do + ptr <- [C.exp| ImGuiTableSortSpecs* { TableGetSortSpecs() } |] + if ptr == nullPtr then + return Nothing + else + return $ Just ptr + +-- | Wraps @ImGui::TableGetColumnCount()@. +tableGetColumnCount :: MonadIO m => m CInt +tableGetColumnCount = liftIO do + [C.exp| int { TableGetColumnCount() } |] + +-- | Wraps @ImGui::TableGetColumnIndex()@. +tableGetColumnIndex :: MonadIO m => m CInt +tableGetColumnIndex = liftIO do + [C.exp| int { TableGetColumnIndex() } |] + +-- | Wraps @ImGui::TableGetRowIndex()@. +tableGetRowIndex :: MonadIO m => m CInt +tableGetRowIndex = liftIO do + [C.exp| int { TableGetRowIndex() } |] + +-- | Wraps @ImGui::TableGetColumnName +-- 'Nothing' returns the current column name +tableGetColumnName :: MonadIO m => Maybe CInt -> m CString +tableGetColumnName Nothing = tableGetColumnName (Just (-1)) +tableGetColumnName (Just column_n) = liftIO do + [C.exp| const char* { TableGetColumnName($(int column_n)) } |] + +-- | Wraps @ImGui::TableGetRowIndex()@. +-- 'Nothing' returns the current column flags +tableGetColumnFlags :: MonadIO m => Maybe CInt -> m ImGuiTableColumnFlags +tableGetColumnFlags Nothing = tableGetColumnFlags (Just (-1)) +tableGetColumnFlags (Just column_n) = liftIO do + [C.exp| ImGuiTableColumnFlags { TableGetColumnFlags($(int column_n)) } |] + +-- | Wraps @ImGui::TableSetColumnEnabled()@. +tableSetColumnEnabled :: MonadIO m => CInt -> CBool -> m () +tableSetColumnEnabled column_n v = liftIO do + [C.exp| void { TableSetColumnEnabled($(int column_n), $(bool v)) } |] + +-- | Wraps @ImGui::TableSetBgColor()@. +-- 'Nothing' sets the current row/column color +tableSetBgColor :: MonadIO m => ImGuiTableBgTarget -> ImU32 -> Maybe CInt -> m () +tableSetBgColor target color Nothing = tableSetBgColor target color (Just (-1)) +tableSetBgColor target color (Just column_n) = liftIO do + [C.exp| void { TableSetBgColor($(ImGuiTableBgTarget target), $(ImU32 color), $(int column_n)) } |] + -- | Wraps @ImGui::TreeNode()@. treeNode :: (MonadIO m) => CString -> m Bool treeNode labelPtr = liftIO do diff --git a/src/DearImGui/Structs.hs b/src/DearImGui/Structs.hs index f4acfe7..17b02cb 100644 --- a/src/DearImGui/Structs.hs +++ b/src/DearImGui/Structs.hs @@ -13,7 +13,11 @@ import Data.Word ) import Foreign - ( Storable(..), castPtr, plusPtr ) + ( Storable(..), castPtr, plusPtr, Ptr, Int16 ) +import Foreign.C + ( CInt, CBool ) + +import DearImGui.Enums -------------------------------------------------------------------------------- data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float } @@ -98,12 +102,85 @@ 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 = Word32 + -- | 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 + { imGuiTableColumnSortSpecs :: Ptr ImGuiTableColumnSortSpecs + , imGuiTableSortSpecsCount :: CInt + , imGuiTableSortSpecsDirty :: CBool + } + +instance Storable ImGuiTableSortSpecs where + sizeOf _ = sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) + + sizeOf (undefined :: CInt) + + sizeOf (undefined :: CBool) + + alignment _ = 0 + + 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 + + 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) + +-- | 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) + +instance Storable ImGuiTableColumnSortSpecs where + sizeOf _ = sizeOf (undefined :: ImGuiID) + + sizeOf (undefined :: ImS16) + + sizeOf (undefined :: ImS16) + + sizeOf (undefined :: ImGuiSortDirection) + + alignment _ = 0 + + 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 + + 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)