test shader

6 files changed, 61 insertions, 23 deletions

diff --git a/.gitignore b/.gitignore
index 4c61acd..85dc265 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,3 @@
-dist-newstyle
\ No newline at end of file
+dist-newstyle
+assets/shaders/*
+!.gitkeep
\ No newline at end of file
diff --git a/Main.hs b/Main.hs
index f42f8a3..a314bdb 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/shell.nix b/shell.nix
index 7028dfd..0257838 100644
--- a/shell.nix
+++ b/shell.nix
@@ -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,