diff options
| -rw-r--r-- | .gitignore | 4 | ||||
| -rw-r--r-- | Main.hs | 42 | ||||
| -rw-r--r-- | Shaders.hs | 23 | ||||
| -rw-r--r-- | assets/shaders/.gitkeep | 0 | ||||
| -rw-r--r-- | shell.nix | 1 | ||||
| -rw-r--r-- | vktest.cabal | 14 |
6 files changed, 61 insertions, 23 deletions
@@ -1 +1,3 @@ -dist-newstyle
\ No newline at end of file +dist-newstyle +assets/shaders/* +!.gitkeep
\ No newline at end of file @@ -3,30 +3,35 @@ {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} module Main (main) where -import Control.Exception (bracket) -import Data.Bits ((.|.), (.&.)) -import Data.ByteString (ByteString) -import Data.Coerce (coerce) -import Data.Int (Int32) -import Data.List ((\\)) -import Data.Vector (Vector) +import Control.Exception (bracket) +import Data.Bits ((.|.), (.&.)) +import Data.ByteString (ByteString) +import Data.Coerce (coerce) +import Data.Int (Int32) +import Data.List ((\\)) +import Data.Vector (Vector) +import FIR (compileTo, runCompilationsTH) import Foreign.C -import Foreign.C.ConstPtr (ConstPtr(..)) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Array (advancePtr) -import Foreign.Ptr (Ptr) -import Foreign.Storable (peek) -import Unsafe.Coerce (unsafeCoerce) +import Foreign.C.ConstPtr (ConstPtr(..)) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (advancePtr) +import Foreign.Ptr (Ptr) +import Foreign.Storable (peek) +import Language.Haskell.TH (runIO) +import System.Directory (makeAbsolute) +import Unsafe.Coerce (unsafeCoerce) import Vulkan.CStruct.Extends (SomeStruct(..)) -import Vulkan.Zero (zero) +import Vulkan.Zero (zero) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.Vector as V import qualified RGFW as RGFW +import qualified Shaders as Shaders import qualified Vulkan.Core10 as Vk import qualified Vulkan.Extensions.VK_KHR_surface as Vk import qualified Vulkan.Extensions.VK_KHR_swapchain as Vk @@ -42,9 +47,12 @@ layers = V.fromList $ map BSC.pack ["VK_LAYER_KHRONOS_validation"] extensions :: Vector ByteString extensions = V.fromList $ map BSC.pack ["VK_KHR_swapchain"] +frag = $( do + fragPath <- runIO $ makeAbsolute "assets/shaders/frag.spv" + runCompilationsTH [("Fragment Shader", compileTo fragPath [] Shaders.fragment)]) + main :: IO () main = withRGFW "rgfw instance title" (fromIntegral $ RGFW.unwrapRGFW_initFlags_enum RGFW.RGFW_initVulkan) $ \_ -> do - putStrLn $ show extensions exts <- alloca $ \extension_count -> do exts <- RGFW.rGFW_getRequiredInstanceExtensions_Vulkan extension_count cexts <- peek extension_count @@ -94,7 +102,7 @@ main = withRGFW "rgfw instance title" (fromIntegral $ RGFW.unwrapRGFW_initFlags_ , Vk.subresourceRange = zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT , Vk.levelCount = Vk.REMAINING_MIP_LEVELS , Vk.layerCount = Vk.REMAINING_ARRAY_LAYERS - } + } , Vk.format = (V.head forms).format -- TODO fetch the best format }) images) Nothing $ \imageViews -> do Vk.withRenderPass dev zero { Vk.subpasses = V.fromList [zero {Vk.pipelineBindPoint = Vk.PIPELINE_BIND_POINT_GRAPHICS}] @@ -182,7 +190,7 @@ withImageViews :: Vk.Device -> Vector (Vk.ImageViewCreateInfo '[]) -> Maybe Vk.A withImageViews dev infos alloc io = do imageViews <- mapM (\(info) -> Vk.createImageView dev info alloc) infos o0 <- io imageViews - mapM (\imageView -> Vk.destroyImageView dev imageView alloc) imageViews + _ <- mapM (\imageView -> Vk.destroyImageView dev imageView alloc) imageViews return o0 withWindow :: String -> Int32 -> Int32 -> Int32 -> Int32 -> RGFW.RGFW_windowFlags -> (Ptr RGFW.RGFW_window -> IO r) -> IO r diff --git a/Shaders.hs b/Shaders.hs new file mode 100644 index 0000000..f94bc43 --- /dev/null +++ b/Shaders.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +-- from the FIR docs +module Shaders where + +import FIR +import Math.Linear + +type FragmentDefs = '[ "in_pos" ':-> Input '[ Location 0 ] (V 2 Float) + , "out_col" ':-> Output '[ Location 0 ] (V 4 Float) + , "image" ':-> Texture2D '[ DescriptorSet 0, Binding 0 ] (RGBA8 UNorm) + , "main" ':-> EntryPoint '[ OriginLowerLeft ] Fragment + ] + +fragment :: Module FragmentDefs +fragment = Module $ entryPoint @"main" @Fragment do + pos <- get @"in_pos" + col <- use @(ImageTexel "image") NilOps pos + put @"out_col" col
\ No newline at end of file diff --git a/assets/shaders/.gitkeep b/assets/shaders/.gitkeep new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/assets/shaders/.gitkeep @@ -7,6 +7,7 @@ pkgs.mkShell { pkgs.haskell.compiler.ghc914 pkgs.llvm pkgs.vulkan-tools + pkgs.spirv-tools pkgs.pkg-config pkgs.vulkan-headers diff --git a/vktest.cabal b/vktest.cabal index 8f40c1c..400dc13 100644 --- a/vktest.cabal +++ b/vktest.cabal @@ -11,11 +11,15 @@ extra-doc-files: CHANGELOG.md executable vktest main-is: Main.hs - other-modules: RGFW - build-depends: base >= 4.20.2, - bytestring >= 0.12, - vector >= 0.13, - vulkan >= 3.27, + other-modules: RGFW, + Shaders, + build-depends: base >= 4.20.2, + bytestring >= 0.12, + directory >= 1.3, + filepath >= 1.5, + template-haskell >= 2.24, + vector >= 0.13, + vulkan >= 3.27, hs-bindgen, hs-bindgen-runtime, fir, |