{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE GADTs, TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Descriptor.Internal (

	-- * EXTENSION NAME

	indexingExtensionName,

	-- * BUFFER INFO

	BufferInfo(..), bufferInfoToMiddle,

	-- * IMAGE INFO

	ImageInfo(..), imageInfoToMiddle,
	ImageInfoNoSampler(..), imageInfoNoSamplerToMiddle

	) where

import Gpu.Vulkan.Object qualified as VObj

import qualified Gpu.Vulkan.Buffer as Buffer
import qualified Gpu.Vulkan.Buffer.Type as Buffer
import qualified Gpu.Vulkan.Descriptor.Middle as M

import qualified Gpu.Vulkan.Sampler.Type as Sampler
import qualified Gpu.Vulkan.Image.Enum as Image
import qualified Gpu.Vulkan.ImageView as ImageView
import qualified Gpu.Vulkan.ImageView.Type as ImageView

import Gpu.Vulkan.Sampler.Middle as Sampler.M

import Gpu.Vulkan.PhysicalDevice qualified as PhysicalDevice

indexingExtensionName :: PhysicalDevice.ExtensionName
indexingExtensionName :: ExtensionName
indexingExtensionName = Text -> ExtensionName
PhysicalDevice.ExtensionName Text
M.indexingExtensionName

data BufferInfo sm sb nm obj i = forall objs .
	(Show (Buffer.Binded sm sb nm objs), VObj.OffsetRange obj objs i) =>
	BufferInfo (Buffer.Binded sm sb nm objs)

deriving instance Show (BufferInfo sm sb nm obj i)

bufferInfoToMiddle :: forall sb sm nm obj i .
	BufferInfo sm sb nm obj i -> M.BufferInfo
bufferInfoToMiddle :: forall sb sm (nm :: Symbol) (obj :: O) (i :: Nat).
BufferInfo sm sb nm obj i -> BufferInfo
bufferInfoToMiddle (BufferInfo (Buffer.Binded PL Length objs
lns B
b)) = M.BufferInfo {
	bufferInfoBuffer :: B
M.bufferInfoBuffer = B
b,
	bufferInfoOffset :: Size
M.bufferInfoOffset = Size
ost,
	bufferInfoRange :: Size
M.bufferInfoRange = Size
rng }
	where (Size
ost, Size
rng) = forall (obj :: O) (objs :: [O]) (i :: Nat).
OffsetRange obj objs i =>
Size -> PL Length objs -> (Size, Size)
VObj.offsetRange @obj @_ @i Size
0 PL Length objs
lns

data ImageInfo ss fmt nm si = ImageInfo {
	forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> S ss
imageInfoSampler :: Sampler.S ss,
	forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> I fmt nm si
imageInfoImageView :: ImageView.I fmt nm si,
	forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> Layout
imageInfoImageLayout :: Image.Layout }
	deriving Int -> ImageInfo ss fmt nm si -> ShowS
[ImageInfo ss fmt nm si] -> ShowS
ImageInfo ss fmt nm si -> String
(Int -> ImageInfo ss fmt nm si -> ShowS)
-> (ImageInfo ss fmt nm si -> String)
-> ([ImageInfo ss fmt nm si] -> ShowS)
-> Show (ImageInfo ss fmt nm si)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ss (fmt :: Symbol) (nm :: Format) si.
Int -> ImageInfo ss fmt nm si -> ShowS
forall ss (fmt :: Symbol) (nm :: Format) si.
[ImageInfo ss fmt nm si] -> ShowS
forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> String
$cshowsPrec :: forall ss (fmt :: Symbol) (nm :: Format) si.
Int -> ImageInfo ss fmt nm si -> ShowS
showsPrec :: Int -> ImageInfo ss fmt nm si -> ShowS
$cshow :: forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> String
show :: ImageInfo ss fmt nm si -> String
$cshowList :: forall ss (fmt :: Symbol) (nm :: Format) si.
[ImageInfo ss fmt nm si] -> ShowS
showList :: [ImageInfo ss fmt nm si] -> ShowS
Show

imageInfoToMiddle ::
	ImageInfo ss fmt nm si -> M.ImageInfo
imageInfoToMiddle :: forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> ImageInfo
imageInfoToMiddle ImageInfo {
	imageInfoSampler :: forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> S ss
imageInfoSampler = S ss
s,
	imageInfoImageView :: forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> I fmt nm si
imageInfoImageView = ImageView.I I
iv,
	imageInfoImageLayout :: forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> Layout
imageInfoImageLayout = Layout
lyt } = M.ImageInfo {
	imageInfoSampler :: S
M.imageInfoSampler = S ss -> S
forall s. S s -> S
Sampler.sToMiddle S ss
s,
	imageInfoImageView :: I
M.imageInfoImageView = I
iv,
	imageInfoImageLayout :: Layout
M.imageInfoImageLayout = Layout
lyt }

data ImageInfoNoSampler fmt nm si = ImageInfoNoSampler {
	forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> I fmt nm si
imageInfoNoSamplerImageView :: ImageView.I fmt nm si,
	forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> Layout
imageInfoNoSamplerImageLayout :: Image.Layout }
	deriving Int -> ImageInfoNoSampler fmt nm si -> ShowS
[ImageInfoNoSampler fmt nm si] -> ShowS
ImageInfoNoSampler fmt nm si -> String
(Int -> ImageInfoNoSampler fmt nm si -> ShowS)
-> (ImageInfoNoSampler fmt nm si -> String)
-> ([ImageInfoNoSampler fmt nm si] -> ShowS)
-> Show (ImageInfoNoSampler fmt nm si)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (fmt :: Symbol) (nm :: Format) si.
Int -> ImageInfoNoSampler fmt nm si -> ShowS
forall (fmt :: Symbol) (nm :: Format) si.
[ImageInfoNoSampler fmt nm si] -> ShowS
forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> String
$cshowsPrec :: forall (fmt :: Symbol) (nm :: Format) si.
Int -> ImageInfoNoSampler fmt nm si -> ShowS
showsPrec :: Int -> ImageInfoNoSampler fmt nm si -> ShowS
$cshow :: forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> String
show :: ImageInfoNoSampler fmt nm si -> String
$cshowList :: forall (fmt :: Symbol) (nm :: Format) si.
[ImageInfoNoSampler fmt nm si] -> ShowS
showList :: [ImageInfoNoSampler fmt nm si] -> ShowS
Show

imageInfoNoSamplerToMiddle ::
	ImageInfoNoSampler fmt nm si -> M.ImageInfo
imageInfoNoSamplerToMiddle :: forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> ImageInfo
imageInfoNoSamplerToMiddle ImageInfoNoSampler {
	imageInfoNoSamplerImageView :: forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> I fmt nm si
imageInfoNoSamplerImageView = ImageView.I I
iv,
	imageInfoNoSamplerImageLayout :: forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> Layout
imageInfoNoSamplerImageLayout = Layout
lyt } = M.ImageInfo {
	imageInfoSampler :: S
M.imageInfoSampler = S
Sampler.M.Null,
	imageInfoImageView :: I
M.imageInfoImageView = I
iv,
	imageInfoImageLayout :: Layout
M.imageInfoImageLayout = Layout
lyt }