🦥

HaskellからGPUを使う - 「結果をウィンドウに表示」の前に

2025/02/12に公開

Haskell

GPU

Vulkan

tech

はじめに

この記事は以下の記事の続編だ。リファクタリングの回で新しいことはできないので、面白味はないかもしれない。

前回の記事ではコンピュートシェーダーを使って、GPUに双三次補間による画像の拡大処理をさせた。ファイルから読み込み、ファイルに書き込む形で実装した。次にしようと思うのは、ファイルに書き込むだけではなく、ウィンドウにその画像を表示させることだ。ウィンドウに表示させることで、パラメータをリアルタイムに変えていくことができる。ただ、そろそろソースコードが乱雑になってきたのでリファクタリングをする必要がある。今回はリファクタリングを行い、「結果をウィンドウに表示」するのは次回とする。今回の記事で出来上がるコードは以下に置いておいた。

リファクタリングは次の3段階でやっていくことにする。

コードの並べ替え
細かい修正
Vulkanのバージョン1.3で新しく追加された関数を使う

上の2つについては細かい話なのでとばすのも「あり」かと思う。

前回のソースコードを引き続き使う場合
新たにこの回から始める場合
前半のトリビアルなリファクタリングの部分をとばす場合

前回からのソースコードを引き続き使う場合

使うパッケージを最新のものにする。ファイルstack.yamlのsnapshotとextra-depsの内容を修正する。

stack.yaml
...

snapshot: nightly-2025-02-09

...

extra-deps:
  - gpu-vulkan-0.1.0.169
  - gpu-vulkan-middle-0.1.0.74
  - gpu-vulkan-core-0.1.0.21
  - shaderc-0.1.0.7
  - language-spir-v-0.1.0.3

...

コードの並べ替えに進む。

新たにこの回から始める場合

適当なディレクトリに移動してプロジェクトを作成する。

% stack new zenn-vulkan-bicubic-refactoring
% cd zenn-vulkan-bicubic-refactoring

使用するパッケージのバージョンなどを指定する。

stack.yaml
...

snapshot: nightly-2025-02-09

...

extra-deps:
  - gpu-vulkan-0.1.0.169
  - gpu-vulkan-middle-0.1.0.74
  - gpu-vulkan-core-0.1.0.21
  - shaderc-0.1.0.7
  - language-spir-v-0.1.0.3

...

直接使用するパッケージ名とシェーダーのファイルパスを指定する。

package.yaml
...

dependencies:
- base >= 4.7 && < 5
- array
- bytestring
- data-default
- JuicyPixels
- gpu-vulkan
- shaderc
- language-spir-v
- hetero-parameter-list
- tools-yj
- typelevel-tools-yj

...

library:
  source-dirs: src

data-files:
  - shader/expandWidth.comp
  - shader/expandHeight.comp
  - shader/interpolate.comp

...

ソースコードapp/Main.hsとシェーダーをダウンロードしてコピーする。

% cp DOWNLOAD/Main.hs app/Main.hs
% mkdir shader
% cp DOWNLOAD/expandWidth.comp shader/
% cp DOWNLOAD/expandHeight.comp shader/
% cp DOWNLOAD/interpolate.comp shader/

import文を1行修正する。

app/Main.hs
...
import Gpu.Vulkan.PushConstant qualified as Vk.PshCnst

import Paths_zenn_vulkan_bicubic_refactoring

-- DATA TYPE IMAGE RGBA8

...

ビルドを試してみる。テスト用の画像ファイルをダウンロードして置いておく。

% stack build
% cp DOWNLOAD/funenohito.png ./
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388

コードの並べ替えに進む。

前半のトリビアルなリファクタリングの部分をとばす場合

新たにこの回から始める場合の手順を実行するがapp/Main.hsだけ以下のものを使う。

% cp DOWNLOAD/Main.hs app/Main.hs

Vulkanのバージョン1.3で新しく追加された関数を使うに進む。

コードの並べ替え

Control.Arrowは使ってないのでimport文を削除する。

app/Main.hs
...

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
import Data.TypeLevel.Tuple.Uncurry
import Data.TypeLevel.Maybe qualified as TMaybe
...

import Paths_zenn_vulkan_...をパッケージ名に合わせて修正する。例ではPaths_zenn_vulkan_bicubic_refactoringとしてある。

...
import Gpu.Vulkan.PipelineLayout qualified as Vk.PplLyt
import Gpu.Vulkan.PushConstant qualified as Vk.PshCnst

import Paths_zenn_vulkan_bicubic_refactoring

-- DATA TYPE IMAGE RGBA8

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

...

コードが長くなってきたとき、僕はコードのimport文の後に目次を置くことにしている。

app/Main.hs
...
import Gpu.Vulkan.PipelineLayout qualified as Vk.PplLyt
import Gpu.Vulkan.PushConstant qualified as Vk.PshCnst

import Paths_zenn_vulkan_bicubic_refactoring

---------------------------------------------------------------------------
--
-- * DATA TYPE IMAGE RGBA8
-- * MAIN
-- * BUFFER AND IMAGE
-- * COMMAND BUFFER
-- * COMMANDS
-- * PIPELINE AND DESCRIPTOR SET
--
---------------------------------------------------------------------------

-- DATA TYPE IMAGE RGBA8

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

...

関数resultBffrの定義を関数bodyの定義の後ろに移動する。コメント-- RESULT BUFFERは削除する。

app/Main.hs
...
lx = fromIntegral $ i `mod` n
iy = fromIntegral $ i `div` n
x `div'` y = case x `divMod` y of (d, 0) -> d; (d, _) -> d + 1

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

type PshCnsts = '[Filter, Float, Word32, Word32, Word32]

...

型PshCnstsの定義とVk.DscStLyt.Binding型の値strImgBindingを関数imgVwInfoの定義の後に移動する。またコメントのBUFFERをBUFFER AND IMAGEにする。

app/Main.hs
...
	Vk.Img.subresourceRangeBaseArrayLayer = 0,
	Vk.Img.subresourceRangeLayerCount = Vk.remainingArrayLayers } }

type PshCnsts = '[Filter, Float, Word32, Word32, Word32]

strImgBinding :: Vk.DscStLyt.Binding ('Vk.DscStLyt.Image iargs)
	Vk.DscStLyt.bindingImageDescriptorType = Vk.Dsc.TypeStorageImage,
	Vk.DscStLyt.bindingImageStageFlags = Vk.ShaderStageComputeBit }

-- BUFFER AND IMAGE

bffrInfo :: Vk.Obj.Length o ->
...

関数createBffrImgとcreateBffrとfindMmTypeの定義を関数bffrInfoの前に移動させる。

app/Main.hs
...

-- BUFFER AND IMAGE

createBffrImg :: forall img sd bnm nm a . Vk.ObjB.IsImage img =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Bffr.UsageFlags ->
	...

createBffr :: forall sd bnm o a . Vk.Obj.SizeAlignment o =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Obj.Length o ->
	...

findMmType ::
	Vk.Phd.P -> Vk.Mm.TypeVBits -> Vk.Mm.PropertyFlags -> IO Vk.Mm.TypeIndex
findMmType pd tbs prs =
	fromMaybe (error msg) . suit <$> Vk.Phd.getMemoryProperties pd
	...

bffrInfo :: Vk.Obj.Length o ->
	Vk.Bffr.UsageFlags -> Vk.Bffr.CreateInfo 'Nothing '[o]
bffrInfo ln us = Vk.Bffr.CreateInfo {
	Vk.Bffr.createInfoNext = TMaybe.N,
	...

関数prepareImgの下のコメントのCOMMANDSをCOMMAND BUFFERに修正する。

app/Main.hs
	...
	minfo mt = Vk.Mm.AllocateInfo {
		Vk.Mm.allocateInfoNext = TMaybe.N,
		Vk.Mm.allocateInfoMemoryTypeIndex = mt }

-- COMMAND BUFFER

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とcopyBffrToImgとの2つの定義のあいだにコメント-- COMMANDSを置く。

app/Main.hs

		...
		Vk.submitInfoCommandBuffers = HPList.Singleton cb,
		Vk.submitInfoSignalSemaphores = HPList.Nil }

-- COMMANDS

copyBffrToImg :: forall scb smb sbb bnm img imgnm smi si inm .
	Storable (Vk.ObjB.ImagePixel img) => Vk.CBffr.C scb ->
	...

関数copyImgToBffrの定義の下にコメント-- PIPELINE AND DESCRIPTOR SETを置く。

app/Main.hs
			...
			Vk.Bffr.imageCopyImageOffset = Vk.Offset3d 0 0 0,
			Vk.Bffr.imageCopyImageExtent = Vk.Extent3d w h 1 }

-- PIPELINE AND DESCRIPTOR SET

createCmdPpl :: forall pctps pcrng sd bds a . (
	Vk.PshCnst.RangeListToMiddle pctps prng,
	...

関数createCmpPplとcreatePplLytの定義を関数createDscStLytの上に移動させる。

app/Main.hs
...

-- PIPELINE AND DESCRIPTOR SET

createCmpPpl :: forall pctps scrng sd bds a . (
	Vk.PshCnst.RangeListToMiddle pctps prng,
	...

createPplLyt :: forall pctps pcrng sd a bds . (
	Vk.DscStLyt.BindingListToMiddle bds,
	...

createDscStLyt :: Vk.DscStLyt.BindingListToMiddle bts =>
	Vk.Dvc.D sd -> HPList.PL Vk.DscStLyt.Binding bts ->
	...

関数createDscStSrcの定義を関数createDscStの定義の下に移動させる。

app/Main.hs
		...
		Vk.DscSt.allocateInfoDescriptorPool = dp,
		Vk.DscSt.allocateInfoSetLayouts = HPList.Singleton $ U2 dl }

createDscStSrc ::
	Vk.Dvdc.D sd -> Vk.DscPl.P sp ->
	Vk.ImgVw.I "source_image" ShaderFormat sivs ->
	...

これでコードの並び替えができた。説明の都合でボトムアップの順になっていた関数の並びを、見通しのいいトップダウンの順にするなどした。並び替えの結果は次のようになる。

ビルドして試してみよう。

% stack build
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388

細かい修正

ここでは細かい修正をしていく。はじめは本当に細かい修正から。関数createLgDvcの予約語whereの前の改行を消す。

app/Main.hs
...

createLgDvc pd qfi = Vk.Dvc.create pd info nil where
	...

関数bodyの型宣言のIO imgの前に改行を追加する。関数定義の'='の後に改行を追加する。引数nについてはwhere節でn' = fromIntegral nとしていたが、ビューパターンを使って変数の数を節約する。ccb pl (flt :* a :* n :* ix :*で始まる行を修正し、where節のixとiyの定義を修正する。

app/Main.hs
...

body :: forall sd sc img . Vk.ObjB.IsImage img => Vk.Phd.P -> Vk.Dvc.D sd ->
	Vk.Q.Q -> Vk.CmdPl.C sc -> img -> Filter -> Float -> Int32 -> Int32 ->
	IO img
body pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...
	Vk.Cmd.bindPipelineCompute cb Vk.Ppl.BindPointCompute ppl \ccb -> do
		Vk.Cmd.bindDescriptorSetsCompute
			ccb pl (HPList.Singleton $ U2 ds) def
		Vk.Cmd.pushConstantsCompute @'[ 'Vk.T.ShaderStageComputeBit]
			ccb pl (flt :* a :* n :* ix :* iy :* HPList.Nil)
		Vk.Cmd.dispatch ccb (w `div'` 16) (h `div'` 16) 1
	...
	where
	...
	ix, iy :: Word32
	ix = fromIntegral i `mod` n
	iy = fromIntegral i `div` n

変数strImgBindingをstrgImgBindingに修正する。定義を含めて6ヵ所修正する。

app/Main.hs
...
body  pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...

	compileShader "shader/expandWidth.comp" >>= \exws ->
	createCmpPpl @'[] @'[]
		dv (HPList.Singleton strgImgBinding) exws \wdsl wpl wppl ->
	createDscPl dv \wdp -> createDscStSrc dv wdp imgvws' wdsl \wds ->

	compileShader "shader/expendHeight.comp" >>= \exhs ->
	createCmpPpl @'[] @'[]
		dv (HPList.Singleton strgImgBinding( exhs \hdsl hpl hppl ->
	createDscPl dv \hdp -> createDscStSrc dv hdp imgvws' wdsl \hds ->

	compileShader "shader/interpolate.comp" >>= \shdr ->
	createCmpPpl @PshCnsts
		@'[ 'Vk.PshCnst.Range '[ 'Vk.T.ShaderStageComputeBit] PshCnsts]
		dv (strgImgBinding :** strgImgBinding :** HPList.Nil) shdr
		\dsl -pl ppl -> createDscSt dv dp imgvws' imgvwd' dsl \ds ->

	...

strgImgBinding :: Vk.DscStLyt.Binding ('Vk.DscStLyt.Image iargs)
strgImgBinding = Vk.DscStLyt.BindingImage {
	Vk.DscStLyt.bindingImageDescriptorType = Vk.Dsc.TypeStorageImage,
	Vk.DscStLyt.bindingImageStageFlags = Vk.ShaderStageComputeBit }

-- BUFFER AND IMAGE

createBffrImg :: forall img sd bnm nm a . Vk.ObjB.IsImage img =>
	...

関数copyImgToImgを修正し関数copyImgToImg'を削除する。

app/Main.hs
...

copyImgToImg :: Vk.CBffr.C scb ->
	Vk.Img.Binded sms sis nms fmts -> Vk.Img.Binded smd sid nmd fmtd ->
	Int32 -> Int32 -> Int32 -> Int32 -> IO ()
copyImgToImg cb si di w h dl dt = Vk.Cmd.blitImage cb
	si Vk.Img.LayoutTransferSrcOptimal
	di Vk.Img_LayoutTransferDstOptimal [blt] Vk.FilterNearest
	where blt = Vk.Img.Blit {
		Vk.Img.blitSrcSubresource = colorLayer0
		Vk.Img.blitSrcOffsetFrom = Vk.Offset3d 0 0 0,
		Vk.Img.blitSrcOffsetTo = Vk.Offset3d w h 1,
		Vk.Img.blitDstOffsetFrom = Vk.Offset3d dl dt 0,
		Vk.Img.blitDstOffsetTo = Vk.Offset3d (w + dl) (h + dt) 1 }

...

関数copyImgToImgとcopyImgToImg'とを使っている部分を修正する。

app/Main.hs
...
body pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...

	runCmds dv gq cp \cb -> do
	tr cb imgs Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
	...
	tr cb imgs' Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
	copyImgToImg cb imgs imgs' w h 1 1
	tr cb imgs' Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutGeneral
	...

	tr cb imgd Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
	copyImgToImg cb imgd' imgd w h 0 0
	tr cb imgd
		Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutTransferSrcOptimal
	...

関数runCmdsのなかでコマンドバッファーの割り当てをしていたが、次回の更新では1つのコマンドバッファーを複数回使うのでコマンドバッファーの割り当てを分けたほうがいい。関数runCmdsの定義を修正する。

app/Main.hs
...

-- COMMAND BUFFER

allocateCmdBffr :: forall sd scp a .
	Vk.Dvc.D sd -> Vk.CmdPl.C scp ->
	(forall scb . Vk.CBffr.C scb -> IO a) -> IO a
allocateCmdBffr dv cp f = Vk.CBffr.allocateCs dv info \(b :*. HPList.Nil) -> f b
	where
	info :: Vk.CBffr.AllocateInfo 'Nothing scp '[ '()]
	info = Vk.CBffr.AllocateInfo {
		Vk.CBffr.allocateInfoNext = TMaybe.N,
		Vk.CBffr.allocateInfoCommandPool = cp,
		Vk.CBffr.allocaetInfoLevel = Vk.CBffr.LevelPrimary }

runCmds :: forall scb a . Vk.Q.Q -> Vk.CBffr.C scb -> IO a -> IO a
runCmds gq cb cmds =
	Vk.CBffr.begin @_ @'Nothing cb binfo cmds <* do
	Vk.Q.submit gq (HPList.Singleton $ U4 sinfo) Nothing
	Vk.Q.waitIdle gq
	where
	binfo = Vk.CBffr.BeginInfo {
		Vk.CBffr.beginInfoNext = TMaybe.N,
		Vk.CBffr.beginInfoFlags = Vk.CBffr.UsageOneTimeSubmitBit,
		Vk.CBffr.beginInfoInheritanceInfo = Nothing }
	sinfo = Vk.SubmitInfo {
		Vk.submitInfoNext = TMaybe.N,
		Vk.submitInfoWaitSemaphoreDstStageMasks = HPList.Nil,
		Vk.submitInfoCommandBuffers = HPList.Singleton cb,
		Vk.submitInfoSignalSemaphores = HPList.NiL }

-- COMMANDS

...

関数runCmdsを使っている場所を修正する。allocateCmdBffrの行を追加しrunCmdsの行を修正する。それ以降の行はインデントを増やし、さらに1行80文字にするために適宜改行を入れている。

app/Main.hs
...
body pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...
	createDscPl dv \dp -> createDscSt dv dp imgvws' imgvwd' dsl \ds ->

	allocateCmdBffr dv cp \cb ->
	runCmds gq cb do
		tr cb imgs
			Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
		copyBffrToImg cb b imgs
		tr cb imgs
			Vk.Img.LayoutTransferDstOptimal
			Vk.Img.LayoutTransferSrcOptimal
		tr cb imgs'
			Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
		copyImgToImg cb imgs imgs' w h 1 1
		tr cb imgs' Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutGeneral
		tr cb imgd' Vk.Img.LayoutUndefined Vk.Img.LayoutGeneral
		Vk.Cmd.bindPipelineCompute
				cb Vk.Ppl.BindPointCompute wppl \ccb -> do
			Vk.Cmd.bindDescriptorSetCompute
				ccb wpl (HPList.Singleton $ U2 wds) def
			Vk.Cmd.dispatch ccb 1 (h + 2) `div'` 16) 1
		Vk.Cmd.bindPipelineCompute
				cb Vk.Ppl.BindPointCompute hppl \ccb -> do
			Vk.Cmd.bindDescriptorSetCompute
				ccb hpl (HPList.Singleton $ U2 hds) def
			Vk.Cmd.dispatch ccb ((w + 2) `div'` 16) 1 1
		Vk.Cmd.bindPipelineCompute
				cb Vk.Ppl.BindPointCompute ppl \ccb -> do
			Vk.Cmd.bindDescriptorSetsCompute
				ccb pl (HPList.Singleton $ U2 ds) def
			Vk.Cmd.pushConstantsCompute
				@'[ 'Vk.T.ShaderStageCoputeBit]
				ccb pl (flt :* a :* n :* ix :* iy :* HPList.Nil)
			Vk.Cmd.dispatch ccb (w `div'` 16) (h `div'` 16) 1
		tr cb imgd' Vk.Img.LayoutGeneral Vk.Img.LayoutTransferSrcOptimal
		tr cb imgd
			Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
		copyImgToImg cb imgd' imgd w h 0 0
		tr cb imgd
			Vk.Img.LayoutTransferDstOptimal
			Vk.Img.LayoutTransferSrcOptimal
		copyImgToBffr cb imgd rb
	where
	...

関数div'を関数bodyのwhere節からトップレベルに移動させる。関数bodyのwhere節から関数divの定義を消しファイルの末尾に追加する。

app/Main.hs
...
body pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...
		tr cb imgd
			Vk.Img.LayoutTransferDstOptimal
			Vk.Img.LayoutTransferSrcOptimal
		copyImgToBffr cb imgd rb
	where
	trsd = Vk.Img.UsageTransferSrcBit .|. Vk.Img.UsageTransferDstBit
	...
	ix = fromIntegral i `mod` n
	iy = fromIntegral i `div` n

...

-- TOOLS

div' :: Integral n => n -> n -> n
x `div'` y = case x `divMod` y of (d, 0) -> d; (d, _) -> d + 1

関数resultBffrの演算子(<$>)の位置を変える。これは「なんとなく」だ。

app/Main.hs
...
resultBffr pd dv w h f = head <$>
	createBffrImg pd dv Vk.Bffr.UsageTransferDstBit w h
		\(b :: Vk.Bffr.Binded sm sb nm '[o]) m ->
	...

関数imgVwInfoの型変数ivfmtをvfmtにする。またフィールドcreateInfoNextとcreateInfoFlagsの定義のあいだの改行をなくす。

app/Main.hs
...

imgVwInfo :: Vk.Img.Binded sm si nm ifmt ->
	Vk.ImgVw.CreateInfo 'Nothing sm si nm ifmt vfmt
imgVwInfo i = Vk.ImgVw.CreateInfo {
	Vk.ImgVw.createInfoNext = TMaybe.N, Vk.ImgVw.createInfoFlags = zeroBits,
	Vk.ImgVw.createInfoImage = i,
	...

関数createBffrImgの型宣言のsb,の後の改行をなくす。

app/Main.hs
...

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
...

関数bffrInfoの定義の要素createInfoNextの定義のあとの改行をなくす。

app/Main.hs
...
bffrInfo ln us = Vk.Bffr.CreateInfo {
	Vk.Bffr.createInfoNext = TMaybe.N, Vk.Bffr.createInfoFlags = zeroBits,
	Vk.Bffr.createInfoLengths = HPList.Singleton ln,
	...

関数prepareImgの型宣言のforall si smの型変数siとsmの順番を修正する。引数usgをusにする。

app/Main.hs
...

prepareImg :: forall fmt sd nm a . Vk.T.FormatToValue fmt =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Img.UsageFlags -> Word32 -> Word32 ->
	(forall sm si . Vk.Img.Binded sm si nm fmt -> IO a) -> IO a
prepareImg pd dv us w h f = Vk.Img.create @'Nothing dv iinfo nil \i -> do
	rqs <- Vk.Img.getMemoryRequirements dv i
	...
	where
	iinfo = Vk.Img.CreateInfo {
		Vk.Img.createInfoNext = TMaybe.N,
		...
		Vk.Img.createInfoTiling = Vk.Img.TilingOptimal,
		Vk.Img.createInfoUsage = us,
		Vk.Img.createInfoSharingMode = Vk.SharingModeExclusive,
		...

関数transitionImgLytのwhere節のsrrの定義を修正する。フィールドsubresourceRangeLevelCountとsubresourceRangeLayerCountを1から、それぞれVk.remainingMipLevelsとVk.remainingArrayLayersにする。これは、「1枚」を指定していたのを「残り全て」を指定するようにしたということで、そもそも1枚しか用意しないので同じことだけど、なんとなく「残り全て」にしてみた。

app/Main.hs
...
transitionImgLyt cb i ol nl =
	Vk.Cmd.pipelineBarrier cb srcst dstst zeroBits
		HPList.Nil HPList.NIl . HPList.Singleton $ U5 brrr
	where
	brrr = Vk.Img.MemoryBarrier {
		Vk.Img.memoryBarrierNext = TMaybe.N,
		...
	srr = Vk.Img.SubresourceRange {
		Vk.Img.subresourceRangeAspectMask = Vk.Img.AspectColorBit,
		Vk.Img.subresourceRangeBaseMipLievel = 0,
		Vk.Img.subresourceRangeLevelCount = Vk.remainingMipLevels,
		Vk.Img.subresourceRangeBaseArrayLayer = 0,
		Vk.Img.subresourceRangeLayerCount = Vk.remainingArrayLayers }
	(srcst, dstst, srcam, dstam) = case (ol, nl) of
		(Vk.Img.LayoutUndefined, Vk.Img.LayoutTransferDstOptimal) -> (
		...

関数copyImgToBffrの定義の部分の改行の位置を変える。

app/Main.hs
...
copyImgToBffr cb i b@(bffrImgExtent -> (w, h)) =
	Vk.Cmd.copyImageToBuffer
		@1 @img @'[imgnm] cb i Vk.Img.LayoutTransferSrcOptimal b
		...

関数createCmpPplの型変数pctpsをpctsに修正する。また型宣言の中の改行を2つ消す。where節の関数infoの型宣言を消す。

app/Main.hs
...

-- PIPELINE AND DESCRIPTOR SET

createCmpPpl :: forall pcts pcrng sd bds a . (
	Vk.PshCnst.RangeListToMiddle pcts pcrng,
	Vk.DscStLyt.BindingListToMiddle bds ) =>
	Vk.Dvc.D sd -> HPList.PL Vk.DscStLyt.Binding bds ->
	SpirV.S GlslComputeShader -> (forall sds scppl spl .
		Vk.DscStLyt.D sds bds -> Vk.PplLyt.P spl '[ '(sds, bds)] pcts ->
		Vk.Ppl.Cp.C scppl '(spl, '[ '(sds, bds)], pcts) -> IO a) -> IO a
createCmpPpl d bds shdr f =
	createPplLyt @pcts @p[crng d bds \dsl pl ->
	Vk.Ppl.Cp.createCs d Nothing (HPList.Singletion . U4 $ info pl) nil
		\(HPList.Singleton p) -> f dsl pl p
	where
	info pl = Vk.Ppl.Cp.CreateInfo {
		Vk.Ppl.Cp.createInfoNext = TMaybe.N,
		...

関数createPplLytの型変数pctpsをpctsに修正する。where節の関数infoの型宣言の改行の位置を変える。

app/Main.hs
...

createPplLyt :: forall pcts pcrng sd a bds . (
	Vk.DscStLyt.BindingListToMiddle bds,
	Vk.PshCnst.RangeListToMiddle pcts pcrng ) =>
	Vk.Dvc.D sd -> HPList.PL Vk.DscStLyt.Binding bds -> (forall sl sdsl .
		Vk.DscStLyt.D sdsl bds ->
		Vk.PplLyt.P sl '[ '(sdsl, bds)] pcts -> IO a) -> IO a
createPplLyt dv bds f = createDscStLyt dv bds \dsl ->
	Vk.PplLyt.create dv (info dsl) nil $ f dsl
	where
	info :: Vk.DscStLyt.D sdsl bds -> Vk.PplLyt.CreateInfo 'Nothing
		'[ '(sdsl, bds)] ('Vk.PshCnst.Layout pcts pcrng)
	info dsl = Vk.PplLyt.CreateInfo {
		Vk.PplLyt.createInfoNext = TMaybe.N,
		Vk.PplLyt.createInfoFlags = zeroBits,
		Vk.PplLyt.createInfoSetLayouts = HPList.Singleton $ U2 dsl }

...

型シノニムSrcImgNmとDstImgNmとを定義し"source_image"と"destination_image"とを置き換える。

app/Main.hs
...

createDscSt ::
	Vk.Dvc.D sd -> Vk.DscPl.P sdp ->
	Vk.ImgVw.I SrcImgNm ShaderFormat sivs ->
	Vk.ImgVw.I DstImgNm ShaderFormat sivd ->
	Vk.DscStLyt.D sdsl '[SrcImg, DstImg] ->
	...

createDscStSrc ::
	Vk.Dvc.D sd -> Vk.DscPl.P sp ->
	Vk.ImgVw.I SrcImgNm ShaderFormat sivs ->
	Vk.DscStLyt.D sdsl '[SrcImg] ->
	...

type SrcImg = 'Vk.DscStLyt.Image '[ '(SrcImgName, ShaderFormat))]
type DstImg = 'Vk.DscStLyt.Image '[ '(DstImgName, ShaderFormat))]
type SrcImgNm = "source_image"; type DstImgNm = "destination_image"

...

関数createDscStの引数svwとdvwをそれぞれvsとvdに修正する。また、定義の改行の位置を修正する。

app/Main.hs
...
createDscSt dv dp vs vd dl a =
	Vk.DscSt.allocateDs dv info \(HPList.Singleton ds) ->
	(>> a ds) $ Vk.DscSt.updateDs
		dv (U5 (dscWrite ds vs) :** U5 (dscWrite ds vd) :** HPList.NIl)
		HPList.Nil
	where info = Vk.DscSt.AllocateInfo {
		Vk.DscSt.allocateInfoNext = TMaybe.N,
		...

型宣言の改行をひとつ削除する。関数createDscStSrcの引数svwをvsに修正する。定義の改行の位置を修正する。

app/Main.hs
...

createDscStSrc ::
	Vk.Dsc.D sd -> Vk.DscPl.P sp -> Vk.ImgVw.I SrcImgNm ShaderFormat sivs ->
	Vk.DscStLyt.D sdsl '[SrcImg] ->
        (forall sds . Vk.DscSt.D sds '(sdsl, '[SrcImg]) -> IO a) -> IO a
createDscStSrc dv dp vs dl a =
	Vk.DscSt.allocateDs dv info \(HPList.Singleton ds) ->
	(>> a ds) $ Vk.DscSt.updateDs
		dv (HPList.Singleton . U5 $ dscWrite ds vs) HPList.Nil
	where info = Vk.DscSt.AllocateInfo {
		Vk.DscSt.allocateInfoNext = TMaybe.N,
		...

ビルドして試してみる。

% stack build
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388

Vulkanのバージョン1.3で新しく追加された関数を使う

リファクタリングの一環として、Vulkanのバージョン1.3で新しく追加された以下の関数を使うようにコードを修正する。

vkCmdBlitImage2
vkCmdPipelineBarrier2
vkQueueSubmit2

vkCmdBlitImage2

「この命令は機能的にはvkCmdBlitImageと同じだけど、sTypeとpNextというパラメーターを持つ拡張可能な下部構造を持ち、より簡単に拡張できるようになっている」とのこと。ばらばらに指定していた引数がVkBlitImageInfo2という構造体にまとめられて、でその構造体は「Vulkanでよく出てくる拡張しやすい形式」になっているということ。

Gpu.Vulkan.Cmd.blitImage2は簡潔に書くと次のような型になっている。

blitImage2 ::
	Vk.CmdBffr.C scb ->
	Vk.BlitImageInfo2 mn sms sis nms fmts smd sid nmd fmtd ras -> IO ()

引数としてコマンドバッファーとVk.BlitImageInfo2型の値を取る。

BlitImageInfo2 mn sms sis nms fmts smd sid nmd fmtd ras = BlitImageInfo2 {
	blitImageInfo2Next :: M mn,
	blitImageInfo2SrcImage :: Vk.Img.Binded sms sis nms fmts,
	blitImageInfo2SrcImageLayout :: Vk.Img.Layout,
	blitImageInfo2DstImage :: Vk.Img.Binded smd sid nmd fmtd,
	blitImageInfo2DstImageLayout :: Vk.Img.Layout,
	blitImageInfo2Regions :: HPList.PL Vk.Img.Blit2 ras
	blitImageInfo2Filter :: Vk.Filter }

関数Vk.Cmd.blitImageの引数を構造体にまとめたような形になっている。例題コードの関数copyImgToImgをこれを使って書き換えてみよう。

app/Main.hs
...

copyImgToImg :: Vk.CBffr.C scb ->
	Vk.Img.Binded sms sis nms fmts -> Vk.Img.Binded smd sid nmd fmtd ->
	Int32 -> Int32 -> Int32 -> Int32 -> IO ()
copyImgToImg cb si di w h dl dt = Vk.Cmd.blitImage2 cb info
	where
	info = Vk.BlitImageInfo2 {
		Vk.blitImageInfo2Next = TMaybe.N,
		Vk.blitImageInfo2SrcImage = si
		Vk.blitImageInfo2SrcImageLayout =
			Vk.Img.LayoutTransferSrcOptimal,
		Vk.blitImageInfo2DstImage = di,
		Vk.blitImageInfo2DstImageLayout =
			Vk.Img.LayoutTransferDstOptimal,
		Vk.blitImageInfo2Regions = blt,
		Vk.blitImageInfo2Filter = Vk.FilterNearest }
	blt = HPList.Singleton Vk.Img.Blit2 {
		Vk.Img.blit2Next = TMaybe.N,
		Vk.Img.blit2SrcSubresource = colorLayer0,
		Vk.Img.blit2SrcOffsetFrom = Vk.Offset3d 0 0 0,
		Vk.Img.blit2SrcOffsetTo = Vk.Offset3d w h 1,
		Vk.Img.blit2DstSubresource = colorLayer0,
		Vk.Img.blit2DstOffsetFrom = Vk.Offset3d dl dt 0,
		Vk.Img.blit2DstOffsetTo = Vk.Offset3d (w + dl) (w + dt) 1 }

...

ビルドして試してみる。

% stack build
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388
...
zsh: segmentation fault ...

エラーになってしまった。

関数vkCmdBlitImage2はVulkanのバージョン1.3で導入された。なのでAPIのバージョン1.3を使うことを指定する必要がある。APIのバージョンはインスタンスを作るときのVk.Ist.CreateInfo型の値のフィールドcreateInfoApplicationNameのさらにフィールドapplicationInfoApiVersionで指定する。例題のコードを修正する。Vk.ApplicationInfo型の値のフィールドapplicationInfoApiVersion以外のフィールドには適当な値を指定してある。

app/Main.hs
...

createIst :: (forall si . Vk.Ist.I si -> IO a) -> IO a
createIst = Vk.Ist.create info niol
	where
	info :: Vk.Ist.CreateInfo 'Nothing 'Nothing
	info = def {
		Vk.Ist.createInfoApplicationInfo = Just ainfo,
		Vk.Ist.createInfoEnabledLayerNames = vldLayers }
	ainfo = Vk.ApplicationInfo {
		Vk.applicationInfoNext = TMaybe.N,
		Vk.applicationInfoApplicationName = "BICUBIC INTERPOLATION",
		Vk.applicationInfoApplicationVersion =
			Vk.makeApiVersion 0 1 0 0,
		Vk.applicationInfoEngineName = "No Engine",
                Vk.applicationInfoEngineVersion = Vk.makeApiVersion 0 1 0 0,
		Vk.applicationInfoApiVersion = Vk.apiVersion_1_3 }
...

ビルドして試してみる。

% stack build
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388

vkCmdPipelineBarrier2

vkCmdPipelineBarrier2はここではイメージのレイアウトの変換に使っているが、この関数の主な機能はメモリーに関する依存関係を指定することだ。Vulkanではキューに提出された複数の命令は提出ごとに並行して実行される。そのとき、提出された複数の命令のなかのうち、特定のメモリーに対する命令については、その順番を守ってほしいときがある。たとえば、「そのメモリーに対する書き込みが終わってから、読み込みをしてほしい」などだ。このようなときに、「指定したメモリーに関する、指定した種類の命令について、vkCmdPipelineBarrier2の実行をまたがないようにする」という形で順番を守らせることができる。

pipelineBarrier2 ::
	Vk.CmdBffr.C scb -> Vk.DependencyInfo mn mbas bmbas imbas -> IO ()

data Vk.DependencyInfo mn mbas bmbas imbas = Vk.DependencyInfo {
	dependencyInfoNext :: TMaybe.M mn,
	dependencyInfoDependencyFlags :: DependencyFlags,
	dependencyInfoMemoryBarriers :: HPList.PL Vk.Mm.Barrier2 mbas,
	dependencyInfoBufferMemoryBarriers ::
		HPList.PL (U5 Vk.Bffr.MemoryBarrier2) bmbas,
	dependencyInfoImageMemoryBarriers ::
		HPList.PL (U5 Vk.Img.MemoryBarrier2) imbas }

実際のバリアを指定するフィールドにdependencyInfoMemoryBarriersとdependencyInfoBufferMemoryBarriersとdependencyInfoImageMemoryBarriersとがあるが、ここでは3番目のものしか使わないので、それだけを見ておこう。

data Vk.Img.MemoryBarrier2 mn sm si nm fmt = Vk.Img.MemoryBarrier2 {
	memoryBarrier2Next :: TMaybe.M mn,
	memoryBarrier2SrcStageMask :: Vk.Ppl.StageFlags2,
	memoryBarrier2SrcAccessMask :: Vk.AccessMask,
	memoryBarrier2DstStageMawsk :: Vk.Ppl.StageFlags2,
	memoryBarrier2DstAccessMask :: Vk.AccessMask,
	memoryBarrier2OldLayout :: Vk.Img.Layout,
	memoryBarrier2NewLayout :: Vk.Img.Layout,
	memoryBarrier2SrcQueueFamilyIndex :: Vk.QFam.Index,
	memoryBarrier2DstQueueFamilyIndex :: Vk.QFam.Index,
	memoryBarrier2Image :: Vk.Img.Binded sm si nm fmt,
	memoryBarrier2SubresourceRange :: Vk.Img.SubresourceRange }

`memoryBarrier2SrcStageMask`

先に提出された命令について、パイプラインのどの段階が対象になるかを指定する。

`memoryBarrier2SrcAccessMask`

先に提出された命令について、メモリへのどういったアクセスの仕方が対象になるかを指定する。

`memoryBarrier2DstStageMask`

後に提出された命令について、パイプラインのどの段階が対象になるかを指定する。

`memoryBarrier2DstAccessMsak`

後に提出された命令について、メモリへのどういったアクセスの仕方が対象になるかを指定する。

`memoryBarrier2OldLayout`

変換前のイメージのレイアウト。

`memoryBarrier2NewLayout`

変換後のイメージのレイアウト。

`memoryBarrier2SrcQueueFamilyIndex`

メモリーの持ち主を変える場合に指定する変更前のキューファミリー。

`memoryBarrier2DstQueueFamilyIndex`

メモリーの持ち主を変える場合に指定する変更後のキューファミリー。

`memoryBarrier2Image`

このバリアの対象になるイメージ。

`memoryBarrier2SubresourceRange`

イメージのなかで、このバリアの対象になる範囲。

例題のコード

関数transitionImgLytを書き換える。

app/Main.hs
...

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.pipelineBarrier2 cb dinfo
	where
	dinfo = Vk.DependencyInfo {
		Vk.dependencyInfoNext = TMaybe.N,
		Vk.dependencyInfoDependencyFlags = zeroBits,
		Vk.dependencyInfoMemoryBarriers = HPList.NIl,
		Vk.dependencyInfoBufferMemoryBarriers = HPList.Nil,
		Vk.dependencyInfoImageMemoryBarriers =
			HPList.Singleton $ U5 ibrrr }
	ibrrr = Vk.Img.MemoryBarrier2 {
		Vk.Img.memoryBarrier2Next = TMaybe.N,
		Vk.Img.memoryBarrier2SrcStageMask = Vk.Ppl.Stage2AllCommandsBit,
		Vk.Img.memoryBarrier2SrcAccessMask = Vk.Access2MemoryWriteBit,
		Vk.Img.memoryBarrier2DstStageMask = Vk.Ppl.Stage2AllCommandsBit,
		Vk.Img.memoryBarrier2DstAccessMask =
			Vk.Access2MemoryWriteBit .|. Vk.Access2MemoryReadBit,
		Vk.Img.memoryBarrier2OldLayout = ol,
		Vk.Img.memoryBarrier2NewLayout = nl,
		Vk.Img.memoryBarrier2SrcQueueFamilyIndex = Vk.QFam.Ignored,
		Vk.Img.memoryBarrier2DstQueueFamilyIndex = Vk.QFam.Ignored,
		Vk.Img.memoryBarrier2Image = i,
		Vk.Img.memoryBarrier2SubresourceRange = isr }
	isr = Vk.Img.SubresourceRange {
		Vk.Img.subresourceRangeAspectMask = Vk.Img.AspectColorBit,
		Vk.Img.subresourceRangeBaseMipLevel = 0,
		Vk.Img.subresourceRangeLevelCount = Vk.remainingMipLevels,
		Vk.Img.subresourceRangeBaseArrayLayer = 0,
		Vk.Img.subresourceRangeLayerCount = Vk.remainingArrayLayers }

...

ビルドして試してみる。

% stack build
% cp DOWNLOAD/funenohito.png ./
% stack exec -- zenn-vulkan-bicibuc-refactoring-exe funenohito.png funenohito-cubic.png cubic -0.5 25 388
...
The Vulkan spec states: The synchronization2 feature must be enabled (https://www....)
    Objects: 1
        [0] 0x1db6c40, type: 6, name: NULL
VUID-vkCmdPipelineBarrier2-synchronization2-03848(ERROR / SPEC): msgNum:
168166404 - Validation Error:
[ VUID-vkCmdPipelineBarrier2-synchronization2-03848 ] Object 0:
handle = 0x1db6c40, type = VK_OBJECT_TYPE_COMMAND_BUFFER;
| MessageID = 0xa060404 | vkCmdPipelineBarrier2():
the synchronization2 feature was not enabled.
The Vulkan spec states: The synchronization2 feature must be enabled (https://www....)
    Objects: 1
        [0] 0x1db6c40, type: 6, name: NULL

「synchronization2 featureが無効になっている」という警告が出る。これを有効にする必要がある。関数createLgDvcを書き換える。Vk.Dvc.CreateInfo型の値のフィールドcreateInfoNextにVulkan13Features型の値を指定し、そのフィールドvulkan13FeaturesSynchronization2の値をTrueにする。

...

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.J (Vk.Phd.vulkan13FeaturesZero TMaybe.N) {
				Vk.Phd.vulkan13FeaturesSynchronization2 = True
				},
		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] }

...

vkQueueSubmit2

関数vkQueueSubmit2では引数としてVkSubmitInfo2型の値を使う。VkSubmitInfo型の値ではフィールドとして直接にセマフォやコマンドバッファを持つ形だったが、VkSubmitInfo2では、それぞれVkSemaphoreSubmitInfoやVkCommandBufferSubmitInfo型の値がフィールドの値になっている。機能拡張に対応できるようになっている。

data Vk.SubmitInfo2 mn wsas cbas ssas = Vk.SubmitInfo2 {
	submitInfo2Next :: TMaybe.M mn,
	submitInfo2Flags :: Vk.SubmitFlags,
	submitInfo2WaitSemaphoreInfos :: HPList.PL (U2 Vk.Smph.SubmitInfo) wsas,
	submitInfo2CommandBufferInfos ::
		HPList.PL (U2 Vk.CmdBffr.SubmitInfo) cbas,
	submitInfo2SignalSemaphoreInfos ::
		HPList.PL (U2 Vk.Smph.SubmitInfo) ssas }
	}

`submitInfo2WaitSemaphoreInfos`

フィールドsubmitInfo2WaitSemaphoreInfosには命令実行の前に待つセマフォを指定する。

data Vk.Smph.SubmitInfo mn ss = Vk.Smph.SubmitInfo {
	submitInfoNext :: TMaybe.M mn,
	submitInfoSemaphore :: Vk.Smph.S ss,
	submitInfoValue :: Word64,
	submitInfoStageMask :: Vk.Ppl.StageFlags2,
	submitInfoDeviceIndex :: Vk.GDvc.Index }

フィールドsubmitInfoSemaphoreでは使用するセマフォを指定する。submitInfoStageMaskでは待ったり、シグナルを出したりするパイプライン上での段階を指定する。submitInfoValueはtimeline semaphoreという種類のセマフォを使う場合に意味のある値だ。submitInfoDeviceIndexはdevice groupという機能を利用するときに意味のある値だ。

`submitInfo2CommandBufferInfos`

data Vk.CmdBffr.SubmitInfo mn sc = Vk.CmdBffr.SubmitInfo {
	submitInfoNext :: TMaybe.M mn,
	submitInfoCommandBuffer :: Vk.CmdBffr.C sc,
	submitInfoDeviceMask :: Vk.Dvc.GrpDvc.Mask }

フィールドsubmitInfoCommandBufferで使用するコマンドバッファーを指定する。submitInfoDeviceMaskではデバイスグループのなかで使用するデバイスを指定する。今回はデバイスグループは使わない。

`submitInfo2SignalSemaphoreInfos`

フィールドsubmitInfo2WaitSemahoreInfoと同様。

例題のコード

インポート文を1行追加する。

app/Main.hs
...
import Gpu.Vulkan.PushConstant qualified as Vk.PshCnst

import Gpu.Vulkan.Semaphore qualified as Vk.Smph

import Paths_zenn_vulkan_bicubic_refactoring

---------------------------------------------------------------------------
--
-- * DATA TYPE IMAGE RGBA8
...

関数runCmdsを書き換える。

app/Main.hs
...

runCmds :: forall scb wss sss a . (
	Vk.Smph.SubmitInfoListToMiddle wss,
	Vk.Smph.SubmitInfoListToMiddle sss ) =>
	Vk.Q.Q -> Vk.CBffr.C scb ->
	HPList.PL (U2 Vk.Smph.SubmitInfo) wss ->
	HPList.PL (U2 Vk.Smph.SubmitInfo) sss -> IO a -> IO a
runCmds gq cb wss sss cmds =
	Vk.CBffr.begin @_ @'Nothing cb binfo cmds <* do
	Vk.Q.submit2 gq (HPList.Singleton . U4 $ submitInfo cb wss sss) Nothing
	Vk.Q.waitIdle gq
	where binfo = Vk.CBffr.BeginInfo {
		Vk.CBffr.beginInfoNext = TMaybe.N,
		Vk.CBffr.beginInfoFlags = Vk.CBffr.UsageOneTimeSubmitBit,
		Vk.CBffr.beginInfoInheritanceInfo = Nothing }

submitInfo :: Vk.CBffr.C scb ->
	HPList.PL (U2 Vk.Smph.SubmitInfo) wsas ->
	HPList.PL (U2 Vk.Smph.SubmitInfo) ssas ->
	Vk.SubmitInfo2 'Nothing wsas '[ '( 'Nothing, scb)] ssas
submitInfo cb wsis ssis = Vk.SubmitInfo2 {
	Vk.submitInfo2Next = TMaybe.N, Vk.submitInfo2Flags = zeroBits,
        Vk.submitInfo2WaitSemaphoreInfos = wsis,
        Vk.submitInfo2CommandBufferInfos = HPList.Singleton $ U2 cbi,
        Vk.submitInfo2SignalSemaphoreInfos = ssis }
	where cbi = Vk.CBffr.SubmitInfo {
		Vk.CBffr.submitInfoNext = TMaybe.N,
                Vk.CBffr.submitInfoCommandBuffer = cb,
                Vk.CBffr.submitInfoDeviceMask = def }

...

関数runCmdsを使っているところも書き換える。

app/Main.hs
...
body pd dv gq cp img flt a (fromIntegral -> n) i =
	resultBffr @img pd dv w h \rb ->
	...
	allocateCmdBffr dv cp \cb ->
	runCmds gq cb HPList.Nil HPList.Nil do
		tr cb imgs
			Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimal
		...

まとめ

今回はここまで書いてきたソースコードをリファクタリングして形を整えた。つぎは拡大した画像をウィンドウに表示してみる。補間のアルゴリズムなどをキー入力でリアルタイムに変えられるようにする。

書いた。

Discussion

ログインするとコメントできます