module Codec.Ktx where

import Data.Binary (Binary(..), decodeFileOrFail, decodeOrFail)
import Data.Binary.Get (Get, ByteOffset, getWord32le, getWord32be, getByteString)
import Data.Binary.Put (Put, execPut, putByteString, putWord32le, putWord32be)
import Data.ByteString (ByteString)
import Data.ByteString qualified  as BS
import Data.ByteString.Builder (Builder, hPutBuilder)
import Data.ByteString.Lazy qualified  as BSL
import Data.Coerce (coerce)
import Data.Vector (Vector)
import Data.Vector qualified  as Vector
import Data.Word (Word32)
import GHC.Generics (Generic)
import System.IO (IOMode(..), withBinaryFile)

import Codec.Ktx.KeyValue (KeyValueData)
import Codec.Ktx.KeyValue qualified as KeyValue

fromByteStringLazy :: BSL.ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy :: ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy ByteString
bsl =
  case ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Ktx)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bsl of
    Right (ByteString
_leftovers, ByteOffset
_bytesLeft, Ktx
ktx) ->
      Ktx -> Either (ByteOffset, String) Ktx
forall a b. b -> Either a b
Right Ktx
ktx
    Left (ByteString
_leftovers, ByteOffset
bytesLeft, String
err) ->
      (ByteOffset, String) -> Either (ByteOffset, String) Ktx
forall a b. a -> Either a b
Left (ByteOffset
bytesLeft, String
err)

fromByteString :: ByteString -> Either (ByteOffset, String) Ktx
fromByteString :: ByteString -> Either (ByteOffset, String) Ktx
fromByteString = ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy (ByteString -> Either (ByteOffset, String) Ktx)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteOffset, String) Ktx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict

fromFile :: FilePath -> IO (Either (ByteOffset, String) Ktx)
fromFile :: String -> IO (Either (ByteOffset, String) Ktx)
fromFile = String -> IO (Either (ByteOffset, String) Ktx)
forall a. Binary a => String -> IO (Either (ByteOffset, String) a)
decodeFileOrFail

toBuilder :: Ktx -> Builder
toBuilder :: Ktx -> Builder
toBuilder = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (Ktx -> PutM ()) -> Ktx -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ktx -> PutM ()
forall t. Binary t => t -> PutM ()
put

toFile :: FilePath -> Ktx -> IO ()
toFile :: String -> Ktx -> IO ()
toFile String
dest Ktx
ktx =
  String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
dest IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
    Handle -> Builder -> IO ()
hPutBuilder Handle
handle (Ktx -> Builder
toBuilder Ktx
ktx)

data Ktx = Ktx
  { Ktx -> Header
header :: Header
  , Ktx -> KeyValueData
kvs    :: KeyValueData
  , Ktx -> MipLevels
images :: MipLevels
  } deriving (Int -> Ktx -> ShowS
[Ktx] -> ShowS
Ktx -> String
(Int -> Ktx -> ShowS)
-> (Ktx -> String) -> ([Ktx] -> ShowS) -> Show Ktx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ktx -> ShowS
showsPrec :: Int -> Ktx -> ShowS
$cshow :: Ktx -> String
show :: Ktx -> String
$cshowList :: [Ktx] -> ShowS
showList :: [Ktx] -> ShowS
Show, (forall x. Ktx -> Rep Ktx x)
-> (forall x. Rep Ktx x -> Ktx) -> Generic Ktx
forall x. Rep Ktx x -> Ktx
forall x. Ktx -> Rep Ktx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ktx -> Rep Ktx x
from :: forall x. Ktx -> Rep Ktx x
$cto :: forall x. Rep Ktx x -> Ktx
to :: forall x. Rep Ktx x -> Ktx
Generic)

instance Binary Ktx where
  get :: Get Ktx
get = do
    Header
header <- Get Header
forall t. Binary t => Get t
get
    KeyValueData
kvs <- Get Word32 -> Int -> Get KeyValueData
KeyValue.getData
      (Word32 -> Get Word32
mkGetWord32 (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ Header -> Word32
endianness Header
header)
      (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word32
bytesOfKeyValueData Header
header)
    MipLevels
images <- Header -> Get MipLevels
getImages Header
header
    pure Ktx{KeyValueData
MipLevels
Header
header :: Header
kvs :: KeyValueData
images :: MipLevels
header :: Header
kvs :: KeyValueData
images :: MipLevels
..}

  put :: Ktx -> PutM ()
put Ktx{KeyValueData
MipLevels
Header
header :: Ktx -> Header
kvs :: Ktx -> KeyValueData
images :: Ktx -> MipLevels
header :: Header
kvs :: KeyValueData
images :: MipLevels
..} = do
    Header -> PutM ()
forall t. Binary t => t -> PutM ()
put Header
header
    (Word32 -> PutM ()) -> KeyValueData -> PutM ()
KeyValue.putData Word32 -> PutM ()
putWord32 KeyValueData
kvs
    (Word32 -> PutM ()) -> MipLevels -> PutM ()
putImages Word32 -> PutM ()
putWord32 MipLevels
images
    where
      putWord32 :: Word32 -> PutM ()
putWord32 = Word32 -> Word32 -> PutM ()
mkPutWord32 (Word32 -> Word32 -> PutM ()) -> Word32 -> Word32 -> PutM ()
forall a b. (a -> b) -> a -> b
$ Header -> Word32
endianness Header
header

-- * Header

data Header = Header
  { Header -> ByteString
identifier            :: ByteString
  , Header -> Word32
endianness            :: Word32
  , Header -> Word32
glType                :: Word32
  , Header -> Word32
glTypeSize            :: Word32
  , Header -> Word32
glFormat              :: Word32
  , Header -> Word32
glInternalFormat      :: Word32
  , Header -> Word32
glBaseInternalFormat  :: Word32
  , Header -> Word32
pixelWidth            :: Word32
  , Header -> Word32
pixelHeight           :: Word32
  , Header -> Word32
pixelDepth            :: Word32
  , Header -> Word32
numberOfArrayElements :: Word32
  , Header -> Word32
numberOfFaces         :: Word32
  , Header -> Word32
numberOfMipmapLevels  :: Word32
  , Header -> Word32
bytesOfKeyValueData   :: Word32
  } deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show, (forall x. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
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
$cfrom :: forall x. Header -> Rep Header x
from :: forall x. Header -> Rep Header x
$cto :: forall x. Rep Header x -> Header
to :: forall x. Rep Header x -> Header
Generic)

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

    Word32
endianness <- Get Word32
getWord32le
    let
      getNext :: Get Word32
getNext =
        if Word32
endianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
          Get Word32
getWord32le
        else
          Get Word32
getWord32be

    Word32
glType                <- Get Word32
getNext
    Word32
glTypeSize            <- Get Word32
getNext
    Word32
glFormat              <- Get Word32
getNext
    Word32
glInternalFormat      <- Get Word32
getNext
    Word32
glBaseInternalFormat  <- Get Word32
getNext
    Word32
pixelWidth            <- Get Word32
getNext
    Word32
pixelHeight           <- Get Word32
getNext
    Word32
pixelDepth            <- Get Word32
getNext
    Word32
numberOfArrayElements <- Get Word32
getNext
    Word32
numberOfFaces         <- Get Word32
getNext
    Word32
numberOfMipmapLevels  <- Get Word32
getNext
    Word32
bytesOfKeyValueData   <- Get Word32
getNext

    pure Header{Word32
ByteString
endianness :: Word32
bytesOfKeyValueData :: Word32
identifier :: ByteString
glType :: Word32
glTypeSize :: Word32
glFormat :: Word32
glInternalFormat :: Word32
glBaseInternalFormat :: Word32
pixelWidth :: Word32
pixelHeight :: Word32
pixelDepth :: Word32
numberOfArrayElements :: Word32
numberOfFaces :: Word32
numberOfMipmapLevels :: Word32
identifier :: ByteString
endianness :: Word32
glType :: Word32
glTypeSize :: Word32
glFormat :: Word32
glInternalFormat :: Word32
glBaseInternalFormat :: Word32
pixelWidth :: Word32
pixelHeight :: Word32
pixelDepth :: Word32
numberOfArrayElements :: Word32
numberOfFaces :: Word32
numberOfMipmapLevels :: Word32
bytesOfKeyValueData :: Word32
..}

  put :: Header -> PutM ()
put Header{Word32
ByteString
endianness :: Header -> Word32
bytesOfKeyValueData :: Header -> Word32
identifier :: Header -> ByteString
glType :: Header -> Word32
glTypeSize :: Header -> Word32
glFormat :: Header -> Word32
glInternalFormat :: Header -> Word32
glBaseInternalFormat :: Header -> Word32
pixelWidth :: Header -> Word32
pixelHeight :: Header -> Word32
pixelDepth :: Header -> Word32
numberOfArrayElements :: Header -> Word32
numberOfFaces :: Header -> Word32
numberOfMipmapLevels :: Header -> Word32
identifier :: ByteString
endianness :: Word32
glType :: Word32
glTypeSize :: Word32
glFormat :: Word32
glInternalFormat :: Word32
glBaseInternalFormat :: Word32
pixelWidth :: Word32
pixelHeight :: Word32
pixelDepth :: Word32
numberOfArrayElements :: Word32
numberOfFaces :: Word32
numberOfMipmapLevels :: Word32
bytesOfKeyValueData :: Word32
..} = do
    ByteString -> PutM ()
putByteString ByteString
identifier
    let putWord32 :: Word32 -> PutM ()
putWord32 = Word32 -> Word32 -> PutM ()
mkPutWord32 Word32
endianness

    Word32 -> PutM ()
putWord32 Word32
endianness
    Word32 -> PutM ()
putWord32 Word32
glType
    Word32 -> PutM ()
putWord32 Word32
glTypeSize
    Word32 -> PutM ()
putWord32 Word32
glFormat
    Word32 -> PutM ()
putWord32 Word32
glInternalFormat
    Word32 -> PutM ()
putWord32 Word32
glBaseInternalFormat
    Word32 -> PutM ()
putWord32 Word32
pixelWidth
    Word32 -> PutM ()
putWord32 Word32
pixelHeight
    Word32 -> PutM ()
putWord32 Word32
pixelDepth
    Word32 -> PutM ()
putWord32 Word32
numberOfArrayElements
    Word32 -> PutM ()
putWord32 Word32
numberOfFaces
    Word32 -> PutM ()
putWord32 Word32
numberOfMipmapLevels
    Word32 -> PutM ()
putWord32 Word32
bytesOfKeyValueData

endiannessLE :: Word32
endiannessLE :: Word32
endiannessLE = Word32
0x04030201

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

-- * Images

type MipLevels = Vector MipLevel

data MipLevel = MipLevel
  { MipLevel -> Word32
imageSize     :: Word32
  , MipLevel -> Vector ArrayElement
arrayElements :: Vector ArrayElement
  }
  deriving (Int -> MipLevel -> ShowS
[MipLevel] -> ShowS
MipLevel -> String
(Int -> MipLevel -> ShowS)
-> (MipLevel -> String) -> ([MipLevel] -> ShowS) -> Show MipLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MipLevel -> ShowS
showsPrec :: Int -> MipLevel -> ShowS
$cshow :: MipLevel -> String
show :: MipLevel -> String
$cshowList :: [MipLevel] -> ShowS
showList :: [MipLevel] -> ShowS
Show, (forall x. MipLevel -> Rep MipLevel x)
-> (forall x. Rep MipLevel x -> MipLevel) -> Generic MipLevel
forall x. Rep MipLevel x -> MipLevel
forall x. MipLevel -> Rep MipLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MipLevel -> Rep MipLevel x
from :: forall x. MipLevel -> Rep MipLevel x
$cto :: forall x. Rep MipLevel x -> MipLevel
to :: forall x. Rep MipLevel x -> MipLevel
Generic)

newtype ArrayElement = ArrayElement
  { ArrayElement -> Vector Face
faces :: Vector Face
  }
  deriving (Int -> ArrayElement -> ShowS
[ArrayElement] -> ShowS
ArrayElement -> String
(Int -> ArrayElement -> ShowS)
-> (ArrayElement -> String)
-> ([ArrayElement] -> ShowS)
-> Show ArrayElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayElement -> ShowS
showsPrec :: Int -> ArrayElement -> ShowS
$cshow :: ArrayElement -> String
show :: ArrayElement -> String
$cshowList :: [ArrayElement] -> ShowS
showList :: [ArrayElement] -> ShowS
Show, (forall x. ArrayElement -> Rep ArrayElement x)
-> (forall x. Rep ArrayElement x -> ArrayElement)
-> Generic ArrayElement
forall x. Rep ArrayElement x -> ArrayElement
forall x. ArrayElement -> Rep ArrayElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArrayElement -> Rep ArrayElement x
from :: forall x. ArrayElement -> Rep ArrayElement x
$cto :: forall x. Rep ArrayElement x -> ArrayElement
to :: forall x. Rep ArrayElement x -> ArrayElement
Generic)

newtype Face = Face
  { Face -> Vector ZSlice
zSlices :: Vector ZSlice
  }
  deriving (Int -> Face -> ShowS
[Face] -> ShowS
Face -> String
(Int -> Face -> ShowS)
-> (Face -> String) -> ([Face] -> ShowS) -> Show Face
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Face -> ShowS
showsPrec :: Int -> Face -> ShowS
$cshow :: Face -> String
show :: Face -> String
$cshowList :: [Face] -> ShowS
showList :: [Face] -> ShowS
Show, (forall x. Face -> Rep Face x)
-> (forall x. Rep Face x -> Face) -> Generic Face
forall x. Rep Face x -> Face
forall x. Face -> Rep Face x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Face -> Rep Face x
from :: forall x. Face -> Rep Face x
$cto :: forall x. Rep Face x -> Face
to :: forall x. Rep Face x -> Face
Generic)

newtype ZSlice = ZSlice
  { ZSlice -> ByteString
block :: ByteString
  }
  deriving ((forall x. ZSlice -> Rep ZSlice x)
-> (forall x. Rep ZSlice x -> ZSlice) -> Generic ZSlice
forall x. Rep ZSlice x -> ZSlice
forall x. ZSlice -> Rep ZSlice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ZSlice -> Rep ZSlice x
from :: forall x. ZSlice -> Rep ZSlice x
$cto :: forall x. Rep ZSlice x -> ZSlice
to :: forall x. Rep ZSlice x -> ZSlice
Generic)

instance Show ZSlice where
  show :: ZSlice -> String
show ZSlice{ByteString
block :: ZSlice -> ByteString
block :: ByteString
..} =
    let
      size :: Int
size = ByteString -> Int
BS.length ByteString
block
    in
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"ZSlice ("
        , Int -> String
forall a. Show a => a -> String
show Int
size
        , String
") "
        , ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
32 ByteString
block)
        ]

getImages :: Header -> Get MipLevels
getImages :: Header -> Get MipLevels
getImages Header{Word32
ByteString
endianness :: Header -> Word32
bytesOfKeyValueData :: Header -> Word32
identifier :: Header -> ByteString
glType :: Header -> Word32
glTypeSize :: Header -> Word32
glFormat :: Header -> Word32
glInternalFormat :: Header -> Word32
glBaseInternalFormat :: Header -> Word32
pixelWidth :: Header -> Word32
pixelHeight :: Header -> Word32
pixelDepth :: Header -> Word32
numberOfArrayElements :: Header -> Word32
numberOfFaces :: Header -> Word32
numberOfMipmapLevels :: Header -> Word32
identifier :: ByteString
endianness :: Word32
glType :: Word32
glTypeSize :: Word32
glFormat :: Word32
glInternalFormat :: Word32
glBaseInternalFormat :: Word32
pixelWidth :: Word32
pixelHeight :: Word32
pixelDepth :: Word32
numberOfArrayElements :: Word32
numberOfFaces :: Word32
numberOfMipmapLevels :: Word32
bytesOfKeyValueData :: Word32
..} =
  Word32 -> Get MipLevel -> Get MipLevels
forall {m :: * -> *} {a} {b}.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfMipmapLevels' do
    Word32
imageSize <- Get Word32
getImageSize

    let
      sliceSize :: Int
sliceSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$
        if Word32
numberOfFaces Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
6 then
          Word32
imageSize
        else
          Word32
imageSize
            Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
numberOfArrayElements'
            Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
numberOfFaces
            Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
pixelDepth'

    Vector (Vector (Vector ZSlice))
elements <- Word32
-> Get (Vector (Vector ZSlice))
-> Get (Vector (Vector (Vector ZSlice)))
forall {m :: * -> *} {a} {b}.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfArrayElements' (Get (Vector (Vector ZSlice))
 -> Get (Vector (Vector (Vector ZSlice))))
-> Get (Vector (Vector ZSlice))
-> Get (Vector (Vector (Vector ZSlice)))
forall a b. (a -> b) -> a -> b
$
      Word32 -> Get (Vector ZSlice) -> Get (Vector (Vector ZSlice))
forall {m :: * -> *} {a} {b}.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfFaces (Get (Vector ZSlice) -> Get (Vector (Vector ZSlice)))
-> Get (Vector ZSlice) -> Get (Vector (Vector ZSlice))
forall a b. (a -> b) -> a -> b
$
        Word32 -> Get ZSlice -> Get (Vector ZSlice)
forall {m :: * -> *} {a} {b}.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
pixelDepth' (Get ZSlice -> Get (Vector ZSlice))
-> Get ZSlice -> Get (Vector ZSlice)
forall a b. (a -> b) -> a -> b
$
          ByteString -> ZSlice
ZSlice (ByteString -> ZSlice) -> Get ByteString -> Get ZSlice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
sliceSize

    pure MipLevel
      { imageSize :: Word32
imageSize     = Word32
imageSize
      , arrayElements :: Vector ArrayElement
arrayElements = Vector (Vector (Vector ZSlice)) -> Vector ArrayElement
forall a b. Coercible a b => a -> b
coerce Vector (Vector (Vector ZSlice))
elements
      }

  where
    some_ :: a -> m b -> m (Vector b)
some_ a
n m b
action = Vector a -> (a -> m b) -> m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
Vector.forM ([a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList [a
1..a
n]) \a
_ix -> m b
action

    numberOfMipmapLevels' :: Word32
numberOfMipmapLevels'
      | Word32
numberOfMipmapLevels Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
      | Bool
otherwise                 = Word32
numberOfMipmapLevels

    numberOfArrayElements' :: Word32
numberOfArrayElements'
      | Word32
numberOfArrayElements Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
      | Bool
otherwise                  = Word32
numberOfArrayElements

    pixelDepth' :: Word32
pixelDepth'
      | Word32
pixelDepth Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
      | Bool
otherwise       = Word32
pixelDepth

    getImageSize :: Get Word32
getImageSize =
      if Word32
endianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
        Get Word32
getWord32le
      else
        Get Word32
getWord32be

putImages :: (Word32 -> Put) -> MipLevels -> Put
putImages :: (Word32 -> PutM ()) -> MipLevels -> PutM ()
putImages Word32 -> PutM ()
putWord32 MipLevels
mipLevels = MipLevels -> (MipLevel -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ MipLevels
mipLevels \MipLevel{Word32
Vector ArrayElement
imageSize :: MipLevel -> Word32
arrayElements :: MipLevel -> Vector ArrayElement
imageSize :: Word32
arrayElements :: Vector ArrayElement
..} -> do
  Word32 -> PutM ()
putWord32 Word32
imageSize
  Vector ArrayElement -> (ArrayElement -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector ArrayElement
arrayElements \ArrayElement{Vector Face
faces :: ArrayElement -> Vector Face
faces :: Vector Face
..} ->
    Vector Face -> (Face -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector Face
faces \Face{Vector ZSlice
zSlices :: Face -> Vector ZSlice
zSlices :: Vector ZSlice
..} ->
      Vector ZSlice -> (ZSlice -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector ZSlice
zSlices \ZSlice{ByteString
block :: ZSlice -> ByteString
block :: ByteString
..} ->
        ByteString -> PutM ()
putByteString ByteString
block

-- * Utils

mkGetWord32 :: Word32 -> Get Word32
mkGetWord32 :: Word32 -> Get Word32
mkGetWord32 Word32
someEndianness =
  if Word32
someEndianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
    Get Word32
getWord32le
  else
    Get Word32
getWord32be

mkPutWord32 :: Word32 -> (Word32 -> Put)
mkPutWord32 :: Word32 -> Word32 -> PutM ()
mkPutWord32 Word32
someEndianness =
  if Word32
someEndianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
    Word32 -> PutM ()
putWord32le
  else
    Word32 -> PutM ()
putWord32be