Header.hs

module Codec.Ktx2.Header 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
  { 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.
  , 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.

  , pixelWidth  :: Word32
  , pixelHeight :: Word32
  , pixelDepth  :: Word32

  , layerCount :: Word32 -- ^ Specifies the number of array elements. If the texture is not an array texture, @layerCount@ must equal 0.
  , faceCount  :: Word32 -- ^ If @faceCount@ is equal to 6, @pixelHeight@ must be equal to @pixelWidth@, and @pixelDepth@ must be 0.
  , 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.

  , 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
  , dfdByteOffset :: Word32 -- ^ The offset from the start of the file of the @dfdTotalSize@ field of the Data Format Descriptor.
  , dfdByteLength :: Word32 -- ^ The total number of bytes in the Data Format Descriptor including the @dfdTotalSize@ field. @dfdByteLength@ must equal @dfdTotalSize@.
  , 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.
  , kvdByteLength :: Word32 -- ^ The total number of bytes of key/value data including all keyAndValueByteLength fields, all keyAndValue fields and all valuePadding fields.
  , sgdByteOffset :: Word64 -- ^ The offset from the start of the file of supercompressionGlobalData. The value must be 0 when sgdByteLength = 0.
  , 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 (Eq, Show, Generic)

instance Binary Header where
  get = do
    identifier <- getByteString 12
    if identifier == canonicalIdentifier then
      pure ()
    else
      fail $ "KTX2 identifier mismatch: " <> show identifier

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

    dfdByteOffset <- getWord32le
    dfdByteLength <- getWord32le
    kvdByteOffset <- getWord32le
    kvdByteLength <- getWord32le
    sgdByteOffset <- getWord64le
    sgdByteLength <- getWord64le

    pure Header{..}

  put Header{..} = do
    putByteString canonicalIdentifier

    putWord32le vkFormat
    putWord32le typeSize
    putWord32le pixelWidth
    putWord32le pixelHeight
    putWord32le pixelDepth
    putWord32le layerCount
    putWord32le faceCount
    putWord32le levelCount
    putWord32le supercompressionScheme

    putWord32le dfdByteOffset
    putWord32le dfdByteLength
    putWord32le kvdByteOffset
    putWord32le kvdByteLength
    putWord64le sgdByteOffset
    putWord64le sgdByteLength

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

pattern SC_NONE :: (Eq a, Num a) => a
pattern SC_NONE = 0

pattern SC_BASISLZ :: (Eq a, Num a) => a
pattern SC_BASISLZ = 1

pattern SC_ZSTANDARD :: (Eq a, Num a) => a
pattern SC_ZSTANDARD = 2

pattern SC_ZLIB :: (Eq a, Num a) => a
pattern SC_ZLIB = 3