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 -> Word32
vkFormat :: Word32
, Header -> Word32
typeSize :: Word32
, Header -> Word32
pixelWidth :: Word32
, Header -> Word32
pixelHeight :: Word32
, Header -> Word32
pixelDepth :: Word32
, Header -> Word32
layerCount :: Word32
, Header -> Word32
faceCount :: Word32
, Header -> Word32
levelCount :: Word32
, Header -> Word32
supercompressionScheme :: Word32
, Header -> Word32
dfdByteOffset :: Word32
, Header -> Word32
dfdByteLength :: Word32
, Header -> Word32
kvdByteOffset :: Word32
, Header -> Word32
kvdByteLength :: Word32
, Header -> Word64
sgdByteOffset :: Word64
, Header -> Word64
sgdByteLength :: Word64
} 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)
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
, Word8
0xBB, Word8
0x0D, Word8
0x0A, Word8
0x1A, Word8
0x0A
]
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