% stack exec zenn-vulkan-blit-exe <入力画像ファイル名> <出力画像ファイル名> <nearest/linear> <分割数n> <位置を示す数i>

 +-----+-----+-----+
 |  0  |  1  |  2  |
 +-----+-----+-----+
 |  3  |  4  |  5  |
 +-----+-----+-----+
 |  6  |  7  |  8  |
 +-----+-----+-----+

$ pkg-config --cflags --libs vulkan
$ pkg-config --cflags --libs shaderc

$ pacman -S mingw-w64-x86_64-mesa
$ pacman -S mingw-w64-x86_64-vulkan-devel
$ pacman -S mingw-w64-x86_64-shaderc

$ export VK_LAYER_PATH=/mingw64/bin/

$ pacman -S mingw-w64-x86_64-neovim
$ nvim ~/.bashrc
export VK_LAYER_PATH=/mingw64/bin/

$ pkg-config --cflags --libs vulkan
 -lvulkan-1.dll
$ pkg-config --cflags --libs shaderc
 -lshaderc_shared

$ sudo apt install vulkan-tools
$ sudo apt install libvulkan-dev
$ sudo apt install vulkan-validationlayers-dev
$ sudo apt install spirv-tools
$ sudo apt install libshaderc-dev

$ sudo dnf install vulkan-tools
$ sudo dnf install vulkan-loader-devel
$ sudo dnf install mesa-vulkan-devel
$ sudo dnf install vulkan-validation-layers-devel
$ sudo dnf install libshaderc-devel

emerge -pv mesa

$ pkg-config --cflags --libs vulkan
$ pkg-config --cflags --libs shaderc

% mkdir ~/zenn-practice
% cd ~/zenn-practice
% stack new zenn-vulkan-blit
% cd zenn-vulkan-blit

% nvim stack.yaml
...
snapshot: nightly-2024-12-08
...
extra-deps:
  - gpu-vulkan-0.1.0.155
  - gpu-vulkan-middle-0.1.0.60
  - gpu-vulkan-core-0.1.0.11
  - language-spir-v-0.1.0.1
...

% nvim package.yaml
...
dependencies:
- base >= 4.7 && < 5
- array
- data-default
- JuicyPixels
- gpu-vulkan
- hetero-parameter-list
- typelevel-tools-yj
- tools-yj

...

% stack build

% LANG='C' stack build

$ chcp.com 65001
$ stack build

% stack exec zenn-vulkan-blit-exe
someFunc

{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications, RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Main (main) where

module Main (main) where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
import Control.Arrow
import Data.TypeLevel.Tuple.Uncurry
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe (nil)
import Data.Bits
import Data.Bits.ToolsYj
import Data.Default
import Data.Maybe
import Data.Maybe.ToolsYj
import Data.List qualified as L
import Data.List.ToolsYj
import Data.HeteroParList (pattern (:*.))
import Data.HeteroParList qualified as HPList
import Data.Array
import Data.Word
import Data.Int
import Text.Read
import System.Environment
import Codec.Picture

import Gpu.Vulkan qualified as Vk
import Gpu.Vulkan.TypeEnum qualified as Vk.T
import Gpu.Vulkan.Object qualified as Vk.Obj
import Gpu.Vulkan.Object.NoAlignment qualified as Vk.ObjNA
import Gpu.Vulkan.Object.Base qualified as Vk.ObjB
import Gpu.Vulkan.Instance qualified as Vk.Ist
import Gpu.Vulkan.PhysicalDevice qualified as Vk.Phd
import Gpu.Vulkan.Queue qualified as Vk.Q
import Gpu.Vulkan.QueueFamily qualified as Vk.QFam
import Gpu.Vulkan.Device qualified as Vk.Dvc
import Gpu.Vulkan.Memory qualified as Vk.Mm
import Gpu.Vulkan.Buffer qualified as Vk.Bffr
import Gpu.Vulkan.Image qualified as Vk.Img
import Gpu.Vulkan.CommandPool qualified as Vk.CmdPl
import Gpu.Vulkan.CommandBuffer qualified as Vk.CBffr
import Gpu.Vulkan.Cmd qualified as Vk.Cmd
import Gpu.Vulkan.Pipeline qualified as Vk.Ppl
import Gpu.Vulkan.Sample qualified as Vk.Sample

main :: IO ()
main = putStrLn "Slozsoft"

% stack build

-- DATA TYPE IMAGE RGBA8

newtype ImageRgba8 = ImageRgba8 (Image PixelRGBA8)
newtype PixelRgba8 = PixelRgba8 PixelRGBA8 deriving Show

instance Vk.ObjB.IsImage ImageRgba8 where
	type ImagePixel ImageRgba8 = PixelRgba8
	type ImageFormat ImageRgba8 = 'Vk.T.FormatR8g8b8a8Unorm
	imageRow = Vk.ObjB.imageWidth
	imageWidth (ImageRgba8 i) = fromIntegral $ imageWidth i
	imageHeight (ImageRgba8 i) = fromIntegral $ imageHeight i
	imageDepth _ = 1
	imageBody (ImageRgba8 i) = (<$> [0 .. imageHeight i - 1]) \y ->
		(<$> [0 .. imageWidth i - 1]) \x -> PixelRgba8 $ pixelAt i x y
	imageMake (fromIntegral -> w) (fromIntegral -> h) _d pss =
		ImageRgba8 $ generateImage
			(\x y -> let PixelRgba8 p = (pss' ! y) ! x in p) w h
		where pss' = listArray (0, h - 1) (listArray (0, w - 1) <$> pss)

instance Storable PixelRgba8 where
	sizeOf _ = 4 * sizeOf @Pixel8 undefined
	alignment _ = alignment @Pixel8 undefined
	peek p = PixelRgba8 . (\(r, g, b, a) -> PixelRGBA8 r g b a)
		. listToTuple4 <$> peekArray 4 (castPtr p)
	poke p (PixelRgba8 (PixelRGBA8 r g b a)) =
		pokeArray (castPtr p) [r, g, b, a]

typedef struct VkBufferImageCopy {
	VkDeviceSize		    bufferOffset;
	uint32_t		    bufferRowLength;
	uint32_5		    bufferImageHeight;
	VkImageSubresourceLayers    imageSubresource;
	VkOffset3D		    imageOffset;
	VkOffset3D		    imageExtent;
} VkBufferImageCopy;

imageBody :: img -> [[ImagePixel img]]
imageMake :: Size -> Size -> Size -> [[ImagePixel img]] -> img

-- MAIN

main :: IO ()
main = getArgs >>= \case
	[ifp, ofp, getFilter -> Just flt,
		readMaybe -> Just n, readMaybe -> Just i] -> do
		img <- either error convewrtRGBA8 <$> readImage ifp
		ImageRgba8 img' <- realMain (ImageRgba8 img) flt n i
		writePng ofp img'
	_ -> error "Invalid command line arguments"

getFilter :: String -> Maybe Vk.Filter
getFilter = \case
	"nearest" -> Just Vk.FilterNearest; "linear" -> Just Vk.FilterLinear
	_ -> Nothing

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = do
	print $ Vk.ObjB.imageBody img !! fromIntegral i !! fromIntegral n
	pure img

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 234 210
PixelRgba8 (PixelRGBA8 234 210 33 255)

Gpu.Vulkan.Instance.create ::
	Gpu.Vulkan.Instance.CreateInfo mn ai ->
	Data.TypeLevel.ParMaybe.M (U2 GPU.Vulkan.AllocationCallbacks.A) mac ->
	(forall s . I s -> IO a) -> IO a

foo = Vk.Ist.create def nil \ist -> ...

Gpu.Vulkan.Instance.CreateInfo mn ai = Gpu.Vulkan.Instance.CreateInfo {
	createInfoNext :: Data.TypeLevel.Maybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoApplicationInfo :: Maybe (ApplicationInfo ai),
	createInfoEnabledLayerNames :: [LayerName],
	createInfoEnableExtensionNames :: [ExtensionName] }

ApplicationInfo mn = ApplicationInfo {
	applicationInfoNext :: M mn,
	applicationInfoApplicationName :: Text,
	applicationInfoApplicationVersion :: ApiVersion,
	applicationInfoEngineName :: Text,
	applicationInfoEngineVersion :: ApiVersion,
	applicationInfoApiVersion :: ApiVersion }

VkResult vkCreateFoo(...)
{
	if (...) {
		log("Something wrong!");
		return VK_ERROR_FOO_FAILED;
	}
	return real_vkCreateFoo(...);
}

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> print ist >> pure img

createIst :: (forall si . Vk.Ist.I si -> IO a) -> IO a
createIst = Vk.Ist.create info nil
	where
	info :: Vk.Ist.CreateInfo 'Nothing 'Nothing
	info = def { Vk.Ist.createInfoEnabledLayerNames = vldLayers }

vldLayers :: [Vk.LayerName]
vldLayers = [Vk.layerKhronosValidation]

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
I {unI = I 0x00000000...}

Gpu.Vulkan.PhysicalDevice.enumerate ::
	Gpu.Vulkan.Instance.I si -> IO [Gpu.Vulkan.PhysicalDevice.P]

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> pickPhd ist >>= \(pd, qfi) ->
	print pd >>
	(print . Vk.Phd.propertiesDeviceName =<< Vk.Phd.getProperties pd) >>
	print qfi >> pure img

pickPhd :: Vk.Ist.I si -> IO (Vk.Phd.P, Vk.QFam.Index)
pickPhd ist = Vk.Phd.enumerate ist >>= \case
	[] -> error "failed to find GPUs with Vulkan support!"
	pds -> findMaybeM suit pds >>= \case
		Nothing -> error "failed to find a suitable GPU!"
		Just pdqfi -> pure pdqfi
	where
	suit pd = findf <$> Vk.Phd.getQueueFamilyProperties pd
	findf ps = fst <$> L.find (grbit . snd) ps
	grbit = checkBits Vk.Q.GraphicsBit . Vk.QFam.propertiesQueueFlags

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
P 0x00000000...
"Intel(R) Graphics ..."
Index 0

Gpu.Vulkan.Device.create ::
	Gpu.Vulkan.PhysicalDevice.P -> Gpu.Vulkan.Device.CreateInfo mn qcis ->
	M (U2 A) mac -> (forall s . D s -> IO a) -> IO a

Gpu.Vulkan.Device.CreateInfo mn qcis = Gpu.Vulkan.Device.CreateInfo {
	createInfoNext :: Data.TypeLevel.Maybe.M mn,
	createInfoFlags :: Gpu.Vulkan.Device.CreateFlags,
	createInfoQueueCreateInfos ::
		Data.HeteroParList.PL QueueCreateInfo qcis,
	createInfoEnabledLayerNames :: [LayerName],
	createInfoEnabledExtensionNames :: [ExtensionName],
	createInfoEnabledFeatures :: Maybe Features }

Gpu.Vulkan.Device.QueueCreateInfo mn = Gpu.Vulkan.Device.QueueCreateInfo {
	queueCreateInfoNext :: M mn,
	queueCreateInfoFlags :: QueueCreateFlags,
	queueCreateInfoQueueFamilyIndex :: Index,
	queueCreateInfoQueuePriorities :: [Float] }

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> pickPhd ist >>= \(pd, qfi) ->
	createLgDvc pd qfi \dv -> print dv >> pure img

createLgDvc ::
	Vk.Phd.P -> Vk.QFam.Index -> (forall sd . Vk.Dvc.D sd -> IO a) -> IO a
createLgDvc pd qfi = Vk.Dvc.create pd info nil
	where
	info = Vk.Dvc.CreateInfo {
		Vk.Dvc.createInfoNext = TMaybe.N,
		Vk.Dvc.createInfoFlags = zeroBits,
		Vk.Dvc.createInfoQueueCreateInfos = HPList.Singleton qinfo,
		Vk.Dvc.createInfoEnabledLayerNames = vldLayers,
		Vk.Dvc.createInfoEnabledExtensionNames = [],
		Vk.Dvc.createInfoEnabledFeatures = Just def }
	qinfo = Vk.Dvc.QueueCreateInfo {
		Vk.Dvc.queueCreateInfoNext = TMaybe.N,
		Vk.Dvc.queueCreateInfoFlags = zeroBits,
		Vk.Dvc.queueCreateInfoQueueFamilyIndex = qfi,
		Vk.Dvc.queueCreateInfoQueuePriorities = [1.0] }

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
D (D 0x000000...)

Gpu.Vulkan.Device.getQueue :: Gpu.Vulkan.Device.D sd ->
	Gpu.Vulkan.QueueFamily.Index -> Gpu.Vulkan.Queue.Index ->
	IO Gpu.Vulkan.Queue.Q

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> pickPhd ist >>= \(pd, qfi) ->
	createLgDvc pd qfi \dv -> Vk.Dvc.getQueue dv qfi 0 >>= \gq ->
	print gq >> pure img

$ stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
Q 0x0000000...

Gpu.Vulkan.CommandPool.create ::
	Gpu.Vulkan.Device.D sd -> Gpu.Vulkan.CommandPool.CreateInfo mn ->
	Data.TypeLevel.ParMaybe.M (U2  A) ma ->
	(forall s . Gpu.Vulkan.CommandPool.C s -> IO a) -> IO a

Gpu.Vulkan.CommandPool.CreateInfo mn = Gpu.Vulkan.CommandPool.CreateInfo {
	createInfoNext :: M mn,
	createInfoFlags :: Gpu.Vulkan.CommandPool.CreateFlags,
	createInfoQueueFamilyIndex :: Vk.QueueFamily.Index }

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> pickPhd ist >>= \(pd, qfi) ->
	createLgDvc pd qfi \dv -> Vk.Dvc.getQueue dv qfi 0 >>= \gq ->
	createCmdPl qfi dv \cp -> print cp >> pure img

createCmdPl :: Vk.QFam.Index ->
	Vk.Dvc.D sd -> (forall sc . Vk.CmdPl.C sc -> IO a) -> IO a
createCmdPl qfi dv = Vk.CmdPl.create dv info nil
	where info = Vk.CmdPl.CreateInfo {
		Vk.CmdPl.createInfoNext = TMaybe.N,
		Vk.CmdPl.createInfoFlags = zeroBits,
		Vk.CmdPl.createInfoQueueFamilyIndex = qfi }

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
C (C 0xfd5......)

realMain :: ImageRgba8 -> Vk.Filter -> Int32 -> Int32 -> IO ImageRgba8
realMain img flt n i = createIst \ist -> pickPhd ist >>= \(pd, qfi) ->
	createLgDvc pd qfi \dv -> Vk.Dvc.getQueue dv qfi 0 >>= \gq ->
	createCmdPl qfi dv \cp -> body pd dv gq cp img flt n i

body :: forall sd sc img . Vk.ObjB.IsImage img => Vk.Phd.P -> Vk.Dvc.D sd ->
	Vk.Q.Q -> Vk.CmdPl.C sc -> img -> Vk.Filter -> Int32 -> Int32 -> IO img
body pd dv gq cp img flt n i = pure img

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.Buffer.B s bnm objs

Gpu.Vulkan.Buffer.create ::
	Gpu.Vulkan.Device.D sd -> Gpu.Vulkan.Buffer.CreateInfo mn objs ->
	Data.TypeLevel.ParMaybe.M (U2 Gpu.Vulkan.AllocationCallbacks.A) ma ->
	(forall sb . B sb nm objs -> IO a) -> IO a

Gpu.Vulkan.Buffer.CreateInfo mn objs = Gpu.Vulkan.Buffer.CreateInfo {
	createInfoNext :: M mn,
	createInfoFlags :: Gpu.Vulkan.Buffer.CreateFlags
	createInfoLengths :: Data.HeteroParList.PL Gpu.Vulkan.Object.Length objs,
	createInfoUsage :: Gpu.Vulkan.Buffer.UsageFlags,
	createInfoSharingMode :: Gpu.Vulkan.SharingMode,
	createInfoQueueFamilyIndices :: [Gpu.Vulkan.QueueFamily.Index] }

body :: forall sd sc img . Vk.ObjB.IsImage img => Vk.Phd.P -> Vk.Dvc.D sd ->
	Vk.Q.Q -> Vk.CmdPl.C sc -> img -> Vk.Filter -> Int32 -> Int32 -> IO img
body pd dv gq cp img flt n i =
	Vk.Bffr.create @_ @'[Vk.ObjNA.Image img "sample-buffer"] dv (
		bffrInfo
			(Vk.Obj.LengthImage 100 100 100 1 1)
			Vk.Bffr.UsageTransferDstBit
		) nil \b -> print b >> pure img

-- BUFFER

bffrInfo :: Vk.Obj.Length o ->
	Vk.Bffr.UsageFlags -> Vk.Bffr.CreateInfo 'Nothing '[o]
bffrInfo ln us = Vk.Bffr.CreateInfo {
	Vk.Bffr.createInfoNext = TMaybe.N,
	Vk.Bffr.createInfoFlags = zeroBits,
	Vk.Bffr.createInfoLengths = HPList.Singleton ln,
	Vk.Bffr.createInfoUsage = us,
	Vk.Bffr.createInfoSharingMode = Vk.SharingModeExclusive,
	Vk.Bffr.createInfoQueueFamilyIndices = [] }

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
B LengthStatic (LengthImage {
lengthImageRow = Size 100, lengthImageWidth = Size 100,
lengthImageHeight = Size 100, lengthImageDepth = Size 1},
lengthImageLayerCount = Size 1) :** Nil (B 0xfa...)

Gpu.Vulkan.Memory.allocateBind :: Gpu.Vulkan.Device.D sd ->
	Data.HeteroParList.PL (U2 (Gpu.Vulkan.Memory.ImageBufferBinded sm)) ibargs ->
	Gpu.Vulkan.Memory.AllocationInfo mn ->
	Data.TypeLevel.ParMayber.M (U2 Gpu.Vulkan.AllocationCallbacks.A) mac ->
	(forall s . Data.HeteroParList.PL (U2 (
			Gpu.Vulkan.Memory.ImageBufferBinded s)) ibargs ->
		Gpu.Vulkan.Memory.M s ibargs -> IO a) -> IO a

allocateBind :: ImageBufferList -> AllocationInfo ->
	(BindedImageBufferList -> Memory -> IO a) -> IO a

Gpu.Vulkan.Memory.AllocateInfo mn = Gpu.Vulkan.Memory.AllocateInfo {
	allocateInfoNext :: Data.TypeLevel.Maybe.M mn,
	allocateInfoMemoryTypeIndex :: Gpu.Vulkan.Memory.TypeIndex }

Gpu.Vulkan.PhysicalDevice.getMemoryProperties ::
	Gpu.Vulkan.PhysicalDevice.P ->
	IO Gpu.Vulkan.PhysicalDevice.MemoryProperties

Gpu.Vulkan.PhysicalDevice.MemoryProperties =
	Gpu.Vulkahn.PhysicalDevice.MemoryProperties {
		memoryPropertiesMemoryTypes :: [(
			Gpu.Vulkan.Memory.TypeIndex,
			Gpu.Vulkan.Memory.MType )],
		memoryPropertiesMemoryHeap :: [Gpu.Vulkan.Memory.Heap] }

Gpu.Vulkan.Buffer.getMemoryRequirements ::
	Gpu.Vulkan.Device.D sd -> Gpu.Vulkan.Buffer.B sb nm objs ->
	IO Gpu.Vulkan.Memory.Requirements

Gpu.Vulkan.Memory.Requirements = Gpu.Vulkan.Memory.Requirements {
	requirementsSize :: Gpu.Vulkan.Device.Size,
	requirementsAlignment :: Gpu.Vulkan.Device.Size,
	requirementsMemoryTypeBits :: Gpu.Vulkan.Memory.TypeBits }

body pd dv gq cp img flt n i =
	Vk.Bffr.create @_ @'[Vk.ObjNA.Image img "sample-buffer"] dv (
		bffrInfo
			(Vk.Obj.LengthImage 100 100 100 1)
			Vk.Bffr.UsageTransferDstBit
		) nil \b -> do
			print =<< Vk.Bffr.getMemoryRequirements dv b
			pure img

% stack build
% stack exec zenn-vulkan-blit-exe xy_pg.png foo.png linear 1 0
Requirements {requirementsSize = Size 40000, requrementsAlignment = Size 64,
requirementsMemoryTypeBits = TypeBits 7}

body pd dv gq cp img flt n i =
	Vk.Bffr.create @_ @'[Vk.ObjNA.Image img "sample-buffer"] dv (
		bffrInfo
			(Vk.Obj.LengthImage 100 100 100 1)
			Vk.Bffr.UsageTransferDstBirt
		) nil \b -> do
			print =<< Vk.Bffr.getMemoryRequrements dv b
			print =<< Vk.Phd.getMemoryProperties pd
			pure img

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
Requirements {requirementsSize = Size 40000, requirementsAlignment = Size 64, requirementsMemoryTypeBits = TypeBits 7}
MemoryProperties {memoryPropertiesMemoryTypes = [
(TypeIndex 0,MType {mTypePropertyFlags = PropertyDeviceLocalBit, mTypeHeapIndex = 0}),
(TypeIndex 1,MType {mTypePropertyFlags = PropertyFlagBits 7, mTypeHeapIndex = 0}),
...
(TypeIndex 6,MType {mTypePropertyFlags = PropertyFlagBits 15, mTypeHeapIndex = 0})],
memoryPropertiesMemoryHeaps = [Heap {heapSize = Size 8198477824, heapFlags = HeapDeviceLocalBit}]}

body pd dv gq cp img flt n i =
	Vk.Bffr.create @_ @'[Vk.ObjNA.Image img "sample-buffer"] dv (
		bffrInfo
			(Vk.Obj.LengthImage 100 100 100 1)
			Vk.Bffr.UsageTransferDstBirt
		) nil \b -> do
			print =<< Vk.Bffr.getMemoryRequrements dv b
			print =<< (second (bitsList
					. Vk.Mm.mTypePropertyFlags) <$>)
				. Vk.Phd.memoryPropertiesMemoryTypes
				<$> Vk.Phd.getMemoryProperties pd
			pure img

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
Requirements {requirementsSize = Size 40000, requirementsAlignment = Size 64, requirementsMemoryTypeBits = TypeBits 7}
[
(TypeIndex 0,[PropertyDeviceLocalBit]),
(TypeIndex 1,[PropertyDeviceLocalBit,PropertyHostVisibleBit,PropertyHostCoherentBit]),
(TypeIndex 2,[PropertyDeviceLocalBit,PropertyHostVisibleBit,PropertyHostCoherentBit,PropertyHostCachedBit]),
(TypeIndex 3,[PropertyDeviceLocalBit,PropertyProtectedBit]),
(TypeIndex 4,[PropertyDeviceLocalBit]),
(TypeIndex 5,[PropertyDeviceLocalBit,PropertyHostVisibleBit,PropertyHostCoherentBit]),
(TypeIndex 6,[PropertyDeviceLocalBit,PropertyHostVisibleBit,PropertyHostCoherentBit,PropertyHostCachedBit])]

findMmType ::
	Vk.Phd.P -> Vk.Mm.TypeBits -> Vk.Mm.PropertyFlags -> IO Vk.Mm.TypeIndex
findMmType pd tbs prs =
	fromMaybe (error msg) . suit <$> Vk.Phd.getMemoryProperties pd
	where
	msg = "failed to find suitable memory type!"
	suit p = fst <$> L.find ((&&)
			<$> (`Vk.Mm.elemTypeIndex` tbs) . fst
			<*> checkBits prs . Vk.Mm.mTypePropertyFlags . snd)
		(Vk.Phd.memoryPropertiesMemoryTypes p)

createBffr :: forall sd bnm o a . Vk.Obj.SizeAlignment o =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Obj.Length o ->
	Vk.Bffr.UsageFlags -> Vk.Mm.PropertyFlags -> (forall sm sb .
		Vk.Bffr.Binded sm sb bnm '[o] ->
		Vk.Mm.M sm '[ '(sb, 'Vk.Mm.BufferArg bnm '[o])] -> IO a) -> IO a
createBffr pd dv ln us prs f = Vk.Bffr.create dv binfo nil \b -> do
	rqs <- Vk.Bffr.getMemoryRequirements dv b
	mt <- findMmType pd (Vk.Mm.requirementsMemoryTypeBits rqs) prs
	Vk.Mm.allocateBind dv (HPList.Singleton . U2 $ Vk.Mm.Buffer b)
		(ainfo mt) nil
		$ f . \(HPList.Singleton (U2 (Vk.Mm.BufferBinded bd))) -> bd
	where
	binfo = bffrInfo ln us
	ainfo mt = Vk.Mm.AllocateInfo {
		Vk.Mm.allocateInfoNext = TMaybe.N,
		Vk.Mm.allocateInfoMemoryTypeIndex = mt }

createBffrImg :: forall img sd bnm nm a . Vk.ObjB.IsImage img =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Bffr.UsageFlags ->
	Vk.Dvc.Size -> Vk.Dvc.Size -> (forall sm sb .
		Vk.Bffr.Binded sm sb bnm '[Vk.ObjNA.Image img nm] ->
		Vk.Mm.M sm '[ '(
			sb,
			'Vk.Mm.BufferArg bnm '[Vk.ObjNA.Image img nm] )] ->
		IO a) -> IO a
createBffrImg pd dv us w h = createBffr pd dv (Vk.Obj.LengthImage w w h 1 1) us
	(Vk.Mm.PropertyHostVisibleBit .|. Vk.Mm.PropertyHostCoherentBit)

body pd dv gq cp img flt n i =
	createBffrImg @img pd dv Vk.Bffr.UsageTransferSrcBit w h \b bm ->
	print b >> pure img
	where
	w, h :: Integral n => n
	w = fromIntegral $ Vk.ObjB.imageWidth img
	h = fromIntegral $ Vk.ObjB.imageHeight img

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
Binded LengthStatic (LengthImage {lengthIamgeRow = Size 256,
lengthImageWidth = Size 256, lengthImageHight = Size 256,
lengthImageDepth = Size 1, lengthImageLayerCount = Size 1}) :** Nil (B 0xfab...)

Gpu.Vulkan.Image.create :: Gpu.Vulkan.Device.D sd ->
	Gpu.Vulkan.Image.CreateInfo mn fmt ->
	Data.TypeLevel.Maybe.M (U2 Gpu.Vulkan.AllocationCallbacks.A) mac ->
	(forall s . Gpu.Vulkan.Image.I s nm fmt -> IO a) -> IO a

Gpu.Vulkan.Image.CreateInfo = Gpu.Vulkan.Image.CreateInfo {
	createInfoNext :: Data.TypeLevel.Maybe.M mn,
	createInfoFlags :: Gpu.Vulkan.Image.CreateFlags,
	createInfoImageType :: Gpu.Vulkan.Image.Type,
	createInfoExtent :: Gpu.Vulkan.Extent3d,
	createInfoMipLevels :: Word32,
	createInfoArrayLayers :: Word32,
	createInfoSamples :: Gpu.Vulkan.Sample.CountFlagBits,
	createInfoTiling :: Gpu.Vulkan.Image.Tiling,
	createInfoUsage :: Gpu.Vulkan.Image.UsageFlags,
	createInfoSharingMode :: Gpu.Vulkan.SharingMode,
	createInfoQueueFamilyIndices :: [Gpu.Vulkan.QueueFamily.Index],
	createInfoInitialLayout :: Gpu.Vulkan.Image.Layout }

Extent3d = Extent3d {
	extent3dWidth :: Word32,
	extent3dHeight :: Word32,
	extent3dDepth :: Word32 }

-- IMAGE

prepareImg :: forall fmt sd nm a . Vk.T.FormatToValue fmt =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Word32 -> Word32 ->
	(forall si sm . Vk.Img.Binded sm si nm fmt -> IO a) -> IO a
prepareImg pd dv w h f = Vk.Img.create @'Nothing dv iinfo nil \i -> do
	rqs <- Vk.Img.getMemoryRequirements dv i
	mt <- findMmType pd (Vk.Mm.requirementsMemoryTypeBits rqs) zeroBits
	Vk.Mm.allocateBind dv (HPList.Singleton . U2 $ Vk.Mm.Image i) (minfo mt)
		nil \(HPList.Singleton (U2 (Vk.Mm.ImageBinded bd))) _ -> f bd
	where
	iinfo = Vk.Img.CreateInfo {
		Vk.Img.createInfoNext = TMaybe.N,
		Vk.Img.createInfoFlags = zeroBits,
		Vk.Img.createInfoImageType = Vk.Img.Type2d,
		Vk.Img.createInfoExtent = Vk.Extent3d {
			Vk.extent3dWidth = w, Vk.extent3dHeight = h,
			Vk.extent3dDepth = 1 },
		Vk.Img.createInfoMipLevels = 1,
		Vk.Img.createInfoArrayLayers = 1,
		Vk.Img.createInfoSamples = Vk.Sample.Count1Bit,
		Vk.Img.createInfoTiling = Vk.Img.TilingOptimal,
		Vk.Img.createInfoUsage =
			Vk.Img.UsageTransferSrcBit .|.
			Vk.Img.UsageTransferDstBit,
		Vk.Img.createInfoSharingMode = Vk.SharingModeExclusive,
		Vk.Img.createInfoQueueFamilyIndices = [],
		Vk.Img.createInfoInitialLayout = Vk.Img.LayoutUndefined }
	minfo mt = Vk.Mm.AllocateInfo {
		Vk.Mm.allocateInfoNext = TMaybe.N,
		Vk.Mm.allocateInfoMemoryTypeIndex = mt }

body pd dv gq cp img flt n i =
	prepareImg @(Vk.ObjB.ImageFormat img) pd dv w h \imgd -> pure img
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.CommandBuffer.allocateCs :: Gpu.Vulkan.Device.D sd ->
	Gpu.Vulkan.CommandBuffer.AllocateInfo mn scp c -> (forall scb .
		Data.HeteroParList.LL (Gpu.Vulkan.CommandBuffer.C scb) ->
		IO a) -> IO a

Gpu.Vulkan.CommandBuffer.AllocateInfo mn scp (c :: [()]) =
	Gpu.Vulkan.CommandBuffer.AllocateInfo {
		allocateInfoNext :: Data.TypeLevel.Maybe.M mn,
		allocateInfoCommandPool :: Gpu.Vulkan.CommandPool.C scp,
		allocateInfoLevel :: Gpu.Vulkan.CommandBuffer.Level }

Gpu.Vulkan.CommandBuffer.begin :: Gpu.Vulkan.CommandBuffer.C scb ->
	Gpu.Vulkan.CommandBuffer.BeginInfo mn ii -> IO a -> IO a

Gpu.Vulkan.CommandBuffer.BeginInfo = Gpu.Vulkan.CommandBuffer.BeginInfo {
	beginInfoNext :: Data.TypeLevel.Maybe.M mn,
	beginInfoFlags :: Gpu.Vulkan.CommandBuffer.UsageFlags,
	beginInfoInheritancxeInfo :: Maybe (InheritanceInfo ii) }

Gpu.Vulkan.Queue.submit :: Gpu.Vulkan.Q ->
	Data.HeteroParList.PL (U4 Gpu.Vulkan.SubmitInfo) sias ->
	Maybe (Gpu.Vulkan.Fence.F sf) -> IO ()

Gpu.Vulkan.SubmitInfo mn spsfs scbs ssgsms = Gpu.Vulkan.SubmitInfo {
	submitInfoNext :: Data.TypeLevel.Maybe.M mn,
	submitInfoWaitSemaphoreDstStageMasks ::
		Data.HeteroParList.PL
			Gpu.Vulkan.SemaphorePipelineStageFlags spsfs,
	submitInfoCommandBuffers ::
		Data.HeteroParList.PL Gpu.Vulkan.CommandBuffer.C scbs,
	submitInfoSignalSemaphores ::
		Data.HeteroParList.PL Gpu.Vulkan.Semaphore.S ssgsms }

Gpu.Vulkan.Queue.waitIdle :: Gpu.Vulkan.Queue.Q -> IO ()

-- COMMANDS

runCmds :: forall sd sc a . Vk.Dvc.D sd ->
	Vk.Q.Q -> Vk.CmdPl.C sc -> (forall scb . Vk.CBffr.C scb -> IO a) -> IO a
runCmds dv gq cp cmds =
	Vk.CBffr.allocateCs dv cbinfo \(cb :*. HPList.Nil) ->
	Vk.CBffr.begin @_ @'Nothing cb binfo (cmds cb) <* do
	Vk.Q.submit gq (HPList.Singleton . U4 $ sinfo cb) Nothing
	Vk.Q.waitIdle gq
	where
	cbinfo :: Vk.CBffr.AllocateInfo 'Nothing sc '[ '()]
	cbinfo = Vk.CBffr.AllocateInfo {
		Vk.CBffr.allocateInfoNext = TMaybe.N,
		Vk.CBffr.allocateInfoCommandPool = cp,
		Vk.CBffr.allocateInfoLevel = Vk.CBffr.LevelPrimary }
	binfo = Vk.CBffr.BeginInfo {
		Vk.CBffr.beginInfoNext = TMaybe.N,
		Vk.CBffr.beginInfoFlags = Vk.CBffr.UsageOneTimeSubmitBit,
		Vk.CBffr.beginInfoInheritanceInfo = Nothing }
	sinfo cb = Vk.SubmitInfo {
		Vk.submitInfoNext = TMaybe.N,
		Vk.submitInfoWaitSemaphoreDstStageMasks = HPList.Nil,
		Vk.submitInfoCommandBuffers = HPList.Singleton cb,
		Vk.submitInfoSignalSemaphores = HPList.Nil }

body pd dv gq cp img flt n i = runCmds dv gq cp \cb -> pure img
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.Memory.write :: forall bnm obj i v sd sm ibargs . (
	Gpu.Vulkan.Object.Store v Obj,
	Gpu.Vulkan.Memory.OffsetSize bnm obj ibargs i ) =>
	Gpu.Vulkan.Device.D sd -> Gpu.Vulkan.Memory.M sm ibargs ->
	Gpu.Vulkan.Memory.MapFlags -> v -> IO ()

body pd dv gq cp img flt n i =
	createBffrImg @img pd dv Vk.Bffr.UsageTransferSrcBit w h
		\(b :: Vk.Bffr.Binded sm sb nm '[o]) bm ->
	Vk.Mm.write @nm @o @0 dv bm zeroBits [img] >> pure img
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.Cmd.copyBufferToImage :: forall
	algn img inms scb smb sbb bnm objs smi si inm .
	Gpu.Vulkan.Buffer.ImageCopyLKistToMiddle algn objs img inms =>
	Gpu.Vulkan.CommandBuffer.C scb ->
	Gpu.Vulkan.Buffer.Binded smb sbb bnm objs ->
	Gpu.Vulkan.Image.Binded smi si inm (ImageFormat img) ->
	Gpu.Vulkan.Image.Layout ->
	Data.HeteroParLIst.PL (Gpu.Vulkan.Buffer.ImageCopy img) inms -> IO ()

Gpu.Vulkan.Buffer.ImageCopy = Gpu.Vulkan.Buffer.ImageCopy {
	imageCopyImageSubresource :: Gpu.Vulkan.Image.SubresourceLayers,
	imageCopyImageOffset :: Offset3d,
	imageCopyImageExtent :: Extent3d }

Gpu.Vulkan.Image.SubresourceLayers = Gpu.Vulkan.Image.SubresourceLayers {
	subresourceLayersAspectMask ::  Gpu.Vulkan.Image.AspectFlags,
	subresourceLayersMipLevel :: Word32,
	subresourceLayersBaseArrayLayer :: Word32,
	subresourceLayersLayerCount :: Word32 }

copyBffrToImg :: forall scb smb sbb bnm img imgnm smi si inm .
	Storable (Vk.ObjB.ImagePixel img) => Vk.CBffr.C scb ->
	Vk.Bffr.Binded smb sbb bnm '[Vk.ObjNA.Image img imgnm] ->
	Vk.Img.Binded smi si inm (Vk.ObjB.ImageFormat img) -> IO ()
copyBffrToImg cb b@(bffrImgExtent -> (w, h)) i =
	Vk.Cmd.copyBufferToImage @1 @img @'[imgnm] cb b i
		Vk.Img.LayoutTransferDstOptimal
		$ HPList.Singleton Vk.Bffr.ImageCopy {
			Vk.Bffr.imageCopyImageSubresource = colorLayer0,
			Vk.Bffr.imageCopyImageOffset = Vk.Offset3d 0 0 0,
			Vk.Bffr.imageCopyImageExtent = Vk.Extent3d w h 1 }

colorLayer0 :: Vk.Img.SubresourceLayers
colorLayer0 = Vk.Img.SubresourceLayers {
	Vk.Img.subresourceLayersAspectMask = Vk.Img.AspectColorBit,
	Vk.Img.subreousrceLayersMipLevel = 0,
	Vk.Img.subresourceLayersBaseArrayLayer = 0,
	Vk.Img.subresourceLayersLayerCount = 1 }

bffrImgExtent :: forall sm sb bnm img nm .
	Vk.Bffr.Binded sm sb bnm '[Vk.ObjNA.Image img nm] -> (Word32, Word32)
bffrImgExtent (Vk.Bffr.lengthBinded -> ln) = (w, h)
	where Vk.Obj.LengthImage _ (fromIntegral -> w) (fromIntegral -> h) _ _ =
		Vk.Obj.lengthOf @(Vk.ObjNA.Image img nm) ln

body pd dv gq cp img flt n i =
	prepareImg pd dv w h \imgs ->
	createBffrImg @img pd dv Vk.Bffr.UsageTransferSrcBit w h
		\(b :: Vk.Bffr.Binded sm sb nm '[o]) bm ->
	Vk.Mm.write @nm @o @0 dv bm zeroBits img >>
	runCmds dv gq cp \cb -> copyBffrToImg cb b imgs >> pure img
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0
UNASSIGNED-CoreValidation-DrawState-InvalidImageLayout(ERROR / SPEC): msgNum: 1303270965 -
Validation Error: [ UNASSIGNED-CoreValidation-DrawState-InvalidImageLayout ]
Object 0: handle = 0x2a94400, type = VK_OBJECT_TYPE_COMMAND_BUFFER;
Object 1: handle = 0xfab64d0000000002, type = VK_OBJECT_TYPE_IMAGE;
| MessageID = 0x4dae5635 | vkQueueSubmit(): pSubmits[0].pCommandBuffers[0]
command buffer VkCommandBuffer 0x2a94400[]
expects VkImage 0xfab64d0000000002[]
(subresource: aspectMask 0x1 array layer 0, mip level 0) to be
in layout VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL--instead,
current layout is VK_IMAGE_LAYOUT_UNDEFINED.
    Objects: 2
        [0] 0x2a94400, type: 6, name: NULL
        [1] 0xfab64d0000000002, type: 10, name: NULL

Gpu.Vulkan.Cmd.pipelineBarrier ::
	Gpu.Vulkan.CommandBuffer.C scb ->
	Gpu.Vulkan.Pipeline.StageFlags -> Gpu.Vulkan.Pipeline.StageFlags ->
	Gpu.Vulkan.DependencyFlags ->
	Data.HeteroParList.PL Gpu.Vulkan.Memory.Barrier mbargs ->
	Data.HeteroParList.PL (U5 Gpu.Vulkan.Buffer.MemoryBarrier) bmbargss ->
	Data.HeteroParList.PL (U5 Gpu.Vulkan.Image.MemoryBarrier) imbargss -> IO ()

Gpu.Vulkan.Image.MemoryBarrier mn sm si nm fmt =
	Gpu.Vulkan.Image.MemoryBarrier {
		memoryBarrierNext :: Data.TypeLevel.Maybe.M mn,
		memoryBarrierSrcAccessMask :: Gpu.Vulkan.AccessFlags,
		memoryBarrierDstAccessMask :: Gpu.Vulkan.AccessFlags,
		memoryBarrierOldLayout :: Gpu.Vulkan.Image.Layout,
		memoryBarrierNewLayout :: Gpu.Vulkan.Image.Layout,
		memoryBarrierSrcQueueFamilyIndex ::
			Gpu.Vulkan.QueueFamily.Index,
		memoryBarrierDstQueueFamilyIndex ::
			Gpu.Vulkan.QueueFamily.Index,
		memoryBarrierImage :: Gpu.Vulkan.Image.Binded sm si nm fmt,
		memoryBarrierSubresourceRange ::
			Gpu.Vulkan.Image.SubresourceRange }

transitionImgLyt :: Vk.CBffr.C scb ->
	Vk.Img.Binded sm si nm fmt -> Vk.Img.Layout -> Vk.Img.Layout -> IO ()
transitionImgLyt cb i ol nl =
	Vk.Cmd.pipelineBarrier cb
		Vk.Ppl.StageTopOfPipeBit Vk.Ppl.StageTransferBit zeroBits
		HPList.Nil HPList.Nil . HPList.Singleton $ U5 brrr
	where
	brrr = Vk.Img.MemoryBarrier {
		Vk.Img.memoryBarrierNext = TMaybe.N,
		Vk.Img.memoryBarrierOldLayout = ol,
		Vk.Img.memoryBarrierNewLayout = nl,
		Vk.Img.memoryBarrierSrcQueueFamilyIndex = Vk.QFam.Ignored,
		Vk.Img.memoryBarrierDstQueueFamilyIndex = Vk.QFam.Ignored,
		Vk.Img.memoryBarrierImage = i,
		Vk.Img.memoryBarrierSubresourceRange = srr,
		Vk.Img.memoryBarrierSrcAccessMask = zeroBits,
		Vk.Img.memoryBarrierDstAccessMask = case nl of
			Vk.Img.LayoutTransferSrcOptimal ->
				Vk.AccessTransferReadBit
			Vk.Img.LayoutTransferDstOptimal ->
				Vk.AccessTransferWriteBit
			_ -> error "unsupported layout transition!" }
	srr = Vk.Img.SubresourceRange {
		Vk.Img.subreousrceRangeAspectMask = Vk.Img.AspectColorBit,
		Vk.Img.subresourceRangeBaseMipLevel = 0,
		Vk.Img.subresourceRangeLevelCount = 1,
		Vk.Img.subresourceRangeBaseArrayLayer = 0,
		Vk.Img.subresourceRangeLayerCount = 1 }

body pd dv gq cp img flt n i =
	prepareImg pd dv w h \imgs ->
	createBffrImg @img pd dv Vk.Bffr.UsageTransferSrcBit w h
		\(b :: Vk.Bffr.Binded sm sb nm '[9]) bm ->
	Vk.Mm.wreite @nm @o @0 dv bm zeroBits img >>
	runCmds dv gq cp \cb -> do
	tr cb imgs Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
	copyBffrToImg cb b imgs
	pure img
	where
	w, h :: Integral n => n
	w = fromIntegral $ Vk.ObjB.imageWidth img
	h = fromIntegral $ Vk.ObjB.imageHeight img
	tr = transitionImgLyt

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.Cmd.blitImage :: Gpu.Vulkan.CommandBuffer.C scb ->
	Gpu.Vulkan.Image.Binded sms sis nms fmts -> Gpu.Vulkan.Image.Layout ->
	Gpu.Vulkan.Image.Binded smd sid nmd fmtd -> Gpu.Vulkan.Image.Layout ->
	[Gpu.Vulkan.Image.Blit] -> Gpu.Vulkan.Filter -> IO ()

Gpu.Vulkan.Image.Blit = Gpu.Vulkan.Image.Blit {
	blitSrcSubresource :: Gpu.Vulkan.Image.SubresourceLayers,
	blitSrcOffsetFrom :: Gpu.Vulkan.Offset3d,
	blitSrcOffsetTo :: Gpu.Vulkan.Offset3d,
	blitDstSubresource :: Gpu.Vulkan.Image.SubresourceLayers,
	blitDstOffsetFrom :: Gpu.Vulkan.Offset3d,
	blitDstOffsetTo :: Gpu.Vulkan.Offset3d }

copyImgToImg :: Vk.CBffr.C scb ->
	Vk.Img.Binded sms sis nms fmts -> Vk.Img.Binded smd sid nmd fmtd ->
	Int32 -> Int32 -> Vk.Filter -> Int32 -> Int32 -> IO ()
copyImgToImg cb si di w h flt n i = Vk.Cmd.blitImage cb
	si Vk.Img.LayoutTransferSrcOptimal
	di Vk.Img.LayoutTransferDstOptimal [blt] flt
	where
	blt = Vk.Img.Blit {
		Vk.Img.blitSrcSubresource = colorLayer0,
		Vk.Img.blitSrcOffsetFrom = Vk.Offset3d l t 0,
		Vk.Img.blitSrcOffsetTo = Vk.Offset3d r b 1,
		Vk.Img.blitDstSubresource = colorLayer0,
		Vk.Img.blitDstOffsetFrom = Vk.Offset3d 0 0 0,
		Vk.Img.blitDstOffsetTo = Vk.Offset3d w h 1 }
	(l, r, t, b) = (
		w * (i `mod` n) `div` n, w * (i `mod` n + 1) `div` n,
		h * (i `div` n) `div` n, h * (i `div` n + 1) `div` n )

body pd dv gq cp img flt n i =
	prepareImg @(Vk.ObjB.ImageFormat img) pd dv w h \imgd ->
	prepareImg pd dv w h \imgs ->
	...
	copyBffrToImg cb b imgs
	tr cb imgs
		Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutTransferSrcOptimal
	tr cb imgd Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
	copyImgToImg cb imgs imgd w h flt n i
	pure img
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe xy_rg.png foo.png linear 1 0

Gpu.Vulkan.Cmd.copyImageToBuffer :: forall
	algn img inms scb smi si inm smb sbb bnm objs .
	Gpu.Vulkan.BufferImageCopyListToMiddle algn objs img inms =>
	Gpu.Vulkan.CommandBuffer.C scb ->
	Gpu.Vulkan.Image.Binded smi si inm (ImageFormat img) ->
	Gpu.Vulkan.Image.Layout ->
	Gpu.Vulkan.Buffer.Binded smb sbb bnm objs ->
	Data.HeteroParList.PL (Gpu.Vulkan.Buffer.ImageCopy img) inms -> IO ()

copyImgToBffr :: forall scb img smi si inm smb sbb bnm imgnm .
	Storable (Vk.ObjB.ImagePixel img) => Vk.CBffr.C scb ->
	Vk.Img.Binded smi si inm (Vk.ObjB.ImageFormat img) ->
	Vk.Bffr.Binded smb sbb bnm '[Vk.ObjNA.Image img imgnm] -> IO ()
copyImgToBffr cb i b@(bffrImgExtent -> (w, h)) =
	Vk.Cmd.copyImageToBuffer @1 @img @'[imgnm] cb i
		Vk.Img.LayoutTransferSrcOptimal b
		$ HPList.Singleton Vk.Bffr.ImageCopy {
			Vk.Bffr.imageCopyImageSubresource = colorLayer0,
			Vk.Bffr.imageCopyImageOffset = Vk.Offset3d 0 0 0,
			Vk.Bffr.imageCopyImageExtent = Vk.Extent3d w h 1 }

Gpu.Vulkan.Memory.read :: forall
	nm obj i v sd sm ibargs .
	Gpu.Vulkan.Device.D sd -> Gpu.Vulkan.Memory.M sm ibargs ->
	Gpu.Vulkan.Memory.MapFlags -> IO v

-- RESULT BUFFER

resultBffr :: Vk.ObjB.IsImage img =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Dvc.Size -> Vk.Dvc.Size -> (forall sm sb .
		Vk.Bffr.Binded sm sb nm '[Vk.ObjNA.Image img nmi] -> IO a) ->
	IO img
resultBffr pd dv w h f = head
	<$> createBffrImg pd dv Vk.Bffr.UsageTransferDstBit w h
		\(b :: Vk.Bffr.Binded sm sb nm '[o]) m ->
	f b >> Vk.Mm.read @nm @o @0 dv m zeroBits

body pd dv gq cp img flt n i = resultBffr @img pd dv w h \rb ->
	prepareImg pd dv w h \imgd -> prepareImg pd dv w h \imgs ->
	...
	copyImgToImg cb imgs imgd w h flt n i
	tr cb imgd
		Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutTransferSrcOptimal
	copyImgToBffr cb imgd rb
	where
	w, h :: Integral n => n
	...

% stack build
% stack exec zenn-vulkan-blit-exe funenohito.png funenohito-nearest.png nearest 25 388
% stack exec zenn-vulkan-blit-exe funenohito.png funenohito-linear.png linear 25 388