{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.MediaLive.Types.BurnInDestinationSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.MediaLive.Types.BurnInDestinationSettings where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaLive.Types.BurnInAlignment
import Amazonka.MediaLive.Types.BurnInBackgroundColor
import Amazonka.MediaLive.Types.BurnInFontColor
import Amazonka.MediaLive.Types.BurnInOutlineColor
import Amazonka.MediaLive.Types.BurnInShadowColor
import Amazonka.MediaLive.Types.BurnInTeletextGridControl
import Amazonka.MediaLive.Types.InputLocation
import qualified Amazonka.Prelude as Prelude

-- | Burn In Destination Settings
--
-- /See:/ 'newBurnInDestinationSettings' smart constructor.
data BurnInDestinationSettings = BurnInDestinationSettings'
  { -- | If no explicit xPosition or yPosition is provided, setting alignment to
    -- centered will place the captions at the bottom center of the output.
    -- Similarly, setting a left alignment will align captions to the bottom
    -- left of the output. If x and y positions are given in conjunction with
    -- the alignment parameter, the font will be justified (either left or
    -- centered) relative to those coordinates. Selecting \"smart\"
    -- justification will left-justify live subtitles and center-justify
    -- pre-recorded subtitles. All burn-in and DVB-Sub font settings must
    -- match.
    BurnInDestinationSettings -> Maybe BurnInAlignment
alignment :: Prelude.Maybe BurnInAlignment,
    -- | Specifies the color of the rectangle behind the captions. All burn-in
    -- and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe BurnInBackgroundColor
backgroundColor :: Prelude.Maybe BurnInBackgroundColor,
    -- | Specifies the opacity of the background rectangle. 255 is opaque; 0 is
    -- transparent. Leaving this parameter out is equivalent to setting it to 0
    -- (transparent). All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
backgroundOpacity :: Prelude.Maybe Prelude.Natural,
    -- | External font file used for caption burn-in. File extension must be
    -- \'ttf\' or \'tte\'. Although the user can select output fonts for many
    -- different types of input captions, embedded, STL and teletext sources
    -- use a strict grid system. Using external fonts with these caption
    -- sources could cause unexpected display of proportional fonts. All
    -- burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe InputLocation
font :: Prelude.Maybe InputLocation,
    -- | Specifies the color of the burned-in captions. This option is not valid
    -- for source captions that are STL, 608\/embedded or teletext. These
    -- source settings are already pre-defined by the caption stream. All
    -- burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe BurnInFontColor
fontColor :: Prelude.Maybe BurnInFontColor,
    -- | Specifies the opacity of the burned-in captions. 255 is opaque; 0 is
    -- transparent. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
fontOpacity :: Prelude.Maybe Prelude.Natural,
    -- | Font resolution in DPI (dots per inch); default is 96 dpi. All burn-in
    -- and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
fontResolution :: Prelude.Maybe Prelude.Natural,
    -- | When set to \'auto\' fontSize will scale depending on the size of the
    -- output. Giving a positive integer will specify the exact font size in
    -- points. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Text
fontSize :: Prelude.Maybe Prelude.Text,
    -- | Specifies font outline color. This option is not valid for source
    -- captions that are either 608\/embedded or teletext. These source
    -- settings are already pre-defined by the caption stream. All burn-in and
    -- DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe BurnInOutlineColor
outlineColor :: Prelude.Maybe BurnInOutlineColor,
    -- | Specifies font outline size in pixels. This option is not valid for
    -- source captions that are either 608\/embedded or teletext. These source
    -- settings are already pre-defined by the caption stream. All burn-in and
    -- DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
outlineSize :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the color of the shadow cast by the captions. All burn-in and
    -- DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe BurnInShadowColor
shadowColor :: Prelude.Maybe BurnInShadowColor,
    -- | Specifies the opacity of the shadow. 255 is opaque; 0 is transparent.
    -- Leaving this parameter out is equivalent to setting it to 0
    -- (transparent). All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
shadowOpacity :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the horizontal offset of the shadow relative to the captions
    -- in pixels. A value of -2 would result in a shadow offset 2 pixels to the
    -- left. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Int
shadowXOffset :: Prelude.Maybe Prelude.Int,
    -- | Specifies the vertical offset of the shadow relative to the captions in
    -- pixels. A value of -2 would result in a shadow offset 2 pixels above the
    -- text. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Int
shadowYOffset :: Prelude.Maybe Prelude.Int,
    -- | Controls whether a fixed grid size will be used to generate the output
    -- subtitles bitmap. Only applicable for Teletext inputs and
    -- DVB-Sub\/Burn-in outputs.
    BurnInDestinationSettings -> Maybe BurnInTeletextGridControl
teletextGridControl :: Prelude.Maybe BurnInTeletextGridControl,
    -- | Specifies the horizontal position of the caption relative to the left
    -- side of the output in pixels. A value of 10 would result in the captions
    -- starting 10 pixels from the left of the output. If no explicit xPosition
    -- is provided, the horizontal caption position will be determined by the
    -- alignment parameter. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
xPosition :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the vertical position of the caption relative to the top of
    -- the output in pixels. A value of 10 would result in the captions
    -- starting 10 pixels from the top of the output. If no explicit yPosition
    -- is provided, the caption will be positioned towards the bottom of the
    -- output. All burn-in and DVB-Sub font settings must match.
    BurnInDestinationSettings -> Maybe Natural
yPosition :: Prelude.Maybe Prelude.Natural
  }
  deriving (BurnInDestinationSettings -> BurnInDestinationSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BurnInDestinationSettings -> BurnInDestinationSettings -> Bool
$c/= :: BurnInDestinationSettings -> BurnInDestinationSettings -> Bool
== :: BurnInDestinationSettings -> BurnInDestinationSettings -> Bool
$c== :: BurnInDestinationSettings -> BurnInDestinationSettings -> Bool
Prelude.Eq, ReadPrec [BurnInDestinationSettings]
ReadPrec BurnInDestinationSettings
Int -> ReadS BurnInDestinationSettings
ReadS [BurnInDestinationSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BurnInDestinationSettings]
$creadListPrec :: ReadPrec [BurnInDestinationSettings]
readPrec :: ReadPrec BurnInDestinationSettings
$creadPrec :: ReadPrec BurnInDestinationSettings
readList :: ReadS [BurnInDestinationSettings]
$creadList :: ReadS [BurnInDestinationSettings]
readsPrec :: Int -> ReadS BurnInDestinationSettings
$creadsPrec :: Int -> ReadS BurnInDestinationSettings
Prelude.Read, Int -> BurnInDestinationSettings -> ShowS
[BurnInDestinationSettings] -> ShowS
BurnInDestinationSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BurnInDestinationSettings] -> ShowS
$cshowList :: [BurnInDestinationSettings] -> ShowS
show :: BurnInDestinationSettings -> String
$cshow :: BurnInDestinationSettings -> String
showsPrec :: Int -> BurnInDestinationSettings -> ShowS
$cshowsPrec :: Int -> BurnInDestinationSettings -> ShowS
Prelude.Show, forall x.
Rep BurnInDestinationSettings x -> BurnInDestinationSettings
forall x.
BurnInDestinationSettings -> Rep BurnInDestinationSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BurnInDestinationSettings x -> BurnInDestinationSettings
$cfrom :: forall x.
BurnInDestinationSettings -> Rep BurnInDestinationSettings x
Prelude.Generic)

-- |
-- Create a value of 'BurnInDestinationSettings' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'alignment', 'burnInDestinationSettings_alignment' - If no explicit xPosition or yPosition is provided, setting alignment to
-- centered will place the captions at the bottom center of the output.
-- Similarly, setting a left alignment will align captions to the bottom
-- left of the output. If x and y positions are given in conjunction with
-- the alignment parameter, the font will be justified (either left or
-- centered) relative to those coordinates. Selecting \"smart\"
-- justification will left-justify live subtitles and center-justify
-- pre-recorded subtitles. All burn-in and DVB-Sub font settings must
-- match.
--
-- 'backgroundColor', 'burnInDestinationSettings_backgroundColor' - Specifies the color of the rectangle behind the captions. All burn-in
-- and DVB-Sub font settings must match.
--
-- 'backgroundOpacity', 'burnInDestinationSettings_backgroundOpacity' - Specifies the opacity of the background rectangle. 255 is opaque; 0 is
-- transparent. Leaving this parameter out is equivalent to setting it to 0
-- (transparent). All burn-in and DVB-Sub font settings must match.
--
-- 'font', 'burnInDestinationSettings_font' - External font file used for caption burn-in. File extension must be
-- \'ttf\' or \'tte\'. Although the user can select output fonts for many
-- different types of input captions, embedded, STL and teletext sources
-- use a strict grid system. Using external fonts with these caption
-- sources could cause unexpected display of proportional fonts. All
-- burn-in and DVB-Sub font settings must match.
--
-- 'fontColor', 'burnInDestinationSettings_fontColor' - Specifies the color of the burned-in captions. This option is not valid
-- for source captions that are STL, 608\/embedded or teletext. These
-- source settings are already pre-defined by the caption stream. All
-- burn-in and DVB-Sub font settings must match.
--
-- 'fontOpacity', 'burnInDestinationSettings_fontOpacity' - Specifies the opacity of the burned-in captions. 255 is opaque; 0 is
-- transparent. All burn-in and DVB-Sub font settings must match.
--
-- 'fontResolution', 'burnInDestinationSettings_fontResolution' - Font resolution in DPI (dots per inch); default is 96 dpi. All burn-in
-- and DVB-Sub font settings must match.
--
-- 'fontSize', 'burnInDestinationSettings_fontSize' - When set to \'auto\' fontSize will scale depending on the size of the
-- output. Giving a positive integer will specify the exact font size in
-- points. All burn-in and DVB-Sub font settings must match.
--
-- 'outlineColor', 'burnInDestinationSettings_outlineColor' - Specifies font outline color. This option is not valid for source
-- captions that are either 608\/embedded or teletext. These source
-- settings are already pre-defined by the caption stream. All burn-in and
-- DVB-Sub font settings must match.
--
-- 'outlineSize', 'burnInDestinationSettings_outlineSize' - Specifies font outline size in pixels. This option is not valid for
-- source captions that are either 608\/embedded or teletext. These source
-- settings are already pre-defined by the caption stream. All burn-in and
-- DVB-Sub font settings must match.
--
-- 'shadowColor', 'burnInDestinationSettings_shadowColor' - Specifies the color of the shadow cast by the captions. All burn-in and
-- DVB-Sub font settings must match.
--
-- 'shadowOpacity', 'burnInDestinationSettings_shadowOpacity' - Specifies the opacity of the shadow. 255 is opaque; 0 is transparent.
-- Leaving this parameter out is equivalent to setting it to 0
-- (transparent). All burn-in and DVB-Sub font settings must match.
--
-- 'shadowXOffset', 'burnInDestinationSettings_shadowXOffset' - Specifies the horizontal offset of the shadow relative to the captions
-- in pixels. A value of -2 would result in a shadow offset 2 pixels to the
-- left. All burn-in and DVB-Sub font settings must match.
--
-- 'shadowYOffset', 'burnInDestinationSettings_shadowYOffset' - Specifies the vertical offset of the shadow relative to the captions in
-- pixels. A value of -2 would result in a shadow offset 2 pixels above the
-- text. All burn-in and DVB-Sub font settings must match.
--
-- 'teletextGridControl', 'burnInDestinationSettings_teletextGridControl' - Controls whether a fixed grid size will be used to generate the output
-- subtitles bitmap. Only applicable for Teletext inputs and
-- DVB-Sub\/Burn-in outputs.
--
-- 'xPosition', 'burnInDestinationSettings_xPosition' - Specifies the horizontal position of the caption relative to the left
-- side of the output in pixels. A value of 10 would result in the captions
-- starting 10 pixels from the left of the output. If no explicit xPosition
-- is provided, the horizontal caption position will be determined by the
-- alignment parameter. All burn-in and DVB-Sub font settings must match.
--
-- 'yPosition', 'burnInDestinationSettings_yPosition' - Specifies the vertical position of the caption relative to the top of
-- the output in pixels. A value of 10 would result in the captions
-- starting 10 pixels from the top of the output. If no explicit yPosition
-- is provided, the caption will be positioned towards the bottom of the
-- output. All burn-in and DVB-Sub font settings must match.
newBurnInDestinationSettings ::
  BurnInDestinationSettings
newBurnInDestinationSettings :: BurnInDestinationSettings
newBurnInDestinationSettings =
  BurnInDestinationSettings'
    { $sel:alignment:BurnInDestinationSettings' :: Maybe BurnInAlignment
alignment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backgroundColor:BurnInDestinationSettings' :: Maybe BurnInBackgroundColor
backgroundColor = forall a. Maybe a
Prelude.Nothing,
      $sel:backgroundOpacity:BurnInDestinationSettings' :: Maybe Natural
backgroundOpacity = forall a. Maybe a
Prelude.Nothing,
      $sel:font:BurnInDestinationSettings' :: Maybe InputLocation
font = forall a. Maybe a
Prelude.Nothing,
      $sel:fontColor:BurnInDestinationSettings' :: Maybe BurnInFontColor
fontColor = forall a. Maybe a
Prelude.Nothing,
      $sel:fontOpacity:BurnInDestinationSettings' :: Maybe Natural
fontOpacity = forall a. Maybe a
Prelude.Nothing,
      $sel:fontResolution:BurnInDestinationSettings' :: Maybe Natural
fontResolution = forall a. Maybe a
Prelude.Nothing,
      $sel:fontSize:BurnInDestinationSettings' :: Maybe Text
fontSize = forall a. Maybe a
Prelude.Nothing,
      $sel:outlineColor:BurnInDestinationSettings' :: Maybe BurnInOutlineColor
outlineColor = forall a. Maybe a
Prelude.Nothing,
      $sel:outlineSize:BurnInDestinationSettings' :: Maybe Natural
outlineSize = forall a. Maybe a
Prelude.Nothing,
      $sel:shadowColor:BurnInDestinationSettings' :: Maybe BurnInShadowColor
shadowColor = forall a. Maybe a
Prelude.Nothing,
      $sel:shadowOpacity:BurnInDestinationSettings' :: Maybe Natural
shadowOpacity = forall a. Maybe a
Prelude.Nothing,
      $sel:shadowXOffset:BurnInDestinationSettings' :: Maybe Int
shadowXOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:shadowYOffset:BurnInDestinationSettings' :: Maybe Int
shadowYOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:teletextGridControl:BurnInDestinationSettings' :: Maybe BurnInTeletextGridControl
teletextGridControl = forall a. Maybe a
Prelude.Nothing,
      $sel:xPosition:BurnInDestinationSettings' :: Maybe Natural
xPosition = forall a. Maybe a
Prelude.Nothing,
      $sel:yPosition:BurnInDestinationSettings' :: Maybe Natural
yPosition = forall a. Maybe a
Prelude.Nothing
    }

-- | If no explicit xPosition or yPosition is provided, setting alignment to
-- centered will place the captions at the bottom center of the output.
-- Similarly, setting a left alignment will align captions to the bottom
-- left of the output. If x and y positions are given in conjunction with
-- the alignment parameter, the font will be justified (either left or
-- centered) relative to those coordinates. Selecting \"smart\"
-- justification will left-justify live subtitles and center-justify
-- pre-recorded subtitles. All burn-in and DVB-Sub font settings must
-- match.
burnInDestinationSettings_alignment :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInAlignment)
burnInDestinationSettings_alignment :: Lens' BurnInDestinationSettings (Maybe BurnInAlignment)
burnInDestinationSettings_alignment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInAlignment
alignment :: Maybe BurnInAlignment
$sel:alignment:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInAlignment
alignment} -> Maybe BurnInAlignment
alignment) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInAlignment
a -> BurnInDestinationSettings
s {$sel:alignment:BurnInDestinationSettings' :: Maybe BurnInAlignment
alignment = Maybe BurnInAlignment
a} :: BurnInDestinationSettings)

-- | Specifies the color of the rectangle behind the captions. All burn-in
-- and DVB-Sub font settings must match.
burnInDestinationSettings_backgroundColor :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInBackgroundColor)
burnInDestinationSettings_backgroundColor :: Lens' BurnInDestinationSettings (Maybe BurnInBackgroundColor)
burnInDestinationSettings_backgroundColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInBackgroundColor
backgroundColor :: Maybe BurnInBackgroundColor
$sel:backgroundColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInBackgroundColor
backgroundColor} -> Maybe BurnInBackgroundColor
backgroundColor) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInBackgroundColor
a -> BurnInDestinationSettings
s {$sel:backgroundColor:BurnInDestinationSettings' :: Maybe BurnInBackgroundColor
backgroundColor = Maybe BurnInBackgroundColor
a} :: BurnInDestinationSettings)

-- | Specifies the opacity of the background rectangle. 255 is opaque; 0 is
-- transparent. Leaving this parameter out is equivalent to setting it to 0
-- (transparent). All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_backgroundOpacity :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_backgroundOpacity :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_backgroundOpacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
backgroundOpacity :: Maybe Natural
$sel:backgroundOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
backgroundOpacity} -> Maybe Natural
backgroundOpacity) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:backgroundOpacity:BurnInDestinationSettings' :: Maybe Natural
backgroundOpacity = Maybe Natural
a} :: BurnInDestinationSettings)

-- | External font file used for caption burn-in. File extension must be
-- \'ttf\' or \'tte\'. Although the user can select output fonts for many
-- different types of input captions, embedded, STL and teletext sources
-- use a strict grid system. Using external fonts with these caption
-- sources could cause unexpected display of proportional fonts. All
-- burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_font :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe InputLocation)
burnInDestinationSettings_font :: Lens' BurnInDestinationSettings (Maybe InputLocation)
burnInDestinationSettings_font = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe InputLocation
font :: Maybe InputLocation
$sel:font:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe InputLocation
font} -> Maybe InputLocation
font) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe InputLocation
a -> BurnInDestinationSettings
s {$sel:font:BurnInDestinationSettings' :: Maybe InputLocation
font = Maybe InputLocation
a} :: BurnInDestinationSettings)

-- | Specifies the color of the burned-in captions. This option is not valid
-- for source captions that are STL, 608\/embedded or teletext. These
-- source settings are already pre-defined by the caption stream. All
-- burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_fontColor :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInFontColor)
burnInDestinationSettings_fontColor :: Lens' BurnInDestinationSettings (Maybe BurnInFontColor)
burnInDestinationSettings_fontColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInFontColor
fontColor :: Maybe BurnInFontColor
$sel:fontColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInFontColor
fontColor} -> Maybe BurnInFontColor
fontColor) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInFontColor
a -> BurnInDestinationSettings
s {$sel:fontColor:BurnInDestinationSettings' :: Maybe BurnInFontColor
fontColor = Maybe BurnInFontColor
a} :: BurnInDestinationSettings)

-- | Specifies the opacity of the burned-in captions. 255 is opaque; 0 is
-- transparent. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_fontOpacity :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_fontOpacity :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_fontOpacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
fontOpacity :: Maybe Natural
$sel:fontOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
fontOpacity} -> Maybe Natural
fontOpacity) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:fontOpacity:BurnInDestinationSettings' :: Maybe Natural
fontOpacity = Maybe Natural
a} :: BurnInDestinationSettings)

-- | Font resolution in DPI (dots per inch); default is 96 dpi. All burn-in
-- and DVB-Sub font settings must match.
burnInDestinationSettings_fontResolution :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_fontResolution :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_fontResolution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
fontResolution :: Maybe Natural
$sel:fontResolution:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
fontResolution} -> Maybe Natural
fontResolution) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:fontResolution:BurnInDestinationSettings' :: Maybe Natural
fontResolution = Maybe Natural
a} :: BurnInDestinationSettings)

-- | When set to \'auto\' fontSize will scale depending on the size of the
-- output. Giving a positive integer will specify the exact font size in
-- points. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_fontSize :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Text)
burnInDestinationSettings_fontSize :: Lens' BurnInDestinationSettings (Maybe Text)
burnInDestinationSettings_fontSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Text
fontSize :: Maybe Text
$sel:fontSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Text
fontSize} -> Maybe Text
fontSize) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Text
a -> BurnInDestinationSettings
s {$sel:fontSize:BurnInDestinationSettings' :: Maybe Text
fontSize = Maybe Text
a} :: BurnInDestinationSettings)

-- | Specifies font outline color. This option is not valid for source
-- captions that are either 608\/embedded or teletext. These source
-- settings are already pre-defined by the caption stream. All burn-in and
-- DVB-Sub font settings must match.
burnInDestinationSettings_outlineColor :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInOutlineColor)
burnInDestinationSettings_outlineColor :: Lens' BurnInDestinationSettings (Maybe BurnInOutlineColor)
burnInDestinationSettings_outlineColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInOutlineColor
outlineColor :: Maybe BurnInOutlineColor
$sel:outlineColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInOutlineColor
outlineColor} -> Maybe BurnInOutlineColor
outlineColor) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInOutlineColor
a -> BurnInDestinationSettings
s {$sel:outlineColor:BurnInDestinationSettings' :: Maybe BurnInOutlineColor
outlineColor = Maybe BurnInOutlineColor
a} :: BurnInDestinationSettings)

-- | Specifies font outline size in pixels. This option is not valid for
-- source captions that are either 608\/embedded or teletext. These source
-- settings are already pre-defined by the caption stream. All burn-in and
-- DVB-Sub font settings must match.
burnInDestinationSettings_outlineSize :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_outlineSize :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_outlineSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
outlineSize :: Maybe Natural
$sel:outlineSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
outlineSize} -> Maybe Natural
outlineSize) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:outlineSize:BurnInDestinationSettings' :: Maybe Natural
outlineSize = Maybe Natural
a} :: BurnInDestinationSettings)

-- | Specifies the color of the shadow cast by the captions. All burn-in and
-- DVB-Sub font settings must match.
burnInDestinationSettings_shadowColor :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInShadowColor)
burnInDestinationSettings_shadowColor :: Lens' BurnInDestinationSettings (Maybe BurnInShadowColor)
burnInDestinationSettings_shadowColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInShadowColor
shadowColor :: Maybe BurnInShadowColor
$sel:shadowColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInShadowColor
shadowColor} -> Maybe BurnInShadowColor
shadowColor) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInShadowColor
a -> BurnInDestinationSettings
s {$sel:shadowColor:BurnInDestinationSettings' :: Maybe BurnInShadowColor
shadowColor = Maybe BurnInShadowColor
a} :: BurnInDestinationSettings)

-- | Specifies the opacity of the shadow. 255 is opaque; 0 is transparent.
-- Leaving this parameter out is equivalent to setting it to 0
-- (transparent). All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_shadowOpacity :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_shadowOpacity :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_shadowOpacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
shadowOpacity :: Maybe Natural
$sel:shadowOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
shadowOpacity} -> Maybe Natural
shadowOpacity) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:shadowOpacity:BurnInDestinationSettings' :: Maybe Natural
shadowOpacity = Maybe Natural
a} :: BurnInDestinationSettings)

-- | Specifies the horizontal offset of the shadow relative to the captions
-- in pixels. A value of -2 would result in a shadow offset 2 pixels to the
-- left. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_shadowXOffset :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Int)
burnInDestinationSettings_shadowXOffset :: Lens' BurnInDestinationSettings (Maybe Int)
burnInDestinationSettings_shadowXOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Int
shadowXOffset :: Maybe Int
$sel:shadowXOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
shadowXOffset} -> Maybe Int
shadowXOffset) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Int
a -> BurnInDestinationSettings
s {$sel:shadowXOffset:BurnInDestinationSettings' :: Maybe Int
shadowXOffset = Maybe Int
a} :: BurnInDestinationSettings)

-- | Specifies the vertical offset of the shadow relative to the captions in
-- pixels. A value of -2 would result in a shadow offset 2 pixels above the
-- text. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_shadowYOffset :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Int)
burnInDestinationSettings_shadowYOffset :: Lens' BurnInDestinationSettings (Maybe Int)
burnInDestinationSettings_shadowYOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Int
shadowYOffset :: Maybe Int
$sel:shadowYOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
shadowYOffset} -> Maybe Int
shadowYOffset) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Int
a -> BurnInDestinationSettings
s {$sel:shadowYOffset:BurnInDestinationSettings' :: Maybe Int
shadowYOffset = Maybe Int
a} :: BurnInDestinationSettings)

-- | Controls whether a fixed grid size will be used to generate the output
-- subtitles bitmap. Only applicable for Teletext inputs and
-- DVB-Sub\/Burn-in outputs.
burnInDestinationSettings_teletextGridControl :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe BurnInTeletextGridControl)
burnInDestinationSettings_teletextGridControl :: Lens' BurnInDestinationSettings (Maybe BurnInTeletextGridControl)
burnInDestinationSettings_teletextGridControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe BurnInTeletextGridControl
teletextGridControl :: Maybe BurnInTeletextGridControl
$sel:teletextGridControl:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInTeletextGridControl
teletextGridControl} -> Maybe BurnInTeletextGridControl
teletextGridControl) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe BurnInTeletextGridControl
a -> BurnInDestinationSettings
s {$sel:teletextGridControl:BurnInDestinationSettings' :: Maybe BurnInTeletextGridControl
teletextGridControl = Maybe BurnInTeletextGridControl
a} :: BurnInDestinationSettings)

-- | Specifies the horizontal position of the caption relative to the left
-- side of the output in pixels. A value of 10 would result in the captions
-- starting 10 pixels from the left of the output. If no explicit xPosition
-- is provided, the horizontal caption position will be determined by the
-- alignment parameter. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_xPosition :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_xPosition :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_xPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
xPosition :: Maybe Natural
$sel:xPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
xPosition} -> Maybe Natural
xPosition) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:xPosition:BurnInDestinationSettings' :: Maybe Natural
xPosition = Maybe Natural
a} :: BurnInDestinationSettings)

-- | Specifies the vertical position of the caption relative to the top of
-- the output in pixels. A value of 10 would result in the captions
-- starting 10 pixels from the top of the output. If no explicit yPosition
-- is provided, the caption will be positioned towards the bottom of the
-- output. All burn-in and DVB-Sub font settings must match.
burnInDestinationSettings_yPosition :: Lens.Lens' BurnInDestinationSettings (Prelude.Maybe Prelude.Natural)
burnInDestinationSettings_yPosition :: Lens' BurnInDestinationSettings (Maybe Natural)
burnInDestinationSettings_yPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BurnInDestinationSettings' {Maybe Natural
yPosition :: Maybe Natural
$sel:yPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
yPosition} -> Maybe Natural
yPosition) (\s :: BurnInDestinationSettings
s@BurnInDestinationSettings' {} Maybe Natural
a -> BurnInDestinationSettings
s {$sel:yPosition:BurnInDestinationSettings' :: Maybe Natural
yPosition = Maybe Natural
a} :: BurnInDestinationSettings)

instance Data.FromJSON BurnInDestinationSettings where
  parseJSON :: Value -> Parser BurnInDestinationSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BurnInDestinationSettings"
      ( \Object
x ->
          Maybe BurnInAlignment
-> Maybe BurnInBackgroundColor
-> Maybe Natural
-> Maybe InputLocation
-> Maybe BurnInFontColor
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Maybe BurnInOutlineColor
-> Maybe Natural
-> Maybe BurnInShadowColor
-> Maybe Natural
-> Maybe Int
-> Maybe Int
-> Maybe BurnInTeletextGridControl
-> Maybe Natural
-> Maybe Natural
-> BurnInDestinationSettings
BurnInDestinationSettings'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"alignment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"backgroundColor")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"backgroundOpacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"font")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"fontColor")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"fontOpacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"fontResolution")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"fontSize")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"outlineColor")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"outlineSize")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"shadowColor")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"shadowOpacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"shadowXOffset")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"shadowYOffset")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"teletextGridControl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"xPosition")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"yPosition")
      )

instance Prelude.Hashable BurnInDestinationSettings where
  hashWithSalt :: Int -> BurnInDestinationSettings -> Int
hashWithSalt Int
_salt BurnInDestinationSettings' {Maybe Int
Maybe Natural
Maybe Text
Maybe BurnInAlignment
Maybe BurnInBackgroundColor
Maybe BurnInFontColor
Maybe BurnInOutlineColor
Maybe BurnInShadowColor
Maybe BurnInTeletextGridControl
Maybe InputLocation
yPosition :: Maybe Natural
xPosition :: Maybe Natural
teletextGridControl :: Maybe BurnInTeletextGridControl
shadowYOffset :: Maybe Int
shadowXOffset :: Maybe Int
shadowOpacity :: Maybe Natural
shadowColor :: Maybe BurnInShadowColor
outlineSize :: Maybe Natural
outlineColor :: Maybe BurnInOutlineColor
fontSize :: Maybe Text
fontResolution :: Maybe Natural
fontOpacity :: Maybe Natural
fontColor :: Maybe BurnInFontColor
font :: Maybe InputLocation
backgroundOpacity :: Maybe Natural
backgroundColor :: Maybe BurnInBackgroundColor
alignment :: Maybe BurnInAlignment
$sel:yPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:xPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:teletextGridControl:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInTeletextGridControl
$sel:shadowYOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowXOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:shadowColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInShadowColor
$sel:outlineSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:outlineColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInOutlineColor
$sel:fontSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Text
$sel:fontResolution:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInFontColor
$sel:font:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe InputLocation
$sel:backgroundOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:backgroundColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInBackgroundColor
$sel:alignment:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInAlignment
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInAlignment
alignment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInBackgroundColor
backgroundColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
backgroundOpacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputLocation
font
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInFontColor
fontColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
fontOpacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
fontResolution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fontSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInOutlineColor
outlineColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
outlineSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInShadowColor
shadowColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
shadowOpacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
shadowXOffset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
shadowYOffset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BurnInTeletextGridControl
teletextGridControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
xPosition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
yPosition

instance Prelude.NFData BurnInDestinationSettings where
  rnf :: BurnInDestinationSettings -> ()
rnf BurnInDestinationSettings' {Maybe Int
Maybe Natural
Maybe Text
Maybe BurnInAlignment
Maybe BurnInBackgroundColor
Maybe BurnInFontColor
Maybe BurnInOutlineColor
Maybe BurnInShadowColor
Maybe BurnInTeletextGridControl
Maybe InputLocation
yPosition :: Maybe Natural
xPosition :: Maybe Natural
teletextGridControl :: Maybe BurnInTeletextGridControl
shadowYOffset :: Maybe Int
shadowXOffset :: Maybe Int
shadowOpacity :: Maybe Natural
shadowColor :: Maybe BurnInShadowColor
outlineSize :: Maybe Natural
outlineColor :: Maybe BurnInOutlineColor
fontSize :: Maybe Text
fontResolution :: Maybe Natural
fontOpacity :: Maybe Natural
fontColor :: Maybe BurnInFontColor
font :: Maybe InputLocation
backgroundOpacity :: Maybe Natural
backgroundColor :: Maybe BurnInBackgroundColor
alignment :: Maybe BurnInAlignment
$sel:yPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:xPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:teletextGridControl:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInTeletextGridControl
$sel:shadowYOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowXOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:shadowColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInShadowColor
$sel:outlineSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:outlineColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInOutlineColor
$sel:fontSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Text
$sel:fontResolution:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInFontColor
$sel:font:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe InputLocation
$sel:backgroundOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:backgroundColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInBackgroundColor
$sel:alignment:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInAlignment
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInAlignment
alignment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInBackgroundColor
backgroundColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
backgroundOpacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputLocation
font
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInFontColor
fontColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
fontOpacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
fontResolution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fontSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInOutlineColor
outlineColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
outlineSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInShadowColor
shadowColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
shadowOpacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
shadowXOffset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
shadowYOffset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BurnInTeletextGridControl
teletextGridControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
xPosition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
yPosition

instance Data.ToJSON BurnInDestinationSettings where
  toJSON :: BurnInDestinationSettings -> Value
toJSON BurnInDestinationSettings' {Maybe Int
Maybe Natural
Maybe Text
Maybe BurnInAlignment
Maybe BurnInBackgroundColor
Maybe BurnInFontColor
Maybe BurnInOutlineColor
Maybe BurnInShadowColor
Maybe BurnInTeletextGridControl
Maybe InputLocation
yPosition :: Maybe Natural
xPosition :: Maybe Natural
teletextGridControl :: Maybe BurnInTeletextGridControl
shadowYOffset :: Maybe Int
shadowXOffset :: Maybe Int
shadowOpacity :: Maybe Natural
shadowColor :: Maybe BurnInShadowColor
outlineSize :: Maybe Natural
outlineColor :: Maybe BurnInOutlineColor
fontSize :: Maybe Text
fontResolution :: Maybe Natural
fontOpacity :: Maybe Natural
fontColor :: Maybe BurnInFontColor
font :: Maybe InputLocation
backgroundOpacity :: Maybe Natural
backgroundColor :: Maybe BurnInBackgroundColor
alignment :: Maybe BurnInAlignment
$sel:yPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:xPosition:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:teletextGridControl:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInTeletextGridControl
$sel:shadowYOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowXOffset:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Int
$sel:shadowOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:shadowColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInShadowColor
$sel:outlineSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:outlineColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInOutlineColor
$sel:fontSize:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Text
$sel:fontResolution:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:fontColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInFontColor
$sel:font:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe InputLocation
$sel:backgroundOpacity:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe Natural
$sel:backgroundColor:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInBackgroundColor
$sel:alignment:BurnInDestinationSettings' :: BurnInDestinationSettings -> Maybe BurnInAlignment
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"alignment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInAlignment
alignment,
            (Key
"backgroundColor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInBackgroundColor
backgroundColor,
            (Key
"backgroundOpacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
backgroundOpacity,
            (Key
"font" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe InputLocation
font,
            (Key
"fontColor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInFontColor
fontColor,
            (Key
"fontOpacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
fontOpacity,
            (Key
"fontResolution" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
fontResolution,
            (Key
"fontSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
fontSize,
            (Key
"outlineColor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInOutlineColor
outlineColor,
            (Key
"outlineSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
outlineSize,
            (Key
"shadowColor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInShadowColor
shadowColor,
            (Key
"shadowOpacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
shadowOpacity,
            (Key
"shadowXOffset" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
shadowXOffset,
            (Key
"shadowYOffset" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
shadowYOffset,
            (Key
"teletextGridControl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BurnInTeletextGridControl
teletextGridControl,
            (Key
"xPosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
xPosition,
            (Key
"yPosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
yPosition
          ]
      )