packages feed

dear-imgui 1.4.0 → 1.5.0

raw patch · 10 files changed

+829/−66 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- DearImGui: instance DearImGui.ToID GHC.Integer.Type.Integer
- DearImGui: type family Count a :: Nat;
- DearImGui.Raw: type family Count a :: Nat;
+ DearImGui: ImGuiTableColumnSortSpecs :: ImGuiID -> ImS16 -> ImS16 -> ImGuiSortDirection -> ImGuiTableColumnSortSpecs
+ DearImGui: ImGuiTableSortSpecs :: Ptr ImGuiTableColumnSortSpecs -> CInt -> CBool -> ImGuiTableSortSpecs
+ DearImGui: SelectableOptions :: Bool -> ImGuiSelectableFlags -> ImVec2 -> SelectableOptions
+ DearImGui: TableColumnOptions :: ImGuiTableColumnFlags -> Float -> ImGuiID -> TableColumnOptions
+ DearImGui: TableOptions :: ImGuiTableFlags -> ImVec2 -> Float -> TableOptions
+ DearImGui: TableRowOptions :: ImGuiTableRowFlags -> Float -> TableRowOptions
+ DearImGui: TableSortingSpecs :: Int -> Bool -> ImGuiID -> TableSortingSpecs
+ DearImGui: [$sel:columnIndex:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImS16
+ DearImGui: [$sel:columnUserID:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImGuiID
+ DearImGui: [$sel:flags:SelectableOptions] :: SelectableOptions -> ImGuiSelectableFlags
+ DearImGui: [$sel:selected:SelectableOptions] :: SelectableOptions -> Bool
+ DearImGui: [$sel:size:SelectableOptions] :: SelectableOptions -> ImVec2
+ DearImGui: [$sel:sortDirection:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImGuiSortDirection
+ DearImGui: [$sel:sortOrder:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImS16
+ DearImGui: [$sel:specs:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> Ptr ImGuiTableColumnSortSpecs
+ DearImGui: [$sel:specsCount:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> CInt
+ DearImGui: [$sel:specsDirty:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> CBool
+ DearImGui: [$sel:tableColumnFlags:TableColumnOptions] :: TableColumnOptions -> ImGuiTableColumnFlags
+ DearImGui: [$sel:tableColumnInitWidthOrWeight:TableColumnOptions] :: TableColumnOptions -> Float
+ DearImGui: [$sel:tableColumnUserId:TableColumnOptions] :: TableColumnOptions -> ImGuiID
+ DearImGui: [$sel:tableFlags:TableOptions] :: TableOptions -> ImGuiTableFlags
+ DearImGui: [$sel:tableInnerWidth:TableOptions] :: TableOptions -> Float
+ DearImGui: [$sel:tableOuterSize:TableOptions] :: TableOptions -> ImVec2
+ DearImGui: [$sel:tableRowFlags:TableRowOptions] :: TableRowOptions -> ImGuiTableRowFlags
+ DearImGui: [$sel:tableRowMinHeight:TableRowOptions] :: TableRowOptions -> Float
+ DearImGui: [$sel:tableSortingColumn:TableSortingSpecs] :: TableSortingSpecs -> Int
+ DearImGui: [$sel:tableSortingReverse:TableSortingSpecs] :: TableSortingSpecs -> Bool
+ DearImGui: [$sel:tableSortingUserId:TableSortingSpecs] :: TableSortingSpecs -> ImGuiID
+ DearImGui: beginPopupContextItem :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool
+ DearImGui: beginPopupContextVoid :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool
+ DearImGui: beginPopupContextWindow :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool
+ DearImGui: beginTable :: MonadIO m => TableOptions -> String -> Int -> m Bool
+ DearImGui: data ImGuiTableColumnSortSpecs
+ DearImGui: data ImGuiTableSortSpecs
+ DearImGui: data SelectableOptions
+ DearImGui: data TableColumnOptions
+ DearImGui: data TableOptions
+ DearImGui: data TableRowOptions
+ DearImGui: data TableSortingSpecs
+ DearImGui: defSelectableOptions :: SelectableOptions
+ DearImGui: defTableColumnOptions :: TableColumnOptions
+ DearImGui: defTableOptions :: TableOptions
+ DearImGui: defTableRowOptions :: TableRowOptions
+ DearImGui: endTable :: MonadIO m => m ()
+ DearImGui: instance DearImGui.ToID GHC.Num.Integer.Integer
+ DearImGui: instance GHC.Classes.Eq DearImGui.TableSortingSpecs
+ DearImGui: instance GHC.Classes.Ord DearImGui.TableSortingSpecs
+ DearImGui: instance GHC.Show.Show DearImGui.SelectableOptions
+ DearImGui: instance GHC.Show.Show DearImGui.TableColumnOptions
+ DearImGui: instance GHC.Show.Show DearImGui.TableOptions
+ DearImGui: instance GHC.Show.Show DearImGui.TableRowOptions
+ DearImGui: instance GHC.Show.Show DearImGui.TableSortingSpecs
+ DearImGui: isAnyLevelPopupOpen :: MonadIO m => String -> m Bool
+ DearImGui: isAnyPopupOpen :: MonadIO m => String -> m Bool
+ DearImGui: isCurrentPopupOpen :: MonadIO m => String -> m Bool
+ DearImGui: itemContextPopup :: MonadUnliftIO m => m () -> m ()
+ DearImGui: openPopupOnItemClick :: MonadIO m => String -> ImGuiPopupFlags -> m ()
+ DearImGui: selectableWith :: MonadIO m => SelectableOptions -> String -> m Bool
+ DearImGui: tableGetColumnCount :: MonadIO m => m Int
+ DearImGui: tableGetColumnFlags :: MonadIO m => Maybe Int -> m ImGuiTableColumnFlags
+ DearImGui: tableGetColumnIndex :: MonadIO m => m Int
+ DearImGui: tableGetColumnName :: MonadIO m => Maybe Int -> m String
+ DearImGui: tableGetRowIndex :: MonadIO m => m Int
+ DearImGui: tableHeader :: MonadIO m => CString -> m ()
+ DearImGui: tableHeadersRow :: MonadIO m => m ()
+ DearImGui: tableNextColumn :: MonadIO m => m () -> m ()
+ DearImGui: tableNextRow :: MonadIO m => m ()
+ DearImGui: tableNextRowWith :: MonadIO m => TableRowOptions -> m ()
+ DearImGui: tableSetBgColor :: MonadIO m => ImGuiTableBgTarget -> ImU32 -> Maybe Int -> m ()
+ DearImGui: tableSetColumnEnabled :: MonadIO m => Int -> Bool -> m ()
+ DearImGui: tableSetColumnIndex :: MonadIO m => Int -> m Bool
+ DearImGui: tableSetupColumn :: MonadIO m => String -> m ()
+ DearImGui: tableSetupColumnWith :: MonadIO m => TableColumnOptions -> String -> m ()
+ DearImGui: tableSetupScrollFreeze :: MonadIO m => Int -> Int -> m ()
+ DearImGui: type Count a :: Nat;
+ DearImGui: type ImGuiID = ImU32
+ DearImGui: type ImS16 = Int16
+ DearImGui: voidContextPopup :: MonadUnliftIO m => m () -> m ()
+ DearImGui: windowContextPopup :: MonadUnliftIO m => m () -> m ()
+ DearImGui: withPopupContextItem :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a
+ DearImGui: withPopupContextItemOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()
+ DearImGui: withPopupContextVoid :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a
+ DearImGui: withPopupContextVoidOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()
+ DearImGui: withPopupContextWindow :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a
+ DearImGui: withPopupContextWindowOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()
+ DearImGui: withSortableTable :: MonadIO m => (Bool -> [TableSortingSpecs] -> m ()) -> m ()
+ DearImGui: withTable :: MonadUnliftIO m => TableOptions -> String -> Int -> (Bool -> m a) -> m a
+ DearImGui: withTableOpen :: MonadUnliftIO m => TableOptions -> String -> Int -> m () -> m ()
+ DearImGui.Raw: ImGuiTableColumnSortSpecs :: ImGuiID -> ImS16 -> ImS16 -> ImGuiSortDirection -> ImGuiTableColumnSortSpecs
+ DearImGui.Raw: ImGuiTableSortSpecs :: Ptr ImGuiTableColumnSortSpecs -> CInt -> CBool -> ImGuiTableSortSpecs
+ DearImGui.Raw: [$sel:columnIndex:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImS16
+ DearImGui.Raw: [$sel:columnUserID:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImGuiID
+ DearImGui.Raw: [$sel:sortDirection:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImGuiSortDirection
+ DearImGui.Raw: [$sel:sortOrder:ImGuiTableColumnSortSpecs] :: ImGuiTableColumnSortSpecs -> ImS16
+ DearImGui.Raw: [$sel:specs:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> Ptr ImGuiTableColumnSortSpecs
+ DearImGui.Raw: [$sel:specsCount:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> CInt
+ DearImGui.Raw: [$sel:specsDirty:ImGuiTableSortSpecs] :: ImGuiTableSortSpecs -> CBool
+ DearImGui.Raw: beginPopupContextItem :: MonadIO m => CString -> ImGuiPopupFlags -> m Bool
+ DearImGui.Raw: beginPopupContextVoid :: MonadIO m => CString -> ImGuiPopupFlags -> m Bool
+ DearImGui.Raw: beginPopupContextWindow :: MonadIO m => CString -> ImGuiPopupFlags -> m Bool
+ DearImGui.Raw: beginTable :: MonadIO m => CString -> CInt -> ImGuiTableFlags -> Ptr ImVec2 -> CFloat -> m Bool
+ DearImGui.Raw: data ImGuiTableColumnSortSpecs
+ DearImGui.Raw: data ImGuiTableSortSpecs
+ DearImGui.Raw: endTable :: MonadIO m => m ()
+ DearImGui.Raw: isPopupOpen :: MonadIO m => CString -> ImGuiPopupFlags -> m Bool
+ DearImGui.Raw: openPopupOnItemClick :: MonadIO m => CString -> ImGuiPopupFlags -> m ()
+ DearImGui.Raw: tableClearSortSpecsDirty :: MonadIO m => Ptr ImGuiTableSortSpecs -> m ()
+ DearImGui.Raw: tableGetColumnCount :: MonadIO m => m CInt
+ DearImGui.Raw: tableGetColumnFlags :: MonadIO m => Maybe CInt -> m ImGuiTableColumnFlags
+ DearImGui.Raw: tableGetColumnIndex :: MonadIO m => m CInt
+ DearImGui.Raw: tableGetColumnName :: MonadIO m => Maybe CInt -> m CString
+ DearImGui.Raw: tableGetRowIndex :: MonadIO m => m CInt
+ DearImGui.Raw: tableGetSortSpecs :: MonadIO m => m (Maybe (Ptr ImGuiTableSortSpecs))
+ DearImGui.Raw: tableHeader :: MonadIO m => CString -> m ()
+ DearImGui.Raw: tableHeadersRow :: MonadIO m => m ()
+ DearImGui.Raw: tableNextColumn :: MonadIO m => m Bool
+ DearImGui.Raw: tableNextRow :: MonadIO m => ImGuiTableRowFlags -> CFloat -> m ()
+ DearImGui.Raw: tableSetBgColor :: MonadIO m => ImGuiTableBgTarget -> ImU32 -> Maybe CInt -> m ()
+ DearImGui.Raw: tableSetColumnEnabled :: MonadIO m => CInt -> CBool -> m ()
+ DearImGui.Raw: tableSetColumnIndex :: MonadIO m => CInt -> m Bool
+ DearImGui.Raw: tableSetupColumn :: MonadIO m => CString -> ImGuiTableColumnFlags -> CFloat -> ImGuiID -> m ()
+ DearImGui.Raw: tableSetupScrollFreeze :: MonadIO m => CInt -> CInt -> m ()
+ DearImGui.Raw: type Count a :: Nat;
+ DearImGui.Raw: type ImGuiID = ImU32
+ DearImGui.Raw: type ImS16 = Int16
- DearImGui: dragScalar :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m) => String -> ImGuiDataType -> ref -> Float -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
+ DearImGui: dragScalar :: (HasSetter ref a, HasGetter ref a, HasGetter range a, Storable a, MonadIO m) => String -> ImGuiDataType -> ref -> Float -> range -> range -> String -> ImGuiSliderFlags -> m Bool
- DearImGui: dragScalarN :: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m) => String -> ImGuiDataType -> valueRef -> Float -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool
+ DearImGui: dragScalarN :: (HasSetter ref [a], HasGetter ref [a], HasGetter range a, Storable a, MonadIO m) => String -> ImGuiDataType -> ref -> Float -> range -> range -> String -> ImGuiSliderFlags -> m Bool
- DearImGui: sliderScalar :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m) => String -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
+ DearImGui: sliderScalar :: (HasGetter ref a, HasSetter ref a, HasGetter range a, Storable a, MonadIO m) => String -> ImGuiDataType -> ref -> range -> range -> String -> ImGuiSliderFlags -> m Bool
- DearImGui: sliderScalarN :: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m) => String -> ImGuiDataType -> valueRef -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool
+ DearImGui: sliderScalarN :: (HasSetter value [a], HasGetter value [a], HasGetter range a, Storable a, MonadIO m) => String -> ImGuiDataType -> value -> range -> range -> String -> ImGuiSliderFlags -> m Bool
- DearImGui: vSliderScalar :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m) => String -> ImVec2 -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
+ DearImGui: vSliderScalar :: (HasSetter ref a, HasGetter ref a, HasGetter range a, Storable a, MonadIO m) => String -> ImVec2 -> ImGuiDataType -> ref -> range -> range -> String -> ImGuiSliderFlags -> m Bool
- DearImGui.Raw: selectable :: MonadIO m => CString -> m Bool
+ DearImGui.Raw: selectable :: MonadIO m => CString -> CBool -> ImGuiSelectableFlags -> Ptr ImVec2 -> m Bool

Files

ChangeLog.md view
@@ -1,5 +1,12 @@ # Changelog for dear-imgui +## [1.5.0]++- Added table wrappers.+- Added popup wrappers.+- Added `selectableWith`/`SelectableOptions` to expose optional arguments.+- Fix GHC-9.2 compatibility.+ ## [1.4.0]  - `imgui` updated to [1.87].@@ -68,6 +75,7 @@ [1.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.0 [1.3.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.1 [1.4.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.4.0+[1.5.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.5.0  [1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87 [1.86]: https://github.com/ocornut/imgui/releases/tag/v1.86
dear-imgui.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: dear-imgui-version: 1.4.0+version: 1.5.0 author: Oliver Charles maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com license: BSD-3-Clause
examples/glfw/Main.hs view
@@ -1,6 +1,7 @@ {-# language BlockArguments #-} {-# language LambdaCase #-} {-# language OverloadedStrings #-}+{-# language RecordWildCards #-}  module Main ( main ) where @@ -8,6 +9,11 @@ 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 @@         -- 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@@ -64,13 +79,19 @@       text "Hello, ImGui!"        -- Add a button widget, and call 'putStrLn' when it's clicked-      button "Clickety Click" >>= \case-        False -> return ()-        True  -> putStrLn "Ow!"+      clicking <- button "Clickety Click"+      when clicking $+        putStrLn "Ow!"+      itemContextPopup do+        text "pop!"+        button "ok" >>= \clicked ->+          when clicked $+            closeCurrentPopup -    -- Show the ImGui demo window-    showDemoWindow+      newLine +      mkTable tableRef+     -- Render     glClear GL_COLOR_BUFFER_BIT @@ -79,4 +100,41 @@      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+      }
examples/vulkan/Backend.hs view
@@ -190,11 +190,11 @@   device <- logDebug "Creating logical device" *>     Vulkan.Utils.createDeviceFromRequirements swapchainDeviceRequirements [] physicalDevice deviceCreateInfo   queue  <- Vulkan.getDeviceQueue device ( fromIntegral queueFamily ) 0-  +   pure ( VulkanContext { .. } )-    + vulkanInstanceInfo   :: MonadVulkan m   => ByteString@@ -206,7 +206,7 @@   let     validationLayer :: Maybe ValidationLayerName     validationLayer-      = coerce +      = coerce       . foldMap         (  (  Vulkan.layerName :: Vulkan.LayerProperties -> ByteString )         >>> \case@@ -374,11 +374,10 @@        case sortOn ( Down . score ) ( Boxed.Vector.toList surfaceFormats ) of         [] -> error "No formats found."-        ( best : _ )-          | Vulkan.FORMAT_UNDEFINED <- ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) best-            -> pure preferredFormat-          | otherwise-            -> pure best+        Vulkan.SurfaceFormatKHR{format=Vulkan.FORMAT_UNDEFINED} : _rest ->+          pure preferredFormat+        best : _rest+          -> pure best      where       match :: Eq a => a -> a -> Int@@ -406,20 +405,17 @@   surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )    ( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface )-  +   let     presentMode :: Vulkan.PresentModeKHR-    presentMode +    presentMode       | Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes       = Vulkan.PRESENT_MODE_MAILBOX_KHR       | otherwise       = Vulkan.PRESENT_MODE_FIFO_KHR -    currentExtent :: Vulkan.Extent2D-    currentExtent = ( Vulkan.currentExtent :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.Extent2D ) surfaceCapabilities--    currentTransform :: Vulkan.SurfaceTransformFlagBitsKHR-    currentTransform = ( Vulkan.currentTransform :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.SurfaceTransformFlagBitsKHR ) surfaceCapabilities+    Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities+    Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat      swapchainCreateInfo :: Vulkan.SwapchainCreateInfoKHR '[]     swapchainCreateInfo =@@ -428,8 +424,8 @@         , Vulkan.flags                 = Vulkan.zero         , Vulkan.surface               = Vulkan.SurfaceKHR surface         , Vulkan.minImageCount         = imageCount-        , Vulkan.imageFormat           = ( Vulkan.format     :: Vulkan.SurfaceFormatKHR -> Vulkan.Format        ) surfaceFormat-        , Vulkan.imageColorSpace       = ( Vulkan.colorSpace :: Vulkan.SurfaceFormatKHR -> Vulkan.ColorSpaceKHR ) surfaceFormat+        , Vulkan.imageFormat           = fmt+        , Vulkan.imageColorSpace       = csp         , Vulkan.imageExtent           = currentExtent         , Vulkan.imageArrayLayers      = 1         , Vulkan.imageUsage            = imageUsage@@ -494,7 +490,7 @@         { Vulkan.next         = ()         , Vulkan.flags        = Vulkan.zero         , Vulkan.attachments  = Boxed.Vector.fromList attachmentDescriptions-        , Vulkan.subpasses    = Boxed.Vector.singleton subpass +        , Vulkan.subpasses    = Boxed.Vector.singleton subpass         , Vulkan.dependencies = Boxed.Vector.fromList [ dependency1, dependency2 ]         } @@ -591,7 +587,7 @@   -> Vulkan.Extent2D   -> f Vulkan.ImageView   -> m ( ResourceT.ReleaseKey, Vulkan.Framebuffer )-createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate+createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate   where     createInfo :: Vulkan.FramebufferCreateInfo '[]     createInfo =@@ -600,8 +596,8 @@         , Vulkan.flags       = Vulkan.zero         , Vulkan.renderPass  = renderPass         , Vulkan.attachments = Boxed.Vector.fromList . toList $ attachments-        , Vulkan.width       = ( Vulkan.width  :: Vulkan.Extent2D -> Word32 ) extent-        , Vulkan.height      = ( Vulkan.height :: Vulkan.Extent2D -> Word32 ) extent+        , Vulkan.width       = width+        , Vulkan.height      = height         , Vulkan.layers      = 1         } 
examples/vulkan/Main.hs view
@@ -201,9 +201,7 @@   surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )    let-    minImageCount, maxImageCount, imageCount :: Word32-    minImageCount = ( Vulkan.minImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities-    maxImageCount = ( Vulkan.maxImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities+    Vulkan.SurfaceCapabilitiesKHR{minImageCount, maxImageCount} = surfaceCapabilities     imageCount       | maxImageCount == 0 =   minImageCount + 1       | otherwise          = ( minImageCount + 1 ) `min` maxImageCount@@ -213,31 +211,30 @@      swapchainResources :: Maybe SwapchainResources -> m ( m (), SwapchainResources )     swapchainResources mbOldResources = do-      ( surfaceFormat, imGuiRenderPass ) <- case mbOldResources of+      ( colFmt, surfaceFormat, imGuiRenderPass ) <- case mbOldResources of         Nothing -> do           logDebug "Choosing swapchain format & color space"           surfaceFormat <- chooseSwapchainFormat preferredFormat physicalDevice surface-          let-            colFmt :: Vulkan.Format-            colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat+          let Vulkan.SurfaceFormatKHR{format=colFmt} = surfaceFormat           logDebug "Creating Dear ImGui render pass"           ( _, imGuiRenderPass ) <-             simpleRenderPass device               ( noAttachments                 { colorAttachments = Boxed.Vector.singleton $ presentableColorAttachmentDescription colFmt }               )-          pure ( surfaceFormat, imGuiRenderPass )-        Just oldResources -> pure ( surfaceFormat oldResources, imGuiRenderPass oldResources )--      let-        colFmt :: Vulkan.Format-        colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat+          pure ( colFmt, surfaceFormat, imGuiRenderPass )+        Just oldResources -> do+          let surFmt = surfaceFormat oldResources+          let Vulkan.SurfaceFormatKHR{format=colFmt} = surFmt+          pure ( colFmt, surFmt, imGuiRenderPass oldResources )        logDebug "Creating swapchain"       ( swapchainKey, swapchain, swapchainExtent ) <-         createSwapchain-          physicalDevice device-          surface surfaceFormat+          physicalDevice+          device+          surface+          surfaceFormat           surfaceUsage           imageCount           ( swapchain <$> mbOldResources )
generator/DearImGui/Generator.hs view
@@ -24,6 +24,10 @@   ( for ) import Foreign.Storable   ( Storable )+#if MIN_VERSION_template_haskell(2,18,0)+import Data.Coerce+  ( coerce )+#endif  -- containers import Data.Map.Strict@@ -171,7 +175,7 @@         else           \ nm args dir pat ->           TH.patSynD_doc nm args dir pat-            ( Just $ Text.unpack patDoc ) []+            ( Just $ Text.unpack _patDoc ) []       ) #else       TH.patSynD
src/DearImGui.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}  {-|@@ -183,6 +184,47 @@   , colorPicker3   , colorButton +    -- ** Tables+  , withTable+  , withTableOpen+  , TableOptions(..)+  , defTableOptions+  , beginTable+  , Raw.endTable++    -- *** Setup+  , tableSetupColumn+  , tableSetupColumnWith+  , TableColumnOptions(..)+  , defTableColumnOptions++  , Raw.tableHeadersRow+  , Raw.tableHeader+  , tableSetupScrollFreeze++    -- *** Rows+  , tableNextRow+  , tableNextRowWith+  , TableRowOptions(..)+  , defTableRowOptions++    -- *** Columns+  , tableNextColumn+  , tableSetColumnIndex++    -- *** Sorting+  , withSortableTable+  , TableSortingSpecs(..)++    -- *** Queries+  , tableGetColumnCount+  , tableGetColumnIndex+  , tableGetRowIndex+  , tableGetColumnName+  , tableGetColumnFlags+  , tableSetColumnEnabled+  , tableSetBgColor+     -- ** Trees   , treeNode   , treePush@@ -190,6 +232,9 @@      -- ** Selectables   , selectable+  , selectableWith+  , SelectableOptions(..)+  , defSelectableOptions      -- ** List Boxes   , listBox@@ -234,19 +279,46 @@   , Raw.endTooltip      -- * Popups/Modals++    -- ** Generic   , withPopup   , withPopupOpen   , beginPopup+  , Raw.endPopup +    -- ** Modal   , withPopupModal   , withPopupModalOpen   , beginPopupModal -  , Raw.endPopup+    -- ** Item context+  , itemContextPopup+  , withPopupContextItemOpen+  , withPopupContextItem+  , beginPopupContextItem +    -- ** Window context+  , windowContextPopup+  , withPopupContextWindowOpen+  , withPopupContextWindow+  , beginPopupContextWindow++    -- ** Void context+  , voidContextPopup+  , withPopupContextVoidOpen+  , withPopupContextVoid+  , beginPopupContextVoid++    -- ** Manual   , openPopup+  , openPopupOnItemClick   , Raw.closeCurrentPopup +    -- ** Queries+  , isCurrentPopupOpen+  , isAnyPopupOpen+  , isAnyLevelPopupOpen+     -- * Item/Widgets Utilities   , Raw.isItemHovered   , Raw.wantCaptureMouse@@ -775,8 +847,8 @@       return changed  dragScalar-  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)-  => String -> ImGuiDataType -> ref -> Float -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool+  :: (HasSetter ref a, HasGetter ref a, HasGetter range a, Storable a, MonadIO m)+  => String -> ImGuiDataType -> ref -> Float -> range -> range -> String -> ImGuiSliderFlags -> m Bool dragScalar label dataType ref vSpeed refMin refMax format flags = liftIO do   currentValue <- get ref   minValue <- get refMin@@ -805,8 +877,8 @@         return changed  dragScalarN-  :: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m)-  => String -> ImGuiDataType -> valueRef -> Float -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool+  :: (HasSetter ref [a], HasGetter ref [a], HasGetter range a, Storable a, MonadIO m)+  => String -> ImGuiDataType -> ref -> Float -> range -> range -> String -> ImGuiSliderFlags -> m Bool dragScalarN label dataType ref vSpeed refMin refMax format flags = liftIO do   currentValues <- get ref   minValue <- get refMin@@ -836,8 +908,8 @@         return changed  sliderScalar-  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)-  => String -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool+  :: (HasGetter ref a, HasSetter ref a, HasGetter range a, Storable a, MonadIO m)+  => String -> ImGuiDataType -> ref -> range -> range -> String -> ImGuiSliderFlags -> m Bool sliderScalar label dataType ref refMin refMax format flags = liftIO do   currentValue <- get ref   minValue <- get refMin@@ -865,8 +937,8 @@         return changed  sliderScalarN-  :: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m)-  => String -> ImGuiDataType -> valueRef -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool+  :: (HasSetter value [a], HasGetter value [a], HasGetter range a, Storable a, MonadIO m)+  => String -> ImGuiDataType -> value -> range -> range -> String -> ImGuiSliderFlags -> m Bool sliderScalarN label dataType ref refMin refMax format flags = liftIO do   currentValues <- get ref   minValue <- get refMin@@ -1115,8 +1187,8 @@       return changed  vSliderScalar-  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)-  => String -> ImVec2 -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool+  :: (HasSetter ref a, HasGetter ref a, HasGetter range a, Storable a, MonadIO m)+  => String -> ImVec2 -> ImGuiDataType -> ref -> range -> range -> String -> ImGuiSliderFlags -> m Bool vSliderScalar label size dataType ref refMin refMax format flags = liftIO do   currentValue <- get ref   minValue <- get refMin@@ -1244,7 +1316,229 @@      return changed +data TableOptions = TableOptions+  { tableFlags      :: ImGuiTableFlags+  , tableOuterSize  :: ImVec2+  , tableInnerWidth :: Float+  } deriving Show +defTableOptions :: TableOptions+defTableOptions = TableOptions+  { tableFlags      = ImGuiTableFlags_None+  , tableOuterSize  = ImVec2 0  0+  , tableInnerWidth = 0+  }+-- | Wraps @ImGui::BeginTable()@.+beginTable :: MonadIO m => TableOptions -> String -> Int -> m Bool+beginTable TableOptions{..} label columns = liftIO do+  withCString label \labelPtr ->+    with tableOuterSize \outerSizePtr ->+      Raw.beginTable labelPtr (fromIntegral columns) tableFlags outerSizePtr (CFloat tableInnerWidth)++-- | Create a table.+--+-- The action will get 'False' if the entry is not visible.+--+-- ==== __Example usage:__+--+-- > 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:+--+-- @+-- | 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)++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+  , tableRowMinHeight :: Float+  } deriving Show++defTableRowOptions :: TableRowOptions+defTableRowOptions = TableRowOptions+  { tableRowFlags     = ImGuiTableRowFlags_None+  , tableRowMinHeight = 0+  }++-- | Wraps @ImGui::TableNextRow()@ with explicit options.+tableNextRowWith :: MonadIO m => TableRowOptions -> m ()+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.+tableSetColumnIndex :: MonadIO m => Int -> m Bool+tableSetColumnIndex column = liftIO do+  Raw.tableSetColumnIndex (fromIntegral column)++data TableColumnOptions = TableColumnOptions+  { tableColumnFlags             :: ImGuiTableColumnFlags+  , tableColumnInitWidthOrWeight :: Float+  , tableColumnUserId            :: ImGuiID+  } deriving Show++defTableColumnOptions :: TableColumnOptions+defTableColumnOptions = TableColumnOptions+  { tableColumnFlags             = ImGuiTableColumnFlags_None+  , tableColumnInitWidthOrWeight = 0+  , tableColumnUserId            = 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{..} 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.+tableSetupScrollFreeze :: MonadIO m => Int -> Int -> m ()+tableSetupScrollFreeze cols rows = liftIO do+  Raw.tableSetupScrollFreeze (fromIntegral cols) (fromIntegral rows)++data TableSortingSpecs = TableSortingSpecs+  { 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+--   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:__+--+-- > 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+-- >     for_ sortedData \(a, b) -> do+-- >       tableNextRow+-- >       tableNextColumn $ text a+-- >       tableNextColumn $ text b+withSortableTable :: MonadIO m => (Bool -> [TableSortingSpecs] -> m ()) -> m ()+withSortableTable action = do+  liftIO Raw.tableGetSortSpecs >>= \case+    Nothing ->+      -- XXX: The table is not sortable+      pure ()++    Just specsPtr -> do+      ImGuiTableSortSpecs{..} <- liftIO $ peek specsPtr+      let isDirty = 0 /= specsDirty+      columns <- liftIO $ peekArray (fromIntegral specsCount) specs++      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 =+  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 treeNode label = liftIO do@@ -1257,12 +1551,31 @@   withCString label Raw.treePush  --- | Wraps @ImGui::Selectable()@.+-- | Wraps @ImGui::Selectable()@ with default options. selectable :: MonadIO m => String -> m Bool-selectable label = liftIO do-  withCString label Raw.selectable+selectable = selectableWith defSelectableOptions +data SelectableOptions = SelectableOptions+  { selected :: Bool+  , flags    :: ImGuiSelectableFlags+  , size     :: ImVec2+  } deriving Show +defSelectableOptions :: SelectableOptions+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 ->+      Raw.selectable labelPtr (bool 0 1 selected) flags sizePtr++ listBox :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool listBox label selectedIndex items = liftIO $ Managed.with m return   where@@ -1479,6 +1792,52 @@ withPopupModalOpen popupId action =   withPopupModal popupId (`when` action) +beginPopupContextItem :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool+beginPopupContextItem itemId flags = liftIO do+  withCStringOrNull itemId \popupIdPtr ->+    Raw.beginPopupContextItem popupIdPtr flags++withPopupContextItem :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a+withPopupContextItem popupId flags = bracket (beginPopupContextItem popupId flags) (`when` Raw.endPopup)++withPopupContextItemOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()+withPopupContextItemOpen popupId flags action = withPopupContextItem popupId flags (`when` action)++-- | Attach item context popup to right mouse button click on a last item.+itemContextPopup :: MonadUnliftIO m => m () -> m ()+itemContextPopup = withPopupContextItemOpen Nothing ImGuiPopupFlags_MouseButtonRight++beginPopupContextWindow :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool+beginPopupContextWindow popupId flags = liftIO do+  withCStringOrNull popupId \popupIdPtr ->+    Raw.beginPopupContextWindow popupIdPtr flags++withPopupContextWindow :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a+withPopupContextWindow popupId flags = bracket (beginPopupContextWindow popupId flags) (`when` Raw.endPopup)++withPopupContextWindowOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()+withPopupContextWindowOpen popupId flags action = withPopupContextWindow popupId flags (`when` action)++-- | Attach item context popup to right mouse button click on a current window.+windowContextPopup :: MonadUnliftIO m => m () -> m ()+windowContextPopup = withPopupContextWindowOpen Nothing ImGuiPopupFlags_MouseButtonRight++beginPopupContextVoid :: MonadIO m => Maybe String -> ImGuiPopupFlags -> m Bool+beginPopupContextVoid popupId flags = liftIO do+  withCStringOrNull popupId \popupIdPtr ->+    Raw.beginPopupContextVoid popupIdPtr flags++withPopupContextVoid :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> (Bool -> m a) -> m a+withPopupContextVoid popupId flags = bracket (beginPopupContextVoid popupId flags) (`when` Raw.endPopup)++withPopupContextVoidOpen :: MonadUnliftIO m => Maybe String -> ImGuiPopupFlags -> m () -> m ()+withPopupContextVoidOpen popupId flags action = withPopupContextVoid popupId flags (`when` action)++-- | Attach item context popup to right mouse button click outside of any windows.+voidContextPopup :: MonadUnliftIO m => m () -> m ()+voidContextPopup = withPopupContextWindowOpen Nothing ImGuiPopupFlags_MouseButtonRight++ -- | Call to mark popup as open (don't call every frame!). -- -- Wraps @ImGui::OpenPopup()@@@ -1486,7 +1845,38 @@ openPopup popupId = liftIO do   withCString popupId Raw.openPopup +-- | Opens a defined popup (i.e. defined with 'withPopup') on defined action.+--+-- Example:+--+-- > openPopupOnItemClick "myPopup" ImGuiPopupFlags_MouseButtonRight+--+-- Wraps @ImGui::OpenPopup()@+openPopupOnItemClick :: MonadIO m => String -> ImGuiPopupFlags -> m ()+openPopupOnItemClick popupId flags = liftIO do+  withCString popupId $ \idPtr ->+    Raw.openPopupOnItemClick idPtr flags +-- | Check if the popup is open at the current 'beginPopup' level of the popup stack.+isCurrentPopupOpen :: MonadIO m => String -> m Bool+isCurrentPopupOpen popupId = liftIO do+  withCString popupId $ \idPtr ->+    Raw.isPopupOpen idPtr ImGuiPopupFlags_None++-- | Check if *any* popup is open at the current 'beginPopup' level of the popup stack.+isAnyPopupOpen :: MonadIO m => String -> m Bool+isAnyPopupOpen popupId = liftIO do+  withCString popupId $ \idPtr ->+    Raw.isPopupOpen idPtr ImGuiPopupFlags_AnyPopupId++-- | Check if *any* popup is open at any level of the popup stack.+isAnyLevelPopupOpen :: MonadIO m => String -> m Bool+isAnyLevelPopupOpen popupId = liftIO do+  withCString popupId $ \idPtr ->+    Raw.isPopupOpen idPtr $+      ImGuiPopupFlags_AnyPopupId .|. ImGuiPopupFlags_AnyPopupLevel++ withCStringOrNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a withCStringOrNull Nothing k  = k nullPtr withCStringOrNull (Just s) k = withCString s k@@ -1495,7 +1885,12 @@ -- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc. -- -- Wraps @ImGui::SetNextWindowPos()@-setNextWindowPos :: (MonadIO m, HasGetter ref ImVec2) => ref -> ImGuiCond -> Maybe ref -> m ()+setNextWindowPos+  :: (MonadIO m, HasGetter ref ImVec2)+  => ref+  -> ImGuiCond+  -> Maybe ref -- XXX: the type should be distinct, but using `setNextWindowPos .. Nothing` is ambiguous resulting in bad UX.+  -> m () setNextWindowPos posRef cond pivotMaybe = liftIO do   pos <- get posRef   with pos $ \posPtr ->
src/DearImGui/Context.hs view
@@ -34,6 +34,7 @@       , ( 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 @@       , ( TypeName "ImFontConfig", [t| ImFontConfig |] )       , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] )       , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] )+      , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] )       ]   }
src/DearImGui/Raw.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} @@ -157,6 +158,29 @@   , colorPicker3   , colorButton +    -- * Tables+  , beginTable+  , endTable+  , tableNextRow+  , tableNextColumn+  , tableSetColumnIndex++  , tableSetupColumn+  , tableSetupScrollFreeze+  , tableHeadersRow+  , tableHeader++  , tableGetSortSpecs+  , tableClearSortSpecsDirty++  , tableGetColumnCount+  , tableGetColumnIndex+  , tableGetRowIndex+  , tableGetColumnName+  , tableGetColumnFlags+  , tableSetColumnEnabled+  , tableSetBgColor+     -- * Trees   , treeNode   , treePush@@ -197,7 +221,12 @@   , beginPopupModal   , endPopup   , openPopup+  , openPopupOnItemClick   , closeCurrentPopup+  , beginPopupContextItem+  , beginPopupContextWindow+  , beginPopupContextVoid+  , isPopupOpen      -- * ID stack/scopes   , pushIDInt@@ -1063,6 +1092,128 @@   (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++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+  [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@@ -1081,12 +1232,19 @@   [C.exp| void { TreePop() } |]  +-- -- | Wraps @ImGui::Selectable()@.+-- selectable :: (MonadIO m) => CString -> m Bool+-- selectable labelPtr = liftIO do+--   (0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]++ -- | Wraps @ImGui::Selectable()@.-selectable :: (MonadIO m) => CString -> m Bool-selectable labelPtr = liftIO do-  (0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]+selectable :: (MonadIO m) => CString -> CBool -> ImGuiSelectableFlags -> Ptr ImVec2 -> m Bool+selectable labelPtr selected flags size = liftIO do+  (0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr), $(bool selected), $(ImGuiSelectableFlags flags), *$(ImVec2 *size)) } |]  + -- | Wraps @ImGui::ListBox()@. listBox :: (MonadIO m) => CString -> Ptr CInt -> Ptr CString -> CInt -> m Bool listBox labelPtr iPtr itemsPtr itemsLen = liftIO do@@ -1253,12 +1411,52 @@   [C.exp| void { OpenPopup($(char* popupIdPtr)) } |]  +-- | Open popup when clicked on last item.+--+-- Note: actually triggers on the mouse _released_ event to be consistent with popup behaviors.+--+-- Wraps @ImGui::OpenPopupOnItemClick()@+openPopupOnItemClick :: (MonadIO m) => CString -> ImGuiPopupFlags-> m ()+openPopupOnItemClick popupIdPtr flags = liftIO do+  [C.exp| void { OpenPopupOnItemClick($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]++ -- | Manually close the popup we have begin-ed into. -- -- Wraps @ImGui::ClosePopup()@ closeCurrentPopup :: (MonadIO m) => m () closeCurrentPopup = liftIO do   [C.exp| void { CloseCurrentPopup() } |]++-- | Open+begin popup when clicked on last item.+--+-- Use str_id==NULL to associate the popup to previous item.+--+-- If you want to use that on a non-interactive item such as 'text' you need to pass in an explicit ID here.+beginPopupContextItem :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool+beginPopupContextItem popupIdPtr flags = liftIO do+  (0 /=) <$> [C.exp| bool { BeginPopupContextItem($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]++-- | Open+begin popup when clicked on current window.+beginPopupContextWindow :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool+beginPopupContextWindow popupIdPtr flags = liftIO do+  (0 /=) <$> [C.exp| bool { BeginPopupContextWindow($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]++-- | Open+begin popup when clicked in void (where there are no windows).+beginPopupContextVoid :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool+beginPopupContextVoid popupIdPtr flags = liftIO do+  (0 /=) <$> [C.exp| bool { BeginPopupContextVoid($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]++-- | Query popup status+--+-- - return 'True' if the popup is open at the current 'beginPopup' level of the popup stack.+-- - with 'ImGuiPopupFlags_AnyPopupId': return 'True' if any popup is open at the current 'beginPopup' level of the popup stack.+-- - with 'ImGuiPopupFlags_AnyPopupId' | 'ImGuiPopupFlags_AnyPopupLevel': return 'True' if any popup is open.+--+-- Wraps @ImGui::IsPopupOpen()@+isPopupOpen :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool+isPopupOpen popupIdPtr flags = liftIO do+  (0 /=) <$> [C.exp| bool { IsPopupOpen($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]   -- | Is the last item hovered? (and usable, aka not blocked by a popup, etc.).
src/DearImGui/Structs.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-}  module DearImGui.Structs where@@ -13,8 +14,13 @@   )  import Foreign-  ( Storable(..), castPtr, plusPtr )+  ( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr )+import Foreign.C+  ( CInt, CBool ) +import DearImGui.Enums+import Data.Bits ((.&.))+ -------------------------------------------------------------------------------- data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }   deriving (Show)@@ -98,12 +104,111 @@ -- | '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 = ImU32+ -- | 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+  { 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)++  alignment _ =+    alignment nullPtr++  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+    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+  { 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 _ = 12+  alignment _ = 4++  poke ptr ImGuiTableColumnSortSpecs{..} = do+    let columnUserIDPtr = castPtr ptr+    poke columnUserIDPtr columnUserID++    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+    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{..}