fix ambiguous record updates

This commit is contained in:
nek0 2023-08-24 19:48:36 +02:00
parent 6d625cabf6
commit 06e3d5c2ec
4 changed files with 11 additions and 10 deletions

View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Devices where module Devices where
import Control.Monad import Control.Monad
@ -38,7 +39,7 @@ pickPhysicalDevice vkInstance = do
physDevices physDevices
let discretePhysDevices = V.filter let discretePhysDevices = V.filter
(\(_, devProps, devFeatures) -> (\(_, _, devFeatures) ->
-- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU && -- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
Vk.geometryShader devFeatures Vk.geometryShader devFeatures
) )
@ -140,9 +141,9 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
if if
V.any V.any
(\a -> (\a ->
(Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) a == a.format ==
Vk.FORMAT_B8G8R8A8_SRGB Vk.FORMAT_B8G8R8A8_SRGB
&& (Vk.colorSpace :: Vk.SurfaceFormatKHR -> Vk.ColorSpaceKHR) a == && a.colorSpace ==
Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR) Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
surfaceFormats surfaceFormats
then then
@ -219,7 +220,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
let createInfo = Vk.zero let createInfo = Vk.zero
{ Vk.image = tmpImage { Vk.image = tmpImage
, Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
, Vk.format = (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) surfaceFormat , Vk.format = surfaceFormat.format
, Vk.components = Vk.ComponentMapping , Vk.components = Vk.ComponentMapping
{ Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY { Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY
, Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY , Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY

View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Main where module Main where
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
@ -11,7 +12,6 @@ import Control.Monad.Trans.Resource
import Data.Bits import Data.Bits
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Word
import qualified SDL hiding (V2) import qualified SDL hiding (V2)
import System.Mem import System.Mem
import qualified Vulkan as Vk import qualified Vulkan as Vk
@ -103,7 +103,7 @@ allocateMemory logicalDevice buffer = do
memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer
let memoryAllocateInfo = Vk.zero let memoryAllocateInfo = Vk.zero
{ Vk.allocationSize = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements { Vk.allocationSize = memoryRequirements.size
, Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String) , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
} }

View file

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Memory where module Memory where
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -27,9 +27,9 @@ initAllocator
-> m VMA.Allocator -> m VMA.Allocator
initAllocator physicalDevice device instance' = do initAllocator physicalDevice device instance' = do
let instanceProcAddr = castFunPtr $ let instanceProcAddr = castFunPtr $
Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance') Vk.pVkGetInstanceProcAddr (instance'.instanceCmds)
deviceProcAddr = castFunPtr $ deviceProcAddr = castFunPtr $
Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device) Vk.pVkGetDeviceProcAddr (device.deviceCmds)
let allocatorInfo = Vk.zero let allocatorInfo = Vk.zero
{ VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice { VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice
, VMA.device = Vk.deviceHandle device , VMA.device = Vk.deviceHandle device

View file

@ -41,7 +41,7 @@ executable vulkan-tutorial
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:
build-depends: base >=4.14.3.0 build-depends: base
, sdl2 , sdl2
, vulkan , vulkan
, vulkan-utils , vulkan-utils