mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2024-12-22 20:56:36 +00:00
Alexander Bondarenko
GitHub
parent
e5969f6b35
commit
bc590d97c5
@ -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
|
||||
}
|
||||
|
||||
208
src/DearImGui.hs
208
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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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{..}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user