GPipe 2.1.3 → 2.1.4

raw patch · 6 files changed

+41/−14 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• GPipe.cabal +1/−1
• src/Graphics/GPipe/Internal/FragmentStream.hs +7/−1
• src/Graphics/GPipe/Internal/PrimitiveArray.hs +8/−5
• src/Graphics/GPipe/Internal/PrimitiveStream.hs +17/−6
• src/Graphics/GPipe/PrimitiveStream.hs +2/−0

@@ -1,4 +1,9 @@-### 2.1.2
+### 2.1.4
+
+- Fixed bug in dropVertices and dropIndices (#16)
+- Added withPointSize (#15)
+
+### 2.1.3
 
 - Fixed bug in clearImage
 

@@ -1,5 +1,5 @@ name:           GPipe
-version:        2.1.3
+version:        2.1.4
 cabal-version:  >= 1.8
 build-type:     Simple
 author:         Tobias Bexelius

@@ -22,6 +22,8 @@ import Linear.Affine (Point(..))
 
 import Graphics.GL.Core33
+import Control.Monad (when)
+import Data.Maybe (isJust)
 
 type VPos = V4 VFloat
 
@@ -63,23 +65,27 @@         return (FragmentStream $ map (f n) xs) 
     where        
         ToFragment (Kleisli m) = toFragment :: ToFragment a (FragmentFormat a)
-        f n ((p, x),s) = (evalState (m x) 0, FragmentStreamData n (makePos p) s true)
+        f n ((p, x),(ps, s)) = (evalState (m x) 0, FragmentStreamData n (makePos p >> makePointSize ps) s true)
         makePos (V4 (S x) (S y) (S z) (S w)) = do
                                        x' <- x
                                        y' <- y
                                        z' <- z
                                        w' <- w
                                        tellAssignment' "gl_Position" $ "vec4("++x'++',':y'++',':z'++',':w'++")"
+        makePointSize Nothing = return ()
+        makePointSize (Just (S ps)) = ps >>= tellAssignment' "gl_PointSize" 
         io s = let (side, ViewPort (V2 x y) (V2 w h), DepthRange dmin dmax) = sf s in if w < 0 || h < 0 
                                                                                         then error "ViewPort, negative size"
                                                                                         else do setGlCullFace side
                                                                                                 glScissor (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
                                                                                                 glViewport (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) 
                                                                                                 glDepthRange (realToFrac dmin) (realToFrac dmax)
+                                                                                                setGLPointSize
 
         setGlCullFace Front = glEnable GL_CULL_FACE >> glCullFace GL_BACK -- Back is culled when front is rasterized
         setGlCullFace Back = glEnable GL_CULL_FACE >> glCullFace GL_FRONT
         setGlCullFace _ = glDisable GL_CULL_FACE
+        setGLPointSize = if any (isJust.fst.snd) xs then glEnable GL_PROGRAM_POINT_SIZE else glDisable GL_PROGRAM_POINT_SIZE
 
 -- | Defines which side to rasterize. Non triangle primitives only has a front side.
 data Side = Front | Back | FrontAndBack

@@ -43,14 +43,14 @@ 
 -- | @takeVertices n a@ creates a shorter vertex array by taking the @n@ first elements of the array @a@.
 takeVertices :: Int -> VertexArray t a -> VertexArray t a
-takeVertices n (VertexArray m f) = VertexArray (min n m) f
+takeVertices n (VertexArray l f) = VertexArray (min (max n 0) l) f
 
 -- | @dropVertices n a@ creates a shorter vertex array by dropping the @n@ first elements of the array @a@. The argument array @a@ must not be
 --   constrained to only 'Instances'.
 dropVertices :: Int -> VertexArray () a -> VertexArray t a
-dropVertices n (VertexArray m f) = VertexArray n' g
+dropVertices n (VertexArray l f) = VertexArray (l - n') g
         where
-            n' = max (m - n) 0
+            n' = min (max n 0) l
             g bIn = f $ bIn { bInSkipElems = bInSkipElems bIn + n'}
 
 -- | @replicateEach n a@ will create a longer vertex array, only to be used for instances, by replicating each element of the array @a@ @n@ times. E.g.
@@ -81,11 +81,14 @@  
 -- | @takeIndices n a@ creates a shorter index array by taking the @n@ first indices of the array @a@.
 takeIndices :: Int -> IndexArray -> IndexArray
-takeIndices n i = i { indexArrayLength = min n (indexArrayLength i) }
+takeIndices n i = i { indexArrayLength = min (max n 0) (indexArrayLength i) }
 
 -- | @dropIndices n a@ creates a shorter index array by dropping the @n@ first indices of the array @a@.
 dropIndices :: Int -> IndexArray -> IndexArray
-dropIndices n i = i { indexArrayLength = max (l - n) 0, offset = offset i + n } where l = indexArrayLength i
+dropIndices n i = i { indexArrayLength = l - n', offset = offset i + n' } 
+    where 
+        l = indexArrayLength i
+        n' = min (max n 0) l
 
 data Triangles
 data Lines

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, Arrows, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, Arrows, GeneralizedNewtypeDeriving, PatternSynonyms #-}
 
 module Graphics.GPipe.Internal.PrimitiveStream where
 
@@ -39,7 +39,7 @@ --   can operate a stream's vertex values using the 'Functor' instance (this will result in a shader running on the GPU).
 --   You may also append 'PrimitiveStream's using the 'Monoid' instance, but if possible append the origin 'PrimitiveArray's instead, as this will create more optimized
 --   draw calls. 
-newtype PrimitiveStream t a = PrimitiveStream [(a, PrimitiveStreamData)] deriving Monoid
+newtype PrimitiveStream t a = PrimitiveStream [(a, (Maybe PointSize, PrimitiveStreamData))] deriving Monoid
 
 instance Functor (PrimitiveStream t) where
         fmap f (PrimitiveStream xs) = PrimitiveStream $ map (first f) xs
@@ -66,22 +66,26 @@                                    let sampleBuffer = makeBuffer undefined undefined uniAl :: Buffer os a
                                        x = fst $ runWriter (evalStateT (mf $ bufBElement sampleBuffer $ BInput 0 0) 0)
                                    doForInputArray n (map drawcall . getPrimitiveArray . sf)
-                                   return $ PrimitiveStream [(x, PrimitiveStreamData n)] 
+                                   return $ PrimitiveStream [(x, (Nothing, PrimitiveStreamData n))] 
     where 
         ToVertex (Kleisli mf) = toVertex :: ToVertex a (VertexFormat a)
         drawcall (PrimitiveArraySimple p l a) binds = (attribs a binds, glDrawArrays (toGLtopology p) 0 (fromIntegral l)) 
         drawcall (PrimitiveArrayIndexed p i a) binds = (attribs a binds, do
                                                     bindIndexBuffer i
-                                                    glDrawElements (toGLtopology p) (fromIntegral $ indexArrayLength i) (indexType i) (intPtrToPtr $ fromIntegral $ offset i))
+                                                    glDrawElements (toGLtopology p) (fromIntegral $ indexArrayLength i) (indexType i) (intPtrToPtr $ fromIntegral $ offset i * glSizeOf (indexType i)))
         drawcall (PrimitiveArrayInstanced p il l a) binds = (attribs a binds, glDrawArraysInstanced (toGLtopology p) 0 (fromIntegral l) (fromIntegral il))
         drawcall (PrimitiveArrayIndexedInstanced p i il a) binds = (attribs a binds, do
                                                       bindIndexBuffer i
-                                                      glDrawElementsInstanced (toGLtopology p) (fromIntegral $ indexArrayLength i) (indexType i) (intPtrToPtr $ fromIntegral $ offset i) (fromIntegral il))
+                                                      glDrawElementsInstanced (toGLtopology p) (fromIntegral $ indexArrayLength i) (indexType i) (intPtrToPtr $ fromIntegral $ offset i * glSizeOf (indexType i)) (fromIntegral il))
         bindIndexBuffer i = do case restart i of Just x -> do glEnable GL_PRIMITIVE_RESTART 
                                                               glPrimitiveRestartIndex (fromIntegral x)
                                                  Nothing -> glDisable GL_PRIMITIVE_RESTART
                                bname <- readIORef (iArrName i)
-                               glBindBuffer GL_ELEMENT_ARRAY_BUFFER bname 
+                               glBindBuffer GL_ELEMENT_ARRAY_BUFFER bname
+        glSizeOf GL_UNSIGNED_INT = 4
+        glSizeOf GL_UNSIGNED_SHORT = 2
+        glSizeOf GL_UNSIGNED_BYTE = 1 
+        glSizeOf _ = error "toPrimitiveStream: Unknown indexArray type"       
 
         assignIxs :: Int -> Binding -> [Int] -> [Binding -> (IO VAOKey, IO ())] -> [(IO VAOKey, IO ())] 
         assignIxs n ix xxs@(x:xs) (f:fs) | x == n    = f ix : assignIxs (n+1) (ix+1) xs fs
@@ -102,6 +106,13 @@ -- | Like 'fmap', but where the vertex and instance IDs are provided as arguments as well. 
 withInputIndices :: (a -> InputIndices -> b) -> PrimitiveStream p a -> PrimitiveStream p b  
 withInputIndices f = fmap (\a -> f a (InputIndices (scalarS' "gl_VertexID") (scalarS' "gl_InstanceID")))
+
+type PointSize = VFloat
+-- | Like 'fmap', but where each point's size is provided as arguments as well, and a new point size is set for each point in addition to the new vertex value.
+--
+--   When a 'PrimitiveStream' of 'Points' is created, all points will have the default size of 1.
+withPointSize :: (a -> PointSize -> (b, PointSize)) -> PrimitiveStream Points a -> PrimitiveStream Points b  
+withPointSize f (PrimitiveStream xs) = PrimitiveStream $ map (\(a, (ps, d)) -> let (b, ps') = f a (maybe (scalarS' "1") id ps) in (b, (Just ps', d))) xs 
 
 makeVertexFx norm x f styp typ b = do 
                              n <- get

@@ -26,6 +26,8 @@     -- * Various PrimitiveStream operations   
     withInputIndices,   
     InputIndices(..),
+    withPointSize,
+    PointSize
 )
 where