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