module Codec.Ktx2.Write
  ( toFile
  , toChunks
  ) where

import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Binary (Binary(..))
import Data.Binary.Put (runPut, putLazyByteString, putByteString)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Foldable (traverse_)
import Data.Map qualified as Map
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word64)

import Codec.Ktx.KeyValue (KeyValueData)
import Codec.Ktx.KeyValue qualified as KeyValueData
import Codec.Ktx2.DFD (DFD(..))
import Codec.Ktx2.DFD qualified as DFD
import Codec.Ktx2.Header (Header)
import Codec.Ktx2.Header qualified as Header
import Codec.Ktx2.Level qualified as Level

toFile
  :: MonadIO io
  => FilePath
  -> Header
  -> Vector DFD.Block
  -> KeyValueData
  -> ByteString
  -> [(Maybe Word64, ByteString)]
  -> io ()
toFile :: forall (io :: * -> *).
MonadIO io =>
FilePath
-> Header
-> Vector Block
-> KeyValueData
-> ByteString
-> [(Maybe Word64, ByteString)]
-> io ()
toFile FilePath
path Header
headerBase Vector Block
dfdBlocks KeyValueData
kvd ByteString
sgd [(Maybe Word64, ByteString)]
levels =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
BSL.writeFile FilePath
path forall a b. (a -> b) -> a -> b
$
    Header
-> Vector Block
-> KeyValueData
-> ByteString
-> [(Maybe Word64, ByteString)]
-> ByteString
toChunks Header
headerBase Vector Block
dfdBlocks KeyValueData
kvd ByteString
sgd [(Maybe Word64, ByteString)]
levels

toChunks
  :: Header
  -> Vector DFD.Block
  -> KeyValueData
  -> ByteString
  -> [(Maybe Word64, ByteString)]
  -> BSL.ByteString
toChunks :: Header
-> Vector Block
-> KeyValueData
-> ByteString
-> [(Maybe Word64, ByteString)]
-> ByteString
toChunks Header
headerBase Vector Block
dfdBlocks KeyValueData
kvd ByteString
sgd [(Maybe Word64, ByteString)]
levels =
  Put -> ByteString
runPut do
    forall t. Binary t => t -> Put
put Header
header
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
Vector.mapM_ forall t. Binary t => t -> Put
put Vector Level
levelIndex
    forall t. Binary t => t -> Put
put DFD
dfd

    ByteString -> Put
putLazyByteString ByteString
kvdBytes

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
sgd) do
      ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
sgdPadding Word8
0x00
      ByteString -> Put
putByteString ByteString
sgd

    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. [a] -> [a]
reverse [(Maybe Word64, ByteString)]
levels)
  where
    header :: Header
header = Header
headerBase
      { levelCount :: Word32
Header.levelCount =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
levelCount

      , dfdByteOffset :: Word32
Header.dfdByteOffset =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dfdOffset
      , dfdByteLength :: Word32
Header.dfdByteLength =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dfdLength

      , kvdByteOffset :: Word32
Header.kvdByteOffset =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kvdOffset
      , kvdByteLength :: Word32
Header.kvdByteLength =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kvdLength

      , sgdByteOffset :: Word64
Header.sgdByteOffset =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sgdOffset
      , sgdByteLength :: Word64
Header.sgdByteLength =
          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sgdLength
      }

    levelIndex :: Vector Level
levelIndex = Word64 -> [(Maybe Word64, ByteString)] -> Vector Level
Level.index Word64
levelBaseOffset [(Maybe Word64, ByteString)]
levels
    levelCount :: Int
levelCount = forall a. Vector a -> Int
Vector.length Vector Level
levelIndex
    levelIndexOffset :: Int
levelIndexOffset = Int
80
    levelIndexLength :: Int
levelIndexLength = Int
levelCount forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
* Int
3
    levelIndexEnd :: Int
levelIndexEnd = Int
levelIndexOffset forall a. Num a => a -> a -> a
+ Int
levelIndexLength

    (Int
dfdOffset, Int
dfdLength) =
      if forall a. Vector a -> Bool
Vector.null Vector Block
dfdBlocks then
        (Int
0, Int
0)
      else
        ( Int
levelIndexEnd
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ DFD -> Word32
dfdTotalSize DFD
dfd
        )
    dfd :: DFD
dfd = DFD
      { dfdTotalSize :: Word32
dfdTotalSize =
          Word32
4 forall a. Num a => a -> a -> a
+ forall a. Num a => Vector a -> a
Vector.sum (forall a b. (a -> b) -> Vector a -> Vector b
Vector.map Block -> Word32
DFD.descriptorBlockSize Vector Block
dfdBlocks)
      , dfdBlocks :: Vector Block
dfdBlocks = Vector Block
dfdBlocks
      }
    dfdEnd :: Int
dfdEnd = Int
levelIndexEnd forall a. Num a => a -> a -> a
+ Int
dfdLength

    (Int
kvdOffset, Int
kvdLength) =
      if forall k a. Map k a -> Bool
Map.null KeyValueData
kvd then
        (Int
0, Int
0)
      else
        ( Int
dfdEnd
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
kvdBytes
        )
    kvdBytes :: ByteString
kvdBytes = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ KeyValueData -> Put
KeyValueData.putDataLe KeyValueData
kvd
    kvdEnd :: Int
kvdEnd = Int
dfdEnd forall a. Num a => a -> a -> a
+ Int
kvdLength

    (Int
sgdPadding, Int
sgdOffset, Int
sgdLength) =
      if ByteString -> Bool
BS.null ByteString
sgd then
        (Int
0, Int
0, Int
0)
      else
        ( Int
7 forall a. Num a => a -> a -> a
- ((Int
kvdEnd forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`rem` Int
8)
        , Int
sgdPadding forall a. Num a => a -> a -> a
+ Int
kvdEnd
        , ByteString -> Int
BS.length ByteString
sgd
        )
    sgdEnd :: Int
sgdEnd = Int
kvdEnd forall a. Num a => a -> a -> a
+ Int
sgdLength

    levelBaseOffset :: Word64
levelBaseOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sgdEnd