{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Khr.Surface.PhysicalDevice (

	-- * GET SUPPORT, FORMATS, CAPABILITIES AND PRESENT MODES

	getSupport, getFormats, getFormatsFiltered, getCapabilities, getPresentModes

	) where

import Data.HeteroParList.Constrained qualified as HeteroParListC

import Gpu.Vulkan.TypeEnum qualified as T
import Gpu.Vulkan.Khr.Surface.Enum
import Gpu.Vulkan.Khr.Surface.Type
import Gpu.Vulkan.Khr.Surface.Internal

import qualified Gpu.Vulkan.PhysicalDevice as PhysicalDevice
import qualified Gpu.Vulkan.QueueFamily as QueueFamily
import qualified Gpu.Vulkan.Khr.Surface.Middle.Internal as M
import qualified Gpu.Vulkan.Khr.Surface.PhysicalDevice.Middle as M

getSupport :: PhysicalDevice.P -> QueueFamily.Index -> S ss -> IO Bool
getSupport :: forall ss. P -> Index -> S ss -> IO Bool
getSupport P
phdvc Index
qfi (S S
sfc) = P -> Index -> S -> IO Bool
M.getSupport P
phdvc Index
qfi S
sfc

getCapabilities :: PhysicalDevice.P -> S ss -> IO M.Capabilities
getCapabilities :: forall ss. P -> S ss -> IO Capabilities
getCapabilities P
phdvc (S S
sfc) = P -> S -> IO Capabilities
M.getCapabilities P
phdvc S
sfc

getFormatsOld :: PhysicalDevice.P -> S ss -> IO [M.Format]
getFormatsOld :: forall ss. P -> S ss -> IO [Format]
getFormatsOld P
phdvc (S S
sfc) = P -> S -> IO [Format]
M.getFormats P
phdvc S
sfc

getFormats :: PhysicalDevice.P -> S ss ->
	(forall fmts .
		Show (HeteroParListC.PL T.FormatToValue Format fmts) =>
		HeteroParListC.PL T.FormatToValue Format fmts -> IO a) -> IO a
getFormats :: forall ss a.
P
-> S ss
-> (forall (fmts :: [Format]).
    Show (PL FormatToValue Format fmts) =>
    PL FormatToValue Format fmts -> IO a)
-> IO a
getFormats P
pd S ss
sfc forall (fmts :: [Format]).
Show (PL FormatToValue Format fmts) =>
PL FormatToValue Format fmts -> IO a
f = P -> S ss -> IO [Format]
forall ss. P -> S ss -> IO [Format]
getFormatsOld P
pd S ss
sfc IO [Format] -> ([Format] -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Format]
fmts -> [Format]
-> (forall (fmts :: [Format]).
    Show (PL FormatToValue Format fmts) =>
    PL FormatToValue Format fmts -> IO a)
-> IO a
forall a.
[Format]
-> (forall (fmts :: [Format]).
    Show (PL FormatToValue Format fmts) =>
    PL FormatToValue Format fmts -> a)
-> a
formatListToNew [Format]
fmts PL FormatToValue Format fmts -> IO a
forall (fmts :: [Format]).
Show (PL FormatToValue Format fmts) =>
PL FormatToValue Format fmts -> IO a
f

getFormatsFiltered :: T.FormatToValue fmt => PhysicalDevice.P -> S ss -> IO [Format fmt]
getFormatsFiltered :: forall (fmt :: Format) ss.
FormatToValue fmt =>
P -> S ss -> IO [Format fmt]
getFormatsFiltered P
pd S ss
sfc = [Format] -> [Format fmt]
forall (fmt :: Format).
FormatToValue fmt =>
[Format] -> [Format fmt]
formatFilter ([Format] -> [Format fmt]) -> IO [Format] -> IO [Format fmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P -> S ss -> IO [Format]
forall ss. P -> S ss -> IO [Format]
getFormatsOld P
pd S ss
sfc

getPresentModes :: PhysicalDevice.P -> S ss -> IO [PresentMode]
getPresentModes :: forall ss. P -> S ss -> IO [PresentMode]
getPresentModes P
phdvc (S S
sfc) = P -> S -> IO [PresentMode]
M.getPresentModes P
phdvc S
sfc