packages feed

gpu-vulkan 0.1.0.153 → 0.1.0.154

raw patch · 4 files changed

+50/−29 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Gpu.Vulkan.Object.Base: instance (GHC.TypeNats.KnownNat algn, Gpu.Vulkan.Object.Base.IsImage img) => Gpu.Vulkan.Object.Base.Store img (Gpu.Vulkan.Object.Base.Image algn img nm)
+ Gpu.Vulkan.Object: lengthImageLayerCount :: forall (algn :: Alignment) v (mnm :: Maybe Symbol). Length ('Static_ (ImageMaybeName algn v mnm)) -> Size
+ Gpu.Vulkan.Object.Base: instance (GHC.TypeNats.KnownNat algn, Gpu.Vulkan.Object.Base.IsImage img, Data.Sequences.IsSequence v, Data.MonoTraversable.Element v GHC.Types.~ img) => Gpu.Vulkan.Object.Base.Store v (Gpu.Vulkan.Object.Base.Image algn img nm)
- Gpu.Vulkan.Object: pattern LengthDynImage :: forall (n :: Nat) (algn :: Alignment) v (nm :: Symbol). Size -> Size -> Size -> Size -> Length ('Dynamic n (Image algn v nm))
+ Gpu.Vulkan.Object: pattern LengthDynImage :: forall (n :: Nat) (algn :: Alignment) v (nm :: Symbol). Size -> Size -> Size -> Size -> Size -> Length ('Dynamic n (Image algn v nm))
- Gpu.Vulkan.Object: pattern LengthImage :: forall (algn :: Alignment) v (mnm :: Maybe Symbol). Size -> Size -> Size -> Size -> Length ('Static_ (ImageMaybeName algn v mnm))
+ Gpu.Vulkan.Object: pattern LengthImage :: forall (algn :: Alignment) v (mnm :: Maybe Symbol). Size -> Size -> Size -> Size -> Size -> Length ('Static_ (ImageMaybeName algn v mnm))
- Gpu.Vulkan.Object.Base: [LengthImage] :: forall (algn :: Alignment) (mnm :: Maybe Symbol) t. Size -> Size -> Size -> Size -> Length ('O algn mnm 'ImageT t)
+ Gpu.Vulkan.Object.Base: [LengthImage] :: forall (algn :: Alignment) (mnm :: Maybe Symbol) t. Size -> Size -> Size -> Size -> Size -> Length ('O algn mnm 'ImageT t)

Files

gpu-vulkan.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gpu-vulkan-version:        0.1.0.153+version:        0.1.0.154 synopsis:       Vulkan library description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan#readme> category:       GPU
src/Gpu/Vulkan/Buffer/Internal.hs view
@@ -395,4 +395,4 @@ 	M.imageCopyImageExtent = iext } 	where 	(ost, _) = VObj.offsetRange @(VObj.Image algn img inm) @_ @0 0 lns-	VObj.LengthImage r _w h _d = VObj.lengthOf @obj lns+	VObj.LengthImage r _w h _d _lc = VObj.lengthOf @obj lns
src/Gpu/Vulkan/Object.hs view
@@ -45,6 +45,7 @@ 	pattern LengthList, 	pattern LengthImage, 	lengthImageRow, lengthImageWidth, lengthImageHeight, lengthImageDepth,+	lengthImageLayerCount,  	pattern LengthDynAtom, 	pattern LengthDynList,@@ -82,10 +83,6 @@  	SizeAlignmentList(..), SizeAlignment(..), -	-- ** Others--	alignment- 	) where  import Prelude hiding (length)@@ -168,13 +165,13 @@ {-# COMPLETE LengthImage #-}  pattern LengthImage ::-	Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size ->+	Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size -> 	Length ('Static_ (K.ImageMaybeName algn v mnm)) pattern LengthImage { 	lengthImageRow, lengthImageWidth,-	lengthImageHeight, lengthImageDepth } = LengthStatic (K.LengthImage+	lengthImageHeight, lengthImageDepth, lengthImageLayerCount } = LengthStatic (K.LengthImage 		lengthImageRow lengthImageWidth-		lengthImageHeight lengthImageDepth)+		lengthImageHeight lengthImageDepth lengthImageLayerCount)  pattern LengthDynAtom :: Length ('Dynamic n (K.Atom algn v nm)) pattern LengthDynAtom <- LengthDynamic K.LengthAtom where@@ -185,9 +182,9 @@ 	LengthDynList n = LengthDynamic (K.LengthList n)  pattern LengthDynImage ::-	Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size -> Length ('Dynamic n (K.Image algn v nm))-pattern LengthDynImage kr kw kh kd <- (LengthDynamic (K.LengthImage kr kw kh kd))-	where LengthDynImage kr kw kh kd = LengthDynamic (K.LengthImage kr kw kh kd)+	Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size -> Device.M.Size -> Length ('Dynamic n (K.Image algn v nm))+pattern LengthDynImage kr kw kh kd klc <- (LengthDynamic (K.LengthImage kr kw kh kd klc))+	where LengthDynImage kr kw kh kd klc = LengthDynamic (K.LengthImage kr kw kh kd klc)  class LengthOf (obj :: O) (objs :: [O]) where 	lengthOf :: HeteroParList.PL Length objs -> Length obj
src/Gpu/Vulkan/Object/Base.hs view
@@ -57,6 +57,8 @@  import Gpu.Vulkan.Device.Middle qualified as Device.M +import Data.List qualified as L+ -- OBJECT  data O = O Alignment (Maybe Symbol) ObjectType Type@@ -107,7 +109,8 @@ 		lengthImageRow :: Device.M.Size, 		lengthImageWidth :: Device.M.Size, 		lengthImageHeight :: Device.M.Size,-		lengthImageDepth :: Device.M.Size } ->+		lengthImageDepth :: Device.M.Size,+		lengthImageLayerCount :: Device.M.Size } -> 		Length ('O algn mnm ImageT t)  deriving instance Eq (Length obj)@@ -115,12 +118,12 @@  instance Default (Length (Atom algn t mnm)) where def = LengthAtom instance Default (Length (List algn t nm)) where def = LengthList 0-instance Default (Length (Image algn t nm)) where def = LengthImage 0 0 0 0+instance Default (Length (Image algn t nm)) where def = LengthImage 0 0 0 0 0  renameLength :: Length ('O algn mnm ot t) -> Length ('O algn mnm' ot t) renameLength LengthAtom = LengthAtom renameLength (LengthList n) = LengthList n-renameLength (LengthImage r w h d) = LengthImage r w h d+renameLength (LengthImage r w h d lc) = LengthImage r w h d lc  -- STORE OBJECT @@ -141,23 +144,44 @@ 	load p (LengthList (fromIntegral -> n)) = Seq.fromList <$> peekArray n p 	length = LengthList . fromIntegral . olength -instance (KnownNat algn, IsImage img) =>-	Store img ((Image algn img nm)) where-	store p0 (LengthImage (fromIntegral -> r) (fromIntegral -> w) _ _) img =-		for_ (zip (iterate (`plusPtr` s) p0) $ imageBody img)-			\(p, take w -> rw) -> pokeArray (castPtr p) rw-		where s = r * S.sizeOf @(ImagePixel img) undefined+instance (KnownNat algn, IsImage img, Seq.IsSequence v, Element v ~ img) =>+	Store v ((Image algn img nm)) where+	store p0 (LengthImage (fromIntegral -> r) (fromIntegral -> w) (fromIntegral -> h) _ (fromIntegral -> lc)) imgs = do+		maybe (pure ()) error $ checkSizes is+		for_ (zip (iterate (`plusPtr` s') p0) $ take lc is) \(p, i) -> go1 p i+		where+		is = otoList imgs+		go1 :: Ptr a -> img -> IO ()+		go1 p img = for_ (zip (iterate (`plusPtr` s) p) $ imageBody img)+			\(p1, take w -> rw) -> pokeArray (castPtr p1) rw+		s = r * S.sizeOf @(ImagePixel img) undefined+		s' = s * h 	load p0 (LengthImage (fromIntegral -> r) 		w_@(fromIntegral -> w) h_@(fromIntegral -> h)-		d_@(fromIntegral -> d)) =-		imageMake w_ h_ d_-			<$> for (take (h * d) $ iterate (`plusPtr` s) p0) \p ->-				peekArray w (castPtr p)-		where s = r * (S.sizeOf @(ImagePixel img) undefined)-	length img = LengthImage+		d_@(fromIntegral -> d) (fromIntegral -> lc)) = Seq.fromList <$>+		for (take lc $ iterate (`plusPtr` s') p0) go1+		where+		go1 :: Ptr a -> IO img+		go1 p = (imageMake w_ h_ d_+			<$> for (take (h * d) $ iterate (`plusPtr` s) p) \p1 ->+				peekArray w (castPtr p1))+		s = r * (S.sizeOf @(ImagePixel img) undefined)+		s' = s * h+	length imgs = LengthImage 		(imageRow img) (imageWidth img) (imageHeight img)-		(imageDepth img)+		(imageDepth img) (fromIntegral . L.length $ otoList imgs)+		where img = head $ otoList imgs +checkSizes :: IsImage img => [img] -> Maybe String+checkSizes [] = Just "at least one layer required"+checkSizes (img : imgs) = if all ck imgs+	then Nothing else Just "all layers should be same size"+	where+	ck i = imageRow i == r && imageWidth i == w &&+		imageHeight i == h && imageDepth i == d+	r = imageRow img; w = imageWidth img+	h = imageHeight img; d = imageDepth img+ -- SIZE AND ALIGNMENT  class SizeAlignment obj where@@ -183,7 +207,7 @@  instance (KnownNat algn, S.Storable (ImagePixel img)) => 	SizeAlignment ((ImageMaybeName algn img nm)) where-	size (LengthImage r _w h d) = r * h * d * applyAlign algn sz+	size (LengthImage r _w h d lc) = r * h * d * lc * applyAlign algn sz 		where 		sz = fromIntegral $ S.sizeOf @(ImagePixel img) undefined 		algn = alignment @((ImageMaybeName algn img nm))