{-# LANGUAGE OverloadedLists #-}
module Engine.Vulkan.Swapchain
( SwapchainResources(..)
, SwapchainInfo(..)
, allocSwapchainResources
, recreateSwapchainResources
, createSwapchain
, threwSwapchainError
, HasSwapchain(..)
, setDynamic
, setDynamicFullscreen
) where
import RIO
import Data.Bits (zeroBits, (.&.), (.|.))
import RIO.Vector qualified as V
import UnliftIO.Resource (MonadResource, allocate, release)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.Exception (VulkanException(..))
import Vulkan.Extensions.VK_KHR_surface qualified as Khr
import Vulkan.Extensions.VK_KHR_swapchain qualified as Khr
import Vulkan.Utils.Misc ((.&&.))
import Vulkan.NamedType ((:::))
import Vulkan.Zero (zero)
import Engine.Camera qualified as Camera
import Engine.Types.RefCounted (RefCounted, newRefCounted, releaseRefCounted)
import Engine.Vulkan.Types (MonadVulkan, HasVulkan(..), HasSwapchain(..), pdiProperties)
import Engine.Worker qualified as Worker
data SwapchainResources = SwapchainResources
{ SwapchainResources -> SwapchainInfo
srInfo :: SwapchainInfo
, SwapchainResources -> Vector ImageView
srImageViews :: Vector Vk.ImageView
, SwapchainResources -> Vector Image
srImages :: Vector Vk.Image
, SwapchainResources -> RefCounted
srRelease :: RefCounted
, SwapchainResources -> ProjectionProcess
srProjection :: Camera.ProjectionProcess
}
data SwapchainInfo = SwapchainInfo
{ SwapchainInfo -> SwapchainKHR
siSwapchain :: Khr.SwapchainKHR
, SwapchainInfo -> ReleaseKey
siSwapchainReleaseKey :: Resource.ReleaseKey
, SwapchainInfo -> PresentModeKHR
siPresentMode :: Khr.PresentModeKHR
, SwapchainInfo -> Word32
siMinImageCount :: Word32
, SwapchainInfo -> Format
siSurfaceFormat :: Vk.Format
, SwapchainInfo -> ColorSpaceKHR
siSurfaceColorspace :: Khr.ColorSpaceKHR
, SwapchainInfo -> Format
siDepthFormat :: Vk.Format
, SwapchainInfo -> SampleCountFlagBits
siMultisample :: Vk.SampleCountFlagBits
, SwapchainInfo -> Float
siAnisotropy :: Float
, SwapchainInfo -> Extent2D
siImageExtent :: Vk.Extent2D
, SwapchainInfo -> SurfaceKHR
siSurface :: Khr.SurfaceKHR
}
instance HasSwapchain SwapchainResources where
getSurfaceExtent :: SwapchainResources -> Extent2D
getSurfaceExtent = SwapchainInfo -> Extent2D
siImageExtent (SwapchainInfo -> Extent2D)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> Extent2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getSurfaceFormat :: SwapchainResources -> Format
getSurfaceFormat = SwapchainInfo -> Format
siSurfaceFormat (SwapchainInfo -> Format)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getDepthFormat :: SwapchainResources -> Format
getDepthFormat = SwapchainInfo -> Format
siDepthFormat (SwapchainInfo -> Format)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getMultisample :: SwapchainResources -> SampleCountFlagBits
getMultisample = SwapchainInfo -> SampleCountFlagBits
siMultisample (SwapchainInfo -> SampleCountFlagBits)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> SampleCountFlagBits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getAnisotropy :: SwapchainResources -> Float
getAnisotropy = SwapchainInfo -> Float
siAnisotropy (SwapchainInfo -> Float)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getSwapchainViews :: SwapchainResources -> Vector ImageView
getSwapchainViews = SwapchainResources -> Vector ImageView
srImageViews
getMinImageCount :: SwapchainResources -> Word32
getMinImageCount = SwapchainInfo -> Word32
siMinImageCount (SwapchainInfo -> Word32)
-> (SwapchainResources -> SwapchainInfo)
-> SwapchainResources
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> SwapchainInfo
srInfo
getImageCount :: SwapchainResources -> Word32
getImageCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (SwapchainResources -> Int) -> SwapchainResources -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Image -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length (Vector Image -> Int)
-> (SwapchainResources -> Vector Image)
-> SwapchainResources
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapchainResources -> Vector Image
srImages
allocSwapchainResources
:: ( MonadResource (RIO env)
, HasVulkan env
, HasLogFunc env
)
=> Khr.SwapchainKHR
-> Vk.Extent2D
-> Khr.SurfaceKHR
-> Camera.ProjectionProcess
-> RIO env SwapchainResources
allocSwapchainResources :: SwapchainKHR
-> Extent2D
-> SurfaceKHR
-> ProjectionProcess
-> RIO env SwapchainResources
allocSwapchainResources SwapchainKHR
oldSwapchain Extent2D
windowSize SurfaceKHR
surface ProjectionProcess
projectionP = do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Allocating swapchain resources"
Device
device <- (env -> Device) -> RIO env Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
info :: SwapchainInfo
info@SwapchainInfo{Float
Word32
ReleaseKey
Format
SampleCountFlagBits
Extent2D
SurfaceKHR
ColorSpaceKHR
PresentModeKHR
SwapchainKHR
siSurface :: SurfaceKHR
siImageExtent :: Extent2D
siAnisotropy :: Float
siMultisample :: SampleCountFlagBits
siDepthFormat :: Format
siSurfaceColorspace :: ColorSpaceKHR
siSurfaceFormat :: Format
siMinImageCount :: Word32
siPresentMode :: PresentModeKHR
siSwapchainReleaseKey :: ReleaseKey
siSwapchain :: SwapchainKHR
$sel:siSurface:SwapchainInfo :: SwapchainInfo -> SurfaceKHR
$sel:siImageExtent:SwapchainInfo :: SwapchainInfo -> Extent2D
$sel:siAnisotropy:SwapchainInfo :: SwapchainInfo -> Float
$sel:siMultisample:SwapchainInfo :: SwapchainInfo -> SampleCountFlagBits
$sel:siDepthFormat:SwapchainInfo :: SwapchainInfo -> Format
$sel:siSurfaceColorspace:SwapchainInfo :: SwapchainInfo -> ColorSpaceKHR
$sel:siSurfaceFormat:SwapchainInfo :: SwapchainInfo -> Format
$sel:siMinImageCount:SwapchainInfo :: SwapchainInfo -> Word32
$sel:siPresentMode:SwapchainInfo :: SwapchainInfo -> PresentModeKHR
$sel:siSwapchainReleaseKey:SwapchainInfo :: SwapchainInfo -> ReleaseKey
$sel:siSwapchain:SwapchainInfo :: SwapchainInfo -> SwapchainKHR
..} <- SwapchainKHR -> Extent2D -> SurfaceKHR -> RIO env SwapchainInfo
forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
SwapchainKHR -> Extent2D -> SurfaceKHR -> m SwapchainInfo
createSwapchain SwapchainKHR
oldSwapchain Extent2D
windowSize SurfaceKHR
surface
(Result
_, Vector Image
swapchainImages) <- Device -> SwapchainKHR -> RIO env (Result, Vector Image)
forall (io :: * -> *).
MonadIO io =>
Device -> SwapchainKHR -> io (Result, Vector Image)
Khr.getSwapchainImagesKHR Device
device SwapchainKHR
siSwapchain
Vector (ReleaseKey, ImageView)
res <- Vector Image
-> (Image -> RIO env (ReleaseKey, ImageView))
-> RIO env (Vector (ReleaseKey, ImageView))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Vector Image
swapchainImages ((Image -> RIO env (ReleaseKey, ImageView))
-> RIO env (Vector (ReleaseKey, ImageView)))
-> (Image -> RIO env (ReleaseKey, ImageView))
-> RIO env (Vector (ReleaseKey, ImageView))
forall a b. (a -> b) -> a -> b
$
Format -> Image -> RIO env (ReleaseKey, ImageView)
forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m) =>
Format -> Image -> m (ReleaseKey, ImageView)
createImageView Format
siSurfaceFormat
let (Vector ReleaseKey
imageViewKeys, Vector ImageView
imageViews) = Vector (ReleaseKey, ImageView)
-> (Vector ReleaseKey, Vector ImageView)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
V.unzip Vector (ReleaseKey, ImageView)
res
IO ()
releaseDebug <- RIO env () -> RIO env (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (RIO env () -> RIO env (IO ())) -> RIO env () -> RIO env (IO ())
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Releasing swapchain resources"
RefCounted
releaseResources <- IO () -> RIO env RefCounted
forall (m :: * -> *). MonadIO m => IO () -> m RefCounted
newRefCounted (IO () -> RIO env RefCounted) -> IO () -> RIO env RefCounted
forall a b. (a -> b) -> a -> b
$ do
IO ()
releaseDebug
(ReleaseKey -> IO ()) -> Vector ReleaseKey -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release Vector ReleaseKey
imageViewKeys
ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
siSwapchainReleaseKey
ProjectionProcess
-> (GetInput ProjectionProcess -> GetInput ProjectionProcess)
-> RIO env ()
forall (m :: * -> *) var.
(MonadIO m, HasInput var) =>
var -> (GetInput var -> GetInput var) -> m ()
Worker.pushInput ProjectionProcess
projectionP \GetInput ProjectionProcess
input -> GetInput ProjectionProcess
ProjectionInput
input
{ $sel:projectionScreen:ProjectionInput :: Extent2D
Camera.projectionScreen = Extent2D
windowSize
}
pure SwapchainResources :: SwapchainInfo
-> Vector ImageView
-> Vector Image
-> RefCounted
-> ProjectionProcess
-> SwapchainResources
SwapchainResources
{ $sel:srInfo:SwapchainResources :: SwapchainInfo
srInfo = SwapchainInfo
info
, $sel:srImageViews:SwapchainResources :: Vector ImageView
srImageViews = Vector ImageView
imageViews
, $sel:srImages:SwapchainResources :: Vector Image
srImages = Vector Image
swapchainImages
, $sel:srRelease:SwapchainResources :: RefCounted
srRelease = RefCounted
releaseResources
, $sel:srProjection:SwapchainResources :: ProjectionProcess
srProjection = ProjectionProcess
projectionP
}
recreateSwapchainResources
:: ( MonadResource (RIO env)
, HasVulkan env
, HasLogFunc env
)
=> Vk.Extent2D
-> SwapchainResources
-> RIO env SwapchainResources
recreateSwapchainResources :: Extent2D -> SwapchainResources -> RIO env SwapchainResources
recreateSwapchainResources Extent2D
windowSize SwapchainResources
oldResources = do
SwapchainResources
sr <- SwapchainKHR
-> Extent2D
-> SurfaceKHR
-> ProjectionProcess
-> RIO env SwapchainResources
forall env.
(MonadResource (RIO env), HasVulkan env, HasLogFunc env) =>
SwapchainKHR
-> Extent2D
-> SurfaceKHR
-> ProjectionProcess
-> RIO env SwapchainResources
allocSwapchainResources
(SwapchainInfo -> SwapchainKHR
siSwapchain (SwapchainInfo -> SwapchainKHR) -> SwapchainInfo -> SwapchainKHR
forall a b. (a -> b) -> a -> b
$ SwapchainResources -> SwapchainInfo
srInfo SwapchainResources
oldResources)
Extent2D
windowSize
(SwapchainInfo -> SurfaceKHR
siSurface (SwapchainInfo -> SurfaceKHR) -> SwapchainInfo -> SurfaceKHR
forall a b. (a -> b) -> a -> b
$ SwapchainResources -> SwapchainInfo
srInfo SwapchainResources
oldResources)
(SwapchainResources -> ProjectionProcess
srProjection SwapchainResources
oldResources)
RefCounted -> RIO env ()
forall (m :: * -> *). MonadIO m => RefCounted -> m ()
releaseRefCounted (SwapchainResources -> RefCounted
srRelease SwapchainResources
oldResources)
pure SwapchainResources
sr
createSwapchain
:: ( MonadResource m
, MonadVulkan env m
, HasLogFunc env
)
=> Khr.SwapchainKHR
-> Vk.Extent2D
-> Khr.SurfaceKHR
-> m SwapchainInfo
createSwapchain :: SwapchainKHR -> Extent2D -> SurfaceKHR -> m SwapchainInfo
createSwapchain SwapchainKHR
oldSwapchain Extent2D
explicitSize SurfaceKHR
surf = do
PhysicalDevice
physical <- (env -> PhysicalDevice) -> m PhysicalDevice
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PhysicalDevice
forall a. HasVulkan a => a -> PhysicalDevice
getPhysicalDevice
Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
PhysicalDeviceProperties
props <- (env -> PhysicalDeviceProperties) -> m PhysicalDeviceProperties
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((env -> PhysicalDeviceProperties) -> m PhysicalDeviceProperties)
-> (env -> PhysicalDeviceProperties) -> m PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ PhysicalDeviceInfo -> PhysicalDeviceProperties
pdiProperties (PhysicalDeviceInfo -> PhysicalDeviceProperties)
-> (env -> PhysicalDeviceInfo) -> env -> PhysicalDeviceProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> PhysicalDeviceInfo
forall a. HasVulkan a => a -> PhysicalDeviceInfo
getPhysicalDeviceInfo
SurfaceCapabilitiesKHR
surfaceCaps <- PhysicalDevice -> SurfaceKHR -> m SurfaceCapabilitiesKHR
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> SurfaceKHR -> io SurfaceCapabilitiesKHR
Khr.getPhysicalDeviceSurfaceCapabilitiesKHR PhysicalDevice
physical SurfaceKHR
surf
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ SurfaceCapabilitiesKHR -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SurfaceCapabilitiesKHR
surfaceCaps
[ImageUsageFlagBits] -> (ImageUsageFlagBits -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ImageUsageFlagBits]
requiredUsageFlags \ImageUsageFlagBits
flag ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SurfaceCapabilitiesKHR -> ImageUsageFlagBits
Khr.supportedUsageFlags SurfaceCapabilitiesKHR
surfaceCaps ImageUsageFlagBits -> ImageUsageFlagBits -> Bool
forall a. Bits a => a -> a -> Bool
.&&. ImageUsageFlagBits
flag) do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Surface images do not support " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ImageUsageFlagBits -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ImageUsageFlagBits
flag
String -> m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Surface images do not support " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ImageUsageFlagBits -> String
forall a. Show a => a -> String
show ImageUsageFlagBits
flag
(Result
_, "presentModes" ::: Vector PresentModeKHR
availablePresentModes) <- PhysicalDevice
-> SurfaceKHR
-> m (Result, "presentModes" ::: Vector PresentModeKHR)
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> SurfaceKHR
-> io (Result, "presentModes" ::: Vector PresentModeKHR)
Khr.getPhysicalDeviceSurfacePresentModesKHR PhysicalDevice
physical SurfaceKHR
surf
PresentModeKHR
presentMode <-
case (PresentModeKHR -> Bool) -> [PresentModeKHR] -> [PresentModeKHR]
forall a. (a -> Bool) -> [a] -> [a]
filter (PresentModeKHR
-> ("presentModes" ::: Vector PresentModeKHR) -> Bool
forall (v :: * -> *) a. (Vector v a, Eq a) => a -> v a -> Bool
`V.elem` "presentModes" ::: Vector PresentModeKHR
availablePresentModes) [PresentModeKHR]
desiredPresentModes of
[] -> do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"Unable to find a suitable present mode for swapchain"
String -> m PresentModeKHR
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"Unable to find a suitable present mode for swapchain"
PresentModeKHR
x : [PresentModeKHR]
_rest ->
PresentModeKHR -> m PresentModeKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure PresentModeKHR
x
SurfaceFormatKHR
surfaceFormatKhr <- PhysicalDevice
-> SurfaceKHR -> SurfaceFormatKHR -> m SurfaceFormatKHR
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> SurfaceKHR -> SurfaceFormatKHR -> io SurfaceFormatKHR
getSurfaceFormatKhr PhysicalDevice
physical SurfaceKHR
surf SurfaceFormatKHR
preferSrgb
Format
depthFormat <- PhysicalDevice -> [Format] -> m [Format]
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> [Format] -> io [Format]
getDepthFormats PhysicalDevice
physical [Format]
preferStenciledDepth m [Format] -> ([Format] -> m Format) -> m Format
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Format
fmt : [Format]
_rest ->
Format -> m Format
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
fmt
[Format]
_none ->
String -> m Format
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"Unable to find a suitable depth format"
let
imageExtent :: Extent2D
imageExtent =
case SurfaceCapabilitiesKHR -> Extent2D
Khr.currentExtent (SurfaceCapabilitiesKHR
surfaceCaps :: Khr.SurfaceCapabilitiesKHR) of
Vk.Extent2D Word32
w Word32
h | Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Bounded a => a
maxBound, Word32
h Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Bounded a => a
maxBound ->
Extent2D
explicitSize
Extent2D
extent ->
Extent2D
extent
let
minImageCount :: Word32
minImageCount =
let
limit :: Word32
limit = case SurfaceCapabilitiesKHR -> Word32
Khr.maxImageCount (SurfaceCapabilitiesKHR
surfaceCaps :: Khr.SurfaceCapabilitiesKHR) of
Word32
0 -> Word32
forall a. Bounded a => a
maxBound
Word32
n -> Word32
n
buffer :: Word32
buffer = Word32
1
desired :: Word32
desired =
Word32
buffer Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SurfaceCapabilitiesKHR -> Word32
Khr.minImageCount (SurfaceCapabilitiesKHR
surfaceCaps :: Khr.SurfaceCapabilitiesKHR)
in
Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
limit Word32
desired
let compositeAlphaMode :: CompositeAlphaFlagBitsKHR
compositeAlphaMode = CompositeAlphaFlagBitsKHR
Khr.COMPOSITE_ALPHA_OPAQUE_BIT_KHR
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CompositeAlphaFlagBitsKHR
compositeAlphaMode CompositeAlphaFlagBitsKHR -> CompositeAlphaFlagBitsKHR -> Bool
forall a. Bits a => a -> a -> Bool
.&&. SurfaceCapabilitiesKHR -> CompositeAlphaFlagBitsKHR
Khr.supportedCompositeAlpha SurfaceCapabilitiesKHR
surfaceCaps) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Surface doesn't support " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CompositeAlphaFlagBitsKHR -> String
forall a. Show a => a -> String
show CompositeAlphaFlagBitsKHR
compositeAlphaMode
let
Khr.SurfaceFormatKHR{$sel:colorSpace:SurfaceFormatKHR :: SurfaceFormatKHR -> ColorSpaceKHR
colorSpace=ColorSpaceKHR
surfaceColorspace, $sel:format:SurfaceFormatKHR :: SurfaceFormatKHR -> Format
format=Format
surfaceFormat} = SurfaceFormatKHR
surfaceFormatKhr
swapchainCreateInfo :: SwapchainCreateInfoKHR '[]
swapchainCreateInfo = SwapchainCreateInfoKHR :: forall (es :: [*]).
Chain es
-> SwapchainCreateFlagsKHR
-> SurfaceKHR
-> Word32
-> Format
-> ColorSpaceKHR
-> Extent2D
-> Word32
-> ImageUsageFlagBits
-> SharingMode
-> Vector Word32
-> SurfaceTransformFlagBitsKHR
-> CompositeAlphaFlagBitsKHR
-> PresentModeKHR
-> Bool
-> SwapchainKHR
-> SwapchainCreateInfoKHR es
Khr.SwapchainCreateInfoKHR
{ $sel:surface:SwapchainCreateInfoKHR :: SurfaceKHR
surface = SurfaceKHR
surf
, $sel:next:SwapchainCreateInfoKHR :: Chain '[]
next = ()
, $sel:flags:SwapchainCreateInfoKHR :: SwapchainCreateFlagsKHR
flags = SwapchainCreateFlagsKHR
forall a. Zero a => a
zero
, $sel:queueFamilyIndices:SwapchainCreateInfoKHR :: Vector Word32
queueFamilyIndices = Vector Word32
forall a. Monoid a => a
mempty
, $sel:minImageCount:SwapchainCreateInfoKHR :: Word32
minImageCount = Word32
minImageCount
, $sel:imageFormat:SwapchainCreateInfoKHR :: Format
imageFormat = Format
surfaceFormat
, $sel:imageColorSpace:SwapchainCreateInfoKHR :: ColorSpaceKHR
imageColorSpace = ColorSpaceKHR
surfaceColorspace
, $sel:imageExtent:SwapchainCreateInfoKHR :: Extent2D
imageExtent = Extent2D
imageExtent
, $sel:imageArrayLayers:SwapchainCreateInfoKHR :: Word32
imageArrayLayers = Word32
1
, $sel:imageUsage:SwapchainCreateInfoKHR :: ImageUsageFlagBits
imageUsage = (ImageUsageFlagBits -> ImageUsageFlagBits -> ImageUsageFlagBits)
-> ImageUsageFlagBits -> [ImageUsageFlagBits] -> ImageUsageFlagBits
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ImageUsageFlagBits -> ImageUsageFlagBits -> ImageUsageFlagBits
forall a. Bits a => a -> a -> a
(.|.) ImageUsageFlagBits
forall a. Zero a => a
zero [ImageUsageFlagBits]
requiredUsageFlags
, $sel:imageSharingMode:SwapchainCreateInfoKHR :: SharingMode
imageSharingMode = SharingMode
Vk.SHARING_MODE_EXCLUSIVE
, $sel:preTransform:SwapchainCreateInfoKHR :: SurfaceTransformFlagBitsKHR
preTransform = SurfaceCapabilitiesKHR -> SurfaceTransformFlagBitsKHR
Khr.currentTransform (SurfaceCapabilitiesKHR
surfaceCaps :: Khr.SurfaceCapabilitiesKHR)
, $sel:compositeAlpha:SwapchainCreateInfoKHR :: CompositeAlphaFlagBitsKHR
compositeAlpha = CompositeAlphaFlagBitsKHR
compositeAlphaMode
, $sel:presentMode:SwapchainCreateInfoKHR :: PresentModeKHR
presentMode = PresentModeKHR
presentMode
, $sel:clipped:SwapchainCreateInfoKHR :: Bool
clipped = Bool
True
, $sel:oldSwapchain:SwapchainCreateInfoKHR :: SwapchainKHR
oldSwapchain = SwapchainKHR
oldSwapchain
}
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Creating swapchain from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SwapchainCreateInfoKHR '[] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SwapchainCreateInfoKHR '[]
swapchainCreateInfo
(ReleaseKey
key, SwapchainKHR
swapchain) <- Device
-> SwapchainCreateInfoKHR '[]
-> Maybe AllocationCallbacks
-> (IO SwapchainKHR
-> (SwapchainKHR -> IO ()) -> m (ReleaseKey, SwapchainKHR))
-> m (ReleaseKey, SwapchainKHR)
forall (a :: [*]) (io :: * -> *) r.
(Extendss SwapchainCreateInfoKHR a, PokeChain a, MonadIO io) =>
Device
-> SwapchainCreateInfoKHR a
-> Maybe AllocationCallbacks
-> (io SwapchainKHR -> (SwapchainKHR -> io ()) -> r)
-> r
Khr.withSwapchainKHR Device
device SwapchainCreateInfoKHR '[]
swapchainCreateInfo Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO SwapchainKHR
-> (SwapchainKHR -> IO ()) -> m (ReleaseKey, SwapchainKHR)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
pure SwapchainInfo :: SwapchainKHR
-> ReleaseKey
-> PresentModeKHR
-> Word32
-> Format
-> ColorSpaceKHR
-> Format
-> SampleCountFlagBits
-> Float
-> Extent2D
-> SurfaceKHR
-> SwapchainInfo
SwapchainInfo
{ $sel:siSwapchain:SwapchainInfo :: SwapchainKHR
siSwapchain = SwapchainKHR
swapchain
, $sel:siSwapchainReleaseKey:SwapchainInfo :: ReleaseKey
siSwapchainReleaseKey = ReleaseKey
key
, $sel:siPresentMode:SwapchainInfo :: PresentModeKHR
siPresentMode = PresentModeKHR
presentMode
, $sel:siMinImageCount:SwapchainInfo :: Word32
siMinImageCount = Word32
minImageCount
, $sel:siSurface:SwapchainInfo :: SurfaceKHR
siSurface = SurfaceKHR
surf
, $sel:siSurfaceFormat:SwapchainInfo :: Format
siSurfaceFormat = Format
surfaceFormat
, $sel:siSurfaceColorspace:SwapchainInfo :: ColorSpaceKHR
siSurfaceColorspace = ColorSpaceKHR
surfaceColorspace
, $sel:siDepthFormat:SwapchainInfo :: Format
siDepthFormat = Format
depthFormat
, $sel:siMultisample:SwapchainInfo :: SampleCountFlagBits
siMultisample = PhysicalDeviceProperties -> SampleCountFlagBits
msaaSamples PhysicalDeviceProperties
props
, $sel:siAnisotropy:SwapchainInfo :: Float
siAnisotropy = PhysicalDeviceLimits -> Float
Vk.maxSamplerAnisotropy (PhysicalDeviceProperties -> PhysicalDeviceLimits
Vk.limits PhysicalDeviceProperties
props)
, $sel:siImageExtent:SwapchainInfo :: Extent2D
siImageExtent = Extent2D
imageExtent
}
getSurfaceFormatKhr
:: MonadIO io
=> Vk.PhysicalDevice
-> Khr.SurfaceKHR
-> Khr.SurfaceFormatKHR
-> io Khr.SurfaceFormatKHR
getSurfaceFormatKhr :: PhysicalDevice
-> SurfaceKHR -> SurfaceFormatKHR -> io SurfaceFormatKHR
getSurfaceFormatKhr PhysicalDevice
device SurfaceKHR
surface SurfaceFormatKHR
desiredFormat = do
(Result
_res, "surfaceFormats" ::: Vector SurfaceFormatKHR
formats) <- PhysicalDevice
-> SurfaceKHR
-> io (Result, "surfaceFormats" ::: Vector SurfaceFormatKHR)
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> SurfaceKHR
-> io (Result, "surfaceFormats" ::: Vector SurfaceFormatKHR)
Khr.getPhysicalDeviceSurfaceFormatsKHR PhysicalDevice
device SurfaceKHR
surface
SurfaceFormatKHR -> io SurfaceFormatKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure case ("surfaceFormats" ::: Vector SurfaceFormatKHR)
-> [SurfaceFormatKHR]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList "surfaceFormats" ::: Vector SurfaceFormatKHR
formats of
[] ->
SurfaceFormatKHR
desiredFormat
[Khr.SurfaceFormatKHR Vk.FORMAT_UNDEFINED _colorSpace] ->
SurfaceFormatKHR
desiredFormat
[SurfaceFormatKHR]
candidates | (SurfaceFormatKHR -> Bool) -> [SurfaceFormatKHR] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SurfaceFormatKHR -> Bool
cond [SurfaceFormatKHR]
candidates ->
SurfaceFormatKHR
desiredFormat
SurfaceFormatKHR
whatever : [SurfaceFormatKHR]
_rest ->
SurfaceFormatKHR
whatever
where
cond :: SurfaceFormatKHR -> Bool
cond SurfaceFormatKHR
f =
SurfaceFormatKHR -> Format
Khr.format SurfaceFormatKHR
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== SurfaceFormatKHR -> Format
Khr.format SurfaceFormatKHR
desiredFormat Bool -> Bool -> Bool
&&
SurfaceFormatKHR -> ColorSpaceKHR
Khr.colorSpace SurfaceFormatKHR
f ColorSpaceKHR -> ColorSpaceKHR -> Bool
forall a. Eq a => a -> a -> Bool
== SurfaceFormatKHR -> ColorSpaceKHR
Khr.colorSpace SurfaceFormatKHR
desiredFormat
preferSrgb :: Khr.SurfaceFormatKHR
preferSrgb :: SurfaceFormatKHR
preferSrgb =
Format -> ColorSpaceKHR -> SurfaceFormatKHR
Khr.SurfaceFormatKHR
Format
Vk.FORMAT_B8G8R8A8_SRGB
ColorSpaceKHR
Khr.COLOR_SPACE_SRGB_NONLINEAR_KHR
getDepthFormats
:: MonadIO io
=> Vk.PhysicalDevice
-> [Vk.Format]
-> io [Vk.Format]
getDepthFormats :: PhysicalDevice -> [Format] -> io [Format]
getDepthFormats PhysicalDevice
device [Format]
desiredDepthFormats = do
[FormatProperties]
properties <- (Format -> io FormatProperties)
-> [Format] -> io [FormatProperties]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PhysicalDevice -> Format -> io FormatProperties
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> Format -> io FormatProperties
Vk.getPhysicalDeviceFormatProperties PhysicalDevice
device) [Format]
desiredDepthFormats
pure do
(Format
format, FormatProperties
props) <- [Format] -> [FormatProperties] -> [(Format, FormatProperties)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Format]
desiredDepthFormats [FormatProperties]
properties
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$
FormatProperties -> FormatFeatureFlags
Vk.optimalTilingFeatures FormatProperties
props FormatFeatureFlags -> FormatFeatureFlags -> Bool
forall a. Bits a => a -> a -> Bool
.&&. FormatFeatureFlags
Vk.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT
pure Format
format
preferStenciledDepth :: [Vk.Format]
preferStenciledDepth :: [Format]
preferStenciledDepth =
[ Item [Format]
Format
Vk.FORMAT_D32_SFLOAT_S8_UINT
, Item [Format]
Format
Vk.FORMAT_D24_UNORM_S8_UINT
, Item [Format]
Format
Vk.FORMAT_D32_SFLOAT
]
msaaSamples :: Vk.PhysicalDeviceProperties -> Vk.SampleCountFlagBits
msaaSamples :: PhysicalDeviceProperties -> SampleCountFlagBits
msaaSamples Vk.PhysicalDeviceProperties{PhysicalDeviceLimits
limits :: PhysicalDeviceLimits
$sel:limits:PhysicalDeviceProperties :: PhysicalDeviceProperties -> PhysicalDeviceLimits
limits} =
case [SampleCountFlagBits]
samplesAvailable of
[] ->
SampleCountFlagBits
Vk.SAMPLE_COUNT_1_BIT
SampleCountFlagBits
best : [SampleCountFlagBits]
_rest ->
SampleCountFlagBits
best
where
counts :: SampleCountFlagBits
counts =
PhysicalDeviceLimits -> SampleCountFlagBits
Vk.framebufferColorSampleCounts PhysicalDeviceLimits
limits SampleCountFlagBits -> SampleCountFlagBits -> SampleCountFlagBits
forall a. Bits a => a -> a -> a
.&.
PhysicalDeviceLimits -> SampleCountFlagBits
Vk.framebufferDepthSampleCounts PhysicalDeviceLimits
limits
samplesAvailable :: [SampleCountFlagBits]
samplesAvailable = do
SampleCountFlagBits
countBit <- [SampleCountFlagBits]
msaaCandidates
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ (SampleCountFlagBits
counts SampleCountFlagBits -> SampleCountFlagBits -> SampleCountFlagBits
forall a. Bits a => a -> a -> a
.&. SampleCountFlagBits
countBit) SampleCountFlagBits -> SampleCountFlagBits -> Bool
forall a. Eq a => a -> a -> Bool
/= SampleCountFlagBits
forall a. Bits a => a
zeroBits
pure SampleCountFlagBits
countBit
msaaCandidates :: [Vk.SampleCountFlagBits]
msaaCandidates :: [SampleCountFlagBits]
msaaCandidates =
[ Item [SampleCountFlagBits]
SampleCountFlagBits
Vk.SAMPLE_COUNT_4_BIT
, Item [SampleCountFlagBits]
SampleCountFlagBits
Vk.SAMPLE_COUNT_2_BIT
]
desiredPresentModes :: [Khr.PresentModeKHR]
desiredPresentModes :: [PresentModeKHR]
desiredPresentModes =
[ Item [PresentModeKHR]
PresentModeKHR
Khr.PRESENT_MODE_FIFO_RELAXED_KHR
, Item [PresentModeKHR]
PresentModeKHR
Khr.PRESENT_MODE_FIFO_KHR
, Item [PresentModeKHR]
PresentModeKHR
Khr.PRESENT_MODE_IMMEDIATE_KHR
]
requiredUsageFlags :: [Vk.ImageUsageFlagBits]
requiredUsageFlags :: [ImageUsageFlagBits]
requiredUsageFlags =
[ Item [ImageUsageFlagBits]
ImageUsageFlagBits
Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT
]
threwSwapchainError :: MonadUnliftIO f => f () -> f Bool
threwSwapchainError :: f () -> f Bool
threwSwapchainError = (Either Result () -> Bool) -> f (Either Result ()) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Result () -> Bool
forall a b. Either a b -> Bool
isLeft (f (Either Result ()) -> f Bool)
-> (f () -> f (Either Result ())) -> f () -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VulkanException -> Maybe Result) -> f () -> f (Either Result ())
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust VulkanException -> Maybe Result
swapchainError
where
swapchainError :: VulkanException -> Maybe Result
swapchainError = \case
VulkanException e :: Result
e@Result
Vk.ERROR_OUT_OF_DATE_KHR ->
Result -> Maybe Result
forall a. a -> Maybe a
Just Result
e
VulkanException Result
Vk.ERROR_SURFACE_LOST_KHR ->
String -> Maybe Result
forall a. HasCallStack => String -> a
error String
"TODO: handle ERROR_SURFACE_LOST_KHR"
VulkanException Result
_ ->
Maybe Result
forall a. Maybe a
Nothing
createImageView
:: ( MonadResource m
, MonadVulkan env m
)
=> Vk.Format
-> Vk.Image
-> m (Resource.ReleaseKey, Vk.ImageView)
createImageView :: Format -> Image -> m (ReleaseKey, ImageView)
createImageView Format
format Image
image = do
Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
Device
-> ImageViewCreateInfo '[]
-> Maybe AllocationCallbacks
-> (IO ImageView
-> (ImageView -> IO ()) -> m (ReleaseKey, ImageView))
-> m (ReleaseKey, ImageView)
forall (a :: [*]) (io :: * -> *) r.
(Extendss ImageViewCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ImageViewCreateInfo a
-> Maybe AllocationCallbacks
-> (io ImageView -> (ImageView -> io ()) -> r)
-> r
Vk.withImageView Device
device ImageViewCreateInfo '[]
imageViewCI Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO ImageView -> (ImageView -> IO ()) -> m (ReleaseKey, ImageView)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
where
imageViewCI :: ImageViewCreateInfo '[]
imageViewCI = ImageViewCreateInfo '[]
forall a. Zero a => a
zero
{ $sel:image:ImageViewCreateInfo :: Image
Vk.image = Image
image
, $sel:viewType:ImageViewCreateInfo :: ImageViewType
Vk.viewType = ImageViewType
Vk.IMAGE_VIEW_TYPE_2D
, $sel:format:ImageViewCreateInfo :: Format
Vk.format = Format
format
, $sel:subresourceRange:ImageViewCreateInfo :: ImageSubresourceRange
Vk.subresourceRange = ImageSubresourceRange
forall a. Zero a => a
zero
{ $sel:aspectMask:ImageSubresourceRange :: ImageAspectFlags
Vk.aspectMask = ImageAspectFlags
Vk.IMAGE_ASPECT_COLOR_BIT
, $sel:baseMipLevel:ImageSubresourceRange :: Word32
Vk.baseMipLevel = Word32
0
, $sel:levelCount:ImageSubresourceRange :: Word32
Vk.levelCount = Word32
1
, $sel:baseArrayLayer:ImageSubresourceRange :: Word32
Vk.baseArrayLayer = Word32
0
, $sel:layerCount:ImageSubresourceRange :: Word32
Vk.layerCount = Word32
1
}
}
setDynamic
:: MonadIO io
=> Vk.CommandBuffer
-> "viewport" ::: Vk.Rect2D
-> "scissor" ::: Vk.Rect2D
-> io ()
setDynamic :: CommandBuffer
-> ("viewport" ::: Rect2D) -> ("viewport" ::: Rect2D) -> io ()
setDynamic CommandBuffer
cb "viewport" ::: Rect2D
viewrect "viewport" ::: Rect2D
scissor = do
CommandBuffer
-> Word32 -> ("viewports" ::: Vector Viewport) -> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32 -> ("viewports" ::: Vector Viewport) -> io ()
Vk.cmdSetViewport CommandBuffer
cb Word32
0 [Item ("viewports" ::: Vector Viewport)
Viewport
viewport]
CommandBuffer
-> Word32
-> ("scissors" ::: Vector ("viewport" ::: Rect2D))
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> ("scissors" ::: Vector ("viewport" ::: Rect2D))
-> io ()
Vk.cmdSetScissor CommandBuffer
cb Word32
0 [Item ("scissors" ::: Vector ("viewport" ::: Rect2D))
"viewport" ::: Rect2D
scissor]
where
viewport :: Viewport
viewport = Viewport :: Float -> Float -> Float -> Float -> Float -> Float -> Viewport
Vk.Viewport
{ $sel:x:Viewport :: Float
x = Int32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
x
, $sel:y:Viewport :: Float
y = Int32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
y
, $sel:width:Viewport :: Float
width = Word32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
width
, $sel:height:Viewport :: Float
height = Word32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
height
, $sel:minDepth:Viewport :: Float
minDepth = Float
0
, $sel:maxDepth:Viewport :: Float
maxDepth = Float
1
}
where
Vk.Offset2D{Int32
$sel:x:Offset2D :: Offset2D -> Int32
x :: Int32
x, Int32
$sel:y:Offset2D :: Offset2D -> Int32
y :: Int32
y} = Offset2D
offset
Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = Extent2D
extent
Vk.Rect2D{Offset2D
$sel:offset:Rect2D :: ("viewport" ::: Rect2D) -> Offset2D
offset :: Offset2D
offset, Extent2D
$sel:extent:Rect2D :: ("viewport" ::: Rect2D) -> Extent2D
extent :: Extent2D
extent} = "viewport" ::: Rect2D
viewrect
setDynamicFullscreen :: MonadIO io => Vk.CommandBuffer -> SwapchainResources -> io ()
setDynamicFullscreen :: CommandBuffer -> SwapchainResources -> io ()
setDynamicFullscreen CommandBuffer
cb SwapchainResources
sr = do
CommandBuffer
-> Word32 -> ("viewports" ::: Vector Viewport) -> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32 -> ("viewports" ::: Vector Viewport) -> io ()
Vk.cmdSetViewport CommandBuffer
cb
Word32
0
[ Viewport :: Float -> Float -> Float -> Float -> Float -> Float -> Viewport
Vk.Viewport
{ $sel:x:Viewport :: Float
x = Float
0
, $sel:y:Viewport :: Float
y = Float
0
, $sel:width:Viewport :: Float
width = Word32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
width
, $sel:height:Viewport :: Float
height = Word32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
height
, $sel:minDepth:Viewport :: Float
minDepth = Float
0
, $sel:maxDepth:Viewport :: Float
maxDepth = Float
1
}
]
CommandBuffer
-> Word32
-> ("scissors" ::: Vector ("viewport" ::: Rect2D))
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> ("scissors" ::: Vector ("viewport" ::: Rect2D))
-> io ()
Vk.cmdSetScissor CommandBuffer
cb Word32
0
[ Rect2D :: Offset2D -> Extent2D -> "viewport" ::: Rect2D
Vk.Rect2D
{ $sel:offset:Rect2D :: Offset2D
offset = Int32 -> Int32 -> Offset2D
Vk.Offset2D Int32
0 Int32
0
, $sel:extent:Rect2D :: Extent2D
extent = Extent2D
siImageExtent
}
]
where
SwapchainResources{SwapchainInfo
srInfo :: SwapchainInfo
$sel:srInfo:SwapchainResources :: SwapchainResources -> SwapchainInfo
srInfo} = SwapchainResources
sr
SwapchainInfo{Extent2D
siImageExtent :: Extent2D
$sel:siImageExtent:SwapchainInfo :: SwapchainInfo -> Extent2D
siImageExtent} = SwapchainInfo
srInfo
Vk.Extent2D{Word32
width :: Word32
$sel:width:Extent2D :: Extent2D -> Word32
width, Word32
height :: Word32
$sel:height:Extent2D :: Extent2D -> Word32
height} = Extent2D
siImageExtent