Drezil/dear-imgui.hs
1
0
Fork 0
mirror of https://github.com/Drezil/dear-imgui.hs.git synced 2024-11-22 08:56:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix GHC-9.2 build (#145)

Browse Source
This commit is contained in:
Alexander Bondarenko 2022-03-28 16:04:22 +03:00 committed by GitHub
parent 7d4f3a8b93
commit 08d4b423ad
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 34 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
examples/vulkan/Backend.hs
View File

@ -374,10 +374,9 @@ chooseSwapchainFormat
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
Vulkan.SurfaceFormatKHR{format=Vulkan.FORMAT_UNDEFINED} : _rest ->
pure preferredFormat
best : _rest
-> pure best
where
@ -415,11 +414,8 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
| 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 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
, 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
@ -591,7 +587,7 @@ createFramebuffer
-> 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 @@ createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev
, 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
}

27
examples/vulkan/Main.hs
View File

@ -201,9 +201,7 @@ app = do
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 @@ app = do
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 )

6
generator/DearImGui/Generator.hs
View File

@ -24,6 +24,10 @@ import Data.Traversable
( 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 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
else
\ nm args dir pat ->
TH.patSynD_doc nm args dir pat
( Just $ Text.unpack patDoc ) []
( Just $ Text.unpack _patDoc ) []
)
#else
TH.patSynD