vinyl-gl 0.1.3.2 → 0.2

raw patch · 5 files changed

+77/−68 lines, 5 filesdep ~vinylPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vinyl

API changes (from Hackage documentation)

Files

• src/Data/Vinyl/Reflect.hs +21/−18
• src/Graphics/VinylGL/Uniforms.hs +25/−23
• src/Graphics/VinylGL/Vertex.hs +24/−21
• tests/BasicTest.hs +5/−4
• vinyl-gl.cabal +2/−2

@@ -1,11 +1,11 @@ {-# LANGUAGE DataKinds, TypeOperators, FlexibleContexts, FlexibleInstances, -             ScopedTypeVariables, CPP #-}+             ScopedTypeVariables, CPP, KindSignatures #-} -- | Reflection utilities for vinyl records. module Data.Vinyl.Reflect where import Data.Foldable (Foldable, foldMap)-import Data.Vinyl.Idiom.Identity import Data.Monoid (Sum(..))-import Data.Vinyl (Rec, PlainRec, (:::))+import Data.Vinyl (FieldRec, PlainFieldRec)+import Data.Vinyl.Universe ((:::)) import Foreign.Storable (Storable(sizeOf)) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 import           Data.Proxy@@ -16,29 +16,32 @@ class HasFieldNames a where   fieldNames :: a -> [String] -instance HasFieldNames (Rec '[] f) where+instance HasFieldNames (FieldRec f '[]) where   fieldNames _ = []  #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707-instance (KnownSymbol sy, HasFieldNames (Rec ts Identity))-  => HasFieldNames (Rec ((sy:::t) ': ts) Identity) where-  fieldNames _ = symbolVal (Proxy::Proxy sy) : fieldNames (undefined::PlainRec ts)+instance (KnownSymbol sy, HasFieldNames (PlainFieldRec ts))+  => HasFieldNames (PlainFieldRec (((sy::Symbol):::t) ': ts)) where+  fieldNames _ = symbolVal (Proxy::Proxy sy)+                 : fieldNames (undefined::PlainFieldRec ts) #else-instance (SingI sy, HasFieldNames (Rec ts Identity))-  => HasFieldNames (Rec ((sy:::t) ': ts) Identity) where-  fieldNames _ = fromSing (sing::Sing sy) : fieldNames (undefined::PlainRec ts)+instance (SingI sy, HasFieldNames (PlainFieldRec ts))+  => HasFieldNames (PlainFieldRec (((sy::Symbol):::t) ': ts)) where+  fieldNames _ = fromSing (sing::Sing sy)+                 : fieldNames (undefined::PlainFieldRec ts) #endif  -- | Compute the size in bytes of of each field in a record. class HasFieldSizes a where   fieldSizes :: a -> [Int] -instance HasFieldSizes (Rec '[] f) where+instance HasFieldSizes (FieldRec f '[]) where   fieldSizes _ = [] -instance (HasFieldSizes (Rec ts Identity), Storable t)-  => HasFieldSizes (Rec ((sy:::t) ': ts) Identity) where-  fieldSizes _ = sizeOf (undefined::t) : fieldSizes (undefined::PlainRec ts)+instance (HasFieldSizes (PlainFieldRec ts), Storable t)+  => HasFieldSizes (PlainFieldRec (((sy::Symbol) ::: t) ': ts)) where+  fieldSizes _ = sizeOf (undefined::t)+                 : fieldSizes (undefined::PlainFieldRec ts)  -- | Compute the dimensionality of each field in a record. This is -- primarily useful for things like the small finite vector types@@ -46,10 +49,10 @@ class HasFieldDims a where   fieldDims :: a -> [Int] -instance HasFieldDims (Rec '[] f) where+instance HasFieldDims (FieldRec f '[]) where   fieldDims _ = [] -instance (HasFieldDims (PlainRec ts), Foldable v, Num (v a))-  => HasFieldDims (PlainRec (sy:::v a ': ts)) where+instance (HasFieldDims (PlainFieldRec ts), Foldable v, Num (v a))+  => HasFieldDims (PlainFieldRec ((sy::Symbol):::v a ': ts)) where   fieldDims _ = getSum (foldMap (const (Sum 1)) (0::v a))-                : fieldDims (undefined::PlainRec ts)+                : fieldDims (undefined::PlainFieldRec ts)

@@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds, TypeOperators, FlexibleContexts, FlexibleInstances,-             GADTs, ScopedTypeVariables, ConstraintKinds #-}+             GADTs, ScopedTypeVariables, ConstraintKinds, KindSignatures #-} -- | Tools for binding vinyl records to GLSL program uniform -- parameters. The most common usage is to use the 'setUniforms' -- function to set each field of a 'PlainRec' to the GLSL uniform@@ -10,27 +10,29 @@                                   HasFieldGLTypes(..), SetUniformFields) where import Control.Applicative ((<$>)) import Data.Foldable (traverse_)-import Data.Vinyl.Idiom.Identity import qualified Data.Map as M import Data.Maybe (fromMaybe) import qualified Data.Set as S-import Data.Vinyl+import Data.Vinyl (FieldRec, PlainFieldRec, Rec(..))+import Data.Vinyl.Idiom.Identity+import Data.Vinyl.Reflect (HasFieldNames(..))+import Data.Vinyl.Universe ((:::))+import GHC.TypeLits (Symbol) import Graphics.GLUtil (HasVariableType(..), ShaderProgram(..), AsUniform(..)) import Graphics.Rendering.OpenGL as GL-import Data.Vinyl.Reflect (HasFieldNames(..))  -- | Provide the 'GL.VariableType' of each field in a 'Rec'. The list -- of types has the same order as the fields of the 'Rec'. class HasFieldGLTypes a where   fieldGLTypes :: a -> [GL.VariableType] -instance HasFieldGLTypes (Rec '[] f) where+instance HasFieldGLTypes (FieldRec f '[]) where   fieldGLTypes _ = [] -instance (HasVariableType t, HasFieldGLTypes (PlainRec ts))-  => HasFieldGLTypes (PlainRec (sy:::t ': ts)) where+instance (HasVariableType t, HasFieldGLTypes (PlainFieldRec ts))+  => HasFieldGLTypes (PlainFieldRec ((sy::Symbol):::t ': ts)) where   fieldGLTypes _ = variableType (undefined::t) -                   : fieldGLTypes (undefined::PlainRec ts)+                   : fieldGLTypes (undefined::PlainFieldRec ts)  type UniformFields a = (HasFieldNames a, HasFieldGLTypes a, SetUniformFields a) @@ -38,45 +40,45 @@ -- performed to verify that /all/ uniforms used by a program are -- represented by the record type. In other words, the record is a -- superset of the parameters used by the program.-setAllUniforms :: forall ts. UniformFields (PlainRec ts)-            => ShaderProgram -> PlainRec ts -> IO ()+setAllUniforms :: forall ts. UniformFields (PlainFieldRec ts)+            => ShaderProgram -> PlainFieldRec ts -> IO () setAllUniforms s x = case checks of                     Left msg -> error msg                     Right _ -> setUniformFields locs x-  where fnames = fieldNames (undefined::PlainRec ts)+  where fnames = fieldNames (undefined::PlainFieldRec ts)         checks = do namesCheck "record" (M.keys $ uniforms s) fnames                     typesCheck True (snd <$> uniforms s) fieldTypes         fieldTypes = M.fromList $-                     zip fnames (fieldGLTypes (undefined::PlainRec ts))+                     zip fnames (fieldGLTypes (undefined::PlainFieldRec ts))         locs = map (fmap fst . (`M.lookup` uniforms s)) fnames {-# INLINE setAllUniforms #-}  -- | Set GLSL uniform parameters from a 'PlainRec' representing a -- subset of all uniform parameters used by a program.-setUniforms :: forall ts. UniformFields (PlainRec ts)-            => ShaderProgram -> PlainRec ts -> IO ()+setUniforms :: forall ts. UniformFields (PlainFieldRec ts)+            => ShaderProgram -> PlainFieldRec ts -> IO () setUniforms s x = case checks of                     Left msg -> error msg                     Right _ -> setUniformFields locs x-  where fnames = fieldNames (undefined::PlainRec ts)+  where fnames = fieldNames (undefined::PlainFieldRec ts)         checks = do namesCheck "GLSL program" fnames (M.keys $ uniforms s)                     typesCheck False fieldTypes (snd <$> uniforms s)         fieldTypes = M.fromList $-                     zip fnames (fieldGLTypes (undefined::PlainRec ts))+                     zip fnames (fieldGLTypes (undefined::PlainFieldRec ts))         locs = map (fmap fst . (`M.lookup` uniforms s)) fnames {-# INLINE setUniforms #-}  -- | Set GLSL uniform parameters from those fields of a 'PlainRec' -- whose names correspond to uniform parameters used by a program.-setSomeUniforms :: forall ts. UniformFields (PlainRec ts)-                => ShaderProgram -> PlainRec ts -> IO ()+setSomeUniforms :: forall ts. UniformFields (PlainFieldRec ts)+                => ShaderProgram -> PlainFieldRec ts -> IO () setSomeUniforms s x = case typesCheck' True (snd <$> uniforms s) fieldTypes of                         Left msg -> error msg                         Right _ -> setUniformFields locs x-  where fnames = fieldNames (undefined::PlainRec ts)+  where fnames = fieldNames (undefined::PlainFieldRec ts)         {-# INLINE fnames #-}         fieldTypes = M.fromList . zip fnames $-                     fieldGLTypes (undefined::PlainRec ts)+                     fieldGLTypes (undefined::PlainFieldRec ts)         {-# INLINE fieldTypes #-}         locs = map (fmap fst . (`M.lookup` uniforms s)) fnames         {-# INLINE locs #-}@@ -139,12 +141,12 @@ class SetUniformFields a where   setUniformFields :: [Maybe UniformLocation] -> a -> IO () -instance SetUniformFields (Rec '[] f) where+instance SetUniformFields (FieldRec f '[]) where   setUniformFields _ _ = return ()   {-# INLINE setUniformFields #-} -instance (AsUniform t, SetUniformFields (PlainRec ts))-  => SetUniformFields (PlainRec ((sy:::t) ': ts)) where+instance (AsUniform t, SetUniformFields (PlainFieldRec ts))+  => SetUniformFields (PlainFieldRec (((sy::Symbol):::t) ': ts)) where   setUniformFields [] _ = error "Ran out of UniformLocations"   setUniformFields (loc:locs) (Identity x :& xs) =      do traverse_ (asUniform x) loc

@@ -15,7 +15,8 @@ import Data.Monoid (Sum(..)) import Data.Proxy (Proxy(..)) import qualified Data.Vector.Storable as V-import Data.Vinyl ((:::)(..), PlainRec, Implicit(..), Elem)+import Data.Vinyl (PlainFieldRec, Implicit(..), Elem)+import Data.Vinyl.Universe((:::)) import Foreign.Ptr (plusPtr) import Foreign.Storable import GHC.TypeLits@@ -32,13 +33,14 @@   BufferedVertices { getVertexBuffer :: GL.BufferObject }  -- | Load vertex data into a GPU-accessible buffer.-bufferVertices :: (Storable (PlainRec rs), BufferSource (v (PlainRec rs)))-               => v (PlainRec rs) -> IO (BufferedVertices rs)+bufferVertices :: (Storable (PlainFieldRec rs),+                   BufferSource (v (PlainFieldRec rs)))+               => v (PlainFieldRec rs) -> IO (BufferedVertices rs) bufferVertices = fmap BufferedVertices . fromSource ArrayBuffer  -- | Reload 'BufferedVertices' with a 'V.Vector' of new vertex data.-reloadVertices :: Storable (PlainRec rs)-               => BufferedVertices rs -> V.Vector (PlainRec rs) -> IO ()+reloadVertices :: Storable (PlainFieldRec rs)+               => BufferedVertices rs -> V.Vector (PlainFieldRec rs) -> IO () reloadVertices b v = do bindBuffer ArrayBuffer $= Just (getVertexBuffer b)                         replaceVector ArrayBuffer v @@ -53,38 +55,39 @@ -- | Line up a shader's attribute inputs with a vertex record. This -- maps vertex fields to GLSL attributes on the basis of record field -- names on the Haskell side, and variable names on the GLSL side.-enableVertices :: forall f rs. ViableVertex (PlainRec rs)+enableVertices :: forall f rs. ViableVertex (PlainFieldRec rs)                => ShaderProgram -> f rs -> IO (Maybe String)-enableVertices s _ = enableAttribs s (Proxy::Proxy (PlainRec rs))+enableVertices s _ = enableAttribs s (Proxy::Proxy (PlainFieldRec rs))  -- | Behaves like 'enableVertices', but raises an exception if the -- supplied vertex record does not include a field required by the -- shader.-enableVertices' :: forall f rs. ViableVertex (PlainRec rs)+enableVertices' :: forall f rs. ViableVertex (PlainFieldRec rs)                => ShaderProgram -> f rs -> IO ()-enableVertices' s _ = enableAttribs s (Proxy::Proxy (PlainRec rs)) >>=+enableVertices' s _ = enableAttribs s (Proxy::Proxy (PlainFieldRec rs)) >>=                       maybe (return ()) error  -- | Produce a 'GL.VertexArrayDescriptor' for a particular field of a -- vertex record.-fieldToVAD :: forall sy v a r rs. -              (r ~ (sy ::: v a), HasFieldNames (PlainRec rs), -               HasFieldSizes (PlainRec rs), HasGLType a, Storable (PlainRec rs),-               Num (v a),+fieldToVAD :: forall sy v a r rs field proxy.+              (r ~ ((sy :: Symbol) ::: v a), HasFieldNames (PlainFieldRec rs), +               HasFieldSizes (PlainFieldRec rs), HasGLType a,+               Storable (PlainFieldRec rs), Num (v a), #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707                KnownSymbol sy, #else                SingI sy, #endif                Foldable v, Implicit (Elem r rs)) =>-              r -> Proxy (PlainRec rs) -> GL.VertexArrayDescriptor a+              field r -> proxy (PlainFieldRec rs) -> GL.VertexArrayDescriptor a fieldToVAD _ _ = GL.VertexArrayDescriptor dim                                           (glType (undefined::a))-                                          (fromIntegral $-                                           sizeOf (undefined::PlainRec rs))+                                          (fromIntegral sz)                                           (offset0 `plusPtr` offset)-  where dim = getSum $ foldMap (const (Sum 1)) (0::v a)-        Just offset = lookup n $ namesAndOffsets (undefined::PlainRec rs)+  where sz = sizeOf (undefined::PlainFieldRec rs)+        dim = getSum $ foldMap (const (Sum 1)) (0::v a)+        Just offset = lookup n $+                      namesAndOffsets (undefined::PlainFieldRec rs) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707         n = symbolVal (Proxy::Proxy sy) #else@@ -98,10 +101,10 @@ -- | Bind some of a shader's attribute inputs to a vertex record. This -- is useful when the inputs of a shader are split across multiple -- arrays.-enableVertexFields :: forall p rs. (ViableVertex (PlainRec rs))+enableVertexFields :: forall p rs. (ViableVertex (PlainFieldRec rs))                    => ShaderProgram -> p rs -> IO ()-enableVertexFields s _ = enableSomeAttribs s (Proxy::Proxy (PlainRec rs)) >>=-                         maybe (return ()) error+enableVertexFields s _ = enableSomeAttribs s p >>= maybe (return ()) error+  where p = Proxy :: Proxy (PlainFieldRec rs)  -- | Do not raise an error is some of a shader's inputs are not bound -- by a vertex record.

@@ -1,6 +1,7 @@-{-# LANGUAGE DataKinds, TypeOperators #-}+{-# LANGUAGE DataKinds, KindSignatures, TypeOperators #-} import Data.Proxy import Data.Vinyl+import Data.Vinyl.Universe import Data.Word import Foreign.Ptr (nullPtr, plusPtr) import Graphics.Rendering.OpenGL (DataType(..), GLfloat,@@ -14,10 +15,10 @@ type Pos = "vpos" ::: V3 GLfloat type Tag = "tagByte" ::: V1 Word8 -tag :: Tag-tag = Field+tag :: SField Tag+tag = SField -type Vertex = PlainRec [Pos, Tag]+type Vertex = PlainFieldRec [Pos, Tag]  --testVad :: VertexArrayDescriptor Word8 testVad :: Test

@@ -1,5 +1,5 @@ name:          vinyl-gl-version:       0.1.3.2+version:       0.2 synopsis:      Utilities for working with OpenGL's GLSL shading language and vinyl records. description:   Using "Data.Vinyl" records (similar in spirit to @HList@)                to carry GLSL uniform parameters and vertex data enables@@ -27,7 +27,7 @@                        Graphics.VinylGL.Vertex   -- other-modules:          build-depends:       base >= 4.6 && < 5, transformers >= 0.3, -                       vinyl >= 0.3 && < 0.4,+                       vinyl >= 0.4.2 && < 0.4.3,                        containers >= 0.5, GLUtil >= 0.6.4, OpenGL >= 2.8,                         tagged >= 0.4, vector >= 0.10, linear >= 1.1.3   hs-source-dirs:      src