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 { unAccessorIx :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

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

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

  , name       :: Maybe Text
  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON Accessor where
  parseJSON = withObject "Accessor" \o -> do
    bufferView    <- o .:? "bufferView"
    byteOffset    <- o .:? "byteOffset" .!= 0
    componentType <- o .:  "componentType"
    normalized    <- o .:? "normalized" .!= False
    count         <- o .:  "count"
    type'         <- o .:  "type"
    min           <- o .:? "min"
    max           <- o .:? "max"
    sparse        <- o .:? "sparse"
    name          <- o .:? "name"
    extensions    <- o .:? "extensions"
    extras        <- o .:? "extras"
    pure Accessor{..}

instance ToJSON Accessor where
  toJSON = gToJSON

newtype ComponentType = ComponentType { unComponentType :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern BYTE :: ComponentType
pattern BYTE = ComponentType 5120

pattern UNSIGNED_BYTE :: ComponentType
pattern UNSIGNED_BYTE = ComponentType 5121

pattern SHORT :: ComponentType
pattern SHORT = ComponentType 5122

pattern UNSIGNED_SHORT :: ComponentType
pattern UNSIGNED_SHORT = ComponentType 5123

pattern UNSIGNED_INT :: ComponentType
pattern UNSIGNED_INT = ComponentType 5125

pattern FLOAT :: ComponentType
pattern FLOAT = ComponentType 5126

newtype AttributeType = AttributeType { unAttributeType :: Text }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern SCALAR :: AttributeType
pattern SCALAR = AttributeType "SCALAR"

pattern VEC2 :: AttributeType
pattern VEC2 = AttributeType "VEC2"

pattern VEC3 :: AttributeType
pattern VEC3 = AttributeType "VEC3"

pattern VEC4 :: AttributeType
pattern VEC4 = AttributeType "VEC4"

pattern MAT2 :: AttributeType
pattern MAT2 = AttributeType "MAT2"

pattern MAT3 :: AttributeType
pattern MAT3 = AttributeType "MAT3"

pattern MAT4 :: AttributeType
pattern MAT4 = AttributeType "MAT4"

-- | Sparse storage of attributes that deviate from their initialization value.
data AccessorSparse = AccessorSparse
  { count   :: Size
  , indices :: AccessorSparseIndices
  , values  :: AccessorSparseValues
  } deriving (Eq, Show, Generic)

instance FromJSON AccessorSparse
instance ToJSON AccessorSparse

-- | Indices of those attributes that deviate from their initialization value.
data AccessorSparseIndices = AccessorSparseIndices
  { bufferView    :: Maybe BufferViewIx
  , byteOffset    :: Size
  , componentType :: ComponentType
  } deriving (Eq, Show, 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
  { bufferView :: Maybe BufferViewIx
  , byteOffset :: Size
  } deriving (Eq, Show, Generic)

instance FromJSON AccessorSparseValues
instance ToJSON AccessorSparseValues