fir-0.1.0.0: src/FIR/Validation/Images.hs
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-|
Module: FIR.Validation.Images
Validation module for stateful operations involving images,
such as 'FIR.Syntax.Program.imageRead', 'FIR.Syntax.Program.imageWrite',
using type families with custom type errors.
This checks, for instance, that one doesn't access a non-sampled storage image
using floating-point texel coordinates.
-}
module FIR.Validation.Images
( LookupImageProperties
, ImageUsageFromProperties
, ValidImageRead, ValidImageWrite
, ValidImageCoordinate, ValidImageGradCoordinate, ValidImageOffsetCoordinate
, ImageTexelType
, MatchesFormat, BasicDim, NotCubeDim
, CanAddProj, CanAddDref
, UsesAffineCoords
, NoDuplicate
, NoMS, CanMultiSample
, NoLODOps, SupportsDepthTest
, ValidQueryImageSize, ValidQueryImageSizeLOD
, ValidQueryImageLOD, ValidQueryImageLevels, ValidQueryImageSamples
)
where
-- base
import Data.Kind
( Type, Constraint )
import Data.Type.Bool
( If, type (&&), Not )
import Data.Type.Equality
( type (==) )
import GHC.TypeLits
( Symbol
, TypeError, ErrorMessage(..)
)
import GHC.TypeNats
( Nat )
-- fir
import Data.Type.List
( Elem )
import Data.Type.Map
( Lookup )
import FIR.Binding
( Binding, BindingsMap, Var )
import {-# SOURCE #-} FIR.Prim.Image
( ImageProperties(Properties), Image
, OperandName(DepthComparison, ProjectiveCoords, BaseOperand)
, ImageCoordinateKind(..)
)
import FIR.Prim.Types
( ScalarFromTy )
import FIR.ProgramState
( ProgramState(ProgramState) )
import Math.Linear
( V )
import SPIRV.Image
( ImageUsage(Sampled, Storage)
, ImageFormat(ImageFormat), I, UI
, ImageFormatDimension
, RequiredFormatUsage
, Arrayness(..)
, Dimensionality(..)
, Normalisation(..)
, HasDepth(..)
, MultiSampling(..)
, Operand(..)
, Projection(..)
)
import qualified SPIRV.Image as Image
( Component(Integer, Floating)
, Operand(..)
)
import qualified SPIRV.Image as LOD
( LODOperand )
import qualified SPIRV.ScalarTy as SPIRV
( ScalarTy(Integer, Floating) )
-------------------------------------------------
-- * Constraints for images.
-- | Retrieve the properties of an image.
--
-- Throws a type error if there is no image with given name.
type family LookupImageProperties (k :: Symbol) (i :: ProgramState) :: ImageProperties where
LookupImageProperties k ('ProgramState i _ _ _ _ _ _ _)
= ImagePropertiesFromLookup k i (Lookup k i)
type family ImagePropertiesFromLookup
( k :: Symbol )
( i :: BindingsMap )
( lookup :: Maybe Binding )
:: ImageProperties
where
ImagePropertiesFromLookup _ _ (Just (Var _ (Image props))) = props
ImagePropertiesFromLookup k i Nothing
= TypeError ( Text "Expected an image, \
\but nothing is bound by name " :<>: ShowType k
)
ImagePropertiesFromLookup k i (Just nonImage)
= TypeError ( Text "Unexpected type " :<>: ShowType nonImage
:<>: Text " bound by name " :<>: ShowType k
:$$: Text "Expected an image."
)
type family ImageUsageFromProperties ( props :: ImageProperties ) :: ImageUsage where
ImageUsageFromProperties ( Properties _ _ _ _ _ _ usage _ ) = usage
-- | Check that we can read from an image.
--
-- Depending on the coordinate type, this is either a sampling operation
-- or a direct image read operation.
--
-- Throws a type error if the operation is incompatible with the given
-- image properties. For instance, if the image is a depth image,
-- a depth-comparison reference value must be provided.
--
-- Refer to the @SPIR-V@ specification for what operations are allowed.
type family ValidImageRead
( props :: ImageProperties )
( ops :: [OperandName] )
( coordType :: Type )
:: Constraint where
ValidImageRead
( Properties coordKind res dim depth arr ms usage fmt )
ops
coordType
= ( AllowedIndexing coordKind ms usage
, CheckDepthTest (DepthComparison `Elem` ops) coordKind depth
, CheckLODOperands coordKind ops
, CompatibleFormat (ScalarFromTy res) usage fmt
, ValidCoordinateType "image coordinates (for reading)" (ImageCoordinatesDim dim arr ops) coordKind coordType
)
type family ValidImageCoordinate
( props :: ImageProperties )
( ops :: [ OperandName ] )
( coordType :: Type )
where
ValidImageCoordinate ( Properties coordKind _ _ _ _ _ _ _ ) _ coordType
= ValidCoordinateType "image coordinates" 1 coordKind coordType
type family ValidImageGradCoordinate
( props :: ImageProperties )
( ops :: [ OperandName ] )
( coordType :: Type )
where
ValidImageGradCoordinate ( Properties coordKind _ dim _ _ _ _ _ ) ops coordType
= ValidCoordinateType "gradient coordinates" (GradCoordinatesDim dim ops) coordKind coordType
type family ValidImageOffsetCoordinate
( props :: ImageProperties )
( ops :: [ OperandName ] )
( coordType :: Type )
where
ValidImageOffsetCoordinate ( Properties coordKind _ dim _ _ _ _ _ ) ops coordType
= ValidCoordinateType "offset coordinates" (OffsetCoordinatesDim dim ops) coordKind coordType
type family ValidCoordinateType
( coordsName :: Symbol )
( coordDim :: Nat )
( coordKind :: ImageCoordinateKind )
( coordType :: Type )
:: Constraint where
ValidCoordinateType _ 1 coordKind a = CoordinateConstraint coordKind a
ValidCoordinateType _ n coordKind ( V n a ) = CoordinateConstraint coordKind a
ValidCoordinateType coordsName n coordKind ( V j a ) =
TypeError
( Text "Use of " :<>: Text coordsName :<>: Text " of the wrong dimension."
:$$: Text "Expected dimension: " :<>: ShowType n
:$$: Text " Actual dimension: " :<>: ShowType j
)
ValidCoordinateType coordsName n IntegralCoordinates nonVec =
TypeError
( Text "Cannot use type " :<>: ShowType nonVec :<>: Text " as " :<>: Text coordsName :<>: Text "."
:$$: Text "Expected a vector of integral types of dimension " :<>: ShowType n :<>: Text "."
)
ValidCoordinateType coordsName n FloatingPointCoordinates nonVec =
TypeError
( Text "Cannot use type " :<>: ShowType nonVec :<>: Text " as " :<>: Text coordsName :<>: Text "."
:$$: Text "Expected a vector of floating-point types of dimension " :<>: ShowType n :<>: Text "."
)
type family CoordinateConstraint ( coordKind :: ImageCoordinateKind ) :: ( Type -> Constraint ) where
CoordinateConstraint IntegralCoordinates = Integral
CoordinateConstraint FloatingPointCoordinates = Floating
-- | Check that we can write to an image.
--
-- Throws a type error if:
--
-- * the image is not a storage image,
-- * the image is a depth image,
-- * the coordinate type is not an integral type, or is of the wrong dimension,
-- * an operand is incompatible with the given image properties,
-- * an operand doesn't make sense for write operations.
--
-- Refer to the @SPIR-V@ specification for what operations are allowed.
type family ValidImageWrite
( props :: ImageProperties )
( ops :: [OperandName] )
( coordType :: Type )
:: Constraint where
ValidImageWrite
( Properties _ _ _ _ _ _ Sampled _ )
ops
_
= TypeError ( Text "Cannot write to a sampled image; must be a storage image." )
ValidImageWrite
( Properties _ _ _ (Just DepthImage) _ _ _ _ )
ops
_
= TypeError ( Text "Cannot write to a depth image." )
ValidImageWrite
( Properties coordKind res dim _ arr _ usage fmt )
ops
coordType
= ( IntegralIndexing coordKind
, CompatibleFormat (ScalarFromTy res) usage fmt
, AllowedWriteOps ops
, ValidCoordinateType "image coordinates (for writing)" (ImageCoordinatesDim dim arr ops) coordKind coordType
)
type family IntegralIndexing (inty :: ImageCoordinateKind) :: Constraint where
IntegralIndexing FloatingPointCoordinates
= TypeError ( Text "Cannot write to an image using floating-point coordinates." )
IntegralIndexing _ = ()
-- Check whether floating-point coordinates are allowed.
type family AllowedIndexing
( inty :: ImageCoordinateKind )
( ms :: MultiSampling )
( usage :: ImageUsage )
:: Constraint where
AllowedIndexing FloatingPointCoordinates _ Storage
= TypeError
( Text "Cannot use floating-point coordinates with a storage image." )
AllowedIndexing FloatingPointCoordinates MultiSampled _
= TypeError
( Text "Cannot use floating-point coordinates with multi-sampling." )
AllowedIndexing _ _ _ = ()
-- Check that depth-testing is appropriately performed.
type family CheckDepthTest
( depthTesting :: Bool )
( inty :: ImageCoordinateKind )
( depth :: Maybe HasDepth )
:: Constraint where
CheckDepthTest False _ (Just DepthImage)
= TypeError
( Text "Must use a depth comparison with this depth image." )
CheckDepthTest True _ (Just NotDepthImage)
= TypeError
( Text "Cannot perform depth comparison: not a depth image." )
CheckDepthTest True IntegralCoordinates _
= TypeError
( Text "Cannot perform depth comparison using integral coordinates." )
CheckDepthTest _ _ _ = ()
-- If using integral coordinates, LOD instructions cannot be provided.
type family CheckLODOperands
( inty :: ImageCoordinateKind )
( ops :: [OperandName] )
:: Constraint where
CheckLODOperands FloatingPointCoordinates _ = ()
CheckLODOperands _ ( BaseOperand ('LODOperand lod) ': _ )
= TypeError
( ShowType lod :<>: Text " operand not allowed: using integral coordinates." )
CheckLODOperands inty ( op ': ops ) = CheckLODOperands inty ops
CheckLODOperands _ '[] = ()
type family CompatibleFormat
( inty :: SPIRV.ScalarTy )
( usage :: ImageUsage )
( fmt :: Maybe (ImageFormat Nat) )
:: Constraint
where
CompatibleFormat (SPIRV.Integer _ _) _ (Just ('ImageFormat (Image.Integer Normalised _) _))
= TypeError
( Text "Expected a floating-point type, but provided an integer type."
:$$: Text "Image uses a normalised integer format, resulting in floating-point texel data."
)
CompatibleFormat (SPIRV.Integer _ _) _ (Just ('ImageFormat Image.Floating _))
= TypeError
( Text "Expected a floating-point type, but provided an integer type."
:$$: Text "Image uses a floating-point format."
)
CompatibleFormat (SPIRV.Floating _) _ (Just ('ImageFormat (Image.Integer Unnormalised _) _))
= TypeError
( Text "Expected an integral type, but provided a floating-point type."
:$$: Text "Image uses unnormalised integers, resulting in integral texel data."
)
CompatibleFormat _ Storage _
= ()
CompatibleFormat _ Sampled (Just fmt)
= If
( RequiredFormatUsage fmt == Just Storage )
( TypeError
( Text "Image format " :<>: ShowType fmt
:<>: Text " can only be used with storage images."
)
)
( () :: Constraint )
-- Only 'Sample' and 'Offset'/'ConstOffset' image operands allowed.
type family AllowedWriteOps (ops :: [OperandName]) :: Constraint where
AllowedWriteOps '[] = ()
AllowedWriteOps (BaseOperand Image.Sample ': ops) = AllowedWriteOps ops
AllowedWriteOps (BaseOperand Image.ConstOffset ': ops) = AllowedWriteOps ops
AllowedWriteOps (BaseOperand Image.Offset ': ops) = AllowedWriteOps ops
AllowedWriteOps (op ': _ )
= TypeError ( Text "Image operand " :<>: ShowType op
:<>: Text " cannot be used in conjunction \
\with an image write operation."
)
----------------------------------------------------------
-- Computing relevant image coordinate type.
-- | Dimension of the coordinates used by an image.
--
-- For instance, a simple 2D texture requires a dimension 2 vector,
-- simple 3D textures and cube maps requires a dimension 3 vector, etc.
type family ImageCoordinatesDim
( dim :: Dimensionality )
( arr :: Arrayness )
( ops :: [OperandName] )
:: Nat where
ImageCoordinatesDim dim arr ops =
If ( ProjectiveCoords `Elem` ops )
( ComputeCoordsDim dim arr Projective )
( ComputeCoordsDim dim arr Affine )
-- | Texel type of an image.
--
-- This is what is returned from an image sampling operation,
-- or needs to be provided for an image write operation.
type family ImageTexelType
( props :: ImageProperties )
( ops :: [OperandName] )
:: Type
where
ImageTexelType ( Properties _ r _ _ _ _ _ fmt ) ops
= If
( DepthComparison `Elem` ops
&& Not ( (BaseOperand ConstOffsets) `Elem` ops)
)
r
( MkTexelType fmt r )
type family MkTexelType ( fmt :: Maybe ( ImageFormat Nat ) ) ( texel :: Type ) :: Type where
MkTexelType Nothing texel = V 4 texel -- most flexible default type for unknown image format
MkTexelType ( Just fmt ) texel = MkTexelType' ( ImageFormatDimension fmt ) texel
type family MkTexelType' ( dim :: Nat ) ( texel :: Type ) :: Type where
MkTexelType' 1 texel = texel
MkTexelType' n texel = V n texel
type family ComputeCoordsDim
( dim :: Dimensionality )
( arr :: Arrayness )
( proj :: Projection )
:: Nat
where
ComputeCoordsDim OneD NonArrayed Affine = 1
ComputeCoordsDim TwoD NonArrayed Affine = 2
ComputeCoordsDim ThreeD NonArrayed Affine = 3
ComputeCoordsDim Cube NonArrayed Affine = 3
ComputeCoordsDim Rect NonArrayed Affine = 2
ComputeCoordsDim Buffer NonArrayed Affine = 1
ComputeCoordsDim SubpassData NonArrayed Affine = 2
ComputeCoordsDim OneD NonArrayed Projective = 2
ComputeCoordsDim TwoD NonArrayed Projective = 3
ComputeCoordsDim ThreeD NonArrayed Projective = 4
ComputeCoordsDim Cube NonArrayed Projective = 4
ComputeCoordsDim Rect NonArrayed Projective = 3
ComputeCoordsDim Buffer NonArrayed Projective = 2
ComputeCoordsDim SubpassData NonArrayed Projective = 3
ComputeCoordsDim OneD Arrayed Affine = 2
ComputeCoordsDim TwoD Arrayed Affine = 3
ComputeCoordsDim Cube Arrayed Affine = 3 -- weird stuff going on here
ComputeCoordsDim dim Arrayed Affine
= TypeError ( Text "Unsupported arrayed image format \
\with dimensionality "
:<>: ShowType dim
)
ComputeCoordsDim dim Arrayed Projective
= TypeError ( Text "Cannot use projective coordinates with an arrayed image." )
-- which coordinates to use to provide explicit derivatives
type family GradCoordinatesDim
( props :: Dimensionality )
( ops :: [OperandName] )
:: Nat where
GradCoordinatesDim dim ops =
If ( ProjectiveCoords `Elem` ops )
( ComputeCoordsDim dim NonArrayed Projective )
( ComputeCoordsDim dim NonArrayed Affine )
-- which coordinates to use to provide an offset
type family OffsetCoordinatesDim
( props :: Dimensionality )
( ops :: [OperandName] )
:: Nat where
OffsetCoordinatesDim dim ops =
If ( ProjectiveCoords `Elem` ops )
( ComputeCoordsDim dim NonArrayed Projective )
( ComputeCoordsDim dim NonArrayed Affine )
-----------------------------------------------------------
-- Validation of image operands.
-- this type family could be slightly more specific
-- and enforce that e.g. reading from an 'Unsigned Integer' image format
-- necessarily returns unsigned integers
-- the 'No instance ...' error message can also be a bit confusing
type family MatchesFormat
( fmt :: Maybe (ImageFormat Nat) )
( a :: Type )
:: Constraint where
MatchesFormat (Just ('ImageFormat I _)) a = Integral a
MatchesFormat (Just ('ImageFormat UI _)) a = Integral a
MatchesFormat (Just ('ImageFormat _ _)) a = Floating a
MatchesFormat _ _ = ()
type family BasicDim (opName :: Symbol) (props :: ImageProperties) :: Constraint where
BasicDim _ ( Properties _ _ OneD _ _ _ _ _ ) = ()
BasicDim _ ( Properties _ _ TwoD _ _ _ _ _ ) = ()
BasicDim _ ( Properties _ _ ThreeD _ _ _ _ _ ) = ()
BasicDim _ ( Properties _ _ Cube _ _ _ _ _ ) = ()
BasicDim opName ( Properties _ _ dim _ _ _ _ _ )
= TypeError
( Text opName :<>: Text " operand: unexpected image dimensionality "
:<>: ShowType dim :<>: Text "."
:$$: Text "Image dimensionality must be 'OneD', 'TwoD', 'ThreeD' or 'Cube'. "
)
type family NotCubeDim (opName :: Symbol) (props :: ImageProperties) :: Constraint where
NotCubeDim opName ( Properties _ _ Cube _ _ _ _ _ )
= TypeError
( Text opName :<>: Text " operand: unexpected 'Cube' image dimensionality."
:$$: Text "Image dimensionality must not be 'Cube'."
)
NotCubeDim _ _ = ()
type family CanAddProj (ops :: [OperandName]) :: Constraint where
CanAddProj '[] = ()
CanAddProj ( ProjectiveCoords ': _ )
= TypeError ( Text "'Proj' operand already supplied." )
CanAddProj ( DepthComparison ': ops ) = CanAddProj ops
CanAddProj ( op ': _ )
= TypeError ( Text "'Proj' operand must be provided after " :<>: ShowType op )
type family CanAddDref (ops :: [OperandName]) :: Constraint where
CanAddDref '[] = ()
CanAddDref ( DepthComparison ': _ )
= TypeError ( Text "'Dref' operand already supplied." )
CanAddDref ( ProjectiveCoords ': ops ) = CanAddDref ops
CanAddDref ( op ': _ )
= TypeError ( Text "'Dref' operand must be provided after " :<>: ShowType op )
type family UsesAffineCoords (ops :: [OperandName]) :: Constraint where
UsesAffineCoords '[] = ()
UsesAffineCoords ( ProjectiveCoords ': _ )
= TypeError ( Text "'Gather': unexpected 'Proj' operand; cannot use projective coordinates." )
UsesAffineCoords ( _ ': ops ) = UsesAffineCoords ops
type NoDuplicate op ops = NoDuplicateFromElem op (op `Elem` ops)
type family NoDuplicateFromElem op dup :: Constraint where
NoDuplicateFromElem _ False = ()
NoDuplicateFromElem op True
= TypeError ( Text "Duplicate image operand " :<>: ShowType op :<>: Text "." )
type family NoMS (opName :: Symbol) (props :: ImageProperties) :: Constraint where
NoMS _ (Properties _ _ _ _ _ SingleSampled _ _) = ()
NoMS opName _
= TypeError
( Text opName :<>: Text " operand: image cannot be multisampled." )
type family CanMultiSample (ms :: ImageProperties) :: Constraint where
CanMultiSample (Properties _ _ _ _ _ SingleSampled _ _)
= TypeError ( Text "Cannot multi-sample this single-sampled image." )
CanMultiSample _ = ()
type family NoLODOps
( name :: Symbol )
( excl :: [LOD.LODOperand] )
( ops :: [OperandName] )
:: Constraint
where
NoLODOps _ _ '[] = ()
NoLODOps name excl (BaseOperand ('LODOperand op) ': ops)
= If
(op `Elem` excl)
( TypeError
( Text "Cannot provide " :<>: ShowType name :<>: Text " operand:"
:$$: ShowType op :<>: Text " operand already provided."
)
)
( NoLODOps name excl ops )
NoLODOps name excl ( _ ': ops ) = NoLODOps name excl ops
type family SupportsDepthTest ( props :: ImageProperties ) :: Constraint where
SupportsDepthTest (Properties _ _ _ (Just NotDepthImage) _ _ _ _)
= TypeError ( Text "Cannot do a depth comparison: image is not a depth image." )
SupportsDepthTest _ = ()
-----------------------------------------------------------
-- Validation of image query operations.
type ValidQueryImageSizeLOD ( imgName :: Symbol ) ( i :: ProgramState ) ( res :: Type )
= ValidQueryImageSizeLODFromProps imgName ( LookupImageProperties imgName i ) res
type ValidQueryImageSize ( imgName :: Symbol ) ( i :: ProgramState ) ( res :: Type )
= ValidQueryImageSizeFromProps imgName ( LookupImageProperties imgName i ) res
type ValidQueryImageLOD ( imgName :: Symbol ) ( i :: ProgramState ) ( coords :: Type ) ( res :: Type )
= ValidQueryImageLODFromProps imgName ( LookupImageProperties imgName i ) coords res
type ValidQueryImageLevels ( imgName :: Symbol ) ( i :: ProgramState ) ( res :: Type )
= ValidQueryImageLevelsFromProps imgName ( LookupImageProperties imgName i ) res
type ValidQueryImageSamples ( imgName :: Symbol ) ( i :: ProgramState ) ( res :: Type )
= ValidQueryImageSamplesFromProps imgName ( LookupImageProperties imgName i ) res
-- ImageQuerySizeLod
type family ValidQueryImageSizeLODFromProps ( imgName :: Symbol ) ( imgProps :: ImageProperties ) ( res :: Type ) :: Constraint where
ValidQueryImageSizeLODFromProps imgName ( Properties _ _ _ _ _ MultiSampled _ _ ) res =
TypeError
( Text "Cannot query size (with explicit LOD) of multi-sampled image " :<>: ShowType imgName )
ValidQueryImageSizeLODFromProps imgName ( Properties _ _ dim _ arr _ _ _ ) res =
( ValidCoordinateType "image coordinates (for querying)" (ImageCoordinatesDim dim arr '[]) IntegralCoordinates res
, ValidImageSizeLODQueryDim imgName dim
)
type family ValidImageSizeLODQueryDim ( imgName :: Symbol ) ( dim :: Dimensionality ) :: Constraint where
ValidImageSizeLODQueryDim _ OneD = ()
ValidImageSizeLODQueryDim _ TwoD = ()
ValidImageSizeLODQueryDim _ ThreeD = ()
ValidImageSizeLODQueryDim _ Cube = ()
ValidImageSizeLODQueryDim imgName dim =
TypeError
( Text "Cannot query the size (with explicit LOD) of image " :<>: ShowType imgName :<>: Text "."
:$$: Text "Unsupported dimensionality " :<>: ShowType dim :<>: Text "."
)
-- ImageQuerySize
type family ValidQueryImageSizeFromProps ( imgName :: Symbol ) ( imgProps :: ImageProperties ) ( res :: Type ) :: Constraint where
ValidQueryImageSizeFromProps imgName ( Properties _ _ dim _ arr ms usage _ ) res =
( ValidCoordinateType "image coordinates (for querying)" (ImageCoordinatesDim dim arr '[]) IntegralCoordinates res
, ValidImageSizeQueryDim imgName dim ms usage
)
type family ValidImageSizeQueryDim ( imgName :: Symbol ) ( dim :: Dimensionality ) ( ms :: MultiSampling ) ( usage :: ImageUsage ) :: Constraint where
ValidImageSizeQueryDim _ Rect _ _ = ()
ValidImageSizeQueryDim _ Buffer _ _ = ()
ValidImageSizeQueryDim imgName SubpassData _ _ =
TypeError
( Text "Cannot query the size (without LOD) of image " :<>: ShowType imgName :<>: Text "."
:$$: Text "Unsupported dimensionality " :<>: ShowType SubpassData :<>: Text "."
)
ValidImageSizeQueryDim imgName dim SingleSampled Sampled =
TypeError
( Text "Cannot query the size (without LOD) of image " :<>: ShowType imgName :<>: Text "."
:$$: Text "Unsupported combination:"
:$$: Text " - dimensionality " :<>: ShowType dim :<>: Text ","
:$$: Text " - no multisampling,"
:$$: Text " - image used with a sampler."
)
ValidImageSizeQueryDim _ _ _ _ = ()
-- ImageQueryLod
type family ValidQueryImageLODFromProps ( imgName :: Symbol ) ( imgProps :: ImageProperties ) ( coords :: Type ) ( res :: Type ) :: Constraint where
ValidQueryImageLODFromProps imgName ( Properties coordKind _ dim _ arr _ _ _ ) coords res =
( QueryLODIsV2Floating imgName res
, ValidCoordinateType "image coordinates (for querying LOD)" (ImageCoordinatesDim dim arr '[]) coordKind res -- TODO: enforce floating point coordinates outside of ComputeKernel?
, ValidImageLODQueryDim imgName dim
)
type family QueryLODIsV2Floating ( imgName :: Symbol ) ( res :: Type ) :: Constraint where
QueryLODIsV2Floating _ ( V 2 a ) = Floating a
QueryLODIsV2Floating imgName t =
TypeError
( Text "Unexpected result type " :<>: ShowType t
:$$: Text "when querying LOD for image named " :<>: ShowType imgName :<>: Text "."
:$$: Text "Result type should be a 2-component floating-point type vector."
)
type family ValidImageLODQueryDim ( imgName :: Symbol ) ( dim :: Dimensionality ) :: Constraint where
ValidImageLODQueryDim _ OneD = ()
ValidImageLODQueryDim _ TwoD = ()
ValidImageLODQueryDim _ ThreeD = ()
ValidImageLODQueryDim _ Cube = ()
ValidImageLODQueryDim imgName dim =
TypeError
( Text "Cannot query the LOD of image " :<>: ShowType imgName :<>: Text "."
:$$: Text "Unsupported dimensionality " :<>: ShowType dim :<>: Text "."
)
-- ImageQueryLevels
type family ValidQueryImageLevelsFromProps ( imgName :: Symbol ) ( imgProps :: ImageProperties ) ( res :: Type ) :: Constraint where
ValidQueryImageLevelsFromProps imgName ( Properties _ _ dim _ _ _ _ _ ) res =
( Integral res
, ValidImageLevelsQueryDim imgName dim
)
type family ValidImageLevelsQueryDim ( imgName :: Symbol ) ( dim :: Dimensionality ) :: Constraint where
ValidImageLevelsQueryDim _ OneD = ()
ValidImageLevelsQueryDim _ TwoD = ()
ValidImageLevelsQueryDim _ ThreeD = ()
ValidImageLevelsQueryDim _ Cube = ()
ValidImageLevelsQueryDim imgName dim =
TypeError
( Text "Cannot query the number of accessible mipmap levels of image named " :<>: ShowType imgName :<>: Text "."
:$$: Text "Unsupported dimensionality " :<>: ShowType dim :<>: Text "."
)
-- ImageQuerySamples
type family ValidQueryImageSamplesFromProps ( imgName :: Symbol ) ( imgProps :: ImageProperties ) ( res :: Type ) :: Constraint where
ValidQueryImageSamplesFromProps _ ( Properties _ _ TwoD _ _ MultiSampled _ _ ) res = Integral res
ValidQueryImageSamplesFromProps imgName ( Properties _ _ dim _ _ MultiSampled _ _ ) _ =
TypeError
( Text "Cannot query the number of samples of image named " :<>: ShowType imgName :<>: Text "."
:$$: Text "This image has unsupported dimensionality " :<>: ShowType dim :<>: Text "."
:$$: Text "Expected a TwoD dimensionality."
)
ValidQueryImageSamplesFromProps imgName ( Properties _ _ _ _ _ _ _ _ ) _ =
TypeError
( Text "Cannot query the number of samples of image named " :<>: ShowType imgName :<>: Text "."
:$$: Text "This image is not multi-sampled."
)