module Codec.Ktx2.DFD.Khronos.BasicV2 where

import Data.Binary (Binary(..))
import Data.Binary.Get (Get, getWord8, getWord16le, getWord32le, runGetOrFail)
import Data.Binary.Put (PutM, putWord8, putWord16le, putWord32le, runPut)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Lazy qualified as LBS
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word8, Word16, Word32)
import GHC.Generics (Generic)

import Codec.Ktx2.DFD qualified as DFD

-- | Khronos
pattern VENDOR_ID :: (Eq a, Num a) => a
pattern $bVENDOR_ID :: forall a. (Eq a, Num a) => a
$mVENDOR_ID :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
VENDOR_ID = 0

-- | Basic DFD Block
pattern DESCRIPTOR_TYPE :: (Eq a, Num a) => a
pattern $bDESCRIPTOR_TYPE :: forall a. (Eq a, Num a) => a
$mDESCRIPTOR_TYPE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
DESCRIPTOR_TYPE = 0

-- | KDF v1.3
pattern VERSION :: (Eq a, Num a) => a
pattern $bVERSION :: forall a. (Eq a, Num a) => a
$mVERSION :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
VERSION = 2

{- |
  A basic descriptor block is designed to encode common metadata associated with bulk data — especially image or texture data.

  While this descriptor holds more information about the data interpretation than is needed by many applications,
  a comprehensive encoding reduces the risk of metadata needed by different APIs being lost in translation.

  The format is described in terms of a repeating axis-aligned texel block composed of samples.
  Each sample contains a single channel of information with a single spatial offset within the texel block,
  and consists of an amount of contiguous data. This descriptor block consists of information about the interpretation
  of the texel block as a whole, supplemented by a description of a number of samples taken from one or more planes of contiguous memory.

  <https://registry.khronos.org/DataFormat/specs/1.3/dataformat.1.3.html>
-}
data BasicV2 = BasicV2
  { BasicV2 -> Word8
colorModel :: Word8
  , BasicV2 -> Word8
colorPrimaries :: Word8
  , BasicV2 -> Word8
transferFunction :: Word8
  , BasicV2 -> Word8
flags :: Word8

  , BasicV2 -> Word8
texelBlockDimension0 :: Word8
    {- ^
      The value held in each of these fields is one fewer than the size of the block in that dimension — 
      that is, a value of 0 represents a size of 1, a value of 1 represents a size of 2, etc.

      A texel block which covers fewer than four dimensions should have a size of 1 in each dimension
      that it lacks, and therefore the corresponding fields in the representation should be 0.
    -}
  , BasicV2 -> Word8
texelBlockDimension1 :: Word8
  , BasicV2 -> Word8
texelBlockDimension2 :: Word8
  , BasicV2 -> Word8
texelBlockDimension3 :: Word8

  , BasicV2 -> Word8
bytesPlane0 :: Word8
  , BasicV2 -> Word8
bytesPlane1 :: Word8
  , BasicV2 -> Word8
bytesPlane2 :: Word8
  , BasicV2 -> Word8
bytesPlane3 :: Word8
  , BasicV2 -> Word8
bytesPlane4 :: Word8
  , BasicV2 -> Word8
bytesPlane5 :: Word8
  , BasicV2 -> Word8
bytesPlane6 :: Word8
  , BasicV2 -> Word8
bytesPlane7 :: Word8

  , BasicV2 -> Vector Sample
samples :: Vector Sample
  }
  deriving (BasicV2 -> BasicV2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicV2 -> BasicV2 -> Bool
$c/= :: BasicV2 -> BasicV2 -> Bool
== :: BasicV2 -> BasicV2 -> Bool
$c== :: BasicV2 -> BasicV2 -> Bool
Eq, Int -> BasicV2 -> ShowS
[BasicV2] -> ShowS
BasicV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicV2] -> ShowS
$cshowList :: [BasicV2] -> ShowS
show :: BasicV2 -> String
$cshow :: BasicV2 -> String
showsPrec :: Int -> BasicV2 -> ShowS
$cshowsPrec :: Int -> BasicV2 -> ShowS
Show, forall x. Rep BasicV2 x -> BasicV2
forall x. BasicV2 -> Rep BasicV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BasicV2 x -> BasicV2
$cfrom :: forall x. BasicV2 -> Rep BasicV2 x
Generic)

getter :: Int -> Get BasicV2
getter :: Int -> Get BasicV2
getter Int
numSamples = do
  Word8
colorModel <- Get Word8
getWord8
  Word8
colorPrimaries <- Get Word8
getWord8
  Word8
transferFunction <- Get Word8
getWord8
  Word8
flags <- Get Word8
getWord8

  Word8
texelBlockDimension0 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Word8
1) Get Word8
getWord8
  Word8
texelBlockDimension1 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Word8
1) Get Word8
getWord8
  Word8
texelBlockDimension2 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Word8
1) Get Word8
getWord8
  Word8
texelBlockDimension3 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Word8
1) Get Word8
getWord8

  Word8
bytesPlane0 <- Get Word8
getWord8
  Word8
bytesPlane1 <- Get Word8
getWord8
  Word8
bytesPlane2 <- Get Word8
getWord8
  Word8
bytesPlane3 <- Get Word8
getWord8
  Word8
bytesPlane4 <- Get Word8
getWord8
  Word8
bytesPlane5 <- Get Word8
getWord8
  Word8
bytesPlane6 <- Get Word8
getWord8
  Word8
bytesPlane7 <- Get Word8
getWord8

  Vector Sample
samples <- forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
numSamples forall t. Binary t => Get t
get

  pure BasicV2{Word8
Vector Sample
samples :: Vector Sample
bytesPlane7 :: Word8
bytesPlane6 :: Word8
bytesPlane5 :: Word8
bytesPlane4 :: Word8
bytesPlane3 :: Word8
bytesPlane2 :: Word8
bytesPlane1 :: Word8
bytesPlane0 :: Word8
texelBlockDimension3 :: Word8
texelBlockDimension2 :: Word8
texelBlockDimension1 :: Word8
texelBlockDimension0 :: Word8
flags :: Word8
transferFunction :: Word8
colorPrimaries :: Word8
colorModel :: Word8
samples :: Vector Sample
bytesPlane7 :: Word8
bytesPlane6 :: Word8
bytesPlane5 :: Word8
bytesPlane4 :: Word8
bytesPlane3 :: Word8
bytesPlane2 :: Word8
bytesPlane1 :: Word8
bytesPlane0 :: Word8
texelBlockDimension3 :: Word8
texelBlockDimension2 :: Word8
texelBlockDimension1 :: Word8
texelBlockDimension0 :: Word8
flags :: Word8
transferFunction :: Word8
colorPrimaries :: Word8
colorModel :: Word8
..}

putter :: BasicV2 -> PutM ()
putter :: BasicV2 -> PutM ()
putter BasicV2{Word8
Vector Sample
samples :: Vector Sample
bytesPlane7 :: Word8
bytesPlane6 :: Word8
bytesPlane5 :: Word8
bytesPlane4 :: Word8
bytesPlane3 :: Word8
bytesPlane2 :: Word8
bytesPlane1 :: Word8
bytesPlane0 :: Word8
texelBlockDimension3 :: Word8
texelBlockDimension2 :: Word8
texelBlockDimension1 :: Word8
texelBlockDimension0 :: Word8
flags :: Word8
transferFunction :: Word8
colorPrimaries :: Word8
colorModel :: Word8
samples :: BasicV2 -> Vector Sample
bytesPlane7 :: BasicV2 -> Word8
bytesPlane6 :: BasicV2 -> Word8
bytesPlane5 :: BasicV2 -> Word8
bytesPlane4 :: BasicV2 -> Word8
bytesPlane3 :: BasicV2 -> Word8
bytesPlane2 :: BasicV2 -> Word8
bytesPlane1 :: BasicV2 -> Word8
bytesPlane0 :: BasicV2 -> Word8
texelBlockDimension3 :: BasicV2 -> Word8
texelBlockDimension2 :: BasicV2 -> Word8
texelBlockDimension1 :: BasicV2 -> Word8
texelBlockDimension0 :: BasicV2 -> Word8
flags :: BasicV2 -> Word8
transferFunction :: BasicV2 -> Word8
colorPrimaries :: BasicV2 -> Word8
colorModel :: BasicV2 -> Word8
..} = do
  Word8 -> PutM ()
putWord8 Word8
colorModel
  Word8 -> PutM ()
putWord8 Word8
colorPrimaries
  Word8 -> PutM ()
putWord8 Word8
transferFunction
  Word8 -> PutM ()
putWord8 Word8
flags

  Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ Word8
texelBlockDimension0 forall a. Num a => a -> a -> a
- Word8
1
  Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ Word8
texelBlockDimension1 forall a. Num a => a -> a -> a
- Word8
1
  Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ Word8
texelBlockDimension2 forall a. Num a => a -> a -> a
- Word8
1
  Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ Word8
texelBlockDimension3 forall a. Num a => a -> a -> a
- Word8
1

  Word8 -> PutM ()
putWord8 Word8
bytesPlane0
  Word8 -> PutM ()
putWord8 Word8
bytesPlane1
  Word8 -> PutM ()
putWord8 Word8
bytesPlane2
  Word8 -> PutM ()
putWord8 Word8
bytesPlane3
  Word8 -> PutM ()
putWord8 Word8
bytesPlane4
  Word8 -> PutM ()
putWord8 Word8
bytesPlane5
  Word8 -> PutM ()
putWord8 Word8
bytesPlane6
  Word8 -> PutM ()
putWord8 Word8
bytesPlane7

  forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
Vector.mapM_ forall t. Binary t => t -> PutM ()
put Vector Sample
samples

data Sample = Sample
  { Sample -> Word16
bitOffset :: Word16
  , Sample -> Word8
bitLength :: Word8
  , Sample -> Word8
channelType :: Word8

  , Sample -> Word8
samplePosition0 :: Word8
  , Sample -> Word8
samplePosition1 :: Word8
  , Sample -> Word8
samplePosition2 :: Word8
  , Sample -> Word8
samplePosition3 :: Word8

  , Sample -> Word32
sampleLower :: Word32
  , Sample -> Word32
sampleUpper :: Word32
  }
  deriving (Sample -> Sample -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c== :: Sample -> Sample -> Bool
Eq, Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sample] -> ShowS
$cshowList :: [Sample] -> ShowS
show :: Sample -> String
$cshow :: Sample -> String
showsPrec :: Int -> Sample -> ShowS
$cshowsPrec :: Int -> Sample -> ShowS
Show, forall x. Rep Sample x -> Sample
forall x. Sample -> Rep Sample x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sample x -> Sample
$cfrom :: forall x. Sample -> Rep Sample x
Generic)

instance Binary Sample where
  get :: Get Sample
get = do
    Word16
bitOffset <- Get Word16
getWord16le
    Word8
bitLength <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+Word8
1) Get Word8
getWord8
    Word8
channelType <- Get Word8
getWord8

    Word8
samplePosition0 <- Get Word8
getWord8
    Word8
samplePosition1 <- Get Word8
getWord8
    Word8
samplePosition2 <- Get Word8
getWord8
    Word8
samplePosition3 <- Get Word8
getWord8

    Word32
sampleLower <- Get Word32
getWord32le
    Word32
sampleUpper <- Get Word32
getWord32le

    pure Sample{Word8
Word16
Word32
sampleUpper :: Word32
sampleLower :: Word32
samplePosition3 :: Word8
samplePosition2 :: Word8
samplePosition1 :: Word8
samplePosition0 :: Word8
channelType :: Word8
bitLength :: Word8
bitOffset :: Word16
sampleUpper :: Word32
sampleLower :: Word32
samplePosition3 :: Word8
samplePosition2 :: Word8
samplePosition1 :: Word8
samplePosition0 :: Word8
channelType :: Word8
bitLength :: Word8
bitOffset :: Word16
..}

  put :: Sample -> PutM ()
put Sample{Word8
Word16
Word32
sampleUpper :: Word32
sampleLower :: Word32
samplePosition3 :: Word8
samplePosition2 :: Word8
samplePosition1 :: Word8
samplePosition0 :: Word8
channelType :: Word8
bitLength :: Word8
bitOffset :: Word16
sampleUpper :: Sample -> Word32
sampleLower :: Sample -> Word32
samplePosition3 :: Sample -> Word8
samplePosition2 :: Sample -> Word8
samplePosition1 :: Sample -> Word8
samplePosition0 :: Sample -> Word8
channelType :: Sample -> Word8
bitLength :: Sample -> Word8
bitOffset :: Sample -> Word16
..} = do
    Word16 -> PutM ()
putWord16le Word16
bitOffset
    Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ Word8
bitLength forall a. Num a => a -> a -> a
- Word8
1
    Word8 -> PutM ()
putWord8 Word8
channelType

    Word8 -> PutM ()
putWord8 Word8
samplePosition0
    Word8 -> PutM ()
putWord8 Word8
samplePosition1
    Word8 -> PutM ()
putWord8 Word8
samplePosition2
    Word8 -> PutM ()
putWord8 Word8
samplePosition3

    Word32 -> PutM ()
putWord32le Word32
sampleLower
    Word32 -> PutM ()
putWord32le Word32
sampleUpper

fromBlock :: DFD.Block -> Maybe BasicV2
fromBlock :: Block -> Maybe BasicV2
fromBlock DFD.Block{Word32
descriptorBlockSize :: Block -> Word32
descriptorBlockSize :: Word32
descriptorBlockSize, ByteString
body :: Block -> ByteString
body :: ByteString
body} =
  case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Int -> Get BasicV2
getter Int
numSamples) ([ByteString] -> ByteString
LBS.fromChunks [ByteString
body]) of
    Left (ByteString, ByteOffset, String)
_err ->
      forall a. Maybe a
Nothing
    Right (ByteString
_bytes, ByteOffset
_offset, BasicV2
ok) ->
      forall a. a -> Maybe a
Just BasicV2
ok
  where
    numSamples :: Int
numSamples =
      forall a. Integral a => a -> a -> a
div (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
descriptorBlockSize forall a. Num a => a -> a -> a
- Int
24) Int
16

toBlock :: BasicV2 -> DFD.Block
toBlock :: BasicV2 -> Block
toBlock BasicV2
v2 =
  DFD.Block
    { descriptorType :: Word32
descriptorType =
        forall a. (Eq a, Num a) => a
DESCRIPTOR_TYPE
    , vendorId :: Word32
vendorId =
        forall a. (Eq a, Num a) => a
VENDOR_ID
    , versionNumber :: Word32
versionNumber =
        forall a. (Eq a, Num a) => a
VERSION
    , descriptorBlockSize :: Word32
descriptorBlockSize =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
body forall a. Num a => a -> a -> a
+ Int
8
    , body :: ByteString
body =
        ByteString
body
    }
  where
    body :: ByteString
body = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM () -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ BasicV2 -> PutM ()
putter BasicV2
v2