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-middle-khr-surface-glfw` + +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-middle-khr-surface-glfw 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/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib + +main :: IO () +main = someFunc diff --git a/gpu-vulkan-middle-khr-surface-glfw.cabal b/gpu-vulkan-middle-khr-surface-glfw.cabal new file mode 100644 --- /dev/null +++ b/gpu-vulkan-middle-khr-surface-glfw.cabal @@ -0,0 +1,82 @@ +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-glfw +version: 0.1.0.0 +synopsis: medium wrapper for GLFW surface for the Vulkan API +description: Please see the README on GitHub at +category: GPU +homepage: https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface-glfw#readme +bug-reports: https://github.com/YoshikuniJujo/gpu-vulkan-middle-khr-surface-glfw/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-glfw + +library + exposed-modules: + Gpu.Vulkan.Khr.Surface.Glfw.Middle + Lib + other-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + autogen-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + 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: + GLFW-b <4 + , base >=4.7 && <5 + , gpu-vulkan-middle <1 + , gpu-vulkan-middle-khr-surface <1 + , typelevel-tools-yj <1 + default-language: Haskell2010 + +executable gpu-vulkan-middle-khr-surface-glfw-exe + main-is: Main.hs + other-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + autogen-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + hs-source-dirs: + app + 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: + GLFW-b <4 + , base >=4.7 && <5 + , gpu-vulkan-middle <1 + , gpu-vulkan-middle-khr-surface <1 + , gpu-vulkan-middle-khr-surface-glfw + , typelevel-tools-yj <1 + default-language: Haskell2010 + +test-suite gpu-vulkan-middle-khr-surface-glfw-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + autogen-modules: + Paths_gpu_vulkan_middle_khr_surface_glfw + 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: + GLFW-b <4 + , base >=4.7 && <5 + , gpu-vulkan-middle <1 + , gpu-vulkan-middle-khr-surface <1 + , gpu-vulkan-middle-khr-surface-glfw + , typelevel-tools-yj <1 + default-language: Haskell2010 diff --git a/src/Gpu/Vulkan/Khr/Surface/Glfw/Middle.hs b/src/Gpu/Vulkan/Khr/Surface/Glfw/Middle.hs new file mode 100644 --- /dev/null +++ b/src/Gpu/Vulkan/Khr/Surface/Glfw/Middle.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -Wall -fno-warn-tabs #-} + +module Gpu.Vulkan.Khr.Surface.Glfw.Middle where + +import Foreign.Marshal +import Foreign.Storable +import Data.TypeLevel.ParMaybe qualified as TPMaybe + +import Gpu.Vulkan.Exception.Middle + +import qualified Graphics.UI.GLFW as GlfwB +import Gpu.Vulkan.AllocationCallbacks.Middle.Internal + qualified as AllocationCallbacks +import qualified Gpu.Vulkan.Instance.Middle.Internal as Instance +import qualified Gpu.Vulkan.Khr.Surface.Middle.Internal as Surface + +createWindowSurface :: Instance.I -> + GlfwB.Window -> TPMaybe.M AllocationCallbacks.A mn -> IO Surface.S +createWindowSurface (Instance.I ist) win mac = Surface.S <$> + alloca \psfc -> do + AllocationCallbacks.mToCore mac \pac -> do + r <- GlfwB.createWindowSurface ist win pac psfc + throwUnlessSuccess r + peek psfc diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" 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"