creating image views complete

This commit is contained in:
nek0 2022-07-11 14:01:04 +02:00
parent afd7f8da37
commit 200b28ac31
3 changed files with 63 additions and 43 deletions

View file

@ -87,53 +87,91 @@ createSwapchain
-> V.Vector Vk.SurfaceFormatKHR
-> V2 CInt
-> Vk.Device
-> m Vk.SwapchainKHR
-> m (Vk.SwapchainKHR, Vk.SurfaceFormatKHR)
createSwapchain surface surfaceFormats windowDimension logicalDevice = do
liftIO $ do
print ("available formats:" :: String)
print surfaceFormats
(surfaceFormat, colorSpace) <-
if
V.any
(\a ->
(Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) a ==
Vk.FORMAT_B8G8R8A8_SRGB
&& (Vk.colorSpace :: Vk.SurfaceFormatKHR -> Vk.ColorSpaceKHR) a ==
Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
surfaceFormats
then
return (Vk.FORMAT_B8G8R8A8_SRGB, Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
else
error ("createSwapchain: No suitable surface formats available" :: String)
liftIO $ do
print ("picking following format and color space:" :: String)
print (surfaceFormat, colorSpace)
let createInfo = Vk.zero
{ Vk.surface = surface
, Vk.minImageCount = 4
, Vk.imageFormat = Vk.FORMAT_B8G8R8A8_SRGB
, Vk.imageColorSpace = Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR
, Vk.imageExtent =
{ Vk.surface = surface
, Vk.minImageCount = 4
, Vk.imageFormat = surfaceFormat
, Vk.imageColorSpace = colorSpace
, Vk.imageExtent =
(\(V2 w h) -> Vk.Extent2D (fromIntegral w) (fromIntegral h)) windowDimension
, Vk.imageArrayLayers = 1
, Vk.imageUsage = Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT
, Vk.presentMode = Vk.PRESENT_MODE_MAILBOX_KHR
, Vk.preTransform = Vk.SURFACE_TRANSFORM_IDENTITY_BIT_KHR
, Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_OPAQUE_BIT_KHR
, Vk.clipped = True
, Vk.imageUsage = Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT
, Vk.presentMode = Vk.PRESENT_MODE_MAILBOX_KHR
, Vk.preTransform = Vk.SURFACE_TRANSFORM_IDENTITY_BIT_KHR
, Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_OPAQUE_BIT_KHR
, Vk.clipped = True
}
snd <$> allocate
swapchain <- snd <$> allocate
(Vk.createSwapchainKHR logicalDevice createInfo Nothing)
(\swapchain -> do
print ("destroying Swapchain" :: String)
print ("destroying swapchain" :: String)
Vk.destroySwapchainKHR logicalDevice swapchain Nothing
)
return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace)
getImageViewHandles
:: (MonadResource m)
=> Vk.SwapchainKHR
-> Vk.SurfaceFormatKHR
-> Vk.Device
-> m (V.Vector Vk.ImageView)
getImageViewHandles swapchain logicalDevice = do
getImageViewHandles swapchain surfaceFormat logicalDevice = do
(result, handles) <- Vk.getSwapchainImagesKHR logicalDevice swapchain
when (result /= Vk.SUCCESS) $
error "getImageHandles: Failed acquiring images from swapchain"
imageViews <- V.mapM
V.mapM
(\image -> do
let createInfo = Vk.zero
{ Vk.image = image
, Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
{ Vk.image = image
, Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
, Vk.format = (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) surfaceFormat
, Vk.components = Vk.ComponentMapping
{ Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY
, Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY
, Vk.b = Vk.COMPONENT_SWIZZLE_IDENTITY
, Vk.a = Vk.COMPONENT_SWIZZLE_IDENTITY
}
, Vk.subresourceRange = Vk.ImageSubresourceRange
{ aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
, baseMipLevel = 0
, levelCount = 1
, baseArrayLayer = 0
, layerCount = 1
}
}
return ()
snd <$> allocate
(Vk.createImageView logicalDevice createInfo Nothing)
(\imageView -> do
print ("destrying image view" :: String)
Vk.destroyImageView logicalDevice imageView Nothing
)
)
V.empty
error "getImageHandles: Not yet implemented"
handles

View file

@ -4,22 +4,13 @@
module Init where
import Control.Monad
import Control.Monad.Loops
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import Data.Word
import qualified SDL hiding (V2)
import qualified SDL.Video.Vulkan as SDL
import qualified Control.Concurrent.STM as STM
import Foreign.C.Types (CInt)
import Foreign.Ptr
import Linear
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
import qualified Vulkan.CStruct.Extends as Vk
-- internal imports
@ -72,7 +63,7 @@ initVulkan window = do
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
)
(\vulkanSurface -> do
print ("destroying Surface" :: String)
print ("destroying surface" :: String)
Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing
)
@ -80,7 +71,7 @@ initVulkan window = do
(vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
swapchain <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice
images <- getImageViewHandles swapchain vulkanLogicalDevice
(swapchain, surfaceFormat) <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
return (vulkanSurface, vulkanInstance, swapchain, images)
return (vulkanSurface, vulkanInstance, swapchain, imageViews)

View file

@ -8,24 +8,15 @@ import Control.Monad.Loops
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import Data.Word
import qualified SDL hiding (V2)
import qualified SDL.Video.Vulkan as SDL
import qualified Control.Concurrent.STM as STM
import Foreign.C.Types (CInt)
import Foreign.Ptr
import Linear
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
import qualified Vulkan.CStruct.Extends as Vk
-- internal imports
import Init
import Devices
import Instance
main :: IO ()
main = runResourceT $ do