diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `gpu-vulkan-core-khr-swapchain` + +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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# gpu-vulkan-core-khr-swapchain diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/gpu-vulkan-core-khr-swapchain.cabal b/gpu-vulkan-core-khr-swapchain.cabal new file mode 100644 --- /dev/null +++ b/gpu-vulkan-core-khr-swapchain.cabal @@ -0,0 +1,61 @@ +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-core-khr-swapchain +version: 0.1.0.0 +synopsis: Thin wrapper for VK_KHR_swapchain extension of the Vulkan API +description: Please see the README on GitHub at +category: GPU +homepage: https://github.com/YoshikuniJujo/gpu-vulkan-core-khr-swapchain#readme +bug-reports: https://github.com/YoshikuniJujo/gpu-vulkan-core-khr-swapchain/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-core-khr-swapchain + +library + exposed-modules: + Gpu.Vulkan.Khr.Swapchain.Core + other-modules: + Paths_gpu_vulkan_core_khr_swapchain + autogen-modules: + Paths_gpu_vulkan_core_khr_swapchain + 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-struct <1 + , gpu-vulkan-core <1 + , gpu-vulkan-core-khr-surface <1 + default-language: Haskell2010 + +test-suite gpu-vulkan-core-khr-swapchain-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_gpu_vulkan_core_khr_swapchain + autogen-modules: + Paths_gpu_vulkan_core_khr_swapchain + 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-struct <1 + , gpu-vulkan-core <1 + , gpu-vulkan-core-khr-surface <1 + , gpu-vulkan-core-khr-swapchain + default-language: Haskell2010 diff --git a/src/Gpu/Vulkan/Khr/Swapchain/Core.hsc b/src/Gpu/Vulkan/Khr/Swapchain/Core.hsc new file mode 100644 --- /dev/null +++ b/src/Gpu/Vulkan/Khr/Swapchain/Core.hsc @@ -0,0 +1,168 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# OPTIONS_GHC -Wall -fno-warn-tabs #-} + +module Gpu.Vulkan.Khr.Swapchain.Core ( + + -- * ACQUIRE NEXT IMAGE + + acquireNextImage, + + -- * QUEUE PRESENT + + queuePresent, + PresentInfo, pattern PresentInfo, + presentInfoSType, presentInfoPNext, + presentInfoWaitSemaphoreCount, presentInfoPWaitSemaphores, + presentInfoSwapchainCount, presentInfoPSwapchains, + presentInfoPImageIndices, presentInfoPResults, + + -- * CREATE AND DESTROY + + create, destroy, S, PtrS, CreateInfo, pattern CreateInfo, + createInfoSType, createInfoPNext, createInfoFlags, + createInfoSurface, createInfoMinImageCount, + createInfoImageFormat, createInfoImageColorSpace, createInfoImageExtent, + createInfoImageArrayLayers, createInfoImageUsage, + createInfoImageSharingMode, + createInfoQueueFamilyIndexCount, createInfoPQueueFamilyIndices, + createInfoPreTransform, createInfoCompositeAlpha, createInfoPresentMode, + createInfoClipped, createInfoOldSwapchain, + + -- * GET IMAGES + + getImages + + ) where + +import Foreign.Ptr +import Foreign.Storable +import Foreign.C.Struct +import Foreign.C.Struct.TypeSynonyms +import Data.Word +import Data.Int + +import Gpu.Vulkan.Core +import Gpu.Vulkan.TypeSynonyms.Core +import Gpu.Vulkan.AllocationCallbacks.Core qualified as AllocationCallbacks +import Gpu.Vulkan.Device.Core qualified as Device +import Gpu.Vulkan.Khr.Surface.Core qualified as Surface +import Gpu.Vulkan.Image.Core qualified as Image + +import Gpu.Vulkan.Queue.Core qualified as Queue +import Gpu.Vulkan.Semaphore.Core qualified as Semaphore +import Gpu.Vulkan.Fence.Core qualified as Fence + +#include + +spType :: #{type VkStructureType} +spType = #{const VK_STRUCTURE_TYPE_PRESENT_INFO_KHR} + +data STag +type S = Ptr STag +type PtrS = Ptr S + +foreign import ccall "vkAcquireNextImageKHR" acquireNextImage :: + Device.D -> S -> #{type uint64_t} -> Semaphore.S -> Fence.F -> + Ptr #{type uint32_t} -> IO #{type VkResult} + +struct "PresentInfo" #{size VkPresentInfoKHR} #{alignment VkPresentInfoKHR} [ + ("sType", ''(), [| const $ pure () |], + [| \p _ -> #{poke VkPresentInfoKHR, sType} p spType |]), + ("pNext", ''PtrVoid, + [| #{peek VkPresentInfoKHR, pNext} |], + [| #{poke VkPresentInfoKHR, pNext} |]), + ("waitSemaphoreCount", ''#{type uint32_t}, + [| #{peek VkPresentInfoKHR, waitSemaphoreCount} |], + [| #{poke VkPresentInfoKHR, waitSemaphoreCount} |]), + ("pWaitSemaphores", ''Semaphore.PtrS, + [| #{peek VkPresentInfoKHR, pWaitSemaphores} |], + [| #{poke VkPresentInfoKHR, pWaitSemaphores} |]), + ("swapchainCount", ''#{type uint32_t}, + [| #{peek VkPresentInfoKHR, swapchainCount} |], + [| #{poke VkPresentInfoKHR, swapchainCount} |]), + ("pSwapchains", ''PtrS, + [| #{peek VkPresentInfoKHR, pSwapchains} |], + [| #{poke VkPresentInfoKHR, pSwapchains} |]), + ("pImageIndices", ''PtrUint32T, + [| #{peek VkPresentInfoKHR, pImageIndices} |], + [| #{poke VkPresentInfoKHR, pImageIndices} |]), + ("pResults", ''PtrResult, + [| #{peek VkPresentInfoKHR, pResults} |], + [| #{poke VkPresentInfoKHR, pResults} |]) ] + [''Show, ''Storable] + +foreign import ccall "vkQueuePresentKHR" queuePresent :: + Queue.Q -> Ptr PresentInfo -> IO #{type VkResult} + +struct "CreateInfo" #{size VkSwapchainCreateInfoKHR} + #{alignment VkSwapchainCreateInfoKHR} [ + ("sType", ''(), [| const $ pure () |], + [| \p _ -> #{poke VkSwapchainCreateInfoKHR, sType} p scType |]), + ("pNext", ''PtrVoid, [| #{peek VkSwapchainCreateInfoKHR, pNext} |], + [| #{poke VkSwapchainCreateInfoKHR, pNext} |]), + ("flags", ''#{type VkSwapchainCreateFlagsKHR}, + [| #{peek VkSwapchainCreateInfoKHR, flags} |], + [| #{poke VkSwapchainCreateInfoKHR, flags} |]), + ("surface", ''Surface.S, + [| #{peek VkSwapchainCreateInfoKHR, surface} |], + [| #{poke VkSwapchainCreateInfoKHR, surface} |]), + ("minImageCount", ''#{type uint32_t}, + [| #{peek VkSwapchainCreateInfoKHR, minImageCount} |], + [| #{poke VkSwapchainCreateInfoKHR, minImageCount} |]), + ("imageFormat", ''#{type VkFormat}, + [| #{peek VkSwapchainCreateInfoKHR, imageFormat} |], + [| #{poke VkSwapchainCreateInfoKHR, imageFormat} |]), + ("imageColorSpace", ''#{type VkColorSpaceKHR}, + [| #{peek VkSwapchainCreateInfoKHR, imageColorSpace} |], + [| #{poke VkSwapchainCreateInfoKHR, imageColorSpace} |]), + ("imageExtent", ''Extent2d, + [| #{peek VkSwapchainCreateInfoKHR, imageExtent} |], + [| #{poke VkSwapchainCreateInfoKHR, imageExtent} |]), + ("imageArrayLayers", ''#{type uint32_t}, + [| #{peek VkSwapchainCreateInfoKHR, imageArrayLayers} |], + [| #{poke VkSwapchainCreateInfoKHR, imageArrayLayers} |]), + ("imageUsage", ''#{type VkImageUsageFlags}, + [| #{peek VkSwapchainCreateInfoKHR, imageUsage} |], + [| #{poke VkSwapchainCreateInfoKHR, imageUsage} |]), + ("imageSharingMode", ''#{type VkSharingMode}, + [| #{peek VkSwapchainCreateInfoKHR, imageSharingMode} |], + [| #{poke VkSwapchainCreateInfoKHR, imageSharingMode} |]), + ("queueFamilyIndexCount", ''#{type uint32_t}, + [| #{peek VkSwapchainCreateInfoKHR, queueFamilyIndexCount} |], + [| #{poke VkSwapchainCreateInfoKHR, queueFamilyIndexCount} |]), + ("pQueueFamilyIndices", ''PtrUint32T, + [| #{peek VkSwapchainCreateInfoKHR, pQueueFamilyIndices} |], + [| #{poke VkSwapchainCreateInfoKHR, pQueueFamilyIndices} |]), + ("preTransform", ''#{type VkSurfaceTransformFlagBitsKHR}, + [| #{peek VkSwapchainCreateInfoKHR, preTransform} |], + [| #{poke VkSwapchainCreateInfoKHR, preTransform} |]), + ("compositeAlpha", ''#{type VkCompositeAlphaFlagBitsKHR}, + [| #{peek VkSwapchainCreateInfoKHR, compositeAlpha} |], + [| #{poke VkSwapchainCreateInfoKHR, compositeAlpha} |]), + ("presentMode", ''#{type VkPresentModeKHR}, + [| #{peek VkSwapchainCreateInfoKHR, presentMode} |], + [| #{poke VkSwapchainCreateInfoKHR, presentMode} |]), + ("clipped", ''#{type VkBool32}, + [| #{peek VkSwapchainCreateInfoKHR, clipped} |], + [| #{poke VkSwapchainCreateInfoKHR, clipped} |]), + ("oldSwapchain", ''S, + [| #{peek VkSwapchainCreateInfoKHR, oldSwapchain} |], + [| #{poke VkSwapchainCreateInfoKHR, oldSwapchain} |]) ] + [''Show, ''Storable] + +scType :: #{type VkStructureType} +scType = #{const VK_STRUCTURE_TYPE_SWAPCHAIN_CREATE_INFO_KHR} + +foreign import ccall "vkCreateSwapchainKHR" create :: + Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A -> Ptr S -> + IO #{type VkResult} + +foreign import ccall "vkDestroySwapchainKHR" destroy :: + Device.D -> S -> Ptr AllocationCallbacks.A -> IO () + +foreign import ccall "vkGetSwapchainImagesKHR" getImages :: + Device.D -> S -> Ptr #{type uint32_t} -> Ptr Image.I -> + IO #{type VkResult} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"