2023-05-14 16:50:02 +00:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Textures where
|
|
|
|
|
|
|
|
import qualified Codec.Picture as P
|
|
|
|
import Control.Monad.IO.Class
|
2023-05-15 10:10:02 +00:00
|
|
|
import Control.Monad.Reader
|
2023-05-14 16:50:02 +00:00
|
|
|
import Control.Monad.Trans.Resource
|
2023-05-15 10:10:02 +00:00
|
|
|
import qualified Data.Map.Strict as M
|
2023-05-14 16:50:02 +00:00
|
|
|
import qualified Data.Vector as V
|
2023-05-15 10:10:02 +00:00
|
|
|
import Foreign hiding (void)
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
2023-05-14 16:50:02 +00:00
|
|
|
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
|
2023-05-15 10:10:02 +00:00
|
|
|
import Image
|
2023-05-14 16:50:02 +00:00
|
|
|
|
|
|
|
loadImageFromFile
|
|
|
|
:: (MonadResource m, MonadIO m)
|
2023-05-15 10:10:02 +00:00
|
|
|
=> VMA.Allocator
|
|
|
|
-> UploadContext
|
|
|
|
-> Vk.Queue
|
|
|
|
-> Vk.Device
|
2023-05-14 16:50:02 +00:00
|
|
|
-> FilePath
|
|
|
|
-> m AllocatedImage
|
2023-05-15 10:10:02 +00:00
|
|
|
loadImageFromFile allocator uploadContext queue device file = do
|
2023-05-14 16:50:02 +00:00
|
|
|
|
|
|
|
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
|
2023-05-15 10:10:02 +00:00
|
|
|
allocator
|
2023-05-14 16:50:02 +00:00
|
|
|
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 <$>
|
2023-05-15 10:10:02 +00:00
|
|
|
VMA.withImage allocator dImgCreateInfo dImgAllocCreateInfo allocate
|
2023-05-14 16:50:02 +00:00
|
|
|
|
|
|
|
immediateSubmit
|
2023-05-15 10:10:02 +00:00
|
|
|
uploadContext
|
|
|
|
queue
|
|
|
|
device
|
2023-05-14 16:50:02 +00:00
|
|
|
(\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
|
|
|
|
}
|
2023-05-15 10:10:02 +00:00
|
|
|
|
|
|
|
loadImages
|
|
|
|
:: (MonadResource m, MonadReader ReadState m)
|
|
|
|
=> VMA.Allocator
|
|
|
|
-> UploadContext
|
|
|
|
-> Vk.Queue
|
|
|
|
-> Vk.Device
|
|
|
|
-> m ()
|
|
|
|
loadImages allocator uploadContext queue device = do
|
|
|
|
|
|
|
|
loadedImage <- loadImageFromFile allocator uploadContext queue device "assets/textures/bricks.png"
|
|
|
|
|
|
|
|
let imageInfo = imageviewCreate (image loadedImage) Vk.FORMAT_R8G8B8A8_SRGB Vk.IMAGE_ASPECT_COLOR_BIT
|
|
|
|
|
|
|
|
imageView <- snd <$> Vk.withImageView device imageInfo Nothing allocate
|
|
|
|
|
|
|
|
let texture = Texture
|
|
|
|
{ textureImage = loadedImage
|
|
|
|
, textureImageView = imageView
|
|
|
|
}
|
|
|
|
|
|
|
|
textureLib <- asks textureLibrary
|
|
|
|
|
|
|
|
void $ liftIO $ STM.atomically $ do
|
|
|
|
texMap <- STM.readTMVar textureLib
|
|
|
|
|
|
|
|
let newMap = M.insert "bricks" texture texMap
|
|
|
|
|
|
|
|
STM.swapTMVar textureLib newMap
|