ktx-codec 0.0.1.2 → 0.0.1.3

raw patch · 5 files changed

+108/−47 lines, 5 filesdep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−1
• README.md +1/−1
• ktx-codec.cabal +6/−6
• src/Codec/Ktx.hs +83/−38
• test/Spec.hs +8/−1

@@ -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 

@@ -1,1 +1,1 @@-# ktx+# ktx-codec

@@ -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

@@ -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

@@ -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