32 changed files with 483 additions and 4938 deletions
--- a/.envrc
+++ b/.envrc
@ -1 +0,0 @@
-use flake
--- a/.gitignore
+++ b/.gitignore
@ -1,3 +1,4 @@
 .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
@ -1,13 +0,0 @@
-# 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
@ -1,15 +1,12 @@
 {
  "nodes": {
    "flake-utils": {
-      "inputs": {
-        "systems": "systems"
-      },
      "locked": {
-        "lastModified": 1694529238,
-        "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
+        "lastModified": 1667395993,
+        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
        "owner": "numtide",
        "repo": "flake-utils",
-        "rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
+        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
        "type": "github"
      },
      "original": {
@ -20,11 +17,11 @@
    },
    "nixpkgs": {
      "locked": {
-        "lastModified": 1699181587,
-        "narHash": "sha256-v35mUUgVU2ituIHPNHifpjl5uiYQYyLrpaMtz8X8Ums=",
+        "lastModified": 1671755972,
+        "narHash": "sha256-X977apvpqBqqRf2XBNorfunZmQNn3cQYGEnQE4L90Fo=",
        "owner": "NixOS",
        "repo": "nixpkgs",
-        "rev": "197629b470f184a47b2a5716312d25b09454bbf8",
+        "rev": "e8ee153b1717dca9c6aa38d5cf198329480d5b41",
        "type": "github"
      },
      "original": {
@ -38,21 +35,6 @@
        "flake-utils": "flake-utils",
        "nixpkgs": "nixpkgs"
      }
-    },
-    "systems": {
-      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
-        "type": "github"
-      }
    }
  },
  "root": "root",
--- a/flake.nix
+++ b/flake.nix
@ -11,45 +11,47 @@
      let
        pkgs = nixpkgs.legacyPackages.${system};

-        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;
-        };
+        haskellPackages = pkgs.haskellPackages;

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

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

-        devShells.default = haskellPackages.shellFor {
-          packages = p: [ p.vulkan-tutorial ];
+        defaultPackage = self.packages.${system}.${packageName};
+
+        devShell = haskellPackages.shellFor {
+          packages = p: [ defaultPackage ];
          withHoogle = true;
          buildInputs = (with haskellPackages; [
            haskell-language-server
            ghcid
            cabal-install
-            (jailbreakUnbreak wavefront)
          ]) ++ (with pkgs; [
            shaderc
-            vulkan-loader
-            vulkan-validation-layers
-            renderdoc
          ]);
-          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/mesh.vert
+++ b/shadersrc/mesh.vert
@ -1,16 +1,11 @@
 #version 450
+
 layout (location = 0) in vec3 vPosition;
 layout (location = 1) in vec3 vNormal;
 layout (location = 2) in vec4 vColor;

 layout (location = 0) out vec4 outColor;

-layout(set = 0, binding = 0) uniform  CameraBuffer{
-	mat4 view;
-	mat4 proj;
-	mat4 viewproj;
-} cameraData;
-
 //push constants block
 layout( push_constant ) uniform constants
 {
@ -20,7 +15,6 @@ layout( push_constant ) uniform constants

 void main()
 {
-	mat4 transformMatrix = (cameraData.viewproj * PushConstants.render_matrix);
-	gl_Position = transformMatrix * vec4(vPosition, 1.0f);
+	gl_Position = PushConstants.render_matrix * vec4(vPosition, 1.0f);
 	outColor = vColor;
 }
--- a/shadersrc/rainbow_lit.frag
+++ b/shadersrc/rainbow_lit.frag
@ -1,21 +0,0 @@
-#version 450
-
-// shader input
-layout(location = 0) in vec4 fragColor;
-
-// output write
-layout(location = 0) out vec4 outColor;
-
-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;
-
-void main() {
-    outColor = vec4(fragColor.xyz + sceneData.ambientColor.xyz, 1.0f);
-    //outColor = fragColor;
-    //outColor = sceneData.ambientColor;
-}
--- a/shadersrc/textured_lit.frag
+++ b/shadersrc/textured_lit.frag
@ -1,24 +0,0 @@
-//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
@ -1,40 +0,0 @@
-#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,52 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
 module CommandBuffer where

-import qualified Control.Concurrent.STM as STM
 import Control.Monad
 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 Foreign hiding (void)
+import Foreign
 import Foreign.C.Types (CInt)
 import Linear
 import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk
-import qualified VulkanMemoryAllocator as VMA

 -- internal imports

+import Devices
 import Types
-import Memory
-import Util
-import Mesh (compactDraws)

-frameOverlap :: Int
-frameOverlap = 2
+createCommandPool
+  :: (MonadResource m)
+  => Vk.PhysicalDevice
+  -> Vk.Device
+  -> m (Vk.CommandPool, Vk.Queue)
+createCommandPool physicalDevice logicalDevice = do

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

  let poolCreateInfo = Vk.zero
        { Vk.flags            = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT
@ -55,11 +34,22 @@ createFrames

  graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0

-  frames <- V.mapM
-    (\_ -> 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
+  return (commandPool, graphicsQueue)
+
+createCommandBuffer
+  :: (MonadResource m)
+  => Vk.Device
+  -> Vk.CommandPool
+  -> Int
+  -> m (V.Vector Vk.CommandBuffer)
+createCommandBuffer logicalDevice commandPool number = do

  let commandBufferAllocationInfo = Vk.zero
        { Vk.commandPool        = commandPool
@ -67,136 +57,29 @@ createFrames
        , Vk.commandBufferCount = 1
        }

-      (_, commandBuffer) <- Vk.withCommandBuffers logicalDevice commandBufferAllocationInfo allocate
-
-      let semaphoreCreateInfo = Vk.zero
-          fenceCreateInfo = Vk.zero
-            { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT
-            } :: Vk.FenceCreateInfo '[]
-
-      [presentSemaphore, renderSemaphore] <- replicateM 2
-        (snd <$>
-          Vk.withSemaphore logicalDevice semaphoreCreateInfo Nothing allocate
-          )
-      renderFence <- snd <$>
-        Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
-
-      cameraBuffer <- createAllocatedBuffer
-        allocator
-        (sizeOf (GPUCameraData identity identity identity))
-        Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
-        VMA.MEMORY_USAGE_CPU_TO_GPU
-
-      sceneBuffer <- createAllocatedBuffer
-        allocator
-        (sizeOf undefinedGPUSceneData * frameOverlap)
-        Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
-        VMA.MEMORY_USAGE_CPU_TO_GPU
-
-      objectBuffer <- createAllocatedBuffer
-        allocator
-        (sizeOf undefinedGPUObjectData * maxObjects)
-        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
-            }
-          objectSetAllocInfo = Vk.zero
-            { Vk.descriptorPool = descriptorPool
-            , Vk.setLayouts     = V.singleton objectSetLayout
-            }
-
-      globalDescriptor <- Vk.allocateDescriptorSets logicalDevice allocationInfo
-      objectDescriptor <- Vk.allocateDescriptorSets logicalDevice objectSetAllocInfo
-
-      let cameraInfo = Vk.zero
-            { Vk.buffer = allocatedBuffer cameraBuffer
-            , Vk.offset = 0
-            , Vk.range  = fromIntegral $ sizeOf (undefined :: GPUCameraData)
-            } :: Vk.DescriptorBufferInfo
-          sceneInfo = Vk.zero
-            { Vk.buffer = allocatedBuffer sceneBuffer
-            , Vk.offset = 0
-            -- , Vk.offset = padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProperties * fromIntegral index
-            , Vk.range  = fromIntegral $ sizeOf undefinedGPUSceneData
-            } :: Vk.DescriptorBufferInfo
-          objectInfo = Vk.zero
-            { Vk.buffer = allocatedBuffer objectBuffer
-            , Vk.offset = 0
-            , Vk.range  = fromIntegral $ sizeOf undefinedGPUObjectData * maxObjects
-            } :: Vk.DescriptorBufferInfo
-          cameraWrite = writeDescriptorBuffer
-            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
-            (V.head globalDescriptor)
-            cameraInfo
-            0
-          sceneWrite = writeDescriptorBuffer
-            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
-            (V.head globalDescriptor)
-            sceneInfo
-            1
-          objectWrite = writeDescriptorBuffer
-            Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
-            (V.head objectDescriptor)
-            objectInfo
-            0
-          setWrites = V.fromList
-            [ cameraWrite
-            , sceneWrite
-            , objectWrite
-            ]
-
-
-      Vk.updateDescriptorSets logicalDevice setWrites V.empty
-
-      return FrameData
-        { framePresentSemaphore  = presentSemaphore
-        , frameRenderSemaphore   = renderSemaphore
-        , frameRenderFence       = renderFence
-        , frameCommandPool       = commandPool
-        , frameMainCommandBuffer = V.head commandBuffer
-        , frameCameraBuffer      = cameraBuffer
-        , frameSceneBuffer       = sceneBuffer
-        , frameObjectBuffer      = objectBuffer
-        , frameIndirectBuffer    = indirectBuffer
-        , frameGlobalDescriptor  = V.head globalDescriptor
-        , frameObjectDescriptor  = V.head objectDescriptor
-        }
-
-      )
-    (V.fromList [1 .. frameOverlap])
-
-  return (frames, graphicsQueue)
+  V.concat <$>
+    replicateM number (Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo)

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

    let commandBufferBeginInfo = Vk.zero
@ -204,7 +87,7 @@ recordCommandBuffer
          , Vk.inheritanceInfo = Nothing
          }

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

    let renderPassInfo = Vk.zero
          { Vk.renderPass  = renderPass
@ -219,119 +102,18 @@ recordCommandBuffer
              , 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.cmdUseRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE $ do
+    Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE

-        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 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
-                )
-
-        (memRelease, memPtr) <- VMA.withMappedMemory
-          allocator
-          (bufferAllocation $ frameIndirectBuffer frame)
-          allocate
-
-        V.mapM_
-          (\(idx, command) -> liftIO $
-            poke
-              (castPtr memPtr `plusPtr` (idx * sizeOf command))
-              command
-          )
-          (V.zip
-            (V.fromList [0 ..])
-            drawCommands
-           )
-
-        release memRelease
-
-        V.mapM_
-          (\(IndirectBatch mesh material first count) -> do
-
-            when
-              (materialTextureSet material /= Vk.NULL_HANDLE)
-              (Vk.cmdBindDescriptorSets
-                commandBuffer
-                Vk.PIPELINE_BIND_POINT_GRAPHICS
-                (materialPipelineLayout material)
-                2
-                (V.singleton $ materialTextureSet material)
-                V.empty
-                )
-
-            Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
-
-            Vk.cmdBindDescriptorSets
-              commandBuffer
-              Vk.PIPELINE_BIND_POINT_GRAPHICS
-              (materialPipelineLayout material)
-              0
-              (V.singleton $ frameGlobalDescriptor frame)
-              V.empty
-
-            Vk.cmdBindDescriptorSets
-              commandBuffer
-              Vk.PIPELINE_BIND_POINT_GRAPHICS
-              (materialPipelineLayout material)
-              1
-              (V.singleton $ frameObjectDescriptor frame)
-              V.empty
-
-            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.cmdDrawIndirect
-              commandBuffer
-              (allocatedBuffer $ frameIndirectBuffer frame)
-              indirectOffset
-              count
-              drawStride
-            )
-          draws
-
-prepareRecording
-  :: V2 CInt
-  -> Vk.CommandBuffer
-  -> Vk.Pipeline
-  -> IO ()
-prepareRecording (V2 width height) commandBuffer graphicsPipeline = do
    Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline

-  -- 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.y        = 0
          , Vk.width    = fromIntegral width
-        , Vk.height   = - fromIntegral height
+          , Vk.height   = fromIntegral height
          , Vk.minDepth = 0
          , Vk.maxDepth = 1
          }
@ -349,45 +131,66 @@ prepareRecording (V2 width height) commandBuffer graphicsPipeline = do
    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
+    liftIO $ maybe
+      (Vk.cmdDraw commandBuffer 3 1 0 0)
+      (\jmesh -> do
+        let camPosition = V3 0 0 (-5)
+            camCenter = V3 0 0 0
+            camUp = V3 0 1 0
+            view = lookAt camPosition camCenter camUp
+            projection = perspective (pi/4) (800 / 600) 0.1 200
+            modelRot = axisAngle (V3 0 1 0) (fromIntegral frameNumber / (10 * pi))
+            model = mkTransformation modelRot (V3 0 0 0)
+            pvm = projection !*! view !*! model
+            constants = MeshPushConstants (V4 0 0 0 0) (transpose pvm)

-  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
-        }
+        pointer <- castPtr <$> new constants
+        Vk.cmdPushConstants
+          commandBuffer
+          meshLayout
+          Vk.SHADER_STAGE_VERTEX_BIT
+          0
+          (fromIntegral $ sizeOf constants)
+          pointer

-  V.mapM_
-    (\(index, obj) -> do
+        Vk.cmdBindVertexBuffers
+          commandBuffer
+          0
+          (V.fromList [ allocatedBuffer $ meshBuffer jmesh ])
+          (V.fromList [ 0 ])

-      let modelMatrix = GPUObjectData (objectMatrix obj)
-
-      liftIO $ poke
-        (castPtr objectPointer `plusPtr` (index * sizeOf (undefined :: GPUObjectData)))
-        modelMatrix
+        Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices jmesh) 1 0 0
        )
-    (V.zip
-      (V.fromList [0 ..])
-      renderObjects
+      mesh
+
+    Vk.cmdEndRenderPass commandBuffer
+
+    Vk.endCommandBuffer commandBuffer
+
+createSyncObjects
+  :: (MonadResource m, MonadFail m)
+  => Vk.Device
+  -> m (Vk.Semaphore, Vk.Semaphore, Vk.Fence)
+createSyncObjects logicalDevice = do
+
+  let semaphoreCreateInfo = Vk.zero
+      fenceCreateInfo = Vk.zero
+        { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT
+        } :: Vk.FenceCreateInfo '[]
+
+  [imageAvailableSemaphore, renderFinishedSemaphore] <- replicateM 2
+    (snd <$> allocate
+      (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing)
+      (\semaphore -> do
+        putStrLn "destroying semaphore"
+        Vk.destroySemaphore logicalDevice semaphore Nothing
+        )
+      )
+  inFlightFence <- snd <$> allocate
+    (Vk.createFence logicalDevice fenceCreateInfo Nothing)
+    (\fence -> do
+      putStrLn "destroying fence"
+      Vk.destroyFence logicalDevice fence Nothing
      )

-  liftIO $ do
-    poke
-      (castPtr scenePointer)
-      ambientParams
-
-    poke
-      (castPtr memoryPointer)
-      cameraParameters
+  return (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence)
--- a/src/Devices.hs
+++ b/src/Devices.hs
@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 module Devices where

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

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

  graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT
@ -105,26 +104,20 @@ 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) <-
-    Vk.withDevice
-      physDevice
-      (deviceCreateInfo Vk.::& shaderDrawParametersFeatures Vk.:& ())
-      Nothing
-      allocate
+  (_, logDevice) <- allocate
+    (Vk.createDevice physDevice deviceCreateInfo Nothing)
+    (\logDevice -> do
+      putStrLn "destroying logical device"
+      Vk.destroyDevice logDevice Nothing
+      )

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

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

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

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

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

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

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

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

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

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

 import qualified Control.Concurrent.STM as STM
 import Control.Monad
-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 Linear
 import qualified Vulkan.Core10 as Vk
 import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
 import qualified Vulkan.CStruct.Extends as Vk
@ -21,96 +15,87 @@ import qualified Vulkan.Zero as Vk

 import CommandBuffer
 import Types
-import Util (getFrame)
+import Control.Monad.IO.Class (MonadIO(liftIO))

 drawFrame
-  :: (MonadResource m, MonadFail m, MonadReader ReadState m)
+  :: (MonadResource m, MonadFail m)
  => EngineData
+  -> STM.TMVar Pipelines
  -> Int
  -> m ()
-drawFrame engineData frameNumber = do
+drawFrame engineData switch frameNumber = do

-  let frame = getFrame engineData frameNumber
+  unless (all (V.length (engineCommandBuffers engineData) ==)
+    [ V.length (engineCommandBuffers engineData)
+    , V.length (engineFramebuffers engineData)
+    ]) $
+      error ("Numbers of elements mismatch: command buffers " <>
+        show (V.length $ engineCommandBuffers engineData) <>
+        ", frame buffers " <> show (V.length $ engineFramebuffers engineData)
+        )

-  void $ Vk.waitForFences
-    (engineLogicalDevice engineData)
-    (V.singleton $ frameRenderFence frame)
-    True
-    maxBound
-  Vk.resetFences (engineLogicalDevice engineData) (V.singleton $ frameRenderFence frame)
+  let fences = V.singleton $ engineInFlightFence engineData
+
+  void $ Vk.waitForFences (engineLogicalDevice engineData) fences True maxBound
+  Vk.resetFences (engineLogicalDevice engineData) fences

  (imageResult, index) <-
    Khr.acquireNextImageKHR
      (engineLogicalDevice engineData)
      (engineSwapchain engineData)
      maxBound
-      (frameRenderSemaphore frame)
+      (engineImageAvailableSemaphore engineData)
      Vk.NULL_HANDLE

  unless (imageResult == Vk.SUCCESS) $
    error "drawFrame: Failed acquiring next image from swapchain"

+  -- liftIO $ putStrLn "resetting command buffer"
  Vk.resetCommandBuffer
-    (frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0)
+    (engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0)

-  matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary
-
-  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
+  switchState <- liftIO $ STM.atomically $ STM.readTMVar switch

+  -- liftIO $ putStrLn "recording command buffer"
  recordCommandBuffer
-    (engineData.engineAllocator)
-    (frameMainCommandBuffer frame)
+    (engineCommandBuffers engineData V.! fromIntegral index)
    (engineRenderPass engineData)
    (engineFramebuffers engineData V.! fromIntegral index)
    (engineWindowDimensions engineData)
-    (materialPipeline $  matLibrary M.! "defaultMesh")
-    frame
+    (meshPipeline engineData V.! fromIntegral index)
+    (meshPipelineLayout engineData)
+    (case switchState of
+      Green ->
+        Just $ engineMesh engineData
+      _ ->
+        Nothing
+      )
+    frameNumber

  let submitInfo = Vk.zero
        { Vk.waitSemaphores =
-          V.singleton $ frameRenderSemaphore frame
+          V.singleton $ engineImageAvailableSemaphore engineData
        , Vk.waitDstStageMask =
          V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
        , Vk.commandBuffers =
-          V.singleton (Vk.commandBufferHandle $ frameMainCommandBuffer frame)
+          V.singleton (Vk.commandBufferHandle $ engineCommandBuffers engineData V.! fromIntegral index)
        , Vk.signalSemaphores =
-          V.singleton $ framePresentSemaphore frame
+          V.singleton $ engineRenderFinishedSemaphore engineData
        }

+  -- liftIO $ putStrLn "submitting to queue"
  Vk.queueSubmit
    (engineQueue engineData)
    (V.singleton (Vk.SomeStruct submitInfo))
-    (frameRenderFence frame)
+    (engineInFlightFence engineData)

  let presentInfo = Vk.zero
-        { Khr.waitSemaphores = V.singleton $ framePresentSemaphore frame
+        { Khr.waitSemaphores = V.singleton $ engineRenderFinishedSemaphore engineData
        , Khr.swapchains = V.singleton $ engineSwapchain engineData
        , 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,6 +39,11 @@ createFramebuffer
        let createInfo = framebufferCreateInfo
              {  Vk.attachments = V.fromList [ imageView, depthImageView ]
              } :: Vk.FramebufferCreateInfo '[]
-        snd <$> Vk.withFramebuffer logicalDevice createInfo Nothing allocate
+        snd <$> allocate
+          (Vk.createFramebuffer logicalDevice createInfo Nothing)
+          (\framebuffer -> do
+            putStrLn "destroying framebuffer"
+            Vk.destroyFramebuffer logicalDevice framebuffer Nothing
+            )
        )
      swapchainImageViews
--- a/src/GraphicsPipeline.hs
+++ b/src/GraphicsPipeline.hs
@ -1,17 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
 module GraphicsPipeline where

 import Linear
-import qualified Control.Concurrent.STM as STM
-import Control.Monad.Reader
+import Control.Monad (unless)
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource
 import Data.Bits
 -- import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS
-import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
 import Foreign (sizeOf)
 import Foreign.C.Types (CInt)
@ -23,6 +21,7 @@ import qualified Vulkan.Utils.ShaderQQ.GLSL.Shaderc as Vk

 -- internal imports
 import Types
+import Mesh

 loadShader
  :: (MonadResource m)
@ -49,8 +48,12 @@ loadShader logicalDevice shaderPath stage = do
        { Vk.code = shader
        }

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

 createRenderPass
  :: (MonadResource m)
@ -103,7 +106,7 @@ createRenderPass
          , Vk.dstSubpass    = 0
          , Vk.srcStageMask  = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
          , Vk.dstStageMask  = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
-          , Vk.srcAccessMask = Vk.ACCESS_MEMORY_READ_BIT
+          , Vk.srcAccessMask = bit 0
          , Vk.dstAccessMask = Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT
          }
        subpassDepthDependency = Vk.zero
@ -111,7 +114,7 @@ createRenderPass
          , Vk.dstSubpass    = 0
          , Vk.srcStageMask  =
            Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT .|. Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT
-          , Vk.srcAccessMask = Vk.ACCESS_MEMORY_READ_BIT
+          , Vk.srcAccessMask = bit 0
          , Vk.dstStageMask  =
            Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT .|. Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT
          , Vk.dstAccessMask = Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT
@ -122,8 +125,12 @@ createRenderPass
          , Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
          } :: Vk.RenderPassCreateInfo '[]

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

 createShaderStageCreateInfo
  :: Vk.ShaderStageFlagBits
@ -187,25 +194,24 @@ createMultisampleStateCreateInfo =
    }

 createGraphicsPipelines
-  :: (MonadResource m, MonadReader ReadState m)
+  :: (MonadResource m)
  => Vk.Device
  -> Vk.RenderPass
  -> ShaderContainer
  -> V2 CInt
+  -> Int
  -> Vk.PipelineLayout
  -> Maybe Vk.PipelineDepthStencilStateCreateInfo
-  -> String
-  -> m ()
+  -> m (V.Vector Vk.Pipeline)
 createGraphicsPipelines
  logicalDevice
  renderPass
  shaderContainer
  (V2 width height)
+  number
  pipelineLayout
  depthState
-  materialName
  = do
-    meshLib <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
    let pipelineStagesCreateInfos =
          V.fromList $ map Vk.SomeStruct
            ( maybe
@ -236,7 +242,7 @@ createGraphicsPipelines
        pipelineDynamicStateCreateInfo = Vk.zero
          { Vk.dynamicStates = dynamicStates
          }
-        vertexDescription = getVertexDescription (V.head $ meshVertices $ meshLib M.! "mask")
+        vertexDescription = getVertexDescription (V.head loadMeshes)
        pipelineVertexInputCreateInfo = Vk.zero
          { Vk.vertexBindingDescriptions   = vidBindings vertexDescription
          , Vk.vertexAttributeDescriptions = vidAttributes vertexDescription
@ -294,39 +300,57 @@ createGraphicsPipelines
          , Vk.basePipelineIndex  = -1
          }

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

 createMeshPipelineLayout
  :: MonadResource m
  => Vk.Device
-  -> V.Vector Vk.DescriptorSetLayout
  -> m Vk.PipelineLayout
-createMeshPipelineLayout logicalDevice layouts = do
+createMeshPipelineLayout logicalDevice = do
  let pushConstantRange = Vk.zero
        { Vk.offset     = 0
-        , Vk.size       = fromIntegral (sizeOf undefinedMeshPushConstants)
+        , Vk.size       = fromIntegral (sizeOf (undefined :: MeshPushConstants))
        , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
        }
      pipelineLayoutCreateInfo = Vk.zero
        { Vk.pushConstantRanges = V.singleton pushConstantRange
-        , Vk.setLayouts         = layouts
        }

-  snd <$>
-    Vk.withPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing allocate
+  snd <$> allocate
+    (Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
+    (\pipelineLayout -> do
+      putStrLn "destroying pipeline layout"
+      Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
+      )
--- a/src/Init.hs
+++ b/src/Init.hs
@ -1,28 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
 module Init where

-import qualified Control.Concurrent.STM as STM
-import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Reader
 import Control.Monad.Trans.Resource
-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.Ptr
-import Linear as L
-import qualified Vulkan as Vk
-import qualified Vulkan.CStruct.Extends as Vk
+import qualified Vulkan.Core10 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

 -- internal imports

@ -30,16 +19,14 @@ import Instance
 import Devices
 import GraphicsPipeline
 import Framebuffers
+import CommandBuffer
 import Memory
 import Types
 import Mesh
-import CommandBuffer
-import Sync
-import Textures
-import Util

 initEngine
-  :: Render EngineData
+  :: (MonadResource m, MonadFail m)
+  => m EngineData
 initEngine = do
  -- initialize SDL2 with all subsystems
  void $ allocate_
@ -52,7 +39,6 @@ initEngine = do
  -- create a window configuration
  let windowConfig = SDL.defaultWindow
        { SDL.windowGraphicsContext = SDL.VulkanContext -- enable Vulkan support
-        , SDL.windowInitialSize     = V2 1280 1024
        }

  -- load vulkan library
@ -61,12 +47,7 @@ initEngine = do
  -- create the window
  (_, window) <-
    allocate
-      (do
-        eexcept <- try (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
-        case eexcept of
-          Left err -> error $ "here's your exception: " <> show (err :: SDL.SDLException)
-          Right a  -> return a
-        )
+      (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
      (\window -> do
        liftIO $ putStrLn "destroying window"
        SDL.destroyWindow window
@ -77,8 +58,9 @@ initEngine = do


 initVulkan
-  :: SDL.Window
-  -> Render EngineData
+  :: (MonadResource m, MonadFail m)
+  => SDL.Window
+  -> m EngineData
 initVulkan window = do

  vulkanInstance <- createInstance window
@ -93,75 +75,38 @@ initVulkan window = do
      )

  vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
-  (vulkanLogicalDevice, surfaceFormats, queueIndex) <-
-    createLogicalDevice vulkanPhysicalDevice vulkanSurface
-
-  uploadContext <- initSyncStructures vulkanLogicalDevice queueIndex
-
-  (descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool) <-
-    initDescriptors vulkanLogicalDevice
+  (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface

  allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance

+  maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator
+
  dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
  (swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <-
    createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator
  imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
-  meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/tri_mesh.vert" "vert"
-  meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag"
-  textureFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/textured_lit.frag" "frag"
+  meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
+  meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.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
-      ]
-      )
+  meshLayout <- createMeshPipelineLayout vulkanLogicalDevice
  let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
-      textureContainer = ShaderContainer (Just meshVertexShader) (Just textureFragmentShader)
+  meshPipelines <-
    createGraphicsPipelines
      vulkanLogicalDevice
      renderPass
      meshContainer
      dimensions
+      (length imageViews)
      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
-      vulkanLogicalDevice
-      allocator
-      descriptorPool
-      descriptorSetLayout1
-      descriptorSetLayout2
-      queueIndex
+  (commandPool, graphicsQueue) <- createCommandPool vulkanPhysicalDevice vulkanLogicalDevice
+  commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool (length frameBuffers)

-  loadMeshes allocator uploadContext queue vulkanLogicalDevice
-
-  loadImages allocator uploadContext queue vulkanLogicalDevice
-
-  initScene vulkanLogicalDevice descriptorPool textureDescriptorSetLayout
+  (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <-
+    createSyncObjects vulkanLogicalDevice

  return $ EngineData
    window
@ -170,176 +115,18 @@ initVulkan window = do
    vulkanLogicalDevice
    vulkanInstance
    swapchain
-    queue
+    graphicsQueue
+    commandBuffer
    frameBuffers
+    meshLayout
+    meshPipelines
    renderPass
+    inFlightFence
+    imageAvailableSemaphore
+    renderFinishedSemaphore
+    maskMesh
+    maskMesh
    allocator
    depthImageView
    depthAllocatedImage
    Vk.FORMAT_D32_SFLOAT
-    frames
-    descriptorSetLayout1
-    descriptorSetLayout2
-    textureDescriptorSetLayout
-    descriptorPool
-    (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)
-      )
-    uploadContext
-
-
-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 = "texturedMesh"
-        , objectMatrix   = identity
-        }
-      triangles = V.concatMap
-        (\y ->
-          V.map
-            (\x ->
-              let
-                translationMatrix = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 x 0 y)
-                scaleMatrix       = scaled (V4 0.2 0.2 0.2 1)
-              in
-                RenderObject
-                  { objectMesh     = "triangle"
-                  , objectMaterial = "defaultMesh"
-                  , objectMatrix   = translationMatrix !*! scaleMatrix
-                  }
-              )
-            (V.fromList [-20 .. 20])
-          )
-        (V.fromList [-20 .. 20])
-
-  renderableContainer <- asks renderables
-  renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer
-
-  void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $
-    (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.DescriptorSetLayout, Vk.DescriptorPool)
-initDescriptors device = do
-  let cameraBind = descriptorsetLayoutBinding
-        Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
-        Vk.SHADER_STAGE_VERTEX_BIT
-        0
-      sceneBind = descriptorsetLayoutBinding
-        Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
-        Vk.SHADER_STAGE_FRAGMENT_BIT
-        1
-      objectBind = descriptorsetLayoutBinding
-        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
-          [ cameraBind
-          , sceneBind
-          ]
-        }
-      setInfo2 = Vk.zero
-        { 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.DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT
-        , Vk.maxSets   = 10
-        , Vk.poolSizes = V.fromList
-          [ Vk.zero
-            { Vk.type'           = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
-            , Vk.descriptorCount = 10
-            }
-          , Vk.zero
-            { 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) <-
-    Vk.withDescriptorSetLayout device setInfo Nothing allocate
-
-  (_, descriptorSetLayout2) <-
-    Vk.withDescriptorSetLayout device setInfo2 Nothing allocate
-
-  (_, textureDescriptorSetLayout) <-
-    Vk.withDescriptorSetLayout device setInfo3 Nothing allocate
-
-  (_, descriptorPool) <-
-    Vk.withDescriptorPool device poolInfo Nothing allocate
-
-  return (descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool)
--- a/src/Instance.hs
+++ b/src/Instance.hs
@ -14,12 +14,10 @@ import qualified Vulkan.Zero as Vk

 createInstance :: MonadResource m => SDL.Window -> m Vk.Instance
 createInstance window = do
-  windowExtensions <- liftIO $ fmap (
-    [ Vk.EXT_DEBUG_UTILS_EXTENSION_NAME
-    ] ++) $
+  windowExtensions <- liftIO $ fmap (Vk.EXT_DEBUG_UTILS_EXTENSION_NAME :) $
    traverse BS.packCString =<< SDL.vkGetInstanceExtensions window
  liftIO $ do
-    putStrLn "activating following extensions:"
+    putStrLn "activating followinfg extensions:"
    print windowExtensions
  let createInfo = Vk.zero
        { Vk.applicationInfo       = Just Vk.zero
@ -32,6 +30,11 @@ createInstance window = do
        , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
        }

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

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

-import qualified Control.Concurrent.STM as STM
 import Control.Monad
 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 Control.Concurrent.STM as STM
 import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk

@ -28,53 +21,25 @@ import Draw (drawFrame)
 import Types

 main :: IO ()
-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
-        , materialLibrary = materialMap
-        , textureLibrary  = textureMap
-        }
-  runRender initState $ do
+main = runResourceT $ do
  engineData <- initEngine

  SDL.showWindow $ engineWindow engineData

  -- create abort condition for upcoming lop
  quit <- liftIO $ STM.newTMVarIO True
-    time <- liftIO $ STM.newTMVarIO =<< getCurrentTime
-    average <- liftIO $ STM.newTMVarIO 0
+  showPipeline <- liftIO $ STM.newTMVarIO Green
+  frameContainer <- 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
+      frameNumber <- liftIO $ STM.atomically $ STM.takeTMVar frameContainer
+      liftIO $ STM.atomically $ STM.putTMVar frameContainer (succ frameNumber)
      -- draw
-        -- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r"
-        drawFrame engineData number
+      drawFrame engineData showPipeline frameNumber
      -- poll events
      evs <- liftIO SDL.pollEvents
      -- flip abort condition on window close
@ -87,12 +52,6 @@ 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
@ -107,8 +66,12 @@ createBufferView logicalDevice = do
          Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
        , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
        }
-  buffer <- snd <$> 
-    (Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate)
+  buffer <- snd <$> allocate
+    (Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
+    (\buffer -> do
+      putStrLn "destroying buffer"
+      Vk.destroyBuffer logicalDevice buffer Nothing
+      )

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

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

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

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

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

-import Control.Monad.IO.Class
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource

-import Data.Bits ((.|.))
-
 import Foreign.Ptr
+import Foreign.Storable

 import qualified VulkanMemoryAllocator as VMA
 import qualified Vulkan.Core10 as Vk
 import qualified Vulkan.Dynamic as Vk
 import qualified Vulkan.Zero as Vk

-- internal imports
-
-import Types
-
 initAllocator
  :: (MonadResource m, MonadFail m)
  => Vk.PhysicalDevice
@ -28,9 +22,9 @@ initAllocator
  -> m VMA.Allocator
 initAllocator physicalDevice device instance' = do
  let instanceProcAddr = castFunPtr $
-        Vk.pVkGetInstanceProcAddr (instance'.instanceCmds)
+        Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
      deviceProcAddr = castFunPtr $
-        Vk.pVkGetDeviceProcAddr (device.deviceCmds)
+        Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
  let allocatorInfo = Vk.zero
        { VMA.physicalDevice  = Vk.physicalDeviceHandle physicalDevice
        , VMA.device          = Vk.deviceHandle device
@ -41,30 +35,11 @@ initAllocator physicalDevice device instance' = do
          } :: VMA.VulkanFunctions)
        } :: VMA.AllocatorCreateInfo

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

  return allocator
-
-createAllocatedBuffer
-  :: (MonadResource m, MonadIO m)
-  => VMA.Allocator
-  -> Int
-  -> Vk.BufferUsageFlags
-  -> VMA.MemoryUsage
-  -> m AllocatedBuffer
-createAllocatedBuffer allocator allocationSize usage memoryUsage = do
-  let bufferCreateInfo = Vk.zero
-        { Vk.size  = fromIntegral allocationSize
-        , Vk.usage = usage
-        }
-      vmaAllocationInfo = Vk.zero
-        { VMA.usage = memoryUsage
-        , VMA.flags = VMA.ALLOCATION_CREATE_MAPPED_BIT
-        , VMA.requiredFlags = Vk.MEMORY_PROPERTY_HOST_VISIBLE_BIT .|. Vk.MEMORY_PROPERTY_HOST_COHERENT_BIT
-        , VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
-        } :: VMA.AllocationCreateInfo
-
-  (_, (buffer, newAllocation, info)) <-
-    VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate
-
-  return $ AllocatedBuffer buffer newAllocation info
--- a/src/Mesh.hs
+++ b/src/Mesh.hs
@ -1,24 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
 module Mesh where

 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
 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 (V2(..), V3(..), V4(..))
+import Linear (V3(..), V4(..))

 import qualified VulkanMemoryAllocator as VMA
 import qualified Vulkan.Core10 as Vk
@ -27,112 +21,50 @@ import qualified Vulkan.Zero as Vk
 -- internal imports

 import Types
-import Sync

 loadMeshes
-  :: (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 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)
+  :: V.Vector Vertex
+loadMeshes =
+  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)
    ]

-  triMesh <- uploadMesh triangle allocator uploadContext queue device
-  maskMesh <- loadFromObj
-    "./assets/models/jaeger.obj"
-    allocator
-    uploadContext
-    queue
-    device
-
-  meshLib <- asks meshLibrary
-
-  liftIO $ STM.atomically $ do
-    meshMap <- STM.readTMVar meshLib
-    let newMap =
-          M.insert "triangle" triMesh $
-          M.insert "mask" maskMesh meshMap
-    CM.void $ STM.swapTMVar meshLib newMap
-
 uploadMesh
  :: (MonadResource m, MonadFail m)
  => V.Vector Vertex
  -> VMA.Allocator
-  -> UploadContext
-  -> Vk.Queue
-  -> Vk.Device
  -> m Mesh
-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
+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
        }
      allocationCreateInfo = Vk.zero
-        { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY
+        { VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
        } :: VMA.AllocationCreateInfo
+  (_, mesh) <- allocate
+    (do
+      (buffer, allocation, _) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
+      return (Mesh vertices (AllocatedBuffer buffer allocation))
+      )
+    (\(Mesh _ (AllocatedBuffer buffer allocation)) -> do
+      putStrLn "destroying mesh"
+      VMA.destroyBuffer allocator buffer allocation
+      )

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

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

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

  return mesh

@ -140,22 +72,18 @@ loadFromObj
  :: (MonadResource m, MonadFail m)
  => FilePath
  -> VMA.Allocator
-  -> UploadContext
-  -> Vk.Queue
-  -> Vk.Device
  -> m Mesh
-loadFromObj filepath vma uploadContext queue device = do
+loadFromObj filepath vma = 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) (objTexCoords obj)
-      uploadMesh vertices vma uploadContext queue device
+      let vertices = digestFaces (objFaces obj) (objLocations obj)
+      uploadMesh vertices vma
  where
-    digestFaces
-      :: V.Vector (Element Face) -> V.Vector Location -> V.Vector TexCoord -> V.Vector Vertex
-    digestFaces faces locations texCoords =
+    digestFaces :: V.Vector (Element Face) -> V.Vector Location -> V.Vector Vertex
+    digestFaces faces locations =
      V.foldl
        (\acc (Element _ _ _ _ (Face fa fb fc others)) ->
          if not (null others)
@ -167,9 +95,8 @@ loadFromObj filepath vma uploadContext queue device = 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 uv
+                      Vertex position normal color
                    )
                  (V.fromList [ fa, fb, fc ])
            in
@ -182,45 +109,3 @@ loadFromObj filepath vma uploadContext queue device = 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
@ -1,75 +0,0 @@
-{-# 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
@ -1,173 +0,0 @@
-{-# 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
@ -1,13 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveFunctor #-}
 module Types where

-import Control.Concurrent.STM.TMVar as STM
-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 Foreign
 import Foreign.C.Types (CInt)
@ -17,6 +10,12 @@ import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk
 import qualified VulkanMemoryAllocator as VMA

+data Pipelines
+  = Rainbow
+  | Red
+  | Green
+  deriving (Eq, Ord, Enum, Bounded)
+
 data ShaderContainer = ShaderContainer
  { containedVertexShader   :: Maybe Vk.ShaderModule
  , containedFragmentShader :: Maybe Vk.ShaderModule
@ -31,63 +30,48 @@ data EngineData = EngineData
  , engineInstance                :: Vk.Instance
  , engineSwapchain               :: Vk.SwapchainKHR
  , engineQueue                   :: Vk.Queue
+  , engineCommandBuffers          :: V.Vector Vk.CommandBuffer
  , engineFramebuffers            :: V.Vector Vk.Framebuffer
+  , meshPipelineLayout            :: Vk.PipelineLayout
+  , meshPipeline                  :: V.Vector Vk.Pipeline
  , engineRenderPass              :: Vk.RenderPass
+  , engineInFlightFence           :: Vk.Fence
+  , engineImageAvailableSemaphore :: Vk.Semaphore
+  , engineRenderFinishedSemaphore :: Vk.Semaphore
+  , engineMesh                    :: Mesh
+  , engineExternalMesh            :: Mesh
  , 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
  , bufferAllocation :: VMA.Allocation
-  , bufferInfo       :: VMA.AllocationInfo
  }
  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, Eq)
+  deriving (Show)

 instance Storable Vertex where

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

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

-  poke ptr (Vertex position normal color uv) = do
+  poke ptr (Vertex position normal color) = 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
+  alignment _ = undefined

 class VertexInputDescribable v where

@ -119,13 +103,6 @@ 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 ]
@ -133,7 +110,6 @@ instance VertexInputDescribable Vertex where
          [ positionAttribute
          , normalAttribute
          , colorAttribute
-          , uvAttribute
          ]
        }

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

 data MeshPushConstants = MeshPushConstants
  { meshPushData     :: V4 Float
@ -155,12 +131,9 @@ data MeshPushConstants = MeshPushConstants
  }
  deriving (Show)

-undefinedMeshPushConstants :: MeshPushConstants
-undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity
-
 instance Storable MeshPushConstants where

-  sizeOf _ = sizeOf (V4 0 0 0 0 :: V4 Float) + sizeOf (identity :: M44 Float)
+  sizeOf _ = sizeOf (undefined :: V4 Float) + sizeOf (undefined :: M44 Float)

  peek ptr = do
    dat <- peek (castPtr ptr)
@ -178,154 +151,3 @@ data AllocatedImage = AllocatedImage
  , allocation :: VMA.Allocation
  }
  deriving (Show)
-
-data Material = Material
-  { materialTextureSet     :: Vk.DescriptorSet
-  , materialPipeline       :: Vk.Pipeline
-  , materialPipelineLayout :: Vk.PipelineLayout
-  }
-  deriving (Show, Eq)
-
-data RenderObject = RenderObject
-  { objectMesh     :: String
-  , objectMaterial :: String
-  , objectMatrix   :: M44 Float
-  }
-  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)
-
-type RenderInner rd m = ReaderT rd m
-
-type Render a = RenderReader ReadState ResIO a
-
-runRender :: ReadState -> Render a -> IO a
-runRender rd actions = runResourceT $ flip runReaderT rd $ runRenderInner actions
-
-data FrameData = FrameData
-  { framePresentSemaphore  :: Vk.Semaphore
-  , frameRenderSemaphore   :: Vk.Semaphore
-  , frameRenderFence       :: Vk.Fence
-  , frameCommandPool       :: Vk.CommandPool
-  , frameMainCommandBuffer :: Vk.CommandBuffer
-  , frameCameraBuffer      :: AllocatedBuffer
-  , frameSceneBuffer       :: AllocatedBuffer
-  , frameObjectBuffer      :: AllocatedBuffer
-  , frameIndirectBuffer    :: AllocatedBuffer
-  , frameGlobalDescriptor  :: Vk.DescriptorSet
-  , frameObjectDescriptor  :: Vk.DescriptorSet
-  }
-  deriving (Show)
-
-newtype GPUObjectData = GPUObjectData
-  { objectModelMatrix :: M44 Float
-  }
-
-undefinedGPUObjectData :: GPUObjectData
-undefinedGPUObjectData = GPUObjectData identity
-
-instance Storable GPUObjectData where
-
-  sizeOf (GPUObjectData _) = sizeOf (identity :: M44 Float)
-
-  alignment _ = 0
-
-  peek ptr = do
-    GPUObjectData <$> peek (castPtr ptr)
-
-  poke ptr (GPUObjectData modelMatrix) =
-    poke (castPtr ptr) $ transpose modelMatrix
-
-data GPUCameraData = GPUCameraData
-  { view           :: M44 Float
-  , projection     :: M44 Float
-  , viewProjection :: M44 Float
-  }
-
-instance Storable GPUCameraData where
-
-  sizeOf _ =
-    3 * sizeOf (undefined :: M44 Float)
-
-  alignment _ = 0
-
-  peek ptr = do
-    v <- peek (castPtr ptr)
-    p <- peek (castPtr ptr `plusPtr` sizeOf v)
-    vp <- peek (castPtr ptr `plusPtr` sizeOf v `plusPtr` sizeOf p)
-    return $ GPUCameraData v p vp
-
-  poke ptr (GPUCameraData pview pprojection pviewProjection) = do
-    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
-  , fogDistance  :: V4 Float
-  , ambientColor :: V4 Float
-  , sunDirection :: V4 Float
-  , sunColor     :: V4 Float
-  }
-  deriving (Show)
-
-undefinedGPUSceneData :: GPUSceneData
-undefinedGPUSceneData = 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)
-
-instance Storable GPUSceneData where
-
-  sizeOf _ =
-    5 * sizeOf (V4 0 0 0 0 :: V4 Float)
-
-  alignment _ = 0
-
-  peek ptr = do
-    fogCol <- peek (castPtr ptr)
-    fogDst <- peek (castPtr $ ptr `plusPtr` sizeOf fogCol)
-    ambCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst))
-    sunDir <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol))
-    sunCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol + sizeOf sunDir))
-    return $ GPUSceneData fogCol fogDst ambCol sunDir sunCol
-
-  poke ptr (GPUSceneData fogCol fogDist ambCol sunDir sunCol) = do
-    poke (castPtr ptr) fogCol
-    poke (castPtr $ ptr `plusPtr` sizeOf fogCol) fogDist
-    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
@ -1,110 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE DataKinds #-}
-module Util where
-
-import Data.Bits
-
-import qualified Data.Vector as V
-
-import Data.Word (Word32)
-
-import qualified Vulkan as Vk
-import qualified Vulkan.CStruct.Extends as Vk
-import qualified Vulkan.Zero as Vk
-
-- internal imports
-
-import Types
-
-getFrame :: EngineData -> Int -> FrameData
-getFrame engineData frame =
-  let frameVector = engineFrames engineData
-  in
-    frameVector V.! (frame `mod` V.length frameVector)
-
-padUniformBufferSize
-  :: Vk.DeviceSize
-  -> Vk.PhysicalDeviceProperties
-  -> Vk.DeviceSize
-padUniformBufferSize origSize gpuProperties =
-  let minUBOAlignment = Vk.minUniformBufferOffsetAlignment $ Vk.limits gpuProperties
-      result =
-        if minUBOAlignment > 0
-        then (origSize + minUBOAlignment - 1) .&. complement (minUBOAlignment - 1)
-        else origSize
-  in
-    -- trace ("padding result: " <> show result) result
-    result
-
-descriptorsetLayoutBinding
-  :: Vk.DescriptorType
-  -> Vk.ShaderStageFlags
-  -> Word32
-  -> Vk.DescriptorSetLayoutBinding
-descriptorsetLayoutBinding type' stageFlags binding =
-  Vk.zero
-    { Vk.binding           = binding
-    , Vk.descriptorCount   = 1
-    , Vk.descriptorType    = type'
-    , Vk.immutableSamplers = V.empty
-    , Vk.stageFlags        = stageFlags
-    }
-
-writeDescriptorBuffer
-  :: Vk.DescriptorType
-  -> Vk.DescriptorSet
-  -> Vk.DescriptorBufferInfo
-  -> Word32
-  -> Vk.SomeStruct Vk.WriteDescriptorSet
-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 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
@ -1,46 +0,0 @@
-{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,30 +34,25 @@ executable vulkan-tutorial
                      Memory
                      Mesh
                      Image
-                      Sync
-                      Textures
                      Types
-                      Util

    -- LANGUAGE extensions used by modules in this package.
    -- other-extensions:
-    build-depends:    base
+    build-depends:    base >=4.14.3.0
                    , sdl2
                    , vulkan
+                    , vulkan-api
                    , vulkan-utils
                    , VulkanMemoryAllocator
                    , wavefront
                    , linear
                    , monad-loops
                    , stm
-                    , time
                    , bytestring
                    , text
                    , vector
                    , resourcet
-                    , mtl
-                    , containers
-                    , JuicyPixels
+                    , transformers
    hs-source-dirs:   src
    default-language: Haskell2010
    ghc-options:      -Wall