🦥

HaskellからGPUを使う - 最近傍補間と双線形補間とをコンピュートシェーダーで実装する

に公開

はじめに

この記事は12月に書いた次の記事の続編だ。

https://zenn.dev/yoshikuni_jujo/articles/introduction-to-gpu-vulkan

12月に書いた記事ではvkCmdBlitImageを使って画像を拡大してみた。拡大のしかたとして最近傍補間と双線形補間とがあった。それらに加えて双三次補間を使った画像の拡大を試してみたい。それにはコンピュートシェーダーを使う。コンピュートシェーダーを使って双三次補間を実装するのだけど、長くなりすぎるので記事を2つに分けることにした。

双三次補間の実装は次の回にまわして、今回はコンピュートシェーダーで最近傍補間と双線形補間とを実装しなおしてみる。

ここで紹介するソースコードは以下で入手できる。

https://github.com/YoshikuniJujo/test_haskell/tree/master/tribial/zenn/vulkan_nearest_linear/zenn-vulkan-nearest-linear1

シェーダーのコンパイルについて

OpenGLでは人間の読み書きできるGLSLという言語で書かれたシェーダーをAPI側が読み込む形だった。ただ、そのような「人間が読み書きできる形式」を使う場合、ドライバーによって許される構文の範囲が異なってしまい、あるドライバで動くシェーダーが別のドライバでは動かないという問題が生じやすい。そこでVulkanではバイトコード形式であるSPIR-Vという形式でシェーダーを読み込むようになっている。これは人間には読み書きしづらい形式なのでGLSLからSPIR-Vにコンパイルするのが一般的だ。GLSLからSPIR-Vへのコンパイラはパッケージshadercとして用意されている。パッケージshadercにはTemplate Haskellの機能を使ってHaskellのソースコードの一部として書かれたGLSLをHaskellのコンパイル時にコンパイルする機能がある。そのやりかたも含めシェーダーのコンパイルには次の3つのやりかたが考えられる。

  • 事前にコンパイルしてSPIR-Vの形式としたシェーダーを同梱する
  • Haskellのソースコード内にGLSLを記述してHaskellのコンパイル時にコンパイルする
  • GLSL形式で書かれたシェーダーを同梱し実行時にコンパイルする

2番目のやりかたが「調度いい」感じだし、一番「かっこいい」やりかただと思う。けど、どうもWindowsでうまくコンパイルが通らないので、ここでは3番目のやりかたをとる。2番目のかっこいいやりかたは番外編として別記事にしようと思う。

yamlファイルを修正する

前回の記事で書いたコードを出発点として、いろいろと修正していく。まずは使用するパッケージを最新のものにしよう。stack.yamlを修正する。

stack.yaml
...
snapshot: nightly-2025-01-21
...
extra-deps:
  - gpu-vulkan-0.1.0.167
  - gpu-vulkan-middle-0.1.0.73
  - gpuv-ulkan-core-0.1.0.20
  - shaderc-0.1.0.6
  - language-spir-v-0.1.0.3
...

package.yamlも修正する。

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/interpolate.comp
...

dependenciesにshadercとlanguage-spir-vを追加し、data-filesフィールドを追加して中身としてshader/interpolat.compを書いておく。ダミーの空ファイルを作成しておこう。コマンドはLinuxでの例だ。それぞれのOSのやりかたでディレクトリshaderを作成し、空ファイルshader/interpolate.compを作っておく。

% mkdir shader
% touch shader/interpolate.comp

試しにビルドしておく。

% stack build

前回の続きではなく、この記事から始める場合

前回の続きではなく、ここから新たに始めるのであれば、適当なディレクトリで以下のようにして新たな作業ディレクトリを作ろう。

% stack new zenn-vulkan-nearest-linear
% cd zenn-vulkan-nearest-linear

上のほうで書いてあるようにstack.yamlとpackage.yamlを修正する。下記のファイルをダウンロードしてapp/Main.hsに上書きでコピーする。

https://github.com/YoshikuniJujo/test_haskell/blob/master/tribial/zenn/vulkan_blit/zenn-vulkan-blit-v2/app/Main.hs

% cp DOWNLOAD_DIRECTORY/Main.hs app/Main.hs

shaderディレクトリと空ファイルを用意する。

% mkdir shader
% touch shader/interpolate.comp

このようにして作ったディレクトリ構造はつぎのリンクに置いてある。

https://github.com/YoshikuniJujo/test_haskell/tree/master/tribial/zenn/vulkan_nearest_linear/zenn-vulkan-nearest-linear0

試しにビルドしておく。

% stack build

もしinvalid argument (invalid byte sequence)のようなエラーが出た場合、Windowsであれば次のようにして再度試す。

% chcp.com 65001
% stack build

前回までの動作の確認

前回までの内容が動作するか確認する。下のリンクの画像をダウンロードして作業ディレクトリに配置する。

https://raw.githubusercontent.com/YoshikuniJujo/test_haskell/refs/heads/master/files/images/funenohito.png

下記のコマンドを試す。zenn-vulkan-blit-exeは、今回新たに作業ディレクトリを作った場合はzenn-vulkan-nearest-linear-exeに読み替える。

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

適当なビューワーで生成された、それぞれのPNG画像を閲覧して正しい結果になっていることを確認する。

Main.hsのメタ情報を修正する

言語拡張や導入するモジュールの部分を修正する。以下の言語拡張を追加する。

  • OverloadedStrings
  • AllowAmbiguousTypes
  • GeneralizedNewtypeDeriving

以下のモジュールを追加する。

  • Data.ByteString
  • Data.ByteString.Char8
  • Language.SpirV
  • Language.SpirV.ShaderKind
  • Language.SpirV.Shaderc
  • Gpu.Vulkan.ImageView
  • Gpu.Vulkan.Sampler
  • Gpu.Vulkan.Descriptor
  • Gpu.Vulkan.DescriptorPool
  • Gpu.Vulkan.DescriptorSet
  • Gpu.Vulkan.DescriptorSetLayout
  • Gpu.Vulkan.ShaderModule
  • Gpu.Vulkan.Pipeline.Compute
  • Gpu.Vulkan.Pipeline.ShaderStage
  • Gpu.Vulkan.PipelineLayout
  • Gpu.Vulkan.PushConstant
  • Paths_zenn_vulkan_blit
    • 'zenn_vulkan_blit'の部分は指定したパッケージ名で置き換える

モジュールData.HeteroParListから以下の名前を追加で導入する。

  • pattern (:**)
  • pattern (:*)

app/Main.hsの先頭の部分は次のようになる。

app/Main.hs
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications, RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Main (main) where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
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 (:**), pattern (:*), pattern (:*.))
import Data.HeteroParList qualified as HPList
import Data.Array
import Data.Word
import Data.Int
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BSC
import Text.Read
import System.Environment
import Codec.Picture

import Language.SpirV qualified as SpirV
import Language.SpirV.ShaderKind
import Language.SpirV.Shaderc qualified as Shaderc

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.ImageView qualified as Vk.ImgVw
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
import Gpu.Vulkan.Sampler qualified as Vk.Smplr

import Gpu.Vulkan.Descriptor qualified as Vk.Dsc
import Gpu.Vulkan.DescriptorPool qualified as Vk.DscPl
import Gpu.Vulkan.DescriptorSet qualified as Vk.DscSt
import Gpu.Vulkan.DescriptorSetLayout qualified as Vk.DscStLyt
import Gpu.Vulkan.ShaderModule qualified as Vk.ShdrMd

import Gpu.Vulkan.Pipeline.Compute qualified as Vk.Ppl.Cp
import Gpu.Vulkan.Pipeline.ShaderStage qualified as Vk.Ppl.ShdrSt
import Gpu.Vulkan.PipelineLayout qualified as Vk.PplLyt
import Gpu.Vulkan.PushConstant qualified as Vk.PshCnst

import Paths_zenn_vulkan_blit

ビルドを試す。

% stack build

コマンドライン引数の処理

フィルターを選ぶ(つまり最近傍補間か双線形補間かを選ぶ)ための値の型を変える。コンピュートシェーダーであつかいやすいようにする。

app/Main.hs
getFilter :: String -> Maybe Filter
getFilter = \case
	"nearest" -> Just Nearest; "linear" -> Just Linear; _ -> Nothing

newtype Filter = Filter Word32 deriving (Show, Storable)
pattern Nearest, Linear :: Filter
pattern Nearest = Filter 0; pattern Linear = Filter 1

関連する必要な箇所を修正する。関数realMainの型宣言と、関数bodyの型宣言と関数copyImgToImgを使っている部分だ。

app/Main.hs
...
realMain :: ImageRgba8 -> Filter -> Int32 -> Int32 -> IO ImageRgba8
...
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 -> Int32 -> Int32 -> IO img
...
	copyImgToImg cb imgs imgd w h (case flt of
		Nearest -> Vk.FilterNearest; Linear -> Vk.FilterLinear
		_ -> error "bad") n i
...

ビルドを試す。

% stack build

イメージの使い道について

イメージは作成のときに、その「使い道」を示す値を指定する。Gpu.Vulkan.Image.UsageFlags型の値だ。前回の説明ではイメージのコピーをあつかったので次の2つを指定した。

  • Gpu.Vulkan.Image.UsageTransferSrcBit
  • Gpu.Vulkan.Image.UsageTransferDstBit

今回はシェーダーでの読み書きも必要なので次の値も指定する必要がある。

  • Gpu.Vulkan.Image.UsageStorageBit

それぞれのイメージに、それぞれの適切な「使い道」を指定できるようにする。関数prepareImgGpu.Vulkan.Image.UsageFlags型の引数を追加し、必要な部分を修正する。

app/Main.hs
...
body pd dv gq cp img flt n = resultBffr @img pd dv w h \rb ->
	prepareImg @(Vk.ObjB.ImageFormat img) pd dv trsd w h \imgd ->
	prepareImg pd dv trsd w h \imgs ->
	createBffrImg @img pd dv Vk.Bffr.UsageTransferSrcBit w h
	...
	copyImgToBffr cb imgd rb
	where
	trsd = Vk.Img.UsageTransferSrcBit .|. Vk.Img.UsageTransferDstBit
	w, h :: Integral n => n
	...
...
prepareImg :: forall fmt sd nm a . Vk.T.FormatToValue fmt =>
	Vk.Phd.P -> Vk.Dvc.D sd -> Vk.Img.UsageFlags -> Word32 -> Word32 ->
	(forall si sm . Vk.Img.Binded sm si nm fmt -> IO a) -> IO a
prepareImg pd dv usg w h f = Vk.Img.create @'Nothing dv iinfo nil \i -> do
	...
	where
	iinfo = Vk.Img.CreateInfo {
		...
		Vk.Img.createInfoTiling = Vk.Img.TilingOptimal,
		Vk.Img.createInfoUsage = usg,
		Vk.Img.createInfoSharingMode = Vk.SharingModeExclusive,
		...
	...
...

関数bodyの定義のprepareImgで始まる2行に引数trsdを追加する。where節にUsageFlags型の値trsdを追加する。関数prepareImgの型宣言の引数の部分にVk.Img.UsageFlagsを追加し、定義の部分に引数usgを追加する。値CreateInfoのフィールドVk.Img.createInfoUsageに値usgを指定する。

ビルドを試す。

% stack build

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

シェーダーから読み書きするためには、イメージのレイアウトはVk.Img.LayoutGeneralとする必要がある。それに関連して関数transitionImgLytを修正する。Vk.Cmd.pipelineBarrierについては、僕自身がまだ十分に理解していないので、十分な解説ができない。以下を写経してもらいたい。

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.pipelineBarrier cb srcst dstst 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.Ignnored,
		Vk.Img.memoryBarrierImage = i,
		Vk.Img.memoryBarrierSubresourceRange = srr,
		Vk.Img.memoryBarrierSrcAccessMask = srcam,
		Vk.Img.memoryBarrierDstAccessMask = dstam }
	srr = Vk.Img.SubresourceRange {
		Vk.Img.subresourceRangeAspectMask = Vk.Img.AspectColorBit,
		Vk.Img.subresourceRangeBaseMipLevel = 0,
		Vk.Img.subreousrceRangeLevelCount = 1,
		Vk.Img.subresourceRangeBaseArrayLayer = 0,
		Vk.Img.subresourceRangeLayerCount = 1 }
	(srcst, dstst, srcam, dstam) = case (ol, nl) of
		(Vk.Img.LayoutUndefined, Vk.Img.LayoutTransferDstOptimal) -> (
			Vk.Ppl.StageTopOfPipeBit, Vk.Ppl.StageTransferBit,
			zeroBits, Vk.AccessTransferWriteBit )
		(Vk.Img.LayoutUndefined, Vk.Img.LayoutGeneral) -> (
			Vk.Ppl.StageTopOfPipeBit, Vk.Ppl.StageComputeShaderBit,
			zeroBits, Vk.AccessShaderWriteBit )
		(Vk.Img.LayoutTransferDstOptimal,
			Vk.Img.LayoutTransferSrcOptimal) -> (
			Vk.Ppl.StageTransferBit, Vk.Ppl.StageTransferBit,
			Vk.AccessTransferWriteBit, Vk.AccessTransferReadBit )
		(Vk.Img.LayoutTransferDstOPtimal,
			Vk.Img.LayoutGeneral) -> (
			Vk.Ppl.StageTransferBit, Vk.Ppl.StageComputeShaderBit,
			Vk.AccessTransferWriteBit, Vk.AccessShaderReadBit )
		(Vk.Img.LayoutGeneral, Vk.Img.LayoutTransferSrcOptimal) -> (
			Vk.Ppl.StageComputeShaderBit, Vk.Ppl.StageTransferBit,
			Vk.AccessShaderWriteBit, Vk.AccessTransferReadBit )
		_ -> error "unsupported layout transition!"
...

関数Vk.Cmd.pipelineBarrierの第2, 第3引数と値brrrのフィールドVk.Img.memoryBarrierSrcAccessMaskVk.Img.memoryBarrierDstAccessMaskの値を変換前後のイメージレイアウトによって決めるようにした。どのステージのどのような命令を待ち、どのステージのどのような命令を待たせるかという話だ。今回は複数のパスを使っていないので、実際のところはあまり関係ない。Vk.Cmd.pipelineBarrierについては、いつか独立した記事を書きたいと思っている。

ビルドしてみる。

% stack build

イメージビュー

シェーダーでイメージを扱うにはイメージビューを作る必要がある。単純化するとイメージビューとはシェーダーに対して「イメージのこの部分を見てほしい」と伝えるものだ。

Gpu.Vulkan.ImageView.create

create :: Gpu.Vulkan.Device.D sd ->
	CerateInfo mn sm si nm ifmt ivfmt ->
	Data.TypeLevel.ParMayby.M (U2 Gpu.Vulkan.AllocationCallbacks.A) mac ->
	(forall s . I nm ivfmt s -> IO a) -> IO a

この関数cerateは今まで何度も出てきたパターンだ。CreateInfo以外は他で説明したのと同様だ。

Gpu.Vulkan.ImageView.CreateInfo

CreateInfo n sm si nm ifmt ivfmt = CreateInfo {
	createInfoNext :: Data.TypeLevel.Maybe.M n,
	createInfoFlags :: Gpu.Vulkan.ImageView.CreateFlags,
	createInfoImage :: Gpu.Vulkan.Image.Binded sm si nm ifmt,
	createInfoViewType :: Gpu.Vulkan.ImageView.Type,
	createInfoComponents :: Gpu.Vulkan.Component.Mapping,
	createInfoSubresourceRange :: Gpu.Vulkan.Image.SubresourceRange }

createInfoNextcreateInfoFlagsは拡張機能を使わないのならばデフォルトで、それぞれTMaybe.NzeroBitsとしておけばいい。createInfoImageには使用するイメージを指定する。それ以外のフィールドについて見ていこう。

createInfoViewType

このフィールドには次の値を指定できる。

  • Type1D
  • Type2D
  • Type3D
  • TypeCube
  • Type1DArray
  • Type2DArray
  • TypeCubeArray

ここではType2dを選べば良い。

createInfoComponents

Gpu.Vulkan.Component.Mapping

Mapping = Mapping {
	mappingR :: Swizzle,
	mappingG :: Swizzle,
	mappingB :: Swizzle,
	mappingA :: Swizzle }

Swizzle型には次の値がある。

  • SwizzleIdentity
  • SwizzleZero
  • SwizzleOne
  • SwizzleR
  • SwizzleG
  • SwizzleB

このフィールドを適切に使うことでイメージにおけるRGBAそれぞれの成分がシェーダー側に、どの成分に見えるかを決めることができる。そのままにしておきたければ、すべてにSwizzleIdentityを指定すればいい。

createInfoSubresourceRange

Gpu.Vulkan.Image.SubresourceRange

SubresourceRange = SubresourceRange {
	subresourceRangeAspectMask :: AspectFlags,
	subresourceRangeBaseMipLevel :: Word32,
	subresourceRangeLevelCount :: Word32,
	subresourceRangeBaseArrayLayer :: word32,
	subresourceRangeLayerCount :: Word32 }

SubresourceRangeについては、前に説明した。シェーダー側に見せるアスペクト、ミップレベル、レイヤーを指定する。

例題のコード

画像ファイルから読み込むイメージとシェーダーで扱うイメージとは異なるフォーマットを使うので、シェーダーで使うイメージを別に用意する。また上で見たようにシェーダーから使うにはイメージビューを作る必要がある。次のようにprepareImg ... \imgd' ->の行とprepareImg ... \imgs' ->の行とVk.ImgVw.createの2行を追加する。where節にVk.Image.UsageFlags型の値stsstdの定義を追加する。さらにトップレベルにimgVwInfoの定義を追加する。また、シェーダーで使うイメージのフォーマットを型シノニムShaderFormatとして定義しておく。

app/Main.hs
type ShaderFormat = Vk.T.FormatR16g16b16a16Sfloat

...
body pd dv gq cp img flt n i = resultBffr @img pd dv w h \rb ->
	prepareImg @(Vk.ObjB.ImageFormat img) pd dv w h \imgd ->
	prepareImg @ShaderFormat pd dv sts w h \imgd' ->
	prepareImg @ShaderFormat pd dv std w h \imgs' ->
	Vk.ImgVw.create @_ @ShaderFormat dv (imgVwInfo imgd') nil \imgvwd' ->
	Vk.ImgVw.create @_ @ShaderFormat dv (imgVwInfo imgs') nil \imgvws' ->
	prepareImg pd dv trsd w h \imgs ->
	...
	where
	trsd = Vk.Img.UsageTransferSrcBit .|. Vk.Img.UsageTransferDstBit
	sts = Vk.Img.UsageStorageBit .|. Vk.Img.UsageTransferSrcBit
	std = Vk.Img.UsageStorageBit .|. Vk.Img.UsageTransferDstBit
...
imgVwInfo :: Vk.Img.Binded sm si nm ifmt ->
	Vk.ImgVw.CreateInfo 'Nothing sm si nm ifmt ivfmt
imgVwInfo i = Vk.ImgVw.CreateInfo {
	Vk.ImgVw.createInfoNext = TMaybe.N,
	Vk.ImgVw.createInfoFlags = zeroBits,
	Vk.ImgVw.createInfoImage = i,
	Vk.ImgVw.createInfoViewType = Vk.ImgVw.Type2d,
	Vk.ImgVw.createInfoComponents = def,
	Vk.ImgVw.createInfoSubresourceRange = Vk.Img.SubresourceRange {
		Vk.Img.subresourceRangeAspectMask = Vk.Img.ASpectColorBit,
		Vk.Img.subresourceRangeBaseMipLevel = 0,
		Vk.Img.subresourceRangeLevelCount = Vk.reaminingMipLevels,
		Vk.Img.subresourceRangeBaseArrayLayer = 0,
		Vk.Img.subresourceRangeLayerCount = Vk.remainingArrayLayers } }
...

関数prepareImgでイメージimgd'imgs'とを作り、それぞれに対してVk.ImgVw.createでイメージビューimgvwd'imgvws'とを作っている。ビルドして試してみよう。

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

パイプラインとディスクリプターセットについての概要

パイプライン

Vulkanでシェーダーを使うにはパイプラインという仕組みを使う。パイプラインには次のようなものがある。

  • グラフィックスパイプライン
  • コンピュートパイプライン

グラフィックスパイプラインは「頂点情報を指定すると適切に画像のピクセルを色付けする」処理の集まりだ。複数の種類の処理を順に並べることで構築される。Vulkanでは、それぞれの処理は、ひとつずつ実行されるのではなくパイプラインという形でまとめて実行される。パイプラインにまとめることで、最適化しやすくなり全体の効率が高くなる。コンピュートパイプラインはコンピュートシェーダーをひとつ含むだけなので、「まとめる」も何もないのだけど、グラフィックスパイプラインとの整合性を取るためにパイプラインになっている(のだと思う)。

ディスクリプターセット

シェーダーでイメージを処理するにはイメージビューを作成したうえで、ディスクリプターセットにまとめる必要がある。ディスクリプターセットはイメージやその他のデータをシェーダーから利用できるようにまとめたものだ。

ディスクリプターセットレイアウト

ディスクリプターセットがどういうタイプのディスクリプターを含むかを保存している値。

Gpu.Vulkan.Descriptor.Type

ディスクリプターのタイプには次のようなものがある。

  • Sampler
  • CombinedImageSampler
  • SampledImage
  • StorageImage
  • UniformTexelBuffer
  • StorageTexelBuffer
  • UniformBuffer
  • StorageBuffer
  • UniformBufferDynamic
  • StorageBufferDynamic
  • InputAttachment
  • ...

今回はStorageImageを使う。イメージに対して、読み書きをする場合に使うタイプだ。ディスクリプターセットレイアウトは、このようなタイプについて、どのタイプのディスクリプターが何個あるかなどを指定する。

プッシュ定数

シェーダーに値を渡すにはディスクリプターを使うのだけど、小さいデータならプッシュ定数という簡単なやりかたが用意されている。Vulkan APIでは128バイトまでは使えることが保証されている。

ディスクリプターセットレイアウト

ディスクリプターセットレイアウトの作成に使う関数は次のようになっている。

Gpu.Vulkan.DescriptorSetLayout.create

create :: Gpu.Vulkan.Device.D sd -> CreateInfo mn bts ->
	Data.TypeLevel.ParMayby.M (U2 Gpu.Vulkan.AllocationCallbacks.A) mac ->
	(forall s . D s bts -> IO a) -> IO a

Gpu.Vulkan.DescriptorSetLayout.CreateInfo

data CreateInfo mn bts = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoBindings :: HPList.PL Binding bts }

Gpu.Vulkan.DescriptorSetLayout.Binding

Gpu.Vulkan.DescriptorSetLayout.Bindingには4つのデータ構築子がある。今回はそのうちのBindingImageを使う。

data Binding bt where
	...
	BindingImage :: {
		bindingImageDescriptorType :: Type,
		bindingImageStageFlags :: Gpu.Vulkan.ShaderStageFlags } ->
		Binding ('Image iargs)
	...

型iargsは[(Symbol, Gpu.Vulkan.TypeEnum.Format)]種の型だ。この型引数はGpu.Vulkan.Image.Binded型の型引数を集めたものだ。

Gpu.Vulkan.Image.Binded

data Gpu.Vulkan.Image.Binded sm si (nm :: Symbol) (fmt :: Gpu.Vulkan.TypeEnum.Format)

例題のコード

app/Main.hs
createDscStLyt :: Vk.DscStLyt.BindingListToMiddle bts =>
	Vk.Dvc.D sd -> HPList.PL Vk.DscStLyt.Binding bts ->
	(forall sdsl . Vk.DscStLyt.D sdsl bts -> IO a) -> IO a
createDscStLyt dv bds = Vk.DscStLyt.create dv info nil
	where info = Vk.DscStLyt.CreateInfo {
		Vk.DscStLyt.createInfoNext = TMaybe.N,
		Vk.DscStLyt.createInfoFlags = zeroBits,
		Vk.DscStLyt.createInfoBindings = bds }

Binding型の値のヘテロリストを指定してディスクリプターセットレイアウトを作る関数だ。

パイプラインレイアウト

ディスクリプターセットレイアウトはパイプラインを作成するときにも使う。ただし直接使うのではなく、ディスクリプターセットレイアウトの内容を含むパイプラインレイアウトを作成し、それを使う。パイプラインレイアウトを作成するときに指定する引数の型Gpu.Vulkan.PipelineLayout.CreateInfoは次のようになっている。

Gpu.Vulkan.PipelineLayout.CreateInfo

CreateInfo mn lytas pcl = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags
	createInfoSetLayouts :: HPList.PL (U2 Vk.DscStLyt.D) lytas }

型引数pclでは使うプッシュ定数の数やサイズなどを指定する。これはGpu.Vulkan.PushConstant.Layout種の型だ。

Gpu.Vulkan.PushConstant.Layout

data Layout = Layout [Type] [Range]

data Range = Range [Gpu.Vulkan.TypeEnum.ShaderStageFlagBits] [Type]

構築子Layoutのはじめの引数である[Type]型の値はプッシュ定数の全体が、どのような型の値を含むかを示し、2番目の[Range]型の値は、全体のなかのどの部分がどの段階のシェーダーで使えるかを示す。

例題のコード

app/Main.hs
createPplLyt :: forall pctps pcrng sd a bds . (
	Vk.DscStLyt.BindingListToMiddle bds,
	Vk.PshCnst.RangeListToMiddle pctps '[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)] pctps -> 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 pctps '[pcrng])
	info dsl = Vk.PplLyt.CreateInfo {
		Vk.PplLyt.createInfoNext = TMaybe.N,
		Vk.PplLyt.createInfoFlags = zeroBits,
		Vk.PplLyt.createInfoSetLayouts = HPList.Singleton $ U2 dsl }

Binding型の値のヘテロリストからディスクリプターセットレイアウトとパイプラインレイアウトを作る関数だ。型変数pctpspcrngの2つはプッシュ定数に関する型変数だ。それ以外については、ディスクリプターセットレイアウトを指定してパイプラインレイアウトを作っているだけだ。

プッシュ定数については型変数pctpsがプッシュ定数に含まれる複数の値がそれぞれどういう型であるかを示し、pcrngはそのなかのどの部分が指定したシェーダーからアクセスできるかを示す。

パイプライン

コンピュートパイプラインを作る。CreateInfoは次のようになっている。

Gpu.Vulkan.Pipeline.Compute.CreateInfo

data CreateInfo mn ssta lyta bpha = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoStage :: U5 Gpu.Vulkan.Pipeline.ShaderStage.CreateInfo ssta,
	createInfoLayout :: U3 Gpu.Vulkan.PipelineLayout.P lyta,
	createInfoBasePipelineHandleOrIndex ::
		Maybe (Either (U2 Gpu.Vulkan.Pipeline.Compute.C bpha) Int32) }

フィールドcreateInfoBasePipelineHandleOrIndexは「元になるパイプラインを指定するとパイプラインの作成が速くなる」みたいな機能らしいけど、よくはわからない。実際のドライバで使われているのかどうかもよく知らない。フィールドcreateInfoLayoutにはパイプラインレイアウトを入れる。重要なのはフィールドcreateInfoStageだ。このフィールドでシェーダーを指定する。これはGpu.Vulkan.Pipeline.ShaderStage.CreateInfo型の値だ。

Gpu.Vulkan.Pipeline.ShaderStage.CreateInfo

data CreateInfo mn mnsm sknd mac vs = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoStage :: Gpu.Vulkan.ShaderStageFlagBits,
	createInfoModule :: (Gpu.Vulkan.ShaderModule.CreateInfo mnsm sknd, M (U2 A) mac),
	createInfoName :: ByuteString
	createInfoSpecializationInfo :: HPList.L vs }

フィールドcreaetInfoStageではこのシェーダーが、どのような処理で使われるかを指定する。今回使うのはコンピュートシェーダーなので、ここにはVk.ShaderStageComputeBitを指定すればいい。で、フィールドcerateInfoModuleが重要なのだけど、これはさらに入れ子になっててGpu.Vulkan.ShaderModule.CreateInfo型の値だ。

Gpu.Vulkan.ShaderModule.CreateInfo

data CreateInfo mn sknd = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoCode :: Language.SpirV.S sknd }

Language.SpirV.S型の値は中身はByteStringだ。これはSPIR-Vのバイトコードだ。つまり、ようやくシェーダーの本体にたどりついた感じだ。

例題のコード

app/Main.hs
createCmpPpl :: forall pctps pcrng sd bds a . (
	Vk.PshCnst.RangeListToMiddle pctps '[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)] pctps ->
		Vk.Ppl.Cp.C scppl '(spl, '[ '(sds, bds)], pctps) -> IO a) ->
	IO a
createCmpPpl d bds shdr f =
	createPplLyt @pctps @pcrng d bds \dsl pl ->
	Vk.Ppl.Cp.createCs d Nothing (HPList.Singleton . U4 $ info pl) nil
		\(HPList.Singleton p) -> f dsl pl p
	where
	info :: Vk.PplLyt.P sl sbtss pcw -> Vk.Ppl.Cp.CreateInfo 'Nothing
		'( 'Nothing, 'Nothing, 'GlslComputeShader, 'Nothing, '[])
		'(sl, sbtss, pcw) bpha
	info pl = Vk.Ppl.Cp.CreateInfo {
		Vk.Ppl.Cp.createInfoNext = TMaybe.N,
		Vk.Ppl.Cp.createInfoFlags = zeroBits,
		Vk.Ppl.Cp.createInfoStage = U5 shdrst,
		Vk.Ppl.Cp.createInfoLayout = U3 pl,
		Vk.Ppl.Cp.createInfoBasePipelineHandleOrIndex = Nothing }
	shdrst :: Vk.Ppl.ShdrSt.CreateInfo
		'Nothing 'Nothing 'GlslComputeShader 'Nothing '[]
	shdrst = Vk.Ppl.ShdrSt.CreateInfo {
		Vk.Ppl.ShdrSt.createInfoNext = TMaybe.N,
		Vk.Ppl.ShdrSt.createInfoFlags = zeroBits,
		Vk.Ppl.ShdrSt.createInfoStage = Vk.ShaderStageComputeBit,
		Vk.Ppl.ShdrSt.createInfoModule = (shdrmd, nil),
		Vk.Ppl.ShdrSt.createInfoName = "main",
		Vk.Ppl.ShdrSt.createInfoSpecializationInfo = HPList.Nil }
	shdrmd = Vk.ShdrMd.CreateInfo {
		Vk.ShdrMd.createInfoNext = TMaybe.N,
		Vk.ShdrMd.createInfoFlags = zeroBits,
		Vk.ShdrMd.createInfoCode = shdr }

Binding型の値のヘテロリストとSPIR-Vにコンパイルされたシェーダーを指定して、パイプラインを作る関数createCmpPplを定義した。関数Vk.Ppl.Cp.createCsは複数のCreateInfoを取って複数のパイプラインを返す関数だ。ここでは1つしか作らないのでHPList.Singletonを引数と返り値の両方に対して使っている。

ディスクリプタープール

ディスクリプターを使うときは、まずディスクリプタープールを用意して、そこから取り出す形で使う。

Gpu.Vulkan.DescriptorPool.CreateInfo

data CreateInfo mn = CreateInfo {
	createInfoNext :: TMaybe.M mn,
	createInfoFlags :: CreateFlags,
	createInfoMaxSets :: Word32,
	createInfoPoolSizes :: [Size] }

data Size = Size {
	sizeType :: Gpu.Vulkan.Descriptor.Type,
	sizeDescriptorCount :: Word32 }

作るディスクリプターセットの最大数と、使うディスクリプターの数とを指定する。

例題のコード

app/Main.hs
createDscPl :: Vk.Dvc.D sd -> (forall sdp . Vk.DscPl.P sdp -> IO a) -> IO a
createDscPl dv = Vk.DscPl.create dv info nil
	where
	info = Vk.DscPl.CreateInfo {
		Vk.DscPl.createInfoNext = TMaybe.N,
		Vk.DscPl.createInfoFlags = Vk.DscPl.CreateFreeDescriptorSetBit,
		Vk.DscPl.createInfoMaxSets = 1,
		Vk.DscPl.createInfoPoolSizes = [sz] }
	sz = Vk.DscPl.Size {
		Vk.DscPl.sizeType = Vk.Dsc.TypeStorageImage,
		Vk.DscPl.sizeDescriptorCount = 2 }

ディスクリプターセットは、ここでは1つだけ作る。またディスクリプターとしては、ストレージイメージを2つ使うということ。

ディスクリプターセット

ディスクリプターセットは、Vk.DscSt.allocateDsで確保してVk.DscSt.updateDsで使用する値を書き込むという形で用意する。

Gpu.Vulkan.DescriptorSet.AllocateInfo

AllocateInfo mn sdp slbtss = AllocateInfo {
	allocateInfoNext :: TMaybe.M mn,
	allocateInfoDescriptorPool :: Gpu.Vulkan.DescriptorPool.P sdp,
	allocateInfoSetLayouts ::
		HPList.PL (U2 Gpu.Vulkan.DescriptorSetLayout.D) slbtss }

関数Vk.DscSt.allocateDsではディスクリプタープールとディスクリプターセットレイアウトを指定して、指定したプールからレイアウトの情報に基づいて適切なディスクリプターセットを取り出す。

Gpu.Vulkan.DescriptorSet.updateDs

updateDs :: D sd -> HPList.PL (U5 Write) writeArgs -> PL (U8 Copy) copyArgs -> IO ()

関数updateDsは第2引数の複数のWriteと第3引数の複数のCopyとをまとめて実行する。今回Copyは使わないのでWriteのほうだけ見てみよう。

Gpu.Vulkan.DescriptorSet.Write

data Write mn sds slbts wsarg i = Write {
	writeNext :: TMaybe.M mn,
	writeDstSet :: D sds slbts,
	writeDescriptorType :: Gpu.Vulkan.Descriptor.Type,
	writeSources :: WriteSources wsarg }

Vk.DscSt.Writeは書き込む対象となるディスクリプターセット、書き込まれるディスクリプターのタイプを指定する。また、フィールドwriteSourcesに書き込まれるディスクリプターの中身を指定する。今回はイメージを書き込むのでWriteSourcesのデータ構築子ImageInfosを見てみよう。

Gpu.Vulkan.DescriptorSet.WriteSources

data WriteSources arg where
	ImageInfos :: HPList.PL (U4 Gpu.Vulkan.Descriptor.ImageInfo) iiargs ->
		WriteSources (`WriteSourcesArgImage iiargs)
	...

Gpu.Vulkan.Descriptor.ImageInfo

data ImageInfo ss fmt nm si = ImageInfo {
	imageInfoSampler :: Gpu.Vulkan.Sampler.S ss,
	imageInfoImageView :: Gpu.Vulkan.ImageView.I fmt nm si,
	imageInfoImageLayout :: Gpu.Vulkan.Image.Layout }

ようやくたどりついた。このImageInfo型の値にイメージビューを指定する。フィールドimageInfoSamplerについては今回はサンプラーは使わないので、nullなサンプラーを指定しておけばいい。

例題のコード

app/Main.hs
createDscSt ::
	Vk.Dvc.D sd -> Vk.DscPl.P sdp ->
	Vk.ImgVw.I "source_image" ShaderFormat sivs ->
	Vk.ImgVw.I "destination_image" ShaderFormat sivd ->
	Vk.DscStLyt.D sdsl '[SrcImg, DstImg] ->
	(forall sds . Vk.DscSt.D sds '(sdsl, '[SrcImg, DstImg]) -> IO a) -> IO a
createDscSt dv dp svw dvw dl a =
	Vk.DscSt.allocateDs dv info \(HPList.Singleton ds) -> (>> a ds)
		$ Vk.DscSt.updateDs dv
			(U5 (dscWrite ds svw) :** U5 (dscWrite ds dvw) :**
				HPList.Nil)
			HPList.Nil
	where info = Vk.DscSt.AllocateInfo {
		Vk.DscSt.allocateInfoNext = TMaybe.N,
		Vk.DscSt.allocateInfoDescriptorPool = dp,
		Vk.DscSt.allocateInfoSetLayouts = HPList.Singleton $ U2 dl }

type SrcImg = 'Vk.DscStLyt.Image '[ '("source_image", ShaderFormat)]
type DstImg = 'Vk.DscStLyt.Image '[ '("destination_image", ShaderFormat)]

dscWrite :: Vk.DscSt.D sds slbts -> Vk.ImgVw.I nm fmt si ->
	Vk.DscSt.Write 'Nothing sds slbts
		('Vk.DscSt.WriteSourcesArgImage '[ '(ss, nm, fmt, si)]) 0
dscWrite ds v = Vk.DscSt.Write {
	Vk.DscSt.writeNext = TMaybe.N, Vk.DscSt.writeDstSet = ds,
	Vk.DscSt.writeDescriptorType = Vk.Dsc.TypeStorageImage,
	Vk.DscSt.writeSources =
		Vk.DscSt.ImageInfos . HPList.Singleton $ U4 Vk.Dsc.ImageInfo {
			Vk.Dsc.imageInfoImageLayout = Vk.Img.LayoutGeneral,
			Vk.Dsc.imageInfoImageView = v,
			Vk.Dsc.imageInfoSampler = Vk.Smplr.Null } }

ここでは2つのイメージビューに、それぞれ"source_image""destination_image"という名前をつけた。型レベルで名前を付けられるので、コンパイル時に誤りをチェックすることができる。ディスクリプターセットを用意(Vk.DscSt.allocateDs)して、それに2つのイメージビューを書き込んでいる(Vk.DscSt.updateDs))。書き込みの内容そのものは関数dscWriteで組み立てている。

シェーダー

シェーダーは別ファイルに保存したものを実行時にSPIR-Vにコンパイルして使うことにした。まずは、シェーダーをコンパイルする関数を定義する。

app/Main.hs
compileShader :: FilePath -> IO (SpirV.S GlslComputeShader)
compileShader fp = do
	cd <- BS.readFile =<< getDataFileName fp
	Shaderc.compile @() cd (BSC.pack fp) "main" def

getDataFileNameはCabalによって配置されたデータファイルへのパスを取り出す関数だ。これによってシェーダーのファイルパスを取り出して、その内容をByteStringとして読み込み、それを関数Shaderc.compileでSPIR-V形式にコンパイルしている。

シェーダーを書いていこう。

shader/interpolate.comp
#version 460

#define Nearest 0
#define Linear 1

layout (local_size_x = 16, local_size_y = 16) in;

layout(rgba16f, set = 0, binding = 0) uniform image2D simg;
layout(rgba16f, set = 0, binding = 1) uniform image2D dimg;

layout(push_constant) uniform P { uint fltr; uint n; uint ix; uint iy; } p;

初めの一行はGLSL言語のバージョンを指定している。ここではバージョン4.6だ。続く#defineでは補間アルゴリズムを示すNearestとLinearという定数を定義している。その次の行ではひとつのワークグループで実行するスレッドの数を16x16と指定している。続く2行ではディスクリプターセットとして与えられた2つのイメージを、それぞれsimg, dimgとして宣言している。次の1行はプッシュ定数であり今回は「フィルターの種類、分割数、x方向で何番目か、y方向で何番目か」を受け取るようにしてある。

shader/interpolate.comp

float
formula_n(float x)
{
	if (x < 0.5) return 1; else return 0;
}

float
formula_n_(float x)
{
	if (x <= 0.5) return 1; else return 0;
}

float
formula_l(float x)
{
	return 1 - x;
}

関数formula_n, formula_n_, formula_lは最近傍補間と双線形補間で使われる係数を計算する式だ。最近傍補間では距離0.5の前後で、そのピクセルの影響が0, 1で変化するようになっているのに対して、双線形補間では距離に対して連続的にピクセルの影響が変化している。最近傍補間について式が2つになっているのは、ちょうど真ん中の点の補間する場合に、どちらかのピクセルを選ぶ必要があるからだ。

shader/interpolate.comp

float[2]
coefficients(float x)
{
	float co[2];
	float d = fract(x);
	switch (p.fltr) {
	case Nearest:
		co[0] = formula_n(d); co[1] = formula_n_(1 - d);
		break;
	case Linear:
		co[0] = formula_l(d); co[1] = formula_l(1 - d);
		break;
	}
	return co;
}

関数coefficientsでは座標上の位置の小数点以下(d)から、それぞれのピクセルに乗算される係数を計算している。補間する点の座標の値より小さい整数値からの距離はdであり、より大きい整数値からの距離は1 - dとなる。

shader/interpolate.comp

vec4[2][2]
points(ivec2 p)
{
	vec4 c[2][2];

	for (int y = 0; y < 2; y++)
		for (int x = 0; x < 2; x++)
			c[y][x] = imageLoad(simg, ivec2(p.x + x, p.y + y));
	return c;
}

関数pointsでは補間する点の周囲にある元画像のピクセルを取り出している。引数pは補間する点よりX座標についてもY座標についても小さくなるような格子点のなかで、補間する点に最も近い点の座標だ。これに対して、それぞれの座標について、それぞれ0, 1を足した位置にあるピクセルを取り出して、2x2個のピクセルの値を返す。

shader/interpolate.comp

void
main()
{
	ivec2 size = imageSize(dimg);
	ivec2 coord = ivec2(gl_GlobalInvocationID.xy);

	float n, ix, iy;
	n = float(p.n); ix = float(p.ix); iy = float(p.iy);

	vec2 pos = vec2(
		float(size.x - 1) * ix / n + float(coord.x) / n,
		float(size.y - 1) * iy / n + float(coord.y) / n);

	float cox[2] = coefficients(pos.x);
	float coy[2] = coefficients(pos.y);

	vec4 c4[2][2] = points(ivec2(floor(pos.x), floor(pos.y)));

	vec4 c = vec4(0.0);
	for (int y = 0; y < 2; y++)
		for (int x = 0; x < 2; x++)
			c += cox[x] * coy[y] * c4[y][x];

	if (coord.x < size.x && coord.y < size.y) imageStore(dimg, coord, c);
}

関数mainでは補間する位置posを計算し、x方向とy方向について、それぞれの係数を求め、周囲の点にそれらの係数をかけ合わせたものの総和を取り、それをその点のピクセルの色として出力用のイメージに書き込んでいる(imageStore)。

関数body

関数bodyを書き換えてコマンドblitImageを実行していた部分についてコンピュートシェーダーを使うようにする。compileShaderの行からcreateDscPlまでの6行を追加する。tr cb imgs' Vk.Img.LayoutUndefined Vk.Img.LayoutTransferDstOptimalの行からtr cb imgd' Vk.Img.LayoutGeneral Vk.Img.LayoutTransferSrcOptimalまでの13行を追加する。copyImgToImg cb imgs imgd w h ... n iの3行をcopyImgToImg cb imgd' imgd w h Vk.FilterNearest 1 0とする。where節のn', ix, iy :: Word32の行からdiv'を定義している行までの5行を追加する。

型シノニムPshCnstsVk.DscStLyt.Binding型の値strImgBindingを定義する。

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 -> Int32 -> Int32 -> IO img
body pd dv gq cp img flt n i = resultBffr @img pd dv w h \rb ->
	prepareImg @(Vk.ObjB.ImageFormat img) pd dv w h \imgd ->
	prepareImg @ShaderFormat pd dv w h \imgd' ->
	prepareImg @ShaderFormat pd dv w h \imgs' ->
	Vk.ImgVw.create @_ @ShaderFormat dv (imgVwInfo imgd') nil \imgvwd' ->
	Vk.ImgVw.create @_ @ShaderFormat dv (imgVwInfo imgs') nil \imgvws' ->
	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] >>

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

	runCmds dv gq cp \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 Vk.FilterNearest 1 0
	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 ppl \ccb -> do
		Vk.Cmd.bindDescriptorSetsCompute
			ccb pl (HPList.Singleton $ U2 ds) def
		Vk.Cmd.pushConstantsCompute @'[ 'Vk.T.ShaderStageComputeBit]
			ccb pl (flt :* 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 Vk.FilterNearest 1 0
	tr cb imgd
		Vk.Img.LayoutTransferDstOptimal Vk.Img.LayoutTransferSrcOptimal
	copyImgToBffr cb imgd rb
	where
	trsd = Vk.Img.UsageTransferSrcBit .|. Vk.Img.UsageTransferDstBit
	sts = Vk.Img.UsaageStorageBit .|. Vk.Img.UsageTransferSrcBit
	std = Vk.Img.UsaageStorageBit .|. Vk.Img.UsageTransferDstBit
	w, h :: Integral n => n
	w = fromIntegral $ Vk.ObjB.imageWidth img
	h = fromIntegral $ Vk.ObjB.imageHewight img
	tr = transitionImgLyt
	n', ix, iy :: Word32
	n' = fromIntegral n
	ix = fromIntegral $ i `mod` n
	iy = fromIntegral $ i `div` n
	x `div'` y = case x `divMod` y of (d, 0) -> d; (d, _) -> d + 1

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

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

追加した部分は次のようの処理を行っている。

  • シェーダーのコンパイル
  • パイプラインの作成
  • ディスクリプタープールとディスクリプターセットの作成
  • imgsからimgs'へのコピー
  • コマンドバッファーへのパイプラインのバインド
  • ディスクリプターセットをバインド
  • プッシュ定数の設定
  • シェーダーの実行
  • imgd'からimgdへのコピー

ビルドして試す。

% 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

funenohito-nearest.png
funenohito-linear.png

まとめ

コンピュートシェーダーを使って画像の一部を拡大した。今回は最近傍補間と双線形補間を実装した。次回は双三次補間を実装する。

書いた。

https://zenn.dev/yoshikuni_jujo/articles/gpu-vulkan-bicubic

Discussion