module Codec.Ktx2.Level where

import Data.Binary (Binary(..))
import Data.Binary.Get (getWord64le)
import Data.Binary.Put (putWord64le)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.List (mapAccumR)
import Data.Maybe (fromMaybe)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word64)
import GHC.Generics (Generic)

data Level = Level
  { Level -> Word64
byteOffset             :: Word64 -- ^ The offset from the start of the file of the first byte of image data for mip level. It is the offset of the first byte after any @mipPadding@.
  , Level -> Word64
byteLength             :: Word64 -- ^ The total size of the data for supercompressed mip level.
  , Level -> Word64
uncompressedByteLength :: Word64 -- ^ the number of bytes of pixel data in LOD level after reflation from supercompression. This includes all z slices, all faces, all rows (or rows of blocks) and all pixels (or blocks) in each row for the mipmap level. When @supercompressionScheme == 0@, @byteLength@ must have the same value as this. When @supercompressionScheme == 1@ (BasisLZ) the value must be 0.
  } deriving (Level -> Level -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show, forall x. Rep Level x -> Level
forall x. Level -> Rep Level x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Level x -> Level
$cfrom :: forall x. Level -> Rep Level x
Generic)

instance Binary Level where
  get :: Get Level
get = do
    Word64
byteOffset <- Get Word64
getWord64le
    Word64
byteLength <- Get Word64
getWord64le
    Word64
uncompressedByteLength <- Get Word64
getWord64le
    pure Level{Word64
uncompressedByteLength :: Word64
byteLength :: Word64
byteOffset :: Word64
uncompressedByteLength :: Word64
byteLength :: Word64
byteOffset :: Word64
..}

  put :: Level -> Put
put Level{Word64
uncompressedByteLength :: Word64
byteLength :: Word64
byteOffset :: Word64
uncompressedByteLength :: Level -> Word64
byteLength :: Level -> Word64
byteOffset :: Level -> Word64
..} = do
    Word64 -> Put
putWord64le Word64
byteOffset
    Word64 -> Put
putWord64le Word64
byteLength
    Word64 -> Put
putWord64le Word64
uncompressedByteLength

-- | Build a level index from level data.
--
-- Levels should be placed from largest (mip 0) to smallest.
index :: Word64 -> [(Maybe Word64, ByteString)] -> Vector Level
index :: Word64 -> [(Maybe Word64, ByteString)] -> Vector Level
index Word64
startOffset = forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR Word64 -> (Maybe Word64, ByteString) -> (Word64, Level)
mkIndex Word64
startOffset
  where
    mkIndex :: Word64 -> (Maybe Word64, ByteString) -> (Word64, Level)
mkIndex Word64
byteOffset (Maybe Word64
uncompressed, ByteString
bytes) =
      ( Word64
byteOffset forall a. Num a => a -> a -> a
+ Word64
byteLength
      , Level{Word64
uncompressedByteLength :: Word64
byteLength :: Word64
byteOffset :: Word64
uncompressedByteLength :: Word64
byteLength :: Word64
byteOffset :: Word64
..}
      )
      where
        byteLength :: Word64
byteLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bytes
        uncompressedByteLength :: Word64
uncompressedByteLength = forall a. a -> Maybe a -> a
fromMaybe Word64
byteLength Maybe Word64
uncompressed