module Codec.Ktx2.Header
  ( Header(..)
  , prepare
  , canonicalIdentifier
  , pattern SC_NONE
  , pattern SC_BASISLZ
  , pattern SC_ZSTANDARD
  , pattern SC_ZLIB
  ) where

import Data.Binary (Binary(..))
import Data.Binary.Get (getWord32le, getWord64le, getByteString)
import Data.Binary.Put (putByteString, putWord32le, putWord64le)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)

data Header = Header
  { Header -> Word32
vkFormat :: Word32 -- ^ Specifies the image format using Vulkan @VkFormat@ enum values. It can be any value defined in core Vulkan 1.2, future core versions or registered Vulkan extensions, except for values listed in Table 1, “Prohibited Formats” and any @*SCALED*@ or @*[2-9]PLANE*@ formats added in future.
  , Header -> Word32
typeSize :: Word32 -- ^ Specifies the size of the data type in bytes used to upload the data to a graphics API. When @typeSize@ is greater than 1, software on big-endian systems must endian convert all image data since it is little-endian. When format is @VK_FORMAT_UNDEFINED@, typeSize must equal 1.

  , Header -> Word32
pixelWidth  :: Word32
  , Header -> Word32
pixelHeight :: Word32
  , Header -> Word32
pixelDepth  :: Word32

  , Header -> Word32
layerCount :: Word32 -- ^ Specifies the number of array elements. If the texture is not an array texture, @layerCount@ must equal 0.
  , Header -> Word32
faceCount  :: Word32 -- ^ If @faceCount@ is equal to 6, @pixelHeight@ must be equal to @pixelWidth@, and @pixelDepth@ must be 0.
  , Header -> Word32
levelCount :: Word32 -- ^ Specifies the number of levels in the Mip Level Array and, by extension, the number of indices in the Level Index array. A KTX file does not need to contain a complete mipmap pyramid.

  , Header -> Word32
supercompressionScheme :: Word32 -- ^ Indicates if a supercompression scheme has been applied to the data in levelImages. It must be one of the values from Table 2, “Supercompression Schemes”. A value of 0 indicates no supercompression.

    -- Static index
  , Header -> Word32
dfdByteOffset :: Word32 -- ^ The offset from the start of the file of the @dfdTotalSize@ field of the Data Format Descriptor.
  , Header -> Word32
dfdByteLength :: Word32 -- ^ The total number of bytes in the Data Format Descriptor including the @dfdTotalSize@ field. @dfdByteLength@ must equal @dfdTotalSize@.
  , Header -> Word32
kvdByteOffset :: Word32 -- ^ An arbitrary number of key/value pairs may follow the Index. These can be used to encode any arbitrary data. The kvdByteOffset field gives the offset of this data, i.e. that of first key/value pair, from the start of the file. The value must be 0 when kvdByteLength = 0.
  , Header -> Word32
kvdByteLength :: Word32 -- ^ The total number of bytes of key/value data including all keyAndValueByteLength fields, all keyAndValue fields and all valuePadding fields.
  , Header -> Word64
sgdByteOffset :: Word64 -- ^ The offset from the start of the file of supercompressionGlobalData. The value must be 0 when sgdByteLength = 0.
  , Header -> Word64
sgdByteLength :: Word64 -- ^ The number of bytes of supercompressionGlobalData. For supercompression schemes for which no reference is provided in the Global Data Format column of Table 2, “Supercompression Schemes”. the value must be 0.
  } deriving (Header -> Header -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Header x -> Header
$cfrom :: forall x. Header -> Rep Header x
Generic)

prepare
  :: Integral dims
  => Word32
  -> Word32
  -> dims
  -> dims
  -> dims
  -> Word32
  -> Header
prepare :: forall dims.
Integral dims =>
Word32 -> Word32 -> dims -> dims -> dims -> Word32 -> Header
prepare Word32
vkFormat Word32
typeSize dims
imageWidth dims
imageHeight dims
imageDepth Word32
scheme = Header
  { Word32
vkFormat :: Word32
vkFormat :: Word32
vkFormat
  , Word32
typeSize :: Word32
typeSize :: Word32
typeSize
  , pixelWidth :: Word32
pixelWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral dims
imageWidth
  , pixelHeight :: Word32
pixelHeight = forall a b. (Integral a, Num b) => a -> b
fromIntegral dims
imageHeight
  , pixelDepth :: Word32
pixelDepth = forall a b. (Integral a, Num b) => a -> b
fromIntegral dims
imageDepth
  , layerCount :: Word32
layerCount = Word32
0
  , faceCount :: Word32
faceCount = Word32
1
  , levelCount :: Word32
levelCount = Word32
1
  , supercompressionScheme :: Word32
supercompressionScheme = Word32
scheme
  , dfdByteOffset :: Word32
dfdByteOffset = Word32
0
  , dfdByteLength :: Word32
dfdByteLength = Word32
0
  , kvdByteOffset :: Word32
kvdByteOffset = Word32
0
  , kvdByteLength :: Word32
kvdByteLength = Word32
0
  , sgdByteOffset :: Word64
sgdByteOffset = Word64
0
  , sgdByteLength :: Word64
sgdByteLength = Word64
0
  }

instance Binary Header where
  get :: Get Header
get = do
    ByteString
identifier <- Int -> Get ByteString
getByteString Int
12
    if ByteString
identifier forall a. Eq a => a -> a -> Bool
== ByteString
canonicalIdentifier then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"KTX2 identifier mismatch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
identifier

    Word32
vkFormat <- Get Word32
getWord32le
    Word32
typeSize <- Get Word32
getWord32le
    Word32
pixelWidth <- Get Word32
getWord32le
    Word32
pixelHeight <- Get Word32
getWord32le
    Word32
pixelDepth <- Get Word32
getWord32le
    Word32
layerCount <- Get Word32
getWord32le
    Word32
faceCount <- Get Word32
getWord32le
    Word32
levelCount <- Get Word32
getWord32le
    Word32
supercompressionScheme <- Get Word32
getWord32le

    Word32
dfdByteOffset <- Get Word32
getWord32le
    Word32
dfdByteLength <- Get Word32
getWord32le
    Word32
kvdByteOffset <- Get Word32
getWord32le
    Word32
kvdByteLength <- Get Word32
getWord32le
    Word64
sgdByteOffset <- Get Word64
getWord64le
    Word64
sgdByteLength <- Get Word64
getWord64le

    pure Header{Word32
Word64
sgdByteLength :: Word64
sgdByteOffset :: Word64
kvdByteLength :: Word32
kvdByteOffset :: Word32
dfdByteLength :: Word32
dfdByteOffset :: Word32
supercompressionScheme :: Word32
levelCount :: Word32
faceCount :: Word32
layerCount :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
typeSize :: Word32
vkFormat :: Word32
sgdByteLength :: Word64
sgdByteOffset :: Word64
kvdByteLength :: Word32
kvdByteOffset :: Word32
dfdByteLength :: Word32
dfdByteOffset :: Word32
supercompressionScheme :: Word32
levelCount :: Word32
faceCount :: Word32
layerCount :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
typeSize :: Word32
vkFormat :: Word32
..}

  put :: Header -> Put
put Header{Word32
Word64
sgdByteLength :: Word64
sgdByteOffset :: Word64
kvdByteLength :: Word32
kvdByteOffset :: Word32
dfdByteLength :: Word32
dfdByteOffset :: Word32
supercompressionScheme :: Word32
levelCount :: Word32
faceCount :: Word32
layerCount :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
typeSize :: Word32
vkFormat :: Word32
sgdByteLength :: Header -> Word64
sgdByteOffset :: Header -> Word64
kvdByteLength :: Header -> Word32
kvdByteOffset :: Header -> Word32
dfdByteLength :: Header -> Word32
dfdByteOffset :: Header -> Word32
supercompressionScheme :: Header -> Word32
levelCount :: Header -> Word32
faceCount :: Header -> Word32
layerCount :: Header -> Word32
pixelDepth :: Header -> Word32
pixelHeight :: Header -> Word32
pixelWidth :: Header -> Word32
typeSize :: Header -> Word32
vkFormat :: Header -> Word32
..} = do
    ByteString -> Put
putByteString ByteString
canonicalIdentifier

    Word32 -> Put
putWord32le Word32
vkFormat
    Word32 -> Put
putWord32le Word32
typeSize
    Word32 -> Put
putWord32le Word32
pixelWidth
    Word32 -> Put
putWord32le Word32
pixelHeight
    Word32 -> Put
putWord32le Word32
pixelDepth
    Word32 -> Put
putWord32le Word32
layerCount
    Word32 -> Put
putWord32le Word32
faceCount
    Word32 -> Put
putWord32le Word32
levelCount
    Word32 -> Put
putWord32le Word32
supercompressionScheme

    Word32 -> Put
putWord32le Word32
dfdByteOffset
    Word32 -> Put
putWord32le Word32
dfdByteLength
    Word32 -> Put
putWord32le Word32
kvdByteOffset
    Word32 -> Put
putWord32le Word32
kvdByteLength
    Word64 -> Put
putWord64le Word64
sgdByteOffset
    Word64 -> Put
putWord64le Word64
sgdByteLength

canonicalIdentifier :: ByteString
canonicalIdentifier :: ByteString
canonicalIdentifier = [Word8] -> ByteString
BS.pack
  [ Word8
0xAB, Word8
0x4B, Word8
0x54, Word8
0x58, Word8
0x20, Word8
0x32, Word8
0x30 -- «KTX 20»
  , Word8
0xBB, Word8
0x0D, Word8
0x0A, Word8
0x1A, Word8
0x0A             -- \r\n\x1A\n
  ]

pattern SC_NONE :: (Eq a, Num a) => a
pattern $bSC_NONE :: forall a. (Eq a, Num a) => a
$mSC_NONE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
SC_NONE = 0

pattern SC_BASISLZ :: (Eq a, Num a) => a
pattern $bSC_BASISLZ :: forall a. (Eq a, Num a) => a
$mSC_BASISLZ :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
SC_BASISLZ = 1

pattern SC_ZSTANDARD :: (Eq a, Num a) => a
pattern $bSC_ZSTANDARD :: forall a. (Eq a, Num a) => a
$mSC_ZSTANDARD :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
SC_ZSTANDARD = 2

pattern SC_ZLIB :: (Eq a, Num a) => a
pattern $bSC_ZLIB :: forall a. (Eq a, Num a) => a
$mSC_ZLIB :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
SC_ZLIB = 3