flake update

a little cleaner
weed out stuff
2023-11-05 12:02:16 +01:00 · 2023-10-22 12:46:16 +02:00 · 2023-10-22 07:14:22 +02:00 · 2023-10-22 06:08:43 +02:00 · 2023-10-22 02:27:33 +02:00 · 2023-10-22 01:32:38 +02:00
30 changed files with 4308 additions and 495 deletions
--- a/.envrc
+++ b/.envrc
@ -0,0 +1 @@
+use flake
--- a/.gitignore
+++ b/.gitignore
@ -1,4 +1,3 @@
 .direnv/
-.envrc
 dist-newstyle/
 extern/
--- a/assets/models/cat_mask_cyberpunk.obj
+++ b/assets/models/cat_mask_cyberpunk.obj
--- a/assets/models/jaeger.mtl
+++ b/assets/models/jaeger.mtl
@ -0,0 +1,13 @@
+# Blender MTL File: 'jaeger.blend'
+# Material Count: 1
+
+newmtl Material_jaeger.texture.tga
+Ns 92.156863
+Ka 1.000000 1.000000 1.000000
+Kd 0.512000 0.512000 0.512000
+Ks 0.500000 0.500000 0.500000
+Ke 0.000000 0.000000 0.000000
+Ni 1.000000
+d 1.000000
+illum 2
+map_Kd jaeger.texture.tga
--- a/assets/models/jaeger.obj
+++ b/assets/models/jaeger.obj
--- a/assets/models/marksman.obj
+++ b/assets/models/marksman.obj
--- a/assets/textures/bricks.png
+++ b/assets/textures/bricks.png
--- a/assets/textures/bricks_orig.png
+++ b/assets/textures/bricks_orig.png
--- a/assets/textures/jaeger.texture.tga
+++ b/assets/textures/jaeger.texture.tga
--- a/assets/textures/marksman.texture.tga
+++ b/assets/textures/marksman.texture.tga
--- a/flake.lock
+++ b/flake.lock
@ -5,11 +5,11 @@
        "systems": "systems"
      },
      "locked": {
-        "lastModified": 1681202837,
-        "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
+        "lastModified": 1694529238,
+        "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
        "owner": "numtide",
        "repo": "flake-utils",
-        "rev": "cfacdce06f30d2b68473a46042957675eebb3401",
+        "rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
        "type": "github"
      },
      "original": {
@ -20,11 +20,11 @@
    },
    "nixpkgs": {
      "locked": {
-        "lastModified": 1681910883,
-        "narHash": "sha256-z/21lGaEJ/994LiS1Y1ruTfgVme5w/d3Ww8MluaffDM=",
+        "lastModified": 1699181587,
+        "narHash": "sha256-v35mUUgVU2ituIHPNHifpjl5uiYQYyLrpaMtz8X8Ums=",
        "owner": "NixOS",
        "repo": "nixpkgs",
-        "rev": "5608f9dbad40f3a0495a351eceb8c4debb9e6099",
+        "rev": "197629b470f184a47b2a5716312d25b09454bbf8",
        "type": "github"
      },
      "original": {
--- a/flake.nix
+++ b/flake.nix
@ -11,28 +11,36 @@
      let
        pkgs = nixpkgs.legacyPackages.${system};

-        haskellPackages = pkgs.haskellPackages;
+        nixos-lib = import (nixpkgs + "/nixos/lib") {};
+
+        haskellPackages = pkgs.haskellPackages.override (old: {
+          overrides = final: prev: {
+            wavefront = jailbreakUnbreak prev.wavefront;
+            vulkan-tutorial = vulkan-tutorial;
+          };
+        });
+
+        vulkan-tutorial = # (ref:haskell-package-def)
+          haskellPackages.callCabal2nix packageName self {
+            # Dependency overrides go here
+            #wavefront = jailbreakUnbreak haskellPackages.wavefront;
+        };

        jailbreakUnbreak = pkg:
-          pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
+          pkgs.haskell.lib.doJailbreak (pkgs.haskell.lib.markUnbroken pkg);

        packageName = "vulkan-tutorial";
      in rec {
-        packages.${packageName} = # (ref:haskell-package-def)
-          haskellPackages.callCabal2nix packageName self rec {
-            # Dependency overrides go here
-            wavefront = jailbreakUnbreak haskellPackages.wavefront;
-          };
+        packages.default = haskellPackages.vulkan-tutorial;

-        defaultPackage = self.packages.${system}.${packageName};
-
-        devShell = haskellPackages.shellFor {
-          packages = p: [ defaultPackage ];
+        devShells.default = haskellPackages.shellFor {
+          packages = p: [ p.vulkan-tutorial ];
          withHoogle = true;
          buildInputs = (with haskellPackages; [
            haskell-language-server
            ghcid
            cabal-install
+            (jailbreakUnbreak wavefront)
          ]) ++ (with pkgs; [
            shaderc
            vulkan-loader
@ -42,21 +50,6 @@
          VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
          SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
        };
-        #devShell = pkgs.mkShell {
-        #  buildInputs = with haskellPackages; [
-        #    haskell-language-server
-        #    ghcid
-        #    cabal-install
-        #  ];
-        #  nativeBuildInputs = with pkgs; [
-        #    pkg-config
-        #    SDL2
-        #    vulkan-validation-layers
-        #    vulkan-headers
-        #    vulkan-loader
-        #  ];
-        #  inputsFrom = builtins.attrValues self.packages.${system};
-        #};
-      });
+    });
 }

--- a/shadersrc/textured_lit.frag
+++ b/shadersrc/textured_lit.frag
@ -0,0 +1,24 @@
+//glsl version 4.5
+#version 450
+
+//shader input
+layout (location = 0) in vec4 inColor;
+layout (location = 1) in vec2 texCoord;
+//output write
+layout (location = 0) out vec4 outFragColor;
+
+layout(set = 0, binding = 1) uniform  SceneData{
+	vec4 fogColor; // w is for exponent
+	vec4 fogDistances; //x for min, y for max, zw unused.
+	vec4 ambientColor;
+	vec4 sunlightDirection; //w for sun power
+	vec4 sunlightColor;
+} sceneData;
+
+layout(set = 2, binding = 0) uniform sampler2D tex1;
+
+void main()
+{
+  vec3 color = texture(tex1, texCoord).xyz;
+	outFragColor = vec4(color, inColor.w);
+}
--- a/shadersrc/tri_mesh.vert
+++ b/shadersrc/tri_mesh.vert
@ -0,0 +1,40 @@
+#version 460
+layout (location = 0) in vec3 vPosition;
+layout (location = 1) in vec3 vNormal;
+layout (location = 2) in vec4 vColor;
+layout (location = 3) in vec2 vTexCoord;
+
+layout (location = 0) out vec4 outColor;
+layout (location = 1) out vec2 texCoord;
+
+layout(set = 0, binding = 0) uniform  CameraBuffer{
+	mat4 view;
+	mat4 proj;
+	mat4 viewproj;
+} cameraData;
+
+struct ObjectData{
+	mat4 model;
+};
+
+//all object matrices
+layout(std140,set = 1, binding = 0) readonly buffer ObjectBuffer{
+
+	ObjectData objects[];
+} objectBuffer;
+
+//push constants block
+layout( push_constant ) uniform constants
+{
+ vec4 data;
+ mat4 render_matrix;
+} PushConstants;
+
+void main()
+{
+	mat4 modelMatrix = objectBuffer.objects[gl_BaseInstance].model;
+	mat4 transformMatrix = (cameraData.viewproj * modelMatrix);
+	gl_Position = transformMatrix * vec4(vPosition, 1.0f);
+	outColor = vColor;
+  texCoord = vTexCoord;
+}
--- a/src/CommandBuffer.hs
+++ b/src/CommandBuffer.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@ -15,17 +14,15 @@ import Foreign hiding (void)
 import Foreign.C.Types (CInt)
 import Linear
 import qualified Vulkan as Vk
-import qualified Vulkan.CStruct.Extends as Vk
 import qualified Vulkan.Zero as Vk
 import qualified VulkanMemoryAllocator as VMA

 -- internal imports

-import Devices
 import Types
 import Memory
 import Util
-import Control.Exception (bracket, bracket_)
+import Mesh (compactDraws)

 frameOverlap :: Int
 frameOverlap = 2
@ -35,18 +32,21 @@ maxObjects = 10000

 createFrames
  :: (MonadResource m, MonadFail m)
-  => Vk.PhysicalDevice
-  -> Vk.Device
+  => Vk.Device
  -> VMA.Allocator
  -> Vk.DescriptorPool
  -> Vk.DescriptorSetLayout
  -> Vk.DescriptorSetLayout
+  -> Word32
  -> m (V.Vector FrameData, Vk.Queue)
-createFrames physicalDevice logicalDevice allocator descriptorPool setLayout objectSetLayout = do
-
-  queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT
-
-  deviceProperties <- Vk.getPhysicalDeviceProperties physicalDevice
+createFrames
+  logicalDevice
+  allocator
+  descriptorPool
+  setLayout
+  objectSetLayout
+  queueFamilyIndex
+  = do

  let poolCreateInfo = Vk.zero
        { Vk.flags            = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT
@ -56,14 +56,10 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
  graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0

  frames <- V.mapM
-    (\index -> do
+    (\_ -> do

-      commandPool <- snd <$> allocate
-        (Vk.createCommandPool logicalDevice poolCreateInfo Nothing)
-        (\commandPool -> do
-          putStrLn "destroying command pool"
-          Vk.destroyCommandPool logicalDevice commandPool Nothing
-          )
+      commandPool <- snd <$>
+        Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate

      let commandBufferAllocationInfo = Vk.zero
            { Vk.commandPool        = commandPool
@ -71,7 +67,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
            , Vk.commandBufferCount = 1
            }

-      commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo
+      (_, commandBuffer) <- Vk.withCommandBuffers logicalDevice commandBufferAllocationInfo allocate

      let semaphoreCreateInfo = Vk.zero
          fenceCreateInfo = Vk.zero
@ -79,19 +75,11 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
            } :: Vk.FenceCreateInfo '[]

      [presentSemaphore, renderSemaphore] <- replicateM 2
-        (snd <$> allocate
-          (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing)
-          (\semaphore -> do
-            putStrLn "destroying semaphore"
-            Vk.destroySemaphore logicalDevice semaphore Nothing
-            )
-          )
-      renderFence <- snd <$> allocate
-        (Vk.createFence logicalDevice fenceCreateInfo Nothing)
-        (\fence -> do
-          putStrLn "destroying fence"
-          Vk.destroyFence logicalDevice fence Nothing
+        (snd <$>
+          Vk.withSemaphore logicalDevice semaphoreCreateInfo Nothing allocate
          )
+      renderFence <- snd <$>
+        Vk.withFence logicalDevice fenceCreateInfo Nothing allocate

      cameraBuffer <- createAllocatedBuffer
        allocator
@ -99,11 +87,6 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
        Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
        VMA.MEMORY_USAGE_CPU_TO_GPU

-      let sceneParamBufferSize =
-            -- frameOverlap *
-              fromIntegral (padUniformBufferSize
-                (fromIntegral $ sizeOf undefinedGPUSceneData)
-                deviceProperties)
      sceneBuffer <- createAllocatedBuffer
        allocator
        (sizeOf undefinedGPUSceneData * frameOverlap)
@ -116,6 +99,15 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
        Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT
        VMA.MEMORY_USAGE_CPU_TO_GPU

+      indirectBuffer <- createAllocatedBuffer
+        allocator
+        (maxObjects * sizeOf (undefined :: Vk.DrawIndirectCommand))
+        (Vk.BUFFER_USAGE_TRANSFER_DST_BIT .|.
+          Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT .|.
+          Vk.BUFFER_USAGE_INDIRECT_BUFFER_BIT
+          )
+        VMA.MEMORY_USAGE_CPU_TO_GPU
+
      let allocationInfo = Vk.zero
            { Vk.descriptorPool = descriptorPool
            , Vk.setLayouts     = V.singleton setLayout
@ -131,7 +123,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
      let cameraInfo = Vk.zero
            { Vk.buffer = allocatedBuffer cameraBuffer
            , Vk.offset = 0
-            , Vk.range  = fromIntegral $ sizeOf (GPUCameraData identity identity identity)
+            , Vk.range  = fromIntegral $ sizeOf (undefined :: GPUCameraData)
            } :: Vk.DescriptorBufferInfo
          sceneInfo = Vk.zero
            { Vk.buffer = allocatedBuffer sceneBuffer
@ -150,7 +142,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
            cameraInfo
            0
          sceneWrite = writeDescriptorBuffer
-            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
+            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
            (V.head globalDescriptor)
            sceneInfo
            1
@ -177,6 +169,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
        , frameCameraBuffer      = cameraBuffer
        , frameSceneBuffer       = sceneBuffer
        , frameObjectBuffer      = objectBuffer
+        , frameIndirectBuffer    = indirectBuffer
        , frameGlobalDescriptor  = V.head globalDescriptor
        , frameObjectDescriptor  = V.head objectDescriptor
        }
@ -188,32 +181,22 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj

 recordCommandBuffer
  :: (MonadResource m, MonadReader ReadState m, MonadIO m)
-  => Vk.CommandBuffer
+  => VMA.Allocator
+  -> Vk.CommandBuffer
  -> Vk.RenderPass
  -> Vk.Framebuffer
  -> V2 CInt
  -> Vk.Pipeline
-  -> Vk.PipelineLayout
-  -> VMA.Allocator
-  -> GPUSceneData
-  -> AllocatedBuffer
-  -> Vk.PhysicalDeviceProperties
  -> FrameData
-  -> Int
  -> m ()
 recordCommandBuffer
+  allocator
  commandBuffer
  renderPass
  frameBuffer
-  (V2 width height)
+  dimensions@(V2 width height)
  graphicsPipeline
-  meshLayout
-  allocator
-  sceneParameters
-  sceneParameterBuffer
-  deviceProps
  frame
-  frameNumber
  = do

    let commandBufferBeginInfo = Vk.zero
@ -221,177 +204,190 @@ recordCommandBuffer
          , Vk.inheritanceInfo = Nothing
          }

-    Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo
+    Vk.useCommandBuffer commandBuffer commandBufferBeginInfo $ do

-    let renderPassInfo = Vk.zero
-          { Vk.renderPass  = renderPass
-          , Vk.framebuffer = frameBuffer
-          , Vk.renderArea  = Vk.Rect2D
-            { offset = Vk.Offset2D
-              { Vk.x = 0
-              , Vk.y = 0
-              }
-            , extent = Vk.Extent2D
-              { Vk.width  = fromIntegral width
-              , Vk.height = fromIntegral height
+      let renderPassInfo = Vk.zero
+            { Vk.renderPass  = renderPass
+            , Vk.framebuffer = frameBuffer
+            , Vk.renderArea  = Vk.Rect2D
+              { offset = Vk.Offset2D
+                { Vk.x = 0
+                , Vk.y = 0
+                }
+              , extent = Vk.Extent2D
+                { Vk.width  = fromIntegral width
+                , Vk.height = fromIntegral height
+                }
              }
+            , Vk.clearValues = V.fromList
+              [ Vk.Color (Vk.Float32 0 0 0 1)
+              , Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)
+              ]
            }
-          , Vk.clearValues = V.fromList [ Vk.Color (Vk.Float32 0 0 0 1), Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)]
-          }

-    Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
+      Vk.cmdUseRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE $ do

-    Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
-
-    let viewport = Vk.zero
-          { Vk.x        = 0
-          , Vk.y        = 0
-          , Vk.width    = fromIntegral width
-          , Vk.height   = fromIntegral height
-          , Vk.minDepth = 0
-          , Vk.maxDepth = 1
-          }
-        scissor = Vk.Rect2D
-          { Vk.offset = Vk.Offset2D
-            { Vk.x = 0
-            , Vk.y = 0
-            }
-          , Vk.extent = Vk.Extent2D
-            { Vk.width = fromIntegral width
-            , Vk.height = fromIntegral height
-            }
-          }
-
-    Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
-    Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
-
-    let framed = fromIntegral frameNumber / 120
-        ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
-        -- ambient = V4 1 0 1 1
-        ambientParams = sceneParameters
-          { ambientColor = ambient
-          }
-        frameIndex = frameNumber `mod` frameOverlap
-        sceneDataOffset = padUniformBufferSize
-          (fromIntegral $ sizeOf undefinedGPUSceneData)
-          deviceProps
-
-
-    liftIO $ do
-      -- VMA.withMappedMemory allocator (bufferAllocation (frameSceneBuffer frame)) bracket $
-      --   \scenePointer ->
-        let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
-
-        -- dataPointer <- liftIO $ new scenePointer
-
-        -- paramsPtr <- liftIO (new ambientParams)
-
-        -- liftIO $ copyBytes
-        --   (scenePointer `plusPtr` (fromIntegral sceneDataOffset * fromIntegral frameIndex))
-        --   paramsPtr
-        --   (sizeOf undefinedGPUSceneData)
-
-        liftIO $ poke
-          (castPtr scenePointer)
-          -- (castPtr scenePointer `plusPtr`
-          --   (fromIntegral $
-          --     padUniformBufferSize (fromIntegral $ sizeOf (undefinedGPUSceneData)) deviceProps))--  *
-          --       -- fromIntegral frameIndex))
-          ambientParams
-
-        -- liftIO $ do
-        --   test <- peek (castPtr scenePointer :: Ptr GPUSceneData)
-        --   print test
-
-        -- VMA.unmapMemory allocator (bufferAllocation sceneParameterBuffer)
- 
-    renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
-    meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
-
-    V.mapM_
-      (\(index, RenderObject meshID materialID modelMatrix) -> do
-
-        let camPosition = V3
-              (-10 * sin (fromIntegral frameNumber / 90))
-              (-2)
-              (-10 * cos (fromIntegral frameNumber / 90))
-            camCenter = V3 0 0 0
-            camUp = V3 0 1 0
-            camView = lookAt camPosition camCenter camUp
-            camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200
+        liftIO $
+          prepareRecording dimensions commandBuffer graphicsPipeline

+        renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
+        meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
        materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary

-        let cameraData = GPUCameraData
-              { view           = transpose camView
-              , projection     = transpose camProjection
-              , viewProjection = transpose $ camProjection !*! camView
-              }
+        let draws = compactDraws meshMap materialMap renderObjects
+            drawCommands = V.map
+              (\(i, RenderObject mesh _ _) ->
+                Vk.DrawIndirectCommand
+                  { vertexCount   = fromIntegral (V.length $ meshVertices $ meshMap M.! mesh)
+                  , firstVertex   = 0
+                  , instanceCount = 1
+                  , firstInstance = i
+                  }
+                )
+              (V.zip
+                (V.fromList [0..])
+                renderObjects
+                )

-            constants = MeshPushConstants
-              { meshPushData     = V4 0 0 0 0
-              , meshRenderMatrix = transpose modelMatrix
-              }
-            mesh = meshMap M.! meshID
-            material = materialMap M.! materialID
-
-        liftIO $ VMA.withMappedMemory
+        (memRelease, memPtr) <- VMA.withMappedMemory
          allocator
-          (bufferAllocation $ frameCameraBuffer frame)
-          bracket
-          $ \memoryPointer ->
+          (bufferAllocation $ frameIndirectBuffer frame)
+          allocate

-            liftIO $ poke (castPtr memoryPointer) cameraData
+        V.mapM_
+          (\(idx, command) -> liftIO $
+            poke
+              (castPtr memPtr `plusPtr` (idx * sizeOf command))
+              command
+          )
+          (V.zip
+            (V.fromList [0 ..])
+            drawCommands
+           )

-        -- VMA.unmapMemory allocator (bufferAllocation $ frameCameraBuffer frame)
+        release memRelease

-        Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
+        V.mapM_
+          (\(IndirectBatch mesh material first count) -> do

-        let uniformOffset =
-              padUniformBufferSize
-               (fromIntegral $ sizeOf undefinedGPUSceneData)
-               deviceProps
-              * fromIntegral frameIndex
+            when
+              (materialTextureSet material /= Vk.NULL_HANDLE)
+              (Vk.cmdBindDescriptorSets
+                commandBuffer
+                Vk.PIPELINE_BIND_POINT_GRAPHICS
+                (materialPipelineLayout material)
+                2
+                (V.singleton $ materialTextureSet material)
+                V.empty
+                )

-        Vk.cmdBindDescriptorSets
-          commandBuffer
-          Vk.PIPELINE_BIND_POINT_GRAPHICS
-          (materialPipelineLayout material)
-          0
-          (V.singleton $ frameGlobalDescriptor frame)
-          V.empty -- (V.singleton $ fromIntegral uniformOffset)
+            Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)

-        Vk.cmdBindDescriptorSets
-          commandBuffer
-          Vk.PIPELINE_BIND_POINT_GRAPHICS
-          (materialPipelineLayout material)
-          1
-          (V.singleton $ frameObjectDescriptor frame)
-          V.empty
+            Vk.cmdBindDescriptorSets
+              commandBuffer
+              Vk.PIPELINE_BIND_POINT_GRAPHICS
+              (materialPipelineLayout material)
+              0
+              (V.singleton $ frameGlobalDescriptor frame)
+              V.empty

-        dataPointer <- liftIO (castPtr <$> new constants)
+            Vk.cmdBindDescriptorSets
+              commandBuffer
+              Vk.PIPELINE_BIND_POINT_GRAPHICS
+              (materialPipelineLayout material)
+              1
+              (V.singleton $ frameObjectDescriptor frame)
+              V.empty

-        Vk.cmdPushConstants
-          commandBuffer
-          (materialPipelineLayout material)
-          Vk.SHADER_STAGE_VERTEX_BIT
-          0
-          (fromIntegral $ sizeOf constants)
-          dataPointer
+            Vk.cmdBindVertexBuffers
+              commandBuffer
+              0
+              (V.fromList [ allocatedBuffer $ meshBuffer mesh ])
+              (V.fromList [ 0 ])

-        Vk.cmdBindVertexBuffers
-          commandBuffer
-          0
-          (V.fromList [ allocatedBuffer $ meshBuffer mesh ])
-          (V.fromList [ 0 ])
+            let indirectOffset = fromIntegral $
+                  first * fromIntegral ( sizeOf (undefined :: Vk.DrawIndirectCommand))
+                drawStride = fromIntegral $ sizeOf (undefined :: Vk.DrawIndirectCommand)

-        Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
-        )
-      (V.zip
-        (V.fromList [0 ..])
-        renderObjects
-        )
+            Vk.cmdDrawIndirect
+              commandBuffer
+              (allocatedBuffer $ frameIndirectBuffer frame)
+              indirectOffset
+              count
+              drawStride
+            )
+          draws

-    Vk.cmdEndRenderPass commandBuffer
+prepareRecording
+  :: V2 CInt
+  -> Vk.CommandBuffer
+  -> Vk.Pipeline
+  -> IO ()
+prepareRecording (V2 width height) commandBuffer graphicsPipeline = do
+  Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline

-    Vk.endCommandBuffer commandBuffer
+  -- Passing negative height and nonzero y origin to the viewport flips the models back in order
+  let viewport = Vk.zero
+        { Vk.x        = 0
+        , Vk.y        = fromIntegral height
+        , Vk.width    = fromIntegral width
+        , Vk.height   = - fromIntegral height
+        , Vk.minDepth = 0
+        , Vk.maxDepth = 1
+        }
+      scissor = Vk.Rect2D
+        { Vk.offset = Vk.Offset2D
+          { Vk.x = 0
+          , Vk.y = 0
+          }
+        , Vk.extent = Vk.Extent2D
+          { Vk.width = fromIntegral width
+          , Vk.height = fromIntegral height
+          }
+        }
+
+  Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
+  Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
+
+pokeData
+  :: (MonadResource m, MonadReader ReadState m, MonadIO m)
+  => FrameData
+  -> Int
+  -> GPUSceneData
+  -> GPUCameraData
+  -> m ()
+pokeData frame frameNumber sceneParameters cameraParameters = do
+  renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
+
+  let scenePointer = VMA.mappedData (bufferInfo $ frameSceneBuffer frame)
+      memoryPointer = VMA.mappedData (bufferInfo $ frameCameraBuffer frame)
+      objectPointer = VMA.mappedData (bufferInfo $ frameObjectBuffer frame)
+      framed = fromIntegral frameNumber / 120
+      ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
+      -- ambient = V4 1 0 1 1
+      ambientParams = sceneParameters
+        { ambientColor = ambient
+        }
+
+  V.mapM_
+    (\(index, obj) -> do
+
+      let modelMatrix = GPUObjectData (objectMatrix obj)
+
+      liftIO $ poke
+        (castPtr objectPointer `plusPtr` (index * sizeOf (undefined :: GPUObjectData)))
+        modelMatrix
+      )
+    (V.zip
+      (V.fromList [0 ..])
+      renderObjects
+      )
+
+  liftIO $ do
+    poke
+      (castPtr scenePointer)
+      ambientParams
+
+    poke
+      (castPtr memoryPointer)
+      cameraParameters
--- a/src/Devices.hs
+++ b/src/Devices.hs
@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Devices where

 import Control.Monad
@ -9,7 +10,7 @@ import Control.Monad.Trans.Resource
 import qualified Data.Vector as V
 import Data.Maybe (fromMaybe, isNothing)
 import Data.Bits
-import Data.Word (Word32)
+import Foreign
 import Foreign.C.Types (CInt)
 import Linear
 import qualified Vulkan as Vk
@ -38,7 +39,7 @@ pickPhysicalDevice vkInstance = do
    physDevices

  let discretePhysDevices = V.filter
-        (\(_, devProps, devFeatures) ->
+        (\(_, _, devFeatures) ->
          -- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
          Vk.geometryShader devFeatures
          )
@ -90,7 +91,7 @@ createLogicalDevice
  :: (MonadResource m)
  => Vk.PhysicalDevice
  -> Vk.SurfaceKHR
-  -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR)
+  -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR, Word32)
 createLogicalDevice physDevice surface = do

  graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT
@ -104,20 +105,26 @@ createLogicalDevice physDevice surface = do
      deviceCreateInfo = Vk.zero
        { Vk.queueCreateInfos      = V.singleton (Vk.SomeStruct queueCreateInfo)
        , Vk.enabledExtensionNames = extensionNames
+        , Vk.enabledFeatures       = Just (Vk.zero
+          { Vk.multiDrawIndirect = True
+          } :: Vk.PhysicalDeviceFeatures)
        }
+      shaderDrawParametersFeatures = Vk.zero
+        { Vk.shaderDrawParameters  = True
+        } :: Vk.PhysicalDeviceShaderDrawParametersFeatures

-  (_, logDevice) <- allocate
-    (Vk.createDevice physDevice deviceCreateInfo Nothing)
-    (\logDevice -> do
-      putStrLn "destroying logical device"
-      Vk.destroyDevice logDevice Nothing
-      )
+  (_, logDevice) <-
+    Vk.withDevice
+      physDevice
+      (deviceCreateInfo Vk.::& shaderDrawParametersFeatures Vk.:& ())
+      Nothing
+      allocate

  (result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface
  unless (result == Vk.SUCCESS) $
    error "createLogicalDevice: Failed retrieving surface image formats"

-  return (logDevice, formats)
+  return (logDevice, formats, graphicsQueueFamily)

 createSwapchain
  :: (MonadResource m)
@ -137,9 +144,9 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
    if
      V.any
        (\a ->
-          (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) a ==
+          a.format ==
            Vk.FORMAT_B8G8R8A8_SRGB
-          && (Vk.colorSpace :: Vk.SurfaceFormatKHR -> Vk.ColorSpaceKHR) a ==
+          && a.colorSpace ==
            Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
        surfaceFormats
    then
@ -166,12 +173,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
        , Vk.clipped          = True
        }

-  swapchain <- snd <$> allocate
-    (Vk.createSwapchainKHR logicalDevice createInfo Nothing)
-    (\swapchain -> do
-      putStrLn "destroying swapchain"
-      Vk.destroySwapchainKHR logicalDevice swapchain Nothing
-      )
+  swapchain <- snd <$>
+    Vk.withSwapchainKHR logicalDevice createInfo Nothing allocate

  let depthImageExtent =
        (\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1)
@ -187,12 +190,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
        , VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
        }

-  (depthImage, depthAllocation, _) <- snd <$> allocate
-    (VMA.createImage allocator depthImageInfo depthImageAllocationInfo)
-    (\(depthImage, depthAllocation, _) -> do
-      putStrLn "destroying image"
-      VMA.destroyImage allocator depthImage depthAllocation
-      )
+  (depthImage, depthAllocation, _) <- snd <$>
+    VMA.withImage allocator depthImageInfo depthImageAllocationInfo allocate

  let allocatedImage = AllocatedImage depthImage depthAllocation
      depthImageView = imageviewCreate
@ -200,12 +199,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
        Vk.FORMAT_D32_SFLOAT
        Vk.IMAGE_ASPECT_DEPTH_BIT

-  depthImageview <- snd <$> allocate
-    (Vk.createImageView logicalDevice depthImageView Nothing)
-    (\depthImageview -> do
-      putStrLn "destroying image view"
-      Vk.destroyImageView logicalDevice depthImageview Nothing
-      )
+  depthImageview <- snd <$>
+    Vk.withImageView logicalDevice depthImageView Nothing allocate

  return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage)

@ -228,7 +223,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
      let createInfo = Vk.zero
            { Vk.image            = tmpImage
            , Vk.viewType         = Vk.IMAGE_VIEW_TYPE_2D
-            , Vk.format           = (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) surfaceFormat
+            , Vk.format           = surfaceFormat.format
            , Vk.components       = Vk.ComponentMapping
              { Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY
              , Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY
@ -243,11 +238,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
              , layerCount     = 1
              }
            }
-      snd <$> allocate
-        (Vk.createImageView logicalDevice createInfo Nothing)
-        (\imageView -> do
-          putStrLn "destroying image view"
-          Vk.destroyImageView logicalDevice imageView Nothing
-          )
+      snd <$>
+        Vk.withImageView logicalDevice createInfo Nothing allocate
      )
    handles
--- a/src/Draw.hs
+++ b/src/Draw.hs
@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Draw where

 import qualified Control.Concurrent.STM as STM
@ -10,6 +11,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Resource
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
+import Linear
 import qualified Vulkan.Core10 as Vk
 import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
 import qualified Vulkan.CStruct.Extends as Vk
@ -48,26 +50,44 @@ drawFrame engineData frameNumber = do
  unless (imageResult == Vk.SUCCESS) $
    error "drawFrame: Failed acquiring next image from swapchain"

-  -- liftIO $ putStrLn "resetting command buffer"
  Vk.resetCommandBuffer
    (frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0)

  matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary

-  -- liftIO $ putStrLn "recording command buffer"
+  let (V2 width height) = engineWindowDimensions engineData
+      camPosition = V3
+        (-10 * sin (fromIntegral frameNumber / 90))
+        2
+        (-10 * cos (fromIntegral frameNumber / 90))
+      camCenter = V3 0 0 0
+      camUp = V3 0 1 0
+      camView = lookAt camPosition camCenter camUp
+      camProjection = perspective
+        (pi/4)
+        (fromIntegral width / fromIntegral height)
+        0.1
+        200
+      cameraData = GPUCameraData
+        { view           = camView
+        , projection     = camProjection
+        , viewProjection = camProjection !*! camView
+        }
+
+  pokeData
+    frame
+    frameNumber
+    (engineSceneParameters engineData)
+    cameraData
+
  recordCommandBuffer
+    (engineData.engineAllocator)
    (frameMainCommandBuffer frame)
    (engineRenderPass engineData)
    (engineFramebuffers engineData V.! fromIntegral index)
    (engineWindowDimensions engineData)
    (materialPipeline $  matLibrary M.! "defaultMesh")
-    (meshPipelineLayout engineData)
-    (engineAllocator engineData)
-    (engineSceneParameters engineData)
-    (engineSceneParameterBuffer engineData)
-    (enginePhysicalDeviceProperties engineData)
    frame
-    frameNumber

  let submitInfo = Vk.zero
        { Vk.waitSemaphores =
@ -80,7 +100,6 @@ drawFrame engineData frameNumber = do
          V.singleton $ framePresentSemaphore frame
        }

-  -- liftIO $ putStrLn "submitting to queue"
  Vk.queueSubmit
    (engineQueue engineData)
    (V.singleton (Vk.SomeStruct submitInfo))
@ -92,7 +111,6 @@ drawFrame engineData frameNumber = do
        , Khr.imageIndices = V.singleton index
        }

-  -- liftIO $ putStrLn "presenting queue"
  presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo

  unless (presentResult == Vk.SUCCESS) $
--- a/src/Framebuffers.hs
+++ b/src/Framebuffers.hs
@ -39,11 +39,6 @@ createFramebuffer
        let createInfo = framebufferCreateInfo
              {  Vk.attachments = V.fromList [ imageView, depthImageView ]
              } :: Vk.FramebufferCreateInfo '[]
-        snd <$> allocate
-          (Vk.createFramebuffer logicalDevice createInfo Nothing)
-          (\framebuffer -> do
-            putStrLn "destroying framebuffer"
-            Vk.destroyFramebuffer logicalDevice framebuffer Nothing
-            )
+        snd <$> Vk.withFramebuffer logicalDevice createInfo Nothing allocate
        )
      swapchainImageViews
--- a/src/GraphicsPipeline.hs
+++ b/src/GraphicsPipeline.hs
@ -49,12 +49,8 @@ loadShader logicalDevice shaderPath stage = do
        { Vk.code = shader
        }

-  snd <$> allocate
-    (Vk.createShaderModule logicalDevice createInfo Nothing)
-    (\shaderModule -> do
-      putStrLn "destroying shader module"
-      Vk.destroyShaderModule logicalDevice shaderModule Nothing
-      )
+  snd <$>
+    Vk.withShaderModule logicalDevice createInfo Nothing allocate

 createRenderPass
  :: (MonadResource m)
@ -126,12 +122,8 @@ createRenderPass
          , Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
          } :: Vk.RenderPassCreateInfo '[]

-    snd <$> allocate
-      (Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
-      (\renderPass -> do
-        putStrLn "destroying render pass"
-        Vk.destroyRenderPass logicalDevice renderPass Nothing
-        )
+    snd <$>
+      Vk.withRenderPass logicalDevice renderPassCreateInfo Nothing allocate

 createShaderStageCreateInfo
  :: Vk.ShaderStageFlagBits
@ -202,6 +194,7 @@ createGraphicsPipelines
  -> V2 CInt
  -> Vk.PipelineLayout
  -> Maybe Vk.PipelineDepthStencilStateCreateInfo
+  -> String
  -> m ()
 createGraphicsPipelines
  logicalDevice
@ -210,6 +203,7 @@ createGraphicsPipelines
  (V2 width height)
  pipelineLayout
  depthState
+  materialName
  = do
    meshLib <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
    let pipelineStagesCreateInfos =
@ -300,29 +294,22 @@ createGraphicsPipelines
          , Vk.basePipelineIndex  = -1
          }

-    pipeline <- snd <$> allocate
+    pipeline <-
      (do
-        (result, pipelines) <- Vk.createGraphicsPipelines
+        (result, pipelines) <- snd <$> Vk.withGraphicsPipelines
          logicalDevice
          Vk.NULL_HANDLE
          (V.singleton (Vk.SomeStruct pipelineCreateInfo))
          Nothing
+          allocate
        unless (result == Vk.SUCCESS) $
          error "createGraphicsPipelines: Failed creating pipelines"
        return pipelines
        )
-      (\pipelines -> do
-        V.mapM_
-          (\pipeline -> do
-            putStrLn "destroying pipeline"
-            Vk.destroyPipeline logicalDevice pipeline Nothing
-            )
-          pipelines
-        )
-    let material = Material (V.head pipeline) pipelineLayout
+    let material = Material Vk.NULL_HANDLE (V.head pipeline) pipelineLayout
    matLibraryTMVar <- asks materialLibrary
    matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar
-    let newMatLibrary = M.insert "defaultMesh" material matLibrary
+    let newMatLibrary = M.insert materialName material matLibrary
    void $ liftIO $ STM.atomically $ STM.swapTMVar matLibraryTMVar newMatLibrary

 createMeshPipelineLayout
@ -333,7 +320,7 @@ createMeshPipelineLayout
 createMeshPipelineLayout logicalDevice layouts = do
  let pushConstantRange = Vk.zero
        { Vk.offset     = 0
-        , Vk.size       = fromIntegral (sizeOf (undefinedMeshPushConstants))
+        , Vk.size       = fromIntegral (sizeOf undefinedMeshPushConstants)
        , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
        }
      pipelineLayoutCreateInfo = Vk.zero
@ -341,9 +328,5 @@ createMeshPipelineLayout logicalDevice layouts = do
        , Vk.setLayouts         = layouts
        }

-  snd <$> allocate
-    (Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
-    (\pipelineLayout -> do
-      putStrLn "destroying pipeline layout"
-      Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
-      )
+  snd <$>
+    Vk.withPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing allocate
--- a/src/Init.hs
+++ b/src/Init.hs
@ -10,15 +10,16 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Reader
 import Control.Monad.Trans.Resource
-import Data.Bits ((.|.))
+import Data.Bits
+import qualified Data.Map.Strict as M
+import Data.Maybe
 import qualified Data.Vector as V
 import qualified SDL hiding (V2)
 import qualified SDL.Video.Vulkan as SDL
-import Foreign (sizeOf)
 import Foreign.Ptr
 import Linear as L
-import qualified VulkanMemoryAllocator as VMA
-import qualified Vulkan.Core10 as Vk
+import qualified Vulkan as Vk
+import qualified Vulkan.CStruct.Extends as Vk
 import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
 import qualified Vulkan.Extensions.VK_KHR_surface as Khr
 import qualified Vulkan.Zero as Vk
@ -33,6 +34,8 @@ import Memory
 import Types
 import Mesh
 import CommandBuffer
+import Sync
+import Textures
 import Util

 initEngine
@ -90,9 +93,13 @@ initVulkan window = do
      )

  vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
-  (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
+  (vulkanLogicalDevice, surfaceFormats, queueIndex) <-
+    createLogicalDevice vulkanPhysicalDevice vulkanSurface

-  (descriptorSetLayout1, descriptorSetLayout2, descriptorPool) <- initDescriptors vulkanLogicalDevice
+  uploadContext <- initSyncStructures vulkanLogicalDevice queueIndex
+
+  (descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool) <-
+    initDescriptors vulkanLogicalDevice

  allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance

@ -100,17 +107,28 @@ initVulkan window = do
  (swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <-
    createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator
  imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
-  meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
+  meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/tri_mesh.vert" "vert"
  meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag"
+  textureFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/textured_lit.frag" "frag"
  renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT
  meshLayout <- createMeshPipelineLayout
    vulkanLogicalDevice
    (V.fromList
      [ descriptorSetLayout1
      , descriptorSetLayout2
+      , textureDescriptorSetLayout
+      ]
+      )
+  textureLayout <- createMeshPipelineLayout
+    vulkanLogicalDevice
+    (V.fromList
+      [ descriptorSetLayout1
+      , descriptorSetLayout2
+      , textureDescriptorSetLayout
      ]
      )
  let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
+      textureContainer = ShaderContainer (Just meshVertexShader) (Just textureFragmentShader)
  createGraphicsPipelines
    vulkanLogicalDevice
    renderPass
@ -118,16 +136,34 @@ initVulkan window = do
    dimensions
    meshLayout
    (Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
+    "defaultMesh"
+  createGraphicsPipelines
+    vulkanLogicalDevice
+    renderPass
+    textureContainer
+    dimensions
+    textureLayout
+    (Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
+    "texturedMesh"

  frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions

-  (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice allocator descriptorPool descriptorSetLayout1 descriptorSetLayout2
+  (frames, queue) <-
+    createFrames
+      vulkanLogicalDevice
+      allocator
+      descriptorPool
+      descriptorSetLayout1
+      descriptorSetLayout2
+      queueIndex

-  loadMeshes allocator
+  loadMeshes allocator uploadContext queue vulkanLogicalDevice

-  initScene
+  loadImages allocator uploadContext queue vulkanLogicalDevice

-  EngineData
+  initScene vulkanLogicalDevice descriptorPool textureDescriptorSetLayout
+
+  return $ EngineData
    window
    dimensions
    vulkanPhysicalDevice
@ -136,7 +172,6 @@ initVulkan window = do
    swapchain
    queue
    frameBuffers
-    meshLayout
    renderPass
    allocator
    depthImageView
@ -145,27 +180,28 @@ initVulkan window = do
    frames
    descriptorSetLayout1
    descriptorSetLayout2
+    textureDescriptorSetLayout
    descriptorPool
-    <$> Vk.getPhysicalDeviceProperties vulkanPhysicalDevice
-    <*> pure (GPUSceneData
+    (GPUSceneData
      (V4 0 0 0 0)
      (V4 0 0 0 0)
      (V4 0 0 0 0)
      (V4 0 0 0 0)
      (V4 0 0 0 0)
      )
-    <*> createAllocatedBuffer
-      allocator
-      (sizeOf undefinedGPUSceneData * frameOverlap)
-      Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
-      VMA.MEMORY_USAGE_GPU_ONLY
+    uploadContext


-initScene :: (MonadReader ReadState m, MonadIO m) => m ()
-initScene = do
-  let mask = RenderObject
+initScene
+  :: (MonadReader ReadState m, MonadIO m, MonadResource m)
+  => Vk.Device
+  -> Vk.DescriptorPool
+  -> Vk.DescriptorSetLayout
+  -> m ()
+initScene device descriptorPool texturedSetLayout = do
+  let catMask = RenderObject
        { objectMesh     = "mask"
-        , objectMaterial = "defaultMesh"
+        , objectMaterial = "texturedMesh"
        , objectMatrix   = identity
        }
      triangles = V.concatMap
@ -190,12 +226,53 @@ initScene = do
  renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer

  void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $
-    (renderableVector `V.snoc` mask) V.++ triangles
+    (renderableVector `V.snoc` catMask) V.++ triangles
+
+  let samplerInfo = samplerCreateInfo Vk.FILTER_NEAREST Vk.SAMPLER_ADDRESS_MODE_REPEAT
+  blockySampler <- snd <$> Vk.withSampler device samplerInfo Nothing allocate
+
+  matLibraryContainer <- asks materialLibrary
+  texturedMaterial <- do
+    matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryContainer
+    return (fromMaybe (error "not texturedMesh") $ matLibrary M.!? "texturedMesh")
+
+  let allocInfo = Vk.zero
+        { Vk.descriptorPool = descriptorPool
+        , Vk.setLayouts     = V.singleton texturedSetLayout
+        }
+
+  texturedDescriptorSet <- V.head . snd <$> Vk.withDescriptorSets device allocInfo allocate
+
+  liftIO $ do
+    matLibrary <- STM.atomically $ STM.readTMVar matLibraryContainer
+    let material = texturedMaterial
+          { materialTextureSet = texturedDescriptorSet
+          }
+        newMatLibrary = M.insert "texturedMesh" material matLibrary
+    void $ STM.atomically $ STM.swapTMVar matLibraryContainer newMatLibrary
+
+  textureContainer <- asks textureLibrary
+  texture <- do
+    texLibrary <- liftIO $ STM.atomically $ STM.readTMVar textureContainer
+    return $ fromMaybe (error "no marksman texture found") $ texLibrary M.!? "marksman"
+
+  let imageBufferInfo = Vk.zero
+        { Vk.sampler = blockySampler
+        , Vk.imageView = textureImageView texture
+        , Vk.imageLayout = Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
+        }
+      texture1 = V.singleton $ Vk.SomeStruct $ writeDescriptorImage
+        Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
+        texturedDescriptorSet
+        imageBufferInfo
+        0
+
+  Vk.updateDescriptorSets device texture1 V.empty

 initDescriptors
  :: (MonadResource m)
  => Vk.Device
-  -> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool)
+  -> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool)
 initDescriptors device = do
  let cameraBind = descriptorsetLayoutBinding
        Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
@ -209,6 +286,10 @@ initDescriptors device = do
        Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
        Vk.SHADER_STAGE_VERTEX_BIT
        0
+      textureBind = descriptorsetLayoutBinding
+        Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
+        Vk.SHADER_STAGE_FRAGMENT_BIT
+        0
      setInfo = Vk.zero
        { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
        , Vk.bindings = V.fromList
@ -220,8 +301,14 @@ initDescriptors device = do
        { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
        , Vk.bindings = V.singleton objectBind
        }
+      setInfo3 = Vk.zero
+        { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
+        , Vk.bindings = V.singleton textureBind
+        }
      poolInfo = Vk.zero
-        { Vk.flags     = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
+        { Vk.flags     =
+            Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT .|.
+            Vk.DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT
        , Vk.maxSets   = 10
        , Vk.poolSizes = V.fromList
          [ Vk.zero
@ -229,35 +316,30 @@ initDescriptors device = do
            , Vk.descriptorCount = 10
            }
          , Vk.zero
-            { Vk.type'           = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
+            { Vk.type'           = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
            , Vk.descriptorCount = 10
            }
          , Vk.zero
            { Vk.type'           = Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
            , Vk.descriptorCount = 10
            }
+          , Vk.zero
+            { Vk.type'           = Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
+            , Vk.descriptorCount = 10
+            }
          ]
        }

-  (_, descriptorSetLayout1) <- allocate
-    (Vk.createDescriptorSetLayout device setInfo Nothing)
-    (\descriptorLayout -> do
-      putStrLn "destroying descriptor layout"
-      Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
-      )
+  (_, descriptorSetLayout1) <-
+    Vk.withDescriptorSetLayout device setInfo Nothing allocate

-  (_, descriptorSetLayout2) <- allocate
-    (Vk.createDescriptorSetLayout device setInfo2 Nothing)
-    (\descriptorLayout -> do
-      putStrLn "destroying descriptor layout"
-      Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
-      )
+  (_, descriptorSetLayout2) <-
+    Vk.withDescriptorSetLayout device setInfo2 Nothing allocate

-  (_, descriptorPool) <- allocate
-    (Vk.createDescriptorPool device poolInfo Nothing)
-    (\descriptorPoolInfo -> do
-      putStrLn "destroying descriptor pool"
-      Vk.destroyDescriptorPool device descriptorPoolInfo Nothing
-      )
+  (_, textureDescriptorSetLayout) <-
+    Vk.withDescriptorSetLayout device setInfo3 Nothing allocate

-  return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)
+  (_, descriptorPool) <-
+    Vk.withDescriptorPool device poolInfo Nothing allocate
+
+  return (descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool)
--- a/src/Instance.hs
+++ b/src/Instance.hs
@ -32,11 +32,6 @@ createInstance window = do
        , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
        }

-  (_, inst) <- allocate
-    (Vk.createInstance createInfo Nothing)
-    (\inst -> do
-      putStrLn "destroying instance"
-      Vk.destroyInstance inst Nothing
-      )
+  (_, inst) <- Vk.withInstance createInfo Nothing allocate

  return inst
--- a/src/Main.hs
+++ b/src/Main.hs
@ -1,6 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Main where

 import qualified Control.Concurrent.STM as STM
@ -9,10 +11,13 @@ import Control.Monad.Loops
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Resource
 import Data.Bits
+import Data.ByteString.Char8
 import qualified Data.Map.Strict as M
+import Data.Time.Clock
 import qualified Data.Vector as V
-import Data.Word
 import qualified SDL hiding (V2)
+import System.IO (stdout)
+import System.Mem
 import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk

@ -27,11 +32,13 @@ main = do
  renderablesContainer <- STM.newTMVarIO (V.empty)
  meshMap <- STM.newTMVarIO (M.empty)
  materialMap <- STM.newTMVarIO (M.empty)
+  textureMap <- STM.newTMVarIO (M.empty)
  frameNumber <- STM.newTMVarIO 0
  let initState = ReadState
-        { renderables = renderablesContainer
-        , meshLibrary = meshMap
+        { renderables     = renderablesContainer
+        , meshLibrary     = meshMap
        , materialLibrary = materialMap
+        , textureLibrary  = textureMap
        }
  runRender initState $ do
    engineData <- initEngine
@ -40,17 +47,33 @@ main = do

    -- create abort condition for upcoming lop
    quit <- liftIO $ STM.newTMVarIO True
+    time <- liftIO $ STM.newTMVarIO =<< getCurrentTime
+    average <- liftIO $ STM.newTMVarIO 0

    -- main loop
    whileM_
      (liftIO $ STM.atomically $ STM.readTMVar quit
        )
      ( do
+        liftIO performMajorGC
+        now <- liftIO getCurrentTime
+        before <- liftIO $ STM.atomically $ STM.swapTMVar time now
+        let timeDiff = diffUTCTime now before
+            fps = recip $ nominalDiffTimeToSeconds timeDiff
+        liftIO $ hPutStr stdout $ pack $ "Current FPS: " <> show (floor fps) <> "  \r"
        number <- liftIO $ STM.atomically $ do
          number <- STM.readTMVar frameNumber
+          if number == 0 then
+            void $ STM.swapTMVar average fps
+          else do
+            oldAverage <- STM.readTMVar average
+            let newAverage = (oldAverage * fromIntegral number + fps) / frameCount
+                frameCount = fromIntegral number + 1
+            void $ STM.swapTMVar average newAverage
          void $ STM.swapTMVar frameNumber (succ number)
          return number
        -- draw
+        -- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r"
        drawFrame engineData number
        -- poll events
        evs <- liftIO SDL.pollEvents
@ -64,6 +87,12 @@ main = do
          evs
      )

+    fps <- liftIO $ STM.atomically $ STM.readTMVar average
+
+    liftIO $ hPutStr stdout $
+      "\n" <>
+      "Average FPS: " <> pack (show fps) <> "\n"
+
    Vk.deviceWaitIdle $ engineLogicalDevice engineData

 createBufferView
@ -78,12 +107,8 @@ createBufferView logicalDevice = do
          Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
        , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
        }
-  buffer <- snd <$> allocate
-    (Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
-    (\buffer -> do
-      putStrLn "destroying buffer"
-      Vk.destroyBuffer logicalDevice buffer Nothing
-      )
+  buffer <- snd <$> 
+    (Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate)

  let bufferViewCreateInfo = Vk.zero
        { Vk.buffer = buffer
@ -92,12 +117,7 @@ createBufferView logicalDevice = do
        , Vk.range  = Vk.WHOLE_SIZE
        }

-  allocate
-    (Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
-    (\bufferView -> do
-      putStrLn "destroying bufferView"
-      Vk.destroyBufferView logicalDevice bufferView Nothing
-      )
+  Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate

 allocateMemory
  :: (MonadResource m)
@ -108,13 +128,8 @@ allocateMemory logicalDevice buffer = do
  memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer

  let memoryAllocateInfo = Vk.zero
-        { Vk.allocationSize  = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements
+        { Vk.allocationSize  = memoryRequirements.size
        , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
        }

-  allocate
-    (Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
-    (\memory -> do
-      putStrLn "Freeing memory"
-      Vk.freeMemory logicalDevice memory Nothing
-      )
+  Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate
--- a/src/Memory.hs
+++ b/src/Memory.hs
@ -1,6 +1,7 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+
 module Memory where

 import Control.Monad.IO.Class
@ -27,9 +28,9 @@ initAllocator
  -> m VMA.Allocator
 initAllocator physicalDevice device instance' = do
  let instanceProcAddr = castFunPtr $
-        Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
+        Vk.pVkGetInstanceProcAddr (instance'.instanceCmds)
      deviceProcAddr = castFunPtr $
-        Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
+        Vk.pVkGetDeviceProcAddr (device.deviceCmds)
  let allocatorInfo = Vk.zero
        { VMA.physicalDevice  = Vk.physicalDeviceHandle physicalDevice
        , VMA.device          = Vk.deviceHandle device
@ -40,12 +41,7 @@ initAllocator physicalDevice device instance' = do
          } :: VMA.VulkanFunctions)
        } :: VMA.AllocatorCreateInfo

-  (_, allocator) <- allocate
-    (VMA.createAllocator allocatorInfo)
-    (\allocator -> do
-      putStrLn "destroying allocator"
-      VMA.destroyAllocator allocator
-      )
+  (_, allocator) <- VMA.withAllocator allocatorInfo allocate

  return allocator

@ -57,7 +53,7 @@ createAllocatedBuffer
  -> VMA.MemoryUsage
  -> m AllocatedBuffer
 createAllocatedBuffer allocator allocationSize usage memoryUsage = do
-  let bufferInfo = Vk.zero
+  let bufferCreateInfo = Vk.zero
        { Vk.size  = fromIntegral allocationSize
        , Vk.usage = usage
        }
@ -68,11 +64,7 @@ createAllocatedBuffer allocator allocationSize usage memoryUsage = do
        , VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
        } :: VMA.AllocationCreateInfo

-  (_, (buffer, newAllocation, info)) <- allocate
-    (VMA.createBuffer allocator bufferInfo vmaAllocationInfo)
-    (\(buffer, newAllocation, _) -> do
-      putStrLn "destroying buffer"
-      VMA.destroyBuffer allocator buffer newAllocation
-      )
+  (_, (buffer, newAllocation, info)) <-
+    VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate

  return $ AllocatedBuffer buffer newAllocation info
--- a/src/Mesh.hs
+++ b/src/Mesh.hs
@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Mesh where

 import Codec.Wavefront
@ -8,15 +9,16 @@ import Codec.Wavefront
 import qualified Control.Concurrent.STM as STM
 import qualified Control.Monad as CM (void)
 import Control.Monad.IO.Class
-import Control.Monad.Reader (asks)
+import Control.Monad.Reader
 import Control.Monad.Trans.Resource

 import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
 import qualified Data.Vector as V

 import Foreign

-import Linear (V3(..), V4(..))
+import Linear (V2(..), V3(..), V4(..))

 import qualified VulkanMemoryAllocator as VMA
 import qualified Vulkan.Core10 as Vk
@ -25,19 +27,29 @@ import qualified Vulkan.Zero as Vk
 -- internal imports

 import Types
+import Sync

 loadMeshes
-  :: VMA.Allocator
-  -> Render ()
-loadMeshes allocator = do
+  :: (MonadReader ReadState m, MonadResource m, MonadFail m)
+  => VMA.Allocator
+  -> UploadContext
+  -> Vk.Queue
+  -> Vk.Device
+  -> m ()
+loadMeshes allocator uploadContext queue device = do
  let triangle = V.fromList
-        [ Vertex (V3 0.5 0.5 0)    (V3 0 0 0) (V4 0 1 0 1)
-        , Vertex (V3 (-0.5) 0.5 0) (V3 0 0 0) (V4 0 1 0 1)
-        , Vertex (V3 0 (-0.5) 0)   (V3 0 0 0) (V4 0 1 0 1)
+        [ Vertex (V3 0.5 0 0)    (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
+        , Vertex (V3 (-0.5) 0 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
+        , Vertex (V3 0 1 0)   (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
        ]

-  triMesh <- uploadMesh triangle allocator
-  maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator
+  triMesh <- uploadMesh triangle allocator uploadContext queue device
+  maskMesh <- loadFromObj
+    "./assets/models/jaeger.obj"
+    allocator
+    uploadContext
+    queue
+    device

  meshLib <- asks meshLibrary

@ -52,38 +64,75 @@ uploadMesh
  :: (MonadResource m, MonadFail m)
  => V.Vector Vertex
  -> VMA.Allocator
+  -> UploadContext
+  -> Vk.Queue
+  -> Vk.Device
  -> m Mesh
-uploadMesh vertices allocator = do
-  let bufferCreateInfo = Vk.zero
-        { Vk.size  = fromIntegral $
-          V.length vertices * sizeOf (Vertex (V3 0 0 0) (V3 0 0 0 ) (V4 0 0 0 0))
-        , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
+uploadMesh vertices allocator uploadContext queue device = do
+
+  let bufferSize = fromIntegral $ V.length vertices * sizeOf (undefined :: Vertex)
+      stagingBufferCrateInfo = Vk.zero
+        { Vk.size  = bufferSize
+        , Vk.usage = Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
+        }
+      stagingAllocationCreateInfo = Vk.zero
+        { VMA.usage = VMA.MEMORY_USAGE_CPU_ONLY
+        } :: VMA.AllocationCreateInfo
+
+  (stagingReleaseKey, stagingBuffer) <- do
+    (releaseKey, (buffer, bAllocation, bInfo)) <-
+      VMA.withBuffer allocator stagingBufferCrateInfo stagingAllocationCreateInfo allocate
+    return (releaseKey, AllocatedBuffer
+      { bufferInfo = bInfo
+      , bufferAllocation = bAllocation
+      , allocatedBuffer = buffer
+      })
+
+  (dataReleaseKey, dataPtr) <-
+    VMA.withMappedMemory allocator (bufferAllocation stagingBuffer) allocate
+
+  liftIO $ V.mapM_ (\(idx, vertex) ->
+    poke
+      (castPtr dataPtr `plusPtr` (idx * sizeOf vertex))
+      vertex
+    )
+    (V.zip
+      (V.fromList [0..])
+      vertices
+      )
+
+  liftIO $ release dataReleaseKey
+
+  let vertexBufferCreateInfo = Vk.zero
+        { Vk.size = bufferSize
+        , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT .|. Vk.BUFFER_USAGE_TRANSFER_DST_BIT
        }
      allocationCreateInfo = Vk.zero
-        { VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
+        { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY
        } :: VMA.AllocationCreateInfo
-  (_, mesh) <- allocate
-    (do
-      (buffer, bAllocation, bInfo) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
-      return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
-      )
-    (\(Mesh _ (AllocatedBuffer buffer bAllocation bInfo)) -> do
-      putStrLn "destroying mesh"
-      VMA.destroyBuffer allocator buffer bAllocation
-      )

-  (dataReleaseKey, dataPtr) <- allocate
-    (VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
-    (\_ -> do
-      VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh)
-      )
+  mesh <- do
+    (buffer, bAllocation, bInfo) <- snd <$>
+      VMA.withBuffer allocator vertexBufferCreateInfo allocationCreateInfo allocate
+    return $ Mesh
+      { meshVertices = vertices
+      , meshBuffer = AllocatedBuffer
+        { bufferInfo = bInfo
+        , bufferAllocation = bAllocation
+        , allocatedBuffer = buffer
+        }
+      }

-  liftIO $ mapM_ (\(idx, vertex) ->
-    poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex
-    )
-    (zip [0..] (V.toList vertices))
+  immediateSubmit uploadContext queue device$ \cmd -> do
+    let copy = V.singleton $ Vk.BufferCopy
+          { size = bufferSize
+          , dstOffset = 0
+          , srcOffset = 0
+          }

-  release dataReleaseKey
+    Vk.cmdCopyBuffer cmd (allocatedBuffer stagingBuffer) (allocatedBuffer $ meshBuffer mesh) copy
+
+  release stagingReleaseKey

  return mesh

@ -91,18 +140,22 @@ loadFromObj
  :: (MonadResource m, MonadFail m)
  => FilePath
  -> VMA.Allocator
+  -> UploadContext
+  -> Vk.Queue
+  -> Vk.Device
  -> m Mesh
-loadFromObj filepath vma = do
+loadFromObj filepath vma uploadContext queue device = do
  eitherObj <- liftIO $ fromFile filepath
  case eitherObj of
    Left err ->
      error ("loadFromObj:  loading mesh data: " <> err)
    Right obj -> do
-      let vertices = digestFaces (objFaces obj) (objLocations obj)
-      uploadMesh vertices vma
+      let vertices = digestFaces (objFaces obj) (objLocations obj) (objTexCoords obj)
+      uploadMesh vertices vma uploadContext queue device
  where
-    digestFaces :: V.Vector (Element Face) -> V.Vector Location -> V.Vector Vertex
-    digestFaces faces locations =
+    digestFaces
+      :: V.Vector (Element Face) -> V.Vector Location -> V.Vector TexCoord -> V.Vector Vertex
+    digestFaces faces locations texCoords =
      V.foldl
        (\acc (Element _ _ _ _ (Face fa fb fc others)) ->
          if not (null others)
@ -114,8 +167,9 @@ loadFromObj filepath vma = do
                    let position = faceIndexToPosition faceIndex locations
                        normal   = V3 0 0 0
                        color    = V4 1 1 0 1
+                        uv       = faceIndexToUV faceIndex texCoords
                    in
-                      Vertex position normal color
+                      Vertex position normal color uv
                    )
                  (V.fromList [ fa, fb, fc ])
            in
@ -128,3 +182,45 @@ loadFromObj filepath vma = do
      let Location x y z _ = locations V.! (faceLocIndex index - 1)
      in
        V3 x y z
+    faceIndexToUV :: FaceIndex -> V.Vector TexCoord -> V2 Float
+    faceIndexToUV index texCoords =
+      let TexCoord r s _ =
+            texCoords V.!
+              (fromMaybe (error "no UV coordinates present") (faceTexCoordIndex index) - 1)
+      in
+        -- flip V coordinate of UVs to fix display
+        V2 r (-s)
+
+compactDraws
+  :: M.Map String Mesh
+  -> M.Map String Material
+  -> V.Vector RenderObject
+  -> V.Vector IndirectBatch
+compactDraws meshLib materialLib objects =
+
+  V.foldl
+    (\acc (index, RenderObject mesh material _) ->
+
+      let newDraw = IndirectBatch
+            { batchMesh     = meshLib M.! mesh
+            , batchMaterial = materialLib M.! material
+            , batchFirst    = index
+            , batchCount    = 1
+            }
+          sameMesh = not (V.null acc) && (meshLib M.! mesh == batchMesh (V.last acc))
+          sameMaterial = not (V.null acc) && (materialLib M.! material == batchMaterial (V.last acc))
+
+      in
+        if sameMesh && sameMaterial
+        then
+          V.init acc `V.snoc` ((V.last acc)
+            { batchCount = batchCount (V.last acc) + 1
+            })
+        else
+          acc `V.snoc` newDraw
+      )
+    V.empty
+    (V.zip
+      (V.fromList [0..])
+      objects
+      )
--- a/src/Sync.hs
+++ b/src/Sync.hs
@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Sync where
+
+import Control.Monad.Trans.Resource
+import Data.Bits (bit)
+import qualified Data.Vector as V
+import Data.Word
+import qualified Vulkan as Vk
+import qualified Vulkan.Zero as Vk
+
+-- internal imports
+
+import Control.Monad.Reader
+import Types
+import Util
+
+initSyncStructures
+  :: (MonadResource m)
+  => Vk.Device
+  -> Word32
+  -> m UploadContext
+initSyncStructures logicalDevice queueFamilyIndex = do
+
+  let fenceCreateInfo = Vk.zero
+
+  syncFence <- snd <$>
+    Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
+
+  let uploadCommandPoolCreateInfo = Vk.zero
+        { Vk.queueFamilyIndex = queueFamilyIndex
+        } :: Vk.CommandPoolCreateInfo
+
+  syncCommandPool <- snd <$>
+    Vk.withCommandPool logicalDevice uploadCommandPoolCreateInfo Nothing allocate
+
+  let cmdBufAllocInfo = Vk.zero
+        { Vk.commandPool        = syncCommandPool
+        , Vk.commandBufferCount = 1
+        }
+
+  syncCommandBuffer <- V.head . snd <$> Vk.withCommandBuffers logicalDevice cmdBufAllocInfo allocate
+
+  return $ UploadContext
+    { uploadFence = syncFence
+    , uploadCommandBuffer = syncCommandBuffer
+    , uploadCommandPool = syncCommandPool
+    }
+
+immediateSubmit
+  :: (MonadIO m)
+  => UploadContext
+  -> Vk.Queue
+  -> Vk.Device
+  -> (Vk.CommandBuffer -> m ())
+  -> m ()
+immediateSubmit uploadContext queue device func = do
+
+  let cmdBegin = beginCommandBuffer Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT
+
+  Vk.useCommandBuffer
+    (uploadCommandBuffer uploadContext)
+    cmdBegin
+    (func (uploadCommandBuffer uploadContext))
+
+  let submitInfo = createSubmitInfo (uploadCommandBuffer uploadContext)
+
+  Vk.queueSubmit queue submitInfo (uploadFence uploadContext)
+
+  void $ Vk.waitForFences device (V.singleton $ uploadFence uploadContext) True maxBound
+  Vk.resetFences device (V.singleton $ uploadFence uploadContext)
+
+  Vk.resetCommandPool device (uploadCommandPool uploadContext) (bit 0)
--- a/src/Textures.hs
+++ b/src/Textures.hs
@ -0,0 +1,173 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Textures where
+
+import qualified Codec.Picture as P
+import Control.Monad.IO.Class
+import Control.Monad.Reader
+import Control.Monad.Trans.Resource
+import qualified Data.Map.Strict as M
+import qualified Data.Vector as V
+import qualified Data.Vector.Storable as VS
+import Foreign hiding (void)
+import qualified Control.Concurrent.STM as STM
+import qualified Vulkan as Vk
+import qualified Vulkan.CStruct.Extends as Vk
+import qualified Vulkan.Zero as Vk
+import qualified VulkanMemoryAllocator as VMA
+
+-- internal imports
+
+import Types
+import Memory
+import Sync
+import Image
+
+loadImageFromFile
+  :: (MonadResource m, MonadIO m)
+  => VMA.Allocator
+  -> UploadContext
+  -> Vk.Queue
+  -> Vk.Device
+  -> FilePath
+  -> m AllocatedImage
+loadImageFromFile allocator uploadContext queue device file = do
+
+  pixels <- liftIO $ either error P.convertRGBA8 <$> P.readImage file
+
+  let texWidth = P.imageWidth pixels
+      texHeight = P.imageHeight pixels
+      imageSize = 4 * texWidth * texHeight
+      imageFormat = Vk.FORMAT_R8G8B8A8_SRGB
+
+  stagingBuffer <-
+    createAllocatedBuffer
+    allocator
+    imageSize
+    Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
+    VMA.MEMORY_USAGE_CPU_ONLY
+
+  let dataPtr = VMA.mappedData (bufferInfo stagingBuffer)
+
+  liftIO $ pokeArray (castPtr dataPtr) (VS.toList $ P.imageData pixels)
+
+  let imageExtent = Vk.Extent3D
+        { width  = fromIntegral texWidth
+        , height = fromIntegral texHeight
+        , depth  = 1
+        }
+      dImgAllocCreateInfo = Vk.zero
+        { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY
+        } :: VMA.AllocationCreateInfo
+      dImgCreateInfo = imageCreate
+        imageFormat
+        imageExtent
+        (Vk.IMAGE_USAGE_SAMPLED_BIT .|. Vk.IMAGE_USAGE_TRANSFER_DST_BIT)
+
+  (newImage, newAllocation, _) <- snd <$>
+    VMA.withImage allocator dImgCreateInfo dImgAllocCreateInfo allocate
+
+  immediateSubmit
+    uploadContext
+    queue
+    device
+    (\cmd -> do
+      let range = Vk.zero
+            { Vk.aspectMask     = Vk.IMAGE_ASPECT_COLOR_BIT
+            , Vk.baseMipLevel   = 0
+            , Vk.levelCount     = 1
+            , Vk.baseArrayLayer = 0
+            , Vk.layerCount     = 1
+            }
+          imageBarrierToTransfer = V.singleton $ Vk.SomeStruct (Vk.zero
+            { Vk.oldLayout        = Vk.IMAGE_LAYOUT_UNDEFINED
+            , Vk.newLayout        = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
+            , Vk.image            = newImage
+            , Vk.subresourceRange = range
+            -- , Vk.srcAccessMask    = bit 0
+            , Vk.dstAccessMask    = Vk.ACCESS_TRANSFER_WRITE_BIT
+            } :: Vk.ImageMemoryBarrier '[])
+
+      Vk.cmdPipelineBarrier
+        cmd
+        Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT
+        Vk.PIPELINE_STAGE_TRANSFER_BIT
+        (bit 0)
+        V.empty
+        V.empty
+        imageBarrierToTransfer
+
+      let copyRegion = V.singleton (Vk.zero
+            { Vk.bufferOffset      = 0
+            , Vk.bufferRowLength   = 0
+            , Vk.bufferImageHeight = 0
+            , Vk.imageExtent       = imageExtent
+            , Vk.imageSubresource  = Vk.zero
+              { Vk.aspectMask     = Vk.IMAGE_ASPECT_COLOR_BIT
+              , Vk.mipLevel       = 0
+              , Vk.baseArrayLayer = 0
+              , Vk.layerCount     = 1
+              } :: Vk.ImageSubresourceLayers
+            } :: Vk.BufferImageCopy)
+
+      Vk.cmdCopyBufferToImage
+        cmd
+        (allocatedBuffer stagingBuffer)
+        newImage
+        Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
+        copyRegion
+
+      let imageBarrierToReadable = V.singleton $ Vk.SomeStruct (Vk.zero
+            { Vk.oldLayout = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
+            , Vk.newLayout = Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
+            , Vk.image            = newImage
+            , Vk.subresourceRange = range
+            , Vk.srcAccessMask = Vk.ACCESS_TRANSFER_WRITE_BIT
+            , Vk.dstAccessMask = Vk.ACCESS_SHADER_READ_BIT
+            } :: Vk.ImageMemoryBarrier '[])
+
+      Vk.cmdPipelineBarrier
+        cmd
+        Vk.PIPELINE_STAGE_TRANSFER_BIT
+        Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
+        (bit 0)
+        V.empty
+        V.empty
+        imageBarrierToReadable
+      )
+
+  return $ AllocatedImage
+    { image = newImage
+    , allocation = newAllocation
+    }
+
+loadImages
+  :: (MonadResource m, MonadReader ReadState m)
+  => VMA.Allocator
+  -> UploadContext
+  -> Vk.Queue
+  -> Vk.Device
+  -> m ()
+loadImages allocator uploadContext queue device = do
+
+  loadedImage <- loadImageFromFile allocator uploadContext queue device "assets/textures/jaeger.texture.tga"
+
+  let imageInfo = imageviewCreate (image loadedImage) Vk.FORMAT_R8G8B8A8_SRGB Vk.IMAGE_ASPECT_COLOR_BIT
+
+  imageView <- snd <$> Vk.withImageView device imageInfo Nothing allocate
+
+  let texture = Texture
+        { textureImage     = loadedImage
+        , textureImageView = imageView
+        }
+
+  textureLib <- asks textureLibrary
+
+  void $ liftIO $ STM.atomically $ do
+    texMap <- STM.readTMVar textureLib
+
+    let newMap = M.insert "marksman" texture texMap
+
+    STM.swapTMVar textureLib newMap
--- a/src/Types.hs
+++ b/src/Types.hs
@ -9,7 +9,6 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Resource
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
-import Debug.Trace
 import Foreign
 import Foreign.C.Types (CInt)
 import Linear
@ -25,28 +24,28 @@ data ShaderContainer = ShaderContainer
  deriving (Show)

 data EngineData = EngineData
-  { engineWindow                   :: SDL.Window
-  , engineWindowDimensions         :: V2 CInt
-  , enginePhysicalDevice           :: Vk.PhysicalDevice
-  , engineLogicalDevice            :: Vk.Device
-  , engineInstance                 :: Vk.Instance
-  , engineSwapchain                :: Vk.SwapchainKHR
-  , engineQueue                    :: Vk.Queue
-  , engineFramebuffers             :: V.Vector Vk.Framebuffer
-  , meshPipelineLayout             :: Vk.PipelineLayout
-  , engineRenderPass               :: Vk.RenderPass
-  , engineAllocator                :: VMA.Allocator
-  , engineDepthImageView           :: Vk.ImageView
-  , engineDepthImage               :: AllocatedImage
-  , engineDepthFormat              :: Vk.Format
-  , engineFrames                   :: V.Vector FrameData
-  , engineGlobalSetLayout          :: Vk.DescriptorSetLayout
-  , engineObjectSetLayout          :: Vk.DescriptorSetLayout
-  , engineDescriptorPool           :: Vk.DescriptorPool
-  , enginePhysicalDeviceProperties :: Vk.PhysicalDeviceProperties
-  , engineSceneParameters          :: GPUSceneData
-  , engineSceneParameterBuffer     :: AllocatedBuffer
+  { engineWindow                 :: SDL.Window
+  , engineWindowDimensions       :: V2 CInt
+  , enginePhysicalDevice         :: Vk.PhysicalDevice
+  , engineLogicalDevice          :: Vk.Device
+  , engineInstance               :: Vk.Instance
+  , engineSwapchain              :: Vk.SwapchainKHR
+  , engineQueue                  :: Vk.Queue
+  , engineFramebuffers           :: V.Vector Vk.Framebuffer
+  , engineRenderPass             :: Vk.RenderPass
+  , engineAllocator              :: VMA.Allocator
+  , engineDepthImageView         :: Vk.ImageView
+  , engineDepthImage             :: AllocatedImage
+  , engineDepthFormat            :: Vk.Format
+  , engineFrames                 :: V.Vector FrameData
+  , engineGlobalSetLayout        :: Vk.DescriptorSetLayout
+  , engineObjectSetLayout        :: Vk.DescriptorSetLayout
+  , engineSingleTextureSetLayout :: Vk.DescriptorSetLayout
+  , engineDescriptorPool         :: Vk.DescriptorPool
+  , engineSceneParameters        :: GPUSceneData
+  , engineUploadContext          :: UploadContext
  } 
+  deriving (Show)

 data AllocatedBuffer = AllocatedBuffer
  { allocatedBuffer  :: Vk.Buffer
@ -55,28 +54,38 @@ data AllocatedBuffer = AllocatedBuffer
  }
  deriving (Show)

+instance Eq AllocatedBuffer where
+
+  (AllocatedBuffer buf1 _ _) == (AllocatedBuffer buf2 _ _) = buf1 == buf2
+
 data Vertex = Vertex
  { vertexPosition :: V3 Float
  , vertexNormal   :: V3 Float
  , vertexColor    :: V4 Float
+  , vertexUV       :: V2 Float
  }
-  deriving (Show)
+  deriving (Show, Eq)

 instance Storable Vertex where

-  sizeOf (Vertex position normal color) = sizeOf position + sizeOf normal + sizeOf color
+  sizeOf _ =
+    sizeOf (undefined :: V3 Float) * 2 +
+    sizeOf (undefined :: V4 Float) +
+    sizeOf (undefined :: V2 Float)

  peek ptr = do
    pos <- peek (castPtr ptr)
    nor <- peek (castPtr ptr `plusPtr` sizeOf pos)
    col <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor)
-    return $ Vertex pos nor col
+    uv <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor `plusPtr` sizeOf col)
+    return $ Vertex pos nor col uv

-  poke ptr (Vertex position normal color) = do
+  poke ptr (Vertex position normal color uv) = do
    let castedV3Ptr = castPtr ptr
    pokeElemOff castedV3Ptr 0 position
    pokeElemOff castedV3Ptr 1 normal
    poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color
+    poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal `plusPtr` sizeOf color)) uv

  alignment _ = 0

@ -110,6 +119,13 @@ instance VertexInputDescribable Vertex where
          , Vk.format   = Vk.FORMAT_R32G32B32A32_SFLOAT
          , Vk.offset   = fromIntegral (sizeOf (vertexPosition v) + sizeOf (vertexNormal v))
          } :: Vk.VertexInputAttributeDescription
+        uvAttribute = Vk.zero
+          { Vk.binding  = 0
+          , Vk.location = 3
+          , Vk.format   = Vk.FORMAT_R32G32_SFLOAT
+          , Vk.offset   = fromIntegral $
+            sizeOf (vertexPosition v) + sizeOf (vertexNormal v) + sizeOf (vertexColor v)
+          } :: Vk.VertexInputAttributeDescription
    in
      VertexInputDescription
        { vidBindings   = V.fromList [ mainBinding ]
@ -117,6 +133,7 @@ instance VertexInputDescribable Vertex where
          [ positionAttribute
          , normalAttribute
          , colorAttribute
+          , uvAttribute
          ]
        }

@ -130,7 +147,7 @@ data Mesh = Mesh
  { meshVertices :: V.Vector Vertex
  , meshBuffer   :: AllocatedBuffer
  }
-  deriving (Show)
+  deriving (Show, Eq)

 data MeshPushConstants = MeshPushConstants
  { meshPushData     :: V4 Float
@ -138,6 +155,7 @@ data MeshPushConstants = MeshPushConstants
  }
  deriving (Show)

+undefinedMeshPushConstants :: MeshPushConstants
 undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity

 instance Storable MeshPushConstants where
@ -162,10 +180,11 @@ data AllocatedImage = AllocatedImage
  deriving (Show)

 data Material = Material
-  { materialPipeline       :: Vk.Pipeline
+  { materialTextureSet     :: Vk.DescriptorSet
+  , materialPipeline       :: Vk.Pipeline
  , materialPipelineLayout :: Vk.PipelineLayout
  }
-  deriving (Show)
+  deriving (Show, Eq)

 data RenderObject = RenderObject
  { objectMesh     :: String
@ -174,16 +193,23 @@ data RenderObject = RenderObject
  }
  deriving (Show)

+data Texture = Texture
+  { textureImage     :: AllocatedImage
+  , textureImageView :: Vk.ImageView
+  }
+
 data ReadState = ReadState
  { renderables     :: STM.TMVar (V.Vector RenderObject)
  , meshLibrary     :: STM.TMVar (M.Map String Mesh)
  , materialLibrary :: STM.TMVar (M.Map String Material)
+  , textureLibrary  :: STM.TMVar (M.Map String Texture)
  }

 newtype RenderReader rd m a = RenderReader
  { runRenderInner :: RenderInner rd m a
  }
-  deriving (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)
+  deriving
+    (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)

 type RenderInner rd m = ReaderT rd m

@ -201,6 +227,7 @@ data FrameData = FrameData
  , frameCameraBuffer      :: AllocatedBuffer
  , frameSceneBuffer       :: AllocatedBuffer
  , frameObjectBuffer      :: AllocatedBuffer
+  , frameIndirectBuffer    :: AllocatedBuffer
  , frameGlobalDescriptor  :: Vk.DescriptorSet
  , frameObjectDescriptor  :: Vk.DescriptorSet
  }
@ -210,11 +237,12 @@ newtype GPUObjectData = GPUObjectData
  { objectModelMatrix :: M44 Float
  }

+undefinedGPUObjectData :: GPUObjectData
 undefinedGPUObjectData = GPUObjectData identity

 instance Storable GPUObjectData where

-  sizeOf (GPUObjectData modelMatrix) = sizeOf modelMatrix
+  sizeOf (GPUObjectData _) = sizeOf (identity :: M44 Float)

  alignment _ = 0

@ -222,7 +250,7 @@ instance Storable GPUObjectData where
    GPUObjectData <$> peek (castPtr ptr)

  poke ptr (GPUObjectData modelMatrix) =
-    poke (castPtr ptr) modelMatrix
+    poke (castPtr ptr) $ transpose modelMatrix

 data GPUCameraData = GPUCameraData
  { view           :: M44 Float
@ -232,8 +260,8 @@ data GPUCameraData = GPUCameraData

 instance Storable GPUCameraData where

-  sizeOf (GPUCameraData pview pprojection pviewProjection) =
-    sizeOf pview + sizeOf pprojection + sizeOf pviewProjection
+  sizeOf _ =
+    3 * sizeOf (undefined :: M44 Float)

  alignment _ = 0

@ -244,9 +272,10 @@ instance Storable GPUCameraData where
    return $ GPUCameraData v p vp

  poke ptr (GPUCameraData pview pprojection pviewProjection) = do
-    poke (castPtr ptr) pview
-    poke (castPtr ptr `plusPtr` sizeOf pview) pprojection
-    poke (castPtr ptr `plusPtr` sizeOf pview `plusPtr` sizeOf pprojection) pviewProjection
+    poke (castPtr ptr) $ transpose pview
+    poke (castPtr ptr `plusPtr` sizeOf pview) $ transpose pprojection
+    poke (castPtr ptr `plusPtr` sizeOf pview `plusPtr` sizeOf pprojection) $
+      transpose pviewProjection

 data GPUSceneData = GPUSceneData
  { fogColor     :: V4 Float
@ -286,3 +315,17 @@ instance Storable GPUSceneData where
    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol
    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir
    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol
+
+data UploadContext = UploadContext
+  { uploadFence         :: Vk.Fence
+  , uploadCommandPool   :: Vk.CommandPool
+  , uploadCommandBuffer :: Vk.CommandBuffer
+  }
+  deriving (Show)
+
+data IndirectBatch = IndirectBatch
+  { batchMesh     :: Mesh
+  , batchMaterial :: Material
+  , batchFirst    :: Word32
+  , batchCount    :: Word32
+  }
--- a/src/Util.hs
+++ b/src/Util.hs
@ -8,8 +8,6 @@ import qualified Data.Vector as V

 import Data.Word (Word32)

-import Debug.Trace
-
 import qualified Vulkan as Vk
 import qualified Vulkan.CStruct.Extends as Vk
 import qualified Vulkan.Zero as Vk
@ -58,11 +56,55 @@ writeDescriptorBuffer
  -> Vk.DescriptorBufferInfo
  -> Word32
  -> Vk.SomeStruct Vk.WriteDescriptorSet
-writeDescriptorBuffer type' dstSet bufferInfo binding = Vk.SomeStruct $
+writeDescriptorBuffer type' dstSet dBufferInfo binding = Vk.SomeStruct $
  Vk.zero
    { Vk.dstBinding      = binding
    , Vk.dstSet          = dstSet
    , Vk.descriptorCount = 1
    , Vk.descriptorType  = type'
-    , Vk.bufferInfo      = V.singleton bufferInfo
+    , Vk.bufferInfo      = V.singleton dBufferInfo
+    }
+
+beginCommandBuffer
+  :: Vk.CommandBufferUsageFlags
+  -> Vk.CommandBufferBeginInfo '[]
+beginCommandBuffer flags =
+  Vk.zero
+    { Vk.flags = flags
+    }
+
+createSubmitInfo
+  :: Vk.CommandBuffer
+  -> V.Vector (Vk.SomeStruct Vk.SubmitInfo)
+createSubmitInfo cmd = V.singleton $ Vk.SomeStruct $
+  Vk.zero
+    { Vk.commandBuffers = V.singleton (Vk.commandBufferHandle cmd)
+    }
+
+samplerCreateInfo
+  :: Vk.Filter
+  -> Vk.SamplerAddressMode
+  -> Vk.SamplerCreateInfo '[]
+samplerCreateInfo filters addressMode =
+  Vk.zero
+    { Vk.magFilter = filters
+    , Vk.minFilter = filters
+    , Vk.addressModeU = addressMode
+    , Vk.addressModeV = addressMode
+    , Vk.addressModeW = addressMode
+    }
+
+writeDescriptorImage
+  :: Vk.DescriptorType
+  -> Vk.DescriptorSet
+  -> Vk.DescriptorImageInfo
+  -> Word32
+  -> Vk.WriteDescriptorSet '[]
+writeDescriptorImage type' set imageInfo binding =
+  Vk.zero
+    { Vk.dstBinding = binding
+    , Vk.dstSet     = set
+    , Vk.descriptorCount = 1
+    , Vk.descriptorType  = type'
+    , Vk.imageInfo       = V.singleton imageInfo
    }
--- a/test.nix
+++ b/test.nix
@ -0,0 +1,46 @@
+{pkgs, vulkan-tutorial, ...}:
+pkgs.nixosTest ({
+  name = "test";
+  nodes = {
+    machine = { config, pkgs, ...}: {
+      environment = {
+        systemPackages = with pkgs; [
+          vulkan-tutorial
+          git
+          shaderc
+          vulkan-loader
+          vulkan-validation-layers
+        ];
+        sessionVariables = {
+          VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
+          SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
+        };
+      };
+      hardware.opengl = {
+        enable = true;
+        driSupport = true;
+        driSupport32Bit = true;
+      };
+      services.xserver = {
+        enable = true;
+        displayManager.sddm.enable = true;
+        desktopManager.cinnamon.enable = true;
+      };
+      users.users.test = {
+        password = "test";
+        extraGroups = [
+          "wheel"
+        ];
+        isNormalUser = true;
+      };
+    };
+  };
+
+  skipLint = true;
+
+  testScript = ''
+    start_all()
+
+    machine.shell_interact()
+  '';
+})
--- a/vulkan-tutorial.cabal
+++ b/vulkan-tutorial.cabal
@ -34,12 +34,14 @@ executable vulkan-tutorial
                      Memory
                      Mesh
                      Image
+                      Sync
+                      Textures
                      Types
                      Util

    -- LANGUAGE extensions used by modules in this package.
    -- other-extensions:
-    build-depends:    base >=4.14.3.0
+    build-depends:    base
                    , sdl2
                    , vulkan
                    , vulkan-utils
@ -48,12 +50,14 @@ executable vulkan-tutorial
                    , linear
                    , monad-loops
                    , stm
+                    , time
                    , bytestring
                    , text
                    , vector
                    , resourcet
                    , mtl
                    , containers
+                    , JuicyPixels
    hs-source-dirs:   src
    default-language: Haskell2010
    ghc-options:      -Wall
Author	SHA1	Message	Date
nek0	bab538a0e4	flake update	2023-11-05 12:02:16 +01:00
Amedeo Molnár	2d3fc457be	a little cleaner	2023-10-22 12:46:16 +02:00
nek0	4feac51f26	weed out stuff	2023-10-22 07:14:22 +02:00
nek0	def6e56d1f	implement FPS meter in Console output	2023-10-22 06:08:43 +02:00
Amedeo Molnár	1b6a6392ba	fix rendering!	2023-10-22 02:27:33 +02:00
Amedeo Molnár	8f6f5e428d	flake update	2023-10-22 01:32:38 +02:00
nek0	676e02ed8d	more twiddling	2023-10-22 01:30:52 +02:00
nek0	167599df74	try fixing	2023-10-22 01:30:52 +02:00
nek0	9350198e35	explicitly enable multiIndirectDraw	2023-10-22 01:30:52 +02:00
nek0	9d34dacf76	condense flake	2023-10-22 01:30:52 +02:00
nek0	a6af76f3b3	fix ambiguous record updates	2023-10-22 01:30:51 +02:00
nek0	934085906c	final flake fix	2023-10-22 01:30:18 +02:00
nek0	c55bfc5416	make shell	2023-10-22 01:30:18 +02:00
nek0	f873fa7291	move package	2023-10-22 01:30:18 +02:00
nek0	ccd18f803b	flake update	2023-10-22 01:30:16 +02:00
nek0	fe4155d26f	fix flake	2023-10-22 01:29:49 +02:00
nek0	2ae3daf0f9	fix flake	2023-10-22 01:29:49 +02:00
nek0	d2dac89ce3	small-ish fixes	2023-10-22 01:29:47 +02:00
nek0	0cb8bd8363	add test/debug VM capability	2023-10-22 01:28:21 +02:00
nek0	d9b7c48953	using indirect draw, not working yet	2023-10-22 01:27:18 +02:00
nek0	9084be8bba	first little optimisation	2023-10-22 01:27:13 +02:00
nek0	3928655bb0	fix changing rules	2023-10-22 01:15:03 +02:00
nek0	ea87f58b26	flake update	2023-10-22 00:33:07 +02:00
nek0	272db907a0	fix double spaceships	2023-06-11 08:13:53 +02:00
nek0	6caf99a13c	remove lambda	2023-06-11 08:13:53 +02:00
nek0	ef135731a4	first little optimisation	2023-06-11 08:13:49 +02:00
nek0	b3a7670c97	fix UVs in Code, not in shader	2023-05-30 01:44:20 +01:00
nek0	c0f8e10f44	hunt validation errors	2023-05-17 10:31:01 +02:00
nek0	89464b769f	add comment	2023-05-17 06:05:05 +02:00
nek0	6f6716e69a	flip uv coordintes right	2023-05-17 06:02:56 +02:00
nek0	61f800cdd9	flip y axis	2023-05-17 05:52:41 +02:00
nek0	e91afc8ada	draw textured object	2023-05-16 11:14:50 +02:00
nek0	32bc3fc4b4	fix initialization	2023-05-15 14:20:18 +02:00
nek0	488c32e084	change texture dimensions	2023-05-15 12:29:04 +02:00
nek0	f06ce62cff	implement textures which crash initialization	2023-05-15 12:10:02 +02:00
nek0	ca2d3cc9b1	move meshes	2023-05-15 06:45:12 +02:00
nek0	1f9434b06c	init textures	2023-05-14 18:50:02 +02:00
nek0	fa4f2d6838	optimisation	2023-05-14 13:28:19 +02:00
nek0	82962d3350	move matrix transposition into poke definition	2023-05-14 10:18:09 +02:00
nek0	455124021f	fix it by transposing the model matrix	2023-05-12 14:56:02 +02:00
nek0	526b9ba281	next chapter, but broken	2023-05-12 13:30:00 +02:00
nek0	fdc86a3c03	new shader	2023-05-12 13:29:44 +02:00
nek0	6f369cbec1	further clean allocations	2023-05-01 19:13:21 +02:00
nek0	bd578e1d98	some more cleaning	2023-04-29 19:54:52 +02:00
nek0	1844775cd0	flake update	2023-04-29 19:13:38 +02:00
nek0	1643d8b3db	more cleanup	2023-04-29 18:56:07 +02:00
nek0	cec99c0b6c	more restructuring	2023-04-29 18:52:49 +02:00
nek0	b3a1545fd2	split up and clean	2023-04-29 18:41:59 +02:00
nek0	cde6d15245	optimize allocations	2023-04-29 02:10:27 +02:00
nek0	744a8ddc55	fix the GC	2023-04-29 00:58:41 +02:00
nek0	064f31197e	make code a little more reslilient	2023-04-23 02:12:04 +02:00
nek0	95928de413	remove .envrc from .gitignore	2023-04-20 06:33:31 +02:00
nek0	edc6848878	add .envrc	2023-04-20 06:26:44 +02:00
nek0	a2f986e852	cleanup	2023-04-20 06:21:43 +02:00