148 lines
4.3 KiB
Haskell
148 lines
4.3 KiB
Haskell
|
{-# 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
|
||
|
}
|