module Codec.Ktx where
import Data.Binary (Binary(..), decodeFileOrFail, decodeOrFail)
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)
import Data.Text (Text)
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
import qualified Data.Vector as Vector
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
fromByteStringLazy :: BSL.ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy :: ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy ByteString
bsl =
case ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, Ktx)
forall a.
Binary a =>
ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bsl of
Right (ByteString
_leftovers, ByteOffset
_bytesLeft, Ktx
ktx) ->
Ktx -> Either (ByteOffset, String) Ktx
forall a b. b -> Either a b
Right Ktx
ktx
Left (ByteString
_leftovers, ByteOffset
bytesLeft, String
err) ->
(ByteOffset, String) -> Either (ByteOffset, String) Ktx
forall a b. a -> Either a b
Left (ByteOffset
bytesLeft, String
err)
fromByteString :: ByteString -> Either (ByteOffset, String) Ktx
fromByteString :: ByteString -> Either (ByteOffset, String) Ktx
fromByteString = ByteString -> Either (ByteOffset, String) Ktx
fromByteStringLazy (ByteString -> Either (ByteOffset, String) Ktx)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteOffset, String) Ktx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
fromFile :: FilePath -> IO (Either (ByteOffset, String) Ktx)
fromFile :: String -> IO (Either (ByteOffset, String) Ktx)
fromFile = String -> IO (Either (ByteOffset, String) Ktx)
forall a. Binary a => String -> IO (Either (ByteOffset, String) a)
decodeFileOrFail
toBuilder :: Ktx -> Builder
toBuilder :: Ktx -> Builder
toBuilder = PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (Ktx -> PutM ()) -> Ktx -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ktx -> PutM ()
forall t. Binary t => t -> PutM ()
put
toFile :: FilePath -> Ktx -> IO ()
toFile :: String -> Ktx -> IO ()
toFile String
dest Ktx
ktx =
String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
dest IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
Handle -> Builder -> IO ()
hPutBuilder Handle
handle (Ktx -> Builder
toBuilder Ktx
ktx)
data Ktx = Ktx
{ :: Header
, Ktx -> KeyValueData
kvs :: KeyValueData
, Ktx -> MipLevels
images :: MipLevels
} deriving (Int -> Ktx -> ShowS
[Ktx] -> ShowS
Ktx -> String
(Int -> Ktx -> ShowS)
-> (Ktx -> String) -> ([Ktx] -> ShowS) -> Show Ktx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ktx] -> ShowS
$cshowList :: [Ktx] -> ShowS
show :: Ktx -> String
$cshow :: Ktx -> String
showsPrec :: Int -> Ktx -> ShowS
$cshowsPrec :: Int -> Ktx -> ShowS
Show, (forall x. Ktx -> Rep Ktx x)
-> (forall x. Rep Ktx x -> Ktx) -> Generic Ktx
forall x. Rep Ktx x -> Ktx
forall x. Ktx -> Rep Ktx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ktx x -> Ktx
$cfrom :: forall x. Ktx -> Rep Ktx x
Generic)
instance Binary Ktx where
get :: Get Ktx
get = do
Header
header <- Get Header
forall t. Binary t => Get t
get
KeyValueData
kvs <- Header -> Get KeyValueData
getKeyValueData Header
header
MipLevels
images <- Header -> Get MipLevels
getImages Header
header
pure Ktx :: Header -> KeyValueData -> MipLevels -> Ktx
Ktx{KeyValueData
MipLevels
Header
images :: MipLevels
kvs :: KeyValueData
header :: Header
$sel:images:Ktx :: MipLevels
$sel:kvs:Ktx :: KeyValueData
$sel:header:Ktx :: Header
..}
put :: Ktx -> PutM ()
put Ktx{KeyValueData
MipLevels
Header
images :: MipLevels
kvs :: KeyValueData
header :: Header
$sel:images:Ktx :: Ktx -> MipLevels
$sel:kvs:Ktx :: Ktx -> KeyValueData
$sel:header:Ktx :: Ktx -> Header
..} = do
Header -> PutM ()
forall t. Binary t => t -> PutM ()
put Header
header
(Word32 -> PutM ()) -> KeyValueData -> PutM ()
putKeyValueData Word32 -> PutM ()
putWord32 KeyValueData
kvs
(Word32 -> PutM ()) -> MipLevels -> PutM ()
putImages Word32 -> PutM ()
putWord32 MipLevels
images
where
putWord32 :: Word32 -> PutM ()
putWord32 = Word32 -> Word32 -> PutM ()
mkPutWord32 (Word32 -> Word32 -> PutM ()) -> Word32 -> Word32 -> PutM ()
forall a b. (a -> b) -> a -> b
$ Header -> Word32
endianness Header
header
data =
{ :: ByteString
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
, :: Word32
} deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, (forall x. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Header x -> Header
$cfrom :: forall x. Header -> Rep Header x
Generic)
instance Binary Header where
get :: Get Header
get = do
ByteString
identifier <- Int -> Get ByteString
getByteString Int
12
if ByteString
identifier ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
canonicalIdentifier then
() -> Get ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else
String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"KTX identifier mismatch: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
identifier
Word32
endianness <- Get Word32
getWord32le
let
getNext :: Get Word32
getNext =
if Word32
endianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
Get Word32
getWord32le
else
Get Word32
getWord32be
Word32
glType <- Get Word32
getNext
Word32
glTypeSize <- Get Word32
getNext
Word32
glFormat <- Get Word32
getNext
Word32
glInternalFormat <- Get Word32
getNext
Word32
glBaseInternalFormat <- Get Word32
getNext
Word32
pixelWidth <- Get Word32
getNext
Word32
pixelHeight <- Get Word32
getNext
Word32
pixelDepth <- Get Word32
getNext
Word32
numberOfArrayElements <- Get Word32
getNext
Word32
numberOfFaces <- Get Word32
getNext
Word32
numberOfMipmapLevels <- Get Word32
getNext
Word32
bytesOfKeyValueData <- Get Word32
getNext
pure Header :: ByteString
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Header
Header{Word32
ByteString
bytesOfKeyValueData :: Word32
numberOfMipmapLevels :: Word32
numberOfFaces :: Word32
numberOfArrayElements :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
glBaseInternalFormat :: Word32
glInternalFormat :: Word32
glFormat :: Word32
glTypeSize :: Word32
glType :: Word32
endianness :: Word32
identifier :: ByteString
$sel:bytesOfKeyValueData:Header :: Word32
$sel:numberOfMipmapLevels:Header :: Word32
$sel:numberOfFaces:Header :: Word32
$sel:numberOfArrayElements:Header :: Word32
$sel:pixelDepth:Header :: Word32
$sel:pixelHeight:Header :: Word32
$sel:pixelWidth:Header :: Word32
$sel:glBaseInternalFormat:Header :: Word32
$sel:glInternalFormat:Header :: Word32
$sel:glFormat:Header :: Word32
$sel:glTypeSize:Header :: Word32
$sel:glType:Header :: Word32
$sel:identifier:Header :: ByteString
$sel:endianness:Header :: Word32
..}
put :: Header -> PutM ()
put Header{Word32
ByteString
bytesOfKeyValueData :: Word32
numberOfMipmapLevels :: Word32
numberOfFaces :: Word32
numberOfArrayElements :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
glBaseInternalFormat :: Word32
glInternalFormat :: Word32
glFormat :: Word32
glTypeSize :: Word32
glType :: Word32
endianness :: Word32
identifier :: ByteString
$sel:bytesOfKeyValueData:Header :: Header -> Word32
$sel:numberOfMipmapLevels:Header :: Header -> Word32
$sel:numberOfFaces:Header :: Header -> Word32
$sel:numberOfArrayElements:Header :: Header -> Word32
$sel:pixelDepth:Header :: Header -> Word32
$sel:pixelHeight:Header :: Header -> Word32
$sel:pixelWidth:Header :: Header -> Word32
$sel:glBaseInternalFormat:Header :: Header -> Word32
$sel:glInternalFormat:Header :: Header -> Word32
$sel:glFormat:Header :: Header -> Word32
$sel:glTypeSize:Header :: Header -> Word32
$sel:glType:Header :: Header -> Word32
$sel:identifier:Header :: Header -> ByteString
$sel:endianness:Header :: Header -> Word32
..} = do
ByteString -> PutM ()
putByteString ByteString
identifier
let putWord32 :: Word32 -> PutM ()
putWord32 = Word32 -> Word32 -> PutM ()
mkPutWord32 Word32
endianness
Word32 -> PutM ()
putWord32 Word32
endianness
Word32 -> PutM ()
putWord32 Word32
glType
Word32 -> PutM ()
putWord32 Word32
glTypeSize
Word32 -> PutM ()
putWord32 Word32
glFormat
Word32 -> PutM ()
putWord32 Word32
glInternalFormat
Word32 -> PutM ()
putWord32 Word32
glBaseInternalFormat
Word32 -> PutM ()
putWord32 Word32
pixelWidth
Word32 -> PutM ()
putWord32 Word32
pixelHeight
Word32 -> PutM ()
putWord32 Word32
pixelDepth
Word32 -> PutM ()
putWord32 Word32
numberOfArrayElements
Word32 -> PutM ()
putWord32 Word32
numberOfFaces
Word32 -> PutM ()
putWord32 Word32
numberOfMipmapLevels
Word32 -> PutM ()
putWord32 Word32
bytesOfKeyValueData
endiannessLE :: Word32
endiannessLE :: Word32
endiannessLE = Word32
0x04030201
canonicalIdentifier :: ByteString
canonicalIdentifier :: ByteString
canonicalIdentifier = [Word8] -> ByteString
BS.pack
[ Word8
0xAB, Word8
0x4B, Word8
0x54, Word8
0x58, Word8
0x20, Word8
0x31, Word8
0x31, Word8
0xBB
, Word8
0x0D, Word8
0x0A, Word8
0x1A, Word8
0x0A
]
type KeyValueData = Map Key Value
newtype Key = Key Text
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)
newtype Value = Value ByteString
deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)
getKeyValueData :: Header -> Get KeyValueData
getKeyValueData :: Header -> Get KeyValueData
getKeyValueData Header{Word32
ByteString
bytesOfKeyValueData :: Word32
numberOfMipmapLevels :: Word32
numberOfFaces :: Word32
numberOfArrayElements :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
glBaseInternalFormat :: Word32
glInternalFormat :: Word32
glFormat :: Word32
glTypeSize :: Word32
glType :: Word32
endianness :: Word32
identifier :: ByteString
$sel:bytesOfKeyValueData:Header :: Header -> Word32
$sel:numberOfMipmapLevels:Header :: Header -> Word32
$sel:numberOfFaces:Header :: Header -> Word32
$sel:numberOfArrayElements:Header :: Header -> Word32
$sel:pixelDepth:Header :: Header -> Word32
$sel:pixelHeight:Header :: Header -> Word32
$sel:pixelWidth:Header :: Header -> Word32
$sel:glBaseInternalFormat:Header :: Header -> Word32
$sel:glInternalFormat:Header :: Header -> Word32
$sel:glFormat:Header :: Header -> Word32
$sel:glTypeSize:Header :: Header -> Word32
$sel:glType:Header :: Header -> Word32
$sel:identifier:Header :: Header -> ByteString
$sel:endianness:Header :: Header -> Word32
..} =
Int -> Get KeyValueData -> Get KeyValueData
forall a. Int -> Get a -> Get a
isolate (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bytesOfKeyValueData) (Get KeyValueData -> Get KeyValueData)
-> Get KeyValueData -> Get KeyValueData
forall a b. (a -> b) -> a -> b
$
Integer -> [(Key, Value)] -> Get KeyValueData
go (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
bytesOfKeyValueData) []
where
go :: Integer -> [(Key, Value)] -> Get KeyValueData
go Integer
remains [(Key, Value)]
acc
| Integer
remains Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 =
KeyValueData -> Get KeyValueData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyValueData -> Get KeyValueData)
-> KeyValueData -> Get KeyValueData
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> KeyValueData
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Key, Value)]
acc
| Integer
remains Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 =
String -> Get KeyValueData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Attempted to read beyond bytesOfKeyValueData"
| Bool
otherwise = do
Integer
keyAndValueByteSize <- (Word32 -> Integer) -> Get Word32 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Get Word32
getSize
let paddingSize :: Integer
paddingSize = Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- ((Integer
keyAndValueByteSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
4)
ByteString
keyAndValue <- Int -> Get ByteString
getByteString (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
keyAndValueByteSize)
Int -> Get ()
skip (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
paddingSize)
let
(ByteString
keyBS, ByteString
valueBS) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x00) ByteString
keyAndValue
key :: Key
key = Text -> Key
Key (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
keyBS
value :: Value
value = ByteString -> Value
Value (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
valueBS
Integer -> [(Key, Value)] -> Get KeyValueData
go
(Integer
remains Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
keyAndValueByteSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
paddingSize)
((Key
key, Value
value) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: [(Key, Value)]
acc)
getSize :: Get Word32
getSize =
if Word32
endianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
Get Word32
getWord32le
else
Get Word32
getWord32be
putKeyValueData :: (Word32 -> Put) -> Map Key Value -> Put
putKeyValueData :: (Word32 -> PutM ()) -> KeyValueData -> PutM ()
putKeyValueData Word32 -> PutM ()
endianPut KeyValueData
kvs =
[(Key, Value)] -> ((Key, Value) -> PutM ()) -> PutM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (KeyValueData -> [(Key, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList KeyValueData
kvs) \(Key Text
key, Value ByteString
value) -> do
let
keyAndValue :: ByteString
keyAndValue = Text -> ByteString
Text.encodeUtf8 Text
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BS.singleton Word8
0x00 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
value
keyAndValueByteSize :: Int
keyAndValueByteSize = ByteString -> Int
BS.length ByteString
keyAndValue
paddingSize :: Int
paddingSize = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
keyAndValueByteSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4)
Word32 -> PutM ()
endianPut (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyAndValueByteSize)
ByteString -> PutM ()
putByteString ByteString
keyAndValue
ByteString -> PutM ()
putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
paddingSize Word8
0
type MipLevels = Vector MipLevel
data MipLevel = MipLevel
{ MipLevel -> Word32
imageSize :: Word32
, MipLevel -> Vector ArrayElement
arrayElements :: Vector ArrayElement
}
deriving (Int -> MipLevel -> ShowS
[MipLevel] -> ShowS
MipLevel -> String
(Int -> MipLevel -> ShowS)
-> (MipLevel -> String) -> ([MipLevel] -> ShowS) -> Show MipLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MipLevel] -> ShowS
$cshowList :: [MipLevel] -> ShowS
show :: MipLevel -> String
$cshow :: MipLevel -> String
showsPrec :: Int -> MipLevel -> ShowS
$cshowsPrec :: Int -> MipLevel -> ShowS
Show, (forall x. MipLevel -> Rep MipLevel x)
-> (forall x. Rep MipLevel x -> MipLevel) -> Generic MipLevel
forall x. Rep MipLevel x -> MipLevel
forall x. MipLevel -> Rep MipLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MipLevel x -> MipLevel
$cfrom :: forall x. MipLevel -> Rep MipLevel x
Generic)
newtype ArrayElement = ArrayElement
{ ArrayElement -> Vector Face
faces :: Vector Face
}
deriving (Int -> ArrayElement -> ShowS
[ArrayElement] -> ShowS
ArrayElement -> String
(Int -> ArrayElement -> ShowS)
-> (ArrayElement -> String)
-> ([ArrayElement] -> ShowS)
-> Show ArrayElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayElement] -> ShowS
$cshowList :: [ArrayElement] -> ShowS
show :: ArrayElement -> String
$cshow :: ArrayElement -> String
showsPrec :: Int -> ArrayElement -> ShowS
$cshowsPrec :: Int -> ArrayElement -> ShowS
Show, (forall x. ArrayElement -> Rep ArrayElement x)
-> (forall x. Rep ArrayElement x -> ArrayElement)
-> Generic ArrayElement
forall x. Rep ArrayElement x -> ArrayElement
forall x. ArrayElement -> Rep ArrayElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArrayElement x -> ArrayElement
$cfrom :: forall x. ArrayElement -> Rep ArrayElement x
Generic)
newtype Face = Face
{ Face -> Vector ZSlice
zSlices :: Vector ZSlice
}
deriving (Int -> Face -> ShowS
[Face] -> ShowS
Face -> String
(Int -> Face -> ShowS)
-> (Face -> String) -> ([Face] -> ShowS) -> Show Face
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Face] -> ShowS
$cshowList :: [Face] -> ShowS
show :: Face -> String
$cshow :: Face -> String
showsPrec :: Int -> Face -> ShowS
$cshowsPrec :: Int -> Face -> ShowS
Show, (forall x. Face -> Rep Face x)
-> (forall x. Rep Face x -> Face) -> Generic Face
forall x. Rep Face x -> Face
forall x. Face -> Rep Face x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Face x -> Face
$cfrom :: forall x. Face -> Rep Face x
Generic)
newtype ZSlice = ZSlice
{ ZSlice -> ByteString
block :: ByteString
}
deriving ((forall x. ZSlice -> Rep ZSlice x)
-> (forall x. Rep ZSlice x -> ZSlice) -> Generic ZSlice
forall x. Rep ZSlice x -> ZSlice
forall x. ZSlice -> Rep ZSlice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ZSlice x -> ZSlice
$cfrom :: forall x. ZSlice -> Rep ZSlice x
Generic)
instance Show ZSlice where
show :: ZSlice -> String
show ZSlice{ByteString
block :: ByteString
$sel:block:ZSlice :: ZSlice -> ByteString
..} =
let
size :: Int
size = ByteString -> Int
BS.length ByteString
block
in
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"ZSlice ("
, Int -> String
forall a. Show a => a -> String
show Int
size
, String
") "
, ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
32 ByteString
block)
]
getImages :: Header -> Get MipLevels
getImages :: Header -> Get MipLevels
getImages Header{Word32
ByteString
bytesOfKeyValueData :: Word32
numberOfMipmapLevels :: Word32
numberOfFaces :: Word32
numberOfArrayElements :: Word32
pixelDepth :: Word32
pixelHeight :: Word32
pixelWidth :: Word32
glBaseInternalFormat :: Word32
glInternalFormat :: Word32
glFormat :: Word32
glTypeSize :: Word32
glType :: Word32
endianness :: Word32
identifier :: ByteString
$sel:bytesOfKeyValueData:Header :: Header -> Word32
$sel:numberOfMipmapLevels:Header :: Header -> Word32
$sel:numberOfFaces:Header :: Header -> Word32
$sel:numberOfArrayElements:Header :: Header -> Word32
$sel:pixelDepth:Header :: Header -> Word32
$sel:pixelHeight:Header :: Header -> Word32
$sel:pixelWidth:Header :: Header -> Word32
$sel:glBaseInternalFormat:Header :: Header -> Word32
$sel:glInternalFormat:Header :: Header -> Word32
$sel:glFormat:Header :: Header -> Word32
$sel:glTypeSize:Header :: Header -> Word32
$sel:glType:Header :: Header -> Word32
$sel:identifier:Header :: Header -> ByteString
$sel:endianness:Header :: Header -> Word32
..} =
Word32 -> Get MipLevel -> Get MipLevels
forall (m :: * -> *) a b.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfMipmapLevels' do
Word32
imageSize <- Get Word32
getImageSize
let
sliceSize :: Int
sliceSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$
if Word32
numberOfFaces Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
6 then
Word32
imageSize
else
Word32
imageSize
Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
numberOfArrayElements'
Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
numberOfFaces
Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
pixelDepth'
Vector (Vector (Vector ZSlice))
elements <- Word32
-> Get (Vector (Vector ZSlice))
-> Get (Vector (Vector (Vector ZSlice)))
forall (m :: * -> *) a b.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfArrayElements' (Get (Vector (Vector ZSlice))
-> Get (Vector (Vector (Vector ZSlice))))
-> Get (Vector (Vector ZSlice))
-> Get (Vector (Vector (Vector ZSlice)))
forall a b. (a -> b) -> a -> b
$
Word32 -> Get (Vector ZSlice) -> Get (Vector (Vector ZSlice))
forall (m :: * -> *) a b.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
numberOfFaces (Get (Vector ZSlice) -> Get (Vector (Vector ZSlice)))
-> Get (Vector ZSlice) -> Get (Vector (Vector ZSlice))
forall a b. (a -> b) -> a -> b
$
Word32 -> Get ZSlice -> Get (Vector ZSlice)
forall (m :: * -> *) a b.
(Monad m, Num a, Enum a) =>
a -> m b -> m (Vector b)
some_ Word32
pixelDepth' (Get ZSlice -> Get (Vector ZSlice))
-> Get ZSlice -> Get (Vector ZSlice)
forall a b. (a -> b) -> a -> b
$
ByteString -> ZSlice
ZSlice (ByteString -> ZSlice) -> Get ByteString -> Get ZSlice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
sliceSize
pure MipLevel :: Word32 -> Vector ArrayElement -> MipLevel
MipLevel
{ $sel:imageSize:MipLevel :: Word32
imageSize = Word32
imageSize
, $sel:arrayElements:MipLevel :: Vector ArrayElement
arrayElements = Vector (Vector (Vector ZSlice)) -> Vector ArrayElement
coerce Vector (Vector (Vector ZSlice))
elements
}
where
some_ :: a -> m b -> m (Vector b)
some_ a
n m b
action = Vector a -> (a -> m b) -> m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
Vector.forM ([a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList [a
1..a
n]) \a
_ix -> m b
action
numberOfMipmapLevels' :: Word32
numberOfMipmapLevels'
| Word32
numberOfMipmapLevels Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
| Bool
otherwise = Word32
numberOfMipmapLevels
numberOfArrayElements' :: Word32
numberOfArrayElements'
| Word32
numberOfArrayElements Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
| Bool
otherwise = Word32
numberOfArrayElements
pixelDepth' :: Word32
pixelDepth'
| Word32
pixelDepth Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
1
| Bool
otherwise = Word32
pixelDepth
getImageSize :: Get Word32
getImageSize =
if Word32
endianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
Get Word32
getWord32le
else
Get Word32
getWord32be
putImages :: (Word32 -> Put) -> MipLevels -> Put
putImages :: (Word32 -> PutM ()) -> MipLevels -> PutM ()
putImages Word32 -> PutM ()
putWord32 MipLevels
mipLevels = MipLevels -> (MipLevel -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ MipLevels
mipLevels \MipLevel{Word32
Vector ArrayElement
arrayElements :: Vector ArrayElement
imageSize :: Word32
$sel:arrayElements:MipLevel :: MipLevel -> Vector ArrayElement
$sel:imageSize:MipLevel :: MipLevel -> Word32
..} -> do
Word32 -> PutM ()
putWord32 Word32
imageSize
Vector ArrayElement -> (ArrayElement -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector ArrayElement
arrayElements \ArrayElement{Vector Face
faces :: Vector Face
$sel:faces:ArrayElement :: ArrayElement -> Vector Face
..} ->
Vector Face -> (Face -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector Face
faces \Face{Vector ZSlice
zSlices :: Vector ZSlice
$sel:zSlices:Face :: Face -> Vector ZSlice
..} ->
Vector ZSlice -> (ZSlice -> PutM ()) -> PutM ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
Vector.forM_ Vector ZSlice
zSlices \ZSlice{ByteString
block :: ByteString
$sel:block:ZSlice :: ZSlice -> ByteString
..} ->
ByteString -> PutM ()
putByteString ByteString
block
mkPutWord32 :: Word32 -> (Word32 -> Put)
mkPutWord32 :: Word32 -> Word32 -> PutM ()
mkPutWord32 Word32
someEndianness =
if Word32
someEndianness Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
endiannessLE then
Word32 -> PutM ()
putWord32le
else
Word32 -> PutM ()
putWord32be