vulkan-init-glfw (empty) → 0.1.0.0

raw patch · 8 files changed

+322/−0 lines, 8 filesdep +GLFW-bdep +basedep +bytestringsetup-changed

Dependencies added: GLFW-b, base, bytestring, resourcet, text, vector, vulkan, vulkan-utils

Files

• LICENSE +30/−0
• Setup.hs +3/−0
• changelog.md +4/−0
• package.yaml +38/−0
• readme.md +5/−0
• src/Vulkan/Utils/Init/GLFW.hs +96/−0
• src/Vulkan/Utils/Init/GLFW/Window.hs +90/−0
• vulkan-init-glfw.cabal +56/−0

@@ -0,0 +1,30 @@+Copyright IC Rainbow (c) 2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of IC Rainbow nor the names of other+      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+OWNER 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,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,4 @@+# Change Log++## [0.1.0.0]+- Initial release.

@@ -0,0 +1,38 @@+name: vulkan-init-glfw+version: "0.1.0.0"+synopsis: Vulkan initialization helpers for GLFW+category: Graphics+maintainer: IC Rainbow <aenor.realm@gmail.com>+license: BSD-3-Clause+license-file: LICENSE+github: haskell-game/vulkan+extra-source-files:+- readme.md+- changelog.md+- package.yaml++library:+  source-dirs: src+  dependencies:+  - base <5+  - bytestring+  - GLFW-b >= 3.3 && < 3.4+  - resourcet >= 1.2.4+  - text+  - vector+  - vulkan >= 3.6.14 && < 3.28+  - vulkan-utils++ghc-options:+- -Wall++default-extensions:+- DerivingStrategies+- FlexibleContexts+- LambdaCase+- NamedFieldPuns+- OverloadedStrings+- PatternSynonyms+- RankNTypes+- RecordWildCards+- ScopedTypeVariables

@@ -0,0 +1,5 @@+# vulkan-init-glfw++Vulkan initialization helpers for GLFW windows. Provides the GLFW-specific+glue around `vulkan-utils` so apps can build a Vulkan `Instance` and a+`SurfaceKHR` from a `GLFW.Window` with a couple of calls.

@@ -0,0 +1,96 @@+{-| Vulkan initialization glue for GLFW windows. Compose with+'Vulkan.Utils.Initialization.allocateVulkanInstance' (or just call+'allocateInstance' here) and the rest of @vulkan-utils@ to get a+ready-to-render setup.+-}+module Vulkan.Utils.Init.GLFW+  ( -- * Required extensions+    getRequiredInstanceExtensions+  , getRequiredDeviceExtensions++    -- * Surface+  , createSurface+  , destroySurface+  , allocateSurface++    -- * Instance+  , allocateInstance+  ) where++import Control.Exception (throwIO)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (MonadResource, allocate)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Int (Int32)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (nullPtr)+import Foreign.Storable (peek)+import qualified Graphics.UI.GLFW as GLFW+import Vulkan.Core10+  ( ApplicationInfo+  , Instance+  , instanceHandle+  )+import Vulkan.Core10.Enums.Result (Result (..))+import Vulkan.Exception (VulkanException (..))+import Vulkan.Extensions.VK_KHR_surface+  ( SurfaceKHR (..)+  , destroySurfaceKHR+  )+import Vulkan.Extensions.VK_KHR_swapchain+  ( pattern KHR_SWAPCHAIN_EXTENSION_NAME+  )+import Vulkan.Requirement (InstanceRequirement)+import Vulkan.Utils.Initialization (allocateVulkanInstance)++{- | Vulkan instance extensions GLFW requires. The window argument is unused+(GLFW's API is global) but kept for symmetry with the SDL2 module.+-}+getRequiredInstanceExtensions :: (MonadIO m) => GLFW.Window -> m (Vector ByteString)+getRequiredInstanceExtensions _ =+  liftIO $+    V.fromList <$> (traverse BS.packCString =<< GLFW.getRequiredInstanceExtensions)++{- | Device extensions a GLFW-presenting application needs. Currently just+@VK_KHR_swapchain@.+-}+getRequiredDeviceExtensions :: [ByteString]+getRequiredDeviceExtensions = [KHR_SWAPCHAIN_EXTENSION_NAME]++{- | Create a 'SurfaceKHR' for the given GLFW window. Throws 'VulkanException'+if GLFW reports a non-success result.+-}+createSurface :: Instance -> GLFW.Window -> IO SurfaceKHR+createSurface inst w = alloca $ \surfPtr -> do+  r <- GLFW.createWindowSurface (instanceHandle inst) w nullPtr surfPtr :: IO Int32+  let result = Result r+  when (result /= SUCCESS) (throwIO (VulkanException result))+  peek surfPtr++-- | Destroy a 'SurfaceKHR' previously created with 'createSurface'.+destroySurface :: Instance -> SurfaceKHR -> IO ()+destroySurface inst s = destroySurfaceKHR inst s Nothing++-- | Allocate a surface in 'MonadResource', released with the resource scope.+allocateSurface :: (MonadResource m) => Instance -> GLFW.Window -> m SurfaceKHR+allocateSurface inst w =+  snd <$> allocate (createSurface inst w) (destroySurface inst)++{- | Build a Vulkan 'Instance' wired up with GLFW's required extensions.+Composes 'getRequiredInstanceExtensions' and+'Vulkan.Utils.Initialization.allocateVulkanInstance'.+-}+allocateInstance+  :: (MonadResource m)+  => GLFW.Window+  -> Maybe ApplicationInfo+  -> [InstanceRequirement]+  -> [InstanceRequirement]+  -> m Instance+allocateInstance w appInfo reqs optReqs = do+  exts <- getRequiredInstanceExtensions w+  allocateVulkanInstance exts appInfo reqs optReqs

@@ -0,0 +1,90 @@+{-| Convenience helpers for opening a GLFW window suitable for Vulkan+rendering, polling for close/quit events, and querying the current+framebuffer size for swapchain recreation.++These wrap a small set of opinionated defaults — no client API,+resizable, hidden until the caller has the swapchain ready — sufficient+for examples and prototypes. Applications with different needs should+call GLFW directly.+-}+module Vulkan.Utils.Init.GLFW.Window+  ( withGLFW+  , createWindow+  , drawableSize+  , showWindow+  , shouldQuit+  , glfwAdapter+  ) where++import Control.Monad (unless, void)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (MonadResource, allocate, allocate_)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Graphics.UI.GLFW as GLFW+import Vulkan.Core10 (Extent2D (..))+import qualified Vulkan.Utils.Init.GLFW as Init+import Vulkan.Utils.WindowAdapter (WindowAdapter (..))++-- | Initialise GLFW and tear it down with the resource scope.+withGLFW :: (MonadResource m) => m ()+withGLFW = void $ allocate_ initGLFW GLFW.terminate+  where+    initGLFW = do+      ok <- GLFW.init+      unless ok (fail "GLFW.init failed")++{- | Create a GLFW window configured for Vulkan rendering. The window is+created hidden so the caller can call 'showWindow' once the swapchain is+ready.+-}+createWindow+  :: (MonadResource m)+  => Text+  -- ^ Title+  -> Int+  -- ^ Width+  -> Int+  -- ^ Height+  -> m GLFW.Window+createWindow title width height = do+  liftIO $ do+    GLFW.windowHint (GLFW.WindowHint'ClientAPI GLFW.ClientAPI'NoAPI)+    GLFW.windowHint (GLFW.WindowHint'Resizable True)+    GLFW.windowHint (GLFW.WindowHint'Visible False)+  (_, mWin) <-+    allocate+      (GLFW.createWindow width height (T.unpack title) Nothing Nothing)+      (maybe (pure ()) GLFW.destroyWindow)+  case mWin of+    Just w -> pure w+    Nothing -> liftIO (fail "GLFW.createWindow returned Nothing")++showWindow :: (MonadIO m) => GLFW.Window -> m ()+showWindow = liftIO . GLFW.showWindow++-- | Current framebuffer size, suitable as the swapchain extent fallback.+drawableSize :: (MonadIO m) => GLFW.Window -> m Extent2D+drawableSize win = do+  (w, h) <- liftIO $ GLFW.getFramebufferSize win+  pure $ Extent2D (fromIntegral w) (fromIntegral h)++-- | The window's 'WindowAdapter', for backend-agnostic boot helpers.+glfwAdapter :: (MonadResource m) => GLFW.Window -> WindowAdapter m+glfwAdapter w =+  WindowAdapter+    { waAllocateInstance = Init.allocateInstance w+    , waAllocateSurface = \i -> Init.allocateSurface i w+    , waDrawableSize = drawableSize w+    }++{- | Poll events and report whether the user requested to close the window+(X button, Q, or Escape).+-}+shouldQuit :: (MonadIO m) => GLFW.Window -> m Bool+shouldQuit win = liftIO $ do+  GLFW.pollEvents+  closeRequested <- GLFW.windowShouldClose win+  qPressed <- (== GLFW.KeyState'Pressed) <$> GLFW.getKey win GLFW.Key'Q+  escPressed <- (== GLFW.KeyState'Pressed) <$> GLFW.getKey win GLFW.Key'Escape+  pure (closeRequested || qPressed || escPressed)

@@ -0,0 +1,56 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.39.6.+--+-- see: https://github.com/sol/hpack++name:           vulkan-init-glfw+version:        0.1.0.0+synopsis:       Vulkan initialization helpers for GLFW+category:       Graphics+homepage:       https://github.com/haskell-game/vulkan#readme+bug-reports:    https://github.com/haskell-game/vulkan/issues+maintainer:     IC Rainbow <aenor.realm@gmail.com>+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    readme.md+    changelog.md+    package.yaml++source-repository head+  type: git+  location: https://github.com/haskell-game/vulkan++library+  exposed-modules:+      Vulkan.Utils.Init.GLFW+      Vulkan.Utils.Init.GLFW.Window+  other-modules:+      Paths_vulkan_init_glfw+  autogen-modules:+      Paths_vulkan_init_glfw+  hs-source-dirs:+      src+  default-extensions:+      DerivingStrategies+      FlexibleContexts+      LambdaCase+      NamedFieldPuns+      OverloadedStrings+      PatternSynonyms+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+  ghc-options: -Wall+  build-depends:+      GLFW-b ==3.3.*+    , base <5+    , bytestring+    , resourcet >=1.2.4+    , text+    , vector+    , vulkan >=3.6.14 && <3.28+    , vulkan-utils+  default-language: Haskell2010