module Graphics.TextureContainer.KTX where
import Control.Applicative
import Control.Exception
import Control.Monad
import qualified Data.ByteString as B
import Data.Packer
import Data.Word
data Ktx = Ktx
{ ktxName :: FilePath
, ktxContent :: B.ByteString
, ktxGlType :: Word32
, ktxGlTypeSize :: Word32
, ktxGlFormat :: Word32
, ktxGlInternalFormat :: Word32
, ktxGlBaseInternalFormat :: Word32
, ktxPixelWidth :: Word32
, ktxPixelHeight :: Word32
, ktxPixelDepth :: Word32
, ktxNumElems :: Word32
, ktxNumFaces :: Word32
, ktxNumMipLevels :: Word32
, ktxMap :: [(B.ByteString, B.ByteString)]
, ktxImage :: [[B.ByteString]]
} deriving Show
unpackKtx :: FilePath -> B.ByteString -> Unpacking Ktx
unpackKtx name orig = do
let w = getWord32
(0x58544BAB, 0xBB313120, 0x0A1A0A0D) <- (,,) <$> w <*> w <*> w
0x04030201 <- getWord32
ktx <- Ktx name orig <$> w <*> w <*> w <*> w <*> w <*> w
<*> w <*> w <*> w <*> w <*> w
bytesOfKeyValueData <- getWord32
let getKVP 0 = return []
getKVP i = do
keyAndValueByteSize <- getWord32
x <- getBytes (fromIntegral keyAndValueByteSize)
let padding = 3 (keyAndValueByteSize + 3) `mod` 4
unpackSkip (fromIntegral padding)
xs <- getKVP (i keyAndValueByteSize padding)
return (x:xs)
kvp <- map (B.breakByte 0) <$> getKVP bytesOfKeyValueData
let Ktx{..} = ktx kvp []
imgs <- forM [1..max 1 ktxNumMipLevels] $ \_ -> do
imageSize <- getWord32
forM [1..max 1 ktxNumFaces] $ \_ -> do
img <- getBytes (fromIntegral imageSize)
unpackSkip $ fromIntegral (3 (imageSize + 3) `mod` 4)
return img
return $ ktx kvp imgs
ktxFromFile :: FilePath -> IO Ktx
ktxFromFile path = B.readFile path >>= return . readKtx path
readKtx :: FilePath -> B.ByteString -> Ktx
readKtx path bs = runUnpacking (unpackKtx path bs) bs
tryKtx :: FilePath -> B.ByteString -> Either SomeException Ktx
tryKtx path bs = tryUnpacking (unpackKtx path bs) bs