{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} module Textures where import qualified Codec.Picture as P import Control.Monad.IO.Class import Control.Monad.Trans.Resource import qualified Data.Vector as V import qualified Data.Vector.Storable as VS import Foreign import qualified Vulkan as Vk import qualified Vulkan.CStruct.Extends as Vk import qualified Vulkan.Zero as Vk import qualified VulkanMemoryAllocator as VMA -- internal imports import Types import Memory import Sync loadImageFromFile :: (MonadResource m, MonadIO m) => EngineData -> FilePath -> m AllocatedImage loadImageFromFile engineData file = do pixels <- liftIO $ either error P.convertRGBA8 <$> P.readImage file let texWidth = P.imageWidth pixels texHeight = P.imageHeight pixels imageSize = 4 * texWidth * texHeight imageFormat = Vk.FORMAT_R8G8B8A8_SRGB stagingBuffer <- createAllocatedBuffer (engineAllocator engineData) imageSize Vk.BUFFER_USAGE_TRANSFER_SRC_BIT VMA.MEMORY_USAGE_CPU_ONLY let dataPtr = VMA.mappedData (bufferInfo stagingBuffer) liftIO $ V.mapM_ (\(idx, px) -> poke (castPtr dataPtr `plusPtr` (idx * sizeOf px)) px ) (V.zip (V.fromList [0..]) (V.convert $ P.imageData pixels) ) let imageExtent = Vk.Extent3D { width = fromIntegral $ texWidth , height = fromIntegral $ texHeight , depth = 1 } dImgCreateInfo = Vk.zero { Vk.format = imageFormat , Vk.usage = Vk.IMAGE_USAGE_SAMPLED_BIT .|. Vk.IMAGE_USAGE_TRANSFER_DST_BIT , Vk.extent = imageExtent } dImgAllocCreateInfo = Vk.zero { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY } :: VMA.AllocationCreateInfo (newImage, allocation, _) <- snd <$> VMA.withImage (engineAllocator engineData) dImgCreateInfo dImgAllocCreateInfo allocate immediateSubmit (engineUploadContext engineData) (engineQueue engineData) (engineLogicalDevice engineData) (\cmd -> do let range = Vk.zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT , Vk.baseMipLevel = 0 , Vk.levelCount = 1 , Vk.baseArrayLayer = 0 , Vk.layerCount = 1 } imageBarrierToTransfer = V.singleton $ Vk.SomeStruct (Vk.zero { Vk.oldLayout = Vk.IMAGE_LAYOUT_UNDEFINED , Vk.newLayout = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL , Vk.image = newImage , Vk.subresourceRange = range , Vk.srcAccessMask = bit 0 , Vk.dstAccessMask = Vk.ACCESS_TRANSFER_WRITE_BIT } :: Vk.ImageMemoryBarrier '[]) Vk.cmdPipelineBarrier cmd Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT Vk.PIPELINE_STAGE_TRANSFER_BIT (bit 0) V.empty V.empty imageBarrierToTransfer let copyRegion = V.singleton (Vk.zero { Vk.bufferOffset = 0 , Vk.bufferRowLength = 0 , Vk.bufferImageHeight = 0 , Vk.imageExtent = imageExtent , Vk.imageSubresource = Vk.zero { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT , Vk.mipLevel = 0 , Vk.baseArrayLayer = 0 , Vk.layerCount = 1 } :: Vk.ImageSubresourceLayers } :: Vk.BufferImageCopy) Vk.cmdCopyBufferToImage cmd (allocatedBuffer stagingBuffer) newImage Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL copyRegion let imageBarrierToReadable = V.singleton $ Vk.SomeStruct (Vk.zero { Vk.oldLayout = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL , Vk.newLayout = Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL , Vk.image = newImage , Vk.subresourceRange = range , Vk.srcAccessMask = Vk.ACCESS_TRANSFER_WRITE_BIT , Vk.dstAccessMask = Vk.ACCESS_SHADER_READ_BIT } :: Vk.ImageMemoryBarrier '[]) Vk.cmdPipelineBarrier cmd Vk.PIPELINE_STAGE_TRANSFER_BIT Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT (bit 0) V.empty V.empty imageBarrierToReadable ) return $ AllocatedImage { image = newImage , allocation = allocation }