luminance 0.5.2 → 0.5.2.1
raw patch · 3 files changed
+37/−38 lines, 3 filesdep ~linear
Dependency ranges changed: linear
Files
- CHANGELOG.md +6/−0
- luminance.cabal +2/−2
- src/Graphics/Luminance/Core/Buffer.hs +29/−36
CHANGELOG.md view
@@ -1,3 +1,9 @@+### 0.5.2.1++- Relaxed lower bound of `linear` to accept `linear-1.19.*`. That changes should enable `lumimance`+ to be included into stackage.+- Changed internal representation of `Region`.+ ## 0.5.2 #### Minor changes
luminance.cabal view
@@ -1,5 +1,5 @@ name: luminance-version: 0.5.2+version: 0.5.2.1 synopsis: Type-safe, dependently-typed and stateless graphics framework description: This package exposes several modules to work with /GPUs/ in a stateless and type-safe way. Currently, it uses OpenGL as backend hardware technology but@@ -119,7 +119,7 @@ , contravariant >= 1.3 && < 1.4 , dlist >= 0.7 && < 0.8 , gl >= 0.7 && < 0.8- , linear >= 1.20 && < 1.21+ , linear >= 1.19 && < 1.21 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 , semigroups >= 0.16 && < 0.17
src/Graphics/Luminance/Core/Buffer.hs view
@@ -32,7 +32,7 @@ -- Create a new 'Buffer' and return its GPU address by mapping it to a @Ptr ()@. mkBuffer :: (MonadIO m,MonadResource m) => GLbitfield- -> Word32+ -> Int -> m (Buffer,Ptr ()) mkBuffer flags size = do (bid,mapped) <- liftIO . alloca $ \p -> do@@ -44,10 +44,10 @@ pure (Buffer bid,mapped) -- Create the required OpenGL storage for a 'Buffer'.-createStorage :: GLuint -> GLbitfield -> Word32 -> IO (Ptr ())+createStorage :: GLuint -> GLbitfield -> Int -> IO (Ptr ()) createStorage bid flags size = do glNamedBufferStorage bid bytes nullPtr flags- ptr <- glMapNamedBufferRange bid 0 bytes flags+ ptr <- glMapNamedBufferRange bid 0 (fromIntegral size) flags pure ptr where bytes = fromIntegral size@@ -62,10 +62,10 @@ -> m (a,Buffer) mkBufferWithRegions flags buildRegions = do (buffer,mapped) <- mkBuffer flags bytes- pure (fst $ evalRWS built mapped 0,buffer)+ pure (fst $ evalRWS built (buffer,mapped) 0,buffer) where built = runBuildRegion buildRegions- (bytes,_) = execRWS built nullPtr 0+ (bytes,_) = execRWS built (Buffer 0,nullPtr) 0 -- |'Buffer'’s 'Region's can have reads and writes. That typeclass makes implements all possible -- cases.@@ -97,38 +97,33 @@ -- |A 'Region' is a GPU typed memory area. It can be pictured as a GPU array. data Region rw a = Region {- regionPtr :: Ptr a- , regionSize :: RegionSize a+ regionPtr :: Ptr a -- mapped pointer (into GPU memory)+ , regionOffset :: Int+ , regionSize :: Int -- number of elements living in that region+ , regionBuffer :: Buffer -- buffer the region lays in } deriving (Eq,Show) --- FIXME: do we really need that?!--- |Size of a region, in elements. You don’t have to worry about bytes consideration. If you want--- a @Region rw Float@ with 10 elements in it, use @RegionSize 10@. That’s as simple as that.-newtype RegionSize a = RegionSize Word32 deriving (Eq,Num,Show)---- Get the size in bytes of a 'RegionSize'.-bytesOfR :: forall a. (Storable a) => RegionSize a -> Word32-bytesOfR (RegionSize size) = fromIntegral (sizeOf (undefined :: a)) * size- -- |Convenient type to build 'Region's. newtype BuildRegion rw a = BuildRegion {- runBuildRegion :: RWS (Ptr ()) () Word32 a+ runBuildRegion :: RWS (Buffer,Ptr ()) () Int a } deriving (Applicative,Functor,Monad) -- |Create a new 'Region' by providing the number of wished elements. newRegion :: forall rw a. (Storable a) => Word32 -> BuildRegion rw (Region rw a) newRegion size = BuildRegion $ do offset <- get- put $ offset + bytesOfR regionS- ptr <- ask- pure $ Region (castPtr $ ptr `plusPtr` fromIntegral offset) regionS- where- regionS :: RegionSize a- regionS = RegionSize size+ put $ offset + fromIntegral size * sizeOf (undefined :: a)+ (buffer,ptr) <- ask+ pure $ Region {+ regionPtr = (castPtr $ ptr `plusPtr` fromIntegral offset)+ , regionOffset = offset+ , regionSize = fromIntegral size+ , regionBuffer = buffer+ } -- |Read a whole 'Region'. readWhole :: (MonadIO m,Readable r,Storable a) => Region r a -> m [a]-readWhole (Region p (RegionSize nb)) = liftIO $ peekArray (fromIntegral nb) p+readWhole r = liftIO $ peekArray (regionSize r) (regionPtr r) -- |Write the whole 'Region'. If value are missing, only the provided values will replace the -- existing ones. If there are more values than the size of the 'Region', they are ignored.@@ -136,30 +131,28 @@ => Region w a -> f a -> m ()-writeWhole (Region p (RegionSize nb)) values =- liftIO . pokeArray p . take (fromIntegral nb) $ toList values+writeWhole r values = liftIO . pokeArray (regionPtr r) . take (regionSize r) $ toList values -- |Fill a 'Region' with a value. fill :: (MonadIO m,Storable a,Writable w) => Region w a -> a -> m ()-fill (Region p (RegionSize nb)) a =- liftIO . pokeArray p $ replicate (fromIntegral nb) a+fill r a = liftIO . pokeArray (regionPtr r) $ replicate (regionSize r) a -- |Index getter. Bounds checking is performed and returns 'Nothing' if out of bounds. (@?) :: (MonadIO m,Storable a,Readable r) => Region r a -> Word32 -> m (Maybe a)-Region p (RegionSize nb) @? i- | i >= nb = pure Nothing- | otherwise = liftIO $ Just <$> peekElemOff p (fromIntegral i)+r @? i+ | i >= fromIntegral (regionSize r) = pure Nothing+ | otherwise = liftIO $ Just <$> peekElemOff (regionPtr r) (fromIntegral i) -- |Index getter. Unsafe version of '(@?)'. (@!) :: (MonadIO m,Storable a,Readable r) => Region r a -> Word32 -> m a-Region p _ @! i = liftIO $ peekElemOff p (fromIntegral i)+r @! i = liftIO $ peekElemOff (regionPtr r) (fromIntegral i) -- |Index setter. Bounds checking is performed and nothing is done if out of bounds. writeAt :: (MonadIO m,Storable a,Writable w) => Region w a -> Word32 -> a -> m ()-writeAt (Region p (RegionSize nb)) i a- | i >= nb = pure ()- | otherwise = liftIO $ pokeElemOff p (fromIntegral i) a+writeAt r i a+ | i >= fromIntegral (regionSize r) = pure ()+ | otherwise = liftIO $ pokeElemOff (regionPtr r) (fromIntegral i) a -- |Index setter. Unsafe version of 'writeAt''. writeAt' :: (MonadIO m,Storable a,Writable w) => Region w a -> Word32 -> a -> m ()-writeAt' (Region p _) i a = liftIO $ pokeElemOff p (fromIntegral i) a+writeAt' r i a = liftIO $ pokeElemOff (regionPtr r) (fromIntegral i) a