mirror of
				https://github.com/Drezil/dear-imgui.hs.git
				synced 2025-10-30 04:31:08 +01:00 
			
		
		
		
	
				
					committed by
					
						 GitHub
						GitHub
					
				
			
			
				
	
			
			
			
						parent
						
							e5969f6b35
						
					
				
				
					commit
					bc590d97c5
				
			| @@ -1,6 +1,7 @@ | |||||||
| {-# language BlockArguments #-} | {-# language BlockArguments #-} | ||||||
| {-# language LambdaCase #-} | {-# language LambdaCase #-} | ||||||
| {-# language OverloadedStrings #-} | {-# language OverloadedStrings #-} | ||||||
|  | {-# language RecordWildCards #-} | ||||||
|  |  | ||||||
| module Main ( main ) where | module Main ( main ) where | ||||||
|  |  | ||||||
| @@ -8,6 +9,11 @@ import Control.Exception | |||||||
| import Control.Monad | import Control.Monad | ||||||
| import Control.Monad.IO.Class | import Control.Monad.IO.Class | ||||||
| import Control.Monad.Managed | import Control.Monad.Managed | ||||||
|  | import Data.Bits ((.|.)) | ||||||
|  | import Data.IORef | ||||||
|  | import Data.List (sortBy) | ||||||
|  | import Data.Foldable (traverse_) | ||||||
|  |  | ||||||
| import DearImGui | import DearImGui | ||||||
| import DearImGui.OpenGL2 | import DearImGui.OpenGL2 | ||||||
| import DearImGui.GLFW | import DearImGui.GLFW | ||||||
| @@ -40,14 +46,23 @@ main = do | |||||||
|         -- Initialize ImGui's OpenGL backend |         -- Initialize ImGui's OpenGL backend | ||||||
|         _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown |         _ <- 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 |       Nothing -> do | ||||||
|         error "GLFW createWindow failed" |         error "GLFW createWindow failed" | ||||||
|  |  | ||||||
|   GLFW.terminate |   GLFW.terminate | ||||||
|  |  | ||||||
| mainLoop :: Window -> IO () | mainLoop :: Window -> IORef [(Integer, String)] -> IO () | ||||||
| mainLoop win = do | mainLoop win tableRef = do | ||||||
|   -- Process the event loop |   -- Process the event loop | ||||||
|   GLFW.pollEvents |   GLFW.pollEvents | ||||||
|   close <- GLFW.windowShouldClose win |   close <- GLFW.windowShouldClose win | ||||||
| @@ -73,8 +88,9 @@ mainLoop win = do | |||||||
|           when clicked $ |           when clicked $ | ||||||
|             closeCurrentPopup |             closeCurrentPopup | ||||||
|  |  | ||||||
|     -- Show the ImGui demo window |       newLine | ||||||
|     showDemoWindow |  | ||||||
|  |       mkTable tableRef | ||||||
|  |  | ||||||
|     -- Render |     -- Render | ||||||
|     glClear GL_COLOR_BUFFER_BIT |     glClear GL_COLOR_BUFFER_BIT | ||||||
| @@ -84,4 +100,41 @@ mainLoop win = do | |||||||
|  |  | ||||||
|     GLFW.swapBuffers win |     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 | ||||||
|  |       } | ||||||
|   | |||||||
							
								
								
									
										172
									
								
								src/DearImGui.hs
									
									
									
									
									
								
							
							
						
						
									
										172
									
								
								src/DearImGui.hs
									
									
									
									
									
								
							| @@ -8,6 +8,7 @@ | |||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE OverloadedStrings #-} | ||||||
| {-# LANGUAGE PatternSynonyms #-} | {-# LANGUAGE PatternSynonyms #-} | ||||||
| {-# LANGUAGE QuasiQuotes #-} | {-# LANGUAGE QuasiQuotes #-} | ||||||
|  | {-# LANGUAGE RecordWildCards #-} | ||||||
| {-# LANGUAGE TemplateHaskell #-} | {-# LANGUAGE TemplateHaskell #-} | ||||||
|  |  | ||||||
| {-| | {-| | ||||||
| @@ -184,28 +185,38 @@ module DearImGui | |||||||
|   , colorButton |   , colorButton | ||||||
|  |  | ||||||
|     -- ** Tables |     -- ** Tables | ||||||
|   , beginTable |  | ||||||
|   , Raw.endTable |  | ||||||
|   , withTable |   , withTable | ||||||
|  |   , withTableOpen | ||||||
|   , TableOptions(..) |   , TableOptions(..) | ||||||
|   , defTableOptions |   , defTableOptions | ||||||
|  |   , beginTable | ||||||
|  |   , Raw.endTable | ||||||
|  |  | ||||||
|  |     -- *** Setup | ||||||
|  |   , tableSetupColumn | ||||||
|  |   , tableSetupColumnWith | ||||||
|  |   , TableColumnOptions(..) | ||||||
|  |   , defTableColumnOptions | ||||||
|  |  | ||||||
|  |   , Raw.tableHeadersRow | ||||||
|  |   , Raw.tableHeader | ||||||
|  |   , tableSetupScrollFreeze | ||||||
|  |  | ||||||
|  |     -- *** Rows | ||||||
|   , tableNextRow |   , tableNextRow | ||||||
|   , tableNextRowWith |   , tableNextRowWith | ||||||
|   , TableRowOptions(..) |   , TableRowOptions(..) | ||||||
|   , defTableRowOptions |   , defTableRowOptions | ||||||
|   , Raw.tableNextColumn |  | ||||||
|  |     -- *** Columns | ||||||
|  |   , tableNextColumn | ||||||
|   , tableSetColumnIndex |   , tableSetColumnIndex | ||||||
|  |  | ||||||
|   , tableSetupColumn |     -- *** Sorting | ||||||
|   , TableColumnOptions(..) |  | ||||||
|   , defTableColumnOptions |  | ||||||
|   , tableSetupScrollFreeze |  | ||||||
|   , Raw.tableHeadersRow |  | ||||||
|   , Raw.tableHeader |  | ||||||
|  |  | ||||||
|   , withSortableTable |   , withSortableTable | ||||||
|   , TableSortingSpecs(..) |   , TableSortingSpecs(..) | ||||||
|  |  | ||||||
|  |     -- *** Queries | ||||||
|   , tableGetColumnCount |   , tableGetColumnCount | ||||||
|   , tableGetColumnIndex |   , tableGetColumnIndex | ||||||
|   , tableGetRowIndex |   , tableGetRowIndex | ||||||
| @@ -1307,19 +1318,22 @@ colorButton desc ref = liftIO do | |||||||
|  |  | ||||||
| data TableOptions = TableOptions | data TableOptions = TableOptions | ||||||
|   { tableFlags      :: ImGuiTableFlags |   { tableFlags      :: ImGuiTableFlags | ||||||
|                   , outerSize :: ImVec2 |   , tableOuterSize  :: ImVec2 | ||||||
|                   , innerWidth :: Float |   , tableInnerWidth :: Float | ||||||
|   } deriving Show |   } deriving Show | ||||||
|  |  | ||||||
| defTableOptions :: TableOptions | defTableOptions :: TableOptions | ||||||
| defTableOptions = TableOptions (ImGuiTableFlags 0) (ImVec2 0 0) 0 | defTableOptions = TableOptions | ||||||
|  |   { tableFlags      = ImGuiTableFlags_None | ||||||
|  |   , tableOuterSize  = ImVec2 0  0 | ||||||
|  |   , tableInnerWidth = 0 | ||||||
|  |   } | ||||||
| -- | Wraps @ImGui::BeginTable()@. | -- | Wraps @ImGui::BeginTable()@. | ||||||
| beginTable :: MonadIO m => TableOptions -> String -> Int -> m Bool | beginTable :: MonadIO m => TableOptions -> String -> Int -> m Bool | ||||||
| beginTable (TableOptions flags outer inner) label columns = liftIO do | beginTable TableOptions{..} label columns = liftIO do | ||||||
|   withCString label $ \l ->  |   withCString label \labelPtr -> | ||||||
|     with outer $ \o -> |     with tableOuterSize \outerSizePtr -> | ||||||
|       Raw.beginTable l (fromIntegral columns) flags o (CFloat inner) |       Raw.beginTable labelPtr (fromIntegral columns) tableFlags outerSizePtr (CFloat tableInnerWidth) | ||||||
|  |  | ||||||
| -- | Create a table. | -- | Create a table. | ||||||
| -- | -- | ||||||
| @@ -1327,16 +1341,15 @@ beginTable (TableOptions flags outer inner) label columns = liftIO do | |||||||
| -- | -- | ||||||
| -- ==== __Example usage:__ | -- ==== __Example usage:__ | ||||||
| -- | -- | ||||||
| -- > withTable defTableOptions "MyTable" 2 $ \case | -- > withTableOpen defTableOptions "MyTable" do | ||||||
| -- >   False -> return () |  | ||||||
| -- >   True  -> do |  | ||||||
| -- >   tableSetupColumn "Hello" | -- >   tableSetupColumn "Hello" | ||||||
| -- >   tableSetupColumn "World" | -- >   tableSetupColumn "World" | ||||||
| -- >   tableHeadersRow | -- >   tableHeadersRow | ||||||
| -- >     forM_ [("a","1"),("b","2")] $\(a,b) | -- > | ||||||
|  | -- >   for_ [("a","1"),("b","2")] \(a,b) -> do | ||||||
| -- >     tableNextRow | -- >     tableNextRow | ||||||
| -- >       whenM tableNextColumn (text a) | -- >     tableNextColumn (text a) | ||||||
| -- >       whenM tableNextColumn (text b) | -- >     tableNextColumn (text b) | ||||||
| -- | -- | ||||||
| -- Displays: | -- Displays: | ||||||
| -- | -- | ||||||
| @@ -1351,6 +1364,10 @@ withTable :: MonadUnliftIO m => TableOptions -> String -> Int -> (Bool -> m a) - | |||||||
| withTable options label columns = | withTable options label columns = | ||||||
|   bracket (beginTable options label columns) (`when` Raw.endTable) |   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'. | -- | Wraps @ImGui::TableNextRow()@ with 'defTableRowOptions'. | ||||||
| --   append into the first cell of a new row. | --   append into the first cell of a new row. | ||||||
| tableNextRow :: MonadIO m => m () | tableNextRow :: MonadIO m => m () | ||||||
| @@ -1358,16 +1375,22 @@ tableNextRow = tableNextRowWith defTableRowOptions | |||||||
|  |  | ||||||
| data TableRowOptions = TableRowOptions | data TableRowOptions = TableRowOptions | ||||||
|   { tableRowFlags     :: ImGuiTableRowFlags |   { tableRowFlags     :: ImGuiTableRowFlags | ||||||
|                      , minRowHeight  :: Float |   , tableRowMinHeight :: Float | ||||||
|   } deriving Show |   } deriving Show | ||||||
|  |  | ||||||
| defTableRowOptions :: TableRowOptions | defTableRowOptions :: TableRowOptions | ||||||
| defTableRowOptions = TableRowOptions (ImGuiTableRowFlags 0) 0 | defTableRowOptions = TableRowOptions | ||||||
|  |   { tableRowFlags     = ImGuiTableRowFlags_None | ||||||
|  |   , tableRowMinHeight = 0 | ||||||
|  |   } | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableNextRow()@ with explicit options. | -- | Wraps @ImGui::TableNextRow()@ with explicit options. | ||||||
| tableNextRowWith :: MonadIO m => TableRowOptions -> m () | tableNextRowWith :: MonadIO m => TableRowOptions -> m () | ||||||
| tableNextRowWith (TableRowOptions flags minHeight) = liftIO do | tableNextRowWith TableRowOptions{..} = liftIO do | ||||||
|   Raw.tableNextRow flags (CFloat minHeight) |   Raw.tableNextRow tableRowFlags (CFloat tableRowMinHeight) | ||||||
|  |  | ||||||
|  | tableNextColumn :: MonadIO m => m () -> m () | ||||||
|  | tableNextColumn action = Raw.tableNextColumn >>= (`when` action) | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableSetColumnIndex()@. | -- | Wraps @ImGui::TableSetColumnIndex()@. | ||||||
| --   append into the specified column. Return true when column is visible. | --   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 | tableSetColumnIndex column = liftIO do | ||||||
|   Raw.tableSetColumnIndex (fromIntegral column) |   Raw.tableSetColumnIndex (fromIntegral column) | ||||||
|  |  | ||||||
|  |  | ||||||
| data TableColumnOptions = TableColumnOptions | data TableColumnOptions = TableColumnOptions | ||||||
|   { tableColumnFlags             :: ImGuiTableColumnFlags |   { tableColumnFlags             :: ImGuiTableColumnFlags | ||||||
|                         , initWidthOrWeight :: Float |   , tableColumnInitWidthOrWeight :: Float | ||||||
|                         , userId            :: ImGuiID |   , tableColumnUserId            :: ImGuiID | ||||||
|   } deriving Show |   } deriving Show | ||||||
|  |  | ||||||
| defTableColumnOptions :: TableColumnOptions | defTableColumnOptions :: TableColumnOptions | ||||||
| defTableColumnOptions = TableColumnOptions (ImGuiTableColumnFlags 0) 0 0 | defTableColumnOptions = TableColumnOptions | ||||||
|  |   { tableColumnFlags             = ImGuiTableColumnFlags_None | ||||||
|  |   , tableColumnInitWidthOrWeight = 0 | ||||||
|  |   , tableColumnUserId            = 0 | ||||||
|  |   } | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableSetupColumn()@ using 'defTableColumnOptions'. | -- | Wraps @ImGui::TableSetupColumn()@ using 'defTableColumnOptions'. | ||||||
| tableSetupColumn :: MonadIO m => String -> m () | tableSetupColumn :: MonadIO m => String -> m () | ||||||
| @@ -1391,9 +1417,9 @@ tableSetupColumn = tableSetupColumnWith defTableColumnOptions | |||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableSetupColumn() with explicit options@. | -- | Wraps @ImGui::TableSetupColumn() with explicit options@. | ||||||
| tableSetupColumnWith :: MonadIO m => TableColumnOptions -> String -> m () | tableSetupColumnWith :: MonadIO m => TableColumnOptions -> String -> m () | ||||||
| tableSetupColumnWith (TableColumnOptions flags weight userId) label = liftIO do | tableSetupColumnWith TableColumnOptions{..} label = liftIO do | ||||||
|   withCString label $ \l -> |   withCString label \labelPtr -> | ||||||
|     Raw.tableSetupColumn l flags (CFloat weight) userId |     Raw.tableSetupColumn labelPtr tableColumnFlags (CFloat tableColumnInitWidthOrWeight) tableColumnUserId | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableSetupScrollFreeze()@. | -- | Wraps @ImGui::TableSetupScrollFreeze()@. | ||||||
| --   lock columns/rows so they stay visible when scrolled. | --   lock columns/rows so they stay visible when scrolled. | ||||||
| @@ -1402,12 +1428,18 @@ tableSetupScrollFreeze cols rows = liftIO do | |||||||
|   Raw.tableSetupScrollFreeze (fromIntegral cols) (fromIntegral rows) |   Raw.tableSetupScrollFreeze (fromIntegral cols) (fromIntegral rows) | ||||||
|  |  | ||||||
| data TableSortingSpecs = TableSortingSpecs | 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 | ||||||
|      , tableSortingColumn    :: Int     -- ^ Index of the column, starting at 0 |   , tableSortingReverse :: Bool | ||||||
|      , 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). |   , tableSortingUserId  :: ImGuiID -- ^ User id of the column (if specified by a 'tableSetupColumn' call). | ||||||
|                                         --   On 'ImGuiTableFlags_SortMulti' this is the order in which should be sorted. |   } deriving (Eq, Ord, Show) | ||||||
|      , tableSortingDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending'. Should not be 'ImGuiSortDirection_None' |  | ||||||
|      } deriving (Show, Eq) | 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 | -- | High-Level sorting. Returns of the underlying data should be sorted | ||||||
| --   and to what specification. Number of Specifications is mostly 0 or 1, but | --   and to what specification. Number of Specifications is mostly 0 or 1, but | ||||||
| @@ -1423,35 +1455,39 @@ data TableSortingSpecs = TableSortingSpecs | |||||||
| -- | -- | ||||||
| -- ==== __Example usage:__ | -- ==== __Example usage:__ | ||||||
| -- | -- | ||||||
| -- > withTable defTableOptions "MyTable" 2 $ \case | -- > sortedData <- newIORef [("a","1"), ("b","2")] | ||||||
| -- >   False -> return () | -- > | ||||||
| -- >   True  -> do | -- > let sortable = defTableOptions { tableFlags = ImGuiTableFlags_Sortable } | ||||||
|  | -- > withTableOpen sortable "MyTable" 2 $ do | ||||||
| -- >   tableSetupColumn "Hello" | -- >   tableSetupColumn "Hello" | ||||||
| -- >   tableSetupColumn "World" | -- >   tableSetupColumn "World" | ||||||
| -- >     withSortableTable $ \(mustSort, sortSpecs) do | -- > | ||||||
| -- >     when mustSort $ | -- >   withSortableTable \isDirty sortSpecs -> do | ||||||
| -- >        -- ... do your sorting here & cache it. Dont sort every frame. | -- >     when isDirty $ | ||||||
|  | -- >       -- XXX: do your sorting & cache it. Dont sort every frame. | ||||||
|  | -- >       modifyIORef' sortedData . sortBy $ | ||||||
|  | -- >         foldMap columnSorter sortSpecs | ||||||
|  | -- > | ||||||
| -- >     tableHeadersRow | -- >     tableHeadersRow | ||||||
| -- >     forM_ [("a","1"),("b","2")] $\(a,b) -- use sorted data here. | -- >     for_ sortedData \(a, b) -> do | ||||||
| -- >       tableNextRow | -- >       tableNextRow | ||||||
| -- >       whenM tableNextColumn (text a) | -- >       tableNextColumn $ text a | ||||||
| -- >       whenM tableNextColumn (text b) | -- >       tableNextColumn $ text b | ||||||
| withSortableTable :: MonadIO m => ((Bool,[TableSortingSpecs]) -> m a) -> m a | withSortableTable :: MonadIO m => (Bool -> [TableSortingSpecs] -> m ()) -> m () | ||||||
| withSortableTable action = do | withSortableTable action = do | ||||||
|   specsPtr <- liftIO $ Raw.tableGetSortSpecs |   liftIO Raw.tableGetSortSpecs >>= \case | ||||||
|   case specsPtr of |     Nothing -> | ||||||
|     Nothing -> action (False, []) |       -- XXX: The table is not sortable | ||||||
|     Just ptr -> do |       pure () | ||||||
|       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 |     Just specsPtr -> do | ||||||
|       let cSpecs' = (\(ImGuiTableColumnSortSpecs a b c d) -> TableSortingSpecs a (fromIntegral b) (fromIntegral c) d) <$> cSpecs |       ImGuiTableSortSpecs{..} <- liftIO $ peek specsPtr | ||||||
|  |       let isDirty = 0 /= specsDirty | ||||||
|  |       columns <- liftIO $ peekArray (fromIntegral specsCount) specs | ||||||
|  |  | ||||||
|       result <- action (imGuiTableSortSpecsDirty specs /= 0, cSpecs') |       action isDirty (map convertTableSortingSpecs columns) | ||||||
|       -- set dirty to 0 after everything is done. |       when isDirty $ | ||||||
|       liftIO $ poke (ptr `plusPtr` (sizeOf (imGuiTableColumnSortSpecs specs)) `plusPtr` (sizeOf (imGuiTableSortSpecsCount specs))) (0 :: CInt) |         Raw.tableClearSortSpecsDirty specsPtr | ||||||
|       return result |  | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableGetColumnCount()@. | -- | Wraps @ImGui::TableGetColumnCount()@. | ||||||
| --   return number of columns (value passed to BeginTable) | --   return number of columns (value passed to BeginTable) | ||||||
| @@ -1526,13 +1562,17 @@ data SelectableOptions = SelectableOptions | |||||||
|   } deriving Show |   } deriving Show | ||||||
|  |  | ||||||
| defSelectableOptions :: SelectableOptions | 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. | -- | Wraps @ImGui::Selectable()@ with explicit options. | ||||||
| selectableWith :: MonadIO m => SelectableOptions -> String -> m Bool | selectableWith :: MonadIO m => SelectableOptions -> String -> m Bool | ||||||
| selectableWith (SelectableOptions selected flags size) label = liftIO do | selectableWith (SelectableOptions selected flags size) label = liftIO do | ||||||
|   with size $ \sizePtr -> |   with size \sizePtr -> | ||||||
|     withCString label $ \labelPtr ->  |     withCString label \labelPtr -> | ||||||
|       Raw.selectable labelPtr (bool 0 1 selected) flags sizePtr |       Raw.selectable labelPtr (bool 0 1 selected) flags sizePtr | ||||||
|  |  | ||||||
|  |  | ||||||
|   | |||||||
| @@ -6,6 +6,7 @@ | |||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE OverloadedStrings #-} | ||||||
| {-# LANGUAGE PatternSynonyms #-} | {-# LANGUAGE PatternSynonyms #-} | ||||||
| {-# LANGUAGE QuasiQuotes #-} | {-# LANGUAGE QuasiQuotes #-} | ||||||
|  | {-# LANGUAGE RecordWildCards #-} | ||||||
| {-# LANGUAGE TemplateHaskell #-} | {-# LANGUAGE TemplateHaskell #-} | ||||||
| {-# LANGUAGE ViewPatterns #-} | {-# LANGUAGE ViewPatterns #-} | ||||||
|  |  | ||||||
| @@ -170,6 +171,7 @@ module DearImGui.Raw | |||||||
|   , tableHeader |   , tableHeader | ||||||
|  |  | ||||||
|   , tableGetSortSpecs |   , tableGetSortSpecs | ||||||
|  |   , tableClearSortSpecsDirty | ||||||
|  |  | ||||||
|   , tableGetColumnCount |   , tableGetColumnCount | ||||||
|   , tableGetColumnIndex |   , tableGetColumnIndex | ||||||
| @@ -1165,6 +1167,12 @@ tableGetSortSpecs = liftIO do | |||||||
|   else |   else | ||||||
|     return $ Just ptr |     return $ Just ptr | ||||||
|  |  | ||||||
|  | tableClearSortSpecsDirty :: MonadIO m => Ptr ImGuiTableSortSpecs -> m () | ||||||
|  | tableClearSortSpecsDirty specsPtr = liftIO do | ||||||
|  |   [C.block| void { | ||||||
|  |     $(ImGuiTableSortSpecs* specsPtr)->SpecsDirty = false; | ||||||
|  |   } |] | ||||||
|  |  | ||||||
| -- | Wraps @ImGui::TableGetColumnCount()@. | -- | Wraps @ImGui::TableGetColumnCount()@. | ||||||
| tableGetColumnCount :: MonadIO m => m CInt | tableGetColumnCount :: MonadIO m => m CInt | ||||||
| tableGetColumnCount = liftIO do | tableGetColumnCount = liftIO do | ||||||
|   | |||||||
| @@ -1,5 +1,6 @@ | |||||||
| {-# LANGUAGE DuplicateRecordFields #-} | {-# LANGUAGE DuplicateRecordFields #-} | ||||||
| {-# LANGUAGE NamedFieldPuns #-} | {-# LANGUAGE NamedFieldPuns #-} | ||||||
|  | {-# LANGUAGE RecordWildCards #-} | ||||||
| {-# LANGUAGE CPP #-} | {-# LANGUAGE CPP #-} | ||||||
|  |  | ||||||
| module DearImGui.Structs where | module DearImGui.Structs where | ||||||
| @@ -13,11 +14,12 @@ import Data.Word | |||||||
|   ) |   ) | ||||||
|  |  | ||||||
| import Foreign | import Foreign | ||||||
|   ( Storable(..), castPtr, plusPtr, Ptr, Int16 ) |   ( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr ) | ||||||
| import Foreign.C | import Foreign.C | ||||||
|   ( CInt, CBool ) |   ( CInt, CBool ) | ||||||
|  |  | ||||||
| import DearImGui.Enums | import DearImGui.Enums | ||||||
|  | import Data.Bits ((.&.)) | ||||||
|  |  | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float } | 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) | -- | A unique ID used by widgets (typically the result of hashing a stack of string) | ||||||
| --   unsigned Integer (same as ImU32) | --   unsigned Integer (same as ImU32) | ||||||
| type ImGuiID = Word32 | type ImGuiID = ImU32 | ||||||
|  |  | ||||||
| -- | 32-bit unsigned integer (often used to store packed colors). | -- | 32-bit unsigned integer (often used to store packed colors). | ||||||
| type ImU32 = Word32 | 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. | --   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! | --   Make sure to set @SpecsDirty = false@ after sorting, else you may wastefully sort your data every frame! | ||||||
| data ImGuiTableSortSpecs = ImGuiTableSortSpecs | data ImGuiTableSortSpecs = ImGuiTableSortSpecs | ||||||
|      { imGuiTableColumnSortSpecs :: Ptr ImGuiTableColumnSortSpecs |   { specs      :: Ptr ImGuiTableColumnSortSpecs | ||||||
|      , imGuiTableSortSpecsCount :: CInt |   , specsCount :: CInt | ||||||
|      , imGuiTableSortSpecsDirty :: CBool |   , specsDirty :: CBool | ||||||
|      } |   } deriving (Show, Eq) | ||||||
|  |  | ||||||
| instance Storable ImGuiTableSortSpecs where | instance Storable ImGuiTableSortSpecs where | ||||||
|   sizeOf _ = sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) |   sizeOf _ = | ||||||
|            + sizeOf (undefined :: CInt) |     sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) + | ||||||
|            + sizeOf (undefined :: CBool) |     sizeOf (undefined :: CInt) + | ||||||
|  |     sizeOf (undefined :: CBool) | ||||||
|  |  | ||||||
|   alignment _ = 0 |   alignment _ = | ||||||
|  |     alignment nullPtr | ||||||
|  |  | ||||||
|   poke ptr (ImGuiTableSortSpecs s c d) = do |   poke ptr ImGuiTableSortSpecs{..} = do | ||||||
|     poke ( castPtr ptr                   ) s |     let specsPtr = castPtr ptr | ||||||
|     poke ( castPtr ptr `plusPtr` sizeOf s) c |     poke specsPtr specs | ||||||
|     poke ((castPtr ptr `plusPtr` sizeOf s) |  | ||||||
|                        `plusPtr` sizeOf c) d |     let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs | ||||||
|  |     poke specsCountPtr specsCount | ||||||
|  |  | ||||||
|  |     let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount | ||||||
|  |     poke specsDirtyPtr specsDirty | ||||||
|  |  | ||||||
|   peek ptr = do |   peek ptr = do | ||||||
|     s <- peek ( castPtr ptr                   ) |     let specsPtr = castPtr ptr | ||||||
|     c <- peek ( castPtr ptr `plusPtr` sizeOf s) |     specs <- peek specsPtr | ||||||
|     d <- peek ((castPtr ptr `plusPtr` sizeOf s) |  | ||||||
|                             `plusPtr` sizeOf c) |     let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs | ||||||
|     return (ImGuiTableSortSpecs s c d) |     specsCount <- peek specsCountPtr | ||||||
|  |  | ||||||
|  |     let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount | ||||||
|  |     specsDirty <- peek specsDirtyPtr | ||||||
|  |  | ||||||
|  |     pure ImGuiTableSortSpecs{..} | ||||||
|  |  | ||||||
| -- | Sorting specification for one column of a table | -- | Sorting specification for one column of a table | ||||||
| data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs | data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs | ||||||
|      { imGuiTableColumnSortUserID      :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call) |   { columnUserID  :: ImGuiID            -- ^ User id of the column (if specified by a TableSetupColumn() call) | ||||||
|      , imGuiTableColumnSortColumnIndex :: ImS16 -- ^ Index of the column |   , columnIndex   :: 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) |   , 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) | ||||||
|      , imGuiTableColumnSortDirection   :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending' |   , sortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending' | ||||||
|   } deriving (Show, Eq) |   } deriving (Show, Eq) | ||||||
|  |  | ||||||
| instance Storable ImGuiTableColumnSortSpecs where | instance Storable ImGuiTableColumnSortSpecs where | ||||||
|   sizeOf _  = sizeOf (undefined :: ImGuiID) |   sizeOf _ = 12 | ||||||
|             + sizeOf (undefined :: ImS16) |   alignment _ = 4 | ||||||
|             + sizeOf (undefined :: ImS16) |  | ||||||
|             + sizeOf (undefined :: ImGuiSortDirection) |  | ||||||
|  |  | ||||||
|   alignment _ = 0 |   poke ptr ImGuiTableColumnSortSpecs{..} = do | ||||||
|  |     let columnUserIDPtr = castPtr ptr | ||||||
|  |     poke columnUserIDPtr columnUserID | ||||||
|  |  | ||||||
|   poke ptr (ImGuiTableColumnSortSpecs a b c d) = do |     let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID | ||||||
|     poke (  castPtr ptr                   ) a |     poke columnIndexPtr columnIndex | ||||||
|     poke (  castPtr ptr `plusPtr` sizeOf a) b |  | ||||||
|     poke (( castPtr ptr `plusPtr` sizeOf a) |     let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex | ||||||
|                         `plusPtr` sizeOf b) c |     poke sortOrderPtr sortOrder | ||||||
|     poke (((castPtr ptr `plusPtr` sizeOf a) |  | ||||||
|                         `plusPtr` sizeOf b) |     let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder | ||||||
|                         `plusPtr` sizeOf c) d |     poke sortDirectionPtr sortDirection | ||||||
|  |  | ||||||
|   peek ptr = do |   peek ptr = do | ||||||
|     a <- peek (  castPtr ptr                   ) |     let columnUserIDPtr = castPtr ptr | ||||||
|     b <- peek (  castPtr ptr `plusPtr` sizeOf a) |     columnUserID <- peek columnUserIDPtr | ||||||
|     c <- peek (( castPtr ptr `plusPtr` sizeOf a) |  | ||||||
|                              `plusPtr` sizeOf b) |     let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID | ||||||
|     d <- peek (((castPtr ptr `plusPtr` sizeOf a) |     columnIndex <- peek columnIndexPtr | ||||||
|                              `plusPtr` sizeOf b) |  | ||||||
|                              `plusPtr` sizeOf c) |     let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex | ||||||
|     return (ImGuiTableColumnSortSpecs a b c d) |     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{..} | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user