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 { MeshIx -> Int
unMeshIx :: Int }
  deriving (MeshIx -> MeshIx -> Bool
(MeshIx -> MeshIx -> Bool)
-> (MeshIx -> MeshIx -> Bool) -> Eq MeshIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeshIx -> MeshIx -> Bool
== :: MeshIx -> MeshIx -> Bool
$c/= :: MeshIx -> MeshIx -> Bool
/= :: MeshIx -> MeshIx -> Bool
Eq, Eq MeshIx
Eq MeshIx =>
(MeshIx -> MeshIx -> Ordering)
-> (MeshIx -> MeshIx -> Bool)
-> (MeshIx -> MeshIx -> Bool)
-> (MeshIx -> MeshIx -> Bool)
-> (MeshIx -> MeshIx -> Bool)
-> (MeshIx -> MeshIx -> MeshIx)
-> (MeshIx -> MeshIx -> MeshIx)
-> Ord MeshIx
MeshIx -> MeshIx -> Bool
MeshIx -> MeshIx -> Ordering
MeshIx -> MeshIx -> MeshIx
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
$ccompare :: MeshIx -> MeshIx -> Ordering
compare :: MeshIx -> MeshIx -> Ordering
$c< :: MeshIx -> MeshIx -> Bool
< :: MeshIx -> MeshIx -> Bool
$c<= :: MeshIx -> MeshIx -> Bool
<= :: MeshIx -> MeshIx -> Bool
$c> :: MeshIx -> MeshIx -> Bool
> :: MeshIx -> MeshIx -> Bool
$c>= :: MeshIx -> MeshIx -> Bool
>= :: MeshIx -> MeshIx -> Bool
$cmax :: MeshIx -> MeshIx -> MeshIx
max :: MeshIx -> MeshIx -> MeshIx
$cmin :: MeshIx -> MeshIx -> MeshIx
min :: MeshIx -> MeshIx -> MeshIx
Ord, Int -> MeshIx -> ShowS
[MeshIx] -> ShowS
MeshIx -> String
(Int -> MeshIx -> ShowS)
-> (MeshIx -> String) -> ([MeshIx] -> ShowS) -> Show MeshIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeshIx -> ShowS
showsPrec :: Int -> MeshIx -> ShowS
$cshow :: MeshIx -> String
show :: MeshIx -> String
$cshowList :: [MeshIx] -> ShowS
showList :: [MeshIx] -> ShowS
Show, Value -> Parser [MeshIx]
Value -> Parser MeshIx
(Value -> Parser MeshIx)
-> (Value -> Parser [MeshIx]) -> FromJSON MeshIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MeshIx
parseJSON :: Value -> Parser MeshIx
$cparseJSONList :: Value -> Parser [MeshIx]
parseJSONList :: Value -> Parser [MeshIx]
FromJSON, [MeshIx] -> Value
[MeshIx] -> Encoding
MeshIx -> Value
MeshIx -> Encoding
(MeshIx -> Value)
-> (MeshIx -> Encoding)
-> ([MeshIx] -> Value)
-> ([MeshIx] -> Encoding)
-> ToJSON MeshIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MeshIx -> Value
toJSON :: MeshIx -> Value
$ctoEncoding :: MeshIx -> Encoding
toEncoding :: MeshIx -> Encoding
$ctoJSONList :: [MeshIx] -> Value
toJSONList :: [MeshIx] -> Value
$ctoEncodingList :: [MeshIx] -> Encoding
toEncodingList :: [MeshIx] -> Encoding
ToJSON, (forall x. MeshIx -> Rep MeshIx x)
-> (forall x. Rep MeshIx x -> MeshIx) -> Generic MeshIx
forall x. Rep MeshIx x -> MeshIx
forall x. MeshIx -> Rep MeshIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MeshIx -> Rep MeshIx x
from :: forall x. MeshIx -> Rep MeshIx x
$cto :: forall x. Rep MeshIx x -> MeshIx
to :: forall x. Rep MeshIx x -> MeshIx
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
  { Mesh -> Vector MeshPrimitive
primitives :: Vector MeshPrimitive
  , Mesh -> Maybe (Vector Float)
weights    :: Maybe (Vector Float)
  , Mesh -> Maybe Text
name       :: Maybe Text
  , Mesh -> Maybe Object
extensions :: Maybe Object
  , Mesh -> Maybe Value
extras     :: Maybe Value
  } deriving (Mesh -> Mesh -> Bool
(Mesh -> Mesh -> Bool) -> (Mesh -> Mesh -> Bool) -> Eq Mesh
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mesh -> Mesh -> Bool
== :: Mesh -> Mesh -> Bool
$c/= :: Mesh -> Mesh -> Bool
/= :: Mesh -> Mesh -> Bool
Eq, Int -> Mesh -> ShowS
[Mesh] -> ShowS
Mesh -> String
(Int -> Mesh -> ShowS)
-> (Mesh -> String) -> ([Mesh] -> ShowS) -> Show Mesh
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mesh -> ShowS
showsPrec :: Int -> Mesh -> ShowS
$cshow :: Mesh -> String
show :: Mesh -> String
$cshowList :: [Mesh] -> ShowS
showList :: [Mesh] -> ShowS
Show, (forall x. Mesh -> Rep Mesh x)
-> (forall x. Rep Mesh x -> Mesh) -> Generic Mesh
forall x. Rep Mesh x -> Mesh
forall x. Mesh -> Rep Mesh x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mesh -> Rep Mesh x
from :: forall x. Mesh -> Rep Mesh x
$cto :: forall x. Rep Mesh x -> Mesh
to :: forall x. Rep Mesh x -> Mesh
Generic)

instance FromJSON Mesh where
  parseJSON :: Value -> Parser Mesh
parseJSON = String -> (Object -> Parser Mesh) -> Value -> Parser Mesh
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Mesh" \Object
o -> do
    Vector MeshPrimitive
primitives <- Object
o Object -> Key -> Parser (Vector MeshPrimitive)
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"primitives"
    Maybe (Vector Float)
weights    <- Object
o Object -> Key -> Parser (Maybe (Vector Float))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"weights"
    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 Mesh{Maybe Object
Maybe Value
Maybe Text
Maybe (Vector Float)
Vector MeshPrimitive
$sel:primitives:Mesh :: Vector MeshPrimitive
$sel:weights:Mesh :: Maybe (Vector Float)
$sel:name:Mesh :: Maybe Text
$sel:extensions:Mesh :: Maybe Object
$sel:extras:Mesh :: Maybe Value
primitives :: Vector MeshPrimitive
weights :: Maybe (Vector Float)
name :: Maybe Text
extensions :: Maybe Object
extras :: Maybe Value
..}

instance ToJSON Mesh

-- | Geometry to be rendered with the given material.
data MeshPrimitive = MeshPrimitive
  { MeshPrimitive -> HashMap Text AccessorIx
attributes   :: HashMap Text AccessorIx
  , MeshPrimitive -> MeshPrimitiveMode
mode         :: MeshPrimitiveMode
  , MeshPrimitive -> Maybe AccessorIx
indices      :: Maybe AccessorIx
  , MeshPrimitive -> Maybe MaterialIx
material     :: Maybe MaterialIx
  , MeshPrimitive -> Maybe (Vector (HashMap Text AccessorIx))
targets      :: Maybe (Vector (HashMap Text AccessorIx))
  , MeshPrimitive -> Maybe Object
extensions   :: Maybe Object
  , MeshPrimitive -> Maybe Value
extras       :: Maybe Value
  } deriving (MeshPrimitive -> MeshPrimitive -> Bool
(MeshPrimitive -> MeshPrimitive -> Bool)
-> (MeshPrimitive -> MeshPrimitive -> Bool) -> Eq MeshPrimitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeshPrimitive -> MeshPrimitive -> Bool
== :: MeshPrimitive -> MeshPrimitive -> Bool
$c/= :: MeshPrimitive -> MeshPrimitive -> Bool
/= :: MeshPrimitive -> MeshPrimitive -> Bool
Eq, Int -> MeshPrimitive -> ShowS
[MeshPrimitive] -> ShowS
MeshPrimitive -> String
(Int -> MeshPrimitive -> ShowS)
-> (MeshPrimitive -> String)
-> ([MeshPrimitive] -> ShowS)
-> Show MeshPrimitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeshPrimitive -> ShowS
showsPrec :: Int -> MeshPrimitive -> ShowS
$cshow :: MeshPrimitive -> String
show :: MeshPrimitive -> String
$cshowList :: [MeshPrimitive] -> ShowS
showList :: [MeshPrimitive] -> ShowS
Show, (forall x. MeshPrimitive -> Rep MeshPrimitive x)
-> (forall x. Rep MeshPrimitive x -> MeshPrimitive)
-> Generic MeshPrimitive
forall x. Rep MeshPrimitive x -> MeshPrimitive
forall x. MeshPrimitive -> Rep MeshPrimitive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MeshPrimitive -> Rep MeshPrimitive x
from :: forall x. MeshPrimitive -> Rep MeshPrimitive x
$cto :: forall x. Rep MeshPrimitive x -> MeshPrimitive
to :: forall x. Rep MeshPrimitive x -> MeshPrimitive
Generic)

instance FromJSON MeshPrimitive where
  parseJSON :: Value -> Parser MeshPrimitive
parseJSON = String
-> (Object -> Parser MeshPrimitive)
-> Value
-> Parser MeshPrimitive
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MeshPrimitive" \Object
o -> do
    HashMap Text AccessorIx
attributes <- Object
o Object -> Key -> Parser (HashMap Text AccessorIx)
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"attributes"
    MeshPrimitiveMode
mode       <- Object
o Object -> Key -> Parser (Maybe MeshPrimitiveMode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mode" Parser (Maybe MeshPrimitiveMode)
-> MeshPrimitiveMode -> Parser MeshPrimitiveMode
forall a. Parser (Maybe a) -> a -> Parser a
.!= MeshPrimitiveMode
TRIANGLES
    Maybe AccessorIx
indices    <- Object
o Object -> Key -> Parser (Maybe AccessorIx)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"indices"
    Maybe MaterialIx
material   <- Object
o Object -> Key -> Parser (Maybe MaterialIx)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"material"
    Maybe (Vector (HashMap Text AccessorIx))
targets    <- Object
o Object -> Key -> Parser (Maybe (Vector (HashMap Text AccessorIx)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"targets"
    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 MeshPrimitive{Maybe Object
Maybe Value
Maybe (Vector (HashMap Text AccessorIx))
Maybe MaterialIx
Maybe AccessorIx
HashMap Text AccessorIx
MeshPrimitiveMode
$sel:attributes:MeshPrimitive :: HashMap Text AccessorIx
$sel:mode:MeshPrimitive :: MeshPrimitiveMode
$sel:indices:MeshPrimitive :: Maybe AccessorIx
$sel:material:MeshPrimitive :: Maybe MaterialIx
$sel:targets:MeshPrimitive :: Maybe (Vector (HashMap Text AccessorIx))
$sel:extensions:MeshPrimitive :: Maybe Object
$sel:extras:MeshPrimitive :: Maybe Value
attributes :: HashMap Text AccessorIx
mode :: MeshPrimitiveMode
indices :: Maybe AccessorIx
material :: Maybe MaterialIx
targets :: Maybe (Vector (HashMap Text AccessorIx))
extensions :: Maybe Object
extras :: Maybe Value
..}

instance ToJSON MeshPrimitive

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

pattern POINTS :: MeshPrimitiveMode
pattern $mPOINTS :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bPOINTS :: MeshPrimitiveMode
POINTS = MeshPrimitiveMode 0

pattern LINES :: MeshPrimitiveMode
pattern $mLINES :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bLINES :: MeshPrimitiveMode
LINES = MeshPrimitiveMode 1

pattern LINE_LOOP :: MeshPrimitiveMode
pattern $mLINE_LOOP :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bLINE_LOOP :: MeshPrimitiveMode
LINE_LOOP = MeshPrimitiveMode 2

pattern LINE_STRIP :: MeshPrimitiveMode
pattern $mLINE_STRIP :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bLINE_STRIP :: MeshPrimitiveMode
LINE_STRIP = MeshPrimitiveMode 3

pattern TRIANGLES :: MeshPrimitiveMode
pattern $mTRIANGLES :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRIANGLES :: MeshPrimitiveMode
TRIANGLES = MeshPrimitiveMode 4

pattern TRIANGLE_STRIP :: MeshPrimitiveMode
pattern $mTRIANGLE_STRIP :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRIANGLE_STRIP :: MeshPrimitiveMode
TRIANGLE_STRIP = MeshPrimitiveMode 5

pattern TRIANGLE_FAN :: MeshPrimitiveMode
pattern $mTRIANGLE_FAN :: forall {r}. MeshPrimitiveMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRIANGLE_FAN :: MeshPrimitiveMode
TRIANGLE_FAN = MeshPrimitiveMode 6