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

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

import Codec.GlTF.Prelude

newtype CameraIx = CameraIx { unCameraIx :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, 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
  { type'        :: CameraType
  , perspective  :: Maybe CameraPerspective
  , orthographic :: Maybe CameraOrthographic
  , name         :: Maybe Text
  , extensions   :: Maybe Object
  , extras       :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON Camera where
  parseJSON = gParseJSON

instance ToJSON Camera where
  toJSON = gToJSON

newtype CameraType = CameraType { unCameraType :: Text }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern PERSPECTIVE :: CameraType
pattern PERSPECTIVE = CameraType "perspective"

pattern ORTHOGRAPHIC :: CameraType
pattern ORTHOGRAPHIC = CameraType "orthographic"

-- | A perspective camera containing properties to create a perspective projection matrix.
data CameraPerspective = CameraPerspective
  { yfov        :: Float
  , znear       :: Float
  , aspectRatio :: Maybe Float
  , zfar        :: Maybe Float
  , extensions  :: Maybe Object
  , extras      :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON CameraPerspective
instance ToJSON CameraPerspective

-- | An orthographic camera containing properties to create an orthographic projection matrix.
data CameraOrthographic = CameraOrthographic
  { xmag         :: Float
  , ymag         :: Float
  , zfar         :: Float
  , znear        :: Float
  , extensions   :: Maybe Object
  , extras       :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON CameraOrthographic
instance ToJSON CameraOrthographic