{-# language CPP #-}
-- | = Name
--
-- VK_KHR_display - instance extension
--
-- == VK_KHR_display
--
-- [__Name String__]
--     @VK_KHR_display@
--
-- [__Extension Type__]
--     Instance extension
--
-- [__Registered Extension Number__]
--     3
--
-- [__Revision__]
--     23
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_surface@
--
-- [__Contact__]
--
--     -   James Jones
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_display] @cubanismo%0A<<Here describe the issue or question you have about the VK_KHR_display extension>> >
--
--     -   Norbert Nopper
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_display] @FslNopper%0A<<Here describe the issue or question you have about the VK_KHR_display extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2017-03-13
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   James Jones, NVIDIA
--
--     -   Norbert Nopper, Freescale
--
--     -   Jeff Vigil, Qualcomm
--
--     -   Daniel Rakos, AMD
--
-- == Description
--
-- This extension provides the API to enumerate displays and available
-- modes on a given device.
--
-- == New Object Types
--
-- -   'Vulkan.Extensions.Handles.DisplayKHR'
--
-- -   'Vulkan.Extensions.Handles.DisplayModeKHR'
--
-- == New Commands
--
-- -   'createDisplayModeKHR'
--
-- -   'createDisplayPlaneSurfaceKHR'
--
-- -   'getDisplayModePropertiesKHR'
--
-- -   'getDisplayPlaneCapabilitiesKHR'
--
-- -   'getDisplayPlaneSupportedDisplaysKHR'
--
-- -   'getPhysicalDeviceDisplayPlanePropertiesKHR'
--
-- -   'getPhysicalDeviceDisplayPropertiesKHR'
--
-- == New Structures
--
-- -   'DisplayModeCreateInfoKHR'
--
-- -   'DisplayModeParametersKHR'
--
-- -   'DisplayModePropertiesKHR'
--
-- -   'DisplayPlaneCapabilitiesKHR'
--
-- -   'DisplayPlanePropertiesKHR'
--
-- -   'DisplayPropertiesKHR'
--
-- -   'DisplaySurfaceCreateInfoKHR'
--
-- == New Enums
--
-- -   'DisplayPlaneAlphaFlagBitsKHR'
--
-- == New Bitmasks
--
-- -   'DisplayModeCreateFlagsKHR'
--
-- -   'DisplayPlaneAlphaFlagsKHR'
--
-- -   'DisplaySurfaceCreateFlagsKHR'
--
-- -   'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagsKHR'
--
-- == New Enum Constants
--
-- -   'KHR_DISPLAY_EXTENSION_NAME'
--
-- -   'KHR_DISPLAY_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.ObjectType.ObjectType':
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_DISPLAY_KHR'
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_DISPLAY_MODE_KHR'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DISPLAY_MODE_CREATE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DISPLAY_SURFACE_CREATE_INFO_KHR'
--
-- == Issues
--
-- 1) Which properties of a mode should be fixed in the mode information
-- vs. settable in some other function when setting the mode? E.g., do we
-- need to double the size of the mode pool to include both stereo and
-- non-stereo modes? YUV and RGB scanout even if they both take RGB input
-- images? BGR vs. RGB input? etc.
--
-- __PROPOSED RESOLUTION__: Many modern displays support at most a handful
-- of resolutions and timings natively. Other “modes” are expected to be
-- supported using scaling hardware on the display engine or GPU. Other
-- properties, such as rotation and mirroring should not require
-- duplicating hardware modes just to express all combinations. Further,
-- these properties may be implemented on a per-display or per-overlay
-- granularity.
--
-- To avoid the exponential growth of modes as mutable properties are
-- added, as was the case with @EGLConfig@\/WGL pixel
-- formats\/@GLXFBConfig@, this specification should separate out hardware
-- properties and configurable state into separate objects. Modes and
-- overlay planes will express capabilities of the hardware, while a
-- separate structure will allow applications to configure scaling,
-- rotation, mirroring, color keys, LUT values, alpha masks, etc. for a
-- given swapchain independent of the mode in use. Constraints on these
-- settings will be established by properties of the immutable objects.
--
-- Note the resolution of this issue may affect issue 5 as well.
--
-- 2) What properties of a display itself are useful?
--
-- __PROPOSED RESOLUTION__: This issue is too broad. It was meant to prompt
-- general discussion, but resolving this issue amounts to completing this
-- specification. All interesting properties should be included. The issue
-- will remain as a placeholder since removing it would make it hard to
-- parse existing discussion notes that refer to issues by number.
--
-- 3) How are multiple overlay planes within a display or mode enumerated?
--
-- __PROPOSED RESOLUTION__: They are referred to by an index. Each display
-- will report the number of overlay planes it contains.
--
-- 4) Should swapchains be created relative to a mode or a display?
--
-- __PROPOSED RESOLUTION__: When using this extension, swapchains are
-- created relative to a mode and a plane. The mode implies the display
-- object the swapchain will present to. If the specified mode is not the
-- display’s current mode, the new mode will be applied when the first
-- image is presented to the swapchain, and the default operating system
-- mode, if any, will be restored when the swapchain is destroyed.
--
-- 5) Should users query generic ranges from displays and construct their
-- own modes explicitly using those constraints rather than querying a
-- fixed set of modes (Most monitors only have one real “mode” these days,
-- even though many support relatively arbitrary scaling, either on the
-- monitor side or in the GPU display engine, making “modes” something of a
-- relic\/compatibility construct).
--
-- __PROPOSED RESOLUTION__: Expose both. Display information structures
-- will expose a set of predefined modes, as well as any attributes
-- necessary to construct a customized mode.
--
-- 6) Is it fine if we return the display and display mode handles in the
-- structure used to query their properties?
--
-- __PROPOSED RESOLUTION__: Yes.
--
-- 7) Is there a possibility that not all displays of a device work with
-- all of the present queues of a device? If yes, how do we determine which
-- displays work with which present queues?
--
-- __PROPOSED RESOLUTION__: No known hardware has such limitations, but
-- determining such limitations is supported automatically using the
-- existing @VK_KHR_surface@ and @VK_KHR_swapchain@ query mechanisms.
--
-- 8) Should all presentation need to be done relative to an overlay plane,
-- or can a display mode + display be used alone to target an output?
--
-- __PROPOSED RESOLUTION__: Require specifying a plane explicitly.
--
-- 9) Should displays have an associated window system display, such as an
-- @HDC@ or @Display*@?
--
-- __PROPOSED RESOLUTION__: No. Displays are independent of any windowing
-- system in use on the system. Further, neither @HDC@ nor @Display*@ refer
-- to a physical display object.
--
-- 10) Are displays queried from a physical GPU or from a device instance?
--
-- __PROPOSED RESOLUTION__: Developers prefer to query modes directly from
-- the physical GPU so they can use display information as an input to
-- their device selection algorithms prior to device creation. This avoids
-- the need to create placeholder device instances to enumerate displays.
--
-- This preference must be weighed against the extra initialization that
-- must be done by driver vendors prior to device instance creation to
-- support this usage.
--
-- 11) Should displays and\/or modes be dispatchable objects? If functions
-- are to take displays, overlays, or modes as their first parameter, they
-- must be dispatchable objects as defined in Khronos bug 13529. If they
-- are not added to the list of dispatchable objects, functions operating
-- on them must take some higher-level object as their first parameter.
-- There is no performance case against making them dispatchable objects,
-- but they would be the first extension objects to be dispatchable.
--
-- __PROPOSED RESOLUTION__: Do not make displays or modes dispatchable.
-- They will dispatch based on their associated physical device.
--
-- 12) Should hardware cursor capabilities be exposed?
--
-- __PROPOSED RESOLUTION__: Defer. This could be a separate extension on
-- top of the base WSI specs.
--
-- if they are one physical display device to an end user, but may
-- internally be implemented as two side-by-side displays using the same
-- display engine (and sometimes cabling) resources as two physically
-- separate display devices.
--
-- __RESOLVED__: Tiled displays will appear as a single display object in
-- this API.
--
-- 14) Should the raw EDID data be included in the display information?
--
-- __RESOLVED__: No. A future extension could be added which reports the
-- EDID if necessary. This may be complicated by the outcome of issue 13.
--
-- 15) Should min and max scaling factor capabilities of overlays be
-- exposed?
--
-- __RESOLVED__: Yes. This is exposed indirectly by allowing applications
-- to query the min\/max position and extent of the source and destination
-- regions from which image contents are fetched by the display engine when
-- using a particular mode and overlay pair.
--
-- 16) Should devices be able to expose planes that can be moved between
-- displays? If so, how?
--
-- __RESOLVED__: Yes. Applications can determine which displays a given
-- plane supports using 'getDisplayPlaneSupportedDisplaysKHR'.
--
-- 17) Should there be a way to destroy display modes? If so, does it
-- support destroying “built in” modes?
--
-- __RESOLVED__: Not in this extension. A future extension could add this
-- functionality.
--
-- 18) What should the lifetime of display and built-in display mode
-- objects be?
--
-- __RESOLVED__: The lifetime of the instance. These objects cannot be
-- destroyed. A future extension may be added to expose a way to destroy
-- these objects and\/or support display hotplug.
--
-- 19) Should persistent mode for smart panels be enabled\/disabled at
-- swapchain creation time, or on a per-present basis.
--
-- __RESOLVED__: On a per-present basis.
--
-- == Examples
--
-- Note
--
-- The example code for the @VK_KHR_display@ and @VK_KHR_display_swapchain@
-- extensions was removed from the appendix after revision 1.0.43. The
-- display enumeration example code was ported to the cube demo that is
-- shipped with the official Khronos SDK, and is being kept up-to-date in
-- that location (see:
-- <https://github.com/KhronosGroup/Vulkan-Tools/blob/master/cube/cube.c>).
--
-- == Version History
--
-- -   Revision 1, 2015-02-24 (James Jones)
--
--     -   Initial draft
--
-- -   Revision 2, 2015-03-12 (Norbert Nopper)
--
--     -   Added overlay enumeration for a display.
--
-- -   Revision 3, 2015-03-17 (Norbert Nopper)
--
--     -   Fixed typos and namings as discussed in Bugzilla.
--
--     -   Reordered and grouped functions.
--
--     -   Added functions to query count of display, mode and overlay.
--
--     -   Added native display handle, which may be needed on some
--         platforms to create a native Window.
--
-- -   Revision 4, 2015-03-18 (Norbert Nopper)
--
--     -   Removed primary and virtualPostion members (see comment of James
--         Jones in Bugzilla).
--
--     -   Added native overlay handle to information structure.
--
--     -   Replaced , with ; in struct.
--
-- -   Revision 6, 2015-03-18 (Daniel Rakos)
--
--     -   Added WSI extension suffix to all items.
--
--     -   Made the whole API more “Vulkanish”.
--
--     -   Replaced all functions with a single vkGetDisplayInfoKHR
--         function to better match the rest of the API.
--
--     -   Made the display, display mode, and overlay objects be first
--         class objects, not subclasses of VkBaseObject as they do not
--         support the common functions anyways.
--
--     -   Renamed *Info structures to *Properties.
--
--     -   Removed overlayIndex field from VkOverlayProperties as there is
--         an implicit index already as a result of moving to a “Vulkanish”
--         API.
--
--     -   Displays are not get through device, but through physical GPU to
--         match the rest of the Vulkan API. Also this is something ISVs
--         explicitly requested.
--
--     -   Added issue (6) and (7).
--
-- -   Revision 7, 2015-03-25 (James Jones)
--
--     -   Added an issues section
--
--     -   Added rotation and mirroring flags
--
-- -   Revision 8, 2015-03-25 (James Jones)
--
--     -   Combined the duplicate issues sections introduced in last
--         change.
--
--     -   Added proposed resolutions to several issues.
--
-- -   Revision 9, 2015-04-01 (Daniel Rakos)
--
--     -   Rebased extension against Vulkan 0.82.0
--
-- -   Revision 10, 2015-04-01 (James Jones)
--
--     -   Added issues (10) and (11).
--
--     -   Added more straw-man issue resolutions, and cleaned up the
--         proposed resolution for issue (4).
--
--     -   Updated the rotation and mirroring enums to have proper bitmask
--         semantics.
--
-- -   Revision 11, 2015-04-15 (James Jones)
--
--     -   Added proposed resolution for issues (1) and (2).
--
--     -   Added issues (12), (13), (14), and (15)
--
--     -   Removed pNativeHandle field from overlay structure.
--
--     -   Fixed small compilation errors in example code.
--
-- -   Revision 12, 2015-07-29 (James Jones)
--
--     -   Rewrote the guts of the extension against the latest WSI
--         swapchain specifications and the latest Vulkan API.
--
--     -   Address overlay planes by their index rather than an object
--         handle and refer to them as “planes” rather than “overlays” to
--         make it slightly clearer that even a display with no “overlays”
--         still has at least one base “plane” that images can be displayed
--         on.
--
--     -   Updated most of the issues.
--
--     -   Added an “extension type” section to the specification header.
--
--     -   Re-used the VK_EXT_KHR_surface surface transform enumerations
--         rather than redefining them here.
--
--     -   Updated the example code to use the new semantics.
--
-- -   Revision 13, 2015-08-21 (Ian Elliott)
--
--     -   Renamed this extension and all of its enumerations, types,
--         functions, etc. This makes it compliant with the proposed
--         standard for Vulkan extensions.
--
--     -   Switched from “revision” to “version”, including use of the
--         VK_MAKE_VERSION macro in the header file.
--
-- -   Revision 14, 2015-09-01 (James Jones)
--
--     -   Restore single-field revision number.
--
-- -   Revision 15, 2015-09-08 (James Jones)
--
--     -   Added alpha flags enum.
--
--     -   Added premultiplied alpha support.
--
-- -   Revision 16, 2015-09-08 (James Jones)
--
--     -   Added description section to the spec.
--
--     -   Added issues 16 - 18.
--
-- -   Revision 17, 2015-10-02 (James Jones)
--
--     -   Planes are now a property of the entire device rather than
--         individual displays. This allows planes to be moved between
--         multiple displays on devices that support it.
--
--     -   Added a function to create a VkSurfaceKHR object describing a
--         display plane and mode to align with the new per-platform
--         surface creation conventions.
--
--     -   Removed detailed mode timing data. It was agreed that the mode
--         extents and refresh rate are sufficient for current use cases.
--         Other information could be added back in as an extension if it
--         is needed in the future.
--
--     -   Added support for smart\/persistent\/buffered display devices.
--
-- -   Revision 18, 2015-10-26 (Ian Elliott)
--
--     -   Renamed from VK_EXT_KHR_display to VK_KHR_display.
--
-- -   Revision 19, 2015-11-02 (James Jones)
--
--     -   Updated example code to match revision 17 changes.
--
-- -   Revision 20, 2015-11-03 (Daniel Rakos)
--
--     -   Added allocation callbacks to creation functions.
--
-- -   Revision 21, 2015-11-10 (Jesse Hall)
--
--     -   Added VK_DISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR, and use
--         VkDisplayPlaneAlphaFlagBitsKHR for
--         VkDisplayPlanePropertiesKHR::alphaMode instead of
--         VkDisplayPlaneAlphaFlagsKHR, since it only represents one mode.
--
--     -   Added reserved flags bitmask to VkDisplayPlanePropertiesKHR.
--
--     -   Use VkSurfaceTransformFlagBitsKHR instead of obsolete
--         VkSurfaceTransformKHR.
--
--     -   Renamed vkGetDisplayPlaneSupportedDisplaysKHR parameters for
--         clarity.
--
-- -   Revision 22, 2015-12-18 (James Jones)
--
--     -   Added missing “planeIndex” parameter to
--         vkGetDisplayPlaneSupportedDisplaysKHR()
--
-- -   Revision 23, 2017-03-13 (James Jones)
--
--     -   Closed all remaining issues. The specification and
--         implementations have been shipping with the proposed resolutions
--         for some time now.
--
--     -   Removed the sample code and noted it has been integrated into
--         the official Vulkan SDK cube demo.
--
-- == See Also
--
-- 'Vulkan.Extensions.Handles.DisplayKHR', 'DisplayModeCreateFlagsKHR',
-- 'DisplayModeCreateInfoKHR', 'Vulkan.Extensions.Handles.DisplayModeKHR',
-- 'DisplayModeParametersKHR', 'DisplayModePropertiesKHR',
-- 'DisplayPlaneAlphaFlagBitsKHR', 'DisplayPlaneAlphaFlagsKHR',
-- 'DisplayPlaneCapabilitiesKHR', 'DisplayPlanePropertiesKHR',
-- 'DisplayPropertiesKHR', 'DisplaySurfaceCreateFlagsKHR',
-- 'DisplaySurfaceCreateInfoKHR',
-- 'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagsKHR',
-- 'createDisplayModeKHR', 'createDisplayPlaneSurfaceKHR',
-- 'getDisplayModePropertiesKHR', 'getDisplayPlaneCapabilitiesKHR',
-- 'getDisplayPlaneSupportedDisplaysKHR',
-- 'getPhysicalDeviceDisplayPlanePropertiesKHR',
-- 'getPhysicalDeviceDisplayPropertiesKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_display  ( getPhysicalDeviceDisplayPropertiesKHR
                                         , getPhysicalDeviceDisplayPlanePropertiesKHR
                                         , getDisplayPlaneSupportedDisplaysKHR
                                         , getDisplayModePropertiesKHR
                                         , createDisplayModeKHR
                                         , getDisplayPlaneCapabilitiesKHR
                                         , createDisplayPlaneSurfaceKHR
                                         , DisplayPropertiesKHR(..)
                                         , DisplayPlanePropertiesKHR(..)
                                         , DisplayModeParametersKHR(..)
                                         , DisplayModePropertiesKHR(..)
                                         , DisplayModeCreateInfoKHR(..)
                                         , DisplayPlaneCapabilitiesKHR(..)
                                         , DisplaySurfaceCreateInfoKHR(..)
                                         , DisplayModeCreateFlagsKHR(..)
                                         , DisplaySurfaceCreateFlagsKHR(..)
                                         , DisplayPlaneAlphaFlagsKHR
                                         , DisplayPlaneAlphaFlagBitsKHR( DISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR
                                                                       , DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR
                                                                       , DISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR
                                                                       , DISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR
                                                                       , ..
                                                                       )
                                         , KHR_DISPLAY_SPEC_VERSION
                                         , pattern KHR_DISPLAY_SPEC_VERSION
                                         , KHR_DISPLAY_EXTENSION_NAME
                                         , pattern KHR_DISPLAY_EXTENSION_NAME
                                         , DisplayKHR(..)
                                         , DisplayModeKHR(..)
                                         , SurfaceKHR(..)
                                         , SurfaceTransformFlagBitsKHR(..)
                                         , SurfaceTransformFlagsKHR
                                         ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import Numeric (showHex)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Extensions.Handles (DisplayKHR)
import Vulkan.Extensions.Handles (DisplayKHR(..))
import Vulkan.Extensions.Handles (DisplayModeKHR)
import Vulkan.Extensions.Handles (DisplayModeKHR(..))
import Vulkan.Core10.FundamentalTypes (Extent2D)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Handles (Instance)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Handles (Instance(Instance))
import Vulkan.Dynamic (InstanceCmds(pVkCreateDisplayModeKHR))
import Vulkan.Dynamic (InstanceCmds(pVkCreateDisplayPlaneSurfaceKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetDisplayModePropertiesKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetDisplayPlaneCapabilitiesKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetDisplayPlaneSupportedDisplaysKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceDisplayPlanePropertiesKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceDisplayPropertiesKHR))
import Vulkan.Core10.Handles (Instance_T)
import Vulkan.Core10.FundamentalTypes (Offset2D)
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.Handles (SurfaceKHR)
import Vulkan.Extensions.Handles (SurfaceKHR(..))
import Vulkan.Extensions.VK_KHR_surface (SurfaceTransformFlagBitsKHR)
import Vulkan.Extensions.VK_KHR_surface (SurfaceTransformFlagsKHR)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DISPLAY_MODE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DISPLAY_SURFACE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (DisplayKHR(..))
import Vulkan.Extensions.Handles (DisplayModeKHR(..))
import Vulkan.Extensions.Handles (SurfaceKHR(..))
import Vulkan.Extensions.VK_KHR_surface (SurfaceTransformFlagBitsKHR(..))
import Vulkan.Extensions.VK_KHR_surface (SurfaceTransformFlagsKHR)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceDisplayPropertiesKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr DisplayPropertiesKHR -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr DisplayPropertiesKHR -> IO Result

-- | vkGetPhysicalDeviceDisplayPropertiesKHR - Query information about the
-- available displays
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of display devices available
-- for @physicalDevice@ is returned in @pPropertyCount@. Otherwise,
-- @pPropertyCount@ /must/ point to a variable set by the user to the
-- number of elements in the @pProperties@ array, and on return the
-- variable is overwritten with the number of structures actually written
-- to @pProperties@. If the value of @pPropertyCount@ is less than the
-- number of display devices for @physicalDevice@, at most @pPropertyCount@
-- structures will be written, and 'Vulkan.Core10.Enums.Result.INCOMPLETE'
-- will be returned instead of 'Vulkan.Core10.Enums.Result.SUCCESS', to
-- indicate that not all the available properties were returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPropertiesKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPropertiesKHR-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPropertiesKHR-pProperties-parameter#
--     If the value referenced by @pPropertyCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertyCount@ 'DisplayPropertiesKHR' structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayPropertiesKHR', 'Vulkan.Core10.Handles.PhysicalDevice'
getPhysicalDeviceDisplayPropertiesKHR :: forall io
                                       . (MonadIO io)
                                      => -- | @physicalDevice@ is a physical device.
                                         PhysicalDevice
                                      -> io (Result, ("properties" ::: Vector DisplayPropertiesKHR))
getPhysicalDeviceDisplayPropertiesKHR :: PhysicalDevice
-> io (Result, "properties" ::: Vector DisplayPropertiesKHR)
getPhysicalDeviceDisplayPropertiesKHR PhysicalDevice
physicalDevice = IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> (ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "properties" ::: Vector DisplayPropertiesKHR)
  IO
  (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "properties" ::: Vector DisplayPropertiesKHR)
   IO
   (Result, "properties" ::: Vector DisplayPropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceDisplayPropertiesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPropertiesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
      -> IO Result)
pVkGetPhysicalDeviceDisplayPropertiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPropertiesKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceDisplayPropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceDisplayPropertiesKHR' :: Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPropertiesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO Result
mkVkGetPhysicalDeviceDisplayPropertiesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPropertiesKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPropertyCount" ::: Ptr Word32
pPPropertyCount <- ((("pPropertyCount" ::: Ptr Word32)
  -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPropertyCount" ::: Ptr Word32)
   -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
      IO
      ("pPropertyCount" ::: Ptr Word32))
-> ((("pPropertyCount" ::: Ptr Word32)
     -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPropertyCount" ::: Ptr Word32)
-> (("pPropertyCount" ::: Ptr Word32) -> IO ())
-> (("pPropertyCount" ::: Ptr Word32)
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPropertyCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) ("pPropertyCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceDisplayPropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) ("pProperties" ::: Ptr DisplayPropertiesKHR
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPropertyCount <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr DisplayPropertiesKHR
pPProperties <- ((("pProperties" ::: Ptr DisplayPropertiesKHR)
  -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayPropertiesKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pProperties" ::: Ptr DisplayPropertiesKHR)
   -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
      IO
      ("pProperties" ::: Ptr DisplayPropertiesKHR))
-> ((("pProperties" ::: Ptr DisplayPropertiesKHR)
     -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> (("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO ())
-> (("pProperties" ::: Ptr DisplayPropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pProperties" ::: Ptr DisplayPropertiesKHR)
forall a. Int -> IO (Ptr a)
callocBytes @DisplayPropertiesKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)) ("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ())
-> [Int]
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> ((() -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ())
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr DisplayPropertiesKHR
pPProperties ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayPropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48) :: Ptr DisplayPropertiesKHR) (IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
 -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> (()
    -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> () -> IO (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Result
r' <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceDisplayPropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) (("pProperties" ::: Ptr DisplayPropertiesKHR
pPProperties)))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPropertyCount' <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector DisplayPropertiesKHR
pProperties' <- IO ("properties" ::: Vector DisplayPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("properties" ::: Vector DisplayPropertiesKHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("properties" ::: Vector DisplayPropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
      IO
      ("properties" ::: Vector DisplayPropertiesKHR))
-> IO ("properties" ::: Vector DisplayPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     ("properties" ::: Vector DisplayPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO DisplayPropertiesKHR)
-> IO ("properties" ::: Vector DisplayPropertiesKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO DisplayPropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayPropertiesKHR ((("pProperties" ::: Ptr DisplayPropertiesKHR
pPProperties) ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayPropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DisplayPropertiesKHR)))
  (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "properties" ::: Vector DisplayPropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayPropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayPropertiesKHR))
-> (Result, "properties" ::: Vector DisplayPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector DisplayPropertiesKHR
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceDisplayPlanePropertiesKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr DisplayPlanePropertiesKHR -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr DisplayPlanePropertiesKHR -> IO Result

-- | vkGetPhysicalDeviceDisplayPlanePropertiesKHR - Query the plane
-- properties
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of display planes available
-- for @physicalDevice@ is returned in @pPropertyCount@. Otherwise,
-- @pPropertyCount@ /must/ point to a variable set by the user to the
-- number of elements in the @pProperties@ array, and on return the
-- variable is overwritten with the number of structures actually written
-- to @pProperties@. If the value of @pPropertyCount@ is less than the
-- number of display planes for @physicalDevice@, at most @pPropertyCount@
-- structures will be written.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPlanePropertiesKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPlanePropertiesKHR-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceDisplayPlanePropertiesKHR-pProperties-parameter#
--     If the value referenced by @pPropertyCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertyCount@ 'DisplayPlanePropertiesKHR'
--     structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayPlanePropertiesKHR', 'Vulkan.Core10.Handles.PhysicalDevice'
getPhysicalDeviceDisplayPlanePropertiesKHR :: forall io
                                            . (MonadIO io)
                                           => -- | @physicalDevice@ is a physical device.
                                              PhysicalDevice
                                           -> io (Result, ("properties" ::: Vector DisplayPlanePropertiesKHR))
getPhysicalDeviceDisplayPlanePropertiesKHR :: PhysicalDevice
-> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
getPhysicalDeviceDisplayPlanePropertiesKHR PhysicalDevice
physicalDevice = IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> (ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
  IO
  (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
   IO
   (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceDisplayPlanePropertiesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPlanePropertiesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
      -> IO Result)
pVkGetPhysicalDeviceDisplayPlanePropertiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPlanePropertiesKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceDisplayPlanePropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceDisplayPlanePropertiesKHR' :: Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPlanePropertiesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO Result
mkVkGetPhysicalDeviceDisplayPlanePropertiesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO Result)
vkGetPhysicalDeviceDisplayPlanePropertiesKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPropertyCount" ::: Ptr Word32
pPPropertyCount <- ((("pPropertyCount" ::: Ptr Word32)
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPropertyCount" ::: Ptr Word32)
   -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      ("pPropertyCount" ::: Ptr Word32))
-> ((("pPropertyCount" ::: Ptr Word32)
     -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPropertyCount" ::: Ptr Word32)
-> (("pPropertyCount" ::: Ptr Word32) -> IO ())
-> (("pPropertyCount" ::: Ptr Word32)
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPropertyCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) ("pPropertyCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceDisplayPlanePropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPlanePropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) ("pProperties" ::: Ptr DisplayPlanePropertiesKHR
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPropertyCount <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr DisplayPlanePropertiesKHR
pPProperties <- ((("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
   -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      ("pProperties" ::: Ptr DisplayPlanePropertiesKHR))
-> ((("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
     -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> (("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO ())
-> (("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
forall a. Int -> IO (Ptr a)
callocBytes @DisplayPlanePropertiesKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)) ("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ())
-> [Int]
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> ((()
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
   -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ())
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr DisplayPlanePropertiesKHR
pPProperties ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayPlanePropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) :: Ptr DisplayPlanePropertiesKHR) (IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
 -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> (()
    -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
 -> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> ()
-> IO (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Result
r' <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceDisplayPlanePropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO Result
vkGetPhysicalDeviceDisplayPlanePropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
pPProperties)))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPropertyCount' <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector DisplayPlanePropertiesKHR
pProperties' <- IO ("properties" ::: Vector DisplayPlanePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("properties" ::: Vector DisplayPlanePropertiesKHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("properties" ::: Vector DisplayPlanePropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      ("properties" ::: Vector DisplayPlanePropertiesKHR))
-> IO ("properties" ::: Vector DisplayPlanePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     ("properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO DisplayPlanePropertiesKHR)
-> IO ("properties" ::: Vector DisplayPlanePropertiesKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO DisplayPlanePropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayPlanePropertiesKHR ((("pProperties" ::: Ptr DisplayPlanePropertiesKHR
pPProperties) ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayPlanePropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DisplayPlanePropertiesKHR)))
  (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayPlanePropertiesKHR))
-> (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayPlanePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector DisplayPlanePropertiesKHR
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDisplayPlaneSupportedDisplaysKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Word32 -> Ptr Word32 -> Ptr DisplayKHR -> IO Result) -> Ptr PhysicalDevice_T -> Word32 -> Ptr Word32 -> Ptr DisplayKHR -> IO Result

-- | vkGetDisplayPlaneSupportedDisplaysKHR - Query the list of displays a
-- plane supports
--
-- = Description
--
-- If @pDisplays@ is @NULL@, then the number of displays usable with the
-- specified @planeIndex@ for @physicalDevice@ is returned in
-- @pDisplayCount@. Otherwise, @pDisplayCount@ /must/ point to a variable
-- set by the user to the number of elements in the @pDisplays@ array, and
-- on return the variable is overwritten with the number of handles
-- actually written to @pDisplays@. If the value of @pDisplayCount@ is less
-- than the number of usable display-plane pairs for @physicalDevice@, at
-- most @pDisplayCount@ handles will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available pairs were returned.
--
-- == Valid Usage
--
-- -   #VUID-vkGetDisplayPlaneSupportedDisplaysKHR-planeIndex-01249#
--     @planeIndex@ /must/ be less than the number of display planes
--     supported by the device as determined by calling
--     'getPhysicalDeviceDisplayPlanePropertiesKHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetDisplayPlaneSupportedDisplaysKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetDisplayPlaneSupportedDisplaysKHR-pDisplayCount-parameter#
--     @pDisplayCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetDisplayPlaneSupportedDisplaysKHR-pDisplays-parameter# If
--     the value referenced by @pDisplayCount@ is not @0@, and @pDisplays@
--     is not @NULL@, @pDisplays@ /must/ be a valid pointer to an array of
--     @pDisplayCount@ 'Vulkan.Extensions.Handles.DisplayKHR' handles
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayKHR',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
getDisplayPlaneSupportedDisplaysKHR :: forall io
                                     . (MonadIO io)
                                    => -- | @physicalDevice@ is a physical device.
                                       PhysicalDevice
                                    -> -- | @planeIndex@ is the plane which the application wishes to use, and
                                       -- /must/ be in the range [0, physical device plane count - 1].
                                       ("planeIndex" ::: Word32)
                                    -> io (Result, ("displays" ::: Vector DisplayKHR))
getDisplayPlaneSupportedDisplaysKHR :: PhysicalDevice
-> Word32 -> io (Result, "displays" ::: Vector DisplayKHR)
getDisplayPlaneSupportedDisplaysKHR PhysicalDevice
physicalDevice Word32
planeIndex = IO (Result, "displays" ::: Vector DisplayKHR)
-> io (Result, "displays" ::: Vector DisplayKHR)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "displays" ::: Vector DisplayKHR)
 -> io (Result, "displays" ::: Vector DisplayKHR))
-> (ContT
      (Result, "displays" ::: Vector DisplayKHR)
      IO
      (Result, "displays" ::: Vector DisplayKHR)
    -> IO (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     (Result, "displays" ::: Vector DisplayKHR)
-> io (Result, "displays" ::: Vector DisplayKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "displays" ::: Vector DisplayKHR)
  IO
  (Result, "displays" ::: Vector DisplayKHR)
-> IO (Result, "displays" ::: Vector DisplayKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "displays" ::: Vector DisplayKHR)
   IO
   (Result, "displays" ::: Vector DisplayKHR)
 -> io (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     (Result, "displays" ::: Vector DisplayKHR)
-> io (Result, "displays" ::: Vector DisplayKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDisplayPlaneSupportedDisplaysKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
vkGetDisplayPlaneSupportedDisplaysKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Word32
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pDisplays" ::: Ptr DisplayKHR)
      -> IO Result)
pVkGetDisplayPlaneSupportedDisplaysKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ())
-> IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
vkGetDisplayPlaneSupportedDisplaysKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Word32
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pDisplays" ::: Ptr DisplayKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetDisplayPlaneSupportedDisplaysKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDisplayPlaneSupportedDisplaysKHR' :: Ptr PhysicalDevice_T
-> Word32
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pDisplays" ::: Ptr DisplayKHR)
-> IO Result
vkGetDisplayPlaneSupportedDisplaysKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> Word32
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pDisplays" ::: Ptr DisplayKHR)
-> IO Result
mkVkGetDisplayPlaneSupportedDisplaysKHR FunPtr
  (Ptr PhysicalDevice_T
   -> Word32
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pDisplays" ::: Ptr DisplayKHR)
   -> IO Result)
vkGetDisplayPlaneSupportedDisplaysKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPropertyCount" ::: Ptr Word32
pPDisplayCount <- ((("pPropertyCount" ::: Ptr Word32)
  -> IO (Result, "displays" ::: Vector DisplayKHR))
 -> IO (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPropertyCount" ::: Ptr Word32)
   -> IO (Result, "displays" ::: Vector DisplayKHR))
  -> IO (Result, "displays" ::: Vector DisplayKHR))
 -> ContT
      (Result, "displays" ::: Vector DisplayKHR)
      IO
      ("pPropertyCount" ::: Ptr Word32))
-> ((("pPropertyCount" ::: Ptr Word32)
     -> IO (Result, "displays" ::: Vector DisplayKHR))
    -> IO (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPropertyCount" ::: Ptr Word32)
-> (("pPropertyCount" ::: Ptr Word32) -> IO ())
-> (("pPropertyCount" ::: Ptr Word32)
    -> IO (Result, "displays" ::: Vector DisplayKHR))
-> IO (Result, "displays" ::: Vector DisplayKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPropertyCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) ("pPropertyCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result)
-> IO Result
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDisplayPlaneSupportedDisplaysKHR" (Ptr PhysicalDevice_T
-> Word32
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pDisplays" ::: Ptr DisplayKHR)
-> IO Result
vkGetDisplayPlaneSupportedDisplaysKHR' Ptr PhysicalDevice_T
physicalDevice' (Word32
planeIndex) ("pPropertyCount" ::: Ptr Word32
pPDisplayCount) ("pDisplays" ::: Ptr DisplayKHR
forall a. Ptr a
nullPtr))
  IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ())
-> IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pDisplayCount <- IO Word32
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32)
-> IO Word32
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPDisplayCount
  "pDisplays" ::: Ptr DisplayKHR
pPDisplays <- ((("pDisplays" ::: Ptr DisplayKHR)
  -> IO (Result, "displays" ::: Vector DisplayKHR))
 -> IO (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("pDisplays" ::: Ptr DisplayKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pDisplays" ::: Ptr DisplayKHR)
   -> IO (Result, "displays" ::: Vector DisplayKHR))
  -> IO (Result, "displays" ::: Vector DisplayKHR))
 -> ContT
      (Result, "displays" ::: Vector DisplayKHR)
      IO
      ("pDisplays" ::: Ptr DisplayKHR))
-> ((("pDisplays" ::: Ptr DisplayKHR)
     -> IO (Result, "displays" ::: Vector DisplayKHR))
    -> IO (Result, "displays" ::: Vector DisplayKHR))
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("pDisplays" ::: Ptr DisplayKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pDisplays" ::: Ptr DisplayKHR)
-> (("pDisplays" ::: Ptr DisplayKHR) -> IO ())
-> (("pDisplays" ::: Ptr DisplayKHR)
    -> IO (Result, "displays" ::: Vector DisplayKHR))
-> IO (Result, "displays" ::: Vector DisplayKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pDisplays" ::: Ptr DisplayKHR)
forall a. Int -> IO (Ptr a)
callocBytes @DisplayKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pDisplayCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) ("pDisplays" ::: Ptr DisplayKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result)
-> IO Result
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDisplayPlaneSupportedDisplaysKHR" (Ptr PhysicalDevice_T
-> Word32
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pDisplays" ::: Ptr DisplayKHR)
-> IO Result
vkGetDisplayPlaneSupportedDisplaysKHR' Ptr PhysicalDevice_T
physicalDevice' (Word32
planeIndex) ("pPropertyCount" ::: Ptr Word32
pPDisplayCount) ("pDisplays" ::: Ptr DisplayKHR
pPDisplays))
  IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ())
-> IO () -> ContT (Result, "displays" ::: Vector DisplayKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pDisplayCount' <- IO Word32
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32)
-> IO Word32
-> ContT (Result, "displays" ::: Vector DisplayKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPDisplayCount
  "displays" ::: Vector DisplayKHR
pDisplays' <- IO ("displays" ::: Vector DisplayKHR)
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("displays" ::: Vector DisplayKHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("displays" ::: Vector DisplayKHR)
 -> ContT
      (Result, "displays" ::: Vector DisplayKHR)
      IO
      ("displays" ::: Vector DisplayKHR))
-> IO ("displays" ::: Vector DisplayKHR)
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     ("displays" ::: Vector DisplayKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO DisplayKHR) -> IO ("displays" ::: Vector DisplayKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pDisplayCount')) (\Int
i -> ("pDisplays" ::: Ptr DisplayKHR) -> IO DisplayKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayKHR (("pDisplays" ::: Ptr DisplayKHR
pPDisplays ("pDisplays" ::: Ptr DisplayKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DisplayKHR)))
  (Result, "displays" ::: Vector DisplayKHR)
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     (Result, "displays" ::: Vector DisplayKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "displays" ::: Vector DisplayKHR)
 -> ContT
      (Result, "displays" ::: Vector DisplayKHR)
      IO
      (Result, "displays" ::: Vector DisplayKHR))
-> (Result, "displays" ::: Vector DisplayKHR)
-> ContT
     (Result, "displays" ::: Vector DisplayKHR)
     IO
     (Result, "displays" ::: Vector DisplayKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "displays" ::: Vector DisplayKHR
pDisplays')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDisplayModePropertiesKHR
  :: FunPtr (Ptr PhysicalDevice_T -> DisplayKHR -> Ptr Word32 -> Ptr DisplayModePropertiesKHR -> IO Result) -> Ptr PhysicalDevice_T -> DisplayKHR -> Ptr Word32 -> Ptr DisplayModePropertiesKHR -> IO Result

-- | vkGetDisplayModePropertiesKHR - Query the set of mode properties
-- supported by the display
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of display modes available
-- on the specified @display@ for @physicalDevice@ is returned in
-- @pPropertyCount@. Otherwise, @pPropertyCount@ /must/ point to a variable
-- set by the user to the number of elements in the @pProperties@ array,
-- and on return the variable is overwritten with the number of structures
-- actually written to @pProperties@. If the value of @pPropertyCount@ is
-- less than the number of display modes for @physicalDevice@, at most
-- @pPropertyCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available display modes were returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetDisplayModePropertiesKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetDisplayModePropertiesKHR-display-parameter# @display@
--     /must/ be a valid 'Vulkan.Extensions.Handles.DisplayKHR' handle
--
-- -   #VUID-vkGetDisplayModePropertiesKHR-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetDisplayModePropertiesKHR-pProperties-parameter# If the
--     value referenced by @pPropertyCount@ is not @0@, and @pProperties@
--     is not @NULL@, @pProperties@ /must/ be a valid pointer to an array
--     of @pPropertyCount@ 'DisplayModePropertiesKHR' structures
--
-- -   #VUID-vkGetDisplayModePropertiesKHR-display-parent# @display@ /must/
--     have been created, allocated, or retrieved from @physicalDevice@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayKHR', 'DisplayModePropertiesKHR',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
getDisplayModePropertiesKHR :: forall io
                             . (MonadIO io)
                            => -- | @physicalDevice@ is the physical device associated with @display@.
                               PhysicalDevice
                            -> -- | @display@ is the display to query.
                               DisplayKHR
                            -> io (Result, ("properties" ::: Vector DisplayModePropertiesKHR))
getDisplayModePropertiesKHR :: PhysicalDevice
-> DisplayKHR
-> io (Result, "properties" ::: Vector DisplayModePropertiesKHR)
getDisplayModePropertiesKHR PhysicalDevice
physicalDevice DisplayKHR
display = IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> (ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "properties" ::: Vector DisplayModePropertiesKHR)
  IO
  (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "properties" ::: Vector DisplayModePropertiesKHR)
   IO
   (Result, "properties" ::: Vector DisplayModePropertiesKHR)
 -> io (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> io (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDisplayModePropertiesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
vkGetDisplayModePropertiesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayKHR
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
      -> IO Result)
pVkGetDisplayModePropertiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
vkGetDisplayModePropertiesKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayKHR
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetDisplayModePropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDisplayModePropertiesKHR' :: Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO Result
vkGetDisplayModePropertiesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO Result
mkVkGetDisplayModePropertiesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO Result)
vkGetDisplayModePropertiesKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPropertyCount" ::: Ptr Word32
pPPropertyCount <- ((("pPropertyCount" ::: Ptr Word32)
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPropertyCount" ::: Ptr Word32)
   -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      ("pPropertyCount" ::: Ptr Word32))
-> ((("pPropertyCount" ::: Ptr Word32)
     -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("pPropertyCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPropertyCount" ::: Ptr Word32)
-> (("pPropertyCount" ::: Ptr Word32) -> IO ())
-> (("pPropertyCount" ::: Ptr Word32)
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPropertyCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) ("pPropertyCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDisplayModePropertiesKHR" (Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO Result
vkGetDisplayModePropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' (DisplayKHR
display) ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) ("pProperties" ::: Ptr DisplayModePropertiesKHR
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPropertyCount <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr DisplayModePropertiesKHR
pPProperties <- ((("pProperties" ::: Ptr DisplayModePropertiesKHR)
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayModePropertiesKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pProperties" ::: Ptr DisplayModePropertiesKHR)
   -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      ("pProperties" ::: Ptr DisplayModePropertiesKHR))
-> ((("pProperties" ::: Ptr DisplayModePropertiesKHR)
     -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("pProperties" ::: Ptr DisplayModePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> (("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO ())
-> (("pProperties" ::: Ptr DisplayModePropertiesKHR)
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pProperties" ::: Ptr DisplayModePropertiesKHR)
forall a. Int -> IO (Ptr a)
callocBytes @DisplayModePropertiesKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24)) ("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ())
-> [Int]
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> ((()
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
   -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
  -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ())
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr DisplayModePropertiesKHR
pPProperties ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayModePropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24) :: Ptr DisplayModePropertiesKHR) (IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
 -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ((()
     -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> (()
    -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
 -> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> ()
-> IO (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Result
r' <- IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDisplayModePropertiesKHR" (Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO Result
vkGetDisplayModePropertiesKHR' Ptr PhysicalDevice_T
physicalDevice' (DisplayKHR
display) ("pPropertyCount" ::: Ptr Word32
pPPropertyCount) (("pProperties" ::: Ptr DisplayModePropertiesKHR
pPProperties)))
  IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPropertyCount' <- IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector DisplayModePropertiesKHR
pProperties' <- IO ("properties" ::: Vector DisplayModePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("properties" ::: Vector DisplayModePropertiesKHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("properties" ::: Vector DisplayModePropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      ("properties" ::: Vector DisplayModePropertiesKHR))
-> IO ("properties" ::: Vector DisplayModePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     ("properties" ::: Vector DisplayModePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO DisplayModePropertiesKHR)
-> IO ("properties" ::: Vector DisplayModePropertiesKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO DisplayModePropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayModePropertiesKHR ((("pProperties" ::: Ptr DisplayModePropertiesKHR
pPProperties) ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> "pProperties" ::: Ptr DisplayModePropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DisplayModePropertiesKHR)))
  (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "properties" ::: Vector DisplayModePropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector DisplayModePropertiesKHR)
      IO
      (Result, "properties" ::: Vector DisplayModePropertiesKHR))
-> (Result, "properties" ::: Vector DisplayModePropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
     IO
     (Result, "properties" ::: Vector DisplayModePropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector DisplayModePropertiesKHR
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateDisplayModeKHR
  :: FunPtr (Ptr PhysicalDevice_T -> DisplayKHR -> Ptr DisplayModeCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr DisplayModeKHR -> IO Result) -> Ptr PhysicalDevice_T -> DisplayKHR -> Ptr DisplayModeCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr DisplayModeKHR -> IO Result

-- | vkCreateDisplayModeKHR - Create a display mode
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateDisplayModeKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkCreateDisplayModeKHR-display-parameter# @display@ /must/ be
--     a valid 'Vulkan.Extensions.Handles.DisplayKHR' handle
--
-- -   #VUID-vkCreateDisplayModeKHR-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'DisplayModeCreateInfoKHR'
--     structure
--
-- -   #VUID-vkCreateDisplayModeKHR-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateDisplayModeKHR-pMode-parameter# @pMode@ /must/ be a
--     valid pointer to a 'Vulkan.Extensions.Handles.DisplayModeKHR' handle
--
-- -   #VUID-vkCreateDisplayModeKHR-display-parent# @display@ /must/ have
--     been created, allocated, or retrieved from @physicalDevice@
--
-- == Host Synchronization
--
-- -   Host access to @display@ /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.DisplayKHR', 'DisplayModeCreateInfoKHR',
-- 'Vulkan.Extensions.Handles.DisplayModeKHR',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
createDisplayModeKHR :: forall io
                      . (MonadIO io)
                     => -- | @physicalDevice@ is the physical device associated with @display@.
                        PhysicalDevice
                     -> -- | @display@ is the display to create an additional mode for.
                        DisplayKHR
                     -> -- | @pCreateInfo@ is a pointer to a 'DisplayModeCreateInfoKHR' structure
                        -- describing the new mode to create.
                        DisplayModeCreateInfoKHR
                     -> -- | @pAllocator@ is the allocator used for host memory allocated for the
                        -- display mode object when there is no more specific allocator available
                        -- (see
                        -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>).
                        ("allocator" ::: Maybe AllocationCallbacks)
                     -> io (DisplayModeKHR)
createDisplayModeKHR :: PhysicalDevice
-> DisplayKHR
-> DisplayModeCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DisplayModeKHR
createDisplayModeKHR PhysicalDevice
physicalDevice DisplayKHR
display DisplayModeCreateInfoKHR
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO DisplayModeKHR -> io DisplayModeKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DisplayModeKHR -> io DisplayModeKHR)
-> (ContT DisplayModeKHR IO DisplayModeKHR -> IO DisplayModeKHR)
-> ContT DisplayModeKHR IO DisplayModeKHR
-> io DisplayModeKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT DisplayModeKHR IO DisplayModeKHR -> IO DisplayModeKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT DisplayModeKHR IO DisplayModeKHR -> io DisplayModeKHR)
-> ContT DisplayModeKHR IO DisplayModeKHR -> io DisplayModeKHR
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateDisplayModeKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
vkCreateDisplayModeKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayKHR
      -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pMode" ::: Ptr DisplayModeKHR)
      -> IO Result)
pVkCreateDisplayModeKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO () -> ContT DisplayModeKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DisplayModeKHR IO ())
-> IO () -> ContT DisplayModeKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
vkCreateDisplayModeKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayKHR
      -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pMode" ::: Ptr DisplayModeKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateDisplayModeKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateDisplayModeKHR' :: Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMode" ::: Ptr DisplayModeKHR)
-> IO Result
vkCreateDisplayModeKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMode" ::: Ptr DisplayModeKHR)
-> IO Result
mkVkCreateDisplayModeKHR FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayKHR
   -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMode" ::: Ptr DisplayModeKHR)
   -> IO Result)
vkCreateDisplayModeKHRPtr
  "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
pCreateInfo <- ((("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
  -> IO DisplayModeKHR)
 -> IO DisplayModeKHR)
-> ContT
     DisplayModeKHR IO ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
   -> IO DisplayModeKHR)
  -> IO DisplayModeKHR)
 -> ContT
      DisplayModeKHR IO ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR))
-> ((("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
     -> IO DisplayModeKHR)
    -> IO DisplayModeKHR)
-> ContT
     DisplayModeKHR IO ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
forall a b. (a -> b) -> a -> b
$ DisplayModeCreateInfoKHR
-> (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
    -> IO DisplayModeKHR)
-> IO DisplayModeKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DisplayModeCreateInfoKHR
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     DisplayModeKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO DisplayModeKHR)
 -> IO DisplayModeKHR)
-> ContT
     DisplayModeKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO DisplayModeKHR)
  -> IO DisplayModeKHR)
 -> ContT
      DisplayModeKHR IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO DisplayModeKHR)
    -> IO DisplayModeKHR)
-> ContT
     DisplayModeKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
    -> IO DisplayModeKHR)
-> IO DisplayModeKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pMode" ::: Ptr DisplayModeKHR
pPMode <- ((("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR)
 -> IO DisplayModeKHR)
-> ContT DisplayModeKHR IO ("pMode" ::: Ptr DisplayModeKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR)
  -> IO DisplayModeKHR)
 -> ContT DisplayModeKHR IO ("pMode" ::: Ptr DisplayModeKHR))
-> ((("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR)
    -> IO DisplayModeKHR)
-> ContT DisplayModeKHR IO ("pMode" ::: Ptr DisplayModeKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pMode" ::: Ptr DisplayModeKHR)
-> (("pMode" ::: Ptr DisplayModeKHR) -> IO ())
-> (("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR)
-> IO DisplayModeKHR
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pMode" ::: Ptr DisplayModeKHR)
forall a. Int -> IO (Ptr a)
callocBytes @DisplayModeKHR Int
8) ("pMode" ::: Ptr DisplayModeKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT DisplayModeKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT DisplayModeKHR IO Result)
-> IO Result -> ContT DisplayModeKHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateDisplayModeKHR" (Ptr PhysicalDevice_T
-> DisplayKHR
-> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMode" ::: Ptr DisplayModeKHR)
-> IO Result
vkCreateDisplayModeKHR' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (DisplayKHR
display) "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pMode" ::: Ptr DisplayModeKHR
pPMode))
  IO () -> ContT DisplayModeKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DisplayModeKHR IO ())
-> IO () -> ContT DisplayModeKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  DisplayModeKHR
pMode <- IO DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR)
-> IO DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR
forall a b. (a -> b) -> a -> b
$ ("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayModeKHR "pMode" ::: Ptr DisplayModeKHR
pPMode
  DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR)
-> DisplayModeKHR -> ContT DisplayModeKHR IO DisplayModeKHR
forall a b. (a -> b) -> a -> b
$ (DisplayModeKHR
pMode)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDisplayPlaneCapabilitiesKHR
  :: FunPtr (Ptr PhysicalDevice_T -> DisplayModeKHR -> Word32 -> Ptr DisplayPlaneCapabilitiesKHR -> IO Result) -> Ptr PhysicalDevice_T -> DisplayModeKHR -> Word32 -> Ptr DisplayPlaneCapabilitiesKHR -> IO Result

-- | vkGetDisplayPlaneCapabilitiesKHR - Query capabilities of a mode and
-- plane combination
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetDisplayPlaneCapabilitiesKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetDisplayPlaneCapabilitiesKHR-mode-parameter# @mode@ /must/
--     be a valid 'Vulkan.Extensions.Handles.DisplayModeKHR' handle
--
-- -   #VUID-vkGetDisplayPlaneCapabilitiesKHR-pCapabilities-parameter#
--     @pCapabilities@ /must/ be a valid pointer to a
--     'DisplayPlaneCapabilitiesKHR' structure
--
-- == Host Synchronization
--
-- -   Host access to @mode@ /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayModeKHR',
-- 'DisplayPlaneCapabilitiesKHR', 'Vulkan.Core10.Handles.PhysicalDevice'
getDisplayPlaneCapabilitiesKHR :: forall io
                                . (MonadIO io)
                               => -- | @physicalDevice@ is the physical device associated with the display
                                  -- specified by @mode@
                                  PhysicalDevice
                               -> -- | @mode@ is the display mode the application intends to program when using
                                  -- the specified plane. Note this parameter also implicitly specifies a
                                  -- display.
                                  DisplayModeKHR
                               -> -- | @planeIndex@ is the plane which the application intends to use with the
                                  -- display, and is less than the number of display planes supported by the
                                  -- device.
                                  ("planeIndex" ::: Word32)
                               -> io (DisplayPlaneCapabilitiesKHR)
getDisplayPlaneCapabilitiesKHR :: PhysicalDevice
-> DisplayModeKHR -> Word32 -> io DisplayPlaneCapabilitiesKHR
getDisplayPlaneCapabilitiesKHR PhysicalDevice
physicalDevice DisplayModeKHR
mode Word32
planeIndex = IO DisplayPlaneCapabilitiesKHR -> io DisplayPlaneCapabilitiesKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DisplayPlaneCapabilitiesKHR -> io DisplayPlaneCapabilitiesKHR)
-> (ContT
      DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
    -> IO DisplayPlaneCapabilitiesKHR)
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
-> io DisplayPlaneCapabilitiesKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
-> IO DisplayPlaneCapabilitiesKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
 -> io DisplayPlaneCapabilitiesKHR)
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
-> io DisplayPlaneCapabilitiesKHR
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDisplayPlaneCapabilitiesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
vkGetDisplayPlaneCapabilitiesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayModeKHR
      -> Word32
      -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
      -> IO Result)
pVkGetDisplayPlaneCapabilitiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO () -> ContT DisplayPlaneCapabilitiesKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DisplayPlaneCapabilitiesKHR IO ())
-> IO () -> ContT DisplayPlaneCapabilitiesKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
vkGetDisplayPlaneCapabilitiesKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> DisplayModeKHR
      -> Word32
      -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetDisplayPlaneCapabilitiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDisplayPlaneCapabilitiesKHR' :: Ptr PhysicalDevice_T
-> DisplayModeKHR
-> Word32
-> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO Result
vkGetDisplayPlaneCapabilitiesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> DisplayModeKHR
-> Word32
-> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO Result
mkVkGetDisplayPlaneCapabilitiesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> DisplayModeKHR
   -> Word32
   -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
   -> IO Result)
vkGetDisplayPlaneCapabilitiesKHRPtr
  "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
pPCapabilities <- ((("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
  -> IO DisplayPlaneCapabilitiesKHR)
 -> IO DisplayPlaneCapabilitiesKHR)
-> ContT
     DisplayPlaneCapabilitiesKHR
     IO
     ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct DisplayPlaneCapabilitiesKHR =>
(("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @DisplayPlaneCapabilitiesKHR)
  Result
r <- IO Result -> ContT DisplayPlaneCapabilitiesKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT DisplayPlaneCapabilitiesKHR IO Result)
-> IO Result -> ContT DisplayPlaneCapabilitiesKHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDisplayPlaneCapabilitiesKHR" (Ptr PhysicalDevice_T
-> DisplayModeKHR
-> Word32
-> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO Result
vkGetDisplayPlaneCapabilitiesKHR' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (DisplayModeKHR
mode) (Word32
planeIndex) ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
pPCapabilities))
  IO () -> ContT DisplayPlaneCapabilitiesKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DisplayPlaneCapabilitiesKHR IO ())
-> IO () -> ContT DisplayPlaneCapabilitiesKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  DisplayPlaneCapabilitiesKHR
pCapabilities <- IO DisplayPlaneCapabilitiesKHR
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DisplayPlaneCapabilitiesKHR
 -> ContT
      DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR)
-> IO DisplayPlaneCapabilitiesKHR
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
forall a b. (a -> b) -> a -> b
$ ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO DisplayPlaneCapabilitiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayPlaneCapabilitiesKHR "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
pPCapabilities
  DisplayPlaneCapabilitiesKHR
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayPlaneCapabilitiesKHR
 -> ContT
      DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR)
-> DisplayPlaneCapabilitiesKHR
-> ContT DisplayPlaneCapabilitiesKHR IO DisplayPlaneCapabilitiesKHR
forall a b. (a -> b) -> a -> b
$ (DisplayPlaneCapabilitiesKHR
pCapabilities)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateDisplayPlaneSurfaceKHR
  :: FunPtr (Ptr Instance_T -> Ptr DisplaySurfaceCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr SurfaceKHR -> IO Result) -> Ptr Instance_T -> Ptr DisplaySurfaceCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr SurfaceKHR -> IO Result

-- | vkCreateDisplayPlaneSurfaceKHR - Create a
-- 'Vulkan.Extensions.Handles.SurfaceKHR' structure representing a display
-- plane and mode
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateDisplayPlaneSurfaceKHR-instance-parameter# @instance@
--     /must/ be a valid 'Vulkan.Core10.Handles.Instance' handle
--
-- -   #VUID-vkCreateDisplayPlaneSurfaceKHR-pCreateInfo-parameter#
--     @pCreateInfo@ /must/ be a valid pointer to a valid
--     'DisplaySurfaceCreateInfoKHR' structure
--
-- -   #VUID-vkCreateDisplayPlaneSurfaceKHR-pAllocator-parameter# If
--     @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid pointer
--     to a valid 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks'
--     structure
--
-- -   #VUID-vkCreateDisplayPlaneSurfaceKHR-pSurface-parameter# @pSurface@
--     /must/ be a valid pointer to a
--     'Vulkan.Extensions.Handles.SurfaceKHR' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'DisplaySurfaceCreateInfoKHR', 'Vulkan.Core10.Handles.Instance',
-- 'Vulkan.Extensions.Handles.SurfaceKHR'
createDisplayPlaneSurfaceKHR :: forall io
                              . (MonadIO io)
                             => -- | @instance@ is the instance corresponding to the physical device the
                                -- targeted display is on.
                                Instance
                             -> -- | @pCreateInfo@ is a pointer to a 'DisplaySurfaceCreateInfoKHR' structure
                                -- specifying which mode, plane, and other parameters to use, as described
                                -- below.
                                DisplaySurfaceCreateInfoKHR
                             -> -- | @pAllocator@ is the allocator used for host memory allocated for the
                                -- surface object when there is no more specific allocator available (see
                                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>).
                                ("allocator" ::: Maybe AllocationCallbacks)
                             -> io (SurfaceKHR)
createDisplayPlaneSurfaceKHR :: Instance
-> DisplaySurfaceCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io SurfaceKHR
createDisplayPlaneSurfaceKHR Instance
instance' DisplaySurfaceCreateInfoKHR
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO SurfaceKHR -> io SurfaceKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SurfaceKHR -> io SurfaceKHR)
-> (ContT SurfaceKHR IO SurfaceKHR -> IO SurfaceKHR)
-> ContT SurfaceKHR IO SurfaceKHR
-> io SurfaceKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT SurfaceKHR IO SurfaceKHR -> IO SurfaceKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT SurfaceKHR IO SurfaceKHR -> io SurfaceKHR)
-> ContT SurfaceKHR IO SurfaceKHR -> io SurfaceKHR
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateDisplayPlaneSurfaceKHRPtr :: FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
vkCreateDisplayPlaneSurfaceKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pSurface" ::: Ptr SurfaceKHR)
      -> IO Result)
pVkCreateDisplayPlaneSurfaceKHR (case Instance
instance' of Instance{InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO () -> ContT SurfaceKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT SurfaceKHR IO ())
-> IO () -> ContT SurfaceKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
vkCreateDisplayPlaneSurfaceKHRPtr FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pSurface" ::: Ptr SurfaceKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateDisplayPlaneSurfaceKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateDisplayPlaneSurfaceKHR' :: Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSurface" ::: Ptr SurfaceKHR)
-> IO Result
vkCreateDisplayPlaneSurfaceKHR' = FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
-> Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSurface" ::: Ptr SurfaceKHR)
-> IO Result
mkVkCreateDisplayPlaneSurfaceKHR FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSurface" ::: Ptr SurfaceKHR)
   -> IO Result)
vkCreateDisplayPlaneSurfaceKHRPtr
  "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
pCreateInfo <- ((("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
  -> IO SurfaceKHR)
 -> IO SurfaceKHR)
-> ContT
     SurfaceKHR IO ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
   -> IO SurfaceKHR)
  -> IO SurfaceKHR)
 -> ContT
      SurfaceKHR IO ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR))
-> ((("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
     -> IO SurfaceKHR)
    -> IO SurfaceKHR)
-> ContT
     SurfaceKHR IO ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
forall a b. (a -> b) -> a -> b
$ DisplaySurfaceCreateInfoKHR
-> (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
    -> IO SurfaceKHR)
-> IO SurfaceKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DisplaySurfaceCreateInfoKHR
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT SurfaceKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO SurfaceKHR)
 -> IO SurfaceKHR)
-> ContT SurfaceKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO SurfaceKHR)
  -> IO SurfaceKHR)
 -> ContT SurfaceKHR IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO SurfaceKHR)
    -> IO SurfaceKHR)
-> ContT SurfaceKHR IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO SurfaceKHR)
-> IO SurfaceKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pSurface" ::: Ptr SurfaceKHR
pPSurface <- ((("pSurface" ::: Ptr SurfaceKHR) -> IO SurfaceKHR)
 -> IO SurfaceKHR)
-> ContT SurfaceKHR IO ("pSurface" ::: Ptr SurfaceKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSurface" ::: Ptr SurfaceKHR) -> IO SurfaceKHR)
  -> IO SurfaceKHR)
 -> ContT SurfaceKHR IO ("pSurface" ::: Ptr SurfaceKHR))
-> ((("pSurface" ::: Ptr SurfaceKHR) -> IO SurfaceKHR)
    -> IO SurfaceKHR)
-> ContT SurfaceKHR IO ("pSurface" ::: Ptr SurfaceKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pSurface" ::: Ptr SurfaceKHR)
-> (("pSurface" ::: Ptr SurfaceKHR) -> IO ())
-> (("pSurface" ::: Ptr SurfaceKHR) -> IO SurfaceKHR)
-> IO SurfaceKHR
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pSurface" ::: Ptr SurfaceKHR)
forall a. Int -> IO (Ptr a)
callocBytes @SurfaceKHR Int
8) ("pSurface" ::: Ptr SurfaceKHR) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT SurfaceKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT SurfaceKHR IO Result)
-> IO Result -> ContT SurfaceKHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateDisplayPlaneSurfaceKHR" (Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSurface" ::: Ptr SurfaceKHR)
-> IO Result
vkCreateDisplayPlaneSurfaceKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pSurface" ::: Ptr SurfaceKHR
pPSurface))
  IO () -> ContT SurfaceKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT SurfaceKHR IO ())
-> IO () -> ContT SurfaceKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  SurfaceKHR
pSurface <- IO SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR)
-> IO SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR
forall a b. (a -> b) -> a -> b
$ ("pSurface" ::: Ptr SurfaceKHR) -> IO SurfaceKHR
forall a. Storable a => Ptr a -> IO a
peek @SurfaceKHR "pSurface" ::: Ptr SurfaceKHR
pPSurface
  SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR)
-> SurfaceKHR -> ContT SurfaceKHR IO SurfaceKHR
forall a b. (a -> b) -> a -> b
$ (SurfaceKHR
pSurface)


-- | VkDisplayPropertiesKHR - Structure describing an available display
-- device
--
-- = Description
--
-- Note
--
-- For devices which have no natural value to return here, implementations
-- /should/ return the maximum resolution supported.
--
-- Note
--
-- Persistent presents /may/ have higher latency, and /may/ use less power
-- when the screen content is updated infrequently, or when only a portion
-- of the screen needs to be updated in most frames.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Extensions.Handles.DisplayKHR',
-- 'Vulkan.Extensions.VK_KHR_get_display_properties2.DisplayProperties2KHR',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagsKHR',
-- 'getPhysicalDeviceDisplayPropertiesKHR'
data DisplayPropertiesKHR = DisplayPropertiesKHR
  { -- | @display@ is a handle that is used to refer to the display described
    -- here. This handle will be valid for the lifetime of the Vulkan instance.
    DisplayPropertiesKHR -> DisplayKHR
display :: DisplayKHR
  , -- | @displayName@ is @NULL@ or a pointer to a null-terminated UTF-8 string
    -- containing the name of the display. Generally, this will be the name
    -- provided by the display’s EDID. If @NULL@, no suitable name is
    -- available. If not @NULL@, the string pointed to /must/ remain accessible
    -- and unmodified as long as @display@ is valid.
    DisplayPropertiesKHR -> ByteString
displayName :: ByteString
  , -- | @physicalDimensions@ describes the physical width and height of the
    -- visible portion of the display, in millimeters.
    DisplayPropertiesKHR -> Extent2D
physicalDimensions :: Extent2D
  , -- | @physicalResolution@ describes the physical, native, or preferred
    -- resolution of the display.
    DisplayPropertiesKHR -> Extent2D
physicalResolution :: Extent2D
  , -- | @supportedTransforms@ is a bitmask of
    -- 'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagBitsKHR'
    -- describing which transforms are supported by this display.
    DisplayPropertiesKHR -> SurfaceTransformFlagsKHR
supportedTransforms :: SurfaceTransformFlagsKHR
  , -- | @planeReorderPossible@ tells whether the planes on this display /can/
    -- have their z order changed. If this is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE', the application /can/ re-arrange
    -- the planes on this display in any order relative to each other.
    DisplayPropertiesKHR -> Bool
planeReorderPossible :: Bool
  , -- | @persistentContent@ tells whether the display supports
    -- self-refresh\/internal buffering. If this is true, the application /can/
    -- submit persistent present operations on swapchains created against this
    -- display.
    DisplayPropertiesKHR -> Bool
persistentContent :: Bool
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayPropertiesKHR)
#endif
deriving instance Show DisplayPropertiesKHR

instance ToCStruct DisplayPropertiesKHR where
  withCStruct :: DisplayPropertiesKHR
-> (("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b) -> IO b
withCStruct DisplayPropertiesKHR
x ("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b
f = Int
-> (("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b) -> IO b)
-> (("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr DisplayPropertiesKHR
p -> ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> DisplayPropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayPropertiesKHR
p DisplayPropertiesKHR
x (("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b
f "pProperties" ::: Ptr DisplayPropertiesKHR
p)
  pokeCStruct :: ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> DisplayPropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayPropertiesKHR
p DisplayPropertiesKHR{Bool
ByteString
Extent2D
DisplayKHR
SurfaceTransformFlagsKHR
persistentContent :: Bool
planeReorderPossible :: Bool
supportedTransforms :: SurfaceTransformFlagsKHR
physicalResolution :: Extent2D
physicalDimensions :: Extent2D
displayName :: ByteString
display :: DisplayKHR
$sel:persistentContent:DisplayPropertiesKHR :: DisplayPropertiesKHR -> Bool
$sel:planeReorderPossible:DisplayPropertiesKHR :: DisplayPropertiesKHR -> Bool
$sel:supportedTransforms:DisplayPropertiesKHR :: DisplayPropertiesKHR -> SurfaceTransformFlagsKHR
$sel:physicalResolution:DisplayPropertiesKHR :: DisplayPropertiesKHR -> Extent2D
$sel:physicalDimensions:DisplayPropertiesKHR :: DisplayPropertiesKHR -> Extent2D
$sel:displayName:DisplayPropertiesKHR :: DisplayPropertiesKHR -> ByteString
$sel:display:DisplayPropertiesKHR :: DisplayPropertiesKHR -> DisplayKHR
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pDisplays" ::: Ptr DisplayKHR) -> DisplayKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR)) (DisplayKHR
display)
    CString
displayName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
displayName)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr CChar))) CString
displayName''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent2D)) (Extent2D
physicalDimensions)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent2D)) (Extent2D
physicalResolution)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceTransformFlagsKHR -> SurfaceTransformFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> Ptr SurfaceTransformFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SurfaceTransformFlagsKHR)) (SurfaceTransformFlagsKHR
supportedTransforms)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
planeReorderPossible))
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
persistentContent))
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pProperties" ::: Ptr DisplayPropertiesKHR) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr DisplayPropertiesKHR
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pDisplays" ::: Ptr DisplayKHR) -> DisplayKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR)) (DisplayKHR
forall a. Zero a => a
zero)
    CString
displayName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr CChar))) CString
displayName''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct DisplayPropertiesKHR where
  peekCStruct :: ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> IO DisplayPropertiesKHR
peekCStruct "pProperties" ::: Ptr DisplayPropertiesKHR
p = do
    DisplayKHR
display <- ("pDisplays" ::: Ptr DisplayKHR) -> IO DisplayKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayKHR (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR))
    ByteString
displayName <- CString -> IO ByteString
packCString (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr CChar)))
    Extent2D
physicalDimensions <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent2D))
    Extent2D
physicalResolution <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent2D))
    SurfaceTransformFlagsKHR
supportedTransforms <- Ptr SurfaceTransformFlagsKHR -> IO SurfaceTransformFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @SurfaceTransformFlagsKHR (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR)
-> Int -> Ptr SurfaceTransformFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SurfaceTransformFlagsKHR))
    Bool32
planeReorderPossible <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32))
    Bool32
persistentContent <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pProperties" ::: Ptr DisplayPropertiesKHR
p ("pProperties" ::: Ptr DisplayPropertiesKHR) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32))
    DisplayPropertiesKHR -> IO DisplayPropertiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayPropertiesKHR -> IO DisplayPropertiesKHR)
-> DisplayPropertiesKHR -> IO DisplayPropertiesKHR
forall a b. (a -> b) -> a -> b
$ DisplayKHR
-> ByteString
-> Extent2D
-> Extent2D
-> SurfaceTransformFlagsKHR
-> Bool
-> Bool
-> DisplayPropertiesKHR
DisplayPropertiesKHR
             DisplayKHR
display ByteString
displayName Extent2D
physicalDimensions Extent2D
physicalResolution SurfaceTransformFlagsKHR
supportedTransforms (Bool32 -> Bool
bool32ToBool Bool32
planeReorderPossible) (Bool32 -> Bool
bool32ToBool Bool32
persistentContent)

instance Zero DisplayPropertiesKHR where
  zero :: DisplayPropertiesKHR
zero = DisplayKHR
-> ByteString
-> Extent2D
-> Extent2D
-> SurfaceTransformFlagsKHR
-> Bool
-> Bool
-> DisplayPropertiesKHR
DisplayPropertiesKHR
           DisplayKHR
forall a. Zero a => a
zero
           ByteString
forall a. Monoid a => a
mempty
           Extent2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           SurfaceTransformFlagsKHR
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkDisplayPlanePropertiesKHR - Structure describing display plane
-- properties
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayKHR',
-- 'Vulkan.Extensions.VK_KHR_get_display_properties2.DisplayPlaneProperties2KHR',
-- 'getPhysicalDeviceDisplayPlanePropertiesKHR'
data DisplayPlanePropertiesKHR = DisplayPlanePropertiesKHR
  { -- | @currentDisplay@ is the handle of the display the plane is currently
    -- associated with. If the plane is not currently attached to any displays,
    -- this will be 'Vulkan.Core10.APIConstants.NULL_HANDLE'.
    DisplayPlanePropertiesKHR -> DisplayKHR
currentDisplay :: DisplayKHR
  , -- | @currentStackIndex@ is the current z-order of the plane. This will be
    -- between 0 and the value returned by
    -- 'getPhysicalDeviceDisplayPlanePropertiesKHR' in @pPropertyCount@.
    DisplayPlanePropertiesKHR -> Word32
currentStackIndex :: Word32
  }
  deriving (Typeable, DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool
(DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool)
-> (DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool)
-> Eq DisplayPlanePropertiesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool
$c/= :: DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool
== :: DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool
$c== :: DisplayPlanePropertiesKHR -> DisplayPlanePropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayPlanePropertiesKHR)
#endif
deriving instance Show DisplayPlanePropertiesKHR

instance ToCStruct DisplayPlanePropertiesKHR where
  withCStruct :: DisplayPlanePropertiesKHR
-> (("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b)
-> IO b
withCStruct DisplayPlanePropertiesKHR
x ("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b
f = Int
-> (("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b)
 -> IO b)
-> (("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr DisplayPlanePropertiesKHR
p -> ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> DisplayPlanePropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayPlanePropertiesKHR
p DisplayPlanePropertiesKHR
x (("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b
f "pProperties" ::: Ptr DisplayPlanePropertiesKHR
p)
  pokeCStruct :: ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> DisplayPlanePropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayPlanePropertiesKHR
p DisplayPlanePropertiesKHR{Word32
DisplayKHR
currentStackIndex :: Word32
currentDisplay :: DisplayKHR
$sel:currentStackIndex:DisplayPlanePropertiesKHR :: DisplayPlanePropertiesKHR -> Word32
$sel:currentDisplay:DisplayPlanePropertiesKHR :: DisplayPlanePropertiesKHR -> DisplayKHR
..} IO b
f = do
    ("pDisplays" ::: Ptr DisplayKHR) -> DisplayKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR)) (DisplayKHR
currentDisplay)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
currentStackIndex)
    IO b
f
  cStructSize :: Int
cStructSize = Int
16
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pProperties" ::: Ptr DisplayPlanePropertiesKHR) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr DisplayPlanePropertiesKHR
p IO b
f = do
    ("pDisplays" ::: Ptr DisplayKHR) -> DisplayKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR)) (DisplayKHR
forall a. Zero a => a
zero)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplayPlanePropertiesKHR where
  peekCStruct :: ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> IO DisplayPlanePropertiesKHR
peekCStruct "pProperties" ::: Ptr DisplayPlanePropertiesKHR
p = do
    DisplayKHR
currentDisplay <- ("pDisplays" ::: Ptr DisplayKHR) -> IO DisplayKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayKHR (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pDisplays" ::: Ptr DisplayKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayKHR))
    Word32
currentStackIndex <- ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr DisplayPlanePropertiesKHR
p ("pProperties" ::: Ptr DisplayPlanePropertiesKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    DisplayPlanePropertiesKHR -> IO DisplayPlanePropertiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayPlanePropertiesKHR -> IO DisplayPlanePropertiesKHR)
-> DisplayPlanePropertiesKHR -> IO DisplayPlanePropertiesKHR
forall a b. (a -> b) -> a -> b
$ DisplayKHR -> Word32 -> DisplayPlanePropertiesKHR
DisplayPlanePropertiesKHR
             DisplayKHR
currentDisplay Word32
currentStackIndex

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

instance Zero DisplayPlanePropertiesKHR where
  zero :: DisplayPlanePropertiesKHR
zero = DisplayKHR -> Word32 -> DisplayPlanePropertiesKHR
DisplayPlanePropertiesKHR
           DisplayKHR
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkDisplayModeParametersKHR - Structure describing display parameters
-- associated with a display mode
--
-- = Description
--
-- Note
--
-- For example, a 60Hz display mode would report a @refreshRate@ of 60,000.
--
-- == Valid Usage
--
-- -   #VUID-VkDisplayModeParametersKHR-width-01990# The @width@ member of
--     @visibleRegion@ /must/ be greater than @0@
--
-- -   #VUID-VkDisplayModeParametersKHR-height-01991# The @height@ member
--     of @visibleRegion@ /must/ be greater than @0@
--
-- -   #VUID-VkDisplayModeParametersKHR-refreshRate-01992# @refreshRate@
--     /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayModeCreateInfoKHR', 'DisplayModePropertiesKHR',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D'
data DisplayModeParametersKHR = DisplayModeParametersKHR
  { -- | @visibleRegion@ is the 2D extents of the visible region.
    DisplayModeParametersKHR -> Extent2D
visibleRegion :: Extent2D
  , -- | @refreshRate@ is a @uint32_t@ that is the number of times the display is
    -- refreshed each second multiplied by 1000.
    DisplayModeParametersKHR -> Word32
refreshRate :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayModeParametersKHR)
#endif
deriving instance Show DisplayModeParametersKHR

instance ToCStruct DisplayModeParametersKHR where
  withCStruct :: DisplayModeParametersKHR
-> (Ptr DisplayModeParametersKHR -> IO b) -> IO b
withCStruct DisplayModeParametersKHR
x Ptr DisplayModeParametersKHR -> IO b
f = Int -> (Ptr DisplayModeParametersKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 ((Ptr DisplayModeParametersKHR -> IO b) -> IO b)
-> (Ptr DisplayModeParametersKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr DisplayModeParametersKHR
p -> Ptr DisplayModeParametersKHR
-> DisplayModeParametersKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DisplayModeParametersKHR
p DisplayModeParametersKHR
x (Ptr DisplayModeParametersKHR -> IO b
f Ptr DisplayModeParametersKHR
p)
  pokeCStruct :: Ptr DisplayModeParametersKHR
-> DisplayModeParametersKHR -> IO b -> IO b
pokeCStruct Ptr DisplayModeParametersKHR
p DisplayModeParametersKHR{Word32
Extent2D
refreshRate :: Word32
visibleRegion :: Extent2D
$sel:refreshRate:DisplayModeParametersKHR :: DisplayModeParametersKHR -> Word32
$sel:visibleRegion:DisplayModeParametersKHR :: DisplayModeParametersKHR -> Extent2D
..} IO b
f = do
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent2D)) (Extent2D
visibleRegion)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
refreshRate)
    IO b
f
  cStructSize :: Int
cStructSize = Int
12
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: Ptr DisplayModeParametersKHR -> IO b -> IO b
pokeZeroCStruct Ptr DisplayModeParametersKHR
p IO b
f = do
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplayModeParametersKHR where
  peekCStruct :: Ptr DisplayModeParametersKHR -> IO DisplayModeParametersKHR
peekCStruct Ptr DisplayModeParametersKHR
p = do
    Extent2D
visibleRegion <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent2D))
    Word32
refreshRate <- ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DisplayModeParametersKHR
p Ptr DisplayModeParametersKHR
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    DisplayModeParametersKHR -> IO DisplayModeParametersKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayModeParametersKHR -> IO DisplayModeParametersKHR)
-> DisplayModeParametersKHR -> IO DisplayModeParametersKHR
forall a b. (a -> b) -> a -> b
$ Extent2D -> Word32 -> DisplayModeParametersKHR
DisplayModeParametersKHR
             Extent2D
visibleRegion Word32
refreshRate

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

instance Zero DisplayModeParametersKHR where
  zero :: DisplayModeParametersKHR
zero = Extent2D -> Word32 -> DisplayModeParametersKHR
DisplayModeParametersKHR
           Extent2D
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkDisplayModePropertiesKHR - Structure describing display mode
-- properties
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayModeKHR', 'DisplayModeParametersKHR',
-- 'Vulkan.Extensions.VK_KHR_get_display_properties2.DisplayModeProperties2KHR',
-- 'getDisplayModePropertiesKHR'
data DisplayModePropertiesKHR = DisplayModePropertiesKHR
  { -- | @displayMode@ is a handle to the display mode described in this
    -- structure. This handle will be valid for the lifetime of the Vulkan
    -- instance.
    DisplayModePropertiesKHR -> DisplayModeKHR
displayMode :: DisplayModeKHR
  , -- | @parameters@ is a 'DisplayModeParametersKHR' structure describing the
    -- display parameters associated with @displayMode@.
    DisplayModePropertiesKHR -> DisplayModeParametersKHR
parameters :: DisplayModeParametersKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayModePropertiesKHR)
#endif
deriving instance Show DisplayModePropertiesKHR

instance ToCStruct DisplayModePropertiesKHR where
  withCStruct :: DisplayModePropertiesKHR
-> (("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b)
-> IO b
withCStruct DisplayModePropertiesKHR
x ("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b
f = Int
-> (("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b)
 -> IO b)
-> (("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr DisplayModePropertiesKHR
p -> ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> DisplayModePropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayModePropertiesKHR
p DisplayModePropertiesKHR
x (("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b
f "pProperties" ::: Ptr DisplayModePropertiesKHR
p)
  pokeCStruct :: ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> DisplayModePropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr DisplayModePropertiesKHR
p DisplayModePropertiesKHR{DisplayModeKHR
DisplayModeParametersKHR
parameters :: DisplayModeParametersKHR
displayMode :: DisplayModeKHR
$sel:parameters:DisplayModePropertiesKHR :: DisplayModePropertiesKHR -> DisplayModeParametersKHR
$sel:displayMode:DisplayModePropertiesKHR :: DisplayModePropertiesKHR -> DisplayModeKHR
..} IO b
f = do
    ("pMode" ::: Ptr DisplayModeKHR) -> DisplayModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayModeKHR)) (DisplayModeKHR
displayMode)
    Ptr DisplayModeParametersKHR -> DisplayModeParametersKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DisplayModeParametersKHR)) (DisplayModeParametersKHR
parameters)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pProperties" ::: Ptr DisplayModePropertiesKHR) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr DisplayModePropertiesKHR
p IO b
f = do
    ("pMode" ::: Ptr DisplayModeKHR) -> DisplayModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayModeKHR)) (DisplayModeKHR
forall a. Zero a => a
zero)
    Ptr DisplayModeParametersKHR -> DisplayModeParametersKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DisplayModeParametersKHR)) (DisplayModeParametersKHR
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplayModePropertiesKHR where
  peekCStruct :: ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> IO DisplayModePropertiesKHR
peekCStruct "pProperties" ::: Ptr DisplayModePropertiesKHR
p = do
    DisplayModeKHR
displayMode <- ("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayModeKHR (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayModeKHR))
    DisplayModeParametersKHR
parameters <- Ptr DisplayModeParametersKHR -> IO DisplayModeParametersKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayModeParametersKHR (("pProperties" ::: Ptr DisplayModePropertiesKHR
p ("pProperties" ::: Ptr DisplayModePropertiesKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DisplayModeParametersKHR))
    DisplayModePropertiesKHR -> IO DisplayModePropertiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayModePropertiesKHR -> IO DisplayModePropertiesKHR)
-> DisplayModePropertiesKHR -> IO DisplayModePropertiesKHR
forall a b. (a -> b) -> a -> b
$ DisplayModeKHR
-> DisplayModeParametersKHR -> DisplayModePropertiesKHR
DisplayModePropertiesKHR
             DisplayModeKHR
displayMode DisplayModeParametersKHR
parameters

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

instance Zero DisplayModePropertiesKHR where
  zero :: DisplayModePropertiesKHR
zero = DisplayModeKHR
-> DisplayModeParametersKHR -> DisplayModePropertiesKHR
DisplayModePropertiesKHR
           DisplayModeKHR
forall a. Zero a => a
zero
           DisplayModeParametersKHR
forall a. Zero a => a
zero


-- | VkDisplayModeCreateInfoKHR - Structure specifying parameters of a newly
-- created display mode object
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayModeCreateFlagsKHR', 'DisplayModeParametersKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'createDisplayModeKHR'
data DisplayModeCreateInfoKHR = DisplayModeCreateInfoKHR
  { -- | @flags@ is reserved for future use, and /must/ be zero.
    --
    -- #VUID-VkDisplayModeCreateInfoKHR-flags-zerobitmask# @flags@ /must/ be
    -- @0@
    DisplayModeCreateInfoKHR -> DisplayModeCreateFlagsKHR
flags :: DisplayModeCreateFlagsKHR
  , -- | @parameters@ is a 'DisplayModeParametersKHR' structure describing the
    -- display parameters to use in creating the new mode. If the parameters
    -- are not compatible with the specified display, the implementation /must/
    -- return 'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'.
    --
    -- #VUID-VkDisplayModeCreateInfoKHR-parameters-parameter# @parameters@
    -- /must/ be a valid 'DisplayModeParametersKHR' structure
    DisplayModeCreateInfoKHR -> DisplayModeParametersKHR
parameters :: DisplayModeParametersKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayModeCreateInfoKHR)
#endif
deriving instance Show DisplayModeCreateInfoKHR

instance ToCStruct DisplayModeCreateInfoKHR where
  withCStruct :: DisplayModeCreateInfoKHR
-> (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b)
-> IO b
withCStruct DisplayModeCreateInfoKHR
x ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b
f = Int
-> (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b)
 -> IO b)
-> (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p -> ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> DisplayModeCreateInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p DisplayModeCreateInfoKHR
x (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b
f "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p)
  pokeCStruct :: ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> DisplayModeCreateInfoKHR -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p DisplayModeCreateInfoKHR{DisplayModeParametersKHR
DisplayModeCreateFlagsKHR
parameters :: DisplayModeParametersKHR
flags :: DisplayModeCreateFlagsKHR
$sel:parameters:DisplayModeCreateInfoKHR :: DisplayModeCreateInfoKHR -> DisplayModeParametersKHR
$sel:flags:DisplayModeCreateInfoKHR :: DisplayModeCreateInfoKHR -> DisplayModeCreateFlagsKHR
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DISPLAY_MODE_CREATE_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr DisplayModeCreateFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DisplayModeCreateFlagsKHR)) (DisplayModeCreateFlagsKHR
flags)
    Ptr DisplayModeParametersKHR -> DisplayModeParametersKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DisplayModeParametersKHR)) (DisplayModeParametersKHR
parameters)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DISPLAY_MODE_CREATE_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DisplayModeParametersKHR -> DisplayModeParametersKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DisplayModeParametersKHR)) (DisplayModeParametersKHR
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplayModeCreateInfoKHR where
  peekCStruct :: ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> IO DisplayModeCreateInfoKHR
peekCStruct "pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p = do
    DisplayModeCreateFlagsKHR
flags <- Ptr DisplayModeCreateFlagsKHR -> IO DisplayModeCreateFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayModeCreateFlagsKHR (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr DisplayModeCreateFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DisplayModeCreateFlagsKHR))
    DisplayModeParametersKHR
parameters <- Ptr DisplayModeParametersKHR -> IO DisplayModeParametersKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DisplayModeParametersKHR (("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplayModeCreateInfoKHR)
-> Int -> Ptr DisplayModeParametersKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DisplayModeParametersKHR))
    DisplayModeCreateInfoKHR -> IO DisplayModeCreateInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayModeCreateInfoKHR -> IO DisplayModeCreateInfoKHR)
-> DisplayModeCreateInfoKHR -> IO DisplayModeCreateInfoKHR
forall a b. (a -> b) -> a -> b
$ DisplayModeCreateFlagsKHR
-> DisplayModeParametersKHR -> DisplayModeCreateInfoKHR
DisplayModeCreateInfoKHR
             DisplayModeCreateFlagsKHR
flags DisplayModeParametersKHR
parameters

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

instance Zero DisplayModeCreateInfoKHR where
  zero :: DisplayModeCreateInfoKHR
zero = DisplayModeCreateFlagsKHR
-> DisplayModeParametersKHR -> DisplayModeCreateInfoKHR
DisplayModeCreateInfoKHR
           DisplayModeCreateFlagsKHR
forall a. Zero a => a
zero
           DisplayModeParametersKHR
forall a. Zero a => a
zero


-- | VkDisplayPlaneCapabilitiesKHR - Structure describing capabilities of a
-- mode and plane combination
--
-- = Description
--
-- The minimum and maximum position and extent fields describe the
-- implementation limits, if any, as they apply to the specified display
-- mode and plane. Vendors /may/ support displaying a subset of a
-- swapchain’s presentable images on the specified display plane. This is
-- expressed by returning @minSrcPosition@, @maxSrcPosition@,
-- @minSrcExtent@, and @maxSrcExtent@ values that indicate a range of
-- possible positions and sizes which /may/ be used to specify the region
-- within the presentable images that source pixels will be read from when
-- creating a swapchain on the specified display mode and plane.
--
-- Vendors /may/ also support mapping the presentable images’ content to a
-- subset or superset of the visible region in the specified display mode.
-- This is expressed by returning @minDstPosition@, @maxDstPosition@,
-- @minDstExtent@ and @maxDstExtent@ values that indicate a range of
-- possible positions and sizes which /may/ be used to describe the region
-- within the display mode that the source pixels will be mapped to.
--
-- Other vendors /may/ support only a 1-1 mapping between pixels in the
-- presentable images and the display mode. This /may/ be indicated by
-- returning (0,0) for @minSrcPosition@, @maxSrcPosition@,
-- @minDstPosition@, and @maxDstPosition@, and (display mode width, display
-- mode height) for @minSrcExtent@, @maxSrcExtent@, @minDstExtent@, and
-- @maxDstExtent@.
--
-- The value @supportedAlpha@ /must/ contain at least one valid
-- 'DisplayPlaneAlphaFlagBitsKHR' bit.
--
-- These values indicate the limits of the implementation’s individual
-- fields. Not all combinations of values within the offset and extent
-- ranges returned in 'DisplayPlaneCapabilitiesKHR' are guaranteed to be
-- supported. Presentation requests specifying unsupported combinations
-- /may/ fail.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayPlaneAlphaFlagsKHR',
-- 'Vulkan.Extensions.VK_KHR_get_display_properties2.DisplayPlaneCapabilities2KHR',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.FundamentalTypes.Offset2D',
-- 'getDisplayPlaneCapabilitiesKHR'
data DisplayPlaneCapabilitiesKHR = DisplayPlaneCapabilitiesKHR
  { -- | @supportedAlpha@ is a bitmask of 'DisplayPlaneAlphaFlagBitsKHR'
    -- describing the supported alpha blending modes.
    DisplayPlaneCapabilitiesKHR -> DisplayPlaneAlphaFlagsKHR
supportedAlpha :: DisplayPlaneAlphaFlagsKHR
  , -- | @minSrcPosition@ is the minimum source rectangle offset supported by
    -- this plane using the specified mode.
    DisplayPlaneCapabilitiesKHR -> Offset2D
minSrcPosition :: Offset2D
  , -- | @maxSrcPosition@ is the maximum source rectangle offset supported by
    -- this plane using the specified mode. The @x@ and @y@ components of
    -- @maxSrcPosition@ /must/ each be greater than or equal to the @x@ and @y@
    -- components of @minSrcPosition@, respectively.
    DisplayPlaneCapabilitiesKHR -> Offset2D
maxSrcPosition :: Offset2D
  , -- | @minSrcExtent@ is the minimum source rectangle size supported by this
    -- plane using the specified mode.
    DisplayPlaneCapabilitiesKHR -> Extent2D
minSrcExtent :: Extent2D
  , -- | @maxSrcExtent@ is the maximum source rectangle size supported by this
    -- plane using the specified mode.
    DisplayPlaneCapabilitiesKHR -> Extent2D
maxSrcExtent :: Extent2D
  , -- | @minDstPosition@, @maxDstPosition@, @minDstExtent@, @maxDstExtent@ all
    -- have similar semantics to their corresponding @*Src*@ equivalents, but
    -- apply to the output region within the mode rather than the input region
    -- within the source image. Unlike the @*Src*@ offsets, @minDstPosition@
    -- and @maxDstPosition@ /may/ contain negative values.
    DisplayPlaneCapabilitiesKHR -> Offset2D
minDstPosition :: Offset2D
  , -- No documentation found for Nested "VkDisplayPlaneCapabilitiesKHR" "maxDstPosition"
    DisplayPlaneCapabilitiesKHR -> Offset2D
maxDstPosition :: Offset2D
  , -- No documentation found for Nested "VkDisplayPlaneCapabilitiesKHR" "minDstExtent"
    DisplayPlaneCapabilitiesKHR -> Extent2D
minDstExtent :: Extent2D
  , -- No documentation found for Nested "VkDisplayPlaneCapabilitiesKHR" "maxDstExtent"
    DisplayPlaneCapabilitiesKHR -> Extent2D
maxDstExtent :: Extent2D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplayPlaneCapabilitiesKHR)
#endif
deriving instance Show DisplayPlaneCapabilitiesKHR

instance ToCStruct DisplayPlaneCapabilitiesKHR where
  withCStruct :: DisplayPlaneCapabilitiesKHR
-> (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b)
-> IO b
withCStruct DisplayPlaneCapabilitiesKHR
x ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b
f = Int
-> (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
68 ((("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b)
 -> IO b)
-> (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p -> ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> DisplayPlaneCapabilitiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p DisplayPlaneCapabilitiesKHR
x (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR) -> IO b
f "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p)
  pokeCStruct :: ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> DisplayPlaneCapabilitiesKHR -> IO b -> IO b
pokeCStruct "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p DisplayPlaneCapabilitiesKHR{Offset2D
Extent2D
DisplayPlaneAlphaFlagsKHR
maxDstExtent :: Extent2D
minDstExtent :: Extent2D
maxDstPosition :: Offset2D
minDstPosition :: Offset2D
maxSrcExtent :: Extent2D
minSrcExtent :: Extent2D
maxSrcPosition :: Offset2D
minSrcPosition :: Offset2D
supportedAlpha :: DisplayPlaneAlphaFlagsKHR
$sel:maxDstExtent:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Extent2D
$sel:minDstExtent:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Extent2D
$sel:maxDstPosition:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Offset2D
$sel:minDstPosition:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Offset2D
$sel:maxSrcExtent:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Extent2D
$sel:minSrcExtent:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Extent2D
$sel:maxSrcPosition:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Offset2D
$sel:minSrcPosition:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> Offset2D
$sel:supportedAlpha:DisplayPlaneCapabilitiesKHR :: DisplayPlaneCapabilitiesKHR -> DisplayPlaneAlphaFlagsKHR
..} IO b
f = do
    Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr DisplayPlaneAlphaFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayPlaneAlphaFlagsKHR)) (DisplayPlaneAlphaFlagsKHR
supportedAlpha)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Offset2D)) (Offset2D
minSrcPosition)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset2D)) (Offset2D
maxSrcPosition)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
minSrcExtent)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
maxSrcExtent)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D)) (Offset2D
minDstPosition)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Offset2D)) (Offset2D
maxDstPosition)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D)) (Extent2D
minDstExtent)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent2D)) (Extent2D
maxDstExtent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
68
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p IO b
f = do
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplayPlaneCapabilitiesKHR where
  peekCStruct :: ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> IO DisplayPlaneCapabilitiesKHR
peekCStruct "pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p = do
    DisplayPlaneAlphaFlagsKHR
supportedAlpha <- Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayPlaneAlphaFlagsKHR (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr DisplayPlaneAlphaFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DisplayPlaneAlphaFlagsKHR))
    Offset2D
minSrcPosition <- Ptr Offset2D -> IO Offset2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Offset2D))
    Offset2D
maxSrcPosition <- Ptr Offset2D -> IO Offset2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset2D))
    Extent2D
minSrcExtent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D))
    Extent2D
maxSrcExtent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D))
    Offset2D
minDstPosition <- Ptr Offset2D -> IO Offset2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D))
    Offset2D
maxDstPosition <- Ptr Offset2D -> IO Offset2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Offset2D))
    Extent2D
minDstExtent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D))
    Extent2D
maxDstExtent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR
p ("pCapabilities" ::: Ptr DisplayPlaneCapabilitiesKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent2D))
    DisplayPlaneCapabilitiesKHR -> IO DisplayPlaneCapabilitiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayPlaneCapabilitiesKHR -> IO DisplayPlaneCapabilitiesKHR)
-> DisplayPlaneCapabilitiesKHR -> IO DisplayPlaneCapabilitiesKHR
forall a b. (a -> b) -> a -> b
$ DisplayPlaneAlphaFlagsKHR
-> Offset2D
-> Offset2D
-> Extent2D
-> Extent2D
-> Offset2D
-> Offset2D
-> Extent2D
-> Extent2D
-> DisplayPlaneCapabilitiesKHR
DisplayPlaneCapabilitiesKHR
             DisplayPlaneAlphaFlagsKHR
supportedAlpha Offset2D
minSrcPosition Offset2D
maxSrcPosition Extent2D
minSrcExtent Extent2D
maxSrcExtent Offset2D
minDstPosition Offset2D
maxDstPosition Extent2D
minDstExtent Extent2D
maxDstExtent

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

instance Zero DisplayPlaneCapabilitiesKHR where
  zero :: DisplayPlaneCapabilitiesKHR
zero = DisplayPlaneAlphaFlagsKHR
-> Offset2D
-> Offset2D
-> Extent2D
-> Extent2D
-> Offset2D
-> Offset2D
-> Extent2D
-> Extent2D
-> DisplayPlaneCapabilitiesKHR
DisplayPlaneCapabilitiesKHR
           DisplayPlaneAlphaFlagsKHR
forall a. Zero a => a
zero
           Offset2D
forall a. Zero a => a
zero
           Offset2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Offset2D
forall a. Zero a => a
zero
           Offset2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero


-- | VkDisplaySurfaceCreateInfoKHR - Structure specifying parameters of a
-- newly created display plane surface object
--
-- = Description
--
-- Note
--
-- Creating a display surface /must/ not modify the state of the displays,
-- planes, or other resources it names. For example, it /must/ not apply
-- the specified mode to be set on the associated display. Application of
-- display configuration occurs as a side effect of presenting to a display
-- surface.
--
-- == Valid Usage
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-planeIndex-01252# @planeIndex@
--     /must/ be less than the number of display planes supported by the
--     device as determined by calling
--     'getPhysicalDeviceDisplayPlanePropertiesKHR'
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-planeReorderPossible-01253# If
--     the @planeReorderPossible@ member of the 'DisplayPropertiesKHR'
--     structure returned by 'getPhysicalDeviceDisplayPropertiesKHR' for
--     the display corresponding to @displayMode@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE' then @planeStackIndex@ /must/
--     be less than the number of display planes supported by the device as
--     determined by calling 'getPhysicalDeviceDisplayPlanePropertiesKHR';
--     otherwise @planeStackIndex@ /must/ equal the @currentStackIndex@
--     member of 'DisplayPlanePropertiesKHR' returned by
--     'getPhysicalDeviceDisplayPlanePropertiesKHR' for the display plane
--     corresponding to @displayMode@
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-alphaMode-01254# If @alphaMode@
--     is 'DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR' then @globalAlpha@ /must/ be
--     between @0@ and @1@, inclusive
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-alphaMode-01255# @alphaMode@
--     /must/ be one of the bits present in the @supportedAlpha@ member of
--     'DisplayPlaneCapabilitiesKHR' for the display plane corresponding to
--     @displayMode@
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-width-01256# The @width@ and
--     @height@ members of @imageExtent@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxImageDimension2D@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DISPLAY_SURFACE_CREATE_INFO_KHR'
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-flags-zerobitmask# @flags@
--     /must/ be @0@
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-displayMode-parameter#
--     @displayMode@ /must/ be a valid
--     'Vulkan.Extensions.Handles.DisplayModeKHR' handle
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-transform-parameter# @transform@
--     /must/ be a valid
--     'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagBitsKHR' value
--
-- -   #VUID-VkDisplaySurfaceCreateInfoKHR-alphaMode-parameter# @alphaMode@
--     /must/ be a valid 'DisplayPlaneAlphaFlagBitsKHR' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'Vulkan.Extensions.Handles.DisplayModeKHR',
-- 'DisplayPlaneAlphaFlagBitsKHR', 'DisplaySurfaceCreateFlagsKHR',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagBitsKHR',
-- 'createDisplayPlaneSurfaceKHR'
data DisplaySurfaceCreateInfoKHR = DisplaySurfaceCreateInfoKHR
  { -- | @flags@ is reserved for future use, and /must/ be zero.
    DisplaySurfaceCreateInfoKHR -> DisplaySurfaceCreateFlagsKHR
flags :: DisplaySurfaceCreateFlagsKHR
  , -- | @displayMode@ is a 'Vulkan.Extensions.Handles.DisplayModeKHR' handle
    -- specifying the mode to use when displaying this surface.
    DisplaySurfaceCreateInfoKHR -> DisplayModeKHR
displayMode :: DisplayModeKHR
  , -- | @planeIndex@ is the plane on which this surface appears.
    DisplaySurfaceCreateInfoKHR -> Word32
planeIndex :: Word32
  , -- | @planeStackIndex@ is the z-order of the plane.
    DisplaySurfaceCreateInfoKHR -> Word32
planeStackIndex :: Word32
  , -- | @transform@ is a
    -- 'Vulkan.Extensions.VK_KHR_surface.SurfaceTransformFlagBitsKHR' value
    -- specifying the transformation to apply to images as part of the scanout
    -- operation.
    DisplaySurfaceCreateInfoKHR -> SurfaceTransformFlagsKHR
transform :: SurfaceTransformFlagBitsKHR
  , -- | @globalAlpha@ is the global alpha value. This value is ignored if
    -- @alphaMode@ is not 'DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR'.
    DisplaySurfaceCreateInfoKHR -> Float
globalAlpha :: Float
  , -- | @alphaMode@ is a 'DisplayPlaneAlphaFlagBitsKHR' value specifying the
    -- type of alpha blending to use.
    DisplaySurfaceCreateInfoKHR -> DisplayPlaneAlphaFlagsKHR
alphaMode :: DisplayPlaneAlphaFlagBitsKHR
  , -- | @imageExtent@ is the size of the presentable images to use with the
    -- surface.
    DisplaySurfaceCreateInfoKHR -> Extent2D
imageExtent :: Extent2D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DisplaySurfaceCreateInfoKHR)
#endif
deriving instance Show DisplaySurfaceCreateInfoKHR

instance ToCStruct DisplaySurfaceCreateInfoKHR where
  withCStruct :: DisplaySurfaceCreateInfoKHR
-> (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b)
-> IO b
withCStruct DisplaySurfaceCreateInfoKHR
x ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b
f = Int
-> (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 ((("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b)
 -> IO b)
-> (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p -> ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> DisplaySurfaceCreateInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p DisplaySurfaceCreateInfoKHR
x (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b
f "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p)
  pokeCStruct :: ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> DisplaySurfaceCreateInfoKHR -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p DisplaySurfaceCreateInfoKHR{Float
Word32
Extent2D
DisplayModeKHR
SurfaceTransformFlagsKHR
DisplayPlaneAlphaFlagsKHR
DisplaySurfaceCreateFlagsKHR
imageExtent :: Extent2D
alphaMode :: DisplayPlaneAlphaFlagsKHR
globalAlpha :: Float
transform :: SurfaceTransformFlagsKHR
planeStackIndex :: Word32
planeIndex :: Word32
displayMode :: DisplayModeKHR
flags :: DisplaySurfaceCreateFlagsKHR
$sel:imageExtent:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> Extent2D
$sel:alphaMode:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> DisplayPlaneAlphaFlagsKHR
$sel:globalAlpha:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> Float
$sel:transform:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> SurfaceTransformFlagsKHR
$sel:planeStackIndex:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> Word32
$sel:planeIndex:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> Word32
$sel:displayMode:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> DisplayModeKHR
$sel:flags:DisplaySurfaceCreateInfoKHR :: DisplaySurfaceCreateInfoKHR -> DisplaySurfaceCreateFlagsKHR
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DISPLAY_SURFACE_CREATE_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr DisplaySurfaceCreateFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DisplaySurfaceCreateFlagsKHR)) (DisplaySurfaceCreateFlagsKHR
flags)
    ("pMode" ::: Ptr DisplayModeKHR) -> DisplayModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DisplayModeKHR)) (DisplayModeKHR
displayMode)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
planeIndex)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
planeStackIndex)
    Ptr SurfaceTransformFlagsKHR -> SurfaceTransformFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr SurfaceTransformFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr SurfaceTransformFlagBitsKHR)) (SurfaceTransformFlagsKHR
transform)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
globalAlpha))
    Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr DisplayPlaneAlphaFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DisplayPlaneAlphaFlagBitsKHR)) (DisplayPlaneAlphaFlagsKHR
alphaMode)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D)) (Extent2D
imageExtent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DISPLAY_SURFACE_CREATE_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pMode" ::: Ptr DisplayModeKHR) -> DisplayModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DisplayModeKHR)) (DisplayModeKHR
forall a. Zero a => a
zero)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ("pPropertyCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr SurfaceTransformFlagsKHR -> SurfaceTransformFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr SurfaceTransformFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr SurfaceTransformFlagBitsKHR)) (SurfaceTransformFlagsKHR
forall a. Zero a => a
zero)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr DisplayPlaneAlphaFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DisplayPlaneAlphaFlagBitsKHR)) (DisplayPlaneAlphaFlagsKHR
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DisplaySurfaceCreateInfoKHR where
  peekCStruct :: ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> IO DisplaySurfaceCreateInfoKHR
peekCStruct "pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p = do
    DisplaySurfaceCreateFlagsKHR
flags <- Ptr DisplaySurfaceCreateFlagsKHR -> IO DisplaySurfaceCreateFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplaySurfaceCreateFlagsKHR (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr DisplaySurfaceCreateFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DisplaySurfaceCreateFlagsKHR))
    DisplayModeKHR
displayMode <- ("pMode" ::: Ptr DisplayModeKHR) -> IO DisplayModeKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayModeKHR (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pMode" ::: Ptr DisplayModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DisplayModeKHR))
    Word32
planeIndex <- ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Word32
planeStackIndex <- ("pPropertyCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> "pPropertyCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    SurfaceTransformFlagsKHR
transform <- Ptr SurfaceTransformFlagsKHR -> IO SurfaceTransformFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @SurfaceTransformFlagBitsKHR (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr SurfaceTransformFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr SurfaceTransformFlagBitsKHR))
    CFloat
globalAlpha <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr CFloat))
    DisplayPlaneAlphaFlagsKHR
alphaMode <- Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @DisplayPlaneAlphaFlagBitsKHR (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr DisplayPlaneAlphaFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DisplayPlaneAlphaFlagBitsKHR))
    Extent2D
imageExtent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR
p ("pCreateInfo" ::: Ptr DisplaySurfaceCreateInfoKHR)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Extent2D))
    DisplaySurfaceCreateInfoKHR -> IO DisplaySurfaceCreateInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplaySurfaceCreateInfoKHR -> IO DisplaySurfaceCreateInfoKHR)
-> DisplaySurfaceCreateInfoKHR -> IO DisplaySurfaceCreateInfoKHR
forall a b. (a -> b) -> a -> b
$ DisplaySurfaceCreateFlagsKHR
-> DisplayModeKHR
-> Word32
-> Word32
-> SurfaceTransformFlagsKHR
-> Float
-> DisplayPlaneAlphaFlagsKHR
-> Extent2D
-> DisplaySurfaceCreateInfoKHR
DisplaySurfaceCreateInfoKHR
             DisplaySurfaceCreateFlagsKHR
flags DisplayModeKHR
displayMode Word32
planeIndex Word32
planeStackIndex SurfaceTransformFlagsKHR
transform (CFloat -> Float
coerce @CFloat @Float CFloat
globalAlpha) DisplayPlaneAlphaFlagsKHR
alphaMode Extent2D
imageExtent

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

instance Zero DisplaySurfaceCreateInfoKHR where
  zero :: DisplaySurfaceCreateInfoKHR
zero = DisplaySurfaceCreateFlagsKHR
-> DisplayModeKHR
-> Word32
-> Word32
-> SurfaceTransformFlagsKHR
-> Float
-> DisplayPlaneAlphaFlagsKHR
-> Extent2D
-> DisplaySurfaceCreateInfoKHR
DisplaySurfaceCreateInfoKHR
           DisplaySurfaceCreateFlagsKHR
forall a. Zero a => a
zero
           DisplayModeKHR
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           SurfaceTransformFlagsKHR
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           DisplayPlaneAlphaFlagsKHR
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero


-- | VkDisplayModeCreateFlagsKHR - Reserved for future use
--
-- = Description
--
-- 'DisplayModeCreateFlagsKHR' is a bitmask type for setting a mask, but is
-- currently reserved for future use.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayModeCreateInfoKHR'
newtype DisplayModeCreateFlagsKHR = DisplayModeCreateFlagsKHR Flags
  deriving newtype (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
(DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> Eq DisplayModeCreateFlagsKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c/= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
== :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c== :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
Eq, Eq DisplayModeCreateFlagsKHR
Eq DisplayModeCreateFlagsKHR
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> Ordering)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> Ord DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Ordering
DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
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 :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$cmin :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
max :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$cmax :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
>= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c>= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
> :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c> :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
<= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c<= :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
< :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
$c< :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Bool
compare :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Ordering
$ccompare :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> Ordering
$cp1Ord :: Eq DisplayModeCreateFlagsKHR
Ord, Ptr b -> Int -> IO DisplayModeCreateFlagsKHR
Ptr b -> Int -> DisplayModeCreateFlagsKHR -> IO ()
Ptr DisplayModeCreateFlagsKHR -> IO DisplayModeCreateFlagsKHR
Ptr DisplayModeCreateFlagsKHR
-> Int -> IO DisplayModeCreateFlagsKHR
Ptr DisplayModeCreateFlagsKHR
-> Int -> DisplayModeCreateFlagsKHR -> IO ()
Ptr DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> IO ()
DisplayModeCreateFlagsKHR -> Int
(DisplayModeCreateFlagsKHR -> Int)
-> (DisplayModeCreateFlagsKHR -> Int)
-> (Ptr DisplayModeCreateFlagsKHR
    -> Int -> IO DisplayModeCreateFlagsKHR)
-> (Ptr DisplayModeCreateFlagsKHR
    -> Int -> DisplayModeCreateFlagsKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO DisplayModeCreateFlagsKHR)
-> (forall b. Ptr b -> Int -> DisplayModeCreateFlagsKHR -> IO ())
-> (Ptr DisplayModeCreateFlagsKHR -> IO DisplayModeCreateFlagsKHR)
-> (Ptr DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> IO ())
-> Storable DisplayModeCreateFlagsKHR
forall b. Ptr b -> Int -> IO DisplayModeCreateFlagsKHR
forall b. Ptr b -> Int -> DisplayModeCreateFlagsKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> IO ()
$cpoke :: Ptr DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR -> IO ()
peek :: Ptr DisplayModeCreateFlagsKHR -> IO DisplayModeCreateFlagsKHR
$cpeek :: Ptr DisplayModeCreateFlagsKHR -> IO DisplayModeCreateFlagsKHR
pokeByteOff :: Ptr b -> Int -> DisplayModeCreateFlagsKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DisplayModeCreateFlagsKHR -> IO ()
peekByteOff :: Ptr b -> Int -> IO DisplayModeCreateFlagsKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DisplayModeCreateFlagsKHR
pokeElemOff :: Ptr DisplayModeCreateFlagsKHR
-> Int -> DisplayModeCreateFlagsKHR -> IO ()
$cpokeElemOff :: Ptr DisplayModeCreateFlagsKHR
-> Int -> DisplayModeCreateFlagsKHR -> IO ()
peekElemOff :: Ptr DisplayModeCreateFlagsKHR
-> Int -> IO DisplayModeCreateFlagsKHR
$cpeekElemOff :: Ptr DisplayModeCreateFlagsKHR
-> Int -> IO DisplayModeCreateFlagsKHR
alignment :: DisplayModeCreateFlagsKHR -> Int
$calignment :: DisplayModeCreateFlagsKHR -> Int
sizeOf :: DisplayModeCreateFlagsKHR -> Int
$csizeOf :: DisplayModeCreateFlagsKHR -> Int
Storable, DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR -> Zero DisplayModeCreateFlagsKHR
forall a. a -> Zero a
zero :: DisplayModeCreateFlagsKHR
$czero :: DisplayModeCreateFlagsKHR
Zero, Eq DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR
Eq DisplayModeCreateFlagsKHR
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR
    -> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> DisplayModeCreateFlagsKHR
-> (Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> Bool)
-> (DisplayModeCreateFlagsKHR -> Maybe Int)
-> (DisplayModeCreateFlagsKHR -> Int)
-> (DisplayModeCreateFlagsKHR -> Bool)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR)
-> (DisplayModeCreateFlagsKHR -> Int)
-> Bits DisplayModeCreateFlagsKHR
Int -> DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR -> Bool
DisplayModeCreateFlagsKHR -> Int
DisplayModeCreateFlagsKHR -> Maybe Int
DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR -> Int -> Bool
DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DisplayModeCreateFlagsKHR -> Int
$cpopCount :: DisplayModeCreateFlagsKHR -> Int
rotateR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$crotateR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
rotateL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$crotateL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
unsafeShiftR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cunsafeShiftR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
shiftR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cshiftR :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
unsafeShiftL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cunsafeShiftL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
shiftL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cshiftL :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
isSigned :: DisplayModeCreateFlagsKHR -> Bool
$cisSigned :: DisplayModeCreateFlagsKHR -> Bool
bitSize :: DisplayModeCreateFlagsKHR -> Int
$cbitSize :: DisplayModeCreateFlagsKHR -> Int
bitSizeMaybe :: DisplayModeCreateFlagsKHR -> Maybe Int
$cbitSizeMaybe :: DisplayModeCreateFlagsKHR -> Maybe Int
testBit :: DisplayModeCreateFlagsKHR -> Int -> Bool
$ctestBit :: DisplayModeCreateFlagsKHR -> Int -> Bool
complementBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$ccomplementBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
clearBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cclearBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
setBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$csetBit :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
bit :: Int -> DisplayModeCreateFlagsKHR
$cbit :: Int -> DisplayModeCreateFlagsKHR
zeroBits :: DisplayModeCreateFlagsKHR
$czeroBits :: DisplayModeCreateFlagsKHR
rotate :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$crotate :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
shift :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
$cshift :: DisplayModeCreateFlagsKHR -> Int -> DisplayModeCreateFlagsKHR
complement :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$ccomplement :: DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
xor :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$cxor :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
.|. :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$c.|. :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
.&. :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$c.&. :: DisplayModeCreateFlagsKHR
-> DisplayModeCreateFlagsKHR -> DisplayModeCreateFlagsKHR
$cp1Bits :: Eq DisplayModeCreateFlagsKHR
Bits, Bits DisplayModeCreateFlagsKHR
Bits DisplayModeCreateFlagsKHR
-> (DisplayModeCreateFlagsKHR -> Int)
-> (DisplayModeCreateFlagsKHR -> Int)
-> (DisplayModeCreateFlagsKHR -> Int)
-> FiniteBits DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: DisplayModeCreateFlagsKHR -> Int
$ccountTrailingZeros :: DisplayModeCreateFlagsKHR -> Int
countLeadingZeros :: DisplayModeCreateFlagsKHR -> Int
$ccountLeadingZeros :: DisplayModeCreateFlagsKHR -> Int
finiteBitSize :: DisplayModeCreateFlagsKHR -> Int
$cfiniteBitSize :: DisplayModeCreateFlagsKHR -> Int
$cp1FiniteBits :: Bits DisplayModeCreateFlagsKHR
FiniteBits)



conNameDisplayModeCreateFlagsKHR :: String
conNameDisplayModeCreateFlagsKHR :: String
conNameDisplayModeCreateFlagsKHR = String
"DisplayModeCreateFlagsKHR"

enumPrefixDisplayModeCreateFlagsKHR :: String
enumPrefixDisplayModeCreateFlagsKHR :: String
enumPrefixDisplayModeCreateFlagsKHR = String
""

showTableDisplayModeCreateFlagsKHR :: [(DisplayModeCreateFlagsKHR, String)]
showTableDisplayModeCreateFlagsKHR :: [(DisplayModeCreateFlagsKHR, String)]
showTableDisplayModeCreateFlagsKHR = []

instance Show DisplayModeCreateFlagsKHR where
  showsPrec :: Int -> DisplayModeCreateFlagsKHR -> ShowS
showsPrec = String
-> [(DisplayModeCreateFlagsKHR, String)]
-> String
-> (DisplayModeCreateFlagsKHR -> Word32)
-> (Word32 -> ShowS)
-> Int
-> DisplayModeCreateFlagsKHR
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixDisplayModeCreateFlagsKHR
                            [(DisplayModeCreateFlagsKHR, String)]
showTableDisplayModeCreateFlagsKHR
                            String
conNameDisplayModeCreateFlagsKHR
                            (\(DisplayModeCreateFlagsKHR Word32
x) -> Word32
x)
                            (\Word32
x -> String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)

instance Read DisplayModeCreateFlagsKHR where
  readPrec :: ReadPrec DisplayModeCreateFlagsKHR
readPrec = String
-> [(DisplayModeCreateFlagsKHR, String)]
-> String
-> (Word32 -> DisplayModeCreateFlagsKHR)
-> ReadPrec DisplayModeCreateFlagsKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixDisplayModeCreateFlagsKHR
                          [(DisplayModeCreateFlagsKHR, String)]
showTableDisplayModeCreateFlagsKHR
                          String
conNameDisplayModeCreateFlagsKHR
                          Word32 -> DisplayModeCreateFlagsKHR
DisplayModeCreateFlagsKHR


-- | VkDisplaySurfaceCreateFlagsKHR - Reserved for future use
--
-- = Description
--
-- 'DisplaySurfaceCreateFlagsKHR' is a bitmask type for setting a mask, but
-- is currently reserved for future use.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplaySurfaceCreateInfoKHR'
newtype DisplaySurfaceCreateFlagsKHR = DisplaySurfaceCreateFlagsKHR Flags
  deriving newtype (DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
(DisplaySurfaceCreateFlagsKHR
 -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> Eq DisplaySurfaceCreateFlagsKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c/= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
== :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c== :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
Eq, Eq DisplaySurfaceCreateFlagsKHR
Eq DisplaySurfaceCreateFlagsKHR
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Ordering)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> Ord DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Ordering
DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
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 :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$cmin :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
max :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$cmax :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
>= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c>= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
> :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c> :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
<= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c<= :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
< :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
$c< :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Bool
compare :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Ordering
$ccompare :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> Ordering
$cp1Ord :: Eq DisplaySurfaceCreateFlagsKHR
Ord, Ptr b -> Int -> IO DisplaySurfaceCreateFlagsKHR
Ptr b -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
Ptr DisplaySurfaceCreateFlagsKHR -> IO DisplaySurfaceCreateFlagsKHR
Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> IO DisplaySurfaceCreateFlagsKHR
Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
Ptr DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> IO ()
DisplaySurfaceCreateFlagsKHR -> Int
(DisplaySurfaceCreateFlagsKHR -> Int)
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> (Ptr DisplaySurfaceCreateFlagsKHR
    -> Int -> IO DisplaySurfaceCreateFlagsKHR)
-> (Ptr DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO DisplaySurfaceCreateFlagsKHR)
-> (forall b.
    Ptr b -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ())
-> (Ptr DisplaySurfaceCreateFlagsKHR
    -> IO DisplaySurfaceCreateFlagsKHR)
-> (Ptr DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> IO ())
-> Storable DisplaySurfaceCreateFlagsKHR
forall b. Ptr b -> Int -> IO DisplaySurfaceCreateFlagsKHR
forall b. Ptr b -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> IO ()
$cpoke :: Ptr DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> IO ()
peek :: Ptr DisplaySurfaceCreateFlagsKHR -> IO DisplaySurfaceCreateFlagsKHR
$cpeek :: Ptr DisplaySurfaceCreateFlagsKHR -> IO DisplaySurfaceCreateFlagsKHR
pokeByteOff :: Ptr b -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
peekByteOff :: Ptr b -> Int -> IO DisplaySurfaceCreateFlagsKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DisplaySurfaceCreateFlagsKHR
pokeElemOff :: Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
$cpokeElemOff :: Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> DisplaySurfaceCreateFlagsKHR -> IO ()
peekElemOff :: Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> IO DisplaySurfaceCreateFlagsKHR
$cpeekElemOff :: Ptr DisplaySurfaceCreateFlagsKHR
-> Int -> IO DisplaySurfaceCreateFlagsKHR
alignment :: DisplaySurfaceCreateFlagsKHR -> Int
$calignment :: DisplaySurfaceCreateFlagsKHR -> Int
sizeOf :: DisplaySurfaceCreateFlagsKHR -> Int
$csizeOf :: DisplaySurfaceCreateFlagsKHR -> Int
Storable, DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR -> Zero DisplaySurfaceCreateFlagsKHR
forall a. a -> Zero a
zero :: DisplaySurfaceCreateFlagsKHR
$czero :: DisplaySurfaceCreateFlagsKHR
Zero, Eq DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR
Eq DisplaySurfaceCreateFlagsKHR
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> DisplaySurfaceCreateFlagsKHR
-> (Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR -> Int -> Bool)
-> (DisplaySurfaceCreateFlagsKHR -> Maybe Int)
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> (DisplaySurfaceCreateFlagsKHR -> Bool)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR
    -> Int -> DisplaySurfaceCreateFlagsKHR)
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> Bits DisplaySurfaceCreateFlagsKHR
Int -> DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR -> Bool
DisplaySurfaceCreateFlagsKHR -> Int
DisplaySurfaceCreateFlagsKHR -> Maybe Int
DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR -> Int -> Bool
DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DisplaySurfaceCreateFlagsKHR -> Int
$cpopCount :: DisplaySurfaceCreateFlagsKHR -> Int
rotateR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$crotateR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
rotateL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$crotateL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
unsafeShiftR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cunsafeShiftR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
shiftR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cshiftR :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
unsafeShiftL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cunsafeShiftL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
shiftL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cshiftL :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
isSigned :: DisplaySurfaceCreateFlagsKHR -> Bool
$cisSigned :: DisplaySurfaceCreateFlagsKHR -> Bool
bitSize :: DisplaySurfaceCreateFlagsKHR -> Int
$cbitSize :: DisplaySurfaceCreateFlagsKHR -> Int
bitSizeMaybe :: DisplaySurfaceCreateFlagsKHR -> Maybe Int
$cbitSizeMaybe :: DisplaySurfaceCreateFlagsKHR -> Maybe Int
testBit :: DisplaySurfaceCreateFlagsKHR -> Int -> Bool
$ctestBit :: DisplaySurfaceCreateFlagsKHR -> Int -> Bool
complementBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$ccomplementBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
clearBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cclearBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
setBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$csetBit :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
bit :: Int -> DisplaySurfaceCreateFlagsKHR
$cbit :: Int -> DisplaySurfaceCreateFlagsKHR
zeroBits :: DisplaySurfaceCreateFlagsKHR
$czeroBits :: DisplaySurfaceCreateFlagsKHR
rotate :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$crotate :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
shift :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
$cshift :: DisplaySurfaceCreateFlagsKHR -> Int -> DisplaySurfaceCreateFlagsKHR
complement :: DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$ccomplement :: DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
xor :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$cxor :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
.|. :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$c.|. :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
.&. :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$c.&. :: DisplaySurfaceCreateFlagsKHR
-> DisplaySurfaceCreateFlagsKHR -> DisplaySurfaceCreateFlagsKHR
$cp1Bits :: Eq DisplaySurfaceCreateFlagsKHR
Bits, Bits DisplaySurfaceCreateFlagsKHR
Bits DisplaySurfaceCreateFlagsKHR
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> (DisplaySurfaceCreateFlagsKHR -> Int)
-> FiniteBits DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: DisplaySurfaceCreateFlagsKHR -> Int
$ccountTrailingZeros :: DisplaySurfaceCreateFlagsKHR -> Int
countLeadingZeros :: DisplaySurfaceCreateFlagsKHR -> Int
$ccountLeadingZeros :: DisplaySurfaceCreateFlagsKHR -> Int
finiteBitSize :: DisplaySurfaceCreateFlagsKHR -> Int
$cfiniteBitSize :: DisplaySurfaceCreateFlagsKHR -> Int
$cp1FiniteBits :: Bits DisplaySurfaceCreateFlagsKHR
FiniteBits)



conNameDisplaySurfaceCreateFlagsKHR :: String
conNameDisplaySurfaceCreateFlagsKHR :: String
conNameDisplaySurfaceCreateFlagsKHR = String
"DisplaySurfaceCreateFlagsKHR"

enumPrefixDisplaySurfaceCreateFlagsKHR :: String
enumPrefixDisplaySurfaceCreateFlagsKHR :: String
enumPrefixDisplaySurfaceCreateFlagsKHR = String
""

showTableDisplaySurfaceCreateFlagsKHR :: [(DisplaySurfaceCreateFlagsKHR, String)]
showTableDisplaySurfaceCreateFlagsKHR :: [(DisplaySurfaceCreateFlagsKHR, String)]
showTableDisplaySurfaceCreateFlagsKHR = []

instance Show DisplaySurfaceCreateFlagsKHR where
  showsPrec :: Int -> DisplaySurfaceCreateFlagsKHR -> ShowS
showsPrec = String
-> [(DisplaySurfaceCreateFlagsKHR, String)]
-> String
-> (DisplaySurfaceCreateFlagsKHR -> Word32)
-> (Word32 -> ShowS)
-> Int
-> DisplaySurfaceCreateFlagsKHR
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixDisplaySurfaceCreateFlagsKHR
                            [(DisplaySurfaceCreateFlagsKHR, String)]
showTableDisplaySurfaceCreateFlagsKHR
                            String
conNameDisplaySurfaceCreateFlagsKHR
                            (\(DisplaySurfaceCreateFlagsKHR Word32
x) -> Word32
x)
                            (\Word32
x -> String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)

instance Read DisplaySurfaceCreateFlagsKHR where
  readPrec :: ReadPrec DisplaySurfaceCreateFlagsKHR
readPrec = String
-> [(DisplaySurfaceCreateFlagsKHR, String)]
-> String
-> (Word32 -> DisplaySurfaceCreateFlagsKHR)
-> ReadPrec DisplaySurfaceCreateFlagsKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixDisplaySurfaceCreateFlagsKHR
                          [(DisplaySurfaceCreateFlagsKHR, String)]
showTableDisplaySurfaceCreateFlagsKHR
                          String
conNameDisplaySurfaceCreateFlagsKHR
                          Word32 -> DisplaySurfaceCreateFlagsKHR
DisplaySurfaceCreateFlagsKHR


type DisplayPlaneAlphaFlagsKHR = DisplayPlaneAlphaFlagBitsKHR

-- | VkDisplayPlaneAlphaFlagBitsKHR - Alpha blending type
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_display VK_KHR_display>,
-- 'DisplayPlaneAlphaFlagsKHR', 'DisplaySurfaceCreateInfoKHR'
newtype DisplayPlaneAlphaFlagBitsKHR = DisplayPlaneAlphaFlagBitsKHR Flags
  deriving newtype (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
(DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> Eq DisplayPlaneAlphaFlagsKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c/= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
== :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c== :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
Eq, Eq DisplayPlaneAlphaFlagsKHR
Eq DisplayPlaneAlphaFlagsKHR
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> Ordering)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> Ord DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Ordering
DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
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 :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$cmin :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
max :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$cmax :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
>= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c>= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
> :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c> :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
<= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c<= :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
< :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
$c< :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Bool
compare :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Ordering
$ccompare :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> Ordering
$cp1Ord :: Eq DisplayPlaneAlphaFlagsKHR
Ord, Ptr b -> Int -> IO DisplayPlaneAlphaFlagsKHR
Ptr b -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR
Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> IO DisplayPlaneAlphaFlagsKHR
Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
DisplayPlaneAlphaFlagsKHR -> Int
(DisplayPlaneAlphaFlagsKHR -> Int)
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> (Ptr DisplayPlaneAlphaFlagsKHR
    -> Int -> IO DisplayPlaneAlphaFlagsKHR)
-> (Ptr DisplayPlaneAlphaFlagsKHR
    -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO DisplayPlaneAlphaFlagsKHR)
-> (forall b. Ptr b -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ())
-> (Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR)
-> (Ptr DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> IO ())
-> Storable DisplayPlaneAlphaFlagsKHR
forall b. Ptr b -> Int -> IO DisplayPlaneAlphaFlagsKHR
forall b. Ptr b -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
$cpoke :: Ptr DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR -> IO ()
peek :: Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR
$cpeek :: Ptr DisplayPlaneAlphaFlagsKHR -> IO DisplayPlaneAlphaFlagsKHR
pokeByteOff :: Ptr b -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
peekByteOff :: Ptr b -> Int -> IO DisplayPlaneAlphaFlagsKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DisplayPlaneAlphaFlagsKHR
pokeElemOff :: Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
$cpokeElemOff :: Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> DisplayPlaneAlphaFlagsKHR -> IO ()
peekElemOff :: Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> IO DisplayPlaneAlphaFlagsKHR
$cpeekElemOff :: Ptr DisplayPlaneAlphaFlagsKHR
-> Int -> IO DisplayPlaneAlphaFlagsKHR
alignment :: DisplayPlaneAlphaFlagsKHR -> Int
$calignment :: DisplayPlaneAlphaFlagsKHR -> Int
sizeOf :: DisplayPlaneAlphaFlagsKHR -> Int
$csizeOf :: DisplayPlaneAlphaFlagsKHR -> Int
Storable, DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR -> Zero DisplayPlaneAlphaFlagsKHR
forall a. a -> Zero a
zero :: DisplayPlaneAlphaFlagsKHR
$czero :: DisplayPlaneAlphaFlagsKHR
Zero, Eq DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR
Eq DisplayPlaneAlphaFlagsKHR
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR
    -> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> DisplayPlaneAlphaFlagsKHR
-> (Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> Maybe Int)
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> (DisplayPlaneAlphaFlagsKHR -> Bool)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR)
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> Bits DisplayPlaneAlphaFlagsKHR
Int -> DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR -> Bool
DisplayPlaneAlphaFlagsKHR -> Int
DisplayPlaneAlphaFlagsKHR -> Maybe Int
DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR -> Int -> Bool
DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DisplayPlaneAlphaFlagsKHR -> Int
$cpopCount :: DisplayPlaneAlphaFlagsKHR -> Int
rotateR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$crotateR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
rotateL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$crotateL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
unsafeShiftR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cunsafeShiftR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
shiftR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cshiftR :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
unsafeShiftL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cunsafeShiftL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
shiftL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cshiftL :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
isSigned :: DisplayPlaneAlphaFlagsKHR -> Bool
$cisSigned :: DisplayPlaneAlphaFlagsKHR -> Bool
bitSize :: DisplayPlaneAlphaFlagsKHR -> Int
$cbitSize :: DisplayPlaneAlphaFlagsKHR -> Int
bitSizeMaybe :: DisplayPlaneAlphaFlagsKHR -> Maybe Int
$cbitSizeMaybe :: DisplayPlaneAlphaFlagsKHR -> Maybe Int
testBit :: DisplayPlaneAlphaFlagsKHR -> Int -> Bool
$ctestBit :: DisplayPlaneAlphaFlagsKHR -> Int -> Bool
complementBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$ccomplementBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
clearBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cclearBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
setBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$csetBit :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
bit :: Int -> DisplayPlaneAlphaFlagsKHR
$cbit :: Int -> DisplayPlaneAlphaFlagsKHR
zeroBits :: DisplayPlaneAlphaFlagsKHR
$czeroBits :: DisplayPlaneAlphaFlagsKHR
rotate :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$crotate :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
shift :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
$cshift :: DisplayPlaneAlphaFlagsKHR -> Int -> DisplayPlaneAlphaFlagsKHR
complement :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$ccomplement :: DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
xor :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$cxor :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
.|. :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$c.|. :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
.&. :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$c.&. :: DisplayPlaneAlphaFlagsKHR
-> DisplayPlaneAlphaFlagsKHR -> DisplayPlaneAlphaFlagsKHR
$cp1Bits :: Eq DisplayPlaneAlphaFlagsKHR
Bits, Bits DisplayPlaneAlphaFlagsKHR
Bits DisplayPlaneAlphaFlagsKHR
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> (DisplayPlaneAlphaFlagsKHR -> Int)
-> FiniteBits DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: DisplayPlaneAlphaFlagsKHR -> Int
$ccountTrailingZeros :: DisplayPlaneAlphaFlagsKHR -> Int
countLeadingZeros :: DisplayPlaneAlphaFlagsKHR -> Int
$ccountLeadingZeros :: DisplayPlaneAlphaFlagsKHR -> Int
finiteBitSize :: DisplayPlaneAlphaFlagsKHR -> Int
$cfiniteBitSize :: DisplayPlaneAlphaFlagsKHR -> Int
$cp1FiniteBits :: Bits DisplayPlaneAlphaFlagsKHR
FiniteBits)

-- | 'DISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR' specifies that the source image
-- will be treated as opaque.
pattern $bDISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR :: DisplayPlaneAlphaFlagsKHR
$mDISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR :: forall r.
DisplayPlaneAlphaFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
DISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR                  = DisplayPlaneAlphaFlagBitsKHR 0x00000001
-- | 'DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR' specifies that a global alpha value
-- /must/ be specified that will be applied to all pixels in the source
-- image.
pattern $bDISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR :: DisplayPlaneAlphaFlagsKHR
$mDISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR :: forall r.
DisplayPlaneAlphaFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR                  = DisplayPlaneAlphaFlagBitsKHR 0x00000002
-- | 'DISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR' specifies that the alpha value
-- will be determined by the alpha component of the source image’s pixels.
-- If the source format contains no alpha values, no blending will be
-- applied. The source alpha values are not premultiplied into the source
-- image’s other color components.
pattern $bDISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR :: DisplayPlaneAlphaFlagsKHR
$mDISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR :: forall r.
DisplayPlaneAlphaFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
DISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR               = DisplayPlaneAlphaFlagBitsKHR 0x00000004
-- | 'DISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR' is equivalent to
-- 'DISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR', except the source alpha values
-- are assumed to be premultiplied into the source image’s other color
-- components.
pattern $bDISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR :: DisplayPlaneAlphaFlagsKHR
$mDISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR :: forall r.
DisplayPlaneAlphaFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
DISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR = DisplayPlaneAlphaFlagBitsKHR 0x00000008

conNameDisplayPlaneAlphaFlagBitsKHR :: String
conNameDisplayPlaneAlphaFlagBitsKHR :: String
conNameDisplayPlaneAlphaFlagBitsKHR = String
"DisplayPlaneAlphaFlagBitsKHR"

enumPrefixDisplayPlaneAlphaFlagBitsKHR :: String
enumPrefixDisplayPlaneAlphaFlagBitsKHR :: String
enumPrefixDisplayPlaneAlphaFlagBitsKHR = String
"DISPLAY_PLANE_ALPHA_"

showTableDisplayPlaneAlphaFlagBitsKHR :: [(DisplayPlaneAlphaFlagBitsKHR, String)]
showTableDisplayPlaneAlphaFlagBitsKHR :: [(DisplayPlaneAlphaFlagsKHR, String)]
showTableDisplayPlaneAlphaFlagBitsKHR =
  [ (DisplayPlaneAlphaFlagsKHR
DISPLAY_PLANE_ALPHA_OPAQUE_BIT_KHR                 , String
"OPAQUE_BIT_KHR")
  , (DisplayPlaneAlphaFlagsKHR
DISPLAY_PLANE_ALPHA_GLOBAL_BIT_KHR                 , String
"GLOBAL_BIT_KHR")
  , (DisplayPlaneAlphaFlagsKHR
DISPLAY_PLANE_ALPHA_PER_PIXEL_BIT_KHR              , String
"PER_PIXEL_BIT_KHR")
  , (DisplayPlaneAlphaFlagsKHR
DISPLAY_PLANE_ALPHA_PER_PIXEL_PREMULTIPLIED_BIT_KHR, String
"PER_PIXEL_PREMULTIPLIED_BIT_KHR")
  ]

instance Show DisplayPlaneAlphaFlagBitsKHR where
  showsPrec :: Int -> DisplayPlaneAlphaFlagsKHR -> ShowS
showsPrec = String
-> [(DisplayPlaneAlphaFlagsKHR, String)]
-> String
-> (DisplayPlaneAlphaFlagsKHR -> Word32)
-> (Word32 -> ShowS)
-> Int
-> DisplayPlaneAlphaFlagsKHR
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixDisplayPlaneAlphaFlagBitsKHR
                            [(DisplayPlaneAlphaFlagsKHR, String)]
showTableDisplayPlaneAlphaFlagBitsKHR
                            String
conNameDisplayPlaneAlphaFlagBitsKHR
                            (\(DisplayPlaneAlphaFlagBitsKHR Word32
x) -> Word32
x)
                            (\Word32
x -> String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)

instance Read DisplayPlaneAlphaFlagBitsKHR where
  readPrec :: ReadPrec DisplayPlaneAlphaFlagsKHR
readPrec = String
-> [(DisplayPlaneAlphaFlagsKHR, String)]
-> String
-> (Word32 -> DisplayPlaneAlphaFlagsKHR)
-> ReadPrec DisplayPlaneAlphaFlagsKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixDisplayPlaneAlphaFlagBitsKHR
                          [(DisplayPlaneAlphaFlagsKHR, String)]
showTableDisplayPlaneAlphaFlagBitsKHR
                          String
conNameDisplayPlaneAlphaFlagBitsKHR
                          Word32 -> DisplayPlaneAlphaFlagsKHR
DisplayPlaneAlphaFlagBitsKHR


type KHR_DISPLAY_SPEC_VERSION = 23

-- No documentation found for TopLevel "VK_KHR_DISPLAY_SPEC_VERSION"
pattern KHR_DISPLAY_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_DISPLAY_SPEC_VERSION :: a
$mKHR_DISPLAY_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_DISPLAY_SPEC_VERSION = 23


type KHR_DISPLAY_EXTENSION_NAME = "VK_KHR_display"

-- No documentation found for TopLevel "VK_KHR_DISPLAY_EXTENSION_NAME"
pattern KHR_DISPLAY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_DISPLAY_EXTENSION_NAME :: a
$mKHR_DISPLAY_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_DISPLAY_EXTENSION_NAME = "VK_KHR_display"