module Codec.GlTF.Accessor
  ( AccessorIx(..)
  , Accessor(..)

  , AccessorSparse(..)
  , AccessorSparseIndices(..)
  , AccessorSparseValues(..)

  , ComponentType(..)
  , pattern BYTE
  , pattern UNSIGNED_BYTE
  , pattern SHORT
  , pattern UNSIGNED_SHORT
  , pattern UNSIGNED_INT
  , pattern FLOAT

  , AttributeType(..)
  , pattern SCALAR
  , pattern VEC2
  , pattern VEC3
  , pattern VEC4
  , pattern MAT2
  , pattern MAT3
  , pattern MAT4
  ) where

import Prelude hiding (min, max)
import Codec.GlTF.Prelude

import Codec.GlTF.BufferView (BufferViewIx)

newtype AccessorIx = AccessorIx { AccessorIx -> Int
unAccessorIx :: Int }
  deriving (AccessorIx -> AccessorIx -> Bool
(AccessorIx -> AccessorIx -> Bool)
-> (AccessorIx -> AccessorIx -> Bool) -> Eq AccessorIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessorIx -> AccessorIx -> Bool
$c/= :: AccessorIx -> AccessorIx -> Bool
== :: AccessorIx -> AccessorIx -> Bool
$c== :: AccessorIx -> AccessorIx -> Bool
Eq, Eq AccessorIx
Eq AccessorIx
-> (AccessorIx -> AccessorIx -> Ordering)
-> (AccessorIx -> AccessorIx -> Bool)
-> (AccessorIx -> AccessorIx -> Bool)
-> (AccessorIx -> AccessorIx -> Bool)
-> (AccessorIx -> AccessorIx -> Bool)
-> (AccessorIx -> AccessorIx -> AccessorIx)
-> (AccessorIx -> AccessorIx -> AccessorIx)
-> Ord AccessorIx
AccessorIx -> AccessorIx -> Bool
AccessorIx -> AccessorIx -> Ordering
AccessorIx -> AccessorIx -> AccessorIx
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 :: AccessorIx -> AccessorIx -> AccessorIx
$cmin :: AccessorIx -> AccessorIx -> AccessorIx
max :: AccessorIx -> AccessorIx -> AccessorIx
$cmax :: AccessorIx -> AccessorIx -> AccessorIx
>= :: AccessorIx -> AccessorIx -> Bool
$c>= :: AccessorIx -> AccessorIx -> Bool
> :: AccessorIx -> AccessorIx -> Bool
$c> :: AccessorIx -> AccessorIx -> Bool
<= :: AccessorIx -> AccessorIx -> Bool
$c<= :: AccessorIx -> AccessorIx -> Bool
< :: AccessorIx -> AccessorIx -> Bool
$c< :: AccessorIx -> AccessorIx -> Bool
compare :: AccessorIx -> AccessorIx -> Ordering
$ccompare :: AccessorIx -> AccessorIx -> Ordering
$cp1Ord :: Eq AccessorIx
Ord, Int -> AccessorIx -> ShowS
[AccessorIx] -> ShowS
AccessorIx -> String
(Int -> AccessorIx -> ShowS)
-> (AccessorIx -> String)
-> ([AccessorIx] -> ShowS)
-> Show AccessorIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessorIx] -> ShowS
$cshowList :: [AccessorIx] -> ShowS
show :: AccessorIx -> String
$cshow :: AccessorIx -> String
showsPrec :: Int -> AccessorIx -> ShowS
$cshowsPrec :: Int -> AccessorIx -> ShowS
Show, Value -> Parser [AccessorIx]
Value -> Parser AccessorIx
(Value -> Parser AccessorIx)
-> (Value -> Parser [AccessorIx]) -> FromJSON AccessorIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AccessorIx]
$cparseJSONList :: Value -> Parser [AccessorIx]
parseJSON :: Value -> Parser AccessorIx
$cparseJSON :: Value -> Parser AccessorIx
FromJSON, [AccessorIx] -> Encoding
[AccessorIx] -> Value
AccessorIx -> Encoding
AccessorIx -> Value
(AccessorIx -> Value)
-> (AccessorIx -> Encoding)
-> ([AccessorIx] -> Value)
-> ([AccessorIx] -> Encoding)
-> ToJSON AccessorIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AccessorIx] -> Encoding
$ctoEncodingList :: [AccessorIx] -> Encoding
toJSONList :: [AccessorIx] -> Value
$ctoJSONList :: [AccessorIx] -> Value
toEncoding :: AccessorIx -> Encoding
$ctoEncoding :: AccessorIx -> Encoding
toJSON :: AccessorIx -> Value
$ctoJSON :: AccessorIx -> Value
ToJSON, (forall x. AccessorIx -> Rep AccessorIx x)
-> (forall x. Rep AccessorIx x -> AccessorIx) -> Generic AccessorIx
forall x. Rep AccessorIx x -> AccessorIx
forall x. AccessorIx -> Rep AccessorIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessorIx x -> AccessorIx
$cfrom :: forall x. AccessorIx -> Rep AccessorIx x
Generic)

-- | The root object for a glTF Accessor.
data Accessor = Accessor
  { Accessor -> ComponentType
componentType :: ComponentType
  , Accessor -> Bool
normalized    :: Bool
  , Accessor -> Int
byteOffset    :: Size
  , Accessor -> Int
count         :: Size
  , Accessor -> AttributeType
type'         :: AttributeType

  , Accessor -> Maybe BufferViewIx
bufferView    :: Maybe BufferViewIx
  , Accessor -> Maybe (Vector Scientific)
min           :: Maybe (Vector Scientific)
  , Accessor -> Maybe (Vector Scientific)
max           :: Maybe (Vector Scientific)
  , Accessor -> Maybe AccessorSparse
sparse        :: Maybe AccessorSparse

  , Accessor -> Maybe Text
name       :: Maybe Text
  , Accessor -> Maybe Object
extensions :: Maybe Object
  , Accessor -> Maybe Value
extras     :: Maybe Value
  } deriving (Accessor -> Accessor -> Bool
(Accessor -> Accessor -> Bool)
-> (Accessor -> Accessor -> Bool) -> Eq Accessor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accessor -> Accessor -> Bool
$c/= :: Accessor -> Accessor -> Bool
== :: Accessor -> Accessor -> Bool
$c== :: Accessor -> Accessor -> Bool
Eq, Int -> Accessor -> ShowS
[Accessor] -> ShowS
Accessor -> String
(Int -> Accessor -> ShowS)
-> (Accessor -> String) -> ([Accessor] -> ShowS) -> Show Accessor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accessor] -> ShowS
$cshowList :: [Accessor] -> ShowS
show :: Accessor -> String
$cshow :: Accessor -> String
showsPrec :: Int -> Accessor -> ShowS
$cshowsPrec :: Int -> Accessor -> ShowS
Show, (forall x. Accessor -> Rep Accessor x)
-> (forall x. Rep Accessor x -> Accessor) -> Generic Accessor
forall x. Rep Accessor x -> Accessor
forall x. Accessor -> Rep Accessor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Accessor x -> Accessor
$cfrom :: forall x. Accessor -> Rep Accessor x
Generic)

instance FromJSON Accessor where
  parseJSON :: Value -> Parser Accessor
parseJSON = String -> (Object -> Parser Accessor) -> Value -> Parser Accessor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Accessor" \Object
o -> do
    Maybe BufferViewIx
bufferView    <- Object
o Object -> Key -> Parser (Maybe BufferViewIx)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bufferView"
    Int
byteOffset    <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"byteOffset" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    ComponentType
componentType <- Object
o Object -> Key -> Parser ComponentType
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"componentType"
    Bool
normalized    <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"normalized" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Int
count         <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"count"
    AttributeType
type'         <- Object
o Object -> Key -> Parser AttributeType
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"type"
    Maybe (Vector Scientific)
min           <- Object
o Object -> Key -> Parser (Maybe (Vector Scientific))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min"
    Maybe (Vector Scientific)
max           <- Object
o Object -> Key -> Parser (Maybe (Vector Scientific))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max"
    Maybe AccessorSparse
sparse        <- Object
o Object -> Key -> Parser (Maybe AccessorSparse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sparse"
    Maybe Text
name          <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    Maybe Object
extensions    <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extensions"
    Maybe Value
extras        <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extras"
    pure Accessor :: ComponentType
-> Bool
-> Int
-> Int
-> AttributeType
-> Maybe BufferViewIx
-> Maybe (Vector Scientific)
-> Maybe (Vector Scientific)
-> Maybe AccessorSparse
-> Maybe Text
-> Maybe Object
-> Maybe Value
-> Accessor
Accessor{Bool
Int
Maybe Text
Maybe Value
Maybe Object
Maybe (Vector Scientific)
Maybe BufferViewIx
Maybe AccessorSparse
AttributeType
ComponentType
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
sparse :: Maybe AccessorSparse
max :: Maybe (Vector Scientific)
min :: Maybe (Vector Scientific)
type' :: AttributeType
count :: Int
normalized :: Bool
componentType :: ComponentType
byteOffset :: Int
bufferView :: Maybe BufferViewIx
$sel:extras:Accessor :: Maybe Value
$sel:extensions:Accessor :: Maybe Object
$sel:name:Accessor :: Maybe Text
$sel:sparse:Accessor :: Maybe AccessorSparse
$sel:max:Accessor :: Maybe (Vector Scientific)
$sel:min:Accessor :: Maybe (Vector Scientific)
$sel:bufferView:Accessor :: Maybe BufferViewIx
$sel:type':Accessor :: AttributeType
$sel:count:Accessor :: Int
$sel:byteOffset:Accessor :: Int
$sel:normalized:Accessor :: Bool
$sel:componentType:Accessor :: ComponentType
..}

instance ToJSON Accessor where
  toJSON :: Accessor -> Value
toJSON = Accessor -> Value
forall a. (Generic a, GToJSON' Value Zero (Rep a)) => a -> Value
gToJSON

newtype ComponentType = ComponentType { ComponentType -> Int
unComponentType :: Int }
  deriving (ComponentType -> ComponentType -> Bool
(ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool) -> Eq ComponentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentType -> ComponentType -> Bool
$c/= :: ComponentType -> ComponentType -> Bool
== :: ComponentType -> ComponentType -> Bool
$c== :: ComponentType -> ComponentType -> Bool
Eq, Eq ComponentType
Eq ComponentType
-> (ComponentType -> ComponentType -> Ordering)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> ComponentType)
-> (ComponentType -> ComponentType -> ComponentType)
-> Ord ComponentType
ComponentType -> ComponentType -> Bool
ComponentType -> ComponentType -> Ordering
ComponentType -> ComponentType -> ComponentType
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 :: ComponentType -> ComponentType -> ComponentType
$cmin :: ComponentType -> ComponentType -> ComponentType
max :: ComponentType -> ComponentType -> ComponentType
$cmax :: ComponentType -> ComponentType -> ComponentType
>= :: ComponentType -> ComponentType -> Bool
$c>= :: ComponentType -> ComponentType -> Bool
> :: ComponentType -> ComponentType -> Bool
$c> :: ComponentType -> ComponentType -> Bool
<= :: ComponentType -> ComponentType -> Bool
$c<= :: ComponentType -> ComponentType -> Bool
< :: ComponentType -> ComponentType -> Bool
$c< :: ComponentType -> ComponentType -> Bool
compare :: ComponentType -> ComponentType -> Ordering
$ccompare :: ComponentType -> ComponentType -> Ordering
$cp1Ord :: Eq ComponentType
Ord, Int -> ComponentType -> ShowS
[ComponentType] -> ShowS
ComponentType -> String
(Int -> ComponentType -> ShowS)
-> (ComponentType -> String)
-> ([ComponentType] -> ShowS)
-> Show ComponentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentType] -> ShowS
$cshowList :: [ComponentType] -> ShowS
show :: ComponentType -> String
$cshow :: ComponentType -> String
showsPrec :: Int -> ComponentType -> ShowS
$cshowsPrec :: Int -> ComponentType -> ShowS
Show, Value -> Parser [ComponentType]
Value -> Parser ComponentType
(Value -> Parser ComponentType)
-> (Value -> Parser [ComponentType]) -> FromJSON ComponentType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ComponentType]
$cparseJSONList :: Value -> Parser [ComponentType]
parseJSON :: Value -> Parser ComponentType
$cparseJSON :: Value -> Parser ComponentType
FromJSON, [ComponentType] -> Encoding
[ComponentType] -> Value
ComponentType -> Encoding
ComponentType -> Value
(ComponentType -> Value)
-> (ComponentType -> Encoding)
-> ([ComponentType] -> Value)
-> ([ComponentType] -> Encoding)
-> ToJSON ComponentType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ComponentType] -> Encoding
$ctoEncodingList :: [ComponentType] -> Encoding
toJSONList :: [ComponentType] -> Value
$ctoJSONList :: [ComponentType] -> Value
toEncoding :: ComponentType -> Encoding
$ctoEncoding :: ComponentType -> Encoding
toJSON :: ComponentType -> Value
$ctoJSON :: ComponentType -> Value
ToJSON, (forall x. ComponentType -> Rep ComponentType x)
-> (forall x. Rep ComponentType x -> ComponentType)
-> Generic ComponentType
forall x. Rep ComponentType x -> ComponentType
forall x. ComponentType -> Rep ComponentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentType x -> ComponentType
$cfrom :: forall x. ComponentType -> Rep ComponentType x
Generic)

pattern BYTE :: ComponentType
pattern $bBYTE :: ComponentType
$mBYTE :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
BYTE = ComponentType 5120

pattern UNSIGNED_BYTE :: ComponentType
pattern $bUNSIGNED_BYTE :: ComponentType
$mUNSIGNED_BYTE :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
UNSIGNED_BYTE = ComponentType 5121

pattern SHORT :: ComponentType
pattern $bSHORT :: ComponentType
$mSHORT :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
SHORT = ComponentType 5122

pattern UNSIGNED_SHORT :: ComponentType
pattern $bUNSIGNED_SHORT :: ComponentType
$mUNSIGNED_SHORT :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
UNSIGNED_SHORT = ComponentType 5123

pattern UNSIGNED_INT :: ComponentType
pattern $bUNSIGNED_INT :: ComponentType
$mUNSIGNED_INT :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
UNSIGNED_INT = ComponentType 5125

pattern FLOAT :: ComponentType
pattern $bFLOAT :: ComponentType
$mFLOAT :: forall r. ComponentType -> (Void# -> r) -> (Void# -> r) -> r
FLOAT = ComponentType 5126

newtype AttributeType = AttributeType { AttributeType -> Text
unAttributeType :: Text }
  deriving (AttributeType -> AttributeType -> Bool
(AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool) -> Eq AttributeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeType -> AttributeType -> Bool
$c/= :: AttributeType -> AttributeType -> Bool
== :: AttributeType -> AttributeType -> Bool
$c== :: AttributeType -> AttributeType -> Bool
Eq, Eq AttributeType
Eq AttributeType
-> (AttributeType -> AttributeType -> Ordering)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> AttributeType)
-> (AttributeType -> AttributeType -> AttributeType)
-> Ord AttributeType
AttributeType -> AttributeType -> Bool
AttributeType -> AttributeType -> Ordering
AttributeType -> AttributeType -> AttributeType
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 :: AttributeType -> AttributeType -> AttributeType
$cmin :: AttributeType -> AttributeType -> AttributeType
max :: AttributeType -> AttributeType -> AttributeType
$cmax :: AttributeType -> AttributeType -> AttributeType
>= :: AttributeType -> AttributeType -> Bool
$c>= :: AttributeType -> AttributeType -> Bool
> :: AttributeType -> AttributeType -> Bool
$c> :: AttributeType -> AttributeType -> Bool
<= :: AttributeType -> AttributeType -> Bool
$c<= :: AttributeType -> AttributeType -> Bool
< :: AttributeType -> AttributeType -> Bool
$c< :: AttributeType -> AttributeType -> Bool
compare :: AttributeType -> AttributeType -> Ordering
$ccompare :: AttributeType -> AttributeType -> Ordering
$cp1Ord :: Eq AttributeType
Ord, Int -> AttributeType -> ShowS
[AttributeType] -> ShowS
AttributeType -> String
(Int -> AttributeType -> ShowS)
-> (AttributeType -> String)
-> ([AttributeType] -> ShowS)
-> Show AttributeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeType] -> ShowS
$cshowList :: [AttributeType] -> ShowS
show :: AttributeType -> String
$cshow :: AttributeType -> String
showsPrec :: Int -> AttributeType -> ShowS
$cshowsPrec :: Int -> AttributeType -> ShowS
Show, Value -> Parser [AttributeType]
Value -> Parser AttributeType
(Value -> Parser AttributeType)
-> (Value -> Parser [AttributeType]) -> FromJSON AttributeType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AttributeType]
$cparseJSONList :: Value -> Parser [AttributeType]
parseJSON :: Value -> Parser AttributeType
$cparseJSON :: Value -> Parser AttributeType
FromJSON, [AttributeType] -> Encoding
[AttributeType] -> Value
AttributeType -> Encoding
AttributeType -> Value
(AttributeType -> Value)
-> (AttributeType -> Encoding)
-> ([AttributeType] -> Value)
-> ([AttributeType] -> Encoding)
-> ToJSON AttributeType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AttributeType] -> Encoding
$ctoEncodingList :: [AttributeType] -> Encoding
toJSONList :: [AttributeType] -> Value
$ctoJSONList :: [AttributeType] -> Value
toEncoding :: AttributeType -> Encoding
$ctoEncoding :: AttributeType -> Encoding
toJSON :: AttributeType -> Value
$ctoJSON :: AttributeType -> Value
ToJSON, (forall x. AttributeType -> Rep AttributeType x)
-> (forall x. Rep AttributeType x -> AttributeType)
-> Generic AttributeType
forall x. Rep AttributeType x -> AttributeType
forall x. AttributeType -> Rep AttributeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeType x -> AttributeType
$cfrom :: forall x. AttributeType -> Rep AttributeType x
Generic)

pattern SCALAR :: AttributeType
pattern $bSCALAR :: AttributeType
$mSCALAR :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
SCALAR = AttributeType "SCALAR"

pattern VEC2 :: AttributeType
pattern $bVEC2 :: AttributeType
$mVEC2 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
VEC2 = AttributeType "VEC2"

pattern VEC3 :: AttributeType
pattern $bVEC3 :: AttributeType
$mVEC3 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
VEC3 = AttributeType "VEC3"

pattern VEC4 :: AttributeType
pattern $bVEC4 :: AttributeType
$mVEC4 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
VEC4 = AttributeType "VEC4"

pattern MAT2 :: AttributeType
pattern $bMAT2 :: AttributeType
$mMAT2 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
MAT2 = AttributeType "MAT2"

pattern MAT3 :: AttributeType
pattern $bMAT3 :: AttributeType
$mMAT3 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
MAT3 = AttributeType "MAT3"

pattern MAT4 :: AttributeType
pattern $bMAT4 :: AttributeType
$mMAT4 :: forall r. AttributeType -> (Void# -> r) -> (Void# -> r) -> r
MAT4 = AttributeType "MAT4"

-- | Sparse storage of attributes that deviate from their initialization value.
data AccessorSparse = AccessorSparse
  { AccessorSparse -> Int
count   :: Size
  , AccessorSparse -> AccessorSparseIndices
indices :: AccessorSparseIndices
  , AccessorSparse -> AccessorSparseValues
values  :: AccessorSparseValues
  } deriving (AccessorSparse -> AccessorSparse -> Bool
(AccessorSparse -> AccessorSparse -> Bool)
-> (AccessorSparse -> AccessorSparse -> Bool) -> Eq AccessorSparse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessorSparse -> AccessorSparse -> Bool
$c/= :: AccessorSparse -> AccessorSparse -> Bool
== :: AccessorSparse -> AccessorSparse -> Bool
$c== :: AccessorSparse -> AccessorSparse -> Bool
Eq, Int -> AccessorSparse -> ShowS
[AccessorSparse] -> ShowS
AccessorSparse -> String
(Int -> AccessorSparse -> ShowS)
-> (AccessorSparse -> String)
-> ([AccessorSparse] -> ShowS)
-> Show AccessorSparse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessorSparse] -> ShowS
$cshowList :: [AccessorSparse] -> ShowS
show :: AccessorSparse -> String
$cshow :: AccessorSparse -> String
showsPrec :: Int -> AccessorSparse -> ShowS
$cshowsPrec :: Int -> AccessorSparse -> ShowS
Show, (forall x. AccessorSparse -> Rep AccessorSparse x)
-> (forall x. Rep AccessorSparse x -> AccessorSparse)
-> Generic AccessorSparse
forall x. Rep AccessorSparse x -> AccessorSparse
forall x. AccessorSparse -> Rep AccessorSparse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessorSparse x -> AccessorSparse
$cfrom :: forall x. AccessorSparse -> Rep AccessorSparse x
Generic)

instance FromJSON AccessorSparse
instance ToJSON AccessorSparse

-- | Indices of those attributes that deviate from their initialization value.
data AccessorSparseIndices = AccessorSparseIndices
  { AccessorSparseIndices -> Maybe BufferViewIx
bufferView    :: Maybe BufferViewIx
  , AccessorSparseIndices -> Int
byteOffset    :: Size
  , AccessorSparseIndices -> ComponentType
componentType :: ComponentType
  } deriving (AccessorSparseIndices -> AccessorSparseIndices -> Bool
(AccessorSparseIndices -> AccessorSparseIndices -> Bool)
-> (AccessorSparseIndices -> AccessorSparseIndices -> Bool)
-> Eq AccessorSparseIndices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessorSparseIndices -> AccessorSparseIndices -> Bool
$c/= :: AccessorSparseIndices -> AccessorSparseIndices -> Bool
== :: AccessorSparseIndices -> AccessorSparseIndices -> Bool
$c== :: AccessorSparseIndices -> AccessorSparseIndices -> Bool
Eq, Int -> AccessorSparseIndices -> ShowS
[AccessorSparseIndices] -> ShowS
AccessorSparseIndices -> String
(Int -> AccessorSparseIndices -> ShowS)
-> (AccessorSparseIndices -> String)
-> ([AccessorSparseIndices] -> ShowS)
-> Show AccessorSparseIndices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessorSparseIndices] -> ShowS
$cshowList :: [AccessorSparseIndices] -> ShowS
show :: AccessorSparseIndices -> String
$cshow :: AccessorSparseIndices -> String
showsPrec :: Int -> AccessorSparseIndices -> ShowS
$cshowsPrec :: Int -> AccessorSparseIndices -> ShowS
Show, (forall x. AccessorSparseIndices -> Rep AccessorSparseIndices x)
-> (forall x. Rep AccessorSparseIndices x -> AccessorSparseIndices)
-> Generic AccessorSparseIndices
forall x. Rep AccessorSparseIndices x -> AccessorSparseIndices
forall x. AccessorSparseIndices -> Rep AccessorSparseIndices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessorSparseIndices x -> AccessorSparseIndices
$cfrom :: forall x. AccessorSparseIndices -> Rep AccessorSparseIndices x
Generic)

instance FromJSON AccessorSparseIndices
instance ToJSON AccessorSparseIndices

-- | Array of size @accessor.sparse.count@ times number of components storing
-- the displaced accessor attributes pointed by @accessor.sparse.indices@.
data AccessorSparseValues = AccessorSparseValues
  { AccessorSparseValues -> Maybe BufferViewIx
bufferView :: Maybe BufferViewIx
  , AccessorSparseValues -> Int
byteOffset :: Size
  } deriving (AccessorSparseValues -> AccessorSparseValues -> Bool
(AccessorSparseValues -> AccessorSparseValues -> Bool)
-> (AccessorSparseValues -> AccessorSparseValues -> Bool)
-> Eq AccessorSparseValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessorSparseValues -> AccessorSparseValues -> Bool
$c/= :: AccessorSparseValues -> AccessorSparseValues -> Bool
== :: AccessorSparseValues -> AccessorSparseValues -> Bool
$c== :: AccessorSparseValues -> AccessorSparseValues -> Bool
Eq, Int -> AccessorSparseValues -> ShowS
[AccessorSparseValues] -> ShowS
AccessorSparseValues -> String
(Int -> AccessorSparseValues -> ShowS)
-> (AccessorSparseValues -> String)
-> ([AccessorSparseValues] -> ShowS)
-> Show AccessorSparseValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessorSparseValues] -> ShowS
$cshowList :: [AccessorSparseValues] -> ShowS
show :: AccessorSparseValues -> String
$cshow :: AccessorSparseValues -> String
showsPrec :: Int -> AccessorSparseValues -> ShowS
$cshowsPrec :: Int -> AccessorSparseValues -> ShowS
Show, (forall x. AccessorSparseValues -> Rep AccessorSparseValues x)
-> (forall x. Rep AccessorSparseValues x -> AccessorSparseValues)
-> Generic AccessorSparseValues
forall x. Rep AccessorSparseValues x -> AccessorSparseValues
forall x. AccessorSparseValues -> Rep AccessorSparseValues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessorSparseValues x -> AccessorSparseValues
$cfrom :: forall x. AccessorSparseValues -> Rep AccessorSparseValues x
Generic)

instance FromJSON AccessorSparseValues
instance ToJSON AccessorSparseValues