module Codec.GlTF.Mesh
  ( MeshIx(..)
  , Mesh(..)

  , MeshPrimitive(..)
  , MeshPrimitiveMode(..)
  , pattern POINTS
  , pattern LINES
  , pattern LINE_LOOP
  , pattern LINE_STRIP
  , pattern TRIANGLES
  , pattern TRIANGLE_STRIP
  , pattern TRIANGLE_FAN
 ) where

import Codec.GlTF.Prelude

import Codec.GlTF.Accessor (AccessorIx)
import Codec.GlTF.Material (MaterialIx)

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

-- | A set of primitives to be rendered.
--
-- A node can contain one mesh. A node's transform places the mesh in the scene.
data Mesh = Mesh
  { primitives :: Vector MeshPrimitive
  , weights    :: Maybe (Vector Float)
  , name       :: Maybe Text
  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON Mesh where
  parseJSON = withObject "Mesh" \o -> do
    primitives <- o .:  "primitives"
    weights    <- o .:? "weights"
    name       <- o .:? "name"
    extensions <- o .:? "extensions"
    extras     <- o .:? "extras"
    pure Mesh{..}

instance ToJSON Mesh

-- | Geometry to be rendered with the given material.
data MeshPrimitive = MeshPrimitive
  { attributes   :: HashMap Text AccessorIx
  , mode         :: MeshPrimitiveMode
  , indices      :: Maybe AccessorIx
  , material     :: Maybe MaterialIx
  , targets      :: Maybe (Vector (HashMap Text AccessorIx))
  , extensions   :: Maybe Object
  , extras       :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON MeshPrimitive where
  parseJSON = withObject "MeshPrimitive" \o -> do
    attributes <- o .:  "attributes"
    mode       <- o .:? "mode" .!= TRIANGLES
    indices    <- o .:? "indices"
    material   <- o .:? "material"
    targets    <- o .:? "targets"
    extensions <- o .:? "extensions"
    extras     <- o .:? "extras"
    pure MeshPrimitive{..}

instance ToJSON MeshPrimitive

-- | The type of primitives to render.
newtype MeshPrimitiveMode = MeshPrimitiveMode { unMeshPrimitiveMode :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern POINTS :: MeshPrimitiveMode
pattern POINTS = MeshPrimitiveMode 0

pattern LINES :: MeshPrimitiveMode
pattern LINES = MeshPrimitiveMode 1

pattern LINE_LOOP :: MeshPrimitiveMode
pattern LINE_LOOP = MeshPrimitiveMode 2

pattern LINE_STRIP :: MeshPrimitiveMode
pattern LINE_STRIP = MeshPrimitiveMode 3

pattern TRIANGLES :: MeshPrimitiveMode
pattern TRIANGLES = MeshPrimitiveMode 4

pattern TRIANGLE_STRIP :: MeshPrimitiveMode
pattern TRIANGLE_STRIP = MeshPrimitiveMode 5

pattern TRIANGLE_FAN :: MeshPrimitiveMode
pattern TRIANGLE_FAN = MeshPrimitiveMode 6