gpu-vulkan-middle-khr-surface (empty) → 0.1.0.0

raw patch · 10 files changed

+395/−0 lines, 10 filesdep +basedep +c-enumdep +data-defaultsetup-changed

Dependencies added: base, c-enum, data-default, gpu-vulkan-core, gpu-vulkan-core-khr-surface, gpu-vulkan-middle, gpu-vulkan-middle-khr-surface, storable-peek-poke, typelevel-tools-yj

Files

• CHANGELOG.md +11/−0
• LICENSE +26/−0
• README.md +1/−0
• Setup.hs +2/−0
• gpu-vulkan-middle-khr-surface.cabal +72/−0
• src/Gpu/Vulkan/Khr/Surface/Enum.hsc +112/−0
• src/Gpu/Vulkan/Khr/Surface/Middle.hs +13/−0
• src/Gpu/Vulkan/Khr/Surface/Middle/Internal.hs +94/−0
• src/Gpu/Vulkan/Khr/Surface/PhysicalDevice/Middle.hs +62/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,11 @@+# Changelog for `gpu-vulkan-middle-khr-surface`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

@@ -0,0 +1,26 @@+Copyright 2025 Yoshikuni Jujo++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,1 @@+# gpu-vulkan-middle-khr-surface

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,72 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name:           gpu-vulkan-middle-khr-surface+version:        0.1.0.0+synopsis:       medium wrapper for VK_KHR_surface extension of the Vulkan API+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface#readme>+category:       GPU+homepage:       https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface#readme+bug-reports:    https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface/issues+author:         Yoshikuni Jujo+maintainer:     yoshikuni.jujo@gmail.com+copyright:      (c) 2025 Yoshikuni Jujo+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface++library+  exposed-modules:+      Gpu.Vulkan.Khr.Surface.Enum+      Gpu.Vulkan.Khr.Surface.Middle+      Gpu.Vulkan.Khr.Surface.Middle.Internal+      Gpu.Vulkan.Khr.Surface.PhysicalDevice.Middle+  other-modules:+      Paths_gpu_vulkan_middle_khr_surface+  autogen-modules:+      Paths_gpu_vulkan_middle_khr_surface+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , c-enum <1+    , data-default <1+    , gpu-vulkan-core <1+    , gpu-vulkan-core-khr-surface <1+    , gpu-vulkan-middle <1+    , storable-peek-poke <1+    , typelevel-tools-yj <1+  default-language: Haskell2010++test-suite gpu-vulkan-middle-khr-surface-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_gpu_vulkan_middle_khr_surface+  autogen-modules:+      Paths_gpu_vulkan_middle_khr_surface+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , c-enum <1+    , data-default <1+    , gpu-vulkan-core <1+    , gpu-vulkan-core-khr-surface <1+    , gpu-vulkan-middle <1+    , gpu-vulkan-middle-khr-surface+    , storable-peek-poke <1+    , typelevel-tools-yj <1+  default-language: Haskell2010

@@ -0,0 +1,112 @@+-- This file is automatically generated by the tools/makeEnum.hs+--	% stack runghc --cwd tools/ makeEnum++{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-missing-export-lists -fno-warn-tabs #-}++module Gpu.Vulkan.Khr.Surface.Enum where++import Foreign.Storable+import Foreign.C.Enum+import Data.Bits+import Data.Word+import Data.Default++#include <vulkan/vulkan.h>++enum "TransformFlagBits" ''#{type VkSurfaceTransformFlagBitsKHR}+		[''Show, ''Eq, ''Storable, ''Bits] [+	("TransformFlagsZero", 0),+	("TransformIdentityBit",+		#{const VK_SURFACE_TRANSFORM_IDENTITY_BIT_KHR}),+	("TransformRotate90Bit",+		#{const VK_SURFACE_TRANSFORM_ROTATE_90_BIT_KHR}),+	("TransformRotate180Bit",+		#{const VK_SURFACE_TRANSFORM_ROTATE_180_BIT_KHR}),+	("TransformRotate270Bit",+		#{const VK_SURFACE_TRANSFORM_ROTATE_270_BIT_KHR}),+	("TransformHorizontalMirrorBit",+		#{const VK_SURFACE_TRANSFORM_HORIZONTAL_MIRROR_BIT_KHR}),+	("TransformHorizontalMirrorRotate90Bit",+		#{const VK_SURFACE_TRANSFORM_HORIZONTAL_MIRROR_ROTATE_90_BIT_KHR}),+	("TransformHorizontalMirrorRotate180Bit",+		#{const VK_SURFACE_TRANSFORM_HORIZONTAL_MIRROR_ROTATE_180_BIT_KHR}),+	("TransformHorizontalMirrorRotate270Bit",+		#{const VK_SURFACE_TRANSFORM_HORIZONTAL_MIRROR_ROTATE_270_BIT_KHR}),+	("TransformInheritBit",+		#{const VK_SURFACE_TRANSFORM_INHERIT_BIT_KHR}),+	("TransformFlagBitsMaxEnum",+		#{const VK_SURFACE_TRANSFORM_FLAG_BITS_MAX_ENUM_KHR}) ]++instance Default TransformFlagBits where+	def = TransformFlagsZero++enum "CompositeAlphaFlagBits" ''#{type VkCompositeAlphaFlagBitsKHR}+		[''Show, ''Eq, ''Storable, ''Bits] [+	("CompositeAlphaFlagsZero", 0),+	("CompositeAlphaOpaqueBit",+		#{const VK_COMPOSITE_ALPHA_OPAQUE_BIT_KHR}),+	("CompositeAlphaPreMultipliedBit",+		#{const VK_COMPOSITE_ALPHA_PRE_MULTIPLIED_BIT_KHR}),+	("CompositeAlphaPostMultipliedBit",+		#{const VK_COMPOSITE_ALPHA_POST_MULTIPLIED_BIT_KHR}),+	("CompositeAlphaInheritBit",+		#{const VK_COMPOSITE_ALPHA_INHERIT_BIT_KHR}),+	("CompositeAlphaFlagBitsMaxEnum",+		#{const VK_COMPOSITE_ALPHA_FLAG_BITS_MAX_ENUM_KHR}) ]++instance Default CompositeAlphaFlagBits where+	def = CompositeAlphaFlagsZero++enum "ColorSpace" ''#{type VkColorSpaceKHR}+		[''Show, ''Eq, ''Storable] [+	("ColorSpaceSrgbNonlinear",+		#{const VK_COLOR_SPACE_SRGB_NONLINEAR_KHR}),+	("ColorSpaceDisplayP3NonlinearExt",+		#{const VK_COLOR_SPACE_DISPLAY_P3_NONLINEAR_EXT}),+	("ColorSpaceExtendedSrgbLinearExt",+		#{const VK_COLOR_SPACE_EXTENDED_SRGB_LINEAR_EXT}),+	("ColorSpaceDisplayP3LinearExt",+		#{const VK_COLOR_SPACE_DISPLAY_P3_LINEAR_EXT}),+	("ColorSpaceDciP3NonlinearExt",+		#{const VK_COLOR_SPACE_DCI_P3_NONLINEAR_EXT}),+	("ColorSpaceBt709LinearExt", #{const VK_COLOR_SPACE_BT709_LINEAR_EXT}),+	("ColorSpaceBt709NonlinearExt",+		#{const VK_COLOR_SPACE_BT709_NONLINEAR_EXT}),+	("ColorSpaceBt2020LinearExt",+		#{const VK_COLOR_SPACE_BT2020_LINEAR_EXT}),+	("ColorSpaceHdr10St2084Ext", #{const VK_COLOR_SPACE_HDR10_ST2084_EXT}),+	("ColorSpaceDolbyvisionExt", #{const VK_COLOR_SPACE_DOLBYVISION_EXT}),+	("ColorSpaceHdr10HlgExt", #{const VK_COLOR_SPACE_HDR10_HLG_EXT}),+	("ColorSpaceAdobergbLinearExt",+		#{const VK_COLOR_SPACE_ADOBERGB_LINEAR_EXT}),+	("ColorSpaceAdobergbNonlinearExt",+		#{const VK_COLOR_SPACE_ADOBERGB_NONLINEAR_EXT}),+	("ColorSpacePassThroughExt", #{const VK_COLOR_SPACE_PASS_THROUGH_EXT}),+	("ColorSpaceExtendedSrgbNonlinearExt",+		#{const VK_COLOR_SPACE_EXTENDED_SRGB_NONLINEAR_EXT}),+	("ColorSpaceDisplayNativeAmd",+		#{const VK_COLOR_SPACE_DISPLAY_NATIVE_AMD}),+	("ColorspaceSrgbNonlinear",+		#{const VK_COLORSPACE_SRGB_NONLINEAR_KHR}),+	("ColorSpaceDciP3LinearExt", #{const VK_COLOR_SPACE_DCI_P3_LINEAR_EXT}),+	("ColorSpaceMaxEnum", #{const VK_COLOR_SPACE_MAX_ENUM_KHR}) ]++enum "PresentMode" ''#{type VkPresentModeKHR}+		[''Show, ''Eq, ''Storable] [+	("PresentModeImmediate", #{const VK_PRESENT_MODE_IMMEDIATE_KHR}),+	("PresentModeMailbox", #{const VK_PRESENT_MODE_MAILBOX_KHR}),+	("PresentModeFifo", #{const VK_PRESENT_MODE_FIFO_KHR}),+	("PresentModeFifoRelaxed",+		#{const VK_PRESENT_MODE_FIFO_RELAXED_KHR}),+	("PresentModeSharedDemandRefresh",+		#{const VK_PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR}),+	("PresentModeSharedContinuousRefresh",+		#{const VK_PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR}),+	("PresentModeMaxEnum", #{const VK_PRESENT_MODE_MAX_ENUM_KHR}) ]++type TransformFlags = TransformFlagBits+type CompositeAlphaFlags = CompositeAlphaFlagBits

@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Khr.Surface.Middle (++	-- * DESTROY++	destroy, S,++	-- * CAPABILITIES AND FORMAT++	Capabilities(..), Format(..) ) where++import Gpu.Vulkan.Khr.Surface.Middle.Internal

@@ -0,0 +1,94 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Khr.Surface.Middle.Internal (++	-- * DESTROY++	destroy, S(..),++	-- * CAPABILITIES AND FORMAT++	Capabilities(..), capabilitiesFromCore,+	Format(..), formatFromCore ) where++import Data.Word+import Data.TypeLevel.ParMaybe qualified as TPMaybe++import Gpu.Vulkan.Khr.Surface.Enum++import qualified Gpu.Vulkan.Enum as Vk+import qualified Gpu.Vulkan.Core as C+import Gpu.Vulkan.AllocationCallbacks.Middle.Internal+	qualified as AllocationCallbacks+import qualified Gpu.Vulkan.Khr.Surface.Core as Sfc.C+import qualified Gpu.Vulkan.Image.Enum as Image+import qualified Gpu.Vulkan.Instance.Middle.Internal as Instance++newtype S = S Sfc.C.S deriving Show++destroy :: Instance.I -> S -> TPMaybe.M AllocationCallbacks.A mn -> IO ()+destroy (Instance.I ist) (S sfc) mac =+	AllocationCallbacks.mToCore mac $ Sfc.C.destroy ist sfc++data Capabilities = Capabilities {+	capabilitiesMinImageCount :: Word32,+	capabilitiesMaxImageCount :: Word32,+	capabilitiesCurrentExtent :: C.Extent2d,+	capabilitiesMinImageExtent :: C.Extent2d,+	capabilitiesMaxImageExtent :: C.Extent2d,+	capabilitiesMaxImageArrayLayers :: Word32,+	capabilitiesSupportedTransforms :: TransformFlags,+	capabilitiesCurrentTransform :: TransformFlagBits,+	capabilitiesSupportedCompositeAlpha :: CompositeAlphaFlags,+	capabilitiesSupportedUsageFlags :: Image.UsageFlags }+	deriving Show++capabilitiesFromCore :: Sfc.C.Capabilities -> Capabilities+capabilitiesFromCore Sfc.C.Capabilities {+	Sfc.C.capabilitiesMinImageCount = mnic,+	Sfc.C.capabilitiesMaxImageCount = mxic,+	Sfc.C.capabilitiesCurrentExtent = ce,+	Sfc.C.capabilitiesMinImageExtent = mnie,+	Sfc.C.capabilitiesMaxImageExtent = mxie,+	Sfc.C.capabilitiesMaxImageArrayLayers = mials,+	Sfc.C.capabilitiesSupportedTransforms = st,+	Sfc.C.capabilitiesCurrentTransform = ct,+	Sfc.C.capabilitiesSupportedCompositeAlpha = sca,+	Sfc.C.capabilitiesSupportedUsageFlags = suf+	} = Capabilities {+		capabilitiesMinImageCount = mnic,+		capabilitiesMaxImageCount = mxic,+		capabilitiesCurrentExtent = ce,+		capabilitiesMinImageExtent = mnie,+		capabilitiesMaxImageExtent = mxie,+		capabilitiesMaxImageArrayLayers = mials,+		capabilitiesSupportedTransforms = TransformFlagBits st,+		capabilitiesCurrentTransform = TransformFlagBits ct,+		capabilitiesSupportedCompositeAlpha =+			CompositeAlphaFlagBits sca,+		capabilitiesSupportedUsageFlags = Image.UsageFlagBits suf }++data Format = Format {+	formatFormat :: Vk.Format,+	formatColorSpace :: ColorSpace }+	deriving Show++formatFromCore :: Sfc.C.Format -> Format+formatFromCore Sfc.C.Format {+	Sfc.C.formatFormat = fmt,+	Sfc.C.formatColorSpace = cs+	} = Format {+		formatFormat = Vk.Format fmt,+		formatColorSpace = ColorSpace cs }++{-+formatToCore :: Format -> Sfc.C.Format+formatToCore Format {+	formatFormat = Vk.Format fmt,+	formatColorSpace = ColorSpace cs } = Sfc.C.Format {+		Sfc.C.formatFormat = fmt,+		Sfc.C.formatColorSpace = cs }+-}

@@ -0,0 +1,62 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Khr.Surface.PhysicalDevice.Middle (++	-- * GET SUPPORT, CAPABILITIES, FORMATS AND PRESENT MODES++	getSupport, getCapabilities, getFormats, getPresentModes++	) where++import Foreign.Marshal+import Foreign.Storable+import Foreign.Storable.PeekPoke++import Gpu.Vulkan.Base.Middle.Internal+import Gpu.Vulkan.Exception.Middle+import Gpu.Vulkan.Exception.Enum+import Gpu.Vulkan.Khr.Surface.Enum++import qualified Gpu.Vulkan.PhysicalDevice.Middle.Internal as PhysicalDevice+import qualified Gpu.Vulkan.QueueFamily.Middle as QueueFamily+import qualified Gpu.Vulkan.Khr.Surface.PhysicalDevice.Core as C+import qualified Gpu.Vulkan.Khr.Surface.Middle.Internal as M++getSupport :: PhysicalDevice.P -> QueueFamily.Index -> M.S -> IO Bool+getSupport (PhysicalDevice.P phdvc) (QueueFamily.Index qfi) (M.S sfc) =+	bool32ToBool <$> alloca \pSupported -> do+		r <- C.getSupport phdvc qfi sfc pSupported+		throwUnlessSuccess $ Result r+		peek pSupported++getCapabilities :: PhysicalDevice.P -> M.S -> IO M.Capabilities+getCapabilities (PhysicalDevice.P pdvc) (M.S sfc) =+	M.capabilitiesFromCore <$> alloca \pCapabilities -> do+		r <- C.getCapabilities pdvc sfc pCapabilities+		throwUnlessSuccess $ Result r+		peek pCapabilities++getFormats :: PhysicalDevice.P -> M.S -> IO [M.Format]+getFormats (PhysicalDevice.P pdvc) (M.S sfc) =+	(M.formatFromCore <$>) <$> alloca \pFormatCount ->+	C.getFormats pdvc sfc pFormatCount NullPtr >>= \r ->+	throwUnlessSuccess (Result r) >>+	peek pFormatCount >>= \(fromIntegral -> formatCount) ->+	allocaArray formatCount \pFormats -> do+		r' <- C.getFormats pdvc sfc pFormatCount pFormats+		throwUnlessSuccess $ Result r'+		peekArray formatCount pFormats++getPresentModes :: PhysicalDevice.P -> M.S -> IO [PresentMode]+getPresentModes (PhysicalDevice.P pdvc) (M.S sfc) =+	 (PresentMode <$>) <$> alloca \pPresentModeCount ->+	C.getPresentModes pdvc sfc pPresentModeCount NullPtr >>= \r ->+	throwUnlessSuccess (Result r) >>+	peek pPresentModeCount >>= \(fromIntegral -> presentModeCount) ->+	allocaArray presentModeCount \pPresentModes -> do+		r' <- C.getPresentModes+			pdvc sfc pPresentModeCount pPresentModes+		throwUnlessSuccess $ Result r'+		peekArray presentModeCount pPresentModes

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"