luminance 0.6 → 0.6.0.1
raw patch · 5 files changed
+58/−13 lines, 5 files
Files
- CHANGELOG.md +7/−0
- luminance.cabal +3/−2
- src/Graphics/Luminance/Core/Shader/Program.hs +6/−5
- src/Graphics/Luminance/Core/Shader/UniformBlock.hs +40/−5
- src/Graphics/Luminance/Core/Tuple.hs +2/−1
CHANGELOG.md view
@@ -1,3 +1,10 @@+### 0.6.0.1++- Fixed `(:*:)` for `UniformBlock`.+- Dumped the `Storable` constraint in the `uniBlock` function (rank2 function passed to build+ uniform interfaces to `createProgram`).+- Added `(:.)`, `(,)`, `(,,)` and `(,,,)` into `UniformBlock`.+ # 0.6 #### Breaking changes
luminance.cabal view
@@ -1,6 +1,6 @@ name: luminance-version: 0.6-synopsis: Type-safe, dependently-typed and stateless graphics framework+version: 0.6.0.1+synopsis: Type-safe, type-level 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 others will be added later on, such as Vulkan.@@ -98,6 +98,7 @@ default-extensions: DataKinds , DeriveFoldable , DeriveFunctor+ , DeriveGeneric , FlexibleContexts , FlexibleInstances , GADTs
src/Graphics/Luminance/Core/Shader/Program.hs view
@@ -16,15 +16,16 @@ import Control.Monad.Trans.Resource ( MonadResource, register ) import Control.Monad.Trans.State ( StateT, evalStateT, gets, modify ) import Data.Foldable ( traverse_ )+import Data.Proxy ( Proxy(..) ) import Foreign.C ( peekCString, withCString ) import Foreign.Marshal.Alloc ( alloca ) import Foreign.Marshal.Array ( allocaArray ) import Foreign.Ptr ( castPtr, nullPtr )-import Foreign.Storable ( Storable(peek, sizeOf) )+import Foreign.Storable ( Storable(peek) ) import Graphics.Luminance.Core.Buffer ( Region(..), bufferID ) import Graphics.Luminance.Core.Shader.Stage ( Stage(..) ) import Graphics.Luminance.Core.Shader.Uniform ( U(..), Uniform(..) )-import Graphics.Luminance.Core.Shader.UniformBlock ( UB, UniformBlock )+import Graphics.Luminance.Core.Shader.UniformBlock ( UB, UniformBlock(sizeOfSTD140) ) import Graphics.GL import Numeric.Natural ( Natural ) @@ -47,7 +48,7 @@ -- the function you pass as argument. You can use that value to gather uniforms for instance. createProgram :: (HasProgramError e,MonadError e m,MonadIO m,MonadResource m) => [Stage]- -> ((forall a. (Uniform a) => Either String Natural -> UniformInterface m (U a)) -> (forall a. (Storable a,UniformBlock a) => String -> UniformInterface m (U (Region rw (UB a)))) -> UniformInterface m i)+ -> ((forall a. (Uniform a) => Either String Natural -> UniformInterface m (U a)) -> (forall a. (UniformBlock a) => String -> UniformInterface m (U (Region rw (UB a)))) -> UniformInterface m i) -> m (Program,i) createProgram stages buildIface = do (pid,linked,cl) <- liftIO $ do@@ -127,7 +128,7 @@ | otherwise -> throwError . fromProgramError $ InactiveUniform access -- |Map a 'String' to a uniform block.-uniformizeBlock :: forall a e m rw. (HasProgramError e,MonadError e m,MonadIO m,Storable a,UniformBlock a)+uniformizeBlock :: forall a e m rw. (HasProgramError e,MonadError e m,MonadIO m,UniformBlock a) => Program -> String -> UniformInterface m (U (Region rw (UB a)))@@ -145,7 +146,7 @@ binding (bufferID $ regionBuffer r) (fromIntegral $ regionOffset r)- (fromIntegral $ regionSize r * sizeOf (undefined :: a))+ (fromIntegral $ regionSize r * sizeOfSTD140 (Proxy :: Proxy a)) | otherwise -> throwError . fromProgramError $ InactiveUniformBlock name --------------------------------------------------------------------------------
src/Graphics/Luminance/Core/Shader/UniformBlock.hs view
@@ -21,6 +21,7 @@ import Foreign.Ptr ( Ptr ) import Foreign.Storable ( Storable(..), peekByteOff, pokeByteOff ) import GHC.Generics+import Graphics.Luminance.Core.Tuple ( (:.) ) import Linear.V2 ( V2 ) import Linear.V3 ( V3 ) import Linear.V4 ( V4 )@@ -40,6 +41,9 @@ -- Uniform block --------------------------------------------------------------- class UniformBlock a where+ isStruct :: proxy a -> Bool+ isStruct _ = True+ alignmentSTD140 :: proxy a -> Int default alignmentSTD140 :: (Generic a,GUniformBlock (Rep a)) => proxy a -> Int alignmentSTD140 _ = galignmentSTD140 (Proxy :: Proxy (Rep a))@@ -48,6 +52,10 @@ default sizeOfSTD140 :: (Generic a,GUniformBlock (Rep a)) => proxy a -> Int sizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy (Rep a)) + paddingSTD140 :: proxy a -> Int+ default paddingSTD140 :: (Generic a,GUniformBlock (Rep a)) => proxy a -> Int+ paddingSTD140 _ = gpaddingSTD140 (Proxy :: Proxy (Rep a))+ peekSTD140 :: (MonadIO m) => Ptr b -> Int -> m a default peekSTD140 :: (Generic a,GUniformBlock (Rep a),MonadIO m) => Ptr b -> Int -> m a peekSTD140 p o = liftIO $ fmap to (gpeekSTD140 p o)@@ -65,47 +73,54 @@ class GUniformBlock f where galignmentSTD140 :: proxy f -> Int gsizeOfSTD140 :: proxy f -> Int+ gpaddingSTD140 :: proxy f -> Int gpeekSTD140 :: (MonadIO m) => Ptr b -> Int -> m (f a) gpokeSTD140 :: (MonadIO m) => Ptr b -> Int -> f a -> m () instance GUniformBlock U1 where galignmentSTD140 _ = 1 gsizeOfSTD140 _ = 0+ gpaddingSTD140 _ = 0 gpeekSTD140 _ _ = pure U1 gpokeSTD140 _ _ _ = pure () instance (GUniformBlock f,GUniformBlock g) => GUniformBlock (f :*: g) where galignmentSTD140 _ = galignmentSTD140 (Proxy :: Proxy f) `max` galignmentSTD140 (Proxy :: Proxy g)- gsizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy f) + gsizeOfSTD140 (Proxy :: Proxy g)+ gsizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy f) - gpaddingSTD140 (Proxy :: Proxy f) + gsizeOfSTD140 (Proxy :: Proxy g)+ gpaddingSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy (f :*: g)) `rem` 16 gpeekSTD140 p o = liftIO $ (:*:) <$> gpeekSTD140 p o- <*> gpeekSTD140 p (o + roundUp 32 (gsizeOfSTD140 (Proxy :: Proxy f)))+ <*> gpeekSTD140 p (o + gsizeOfSTD140 (Proxy :: Proxy f) - gpaddingSTD140 (Proxy :: Proxy f)) gpokeSTD140 p o (f :*: g) = liftIO $ do gpokeSTD140 p o f- gpokeSTD140 p (o + roundUp 32 (gsizeOfSTD140 (Proxy :: Proxy f))) g+ gpokeSTD140 p (o + gsizeOfSTD140 (Proxy :: Proxy f) - gpaddingSTD140 (Proxy :: Proxy f)) g instance (GUniformBlock f) => GUniformBlock (D1 c f) where galignmentSTD140 _ = galignmentSTD140 (Proxy :: Proxy f) gsizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy f)+ gpaddingSTD140 _ = gpaddingSTD140 (Proxy :: Proxy f) gpeekSTD140 p o = fmap M1 (gpeekSTD140 p o) gpokeSTD140 p o (M1 a) = gpokeSTD140 p o a instance (GUniformBlock f) => GUniformBlock (C1 c f) where- galignmentSTD140 _ = roundUp 32 (galignmentSTD140 (Proxy :: Proxy f))- gsizeOfSTD140 _ = roundUp 32 (gsizeOfSTD140 (Proxy :: Proxy f))+ galignmentSTD140 _ = galignmentSTD140 (Proxy :: Proxy f)+ gsizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy f)+ gpaddingSTD140 _ = gpaddingSTD140 (Proxy :: Proxy f) gpeekSTD140 p o = fmap M1 (gpeekSTD140 p o) gpokeSTD140 p o (M1 a) = gpokeSTD140 p o a instance (GUniformBlock f) => GUniformBlock (S1 c f) where galignmentSTD140 _ = galignmentSTD140 (Proxy :: Proxy f) gsizeOfSTD140 _ = gsizeOfSTD140 (Proxy :: Proxy f)+ gpaddingSTD140 _ = gpaddingSTD140 (Proxy :: Proxy f) gpeekSTD140 p o = fmap M1 (gpeekSTD140 p o) gpokeSTD140 p o (M1 a) = gpokeSTD140 p o a instance (UniformBlock c) => GUniformBlock (K1 i c) where galignmentSTD140 _ = alignmentSTD140 (Proxy :: Proxy c) gsizeOfSTD140 _ = sizeOfSTD140 (Proxy :: Proxy c)+ gpaddingSTD140 _ = paddingSTD140 (Proxy :: Proxy c) gpeekSTD140 p o = fmap K1 (peekSTD140 p o) gpokeSTD140 p o (K1 a) = pokeSTD140 p o a @@ -113,46 +128,66 @@ -- Basic instances ------------------------------------------------------------- instance UniformBlock Int32 where+ isStruct _ = False alignmentSTD140 _ = 4 sizeOfSTD140 _ = 4+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a) instance UniformBlock Word32 where+ isStruct _ = False alignmentSTD140 _ = 4 sizeOfSTD140 _ = 4+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a) instance UniformBlock Float where+ isStruct _ = False alignmentSTD140 _ = 4 sizeOfSTD140 _ = 4+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a) instance UniformBlock Bool where+ isStruct _ = False alignmentSTD140 _ = 4 sizeOfSTD140 _ = 4+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (fmap toBool $ peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o $ fromBool a) instance (Storable a,UniformBlock a) => UniformBlock (V2 a) where+ isStruct _ = False alignmentSTD140 _ = alignmentSTD140 (Proxy :: Proxy a) * 2 sizeOfSTD140 _ = sizeOfSTD140 (Proxy :: Proxy a) * 2+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a) instance (Storable a,UniformBlock a) => UniformBlock (V3 a) where+ isStruct _ = False alignmentSTD140 _ = alignmentSTD140 (Proxy :: Proxy a) * 4 sizeOfSTD140 _ = sizeOfSTD140 (Proxy :: Proxy a) * 4+ paddingSTD140 _ = sizeOfSTD140 (Proxy :: Proxy a) peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a) instance (Storable a,UniformBlock a) => UniformBlock (V4 a) where+ isStruct _ = False alignmentSTD140 _ = alignmentSTD140 (Proxy :: Proxy a) * 4 sizeOfSTD140 _ = sizeOfSTD140 (Proxy :: Proxy a) * 4+ paddingSTD140 _ = 0 peekSTD140 p o = liftIO (peekByteOff p o) pokeSTD140 p o a = liftIO (pokeByteOff p o a)++instance (UniformBlock a,UniformBlock b) => UniformBlock (a :. b) where++instance (UniformBlock a,UniformBlock b) => UniformBlock (a,b)+instance (UniformBlock a,UniformBlock b,UniformBlock c) => UniformBlock (a,b,c)+instance (UniformBlock a,UniformBlock b,UniformBlock c,UniformBlock d) => UniformBlock (a,b,c,d) fromBool :: Bool -> Int32 fromBool False = 0
src/Graphics/Luminance/Core/Tuple.hs view
@@ -12,11 +12,12 @@ import Foreign.Storable ( Storable(..) ) import Foreign.Ptr ( castPtr, plusPtr )+import GHC.Generics ( Generic ) -- |A tuple of types, right-associated. -- -- The 'Storable' instance is used for foreign packing on 32-bit.-data a :. b = a :. b deriving (Eq,Functor,Ord,Show)+data a :. b = a :. b deriving (Eq,Functor,Generic,Ord,Show) infixr 6 :.