{-# language CPP #-}
-- | = Name
--
-- XR_KHR_composition_layer_color_scale_bias - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_color_scale_bias  XR_KHR_composition_layer_color_scale_bias>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 35
--
-- = Revision
--
-- 5
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'CompositionLayerColorScaleBiasKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_color_scale_bias OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_KHR_composition_layer_color_scale_bias  ( CompositionLayerColorScaleBiasKHR(..)
                                                                    , KHR_composition_layer_color_scale_bias_SPEC_VERSION
                                                                    , pattern KHR_composition_layer_color_scale_bias_SPEC_VERSION
                                                                    , KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME
                                                                    , pattern KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME
                                                                    ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import OpenXR.Core10.OtherTypes (Color4f)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_COLOR_SCALE_BIAS_KHR))
-- | XrCompositionLayerColorScaleBiasKHR - defines color scale and bias for
-- layer textures
--
-- == Member Descriptions
--
-- = Description
--
-- 'CompositionLayerColorScaleBiasKHR' contains the information needed to
-- scale and bias the color of layer textures.
--
-- The 'CompositionLayerColorScaleBiasKHR' structure /can/ be applied by
-- applications to composition layers by adding an instance of the struct
-- to the 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader'::@next@
-- list.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerColorScaleBiasKHR-extension-notenabled# The
--     @@ extension /must/ be enabled prior to using
--     'CompositionLayerColorScaleBiasKHR'
--
-- -   #VUID-XrCompositionLayerColorScaleBiasKHR-type-type# @type@ /must/
--     be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_COLOR_SCALE_BIAS_KHR'
--
-- -   #VUID-XrCompositionLayerColorScaleBiasKHR-next-next# @next@ /must/
--     be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.Color4f',
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data CompositionLayerColorScaleBiasKHR = CompositionLayerColorScaleBiasKHR
  { -- | @colorScale@ is an 'OpenXR.Core10.OtherTypes.Color4f' which will
    -- modulate the color sourced from the images.
    CompositionLayerColorScaleBiasKHR -> Color4f
colorScale :: Color4f
  , -- | @colorBias@ is an 'OpenXR.Core10.OtherTypes.Color4f' which will offset
    -- the color sourced from the images.
    CompositionLayerColorScaleBiasKHR -> Color4f
colorBias :: Color4f
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerColorScaleBiasKHR)
#endif
deriving instance Show CompositionLayerColorScaleBiasKHR

instance ToCStruct CompositionLayerColorScaleBiasKHR where
  withCStruct :: CompositionLayerColorScaleBiasKHR
-> (Ptr CompositionLayerColorScaleBiasKHR -> IO b) -> IO b
withCStruct x :: CompositionLayerColorScaleBiasKHR
x f :: Ptr CompositionLayerColorScaleBiasKHR -> IO b
f = Int
-> Int -> (Ptr CompositionLayerColorScaleBiasKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr CompositionLayerColorScaleBiasKHR -> IO b) -> IO b)
-> (Ptr CompositionLayerColorScaleBiasKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerColorScaleBiasKHR
p -> Ptr CompositionLayerColorScaleBiasKHR
-> CompositionLayerColorScaleBiasKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerColorScaleBiasKHR
p CompositionLayerColorScaleBiasKHR
x (Ptr CompositionLayerColorScaleBiasKHR -> IO b
f Ptr CompositionLayerColorScaleBiasKHR
p)
  pokeCStruct :: Ptr CompositionLayerColorScaleBiasKHR
-> CompositionLayerColorScaleBiasKHR -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerColorScaleBiasKHR
p CompositionLayerColorScaleBiasKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_COLOR_SCALE_BIAS_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Color4f -> Color4f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Color4f)) (Color4f
colorScale)
    Ptr Color4f -> Color4f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Color4f)) (Color4f
colorBias)
    IO b
f
  cStructSize :: Int
cStructSize = 48
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerColorScaleBiasKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerColorScaleBiasKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_COLOR_SCALE_BIAS_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Color4f -> Color4f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Color4f)) (Color4f
forall a. Zero a => a
zero)
    Ptr Color4f -> Color4f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Color4f)) (Color4f
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CompositionLayerColorScaleBiasKHR where
  peekCStruct :: Ptr CompositionLayerColorScaleBiasKHR
-> IO CompositionLayerColorScaleBiasKHR
peekCStruct p :: Ptr CompositionLayerColorScaleBiasKHR
p = do
    Color4f
colorScale <- Ptr Color4f -> IO Color4f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Color4f ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Color4f))
    Color4f
colorBias <- Ptr Color4f -> IO Color4f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Color4f ((Ptr CompositionLayerColorScaleBiasKHR
p Ptr CompositionLayerColorScaleBiasKHR -> Int -> Ptr Color4f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Color4f))
    CompositionLayerColorScaleBiasKHR
-> IO CompositionLayerColorScaleBiasKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerColorScaleBiasKHR
 -> IO CompositionLayerColorScaleBiasKHR)
-> CompositionLayerColorScaleBiasKHR
-> IO CompositionLayerColorScaleBiasKHR
forall a b. (a -> b) -> a -> b
$ Color4f -> Color4f -> CompositionLayerColorScaleBiasKHR
CompositionLayerColorScaleBiasKHR
             Color4f
colorScale Color4f
colorBias

instance Storable CompositionLayerColorScaleBiasKHR where
  sizeOf :: CompositionLayerColorScaleBiasKHR -> Int
sizeOf ~CompositionLayerColorScaleBiasKHR
_ = 48
  alignment :: CompositionLayerColorScaleBiasKHR -> Int
alignment ~CompositionLayerColorScaleBiasKHR
_ = 8
  peek :: Ptr CompositionLayerColorScaleBiasKHR
-> IO CompositionLayerColorScaleBiasKHR
peek = Ptr CompositionLayerColorScaleBiasKHR
-> IO CompositionLayerColorScaleBiasKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr CompositionLayerColorScaleBiasKHR
-> CompositionLayerColorScaleBiasKHR -> IO ()
poke ptr :: Ptr CompositionLayerColorScaleBiasKHR
ptr poked :: CompositionLayerColorScaleBiasKHR
poked = Ptr CompositionLayerColorScaleBiasKHR
-> CompositionLayerColorScaleBiasKHR -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerColorScaleBiasKHR
ptr CompositionLayerColorScaleBiasKHR
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero CompositionLayerColorScaleBiasKHR where
  zero :: CompositionLayerColorScaleBiasKHR
zero = Color4f -> Color4f -> CompositionLayerColorScaleBiasKHR
CompositionLayerColorScaleBiasKHR
           Color4f
forall a. Zero a => a
zero
           Color4f
forall a. Zero a => a
zero


type KHR_composition_layer_color_scale_bias_SPEC_VERSION = 5

-- No documentation found for TopLevel "XR_KHR_composition_layer_color_scale_bias_SPEC_VERSION"
pattern KHR_composition_layer_color_scale_bias_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_composition_layer_color_scale_bias_SPEC_VERSION :: a
$mKHR_composition_layer_color_scale_bias_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_composition_layer_color_scale_bias_SPEC_VERSION = 5


type KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME = "XR_KHR_composition_layer_color_scale_bias"

-- No documentation found for TopLevel "XR_KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME"
pattern KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME :: a
$mKHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_COMPOSITION_LAYER_COLOR_SCALE_BIAS_EXTENSION_NAME = "XR_KHR_composition_layer_color_scale_bias"