module Codec.GlTF.Camera
  ( CameraIx(..)
  , Camera(..)
  , CameraType(..)
  , pattern PERSPECTIVE
  , pattern ORTHOGRAPHIC

  , CameraPerspective(..)
  , CameraOrthographic(..)
  ) where

import Codec.GlTF.Prelude

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

-- | A camera's projection.
--
-- A node can reference a camera to apply a transform to place the camera in the scene.
data Camera = Camera
  { Camera -> CameraType
type'        :: CameraType
  , Camera -> Maybe CameraPerspective
perspective  :: Maybe CameraPerspective
  , Camera -> Maybe CameraOrthographic
orthographic :: Maybe CameraOrthographic
  , Camera -> Maybe Text
name         :: Maybe Text
  , Camera -> Maybe Object
extensions   :: Maybe Object
  , Camera -> Maybe Value
extras       :: Maybe Value
  } deriving (Camera -> Camera -> Bool
(Camera -> Camera -> Bool)
-> (Camera -> Camera -> Bool) -> Eq Camera
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Camera -> Camera -> Bool
$c/= :: Camera -> Camera -> Bool
== :: Camera -> Camera -> Bool
$c== :: Camera -> Camera -> Bool
Eq, Int -> Camera -> ShowS
[Camera] -> ShowS
Camera -> String
(Int -> Camera -> ShowS)
-> (Camera -> String) -> ([Camera] -> ShowS) -> Show Camera
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camera] -> ShowS
$cshowList :: [Camera] -> ShowS
show :: Camera -> String
$cshow :: Camera -> String
showsPrec :: Int -> Camera -> ShowS
$cshowsPrec :: Int -> Camera -> ShowS
Show, (forall x. Camera -> Rep Camera x)
-> (forall x. Rep Camera x -> Camera) -> Generic Camera
forall x. Rep Camera x -> Camera
forall x. Camera -> Rep Camera x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Camera x -> Camera
$cfrom :: forall x. Camera -> Rep Camera x
Generic)

instance FromJSON Camera where
  parseJSON :: Value -> Parser Camera
parseJSON = Value -> Parser Camera
forall a. (Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a
gParseJSON

instance ToJSON Camera where
  toJSON :: Camera -> Value
toJSON = Camera -> Value
forall a. (Generic a, GToJSON' Value Zero (Rep a)) => a -> Value
gToJSON

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

pattern PERSPECTIVE :: CameraType
pattern $bPERSPECTIVE :: CameraType
$mPERSPECTIVE :: forall r. CameraType -> (Void# -> r) -> (Void# -> r) -> r
PERSPECTIVE = CameraType "perspective"

pattern ORTHOGRAPHIC :: CameraType
pattern $bORTHOGRAPHIC :: CameraType
$mORTHOGRAPHIC :: forall r. CameraType -> (Void# -> r) -> (Void# -> r) -> r
ORTHOGRAPHIC = CameraType "orthographic"

-- | A perspective camera containing properties to create a perspective projection matrix.
data CameraPerspective = CameraPerspective
  { CameraPerspective -> Float
yfov        :: Float
  , CameraPerspective -> Float
znear       :: Float
  , CameraPerspective -> Maybe Float
aspectRatio :: Maybe Float
  , CameraPerspective -> Maybe Float
zfar        :: Maybe Float
  , CameraPerspective -> Maybe Object
extensions  :: Maybe Object
  , CameraPerspective -> Maybe Value
extras      :: Maybe Value
  } deriving (CameraPerspective -> CameraPerspective -> Bool
(CameraPerspective -> CameraPerspective -> Bool)
-> (CameraPerspective -> CameraPerspective -> Bool)
-> Eq CameraPerspective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CameraPerspective -> CameraPerspective -> Bool
$c/= :: CameraPerspective -> CameraPerspective -> Bool
== :: CameraPerspective -> CameraPerspective -> Bool
$c== :: CameraPerspective -> CameraPerspective -> Bool
Eq, Int -> CameraPerspective -> ShowS
[CameraPerspective] -> ShowS
CameraPerspective -> String
(Int -> CameraPerspective -> ShowS)
-> (CameraPerspective -> String)
-> ([CameraPerspective] -> ShowS)
-> Show CameraPerspective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CameraPerspective] -> ShowS
$cshowList :: [CameraPerspective] -> ShowS
show :: CameraPerspective -> String
$cshow :: CameraPerspective -> String
showsPrec :: Int -> CameraPerspective -> ShowS
$cshowsPrec :: Int -> CameraPerspective -> ShowS
Show, (forall x. CameraPerspective -> Rep CameraPerspective x)
-> (forall x. Rep CameraPerspective x -> CameraPerspective)
-> Generic CameraPerspective
forall x. Rep CameraPerspective x -> CameraPerspective
forall x. CameraPerspective -> Rep CameraPerspective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CameraPerspective x -> CameraPerspective
$cfrom :: forall x. CameraPerspective -> Rep CameraPerspective x
Generic)

instance FromJSON CameraPerspective
instance ToJSON CameraPerspective

-- | An orthographic camera containing properties to create an orthographic projection matrix.
data CameraOrthographic = CameraOrthographic
  { CameraOrthographic -> Float
xmag         :: Float
  , CameraOrthographic -> Float
ymag         :: Float
  , CameraOrthographic -> Float
zfar         :: Float
  , CameraOrthographic -> Float
znear        :: Float
  , CameraOrthographic -> Maybe Object
extensions   :: Maybe Object
  , CameraOrthographic -> Maybe Value
extras       :: Maybe Value
  } deriving (CameraOrthographic -> CameraOrthographic -> Bool
(CameraOrthographic -> CameraOrthographic -> Bool)
-> (CameraOrthographic -> CameraOrthographic -> Bool)
-> Eq CameraOrthographic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CameraOrthographic -> CameraOrthographic -> Bool
$c/= :: CameraOrthographic -> CameraOrthographic -> Bool
== :: CameraOrthographic -> CameraOrthographic -> Bool
$c== :: CameraOrthographic -> CameraOrthographic -> Bool
Eq, Int -> CameraOrthographic -> ShowS
[CameraOrthographic] -> ShowS
CameraOrthographic -> String
(Int -> CameraOrthographic -> ShowS)
-> (CameraOrthographic -> String)
-> ([CameraOrthographic] -> ShowS)
-> Show CameraOrthographic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CameraOrthographic] -> ShowS
$cshowList :: [CameraOrthographic] -> ShowS
show :: CameraOrthographic -> String
$cshow :: CameraOrthographic -> String
showsPrec :: Int -> CameraOrthographic -> ShowS
$cshowsPrec :: Int -> CameraOrthographic -> ShowS
Show, (forall x. CameraOrthographic -> Rep CameraOrthographic x)
-> (forall x. Rep CameraOrthographic x -> CameraOrthographic)
-> Generic CameraOrthographic
forall x. Rep CameraOrthographic x -> CameraOrthographic
forall x. CameraOrthographic -> Rep CameraOrthographic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CameraOrthographic x -> CameraOrthographic
$cfrom :: forall x. CameraOrthographic -> Rep CameraOrthographic x
Generic)

instance FromJSON CameraOrthographic
instance ToJSON CameraOrthographic