module Codec.GlTF.Texture
  ( TextureIx(..)
  , Texture(..)
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.Image (ImageIx)
import Codec.GlTF.Sampler (SamplerIx)

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

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

instance FromJSON Texture
instance ToJSON Texture