{-# language CPP #-}
module Vulkan.Core10.Enums.SharingMode  (SharingMode( SHARING_MODE_EXCLUSIVE
                                                    , SHARING_MODE_CONCURRENT
                                                    , ..
                                                    )) where

import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Foreign.Storable (Storable)
import Data.Int (Int32)
import GHC.Read (Read(readPrec))
import Text.Read.Lex (Lexeme(Ident))
import Vulkan.Zero (Zero)
-- | VkSharingMode - Buffer and image sharing modes
--
-- = Description
--
-- Note
--
-- 'SHARING_MODE_CONCURRENT' /may/ result in lower performance access to
-- the buffer or image than 'SHARING_MODE_EXCLUSIVE'.
--
-- Ranges of buffers and image subresources of image objects created using
-- 'SHARING_MODE_EXCLUSIVE' /must/ only be accessed by queues in the queue
-- family that has /ownership/ of the resource. Upon creation, such
-- resources are not owned by any queue family; ownership is implicitly
-- acquired upon first use within a queue. Once a resource using
-- 'SHARING_MODE_EXCLUSIVE' is owned by some queue family, the application
-- /must/ perform a
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
-- to make the memory contents of a range or image subresource accessible
-- to a different queue family.
--
-- Note
--
-- Images still require a
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-layouts layout transition>
-- from 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or
-- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED' before
-- being used on the first queue.
--
-- A queue family /can/ take ownership of an image subresource or buffer
-- range of a resource created with 'SHARING_MODE_EXCLUSIVE', without an
-- ownership transfer, in the same way as for a resource that was just
-- created; however, taking ownership in this way has the effect that the
-- contents of the image subresource or buffer range are undefined.
--
-- Ranges of buffers and image subresources of image objects created using
-- 'SHARING_MODE_CONCURRENT' /must/ only be accessed by queues from the
-- queue families specified through the @queueFamilyIndexCount@ and
-- @pQueueFamilyIndices@ members of the corresponding create info
-- structures.
--
-- = See Also
--
-- 'Vulkan.Core10.Buffer.BufferCreateInfo',
-- 'Vulkan.Core10.Image.ImageCreateInfo',
-- 'Vulkan.Extensions.VK_EXT_image_drm_format_modifier.PhysicalDeviceImageDrmFormatModifierInfoEXT',
-- 'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'
newtype SharingMode = SharingMode Int32
  deriving newtype (SharingMode -> SharingMode -> Bool
(SharingMode -> SharingMode -> Bool)
-> (SharingMode -> SharingMode -> Bool) -> Eq SharingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharingMode -> SharingMode -> Bool
$c/= :: SharingMode -> SharingMode -> Bool
== :: SharingMode -> SharingMode -> Bool
$c== :: SharingMode -> SharingMode -> Bool
Eq, Eq SharingMode
Eq SharingMode =>
(SharingMode -> SharingMode -> Ordering)
-> (SharingMode -> SharingMode -> Bool)
-> (SharingMode -> SharingMode -> Bool)
-> (SharingMode -> SharingMode -> Bool)
-> (SharingMode -> SharingMode -> Bool)
-> (SharingMode -> SharingMode -> SharingMode)
-> (SharingMode -> SharingMode -> SharingMode)
-> Ord SharingMode
SharingMode -> SharingMode -> Bool
SharingMode -> SharingMode -> Ordering
SharingMode -> SharingMode -> SharingMode
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 :: SharingMode -> SharingMode -> SharingMode
$cmin :: SharingMode -> SharingMode -> SharingMode
max :: SharingMode -> SharingMode -> SharingMode
$cmax :: SharingMode -> SharingMode -> SharingMode
>= :: SharingMode -> SharingMode -> Bool
$c>= :: SharingMode -> SharingMode -> Bool
> :: SharingMode -> SharingMode -> Bool
$c> :: SharingMode -> SharingMode -> Bool
<= :: SharingMode -> SharingMode -> Bool
$c<= :: SharingMode -> SharingMode -> Bool
< :: SharingMode -> SharingMode -> Bool
$c< :: SharingMode -> SharingMode -> Bool
compare :: SharingMode -> SharingMode -> Ordering
$ccompare :: SharingMode -> SharingMode -> Ordering
$cp1Ord :: Eq SharingMode
Ord, Ptr b -> Int -> IO SharingMode
Ptr b -> Int -> SharingMode -> IO ()
Ptr SharingMode -> IO SharingMode
Ptr SharingMode -> Int -> IO SharingMode
Ptr SharingMode -> Int -> SharingMode -> IO ()
Ptr SharingMode -> SharingMode -> IO ()
SharingMode -> Int
(SharingMode -> Int)
-> (SharingMode -> Int)
-> (Ptr SharingMode -> Int -> IO SharingMode)
-> (Ptr SharingMode -> Int -> SharingMode -> IO ())
-> (forall b. Ptr b -> Int -> IO SharingMode)
-> (forall b. Ptr b -> Int -> SharingMode -> IO ())
-> (Ptr SharingMode -> IO SharingMode)
-> (Ptr SharingMode -> SharingMode -> IO ())
-> Storable SharingMode
forall b. Ptr b -> Int -> IO SharingMode
forall b. Ptr b -> Int -> SharingMode -> 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 SharingMode -> SharingMode -> IO ()
$cpoke :: Ptr SharingMode -> SharingMode -> IO ()
peek :: Ptr SharingMode -> IO SharingMode
$cpeek :: Ptr SharingMode -> IO SharingMode
pokeByteOff :: Ptr b -> Int -> SharingMode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SharingMode -> IO ()
peekByteOff :: Ptr b -> Int -> IO SharingMode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SharingMode
pokeElemOff :: Ptr SharingMode -> Int -> SharingMode -> IO ()
$cpokeElemOff :: Ptr SharingMode -> Int -> SharingMode -> IO ()
peekElemOff :: Ptr SharingMode -> Int -> IO SharingMode
$cpeekElemOff :: Ptr SharingMode -> Int -> IO SharingMode
alignment :: SharingMode -> Int
$calignment :: SharingMode -> Int
sizeOf :: SharingMode -> Int
$csizeOf :: SharingMode -> Int
Storable, SharingMode
SharingMode -> Zero SharingMode
forall a. a -> Zero a
zero :: SharingMode
$czero :: SharingMode
Zero)

-- | 'SHARING_MODE_EXCLUSIVE' specifies that access to any range or image
-- subresource of the object will be exclusive to a single queue family at
-- a time.
pattern $bSHARING_MODE_EXCLUSIVE :: SharingMode
$mSHARING_MODE_EXCLUSIVE :: forall r. SharingMode -> (Void# -> r) -> (Void# -> r) -> r
SHARING_MODE_EXCLUSIVE = SharingMode 0
-- | 'SHARING_MODE_CONCURRENT' specifies that concurrent access to any range
-- or image subresource of the object from multiple queue families is
-- supported.
pattern $bSHARING_MODE_CONCURRENT :: SharingMode
$mSHARING_MODE_CONCURRENT :: forall r. SharingMode -> (Void# -> r) -> (Void# -> r) -> r
SHARING_MODE_CONCURRENT = SharingMode 1
{-# complete SHARING_MODE_EXCLUSIVE,
             SHARING_MODE_CONCURRENT :: SharingMode #-}

instance Show SharingMode where
  showsPrec :: Int -> SharingMode -> ShowS
showsPrec p :: Int
p = \case
    SHARING_MODE_EXCLUSIVE -> String -> ShowS
showString "SHARING_MODE_EXCLUSIVE"
    SHARING_MODE_CONCURRENT -> String -> ShowS
showString "SHARING_MODE_CONCURRENT"
    SharingMode x :: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "SharingMode " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Int32
x)

instance Read SharingMode where
  readPrec :: ReadPrec SharingMode
readPrec = ReadPrec SharingMode -> ReadPrec SharingMode
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec SharingMode)] -> ReadPrec SharingMode
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("SHARING_MODE_EXCLUSIVE", SharingMode -> ReadPrec SharingMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SharingMode
SHARING_MODE_EXCLUSIVE)
                            , ("SHARING_MODE_CONCURRENT", SharingMode -> ReadPrec SharingMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure SharingMode
SHARING_MODE_CONCURRENT)]
                     ReadPrec SharingMode
-> ReadPrec SharingMode -> ReadPrec SharingMode
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec SharingMode -> ReadPrec SharingMode
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "SharingMode")
                       Int32
v <- ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec
                       SharingMode -> ReadPrec SharingMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> SharingMode
SharingMode Int32
v)))