diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,17 @@ # Changelog for ktx-codec +## [0.0.1.3] - 2021-04-04 + +* Allow bytestring-0.12. +* Fix `getKeyValueData` decoder. +* Fix encoder endianness. +* Add `fromByteStringLazy`, `toBuilder` and `toFile`. + +[0.0.1.3]: https://gitlab.com/dpwiz/ktx/-/tree/v0.0.1.3-codec + ## [0.0.1.2] - 2021-01-18 -* Add `fromByteString` +* Add `fromByteString`. [0.0.1.2]: https://gitlab.com/dpwiz/ktx/-/tree/v0.0.1.2-codec diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,1 @@ -# ktx +# ktx-codec diff --git a/ktx-codec.cabal b/ktx-codec.cabal --- a/ktx-codec.cabal +++ b/ktx-codec.cabal @@ -4,20 +4,20 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 90f4385af1027f93ec529bb24d6a8c8435eb753ead4b549c7885a3b1005e21b6 +-- hash: 03c3edd2b72f8de5b48ce539b99ed32e3c9a1c997eabe2604fc6e3b85cbaadc1 name: ktx-codec -version: 0.0.1.2 +version: 0.0.1.3 synopsis: Khronos texture format description: KTX is a format for storing textures for OpenGL® and OpenGL® ES applications. It is distinguished by the simplicity of the loader required to instantiate a GL texture object from the file contents. . - https://www.khronos.org/opengles/sdk/tools/KTX/file_format_spec/ + https://web.archive.org/web/20201116105642/https://www.khronos.org/opengles/sdk/tools/KTX/file_format_spec/ category: Graphics author: Alexander Bondarenko maintainer: aenor.realm@gmail.com -copyright: 2020 Alexander Bondarenko +copyright: 2021 Alexander Bondarenko license: BSD3 license-file: LICENSE build-type: Simple @@ -40,7 +40,7 @@ build-depends: base >=4.7 && <5 , binary >=0.8.7 && <1 - , bytestring >=0.10 && <0.11 + , bytestring >=0.10 && <0.12 , containers >=0.6 && <0.7 , text >=1.2 && <1.3 , vector >=0.12 && <0.13 @@ -58,7 +58,7 @@ build-depends: base >=4.7 && <5 , binary >=0.8.7 && <1 - , bytestring >=0.10 && <0.11 + , bytestring >=0.10 && <0.12 , containers >=0.6 && <0.7 , directory >=1.3 && <1.4 , filepath >=1.4 && <1.5 diff --git a/src/Codec/Ktx.hs b/src/Codec/Ktx.hs --- a/src/Codec/Ktx.hs +++ b/src/Codec/Ktx.hs @@ -1,9 +1,10 @@ module Codec.Ktx where import Data.Binary (Binary(..), decodeFileOrFail, decodeOrFail) -import Data.Binary.Get (Get, ByteOffset, getWord32le, getWord32be, getByteString, skip) -import Data.Binary.Put (Put, putByteString, putWord32le) +import Data.Binary.Get (Get, ByteOffset, getWord32le, getWord32be, getByteString, isolate, skip) +import Data.Binary.Put (Put, execPut, putByteString, putWord32le, putWord32be) import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder, hPutBuilder) import Data.Coerce (coerce) import Data.Foldable (for_) import Data.Map.Strict (Map) @@ -11,6 +12,7 @@ import Data.Vector (Vector) import Data.Word (Word32) import GHC.Generics (Generic) +import System.IO (IOMode(..), withBinaryFile) import qualified Data.Text.Encoding as Text import qualified Data.Map.Strict as Map @@ -18,17 +20,28 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -fromByteString :: ByteString -> Either (ByteOffset, String) Ktx -fromByteString bs = - case decodeOrFail (BSL.fromStrict bs) of +fromByteStringLazy :: BSL.ByteString -> Either (ByteOffset, String) Ktx +fromByteStringLazy bsl = + case decodeOrFail bsl of Right (_leftovers, _bytesLeft, ktx) -> Right ktx Left (_leftovers, bytesLeft, err) -> Left (bytesLeft, err) +fromByteString :: ByteString -> Either (ByteOffset, String) Ktx +fromByteString = fromByteStringLazy . BSL.fromStrict + fromFile :: FilePath -> IO (Either (ByteOffset, String) Ktx) fromFile = decodeFileOrFail +toBuilder :: Ktx -> Builder +toBuilder = execPut . put + +toFile :: FilePath -> Ktx -> IO () +toFile dest ktx = + withBinaryFile dest WriteMode $ \handle -> + hPutBuilder handle (toBuilder ktx) + data Ktx = Ktx { header :: Header , kvs :: KeyValueData @@ -44,8 +57,10 @@ put Ktx{..} = do put header - putKeyValueData kvs - putImages images + putKeyValueData putWord32 kvs + putImages putWord32 images + where + putWord32 = mkPutWord32 $ endianness header -- * Header @@ -99,20 +114,22 @@ put Header{..} = do putByteString identifier - putWord32le endianness - putWord32le glType - putWord32le glTypeSize - putWord32le glFormat - putWord32le glInternalFormat - putWord32le glBaseInternalFormat - putWord32le pixelWidth - putWord32le pixelHeight - putWord32le pixelDepth - putWord32le numberOfArrayElements - putWord32le numberOfFaces - putWord32le numberOfMipmapLevels - putWord32le bytesOfKeyValueData + let putWord32 = mkPutWord32 endianness + putWord32 endianness + putWord32 glType + putWord32 glTypeSize + putWord32 glFormat + putWord32 glInternalFormat + putWord32 glBaseInternalFormat + putWord32 pixelWidth + putWord32 pixelHeight + putWord32 pixelDepth + putWord32 numberOfArrayElements + putWord32 numberOfFaces + putWord32 numberOfMipmapLevels + putWord32 bytesOfKeyValueData + endiannessLE :: Word32 endiannessLE = 0x04030201 @@ -133,38 +150,57 @@ deriving (Show, Generic) getKeyValueData :: Header -> Get KeyValueData -getKeyValueData Header{..} = Map.fromList <$> go bytesOfKeyValueData [] +getKeyValueData Header{..} = + isolate (fromIntegral bytesOfKeyValueData) $ + go (toInteger bytesOfKeyValueData) [] where go remains acc | remains == 0 = - pure acc + pure $ Map.fromList acc | remains < 0 = - fail "" + fail "Attempted to read beyond bytesOfKeyValueData" | otherwise = do - keyAndValueByteSize <- getSize - keyAndValue <- getByteString (fromIntegral keyAndValueByteSize) - _valuePadding <- skip . fromIntegral $ 3 - ((keyAndValueByteSize + 3) `rem` 4) + keyAndValueByteSize <- fmap toInteger getSize + let paddingSize = 3 - ((keyAndValueByteSize + 3) `rem` 4) - let (key, value) = BS.span (/= 0x00) keyAndValue - go (remains - keyAndValueByteSize) $ - ( Key $ Text.decodeUtf8 key - , Value value - ) : acc + keyAndValue <- getByteString (fromInteger keyAndValueByteSize) + skip (fromInteger paddingSize) + {- XXX: Spec says: + Any byte value is allowed. + It is encouraged that the value be a NUL terminated UTF-8 string but this is not required. + If the Value data is a string of bytes then the NUL termination + should be included in the keyAndValueByteSize byte count + (but programs that read KTX files must not rely on this). + -} + let + (keyBS, valueBS) = BS.span (/= 0x00) keyAndValue + key = Key $ Text.decodeUtf8 keyBS + value = Value $ BS.drop 1 valueBS + + go + (remains - 4 - keyAndValueByteSize - paddingSize) + ((key, value) : acc) + getSize = if endianness == endiannessLE then getWord32le else getWord32be -putKeyValueData :: Map Key Value -> Put -putKeyValueData kvs = +putKeyValueData :: (Word32 -> Put) -> Map Key Value -> Put +putKeyValueData endianPut kvs = for_ (Map.toList kvs) \(Key key, Value value) -> do - let keyAndValue = Text.encodeUtf8 key <> BS.singleton 0x00 <> value - putWord32le (fromIntegral $ BS.length keyAndValue) + let + keyAndValue = Text.encodeUtf8 key <> BS.singleton 0x00 <> value + keyAndValueByteSize = BS.length keyAndValue + paddingSize = 3 - ((keyAndValueByteSize + 3) `rem` 4) + + endianPut (fromIntegral keyAndValueByteSize) putByteString keyAndValue + putByteString $ BS.replicate paddingSize 0 -- * Images @@ -249,10 +285,19 @@ else getWord32be -putImages :: MipLevels -> Put -putImages mipLevels = Vector.forM_ mipLevels \MipLevel{..} -> do - put imageSize +putImages :: (Word32 -> Put) -> MipLevels -> Put +putImages putWord32 mipLevels = Vector.forM_ mipLevels \MipLevel{..} -> do + putWord32 imageSize Vector.forM_ arrayElements \ArrayElement{..} -> Vector.forM_ faces \Face{..} -> Vector.forM_ zSlices \ZSlice{..} -> putByteString block + +-- * Utils + +mkPutWord32 :: Word32 -> (Word32 -> Put) +mkPutWord32 someEndianness = + if someEndianness == endiannessLE then + putWord32le + else + putWord32be diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,12 +1,15 @@ module Main where -import Control.Monad (guard) +import Control.Monad (guard, unless) import Data.List (isSuffixOf) import Debug.Trace (traceM) import Shower (printer) import System.Directory (listDirectory) import System.FilePath (()) +import Data.ByteString.Builder (Builder, toLazyByteString) +import qualified Data.ByteString.Lazy as BSL + import qualified Codec.Ktx as Ktx1 assetsPath :: FilePath @@ -34,3 +37,7 @@ ] Right ktx -> do printer ktx + let encodedBytes = toLazyByteString (Ktx1.toBuilder ktx) + originalBytes <- BSL.readFile source + unless (encodedBytes == originalBytes) $ + fail $ "Encoded KTX does not match original for " <> source