{-# LINE 1 "src/Gpu/Vulkan/PipelineLayout/Middle/Internal.hsc" #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE FlexibleContexts, UndecidableInstances #-} {-# LANGUAGE PatternSynonyms, ViewPatterns #-} {-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Gpu.Vulkan.PipelineLayout.Middle.Internal ( P(..), CreateInfo(..), CreateFlags, create, destroy ) where import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Storable import Foreign.Storable.PeekPoke import Foreign.C.Enum import Control.Arrow import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.ParMaybe qualified as TPMaybe import Data.Default import Data.Bits import Data.Word import Gpu.Vulkan.Exception.Middle.Internal import Gpu.Vulkan.Exception.Enum import Gpu.Vulkan.AllocationCallbacks.Middle.Internal qualified as AllocationCallbacks import qualified Gpu.Vulkan.Device.Middle.Internal as Device import qualified Gpu.Vulkan.DescriptorSetLayout.Middle.Internal as DescriptorSet.Layout import qualified Gpu.Vulkan.PushConstant.Middle.Internal as PushConstant import qualified Gpu.Vulkan.PipelineLayout.Core as C enum "CreateFlags" ''Word32 {-# LINE 40 "src/Gpu/Vulkan/PipelineLayout/Middle/Internal.hsc" #-} [''Show, ''Storable, ''Eq, ''Bits] [("CreateFlagsZero", 0)] instance Default CreateFlags where def :: CreateFlags def = CreateFlags CreateFlagsZero data CreateInfo mn = CreateInfo { forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext :: TMaybe.M mn, forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags createInfoFlags :: CreateFlags, forall (mn :: Maybe (*)). CreateInfo mn -> [D] createInfoSetLayouts :: [DescriptorSet.Layout.D], forall (mn :: Maybe (*)). CreateInfo mn -> [Range] createInfoPushConstantRanges :: [PushConstant.Range] } deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn) createInfoToCore :: WithPoked (TMaybe.M mn) => CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO () createInfoToCore :: forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo { createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext = M mn mnxt, createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags createInfoFlags = CreateFlags Word32 flgs, createInfoSetLayouts :: forall (mn :: Maybe (*)). CreateInfo mn -> [D] createInfoSetLayouts = ([D] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([D] -> Int) -> ([D] -> [D]) -> [D] -> (Int, [D]) forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c') forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& ((\(DescriptorSet.Layout.D D lyt) -> D lyt) (D -> D) -> [D] -> [D] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>)) -> (Int slc, [D] sls), createInfoPushConstantRanges :: forall (mn :: Maybe (*)). CreateInfo mn -> [Range] createInfoPushConstantRanges = ( [Range] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Range] -> Int) -> ([Range] -> [Range]) -> [Range] -> (Int, [Range]) forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c') forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& (Range -> Range PushConstant.rangeToCore (Range -> Range) -> [Range] -> [Range] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>)) -> (Int pcrc, [Range] pcrs) } Ptr CreateInfo -> IO a f = M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO () forall a b. WithPoked a => a -> (forall s. PtrS s a -> IO b) -> IO b forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b withPoked' M mn mnxt \PtrS s (M mn) pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO () forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO () withPtrS PtrS s (M mn) pnxt \(Ptr (M mn) -> Ptr () forall a b. Ptr a -> Ptr b castPtr -> Ptr () pnxt') -> Int -> (Ptr D -> IO a) -> IO a forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray Int slc \Ptr D psls -> Ptr D -> [D] -> IO () forall a. Storable a => Ptr a -> [a] -> IO () pokeArray Ptr D psls [D] sls IO () -> IO a -> IO a forall a b. IO a -> IO b -> IO b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Int -> (Ptr Range -> IO a) -> IO a forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray Int pcrc \Ptr Range ppcrs -> Ptr Range -> [Range] -> IO () forall a. Storable a => Ptr a -> [a] -> IO () pokeArray Ptr Range ppcrs [Range] pcrs IO () -> IO a -> IO a forall a b. IO a -> IO b -> IO b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> let ci :: CreateInfo ci = C.CreateInfo { createInfoSType :: () C.createInfoSType = (), createInfoPNext :: Ptr () C.createInfoPNext = Ptr () pnxt', createInfoFlags :: Word32 C.createInfoFlags = Word32 flgs, createInfoSetLayoutCount :: Word32 C.createInfoSetLayoutCount = Int -> Word32 forall a b. (Integral a, Num b) => a -> b fromIntegral Int slc, createInfoPSetLayouts :: Ptr D C.createInfoPSetLayouts = Ptr D psls, createInfoPushConstantRangeCount :: Word32 C.createInfoPushConstantRangeCount = Int -> Word32 forall a b. (Integral a, Num b) => a -> b fromIntegral Int pcrc, createInfoPPushConstantRanges :: Ptr Range C.createInfoPPushConstantRanges = Ptr Range ppcrs } in CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b withPoked CreateInfo ci Ptr CreateInfo -> IO a f newtype P = P C.P deriving Int -> P -> ShowS [P] -> ShowS P -> String (Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> P -> ShowS showsPrec :: Int -> P -> ShowS $cshow :: P -> String show :: P -> String $cshowList :: [P] -> ShowS showList :: [P] -> ShowS Show create :: WithPoked (TMaybe.M mn) => Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO P create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)). WithPoked (M mn) => D -> CreateInfo mn -> M A mc -> IO P create (Device.D D dvc) CreateInfo mn ci M A mc mac = P -> P P (P -> P) -> IO P -> IO P forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Ptr P -> IO P) -> IO P forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca \Ptr P pl -> do CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO () forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo mn ci \Ptr CreateInfo pci -> M A mc -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A mc mac \Ptr A pac -> do r <- D -> Ptr CreateInfo -> Ptr A -> Ptr P -> IO Int32 C.create D dvc Ptr CreateInfo pci Ptr A pac Ptr P pl throwUnlessSuccess $ Result r Ptr P -> IO P forall a. Storable a => Ptr a -> IO a peek Ptr P pl destroy :: Device.D -> P -> TPMaybe.M AllocationCallbacks.A md -> IO () destroy :: forall (md :: Maybe (*)). D -> P -> M A md -> IO () destroy (Device.D D dvc) (P P lyt) M A md mac = M A md -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A md mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ D -> P -> Ptr A -> IO () C.destroy D dvc P lyt