Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- allocateBind :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd a. (WithPoked (M mn), Bindable ibargs, ToMiddle mac) => D sd -> PL (U2 ImageBuffer) ibargs -> AllocateInfo mn -> M (U2 A) mac -> (forall s. PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a) -> IO a
- unsafeReallocateBind :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd sm. (WithPoked (M mn), Rebindable ibargs, ToMiddle mac) => D sd -> PL (U2 (ImageBufferBinded sm)) ibargs -> AllocateInfo mn -> M (U2 A) mac -> M sm ibargs -> IO ()
- unsafeReallocateBind' :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd sm a. (WithPoked (M mn), Rebindable ibargs, ToMiddle mac) => D sd -> PL (U2 (ImageBufferBinded sm)) ibargs -> AllocateInfo mn -> M (U2 A) mac -> M sm ibargs -> IO a -> IO ()
- data Group sd (ma :: Maybe (Type, Type)) s k (ibargs :: [(Type, ImageBufferArg)])
- group :: forall (ma :: Maybe (Type, Type)) sd k (ibargs :: [(Type, ImageBufferArg)]) a. ToMiddle ma => D sd -> M (U2 A) ma -> (forall s. Group sd ma s k ibargs -> IO a) -> IO a
- allocateBind' :: forall k (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (ma :: Maybe (Type, Type)) sd sm. (Ord k, WithPoked (M mn), Bindable ibargs, ToMiddle ma) => Group sd ma sm k ibargs -> k -> PL (U2 ImageBuffer) ibargs -> AllocateInfo mn -> IO (Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs))
- unsafeFree :: forall k (ma :: Maybe (Type, Type)) sd smng (ibargs :: [(Type, ImageBufferArg)]). (Ord k, ToMiddle ma) => Group sd ma smng k ibargs -> k -> IO (Either String ())
- lookup :: forall k sd (ma :: Maybe (Type, Type)) sm (ibargs :: [(Type, ImageBufferArg)]) s. Ord k => Group sd ma sm k ibargs -> k -> IO (Maybe (M s ibargs))
- data M s (ibargs :: [(Type, ImageBufferArg)])
- getBinded :: forall s (ibargs :: [(Type, ImageBufferArg)]). M s ibargs -> IO (PL (U2 (ImageBufferBinded s)) ibargs)
- data ImageBuffer s (ibarg :: ImageBufferArg) where
- data ImageBufferBinded sm sib (ibarg :: ImageBufferArg) where
- ImageBinded :: forall sm sib (nm :: Symbol) (fmt :: Format). Binded sm sib nm fmt -> ImageBufferBinded sm sib ('ImageArg nm fmt)
- BufferBinded :: forall sm sib (nm :: Symbol) (objs :: [O]). Binded sm sib nm objs -> ImageBufferBinded sm sib ('BufferArg nm objs)
- RawBinded :: forall sm sib. Size -> Size -> ImageBufferBinded sm sib 'RawArg
- data ImageBufferArg
- data AllocateInfo (mn :: Maybe Type) = AllocateInfo {}
- data MType = MType {}
- data TypeBits
- data TypeIndex
- elemTypeIndex :: TypeIndex -> TypeBits -> Bool
- data Heap = Heap {}
- class (BindAll ibargs ibargs, Alignments ibargs) => Bindable (ibargs :: [(Type, ImageBufferArg)])
- class (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable (ibargs :: [(Type, ImageBufferArg)])
- getRequirementsList :: forall sd (ibargs :: [(Type, ImageBufferArg)]). D sd -> PL (U2 ImageBuffer) ibargs -> IO [Either AlgnSize Requirements]
- data Requirements = Requirements {}
- read :: forall (nm :: Symbol) (obj :: O) (i :: Nat) v sd sm (ibargs :: [(Type, ImageBufferArg)]). (Store v obj, OffsetSize nm obj ibargs i) => D sd -> M sm ibargs -> MapFlags -> IO v
- write :: forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm (ibargs :: [(Type, ImageBufferArg)]) v. (Store v obj, OffsetSize nm obj ibargs i) => D sd -> M sm ibargs -> MapFlags -> v -> IO ()
- class ObjectLength nm obj ibargs => OffsetSize (nm :: Symbol) (obj :: O) (ibargs :: [(Type, ImageBufferArg)]) (i :: Nat)
- data MapFlags
- data Barrier (mn :: Maybe Type) = Barrier {}
- newtype RawOffset (n :: Nat) = RawOffset Size
- newtype PropertyFlagBits = PropertyFlagBits Word32
- pattern PropertyFlagBitsMaxEnum :: PropertyFlagBits
- pattern PropertyRdmaCapableBitNv :: PropertyFlagBits
- pattern PropertyDeviceUncachedBitAmd :: PropertyFlagBits
- pattern PropertyDeviceCoherentBitAmd :: PropertyFlagBits
- pattern PropertyProtectedBit :: PropertyFlagBits
- pattern PropertyLazilyAllocatedBit :: PropertyFlagBits
- pattern PropertyHostCachedBit :: PropertyFlagBits
- pattern PropertyHostCoherentBit :: PropertyFlagBits
- pattern PropertyHostVisibleBit :: PropertyFlagBits
- pattern PropertyDeviceLocalBit :: PropertyFlagBits
- pattern PropertyFlagsZero :: PropertyFlagBits
- unPropertyFlagBits :: PropertyFlagBits -> Word32
- type HeapFlags = HeapFlagBits
- type PropertyFlags = PropertyFlagBits
- newtype HeapFlagBits = HeapFlagBits Word32
- pattern HeapFlagBitsMaxEnum :: HeapFlagBits
- pattern HeapMultiInstanceBitKhr :: HeapFlagBits
- pattern HeapMultiInstanceBit :: HeapFlagBits
- pattern HeapDeviceLocalBit :: HeapFlagBits
- pattern HeapFlagsZero :: HeapFlagBits
- unHeapFlagBits :: HeapFlagBits -> Word32
ALLOCATE AND BIND
allocateBind :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd a. (WithPoked (M mn), Bindable ibargs, ToMiddle mac) => D sd -> PL (U2 ImageBuffer) ibargs -> AllocateInfo mn -> M (U2 A) mac -> (forall s. PL (U2 (ImageBufferBinded s)) ibargs -> M s ibargs -> IO a) -> IO a Source #
unsafeReallocateBind :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd sm. (WithPoked (M mn), Rebindable ibargs, ToMiddle mac) => D sd -> PL (U2 (ImageBufferBinded sm)) ibargs -> AllocateInfo mn -> M (U2 A) mac -> M sm ibargs -> IO () Source #
unsafeReallocateBind' :: forall (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (mac :: Maybe (Type, Type)) sd sm a. (WithPoked (M mn), Rebindable ibargs, ToMiddle mac) => D sd -> PL (U2 (ImageBufferBinded sm)) ibargs -> AllocateInfo mn -> M (U2 A) mac -> M sm ibargs -> IO a -> IO () Source #
Destruction Group
group :: forall (ma :: Maybe (Type, Type)) sd k (ibargs :: [(Type, ImageBufferArg)]) a. ToMiddle ma => D sd -> M (U2 A) ma -> (forall s. Group sd ma s k ibargs -> IO a) -> IO a Source #
allocateBind' :: forall k (mn :: Maybe Type) (ibargs :: [(Type, ImageBufferArg)]) (ma :: Maybe (Type, Type)) sd sm. (Ord k, WithPoked (M mn), Bindable ibargs, ToMiddle ma) => Group sd ma sm k ibargs -> k -> PL (U2 ImageBuffer) ibargs -> AllocateInfo mn -> IO (Either String (PL (U2 (ImageBufferBinded sm)) ibargs, M sm ibargs)) Source #
unsafeFree :: forall k (ma :: Maybe (Type, Type)) sd smng (ibargs :: [(Type, ImageBufferArg)]). (Ord k, ToMiddle ma) => Group sd ma smng k ibargs -> k -> IO (Either String ()) Source #
lookup :: forall k sd (ma :: Maybe (Type, Type)) sm (ibargs :: [(Type, ImageBufferArg)]) s. Ord k => Group sd ma sm k ibargs -> k -> IO (Maybe (M s ibargs)) Source #
MEMORY
data M s (ibargs :: [(Type, ImageBufferArg)]) Source #
getBinded :: forall s (ibargs :: [(Type, ImageBufferArg)]). M s ibargs -> IO (PL (U2 (ImageBufferBinded s)) ibargs) Source #
data ImageBuffer s (ibarg :: ImageBufferArg) where Source #
Image :: forall s (nm :: Symbol) (fmt :: Format). I s nm fmt -> ImageBuffer s ('ImageArg nm fmt) | |
Buffer :: forall s (nm :: Symbol) (objs :: [O]). B s nm objs -> ImageBuffer s ('BufferArg nm objs) | |
Raw :: forall s. Size -> Size -> ImageBuffer s 'RawArg |
Instances
Show (PL Length objs) => Show (ImageBuffer sib ('BufferArg nm objs)) Source # | |
Defined in Gpu.Vulkan.Memory.ImageBuffer |
data ImageBufferBinded sm sib (ibarg :: ImageBufferArg) where Source #
ImageBinded :: forall sm sib (nm :: Symbol) (fmt :: Format). Binded sm sib nm fmt -> ImageBufferBinded sm sib ('ImageArg nm fmt) | |
BufferBinded :: forall sm sib (nm :: Symbol) (objs :: [O]). Binded sm sib nm objs -> ImageBufferBinded sm sib ('BufferArg nm objs) | |
RawBinded :: forall sm sib. Size -> Size -> ImageBufferBinded sm sib 'RawArg |
Instances
Show (PL Length objs) => Show (ImageBufferBinded sm sib ('BufferArg nm objs)) Source # | |
Defined in Gpu.Vulkan.Memory.ImageBuffer |
data ImageBufferArg Source #
Instances
(OffsetRange obj objs i, LengthOf obj objs) => OffsetSize nm obj ('(sib, 'BufferArg nm objs) ': ibargs) i Source # | |
Defined in Gpu.Vulkan.Memory.OffsetSize offsetSize' :: D sd -> PL (U2 ImageBuffer) ('(sib, 'BufferArg nm objs) ': ibargs) -> Size -> IO (Size, Size) | |
OffsetSize nm obj ibargs i => OffsetSize nm obj ('(sib, ib) ': ibargs) i Source # | |
Defined in Gpu.Vulkan.Memory.OffsetSize offsetSize' :: D sd -> PL (U2 ImageBuffer) ('(sib, ib) ': ibargs) -> Size -> IO (Size, Size) | |
BindSparseInfosToMiddle ('[] :: [(Maybe Type, [Type], [(Type, Symbol, [O], [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [Type])]) Source # | |
Defined in Gpu.Vulkan.Queue bindSparseInfosToMiddle :: D sd -> PL (U6 BindSparseInfo) ('[] :: [(Maybe Type, [Type], [(Type, Symbol, [O], [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [Type])]) -> IO (PL BindSparseInfo (M0_6 ('[] :: [(Maybe Type, [Type], [(Type, Symbol, [O], [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [(Type, Symbol, Format, [(Type, [(Type, ImageBufferArg)], Nat)])], [Type])]))) | |
(MemoryBindInfosToMiddle bbs, OpaqueMemoryBindInfosToMiddle iobs, MemoryBindInfosToMiddle ibs, BindSparseInfosToMiddle bsias) => BindSparseInfosToMiddle ('(mn, swss, bbs, iobs, ibs, ssss) ': bsias) Source # | |
Defined in Gpu.Vulkan.Queue bindSparseInfosToMiddle :: D sd -> PL (U6 BindSparseInfo) ('(mn, swss, bbs, iobs, ibs, ssss) ': bsias) -> IO (PL BindSparseInfo (M0_6 ('(mn, swss, bbs, iobs, ibs, ssss) ': bsias))) |
ALLOCATE INFO
data AllocateInfo (mn :: Maybe Type) Source #
Instances
Show (M mn) => Show (AllocateInfo mn) Source # | |
Defined in Gpu.Vulkan.Memory showsPrec :: Int -> AllocateInfo mn -> ShowS # show :: AllocateInfo mn -> String # showList :: [AllocateInfo mn] -> ShowS # | |
Eq (M mn) => Eq (AllocateInfo mn) Source # | |
Defined in Gpu.Vulkan.Memory (==) :: AllocateInfo mn -> AllocateInfo mn -> Bool # (/=) :: AllocateInfo mn -> AllocateInfo mn -> Bool # |
Instances
Bits TypeBits | |
Defined in Gpu.Vulkan.Memory.Middle.Internal (.&.) :: TypeBits -> TypeBits -> TypeBits # (.|.) :: TypeBits -> TypeBits -> TypeBits # xor :: TypeBits -> TypeBits -> TypeBits # complement :: TypeBits -> TypeBits # shift :: TypeBits -> Int -> TypeBits # rotate :: TypeBits -> Int -> TypeBits # setBit :: TypeBits -> Int -> TypeBits # clearBit :: TypeBits -> Int -> TypeBits # complementBit :: TypeBits -> Int -> TypeBits # testBit :: TypeBits -> Int -> Bool # bitSizeMaybe :: TypeBits -> Maybe Int # isSigned :: TypeBits -> Bool # shiftL :: TypeBits -> Int -> TypeBits # unsafeShiftL :: TypeBits -> Int -> TypeBits # shiftR :: TypeBits -> Int -> TypeBits # unsafeShiftR :: TypeBits -> Int -> TypeBits # rotateL :: TypeBits -> Int -> TypeBits # | |
FiniteBits TypeBits | |
Defined in Gpu.Vulkan.Memory.Middle.Internal finiteBitSize :: TypeBits -> Int # countLeadingZeros :: TypeBits -> Int # countTrailingZeros :: TypeBits -> Int # | |
Show TypeBits | |
Eq TypeBits | |
Instances
Enum TypeIndex | |
Defined in Gpu.Vulkan.Memory.Middle.Internal succ :: TypeIndex -> TypeIndex # pred :: TypeIndex -> TypeIndex # fromEnum :: TypeIndex -> Int # enumFrom :: TypeIndex -> [TypeIndex] # enumFromThen :: TypeIndex -> TypeIndex -> [TypeIndex] # enumFromTo :: TypeIndex -> TypeIndex -> [TypeIndex] # enumFromThenTo :: TypeIndex -> TypeIndex -> TypeIndex -> [TypeIndex] # | |
Num TypeIndex | |
Defined in Gpu.Vulkan.Memory.Middle.Internal | |
Integral TypeIndex | |
Defined in Gpu.Vulkan.Memory.Middle.Internal | |
Real TypeIndex | |
Defined in Gpu.Vulkan.Memory.Middle.Internal toRational :: TypeIndex -> Rational # | |
Show TypeIndex | |
Eq TypeIndex | |
Ord TypeIndex | |
Defined in Gpu.Vulkan.Memory.Middle.Internal |
elemTypeIndex :: TypeIndex -> TypeBits -> Bool #
BINDABLE AND REBINDABLE
class (BindAll ibargs ibargs, Alignments ibargs) => Bindable (ibargs :: [(Type, ImageBufferArg)]) Source #
Instances
(BindAll ibargs ibargs, Alignments ibargs) => Bindable ibargs Source # | |
Defined in Gpu.Vulkan.Memory.Bind |
class (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable (ibargs :: [(Type, ImageBufferArg)]) Source #
Instances
(RebindAll ibargs ibargs, Alignments ibargs) => Rebindable ibargs Source # | |
Defined in Gpu.Vulkan.Memory.Bind |
GET REQUREMENTS
getRequirementsList :: forall sd (ibargs :: [(Type, ImageBufferArg)]). D sd -> PL (U2 ImageBuffer) ibargs -> IO [Either AlgnSize Requirements] Source #
data Requirements #
Instances
Show Requirements | |
Defined in Gpu.Vulkan.Memory.Middle.Internal showsPrec :: Int -> Requirements -> ShowS # show :: Requirements -> String # showList :: [Requirements] -> ShowS # |
READ AND WRITE
read :: forall (nm :: Symbol) (obj :: O) (i :: Nat) v sd sm (ibargs :: [(Type, ImageBufferArg)]). (Store v obj, OffsetSize nm obj ibargs i) => D sd -> M sm ibargs -> MapFlags -> IO v Source #
write :: forall (nm :: Symbol) (obj :: O) (i :: Nat) sd sm (ibargs :: [(Type, ImageBufferArg)]) v. (Store v obj, OffsetSize nm obj ibargs i) => D sd -> M sm ibargs -> MapFlags -> v -> IO () Source #
class ObjectLength nm obj ibargs => OffsetSize (nm :: Symbol) (obj :: O) (ibargs :: [(Type, ImageBufferArg)]) (i :: Nat) Source #
offsetSize'
Instances
(OffsetRange obj objs i, LengthOf obj objs) => OffsetSize nm obj ('(sib, 'BufferArg nm objs) ': ibargs) i Source # | |
Defined in Gpu.Vulkan.Memory.OffsetSize offsetSize' :: D sd -> PL (U2 ImageBuffer) ('(sib, 'BufferArg nm objs) ': ibargs) -> Size -> IO (Size, Size) | |
OffsetSize nm obj ibargs i => OffsetSize nm obj ('(sib, ib) ': ibargs) i Source # | |
Defined in Gpu.Vulkan.Memory.OffsetSize offsetSize' :: D sd -> PL (U2 ImageBuffer) ('(sib, ib) ': ibargs) -> Size -> IO (Size, Size) |
Instances
Storable MapFlags | |
Defined in Gpu.Vulkan.Memory.Middle.Internal | |
Bits MapFlags | |
Defined in Gpu.Vulkan.Memory.Middle.Internal (.&.) :: MapFlags -> MapFlags -> MapFlags # (.|.) :: MapFlags -> MapFlags -> MapFlags # xor :: MapFlags -> MapFlags -> MapFlags # complement :: MapFlags -> MapFlags # shift :: MapFlags -> Int -> MapFlags # rotate :: MapFlags -> Int -> MapFlags # setBit :: MapFlags -> Int -> MapFlags # clearBit :: MapFlags -> Int -> MapFlags # complementBit :: MapFlags -> Int -> MapFlags # testBit :: MapFlags -> Int -> Bool # bitSizeMaybe :: MapFlags -> Maybe Int # isSigned :: MapFlags -> Bool # shiftL :: MapFlags -> Int -> MapFlags # unsafeShiftL :: MapFlags -> Int -> MapFlags # shiftR :: MapFlags -> Int -> MapFlags # unsafeShiftR :: MapFlags -> Int -> MapFlags # rotateL :: MapFlags -> Int -> MapFlags # | |
Show MapFlags | |
Default MapFlags | |
Defined in Gpu.Vulkan.Memory.Middle.Internal | |
Eq MapFlags | |
BARRIER
OTHERS
newtype RawOffset (n :: Nat) Source #
Instances
Num (RawOffset n) Source # | |
Defined in Gpu.Vulkan.Memory.ImageBuffer (+) :: RawOffset n -> RawOffset n -> RawOffset n # (-) :: RawOffset n -> RawOffset n -> RawOffset n # (*) :: RawOffset n -> RawOffset n -> RawOffset n # negate :: RawOffset n -> RawOffset n # abs :: RawOffset n -> RawOffset n # signum :: RawOffset n -> RawOffset n # fromInteger :: Integer -> RawOffset n # | |
Show (RawOffset n) Source # | |
ENUM
newtype PropertyFlagBits #
Instances
pattern PropertyFlagBitsMaxEnum :: PropertyFlagBits #
pattern PropertyRdmaCapableBitNv :: PropertyFlagBits #
pattern PropertyDeviceUncachedBitAmd :: PropertyFlagBits #
pattern PropertyDeviceCoherentBitAmd :: PropertyFlagBits #
pattern PropertyProtectedBit :: PropertyFlagBits #
pattern PropertyLazilyAllocatedBit :: PropertyFlagBits #
pattern PropertyHostCachedBit :: PropertyFlagBits #
pattern PropertyHostCoherentBit :: PropertyFlagBits #
pattern PropertyHostVisibleBit :: PropertyFlagBits #
pattern PropertyDeviceLocalBit :: PropertyFlagBits #
pattern PropertyFlagsZero :: PropertyFlagBits #
type HeapFlags = HeapFlagBits #
type PropertyFlags = PropertyFlagBits #
newtype HeapFlagBits #
Instances
pattern HeapFlagBitsMaxEnum :: HeapFlagBits #
pattern HeapMultiInstanceBitKhr :: HeapFlagBits #
pattern HeapMultiInstanceBit :: HeapFlagBits #
pattern HeapDeviceLocalBit :: HeapFlagBits #
pattern HeapFlagsZero :: HeapFlagBits #
unHeapFlagBits :: HeapFlagBits -> Word32 #