module Text.GLTF.Loader.Internal.Decoders
  ( -- * GLTF Property-specific Type decoders
    getIndices,
    getPositions,
    getNormals,
    getTexCoords,
    -- * GLTF Accessor Type decoders
    getScalar,
    getVec2,
    getVec3,
    getVec4,
    getMat2,
    getMat3,
    getMat4,
    -- * GLTF Component Type decoders
    getByte,
    getUnsignedByte,
    getShort,
    getUnsignedShort,
    getUnsignedInt,
    getFloat
  ) where

import Data.Binary.Get
import Linear
import RIO hiding (min, max)
import qualified RIO.Vector as Vector

-- | Vertex indices binary decoder
getIndices :: Get (Vector Word16)
getIndices :: Get (Vector Word16)
getIndices = forall a. Get a -> Get (Vector a)
getScalar Get Word16
getUnsignedShort

-- | Vertex positions binary decoder
getPositions :: Get (Vector (V3 Float))
getPositions :: Get (Vector (V3 Float))
getPositions = forall a. Get a -> Get (Vector (V3 a))
getVec3 Get Float
getFloat

-- | Vertex normals binary decoder
getNormals :: Get (Vector (V3 Float))
getNormals :: Get (Vector (V3 Float))
getNormals = forall a. Get a -> Get (Vector (V3 a))
getVec3 Get Float
getFloat

-- | Texture coordinates binary decoder
getTexCoords :: Get (Vector (V2 Float))
getTexCoords :: Get (Vector (V2 Float))
getTexCoords = forall a. Get a -> Get (Vector (V2 a))
getVec2 Get Float
getFloat

-- | Scalar (simple) type binary decoder
getScalar :: Get a -> Get (Vector a)
getScalar :: forall a. Get a -> Get (Vector a)
getScalar = forall a. Get a -> Get (Vector a)
getVector

-- | 2D Vector binary decoder
getVec2 :: Get a -> Get (Vector (V2 a))
getVec2 :: forall a. Get a -> Get (Vector (V2 a))
getVec2 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter

-- | 3D Vector binary decoder
getVec3 :: Get a -> Get (Vector (V3 a))
getVec3 :: forall a. Get a -> Get (Vector (V3 a))
getVec3 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter

-- | 4D Vector binary decoder
getVec4 :: Get a -> Get (Vector (V4 a))
getVec4 :: forall a. Get a -> Get (Vector (V4 a))
getVec4 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> V4 a
V4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
getter

-- | 2x2 Matrix binary decoder
getMat2 :: Get a -> Get (Vector (M22 a))
getMat2 :: forall a. Get a -> Get (Vector (M22 a))
getMat2 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ do
  a
m1_1 <- Get a
getter
  a
m1_2 <- Get a
getter

  a
m2_1 <- Get a
getter
  a
m2_2 <- Get a
getter

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2
    (forall a. a -> a -> V2 a
V2 a
m1_1 a
m2_1)
    (forall a. a -> a -> V2 a
V2 a
m1_2 a
m2_2)

-- | 3x3 Matrix binary decoder
getMat3 :: Get a -> Get (Vector (M33 a))
getMat3 :: forall a. Get a -> Get (Vector (M33 a))
getMat3 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ do
  a
m1_1 <- Get a
getter
  a
m1_2 <- Get a
getter
  a
m1_3 <- Get a
getter
  
  a
m2_1 <- Get a
getter
  a
m2_2 <- Get a
getter
  a
m2_3 <- Get a
getter

  a
m3_1 <- Get a
getter
  a
m3_2 <- Get a
getter
  a
m3_3 <- Get a
getter

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> V3 a
V3
    (forall a. a -> a -> a -> V3 a
V3 a
m1_1 a
m2_1 a
m3_1)
    (forall a. a -> a -> a -> V3 a
V3 a
m1_2 a
m2_2 a
m3_2)
    (forall a. a -> a -> a -> V3 a
V3 a
m1_3 a
m2_3 a
m3_3)

-- | 4x4 Matrix binary decoder
getMat4 :: Get a -> Get (Vector (M44 a))
getMat4 :: forall a. Get a -> Get (Vector (M44 a))
getMat4 Get a
getter = forall a. Get a -> Get (Vector a)
getVector forall a b. (a -> b) -> a -> b
$ do
  a
m1_1 <- Get a
getter
  a
m1_2 <- Get a
getter
  a
m1_3 <- Get a
getter
  a
m1_4 <- Get a
getter
  
  a
m2_1 <- Get a
getter
  a
m2_2 <- Get a
getter
  a
m2_3 <- Get a
getter
  a
m2_4 <- Get a
getter

  a
m3_1 <- Get a
getter
  a
m3_2 <- Get a
getter
  a
m3_3 <- Get a
getter
  a
m3_4 <- Get a
getter

  a
m4_1 <- Get a
getter
  a
m4_2 <- Get a
getter
  a
m4_3 <- Get a
getter
  a
m4_4 <- Get a
getter

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> V4 a
V4
    (forall a. a -> a -> a -> a -> V4 a
V4 a
m1_1 a
m2_1 a
m3_1 a
m4_1)
    (forall a. a -> a -> a -> a -> V4 a
V4 a
m1_2 a
m2_2 a
m3_2 a
m4_2)
    (forall a. a -> a -> a -> a -> V4 a
V4 a
m1_3 a
m2_3 a
m3_3 a
m4_3)
    (forall a. a -> a -> a -> a -> V4 a
V4 a
m1_4 a
m2_4 a
m3_4 a
m4_4)

-- | Byte binary decoder
getByte :: Get Int8
getByte :: Get Int8
getByte = Get Int8
getInt8

-- | Unsigned Byte binary decoder
getUnsignedByte :: Get Word8
getUnsignedByte :: Get Word8
getUnsignedByte = Get Word8
getWord8

-- | Short binary decoder
getShort :: Get Int16
getShort :: Get Int16
getShort = Get Int16
getInt16le

-- | Unsigned Short binary decoder
getUnsignedShort :: Get Word16
getUnsignedShort :: Get Word16
getUnsignedShort = Get Word16
getWord16le

-- | Unsigned Int binary decoder
getUnsignedInt :: Get Word32
getUnsignedInt :: Get Word32
getUnsignedInt = Get Word32
getWord32le

-- | Float binary decoder
getFloat :: Get Float
getFloat :: Get Float
getFloat = Get Float
getFloatle

-- | Boxed Vector binary decoder
getVector :: Get a -> Get (Vector a)
getVector :: forall a. Get a -> Get (Vector a)
getVector = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> Get [a]
getList

-- | List binary decoder
getList :: Get a -> Get [a]
getList :: forall a. Get a -> Get [a]
getList Get a
getter = do
  Bool
empty <- Get Bool
isEmpty
  if Bool
empty
    then forall (m :: * -> *) a. Monad m => a -> m a
return []
    else (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Get a -> Get [a]
getList Get a
getter