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 +8/−0
- dear-imgui.cabal +1/−1
- examples/glfw/Main.hs +67/−9
- examples/vulkan/Backend.hs +17/−21
- examples/vulkan/Main.hs +12/−15
- generator/DearImGui/Generator.hs +5/−1
- src/DearImGui.hs +410/−15
- src/DearImGui/Context.hs +2/−0
- src/DearImGui/Raw.hs +201/−3
- src/DearImGui/Structs.hs +106/−1
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{..}