it draws!

5 files changed, 453 insertions, 374 deletions

diff --git a/Main.hs b/Main.hs
index 828753e..d80c533 100644
--- a/Main.hs
+++ b/Main.hs
@@ -9,227 +9,65 @@
 module Main (main) where
 
 import Control.Exception      (bracket)
-import Data.Bits              ((.|.), (.&.))
-import Data.ByteString        (ByteString)
+import Data.Bits              ((.|.))
 import Data.Coerce            (coerce)
-import Data.Int               (Int32)
-import Data.List              ((\\))
 import Data.Vector            (Vector)
-import Data.Word              (Word32)
-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 Vulkan.CStruct.Extends (SomeStruct(..))
 import Vulkan.Zero            (zero)
 
+import VkTest.Config (QueriedData(..))
+
+import qualified VkTest.Config  as Config
+import qualified VkTest.Shaders as Shaders
+import qualified VkTest.Util    as Util
+
 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.Core12                      as Vk
 import qualified Vulkan.Core13                      as Vk
 import qualified Vulkan.Extensions.VK_KHR_surface   as Vk
 import qualified Vulkan.Extensions.VK_KHR_swapchain as Vk
 
-height :: Int32
-height = 400
-width :: Int32
-width = 800
-
-layers :: Vector ByteString
-layers = V.fromList $ map BSC.pack ["VK_LAYER_KHRONOS_validation"]
-
-extensions :: Vector ByteString
-extensions = V.fromList $ map BSC.pack ["VK_KHR_swapchain"]
-
-vert = $( runCompilationsTH [("Fragment Shader", compileTo Shaders.vertPath [] Shaders.vertex)] )
-frag = $( runCompilationsTH [("Fragment Shader", compileTo Shaders.fragPath [] Shaders.fragment)] )
-
-data Consts = Consts
-    { title          :: String
-    , vkApiVersion   :: Word32
-    , framesInFlight :: Word32
-    }
-    deriving Show
-
-consts =
-    Consts
-    { title          = "game title"
-    , vkApiVersion   = Vk.API_VERSION_1_3
-    , framesInFlight = 2
-    }
-
--- for a given physical device and surface
-data QueriedData = QueriedData
-    { surfaceCapabilities      :: Vk.SurfaceCapabilitiesKHR
-    , surfaceSupport           :: [Int]
-    , surfaceFormats           :: Vector Vk.SurfaceFormatKHR
-    , queueFamilyProperties    :: Vector Vk.QueueFamilyProperties
-    , extensionProperties      :: Vector Vk.ExtensionProperties
-    , physicalDeviceProperties :: Vk.PhysicalDeviceProperties
-    }
-    deriving Show
-
-instanceConfig :: Vector ByteString -> Vk.InstanceCreateInfo '[]
-instanceConfig exts =
-    zero { Vk.applicationInfo = Just (zero :: Vk.ApplicationInfo) { Vk.apiVersion = consts.vkApiVersion }
-         , Vk.enabledExtensionNames = exts
-         }
-
-deviceConfig :: Word32 -> Vk.DeviceCreateInfo '[Vk.PhysicalDeviceVulkan13Features, Vk.PhysicalDeviceVulkan12Features]
-deviceConfig gqueueIndex =
-    zero { Vk.next = (vkFeatures13, (vkFeatures12, ()))
-         , Vk.queueCreateInfos = V.singleton $ SomeStruct zero { Vk.queueFamilyIndex = gqueueIndex
-                                                               , Vk.queuePriorities = V.singleton 1
-                                                               }
-         , Vk.enabledExtensionNames = extensions
-         }
-
-vkFeatures12 :: Vk.PhysicalDeviceVulkan12Features
-vkFeatures12 =
-    zero
-
-vkFeatures13 :: Vk.PhysicalDeviceVulkan13Features
-vkFeatures13 =
-    zero { Vk.synchronization2 = True
-         , Vk.dynamicRendering = True
-         }
-
-commandPoolConfig :: Word32 -> Vk.CommandPoolCreateInfo '[]
-commandPoolConfig gqueueIndex =
-    zero { Vk.queueFamilyIndex = gqueueIndex
-         , Vk.flags = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT
-         }
-
-commandBufferConfig :: Vk.CommandPool -> Vk.CommandBufferAllocateInfo
-commandBufferConfig gpool =
-    zero { Vk.commandPool = gpool
-         , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY
-         , Vk.commandBufferCount = consts.framesInFlight
-         }
-
-swapchainConfig :: QueriedData -> Vk.SurfaceKHR -> Vk.SwapchainCreateInfoKHR '[]
-swapchainConfig q surface =
-    zero { Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_OPAQUE_BIT_KHR
-         , Vk.imageArrayLayers = 1
-         , Vk.imageColorSpace = Vk.COLORSPACE_SRGB_NONLINEAR_KHR
-         , Vk.imageExtent = q.surfaceCapabilities.currentExtent
-         , Vk.imageFormat = (V.head q.surfaceFormats).format
-         , Vk.imageUsage = Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT
-         , Vk.minImageCount = q.surfaceCapabilities.minImageCount
-         , Vk.presentMode = Vk.PRESENT_MODE_FIFO_KHR
-         , Vk.preTransform = Vk.SURFACE_TRANSFORM_IDENTITY_BIT_KHR
-         , Vk.surface = surface
-         }
-
-imageViewConfigs :: Vector Vk.Image -> QueriedData -> Vector (Vk.ImageViewCreateInfo '[])
-imageViewConfigs images q =
-    V.map (\image -> (zero :: Vk.ImageViewCreateInfo '[]) { Vk.image = image
-                                                          , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
-                                                          , 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 q.surfaceFormats).format
-                                                          }) images
-
-pipelineLayoutConfig :: Vk.PipelineLayoutCreateInfo
-pipelineLayoutConfig =
-    zero
-
-graphicsPipelineConfig :: QueriedData -> Vk.ShaderModule -> Vk.ShaderModule -> Vk.PipelineLayout -> Vk.GraphicsPipelineCreateInfo '[Vk.PipelineRenderingCreateInfo]
-graphicsPipelineConfig q vertMod fragMod pipelineLayout =
-    zero { Vk.next = (pipelineRenderingConfig q, ())
-         , Vk.stages = V.map (SomeStruct) $ V.fromList [ zero { Vk.stage = Vk.SHADER_STAGE_VERTEX_BIT
-                                                              , Vk.module' = vertMod
-                                                              , Vk.name = "main"
-                                                              }
-                                                       , zero { Vk.stage = Vk.SHADER_STAGE_FRAGMENT_BIT
-                                                              , Vk.module' = fragMod
-                                                              , Vk.name = "main"
-                                                              }]
-         , Vk.vertexInputState = Just zero
-         , Vk.inputAssemblyState = Just zero { Vk.topology = Vk.PRIMITIVE_TOPOLOGY_TRIANGLE_LIST }
-         , Vk.tessellationState = Nothing
-         , Vk.viewportState = Just $ SomeStruct zero { Vk.viewports = V.fromList [zero { Vk.x = 0
-                                                                                       , Vk.y = 0
-                                                                                       , Vk.width = fromIntegral q.surfaceCapabilities.currentExtent.width
-                                                                                       , Vk.height = fromIntegral q.surfaceCapabilities.currentExtent.height
-                                                                                       , Vk.minDepth = 0
-                                                                                       , Vk.maxDepth = 1
-                                                                                       }]
-                                                     , Vk.scissors = V.fromList [(zero :: Vk.Rect2D) { Vk.offset = zero
-                                                                                                     , Vk.extent = q.surfaceCapabilities.currentExtent
-                                                                                                     }]
-                                                     }
-
-         , Vk.rasterizationState = Just $ SomeStruct zero { Vk.lineWidth = 1 }
-         , Vk.multisampleState = Just $ SomeStruct zero { Vk.rasterizationSamples = Vk.SAMPLE_COUNT_1_BIT }
-         , Vk.depthStencilState = Just zero
-         , Vk.colorBlendState = Just $ SomeStruct zero { Vk.attachments = V.singleton zero { Vk.colorWriteMask = Vk.COLOR_COMPONENT_R_BIT .|. Vk.COLOR_COMPONENT_G_BIT .|. Vk.COLOR_COMPONENT_B_BIT .|. Vk.COLOR_COMPONENT_A_BIT }}
-         , Vk.dynamicState = Just zero { Vk.dynamicStates = V.fromList [Vk.DYNAMIC_STATE_VIEWPORT, Vk.DYNAMIC_STATE_SCISSOR] }
-         , Vk.layout = pipelineLayout
-         }
-
-pipelineRenderingConfig :: QueriedData -> Vk.PipelineRenderingCreateInfo
-pipelineRenderingConfig q =
-    zero { Vk.colorAttachmentFormats = V.singleton (V.head q.surfaceFormats).format }
-
 main :: IO ()
-main = withRGFW "rgfw instance title" (fromIntegral $ RGFW.unwrapRGFW_initFlags_enum RGFW.RGFW_initVulkan) $ \_ -> do
+main = Util.withRGFW "rgfw instance title" (fromIntegral $ RGFW.unwrapRGFW_initFlags_enum RGFW.RGFW_initVulkan) $ \_ -> do
     exts <- alloca $ \extension_count -> do
         exts <- RGFW.rGFW_getRequiredInstanceExtensions_Vulkan extension_count
         cexts <- peek extension_count
-        vexts <- processExtensions cexts exts V.empty
+        vexts <- Util.processExtensions cexts exts V.empty
         return vexts
-
-    Vk.withInstance (instanceConfig exts) Nothing bracket $ \i -> do
-
-    withWindow "test window" 0 0 width height ((fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowCenter)) .|. (fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowNoResize))) $ \window -> do
-
+    Vk.withInstance (Config.instance' exts) Nothing bracket $ \i -> do
+    Util.withWindow "test window" 0 0 Config.width Config.height ((fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowCenter)) .|. (fromIntegral (RGFW.unwrapRGFW_windowFlags_enum RGFW.RGFW_windowFloating))) $ \window -> do
     surface :: Vk.SurfaceKHR <- alloca $ \surfacePtr -> do
         _ <- RGFW.rGFW_window_createSurface_Vulkan window (coerce $ Vk.instanceHandle i) surfacePtr
         return . unsafeCoerce =<< peek surfacePtr
     (_, pdevs) <- Vk.enumeratePhysicalDevices i
-    (pdev, q) <- pickPhysicalDevice pdevs surface
-    let gqueueIndex = fromIntegral $ head $ getGraphicsQueues q
-
-    Vk.withDevice pdev (deviceConfig gqueueIndex) Nothing bracket $ \dev -> do
+    (pdev, q) <- Util.pickPhysicalDevice pdevs surface
+    let gqueueIndex = fromIntegral $ head $ Util.getGraphicsQueues q
+    Vk.withDevice pdev (Config.device gqueueIndex) Nothing bracket $ \dev -> do
     gqueue <- Vk.getDeviceQueue dev gqueueIndex 0
-
-    Vk.withCommandPool dev (commandPoolConfig gqueueIndex) Nothing bracket $ \gpool -> do
-    Vk.withSwapchainKHR dev (swapchainConfig q surface) Nothing bracket $ \swapchain -> do
-    
+    Vk.withCommandPool dev (Config.commandPool gqueueIndex) Nothing bracket $ \gpool -> do
+    swapchain <- Vk.createSwapchainKHR dev (Config.swapchain q surface) Nothing
     (_, images) <- Vk.getSwapchainImagesKHR dev swapchain
-    withImageViews dev (imageViewConfigs images q) Nothing $ \imageViews -> do
-
-    withSemaphores dev (V.fromList (take (fromIntegral consts.framesInFlight) (repeat zero))) Nothing $ \sImageAcquired -> do
-    withSemaphores dev (V.fromList (take (V.length images) (repeat zero))) Nothing $ \sRenderFinisheds -> do
-    withFences dev (V.fromList (take (fromIntegral consts.framesInFlight) (repeat ((zero :: Vk.FenceCreateInfo '[]) { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT })))) Nothing $ \fences -> do
-
-    Vk.withCommandBuffers dev (commandBufferConfig gpool) bracket $ \cbuffers -> do
-
+    Util.withImageViews dev (Config.imageViews images q) Nothing $ \imageViews -> do
+    Util.withSemaphores dev (V.fromList (take (fromIntegral Config.consts.framesInFlight) (repeat zero))) Nothing $ \sImageAcquired -> do
+    Util.withSemaphores dev (V.fromList (take (V.length images) (repeat zero))) Nothing $ \sRenderFinisheds -> do
+    Util.withFences dev (V.fromList (take (fromIntegral Config.consts.framesInFlight) (repeat ((zero :: Vk.FenceCreateInfo '[]) { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT })))) Nothing $ \fences -> do
+    Vk.withCommandBuffers dev (Config.commandBuffer gpool) bracket $ \cbuffers -> do
     rawVert <- BS.readFile Shaders.vertPath
     rawFrag <- BS.readFile Shaders.fragPath
-    withShaderModules dev (V.fromList [ zero { Vk.code = rawVert }, zero { Vk.code = rawFrag } ]) Nothing $ \mods -> do
-
+    Util.withShaderModules dev (V.fromList [ zero { Vk.code = rawVert }, zero { Vk.code = rawFrag } ]) Nothing $ \mods -> do
     let vertMod = V.head mods
     let fragMod = V.head $ V.tail mods
-    Vk.withPipelineLayout dev (pipelineLayoutConfig) Nothing bracket $ \pipelineLayout -> do
-
-    Vk.withGraphicsPipelines dev zero (V.singleton $ SomeStruct (graphicsPipelineConfig q vertMod fragMod pipelineLayout)) Nothing bracket $ \(_, pipelines) -> do
-
+    Vk.withPipelineLayout dev (Config.pipelineLayout) Nothing bracket $ \pipelineLayout -> do
+    Vk.withGraphicsPipelines dev zero (V.singleton $ SomeStruct (Config.graphicsPipeline q vertMod fragMod pipelineLayout)) Nothing bracket $ \(_, pipelines) -> do
     let pipeline = V.head pipelines
     gameloop' dev q pipeline swapchain imageViews images cbuffers gqueue sImageAcquired sRenderFinisheds fences 0 window 0
 
-
 gameloop' :: Vk.Device -> QueriedData -> Vk.Pipeline -> Vk.SwapchainKHR -> Vector Vk.ImageView -> Vector Vk.Image -> Vector Vk.CommandBuffer -> Vk.Queue -> Vector Vk.Semaphore -> Vector Vk.Semaphore -> Vector Vk.Fence -> Int -> Ptr RGFW.RGFW_window -> RGFW.RGFW_bool -> IO ()
 gameloop' dev q pipeline swapchain imageViews images cbuffers queue sImageAcquireds sRenderFinisheds fences frameIndex window 0 = do
     let cbuffer = (V.!) cbuffers frameIndex
@@ -243,187 +81,17 @@ gameloop' dev q pipeline swapchain imageViews images cbuffers queue sImageAcquir
         sRenderFinished = (V.!) sRenderFinisheds $ fromIntegral imageIndex
     Vk.resetCommandBuffer cbuffer zero
     Vk.useCommandBuffer cbuffer ((zero :: Vk.CommandBufferBeginInfo '[]) { Vk.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }) $ do
-        Vk.cmdPipelineBarrier2 cbuffer $ zero { Vk.imageMemoryBarriers = V.singleton $ SomeStruct zero { Vk.srcStageMask = Vk.PIPELINE_STAGE_2_NONE
-                                                                                                       , Vk.srcAccessMask = Vk.ACCESS_2_NONE
-                                                                                                       , Vk.dstStageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
-                                                                                                       , Vk.dstAccessMask = Vk.ACCESS_2_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_2_COLOR_ATTACHMENT_WRITE_BIT
-                                                                                                       , Vk.oldLayout = Vk.IMAGE_LAYOUT_UNDEFINED
-                                                                                                       , Vk.newLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
-                                                                                                       , Vk.image = image
-                                                                                                       , Vk.subresourceRange = zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
-                                                                                                                                    , Vk.levelCount = 1
-                                                                                                                                    , Vk.layerCount = 1
-                                                                                                                                    }
-                                                                                                       }
-                                              }
-        Vk.cmdUseRendering cbuffer (zero { Vk.renderArea = zero { Vk.extent = q.surfaceCapabilities.currentExtent }
-                                         , Vk.layerCount = 1
-                                         , Vk.colorAttachments = V.singleton $ (SomeStruct) zero { Vk.imageView = imageView
-                                                                                                 , Vk.imageLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
-                                                                                                 , Vk.loadOp = Vk.ATTACHMENT_LOAD_OP_CLEAR
-                                                                                                 , Vk.storeOp = Vk.ATTACHMENT_STORE_OP_STORE
-                                                                                                 , Vk.clearValue = Vk.Color $ Vk.Float32 0 0 1 1
-                                                                                                 }
-                                         }) $ do
-            Vk.cmdSetViewport cbuffer 0 $ V.singleton zero { Vk.x = 0
-                                                           , Vk.y = 0
-                                                           , Vk.width = fromIntegral q.surfaceCapabilities.currentExtent.width
-                                                           , Vk.height = fromIntegral q.surfaceCapabilities.currentExtent.height
-                                                           , Vk.minDepth = 0
-                                                           , Vk.maxDepth = 1
-                                                           }
-            Vk.cmdSetScissor cbuffer 0 $ V.singleton zero { Vk.offset = zero
-                                                          , Vk.extent = q.surfaceCapabilities.currentExtent
-                                                          }
+        Vk.cmdPipelineBarrier2 cbuffer $ Config.preRenderPipelineBarrier image
+        Vk.cmdUseRendering cbuffer (Config.rendering q imageView) $ do
+            Vk.cmdSetViewport cbuffer 0 $ Config.viewport q
+            Vk.cmdSetScissor cbuffer 0 $ Config.scissor q
             Vk.cmdBindPipeline cbuffer Vk.PIPELINE_BIND_POINT_GRAPHICS pipeline
-            Vk.cmdDraw cbuffer 3 0 0 0
-        Vk.cmdPipelineBarrier2 cbuffer $ zero { Vk.imageMemoryBarriers = V.singleton $ SomeStruct zero { Vk.srcStageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
-                                                                                                       , Vk.srcAccessMask = Vk.ACCESS_2_COLOR_ATTACHMENT_WRITE_BIT
-                                       	                                                               , Vk.dstStageMask = Vk.PIPELINE_STAGE_2_NONE
-                                                                                                       , Vk.dstAccessMask = Vk.ACCESS_2_NONE
-                                                                                                       , Vk.oldLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
-                                                                                                       , Vk.newLayout = Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
-                                                                                                       , Vk.image = image
-                                                                                                       , Vk.subresourceRange = zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
-                                                                                                                                    , Vk.levelCount = 1
-                                                                                                                                    , Vk.layerCount = 1
-                                                                                                                                    }
-                                                                                                      	}
-                                              }
-    Vk.queueSubmit2 queue (V.singleton (SomeStruct zero { Vk.waitSemaphoreInfos = V.singleton $ zero { Vk.semaphore = sImageAcquired
-                                                                                                     , Vk.stageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
-                                                                                                     }
-                                                        , Vk.commandBufferInfos = V.singleton $ SomeStruct zero { Vk.commandBuffer = Vk.commandBufferHandle cbuffer }
-                                                        , Vk.signalSemaphoreInfos = V.singleton $ zero { Vk.semaphore = sRenderFinished
-                                                                                                       , Vk.stageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
-                                                                                                       }
-                                                        })) $ V.head fence
-    _ <- Vk.queuePresentKHR queue (zero { Vk.waitSemaphores = V.singleton sRenderFinished
-                                        , Vk.swapchains = V.singleton swapchain
-                                        , Vk.imageIndices = V.singleton imageIndex
-                                        })
+            Vk.cmdDraw cbuffer 3 1 0 0
+        Vk.cmdPipelineBarrier2 cbuffer $ Config.postRenderPipelineBarrier image
+    Vk.queueSubmit2 queue (Config.submitQueue cbuffer sImageAcquired sRenderFinished) $ V.head fence
+    _ <- Vk.queuePresentKHR queue (Config.present swapchain imageIndex sRenderFinished)
     RGFW.rGFW_pollEvents
-    gameloop' dev q pipeline swapchain imageViews images cbuffers queue sImageAcquireds sRenderFinisheds fences (mod (frameIndex + 1) (fromIntegral consts.framesInFlight)) window =<< RGFW.rGFW_window_shouldClose window
-gameloop' dev _ _ _ _ _ _ _ _ _ _ _ _ _ =
+    gameloop' dev q pipeline swapchain imageViews images cbuffers queue sImageAcquireds sRenderFinisheds fences (mod (frameIndex + 1) (fromIntegral Config.consts.framesInFlight)) window =<< RGFW.rGFW_window_shouldClose window
+gameloop' dev _ _ swapchain _ _ _ _ _ _ _ _ _ _ = do
     Vk.deviceWaitIdle dev
-
-pickPhysicalDevice :: Vector Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO (Vk.PhysicalDevice, QueriedData)
-pickPhysicalDevice pdevs surface = do
-    queriedDevs <- do
-        qs <- V.mapM (\pdev -> (queryPhysicalDevice pdev surface)) pdevs
-        return $ V.zip pdevs qs
-    let validpdevs = V.filter isValidPhysicalDevice queriedDevs
-    pickPhysicalDevice' validpdevs V.empty
-
-pickPhysicalDevice' :: Vector (Vk.PhysicalDevice, QueriedData) -> Vector (Vk.PhysicalDevice, QueriedData) -> IO (Vk.PhysicalDevice, QueriedData)
-pickPhysicalDevice' pdevs opts =
-    if V.null pdevs
-    then return $ (V.head opts)
-    else do
-        let pdev = V.head pdevs
-        case (snd pdev).physicalDeviceProperties.deviceType of
-            Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU -> pickPhysicalDevice' (V.tail pdevs) (V.cons pdev opts)
-            Vk.PHYSICAL_DEVICE_TYPE_CPU -> pickPhysicalDevice' (V.tail pdevs) opts
-            _ -> pickPhysicalDevice' (V.tail pdevs) (V.snoc opts pdev)
-
--- returns list of queueFamilyIndex whick support a graphics pipeline
-getGraphicsQueues :: QueriedData -> [Int]
-getGraphicsQueues q = getGraphicsQueues' q.queueFamilyProperties 0 []
-getGraphicsQueues' :: Vector Vk.QueueFamilyProperties -> Int -> [Int] -> [Int]
-getGraphicsQueues' qfprops i is =
-    if V.null qfprops then is else
-        if zero /= (Vk.QUEUE_GRAPHICS_BIT .&. (V.head qfprops).queueFlags)
-        then getGraphicsQueues' (V.tail qfprops) (i + 1) (i:is)
-        else getGraphicsQueues' (V.tail qfprops) (i + 1) is
-
--- returns list of queueFamilyIndex which support presentation
-getSurfaceSupport :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO [Int]
-getSurfaceSupport pdev surface = do
-    qfprops <- Vk.getPhysicalDeviceQueueFamilyProperties pdev
-    getSurfaceSupport' pdev surface (V.length qfprops - 1) []
-
-getSurfaceSupport' :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> Int -> [Int] -> IO [Int]
-getSurfaceSupport' pdev surface i is = if i < 0 then return is else do
-    support <- Vk.getPhysicalDeviceSurfaceSupportKHR pdev (fromIntegral i) surface
-    if support
-    then getSurfaceSupport' pdev surface (i - 1) (i:is)
-    else getSurfaceSupport' pdev surface (i - 1) is
-
-queryPhysicalDevice :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO QueriedData
-queryPhysicalDevice pdev surface = do
-    qfprops <- Vk.getPhysicalDeviceQueueFamilyProperties pdev
-    sSupport <- getSurfaceSupport pdev surface
-    (_, extps) <- Vk.enumerateDeviceExtensionProperties pdev Nothing
-    caps <- Vk.getPhysicalDeviceSurfaceCapabilitiesKHR pdev surface
-    (_, forms) <- Vk.getPhysicalDeviceSurfaceFormatsKHR pdev surface
-    props <- Vk.getPhysicalDeviceProperties pdev
-    return QueriedData { surfaceCapabilities      = caps
-                       , surfaceSupport           = sSupport
-                       , surfaceFormats           = forms
-                       , queueFamilyProperties    = qfprops
-                       , extensionProperties      = extps
-                       , physicalDeviceProperties = props
-                       }
-
--- checks that a device has the requisite capabilities
-isValidPhysicalDevice :: (Vk.PhysicalDevice, QueriedData) -> Bool
-isValidPhysicalDevice (_, q) =
-    if null $ getGraphicsQueues q
-    then False
-    else if null q.surfaceSupport
-    then False
-    else if [] /= ((V.toList extensions) \\ (V.toList $ V.map (\p -> p.extensionName) q.extensionProperties))
-    then False
-    else True
-
--- type conversion
-processExtensions :: CSize -> Ptr (ConstPtr CChar) -> Vector ByteString -> IO (Vector ByteString)
-processExtensions 0 _ extNames = return extNames
-processExtensions count strs extNames = do
-    str <- peek strs
-    extName <- BS.packCString (coerce str)
-    processExtensions (count - 1) (advancePtr strs 1) $ V.snoc extNames extName
-
-withFences :: Vk.Device -> Vector (Vk.FenceCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.Fence -> IO r) -> IO r
-withFences dev infos alloc io = do
-    fs <- mapM (\info -> Vk.createFence dev info alloc) infos
-    o0 <- io fs
-    _ <- mapM (\f -> Vk.destroyFence dev f alloc) fs
-    return o0
-
-withSemaphores :: Vk.Device -> Vector (Vk.SemaphoreCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.Semaphore -> IO r) -> IO r
-withSemaphores dev infos alloc io = do
-    ss <- mapM (\info -> Vk.createSemaphore dev info alloc) infos
-    o0 <- io ss
-    _ <- mapM (\s -> Vk.destroySemaphore dev s alloc) ss
-    return o0
-
-withImageViews :: Vk.Device -> Vector (Vk.ImageViewCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.ImageView -> IO r) -> IO r
-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
-    return o0
-
-withShaderModules :: Vk.Device -> Vector (Vk.ShaderModuleCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.ShaderModule -> IO r) -> IO r
-withShaderModules dev infos alloc io = do
-    mods <- mapM (\info -> Vk.createShaderModule dev info alloc) infos
-    o0 <- io mods
-    _ <- mapM (\mod -> Vk.destroyShaderModule dev mod alloc) mods
-    return o0
-
-withWindow :: String -> Int32 -> Int32 -> Int32 -> Int32 -> RGFW.RGFW_windowFlags -> (Ptr RGFW.RGFW_window -> IO r) -> IO r
-withWindow name x y w h flags io =
-    withCString name $ \str -> do
-        window <- RGFW.rGFW_createWindow (ConstPtr str) (RGFW.I32 x) (RGFW.I32 y) (RGFW.I32 w) (RGFW.I32 h) flags
-        o0 <- io window
-        RGFW.rGFW_window_close window
-        return o0
-
-withRGFW :: String -> RGFW.RGFW_initFlags -> (Int32 -> IO r) -> IO r
-withRGFW title flags io =
-    withCString title $ \str -> do
-        ret_code <- RGFW.rGFW_init (ConstPtr str) flags
-        o0 <- io $ fromIntegral ret_code
-        RGFW.rGFW_deinit
-        return o0
\ No newline at end of file
+    Vk.destroySwapchainKHR dev swapchain Nothing
\ No newline at end of file
diff --git a/VkTest/Config.hs b/VkTest/Config.hs
new file mode 100644
index 0000000..8f18aa2
--- /dev/null
+++ b/VkTest/Config.hs
@@ -0,0 +1,248 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module VkTest.Config where
+
+import Data.Bits              ((.|.))
+import Data.ByteString        (ByteString)
+import Data.Int               (Int32)
+import Data.Vector            (Vector)
+import Data.Word              (Word32)
+import FIR                    (compileTo, runCompilationsTH, ModuleRequirements)
+import Vulkan.CStruct.Extends (SomeStruct(..))
+import Vulkan.Zero            (zero)
+
+import qualified Data.ByteString.Char8              as BSC
+import qualified Data.Vector                        as V
+import qualified VkTest.Shaders                     as Shaders
+import qualified Vulkan.Core10                      as Vk
+import qualified Vulkan.Core13                      as Vk
+import qualified Vulkan.Extensions.VK_KHR_surface   as Vk
+import qualified Vulkan.Extensions.VK_KHR_swapchain as Vk
+
+height :: Int32
+height = 400
+width :: Int32
+width = 800
+
+layers :: Vector ByteString
+layers = V.fromList $ map BSC.pack ["VK_LAYER_KHRONOS_validation"]
+
+extensions :: Vector ByteString
+extensions = V.fromList $ map BSC.pack ["VK_KHR_swapchain"]
+
+vert :: Either a ModuleRequirements
+vert = $( runCompilationsTH [("Fragment Shader", compileTo Shaders.vertPath [] Shaders.vertex)] )
+
+frag :: Either a ModuleRequirements
+frag = $( runCompilationsTH [("Fragment Shader", compileTo Shaders.fragPath [] Shaders.fragment)] )
+
+data Consts = Consts
+    { title          :: String
+    , vkApiVersion   :: Word32
+    , framesInFlight :: Word32
+    }
+    deriving Show
+
+consts :: Consts
+consts =
+    Consts
+    { title          = "game title"
+    , vkApiVersion   = Vk.API_VERSION_1_3
+    , framesInFlight = 2
+    }
+
+-- for a given physical device and surface
+data QueriedData = QueriedData
+    { surfaceCapabilities      :: Vk.SurfaceCapabilitiesKHR
+    , surfaceSupport           :: [Int]
+    , surfaceFormats           :: Vector Vk.SurfaceFormatKHR
+    , queueFamilyProperties    :: Vector Vk.QueueFamilyProperties
+    , extensionProperties      :: Vector Vk.ExtensionProperties
+    , physicalDeviceProperties :: Vk.PhysicalDeviceProperties
+    }
+    deriving Show
+
+instance' :: Vector ByteString -> Vk.InstanceCreateInfo '[]
+instance' exts =
+    zero { Vk.applicationInfo = Just (zero :: Vk.ApplicationInfo) { Vk.apiVersion = consts.vkApiVersion }
+         , Vk.enabledExtensionNames = exts
+         }
+
+device :: Word32 -> Vk.DeviceCreateInfo '[Vk.PhysicalDeviceVulkan13Features]
+device gqueueIndex =
+    zero { Vk.next = (vkFeatures13, ())
+         , Vk.queueCreateInfos = V.singleton $ SomeStruct zero { Vk.queueFamilyIndex = gqueueIndex
+                                                               , Vk.queuePriorities = V.singleton 1
+                                                               }
+         , Vk.enabledExtensionNames = extensions
+         }
+
+vkFeatures13 :: Vk.PhysicalDeviceVulkan13Features
+vkFeatures13 =
+    zero { Vk.synchronization2 = True
+         , Vk.dynamicRendering = True
+         }
+
+commandPool :: Word32 -> Vk.CommandPoolCreateInfo '[]
+commandPool gqueueIndex =
+    zero { Vk.queueFamilyIndex = gqueueIndex
+         , Vk.flags = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT
+         }
+
+commandBuffer :: Vk.CommandPool -> Vk.CommandBufferAllocateInfo
+commandBuffer gpool =
+    zero { Vk.commandPool = gpool
+         , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY
+         , Vk.commandBufferCount = consts.framesInFlight
+         }
+
+swapchain :: QueriedData -> Vk.SurfaceKHR -> Vk.SwapchainCreateInfoKHR '[]
+swapchain q surface =
+    zero { Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_OPAQUE_BIT_KHR
+         , Vk.imageArrayLayers = 1
+         , Vk.imageColorSpace = Vk.COLORSPACE_SRGB_NONLINEAR_KHR
+         , Vk.imageExtent = q.surfaceCapabilities.currentExtent
+         , Vk.imageFormat = (V.head q.surfaceFormats).format
+         , Vk.imageUsage = Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT
+         , Vk.minImageCount = q.surfaceCapabilities.minImageCount
+         , Vk.presentMode = Vk.PRESENT_MODE_FIFO_KHR
+         , Vk.preTransform = Vk.SURFACE_TRANSFORM_IDENTITY_BIT_KHR
+         , Vk.surface = surface
+         }
+
+imageViews :: Vector Vk.Image -> QueriedData -> Vector (Vk.ImageViewCreateInfo '[])
+imageViews images q =
+    V.map (\image -> (zero :: Vk.ImageViewCreateInfo '[]) { Vk.image = image
+                                                          , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
+                                                          , 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 q.surfaceFormats).format
+                                                          }) images
+
+pipelineLayout :: Vk.PipelineLayoutCreateInfo
+pipelineLayout =
+    zero
+
+graphicsPipeline :: QueriedData -> Vk.ShaderModule -> Vk.ShaderModule -> Vk.PipelineLayout -> Vk.GraphicsPipelineCreateInfo '[Vk.PipelineRenderingCreateInfo]
+graphicsPipeline q vertMod fragMod pipelineLayout' =
+    zero { Vk.next = (pipelineRendering q, ())
+         , Vk.stages = V.map (SomeStruct) $ V.fromList [ zero { Vk.stage = Vk.SHADER_STAGE_VERTEX_BIT
+                                                              , Vk.module' = vertMod
+                                                              , Vk.name = "main"
+                                                              }
+                                                       , zero { Vk.stage = Vk.SHADER_STAGE_FRAGMENT_BIT
+                                                              , Vk.module' = fragMod
+                                                              , Vk.name = "main"
+                                                              }]
+         , Vk.vertexInputState = Just zero
+         , Vk.inputAssemblyState = Just zero { Vk.topology = Vk.PRIMITIVE_TOPOLOGY_TRIANGLE_LIST }
+         , Vk.tessellationState = Nothing
+         , Vk.viewportState = Just $ SomeStruct zero { Vk.viewports = V.fromList [zero { Vk.x = 0
+                                                                                       , Vk.y = 0
+                                                                                       , Vk.width = fromIntegral q.surfaceCapabilities.currentExtent.width
+                                                                                       , Vk.height = fromIntegral q.surfaceCapabilities.currentExtent.height
+                                                                                       , Vk.minDepth = 0
+                                                                                       , Vk.maxDepth = 1
+                                                                                       }]
+                                                     , Vk.scissors = V.fromList [(zero :: Vk.Rect2D) { Vk.offset = zero
+                                                                                                     , Vk.extent = q.surfaceCapabilities.currentExtent
+                                                                                                     }]
+                                                     }
+
+         , Vk.rasterizationState = Just $ SomeStruct zero { Vk.lineWidth = 1 }
+         , Vk.multisampleState = Just $ SomeStruct zero { Vk.rasterizationSamples = Vk.SAMPLE_COUNT_1_BIT }
+         , Vk.depthStencilState = Just zero
+         , Vk.colorBlendState = Just $ SomeStruct zero { Vk.attachments = V.singleton zero { Vk.colorWriteMask = Vk.COLOR_COMPONENT_R_BIT .|. Vk.COLOR_COMPONENT_G_BIT .|. Vk.COLOR_COMPONENT_B_BIT .|. Vk.COLOR_COMPONENT_A_BIT }}
+         , Vk.dynamicState = Just zero { Vk.dynamicStates = V.fromList [Vk.DYNAMIC_STATE_VIEWPORT, Vk.DYNAMIC_STATE_SCISSOR] }
+         , Vk.layout = pipelineLayout'
+         }
+
+pipelineRendering :: QueriedData -> Vk.PipelineRenderingCreateInfo
+pipelineRendering q =
+    zero { Vk.colorAttachmentFormats = V.singleton (V.head q.surfaceFormats).format }
+
+preRenderPipelineBarrier :: Vk.Image -> Vk.DependencyInfo '[]
+preRenderPipelineBarrier image =
+    zero { Vk.imageMemoryBarriers = V.singleton $ SomeStruct zero { Vk.srcStageMask = Vk.PIPELINE_STAGE_2_NONE
+                                                                  , Vk.srcAccessMask = Vk.ACCESS_2_NONE
+                                                                  , Vk.dstStageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
+                                                                  , Vk.dstAccessMask = Vk.ACCESS_2_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_2_COLOR_ATTACHMENT_WRITE_BIT
+                                                                  , Vk.oldLayout = Vk.IMAGE_LAYOUT_UNDEFINED
+                                                                  , Vk.newLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
+                                                                  , Vk.image = image
+                                                                  , Vk.subresourceRange = zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
+                                                                                               , Vk.levelCount = 1
+                                                                                               , Vk.layerCount = 1
+                                                                                               }
+                                                                  }
+         }
+
+postRenderPipelineBarrier :: Vk.Image -> Vk.DependencyInfo '[]
+postRenderPipelineBarrier image =
+    zero { Vk.imageMemoryBarriers = V.singleton $ SomeStruct zero { Vk.srcStageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
+                                                                  , Vk.srcAccessMask = Vk.ACCESS_2_COLOR_ATTACHMENT_WRITE_BIT
+                                                                  , Vk.dstStageMask = Vk.PIPELINE_STAGE_2_NONE
+                                                                  , Vk.dstAccessMask = Vk.ACCESS_2_NONE
+                                                                  , Vk.oldLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
+                                                                  , Vk.newLayout = Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
+                                                                  , Vk.image = image
+                                                                  , Vk.subresourceRange = zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
+                                                                                               , Vk.levelCount = 1
+                                                                                               , Vk.layerCount = 1
+                                                                                               }
+                                                                  }
+         }
+
+rendering :: QueriedData -> Vk.ImageView -> Vk.RenderingInfo '[]
+rendering q imageView =
+    zero { Vk.renderArea = zero { Vk.extent = q.surfaceCapabilities.currentExtent }
+         , Vk.layerCount = 1
+         , Vk.colorAttachments = V.singleton $ (SomeStruct) zero { Vk.imageView = imageView
+                                                                 , Vk.imageLayout = Vk.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL
+                                                                 , Vk.loadOp = Vk.ATTACHMENT_LOAD_OP_CLEAR
+                                                                 , Vk.storeOp = Vk.ATTACHMENT_STORE_OP_STORE
+                                                                 , Vk.clearValue = Vk.Color $ Vk.Float32 0 0 1 1
+                                                                 }
+         }
+
+viewport :: QueriedData -> Vector Vk.Viewport
+viewport q =
+    V.singleton zero { Vk.x = 0
+                     , Vk.y = 0
+                     , Vk.width = fromIntegral q.surfaceCapabilities.currentExtent.width
+                     , Vk.height = fromIntegral q.surfaceCapabilities.currentExtent.height
+                     , Vk.minDepth = 0
+                     , Vk.maxDepth = 1
+                     }
+
+scissor :: QueriedData -> Vector Vk.Rect2D
+scissor q =
+    V.singleton (zero :: Vk.Rect2D) { Vk.offset = zero
+                                    , Vk.extent = q.surfaceCapabilities.currentExtent
+                                    }
+
+submitQueue :: Vk.CommandBuffer -> Vk.Semaphore -> Vk.Semaphore -> Vector (SomeStruct Vk.SubmitInfo2)
+submitQueue cbuffer sImageAcquired sRenderFinished =
+    V.singleton $ SomeStruct zero { Vk.waitSemaphoreInfos = V.singleton $ zero { Vk.semaphore = sImageAcquired
+                                                                               , Vk.stageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
+                                                                               }
+                                  , Vk.commandBufferInfos = V.singleton $ SomeStruct zero { Vk.commandBuffer = Vk.commandBufferHandle cbuffer }
+                                  , Vk.signalSemaphoreInfos = V.singleton $ zero { Vk.semaphore = sRenderFinished
+                                                                                 , Vk.stageMask = Vk.PIPELINE_STAGE_2_COLOR_ATTACHMENT_OUTPUT_BIT
+                                                                                 }
+                                  }
+
+present :: Vk.SwapchainKHR -> Word32 -> Vk.Semaphore -> Vk.PresentInfoKHR '[]
+present swapchain' imageIndex sRenderFinished =
+    zero { Vk.waitSemaphores = V.singleton sRenderFinished
+         , Vk.swapchains = V.singleton swapchain'
+         , Vk.imageIndices = V.singleton imageIndex
+         }
\ No newline at end of file
diff --git a/Shaders.hs b/VkTest/Shaders.hs
index 2e1201f..0d88325 100644
--- a/Shaders.hs
+++ b/VkTest/Shaders.hs
@@ -5,8 +5,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
--- from the FIR docs
-module Shaders where
+module VkTest.Shaders where
 
 import FIR
 import Math.Linear
@@ -25,7 +24,7 @@ vertex :: ShaderModule "main" VertexShader VertexDefs _
 vertex = shader  do
     i <- get @"gl_VertexIndex"
     (Vec2 x y) <- let' $ atv3v2f vertices i (Vec2 0 0)
-    put @"gl_Position" (Vec4 x y 0.0 1.0)
+    put @"gl_Position" (Vec4 x y 0 1)
 
 type FragmentDefs =
     '[ "main"      ':-> EntryPoint '[ OriginUpperLeft ] Fragment
@@ -34,7 +33,7 @@ type FragmentDefs =
 
 fragment :: ShaderModule "main" FragmentShader FragmentDefs _
 fragment = shader do
-    put @"out_color" (Vec4 1.0 1.0 0.0 1.0)
+    put @"out_color" (Vec4 1.0 0.0 1.0 1.0)
 
 atv3v2f :: Code (V 3 (V 2 Float)) -> Code Word32 -> Code (V 2 Float) -> Code (V 2 Float)
 atv3v2f (Vec3 x y z) i d =
diff --git a/VkTest/Util.hs b/VkTest/Util.hs
new file mode 100644
index 0000000..d92c2dd
--- /dev/null
+++ b/VkTest/Util.hs
@@ -0,0 +1,162 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module VkTest.Util ( withRGFW
+                   , withWindow
+                   , withShaderModules
+                   , withImageViews
+                   , withSemaphores
+                   , withFences
+                   , pickPhysicalDevice
+                   , processExtensions
+                   , getGraphicsQueues
+                   ) where
+
+import Data.Bits             ((.&.))
+import Data.ByteString       (ByteString)
+import Data.Coerce           (coerce)
+import Data.Int              (Int32)
+import Data.List             ((\\))
+import Data.Vector           (Vector)
+import Foreign.C
+import Foreign.C.ConstPtr    (ConstPtr(..))
+import Foreign.Marshal.Array (advancePtr)
+import Foreign.Ptr           (Ptr)
+import Foreign.Storable      (peek)
+import Vulkan.Zero           (zero)
+
+import VkTest.Config (QueriedData(..))
+
+import qualified VkTest.Config as Config
+
+import qualified Data.ByteString                    as BS
+import qualified Data.Vector                        as V
+import qualified RGFW                               as RGFW
+import qualified Vulkan.Core10                      as Vk
+import qualified Vulkan.Extensions.VK_KHR_surface   as Vk
+
+pickPhysicalDevice :: Vector Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO (Vk.PhysicalDevice, QueriedData)
+pickPhysicalDevice pdevs surface = do
+    queriedDevs <- do
+        qs <- V.mapM (\pdev -> (queryPhysicalDevice pdev surface)) pdevs
+        return $ V.zip pdevs qs
+    let validpdevs = V.filter isValidPhysicalDevice queriedDevs
+    pickPhysicalDevice' validpdevs V.empty
+
+pickPhysicalDevice' :: Vector (Vk.PhysicalDevice, QueriedData) -> Vector (Vk.PhysicalDevice, QueriedData) -> IO (Vk.PhysicalDevice, QueriedData)
+pickPhysicalDevice' pdevs opts =
+    if V.null pdevs
+    then return $ (V.head opts)
+    else do
+        let pdev = V.head pdevs
+        case (snd pdev).physicalDeviceProperties.deviceType of
+            Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU -> pickPhysicalDevice' (V.tail pdevs) (V.cons pdev opts)
+            Vk.PHYSICAL_DEVICE_TYPE_CPU -> pickPhysicalDevice' (V.tail pdevs) opts
+            _ -> pickPhysicalDevice' (V.tail pdevs) (V.snoc opts pdev)
+
+-- returns list of queueFamilyIndex whick support a graphics pipeline
+getGraphicsQueues :: QueriedData -> [Int]
+getGraphicsQueues q = getGraphicsQueues' q.queueFamilyProperties 0 []
+getGraphicsQueues' :: Vector Vk.QueueFamilyProperties -> Int -> [Int] -> [Int]
+getGraphicsQueues' qfprops i is =
+    if V.null qfprops then is else
+        if zero /= (Vk.QUEUE_GRAPHICS_BIT .&. (V.head qfprops).queueFlags)
+        then getGraphicsQueues' (V.tail qfprops) (i + 1) (i:is)
+        else getGraphicsQueues' (V.tail qfprops) (i + 1) is
+
+-- returns list of queueFamilyIndex which support presentation
+getSurfaceSupport :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO [Int]
+getSurfaceSupport pdev surface = do
+    qfprops <- Vk.getPhysicalDeviceQueueFamilyProperties pdev
+    getSurfaceSupport' pdev surface (V.length qfprops - 1) []
+
+getSurfaceSupport' :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> Int -> [Int] -> IO [Int]
+getSurfaceSupport' pdev surface i is = if i < 0 then return is else do
+    support <- Vk.getPhysicalDeviceSurfaceSupportKHR pdev (fromIntegral i) surface
+    if support
+    then getSurfaceSupport' pdev surface (i - 1) (i:is)
+    else getSurfaceSupport' pdev surface (i - 1) is
+
+queryPhysicalDevice :: Vk.PhysicalDevice -> Vk.SurfaceKHR -> IO QueriedData
+queryPhysicalDevice pdev surface = do
+    qfprops <- Vk.getPhysicalDeviceQueueFamilyProperties pdev
+    sSupport <- getSurfaceSupport pdev surface
+    (_, extps) <- Vk.enumerateDeviceExtensionProperties pdev Nothing
+    caps <- Vk.getPhysicalDeviceSurfaceCapabilitiesKHR pdev surface
+    (_, forms) <- Vk.getPhysicalDeviceSurfaceFormatsKHR pdev surface
+    props <- Vk.getPhysicalDeviceProperties pdev
+    return QueriedData { surfaceCapabilities      = caps
+                       , surfaceSupport           = sSupport
+                       , surfaceFormats           = forms
+                       , queueFamilyProperties    = qfprops
+                       , extensionProperties      = extps
+                       , physicalDeviceProperties = props
+                       }
+
+-- checks that a device has the requisite capabilities
+isValidPhysicalDevice :: (Vk.PhysicalDevice, QueriedData) -> Bool
+isValidPhysicalDevice (_, q) =
+    if null $ getGraphicsQueues q
+    then False
+    else if null q.surfaceSupport
+    then False
+    else if [] /= ((V.toList Config.extensions) \\ (V.toList $ V.map (\p -> p.extensionName) q.extensionProperties))
+    then False
+    else True
+
+-- type conversion
+processExtensions :: CSize -> Ptr (ConstPtr CChar) -> Vector ByteString -> IO (Vector ByteString)
+processExtensions 0 _ extNames = return extNames
+processExtensions count strs extNames = do
+    str <- peek strs
+    extName <- BS.packCString (coerce str)
+    processExtensions (count - 1) (advancePtr strs 1) $ V.snoc extNames extName
+
+withFences :: Vk.Device -> Vector (Vk.FenceCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.Fence -> IO r) -> IO r
+withFences dev infos alloc io = do
+    fs <- mapM (\info -> Vk.createFence dev info alloc) infos
+    o0 <- io fs
+    _ <- mapM (\f -> Vk.destroyFence dev f alloc) fs
+    return o0
+
+withSemaphores :: Vk.Device -> Vector (Vk.SemaphoreCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.Semaphore -> IO r) -> IO r
+withSemaphores dev infos alloc io = do
+    ss <- mapM (\info -> Vk.createSemaphore dev info alloc) infos
+    o0 <- io ss
+    _ <- mapM (\s -> Vk.destroySemaphore dev s alloc) ss
+    return o0
+
+withImageViews :: Vk.Device -> Vector (Vk.ImageViewCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.ImageView -> IO r) -> IO r
+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
+    return o0
+
+withShaderModules :: Vk.Device -> Vector (Vk.ShaderModuleCreateInfo '[]) -> Maybe Vk.AllocationCallbacks -> (Vector Vk.ShaderModule -> IO r) -> IO r
+withShaderModules dev infos alloc io = do
+    mods <- mapM (\info -> Vk.createShaderModule dev info alloc) infos
+    o0 <- io mods
+    _ <- mapM (\mod' -> Vk.destroyShaderModule dev mod' alloc) mods
+    return o0
+
+withWindow :: String -> Int32 -> Int32 -> Int32 -> Int32 -> RGFW.RGFW_windowFlags -> (Ptr RGFW.RGFW_window -> IO r) -> IO r
+withWindow name x y w h flags io =
+    withCString name $ \str -> do
+        window <- RGFW.rGFW_createWindow (ConstPtr str) (RGFW.I32 x) (RGFW.I32 y) (RGFW.I32 w) (RGFW.I32 h) flags
+        o0 <- io window
+        RGFW.rGFW_window_close window
+        return o0
+
+withRGFW :: String -> RGFW.RGFW_initFlags -> (Int32 -> IO r) -> IO r
+withRGFW title flags io =
+    withCString title $ \str -> do
+        ret_code <- RGFW.rGFW_init (ConstPtr str) flags
+        o0 <- io $ fromIntegral ret_code
+        RGFW.rGFW_deinit
+        return o0
\ No newline at end of file
diff --git a/vktest.cabal b/vktest.cabal
index 12525a3..3968074 100644
--- a/vktest.cabal
+++ b/vktest.cabal
@@ -11,8 +11,10 @@ extra-doc-files:    CHANGELOG.md
 
 executable vktest
     main-is:          Main.hs
-    other-modules:    RGFW,
-                      Shaders,
+    other-modules:    VkTest.Shaders,
+                      VkTest.Config,
+                      VkTest.Util,
+                      RGFW,
     build-depends:    base             >= 4.20.2,
                       bytestring       >= 0.12,
                       vector           >= 0.13,
@@ -30,5 +32,5 @@ executable vktest
     include-dirs:     include
     hs-source-dirs:   .
     c-sources:        shim.c
-    ghc-options:      -Wall -optc-DRGFW_VULKAN
+    ghc-options:      -Wall -Wno-ambiguous-fields -optc-DRGFW_VULKAN
     default-language: Haskell2010
\ No newline at end of file