2 Commits

Author SHA1 Message Date
a4237d369f fixed compile-errors. 2022-03-21 13:44:14 +01:00
69a9bf50a5 switched deps 2022-03-21 13:24:22 +01:00
27 changed files with 473 additions and 788 deletions

View File

@ -4,19 +4,19 @@ jobs:
build: build:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- uses: actions/checkout@v2.4.0 - uses: actions/checkout@v2.3.4
with: with:
persist-credentials: false persist-credentials: false
submodules: true submodules: true
- uses: cachix/install-nix-action@v20 - uses: cachix/install-nix-action@v16
with: with:
nix_path: nixpkgs=channel:nixos-unstable nix_path: nixpkgs=channel:nixos-unstable
- uses: cachix/cachix-action@v12 - uses: cachix/cachix-action@v10
with: with:
name: hs-dear-imgui name: hs-dear-imgui
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
- run: nix-build --version - run: nix-build --version
- run: nix-build -A hsPkgs.dear-imgui.components.exes - run: nix-build -A hsPkgs.dear-imgui.components.exes

3
.gitmodules vendored
View File

@ -1,3 +1,4 @@
[submodule "imgui"] [submodule "imgui"]
path = imgui path = imgui
url = https://github.com/ocornut/imgui url = https://github.com/Drezil/imgui
branch = textAlign

View File

@ -1,38 +1,5 @@
# Changelog for dear-imgui # Changelog for dear-imgui
## [2.1.3]
- Fixed off-by-1 in internal Text wrapper.
- Fixed sliderFloat* Raw calls
- Added `formatPtr` to Raw.dragFloat* and Raw.sliderFloat*
## [2.1.2]
- Fixed glfw example build flags.
- Added `plotLines`.
- Added `setNextItemOpen`.
## [2.1.1]
- Build flag fix for MacOS.
## [2.1.0]
- `imgui` updated to [1.88].
* Breaking: `ImGuiKeyModFlags` renamed to `ImGuiModFlags`.
## [2.0.0]
- `String` arguments replaced with `Text`.
* Upgrading to `text-2` recommended to reap the UTF-8 benefits.
## [1.5.0]
- Added table wrappers.
- Added popup wrappers.
- Added `selectableWith`/`SelectableOptions` to expose optional arguments.
- Fix GHC-9.2 compatibility.
## [1.4.0] ## [1.4.0]
- `imgui` updated to [1.87]. - `imgui` updated to [1.87].
@ -101,12 +68,6 @@ Initial Hackage release based on [1.83].
[1.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.0 [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.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.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
[2.0.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.0.0
[2.1.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.0
[2.1.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.1
[2.1.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.2
[2.1.3]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.3
[1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87 [1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87
[1.86]: https://github.com/ocornut/imgui/releases/tag/v1.86 [1.86]: https://github.com/ocornut/imgui/releases/tag/v1.86

View File

@ -10,7 +10,6 @@ import Data.IORef
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import DearImGui import DearImGui
import DearImGui.OpenGL3 import DearImGui.OpenGL3
import DearImGui.Internal.Text (pack)
import DearImGui.SDL import DearImGui.SDL
import DearImGui.SDL.OpenGL import DearImGui.SDL.OpenGL
import Control.Exception import Control.Exception
@ -135,18 +134,18 @@ loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
text "ListClipper" text "ListClipper"
withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do
let lotsOfItems = Vector.generate 50 (pack . mappend "Item " . show) let lotsOfItems = Vector.generate 50 (mappend "Item " . show)
withListClipper Nothing lotsOfItems text withListClipper Nothing lotsOfItems text
text "ListClipper, Haskell-powered" text "ListClipper, Haskell-powered"
withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do
let infiniteItems = map (pack . mappend "Item " . show) [0 :: Int ..] let infiniteItems = map (mappend "Item " . show) [0 :: Int ..]
withListClipper Nothing infiniteItems text withListClipper Nothing infiniteItems text
text "Ethereal ListClipper" text "Ethereal ListClipper"
withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do
withListClipper Nothing (ClipRange (0 :: Int) 1000) $ withListClipper Nothing (ClipRange (0 :: Int) 1000) $
text . pack . mappend "Item " . show text . mappend "Item " . show
plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ] plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]

View File

@ -1,4 +1,4 @@
packages: *.cabal packages: *.cabal
package dear-imgui package dear-imgui
flags: +sdl +glfw +opengl2 +opengl3 +vulkan +examples flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind

View File

@ -1,7 +1,7 @@
cabal-version: 3.0 cabal-version: 3.0
name: dear-imgui name: dear-imgui
version: 2.1.3 version: 1.4.0
author: Oliver Charles author: Oliver Charles
maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
license: BSD-3-Clause license: BSD-3-Clause
@ -126,21 +126,10 @@ flag use-wchar32
manual: manual:
True True
flag use-ImDrawIdx32
description:
Use 32-bit vertex indices (default is 16-bit) is one way to allow large meshes with more than 64K vertices.
Your renderer backend will need to support it (most example renderer backends support both 16/32-bit indices).
Another way to allow large meshes while keeping 16-bit indices is to handle ImDrawCmd::VtxOffset in your renderer.
Read about ImGuiBackendFlags_RendererHasVtxOffset for details.
default:
True
manual:
True
common common common common
build-depends: build-depends:
base base
>= 4.12 && < 4.19 >= 4.12 && < 4.17
default-language: default-language:
Haskell2010 Haskell2010
@ -151,16 +140,15 @@ library
exposed-modules: exposed-modules:
DearImGui DearImGui
DearImGui.FontAtlas DearImGui.FontAtlas
DearImGui.Internal.Text
DearImGui.Raw DearImGui.Raw
DearImGui.Raw.DrawList DearImGui.Raw.DrawList
DearImGui.Raw.Font DearImGui.Raw.Font
DearImGui.Raw.Font.Config DearImGui.Raw.Font.Config
DearImGui.Raw.Font.GlyphRanges DearImGui.Raw.Font.GlyphRanges
DearImGui.Raw.IO
DearImGui.Raw.ListClipper DearImGui.Raw.ListClipper
DearImGui.Raw.Context DearImGui.Raw.IO
other-modules: other-modules:
DearImGui.Context
DearImGui.Enums DearImGui.Enums
DearImGui.Structs DearImGui.Structs
cxx-options: -std=c++11 cxx-options: -std=c++11
@ -183,11 +171,6 @@ library
, StateVar , StateVar
, unliftio , unliftio
, vector , vector
, text
if os(darwin)
ghc-options:
-optcxx-std=c++11
if flag(disable-obsolete) if flag(disable-obsolete)
cxx-options: -DIMGUI_DISABLE_OBSOLETE_FUNCTIONS cxx-options: -DIMGUI_DISABLE_OBSOLETE_FUNCTIONS
@ -196,10 +179,6 @@ library
cxx-options: -DIMGUI_USE_WCHAR32 cxx-options: -DIMGUI_USE_WCHAR32
cpp-options: -DIMGUI_USE_WCHAR32 cpp-options: -DIMGUI_USE_WCHAR32
if flag(use-ImDrawIdx32)
cxx-options: "-DImDrawIdx=unsigned int"
cpp-options: "-DImDrawIdx=unsigned int"
if flag(opengl2) if flag(opengl2)
exposed-modules: exposed-modules:
DearImGui.OpenGL2 DearImGui.OpenGL2
@ -243,7 +222,7 @@ library
build-depends: build-depends:
sdl2 sdl2
cxx-sources: cxx-sources:
imgui/backends/imgui_impl_sdl2.cpp imgui/backends/imgui_impl_sdl.cpp
if os(windows) || os(darwin) if os(windows) || os(darwin)
extra-libraries: extra-libraries:
@ -291,7 +270,7 @@ library dear-imgui-generator
, DearImGui.Generator.Types , DearImGui.Generator.Types
build-depends: build-depends:
template-haskell template-haskell
>= 2.15 && < 2.21 >= 2.15 && < 2.19
, containers , containers
^>= 0.6.2.1 ^>= 0.6.2.1
, directory , directory
@ -307,11 +286,11 @@ library dear-imgui-generator
, scientific , scientific
>= 0.3.6.2 && < 0.3.8 >= 0.3.6.2 && < 0.3.8
, text , text
>= 1.2.4 && < 2.1 >= 1.2.4 && < 1.3
, th-lift , th-lift
>= 0.7 && < 0.9 >= 0.7 && < 0.9
, transformers , transformers
>= 0.5.6 && < 0.7 >= 0.5.6 && < 0.6
, unordered-containers , unordered-containers
>= 0.2.11 && < 0.3 >= 0.2.11 && < 0.3
@ -332,7 +311,7 @@ executable glfw
if (!flag(examples) || !flag(glfw) || !flag(opengl2)) if (!flag(examples) || !flag(glfw) || !flag(opengl2))
buildable: False buildable: False
else else
build-depends: base, GLFW-b, gl, dear-imgui, managed, text build-depends: base, GLFW-b, gl, dear-imgui, managed
executable readme executable readme
import: common, exe-flags import: common, exe-flags
@ -355,7 +334,7 @@ executable image
main-is: Image.hs main-is: Image.hs
hs-source-dirs: examples/sdl hs-source-dirs: examples/sdl
build-depends: sdl2, gl, dear-imgui, managed, vector build-depends: sdl2, gl, dear-imgui, managed, vector
if (!flag(examples) || !flag(sdl) || !flag(opengl3)) if (!flag(examples) || !flag(sdl) || !flag(opengl2))
buildable: False buildable: False
executable vulkan executable vulkan
@ -382,7 +361,7 @@ executable vulkan
, text-short , text-short
^>= 0.1.3 ^>= 0.1.3
, transformers , transformers
>= 0.5.6 && < 0.7 ^>= 0.5.6.2
, unliftio , unliftio
>= 0.2.13 && < 0.2.19 >= 0.2.13 && < 0.2.19
, unliftio-core , unliftio-core
@ -390,9 +369,8 @@ executable vulkan
, vector , vector
^>= 0.12.1.2 ^>= 0.12.1.2
, vulkan , vulkan
>= 3.12 ^>= 3.9
, vulkan-utils , vulkan-utils
>= 0.5 ^>= 0.4.1
, VulkanMemoryAllocator , VulkanMemoryAllocator
>= 0.7.1
, JuicyPixels , JuicyPixels

View File

@ -1,7 +1,6 @@
{-# language BlockArguments #-} {-# language BlockArguments #-}
{-# language LambdaCase #-} {-# language LambdaCase #-}
{-# language OverloadedStrings #-} {-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
module Main ( main ) where module Main ( main ) where
@ -9,12 +8,6 @@ import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Managed import Control.Monad.Managed
import Data.Bits ((.|.))
import Data.IORef
import Data.List (sortBy)
import Data.Foldable (traverse_)
import Data.Text (Text, pack)
import DearImGui import DearImGui
import DearImGui.OpenGL2 import DearImGui.OpenGL2
import DearImGui.GLFW import DearImGui.GLFW
@ -47,23 +40,14 @@ main = do
-- Initialize ImGui's OpenGL backend -- Initialize ImGui's OpenGL backend
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
tableRef <- liftIO $ newIORef liftIO $ mainLoop win
[ (1, "foo")
, (2, "bar")
, (3, "baz")
, (10, "spam")
, (11, "spam")
, (12, "spam")
]
liftIO $ mainLoop win tableRef
Nothing -> do Nothing -> do
error "GLFW createWindow failed" error "GLFW createWindow failed"
GLFW.terminate GLFW.terminate
mainLoop :: Window -> IORef [(Integer, Text)] -> IO () mainLoop :: Window -> IO ()
mainLoop win tableRef = do mainLoop win = do
-- Process the event loop -- Process the event loop
GLFW.pollEvents GLFW.pollEvents
close <- GLFW.windowShouldClose win close <- GLFW.windowShouldClose win
@ -89,9 +73,8 @@ mainLoop win tableRef = do
when clicked $ when clicked $
closeCurrentPopup closeCurrentPopup
newLine -- Show the ImGui demo window
showDemoWindow
mkTable tableRef
-- Render -- Render
glClear GL_COLOR_BUFFER_BIT glClear GL_COLOR_BUFFER_BIT
@ -101,41 +84,4 @@ mainLoop win tableRef = do
GLFW.swapBuffers win GLFW.swapBuffers win
mainLoop win tableRef mainLoop win
mkTable :: IORef [(Integer, Text)] -> 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 (pack $ 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
}

View File

@ -190,9 +190,9 @@ initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequ
device <- logDebug "Creating logical device" *> device <- logDebug "Creating logical device" *>
Vulkan.Utils.createDeviceFromRequirements swapchainDeviceRequirements [] physicalDevice deviceCreateInfo Vulkan.Utils.createDeviceFromRequirements swapchainDeviceRequirements [] physicalDevice deviceCreateInfo
queue <- Vulkan.getDeviceQueue device ( fromIntegral queueFamily ) 0 queue <- Vulkan.getDeviceQueue device ( fromIntegral queueFamily ) 0
pure ( VulkanContext { .. } ) pure ( VulkanContext { .. } )
vulkanInstanceInfo vulkanInstanceInfo
@ -206,7 +206,7 @@ vulkanInstanceInfo appName = do
let let
validationLayer :: Maybe ValidationLayerName validationLayer :: Maybe ValidationLayerName
validationLayer validationLayer
= coerce = coerce
. foldMap . foldMap
( ( Vulkan.layerName :: Vulkan.LayerProperties -> ByteString ) ( ( Vulkan.layerName :: Vulkan.LayerProperties -> ByteString )
>>> \case >>> \case
@ -374,10 +374,11 @@ chooseSwapchainFormat
case sortOn ( Down . score ) ( Boxed.Vector.toList surfaceFormats ) of case sortOn ( Down . score ) ( Boxed.Vector.toList surfaceFormats ) of
[] -> error "No formats found." [] -> error "No formats found."
Vulkan.SurfaceFormatKHR{format=Vulkan.FORMAT_UNDEFINED} : _rest -> ( best : _ )
pure preferredFormat | Vulkan.FORMAT_UNDEFINED <- ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) best
best : _rest -> pure preferredFormat
-> pure best | otherwise
-> pure best
where where
match :: Eq a => a -> a -> Int match :: Eq a => a -> a -> Int
@ -405,17 +406,20 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) ( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
let let
presentMode :: Vulkan.PresentModeKHR presentMode :: Vulkan.PresentModeKHR
presentMode presentMode
| Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes | Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes
= Vulkan.PRESENT_MODE_MAILBOX_KHR = Vulkan.PRESENT_MODE_MAILBOX_KHR
| otherwise | otherwise
= Vulkan.PRESENT_MODE_FIFO_KHR = Vulkan.PRESENT_MODE_FIFO_KHR
Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities currentExtent :: Vulkan.Extent2D
Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat currentExtent = ( Vulkan.currentExtent :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.Extent2D ) surfaceCapabilities
currentTransform :: Vulkan.SurfaceTransformFlagBitsKHR
currentTransform = ( Vulkan.currentTransform :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.SurfaceTransformFlagBitsKHR ) surfaceCapabilities
swapchainCreateInfo :: Vulkan.SwapchainCreateInfoKHR '[] swapchainCreateInfo :: Vulkan.SwapchainCreateInfoKHR '[]
swapchainCreateInfo = swapchainCreateInfo =
@ -424,8 +428,8 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
, Vulkan.flags = Vulkan.zero , Vulkan.flags = Vulkan.zero
, Vulkan.surface = Vulkan.SurfaceKHR surface , Vulkan.surface = Vulkan.SurfaceKHR surface
, Vulkan.minImageCount = imageCount , Vulkan.minImageCount = imageCount
, Vulkan.imageFormat = fmt , Vulkan.imageFormat = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
, Vulkan.imageColorSpace = csp , Vulkan.imageColorSpace = ( Vulkan.colorSpace :: Vulkan.SurfaceFormatKHR -> Vulkan.ColorSpaceKHR ) surfaceFormat
, Vulkan.imageExtent = currentExtent , Vulkan.imageExtent = currentExtent
, Vulkan.imageArrayLayers = 1 , Vulkan.imageArrayLayers = 1
, Vulkan.imageUsage = imageUsage , Vulkan.imageUsage = imageUsage
@ -490,7 +494,7 @@ simpleRenderPass dev attachments = Vulkan.withRenderPass dev createInfo Nothing
{ Vulkan.next = () { Vulkan.next = ()
, Vulkan.flags = Vulkan.zero , Vulkan.flags = Vulkan.zero
, Vulkan.attachments = Boxed.Vector.fromList attachmentDescriptions , 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 ] , Vulkan.dependencies = Boxed.Vector.fromList [ dependency1, dependency2 ]
} }
@ -587,7 +591,7 @@ createFramebuffer
-> Vulkan.Extent2D -> Vulkan.Extent2D
-> f Vulkan.ImageView -> f Vulkan.ImageView
-> m ( ResourceT.ReleaseKey, Vulkan.Framebuffer ) -> m ( ResourceT.ReleaseKey, Vulkan.Framebuffer )
createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate
where where
createInfo :: Vulkan.FramebufferCreateInfo '[] createInfo :: Vulkan.FramebufferCreateInfo '[]
createInfo = createInfo =
@ -596,8 +600,8 @@ createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vu
, Vulkan.flags = Vulkan.zero , Vulkan.flags = Vulkan.zero
, Vulkan.renderPass = renderPass , Vulkan.renderPass = renderPass
, Vulkan.attachments = Boxed.Vector.fromList . toList $ attachments , Vulkan.attachments = Boxed.Vector.fromList . toList $ attachments
, Vulkan.width = width , Vulkan.width = ( Vulkan.width :: Vulkan.Extent2D -> Word32 ) extent
, Vulkan.height = height , Vulkan.height = ( Vulkan.height :: Vulkan.Extent2D -> Word32 ) extent
, Vulkan.layers = 1 , Vulkan.layers = 1
} }

View File

@ -201,7 +201,9 @@ app = do
surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
let let
Vulkan.SurfaceCapabilitiesKHR{minImageCount, maxImageCount} = surfaceCapabilities minImageCount, maxImageCount, imageCount :: Word32
minImageCount = ( Vulkan.minImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities
maxImageCount = ( Vulkan.maxImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities
imageCount imageCount
| maxImageCount == 0 = minImageCount + 1 | maxImageCount == 0 = minImageCount + 1
| otherwise = ( minImageCount + 1 ) `min` maxImageCount | otherwise = ( minImageCount + 1 ) `min` maxImageCount
@ -211,30 +213,31 @@ app = do
swapchainResources :: Maybe SwapchainResources -> m ( m (), SwapchainResources ) swapchainResources :: Maybe SwapchainResources -> m ( m (), SwapchainResources )
swapchainResources mbOldResources = do swapchainResources mbOldResources = do
( colFmt, surfaceFormat, imGuiRenderPass ) <- case mbOldResources of ( surfaceFormat, imGuiRenderPass ) <- case mbOldResources of
Nothing -> do Nothing -> do
logDebug "Choosing swapchain format & color space" logDebug "Choosing swapchain format & color space"
surfaceFormat <- chooseSwapchainFormat preferredFormat physicalDevice surface surfaceFormat <- chooseSwapchainFormat preferredFormat physicalDevice surface
let Vulkan.SurfaceFormatKHR{format=colFmt} = surfaceFormat let
colFmt :: Vulkan.Format
colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
logDebug "Creating Dear ImGui render pass" logDebug "Creating Dear ImGui render pass"
( _, imGuiRenderPass ) <- ( _, imGuiRenderPass ) <-
simpleRenderPass device simpleRenderPass device
( noAttachments ( noAttachments
{ colorAttachments = Boxed.Vector.singleton $ presentableColorAttachmentDescription colFmt } { colorAttachments = Boxed.Vector.singleton $ presentableColorAttachmentDescription colFmt }
) )
pure ( colFmt, surfaceFormat, imGuiRenderPass ) pure ( surfaceFormat, imGuiRenderPass )
Just oldResources -> do Just oldResources -> pure ( surfaceFormat oldResources, imGuiRenderPass oldResources )
let surFmt = surfaceFormat oldResources
let Vulkan.SurfaceFormatKHR{format=colFmt} = surFmt let
pure ( colFmt, surFmt, imGuiRenderPass oldResources ) colFmt :: Vulkan.Format
colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
logDebug "Creating swapchain" logDebug "Creating swapchain"
( swapchainKey, swapchain, swapchainExtent ) <- ( swapchainKey, swapchain, swapchainExtent ) <-
createSwapchain createSwapchain
physicalDevice physicalDevice device
device surface surfaceFormat
surface
surfaceFormat
surfaceUsage surfaceUsage
imageCount imageCount
( swapchain <$> mbOldResources ) ( swapchain <$> mbOldResources )

View File

@ -24,10 +24,6 @@ import Data.Traversable
( for ) ( for )
import Foreign.Storable import Foreign.Storable
( Storable ) ( Storable )
#if MIN_VERSION_template_haskell(2,18,0)
import Data.Coerce
( coerce )
#endif
-- containers -- containers
import Data.Map.Strict import Data.Map.Strict
@ -175,7 +171,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
else else
\ nm args dir pat -> \ nm args dir pat ->
TH.patSynD_doc nm args dir pat TH.patSynD_doc nm args dir pat
( Just $ Text.unpack _patDoc ) [] ( Just $ Text.unpack patDoc ) []
) )
#else #else
TH.patSynD TH.patSynD

View File

@ -60,7 +60,7 @@ import Data.Text
( Text ) ( Text )
import qualified Data.Text as Text import qualified Data.Text as Text
( all, any, breakOn, drop, dropWhile, dropWhileEnd ( all, any, breakOn, drop, dropWhile, dropWhileEnd
, length, stripPrefix, unlines, unpack, pack , length, stripPrefix, unlines, unpack
) )
-- transformers -- transformers
@ -81,8 +81,6 @@ import DearImGui.Generator.Tokeniser
import DearImGui.Generator.Types import DearImGui.Generator.Types
( Comment(..), Enumeration(..), Headers(..) ) ( Comment(..), Enumeration(..), Headers(..) )
import qualified Text.Show as Text
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Parse error type. -- Parse error type.
@ -92,9 +90,7 @@ data CustomParseError
, problems :: ![Text] , problems :: ![Text]
} }
| MissingForwardDeclaration | MissingForwardDeclaration
{ enumName :: !Text { enumName :: !Text }
, library :: HashMap Text ( TH.Name, Comment )
}
| UnexpectedSection | UnexpectedSection
{ sectionName :: !Text { sectionName :: !Text
, problem :: ![Text] , problem :: ![Text]
@ -105,9 +101,8 @@ instance ShowErrorComponent CustomParseError where
showErrorComponent ( Couldn'tLookupEnumValues { enumName, problems } ) = Text.unpack $ showErrorComponent ( Couldn'tLookupEnumValues { enumName, problems } ) = Text.unpack $
"Couldn't lookup the following values in enum " <> enumName <> ":\n" "Couldn't lookup the following values in enum " <> enumName <> ":\n"
<> Text.unlines ( map ( " - " <> ) problems ) <> Text.unlines ( map ( " - " <> ) problems )
showErrorComponent ( MissingForwardDeclaration { enumName, library } ) = Text.unpack $ showErrorComponent ( MissingForwardDeclaration { enumName } ) = Text.unpack $
"Missing forward declaration for enum named " <> enumName <> "\n" "Missing forward declaration for enum named " <> enumName
<> "In Library: " <> Text.pack ( Text.show library)
showErrorComponent ( UnexpectedSection { sectionName, problem } ) = Text.unpack $ showErrorComponent ( UnexpectedSection { sectionName, problem } ) = Text.unpack $
"Unexpected section name.\n\ "Unexpected section name.\n\
\Expected: " <> sectionName <> "\n\ \Expected: " <> sectionName <> "\n\
@ -129,7 +124,6 @@ headers = do
( _defines, basicEnums ) <- partitionEithers <$> ( _defines, basicEnums ) <- partitionEithers <$>
manyTill manyTill
( ( Left <$> try ignoreDefine ) ( ( Left <$> try ignoreDefine )
<|> ( Left <$> try cppConditional )
<|> ( Right <$> enumeration enumNamesAndTypes ) <|> ( Right <$> enumeration enumNamesAndTypes )
) )
( namedSection "Helpers: Memory allocations macros, ImVector<>" ) ( namedSection "Helpers: Memory allocations macros, ImVector<>" )
@ -140,7 +134,7 @@ headers = do
_ <- skipManyTill anySingle ( namedSection "Misc data structures" ) _ <- skipManyTill anySingle ( namedSection "Misc data structures" )
_ <- skipManyTill anySingle ( namedSection "Helpers (ImGuiOnceUponAFrame, ImGuiTextFilter, ImGuiTextBuffer, ImGuiStorage, ImGuiListClipper, Math Operators, ImColor)" ) _ <- skipManyTill anySingle ( namedSection "Helpers (ImGuiOnceUponAFrame, ImGuiTextFilter, ImGuiTextBuffer, ImGuiStorage, ImGuiListClipper, ImColor)" )
_ <- skipManyTill anySingle ( namedSection "Drawing API (ImDrawCmd, ImDrawIdx, ImDrawVert, ImDrawChannel, ImDrawListSplitter, ImDrawListFlags, ImDrawList, ImDrawData)" ) _ <- skipManyTill anySingle ( namedSection "Drawing API (ImDrawCmd, ImDrawIdx, ImDrawVert, ImDrawChannel, ImDrawListSplitter, ImDrawListFlags, ImDrawList, ImDrawData)" )
skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" ) skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" )
@ -177,24 +171,14 @@ forwardDeclarations = do
pure ( structName, doc ) pure ( structName, doc )
_ <- many comment _ <- many comment
enums <- many do enums <- many do
keyword "enum"
enumName <- identifier
symbol ":"
ty <- cTypeName
reservedSymbol ';'
doc <- commentText <$> comment
pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
_ <- many comment
typedefs <- many do
keyword "typedef" keyword "typedef"
ty <- cTypeName ty <- cTypeName
enumName <- identifier enumName <- identifier
reservedSymbol ';' reservedSymbol ';'
doc <- commentText <$> comment doc <- commentText <$> comment
_ <- many comment
pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) ) pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
-- Stopping after simple structs and enums for now. -- Stopping after simple structs and enums for now.
pure ( HashMap.fromList structs, HashMap.fromList (enums <> typedefs) ) pure ( HashMap.fromList structs, HashMap.fromList enums )
cTypeName :: MonadParsec e [Tok] m => m TH.Name cTypeName :: MonadParsec e [Tok] m => m TH.Name
cTypeName = keyword "int" $> ''CInt cTypeName = keyword "int" $> ''CInt
@ -216,7 +200,6 @@ enumeration enumNamesAndTypes = do
keyword "enum" keyword "enum"
pure inlineDocs pure inlineDocs
fullEnumName <- identifier fullEnumName <- identifier
_ <- try $ (symbol ":" >> cTypeName >> pure ()) <|> pure ()
let let
enumName :: Text enumName :: Text
enumName = Text.dropWhileEnd ( == '_' ) fullEnumName enumName = Text.dropWhileEnd ( == '_' ) fullEnumName
@ -224,7 +207,7 @@ enumeration enumNamesAndTypes = do
enumTypeName = () enumTypeName = ()
( underlyingType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of ( underlyingType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
Just res -> pure res Just res -> pure res
Nothing -> customFailure ( MissingForwardDeclaration { enumName, library=enumNamesAndTypes } ) Nothing -> customFailure ( MissingForwardDeclaration { enumName } )
let let
docs :: [Comment] docs :: [Comment]
docs = forwardDoc : CommentText "" : inlineDocs docs = forwardDoc : CommentText "" : inlineDocs

2
imgui

Submodule imgui updated: d4ddc46e77...db20d38864

File diff suppressed because it is too large Load Diff

View File

@ -6,7 +6,7 @@
{-# language PatternSynonyms #-} {-# language PatternSynonyms #-}
{-# language TemplateHaskell #-} {-# language TemplateHaskell #-}
module DearImGui.Raw.Context where module DearImGui.Context where
-- containers -- containers
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map

View File

@ -119,8 +119,6 @@ import DearImGui.Raw.Font.Config (FontConfig(..))
import qualified DearImGui.Raw.Font.Config as FontConfig import qualified DearImGui.Raw.Font.Config as FontConfig
import DearImGui.Raw.Font.GlyphRanges (GlyphRanges(..), GlyphRangesBuilder(..)) import DearImGui.Raw.Font.GlyphRanges (GlyphRanges(..), GlyphRangesBuilder(..))
import qualified DearImGui.Raw.Font.GlyphRanges as GlyphRanges import qualified DearImGui.Raw.Font.GlyphRanges as GlyphRanges
import DearImGui.Internal.Text (Text)
import qualified DearImGui.Internal.Text as Text
import DearImGui.Structs (ImVec2(..), ImWchar) import DearImGui.Structs (ImVec2(..), ImWchar)
@ -334,10 +332,10 @@ addChar char =
GlyphRanges.addChar builder char GlyphRanges.addChar builder char
-- | UTF-8 string -- | UTF-8 string
addText :: Text -> RangesBuilderSetup addText :: String -> RangesBuilderSetup
addText str = addText str =
RangesBuilderSetup \builder -> RangesBuilderSetup \builder ->
Text.withCString str (GlyphRanges.addText builder) withCString str (GlyphRanges.addText builder)
-- | Existing ranges (as is) -- | Existing ranges (as is)
addRangesRaw :: GlyphRanges -> RangesBuilderSetup addRangesRaw :: GlyphRanges -> RangesBuilderSetup

View File

@ -1,76 +0,0 @@
{-# LANGUAGE CPP #-}
module DearImGui.Internal.Text
( withCString
, withCStringOrNull
, withCStringLen
, withCStringEnd
, peekCString
, Text
, pack
, unpack
) where
-- base
import Foreign (nullPtr, plusPtr)
import Foreign.C.String (CString)
import qualified GHC.Foreign as Foreign
import System.IO (utf8)
-- text
import Data.Text (Text, pack, unpack)
import Data.Text.Foreign (withCStringLen)
-- unliftio-core
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
#if MIN_VERSION_text(2,0,1)
-- XXX: just wrap the provided combinator
import qualified Data.Text.Foreign as Text
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString text action =
withUnliftIO $ \(UnliftIO unlift) ->
Text.withCString text $ \buf ->
unlift $ action buf
#elif MIN_VERSION_text(2,0,0)
-- XXX: the text is UTF-8, alas no withCString is available
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
import Data.Word (Word8)
import Foreign (allocaBytes, castPtr, pokeByteOff)
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t@(Text _arr _off len) action =
withUnliftIO $ \(UnliftIO unlift) ->
allocaBytes (len + 1) $ \buf -> do
unsafeCopyToPtr t buf
pokeByteOff buf len (0 :: Word8)
unlift $ action (castPtr buf)
#else
-- XXX: the text is UTF-16, let GHC do it
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t action = do
withUnliftIO $ \(UnliftIO unlift) ->
Foreign.withCString utf8 (unpack t) $ \textPtr ->
unlift $ action textPtr
#endif
peekCString :: CString -> IO Text
peekCString = fmap pack . Foreign.peekCString utf8
withCStringOrNull :: Maybe Text -> (CString -> IO a) -> IO a
withCStringOrNull Nothing k = k nullPtr
withCStringOrNull (Just s) k = withCString s k
withCStringEnd :: MonadUnliftIO m => Text -> (CString -> CString -> m a) -> m a
withCStringEnd t action =
withUnliftIO $ \(UnliftIO unlift) ->
withCStringLen t $ \(textPtr, size) ->
unlift $ action textPtr (textPtr `plusPtr` size)

View File

@ -6,7 +6,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
@ -90,7 +89,6 @@ module DearImGui.Raw
, popItemWidth , popItemWidth
, beginGroup , beginGroup
, endGroup , endGroup
, getCursorPos
, setCursorPos , setCursorPos
, getCursorScreenPos , getCursorScreenPos
, alignTextToFramePadding , alignTextToFramePadding
@ -165,14 +163,13 @@ module DearImGui.Raw
, tableNextRow , tableNextRow
, tableNextColumn , tableNextColumn
, tableSetColumnIndex , tableSetColumnIndex
, tableSetupColumn , tableSetupColumn
, tableSetupScrollFreeze , tableSetupScrollFreeze
, tableHeadersRow , tableHeadersRow
, tableHeader , tableHeader
, tableGetSortSpecs , tableGetSortSpecs
, tableClearSortSpecsDirty
, tableGetColumnCount , tableGetColumnCount
, tableGetColumnIndex , tableGetColumnIndex
@ -186,7 +183,6 @@ module DearImGui.Raw
, treeNode , treeNode
, treePush , treePush
, treePop , treePop
, setNextItemOpen
-- ** Selectables -- ** Selectables
, selectable , selectable
@ -195,7 +191,6 @@ module DearImGui.Raw
, listBox , listBox
-- * Data Plotting -- * Data Plotting
, plotLines
, plotHistogram , plotHistogram
-- ** Menus -- ** Menus
@ -265,7 +260,7 @@ import System.IO.Unsafe
( unsafePerformIO ) ( unsafePerformIO )
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Enums import DearImGui.Enums
import DearImGui.Structs import DearImGui.Structs
@ -694,27 +689,27 @@ combo labelPtr iPtr itemsPtr itemsLen = liftIO do
-- | Wraps @ImGui::DragFloat()@ -- | Wraps @ImGui::DragFloat()@
dragFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool dragFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat descPtr floatPtr speed minValue maxValue formatPtr = liftIO do dragFloat descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat2()@ -- | Wraps @ImGui::DragFloat2()@
dragFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool dragFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat2 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do dragFloat2 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat3()@ -- | Wraps @ImGui::DragFloat3()@
dragFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool dragFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat3 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do dragFloat3 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat4()@ -- | Wraps @ImGui::DragFloat4()@
dragFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool dragFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat4 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do dragFloat4 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloatRange2()@ -- | Wraps @ImGui::DragFloatRange2()@
@ -854,27 +849,27 @@ dragScalarN labelPtr dataType dataPtr components vSpeed minPtr maxPtr formatPtr
maxPtr_ = castPtr maxPtr maxPtr_ = castPtr maxPtr
-- | Wraps @ImGui::SliderFloat()@ -- | Wraps @ImGui::SliderFloat()@
sliderFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool sliderFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat descPtr floatPtr minValue maxValue formatPtr = liftIO do sliderFloat descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat2()@ -- | Wraps @ImGui::SliderFloat2()@
sliderFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool sliderFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat2 descPtr floatPtr minValue maxValue formatPtr = liftIO do sliderFloat2 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat3()@ -- | Wraps @ImGui::SliderFloat3()@
sliderFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool sliderFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat3 descPtr floatPtr minValue maxValue formatPtr = liftIO do sliderFloat3 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat4()@ -- | Wraps @ImGui::SliderFloat4()@
sliderFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool sliderFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat4 descPtr floatPtr minValue maxValue formatPtr = liftIO do sliderFloat4 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |] (0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderAngle()@ -- | Wraps @ImGui::SliderAngle()@
sliderAngle :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> ImGuiSliderFlags -> m Bool sliderAngle :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> ImGuiSliderFlags -> m Bool
@ -1101,7 +1096,7 @@ beginTable labelPtr column flags outerSizePtr innerWidth = liftIO do
(0 /=) <$> [C.exp| bool { BeginTable($(char* labelPtr), $(int column), $(ImGuiTableFlags flags), *$(ImVec2* outerSizePtr), $(float innerWidth)) } |] (0 /=) <$> [C.exp| bool { BeginTable($(char* labelPtr), $(int column), $(ImGuiTableFlags flags), *$(ImVec2* outerSizePtr), $(float innerWidth)) } |]
-- | Only call 'endTable' if 'beginTable' returns true! -- | Only call 'endTable' if 'beginTable' returns true!
-- --
-- Wraps @ImGui::EndTable()@. -- Wraps @ImGui::EndTable()@.
endTable :: MonadIO m => m () endTable :: MonadIO m => m ()
endTable = liftIO do endTable = liftIO do
@ -1170,12 +1165,6 @@ tableGetSortSpecs = liftIO do
else else
return $ Just ptr return $ Just ptr
tableClearSortSpecsDirty :: MonadIO m => Ptr ImGuiTableSortSpecs -> m ()
tableClearSortSpecsDirty specsPtr = liftIO do
[C.block| void {
$(ImGuiTableSortSpecs* specsPtr)->SpecsDirty = false;
} |]
-- | Wraps @ImGui::TableGetColumnCount()@. -- | Wraps @ImGui::TableGetColumnCount()@.
tableGetColumnCount :: MonadIO m => m CInt tableGetColumnCount :: MonadIO m => m CInt
tableGetColumnCount = liftIO do tableGetColumnCount = liftIO do
@ -1235,11 +1224,6 @@ treePop = liftIO do
[C.exp| void { TreePop() } |] [C.exp| void { TreePop() } |]
-- | Wraps @ImGui::SetNextItemOpen()@.
setNextItemOpen :: (MonadIO m) => CBool -> m ()
setNextItemOpen is_open = liftIO do
[C.exp| void { SetNextItemOpen($(bool is_open)) } |]
-- -- | Wraps @ImGui::Selectable()@. -- -- | Wraps @ImGui::Selectable()@.
-- selectable :: (MonadIO m) => CString -> m Bool -- selectable :: (MonadIO m) => CString -> m Bool
-- selectable labelPtr = liftIO do -- selectable labelPtr = liftIO do
@ -1258,10 +1242,6 @@ listBox :: (MonadIO m) => CString -> Ptr CInt -> Ptr CString -> CInt -> m Bool
listBox labelPtr iPtr itemsPtr itemsLen = liftIO do listBox labelPtr iPtr itemsPtr itemsLen = liftIO do
(0 /=) <$> [C.exp| bool { ListBox($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int itemsLen)) }|] (0 /=) <$> [C.exp| bool { ListBox($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int itemsLen)) }|]
-- | Wraps @ImGui::PlotLines()@.
plotLines :: (MonadIO m) => CString -> Ptr CFloat -> CInt -> m ()
plotLines labelPtr valuesPtr valuesLen = liftIO do
[C.exp| void { PlotLines($(char* labelPtr), $(float* valuesPtr), $(int valuesLen)) } |]
-- | Wraps @ImGui::PlotHistogram()@. -- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: (MonadIO m) => CString -> Ptr CFloat -> CInt -> m () plotHistogram :: (MonadIO m) => CString -> Ptr CFloat -> CInt -> m ()
@ -1672,20 +1652,6 @@ setCursorPos :: (MonadIO m) => Ptr ImVec2 -> m ()
setCursorPos posPtr = liftIO do setCursorPos posPtr = liftIO do
[C.exp| void { SetCursorPos(*$(ImVec2* posPtr)) } |] [C.exp| void { SetCursorPos(*$(ImVec2* posPtr)) } |]
-- | Get cursor position in window-local coordinates.
--
-- Useful to overlap draw using 'setCursorPos'.
--
-- Wraps @ImGui::SetCursorPos()@
getCursorPos :: (MonadIO m) => m ImVec2
getCursorPos = liftIO do
C.withPtr_ \ptr ->
[C.block|
void {
*$(ImVec2 * ptr) = GetCursorPos();
}
|]
-- | Cursor position in absolute coordinates. -- | Cursor position in absolute coordinates.
-- --
-- Useful to work with 'DrawList' API. -- Useful to work with 'DrawList' API.

View File

@ -115,7 +115,7 @@ import Foreign hiding (new)
import Foreign.C import Foreign.C
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Enums import DearImGui.Enums
import DearImGui.Structs import DearImGui.Structs
@ -412,8 +412,8 @@ addText_ (DrawList drawList) pos col text_begin text_end = liftIO do
} }
|] |]
addText :: MonadIO m => DrawList -> Ptr ImFont -> CFloat -> Ptr ImVec2 -> ImU32 -> CString -> CString -> CFloat -> Ptr ImVec4 -> m () addText :: MonadIO m => DrawList -> Ptr ImFont -> CFloat -> Ptr ImVec2 -> ImU32 -> CString -> CString -> CFloat -> CFloat -> Ptr ImVec4 -> m ()
addText (DrawList drawList) fontPtr font_size pos col text_begin text_end wrap_width cpu_fine_clip_rect = liftIO do addText (DrawList drawList) fontPtr font_size pos col text_begin text_end wrap_width text_align cpu_fine_clip_rect = liftIO do
[C.block| [C.block|
void { void {
$(ImDrawList* drawList)->AddText( $(ImDrawList* drawList)->AddText(
@ -424,6 +424,7 @@ addText (DrawList drawList) fontPtr font_size pos col text_begin text_end wrap_w
$(char* text_begin), $(char* text_begin),
$(char* text_end), $(char* text_end),
$(float wrap_width), $(float wrap_width),
$(float text_align),
$(ImVec4* cpu_fine_clip_rect) $(ImVec4* cpu_fine_clip_rect)
); );
} }

View File

@ -41,7 +41,7 @@ import Foreign ( Ptr, castPtr )
import Foreign.C import Foreign.C
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Structs import DearImGui.Structs
import DearImGui.Raw.Font.Config import DearImGui.Raw.Font.Config

View File

@ -46,7 +46,7 @@ import Foreign ( Ptr )
import Foreign.C import Foreign.C
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Structs import DearImGui.Structs
import DearImGui.Raw.Font.GlyphRanges import DearImGui.Raw.Font.GlyphRanges

View File

@ -75,7 +75,7 @@ import Foreign.C
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Structs import DearImGui.Structs

View File

@ -39,7 +39,7 @@ import Foreign.C
) )
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
-- import DearImGui.Enums -- import DearImGui.Enums
-- import DearImGui.Structs -- import DearImGui.Structs

View File

@ -59,7 +59,7 @@ import Foreign.C
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
-- dear-imgui -- dear-imgui
import DearImGui.Raw.Context import DearImGui.Context
( imguiContext ) ( imguiContext )
import DearImGui.Structs import DearImGui.Structs
( ImGuiListClipper ) ( ImGuiListClipper )

View File

@ -50,7 +50,7 @@ import Control.Monad.IO.Class
C.context (Cpp.cppCtx <> C.bsCtx) C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h" C.include "imgui.h"
C.include "backends/imgui_impl_sdl2.h" C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h" C.include "SDL.h"
Cpp.using "namespace ImGui" Cpp.using "namespace ImGui"

View File

@ -42,7 +42,7 @@ import Control.Monad.IO.Class
C.context (Cpp.cppCtx <> C.bsCtx) C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h" C.include "imgui.h"
C.include "backends/imgui_impl_opengl2.h" C.include "backends/imgui_impl_opengl2.h"
C.include "backends/imgui_impl_sdl2.h" C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h" C.include "SDL.h"
C.include "SDL_opengl.h" C.include "SDL_opengl.h"
Cpp.using "namespace ImGui" Cpp.using "namespace ImGui"

View File

@ -33,7 +33,7 @@ import Control.Monad.IO.Class ( MonadIO, liftIO )
C.context Cpp.cppCtx C.context Cpp.cppCtx
C.include "imgui.h" C.include "imgui.h"
C.include "backends/imgui_impl_vulkan.h" C.include "backends/imgui_impl_vulkan.h"
C.include "backends/imgui_impl_sdl2.h" C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h" C.include "SDL.h"
C.include "SDL_vulkan.h" C.include "SDL_vulkan.h"
Cpp.using "namespace ImGui" Cpp.using "namespace ImGui"

View File

@ -1,6 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module DearImGui.Structs where module DearImGui.Structs where
@ -14,12 +13,11 @@ import Data.Word
) )
import Foreign import Foreign
( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr ) ( Storable(..), castPtr, plusPtr, Ptr, Int16 )
import Foreign.C import Foreign.C
( CInt, CBool ) ( CInt, CBool )
import DearImGui.Enums import DearImGui.Enums
import Data.Bits ((.&.))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float } data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
@ -106,7 +104,7 @@ data ImGuiListClipper
-- | A unique ID used by widgets (typically the result of hashing a stack of string) -- | A unique ID used by widgets (typically the result of hashing a stack of string)
-- unsigned Integer (same as ImU32) -- unsigned Integer (same as ImU32)
type ImGuiID = ImU32 type ImGuiID = Word32
-- | 32-bit unsigned integer (often used to store packed colors). -- | 32-bit unsigned integer (often used to store packed colors).
type ImU32 = Word32 type ImU32 = Word32
@ -127,88 +125,62 @@ type ImWchar = Word16
-- When @SpecsDirty == true@ you can sort your data. It will be true with sorting specs have changed since last call, or the first time. -- When @SpecsDirty == true@ you can sort your data. It will be true with sorting specs have changed since last call, or the first time.
-- Make sure to set @SpecsDirty = false@ after sorting, else you may wastefully sort your data every frame! -- Make sure to set @SpecsDirty = false@ after sorting, else you may wastefully sort your data every frame!
data ImGuiTableSortSpecs = ImGuiTableSortSpecs data ImGuiTableSortSpecs = ImGuiTableSortSpecs
{ specs :: Ptr ImGuiTableColumnSortSpecs { imGuiTableColumnSortSpecs :: Ptr ImGuiTableColumnSortSpecs
, specsCount :: CInt , imGuiTableSortSpecsCount :: CInt
, specsDirty :: CBool , imGuiTableSortSpecsDirty :: CBool
} deriving (Show, Eq) }
instance Storable ImGuiTableSortSpecs where instance Storable ImGuiTableSortSpecs where
sizeOf _ = sizeOf _ = sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs)
sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) + + sizeOf (undefined :: CInt)
sizeOf (undefined :: CInt) + + sizeOf (undefined :: CBool)
sizeOf (undefined :: CBool)
alignment _ = alignment _ = 0
alignment nullPtr
poke ptr ImGuiTableSortSpecs{..} = do poke ptr (ImGuiTableSortSpecs s c d) = do
let specsPtr = castPtr ptr poke ( castPtr ptr ) s
poke specsPtr specs poke ( castPtr ptr `plusPtr` sizeOf s) c
poke ((castPtr ptr `plusPtr` sizeOf s)
let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs `plusPtr` sizeOf c) d
poke specsCountPtr specsCount
let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount
poke specsDirtyPtr specsDirty
peek ptr = do peek ptr = do
let specsPtr = castPtr ptr s <- peek ( castPtr ptr )
specs <- peek specsPtr c <- peek ( castPtr ptr `plusPtr` sizeOf s)
d <- peek ((castPtr ptr `plusPtr` sizeOf s)
let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs `plusPtr` sizeOf c)
specsCount <- peek specsCountPtr return (ImGuiTableSortSpecs s c d)
let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount
specsDirty <- peek specsDirtyPtr
pure ImGuiTableSortSpecs{..}
-- | Sorting specification for one column of a table -- | Sorting specification for one column of a table
data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs
{ columnUserID :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call) { imGuiTableColumnSortUserID :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call)
, columnIndex :: ImS16 -- ^ Index of the column , imGuiTableColumnSortColumnIndex :: 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) , imGuiTableColumnSortOrder :: ImS16 -- ^ Index within parent ImGuiTableSortSpecs (always stored in order starting from 0, tables sorted on a single criteria will always have a 0 here)
, sortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending' , imGuiTableColumnSortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending'
} deriving (Show, Eq) } deriving (Show, Eq)
instance Storable ImGuiTableColumnSortSpecs where instance Storable ImGuiTableColumnSortSpecs where
sizeOf _ = 12 sizeOf _ = sizeOf (undefined :: ImGuiID)
alignment _ = 4 + sizeOf (undefined :: ImS16)
+ sizeOf (undefined :: ImS16)
+ sizeOf (undefined :: ImGuiSortDirection)
poke ptr ImGuiTableColumnSortSpecs{..} = do alignment _ = 0
let columnUserIDPtr = castPtr ptr
poke columnUserIDPtr columnUserID
let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID poke ptr (ImGuiTableColumnSortSpecs a b c d) = do
poke columnIndexPtr columnIndex poke ( castPtr ptr ) a
poke ( castPtr ptr `plusPtr` sizeOf a) b
let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex poke (( castPtr ptr `plusPtr` sizeOf a)
poke sortOrderPtr sortOrder `plusPtr` sizeOf b) c
poke (((castPtr ptr `plusPtr` sizeOf a)
let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder `plusPtr` sizeOf b)
poke sortDirectionPtr sortDirection `plusPtr` sizeOf c) d
peek ptr = do peek ptr = do
let columnUserIDPtr = castPtr ptr a <- peek ( castPtr ptr )
columnUserID <- peek columnUserIDPtr b <- peek ( castPtr ptr `plusPtr` sizeOf a)
c <- peek (( castPtr ptr `plusPtr` sizeOf a)
let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID `plusPtr` sizeOf b)
columnIndex <- peek columnIndexPtr d <- peek (((castPtr ptr `plusPtr` sizeOf a)
`plusPtr` sizeOf b)
let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex `plusPtr` sizeOf c)
sortOrder <- peek sortOrderPtr return (ImGuiTableColumnSortSpecs a b c d)
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{..}