module Codec.GlTF.Image
  ( ImageIx(..)
  , Image(..)
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.BufferView (BufferViewIx)
import Codec.GlTF.URI (URI)

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

-- | Image data used to create a texture.
--
-- Image can be referenced by URI or bufferView index.
-- @mimeType@ is required in the latter case.
data Image = Image
  { Image -> Maybe URI
uri        :: Maybe URI
  , Image -> Maybe Text
mimeType   :: Maybe Text
  , Image -> Maybe BufferViewIx
bufferView :: Maybe BufferViewIx
  , Image -> Maybe Text
name       :: Maybe Text
  , Image -> Maybe Object
extensions :: Maybe Object
  , Image -> Maybe Value
extras     :: Maybe Value
  } deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, (forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic)

instance FromJSON Image
instance ToJSON Image