GPipe 2.1.2 → 2.1.3

raw patch · 4 files changed

+23/−14 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• GPipe.cabal +1/−1
• src/Graphics/GPipe/Internal/Expr.hs +14/−9
• src/Graphics/GPipe/Internal/FrameBuffer.hs +4/−4

@@ -1,5 +1,9 @@ ### 2.1.2
 
+- Fixed bug in clearImage
+
+### 2.1.2
+
 - Fixed bug when nesting while, ifThen, ifThenElse or ifThenElse'. 
 
 ### 2.1.1

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

@@ -220,6 +220,7 @@ 
 -----------------------
 
+-- | An opaque type
 data ShaderBase a x where
     ShaderBaseFloat :: S x Float -> ShaderBase (S x Float) x 
     ShaderBaseInt :: S x Int -> ShaderBase (S x Int) x 
@@ -275,10 +276,14 @@                          m <- ask
                          return $ S $ fmap (!!i) m
 
-    
+-- | Constraint for types that may pass in and out of shader control structures. Define your own instances in terms of others and make sure to
+--   make toBase as lazy as possible.    
 class ShaderType a x where
+    -- | A base type that this type can convert into. Use the 'ShaderBaseType' function on an existing instance of 'ShaderType' to define this in your instance.  
     type ShaderBaseType a
+    -- | Convert this type to the shader base type. Make sure this is as lazy as possible (e.g. use tilde (@~@) on each pattern match).
     toBase :: x -> a -> ShaderBase (ShaderBaseType a) x
+    -- | Convert back from the shader base type to this type. 
     fromBase :: x -> ShaderBase (ShaderBaseType a) x -> a
     
 instance ShaderType (S x Float) x where
@@ -359,16 +364,16 @@         ifThenElse_ bool thn els a = 
             let ifM = memoizeM $ do
                            boolStr <- unS bool
-                           (lifted, aDecls) <- runWriterT $ shaderbaseDeclare (toBase x (undefined :: a))
+                           (lifted, aDecls) <- runWriterT $ shaderbaseDeclare (toBase x (errShaderType :: a))
                            void $ evalStateT (shaderbaseAssign a) aDecls
-                           decls <- execWriterT $ shaderbaseDeclare (toBase x (undefined :: b))
+                           decls <- execWriterT $ shaderbaseDeclare (toBase x (errShaderType :: b))
                            tellIf boolStr                
                            scopedM $ void $ evalStateT (shaderbaseAssign $ thn lifted) decls                                    
                            T.lift $ T.lift $ tell "} else {\n"                   
                            scopedM $ void $ evalStateT (shaderbaseAssign $ els lifted) decls
                            T.lift $ T.lift $ tell "}\n"                                                 
                            return decls
-            in evalState (runReaderT (shaderbaseReturn (toBase x (undefined :: b))) ifM) 0
+            in evalState (runReaderT (shaderbaseReturn (toBase x (errShaderType :: b))) ifM) 0
 
 -- | @ifThen c f x@ will return @f x@ if @c@ evaluates to 'true' or @x@ otherwise. 
 --
@@ -382,15 +387,14 @@         ifThen_ bool thn a = 
             let ifM = memoizeM $ do
                            boolStr <- unS bool
-                           (lifted, decls) <- runWriterT $ shaderbaseDeclare (toBase x (undefined :: a))
+                           (lifted, decls) <- runWriterT $ shaderbaseDeclare (toBase x (errShaderType :: a))
                            void $ evalStateT (shaderbaseAssign a) decls
                            tellIf boolStr
                            scopedM $ void $ evalStateT (shaderbaseAssign $ thn lifted) decls                                    
                            T.lift $ T.lift $ tell "}\n"
                            return decls
-            in evalState (runReaderT (shaderbaseReturn (toBase x (undefined :: a))) ifM) 0
+            in evalState (runReaderT (shaderbaseReturn (toBase x (errShaderType :: a))) ifM) 0
     
-
 tellIf :: RValue -> ExprM ()
 tellIf boolStr = T.lift $ T.lift $ tell $ mconcat ["if(", boolStr, "){\n" ]
 
@@ -401,7 +405,7 @@         x = undefined :: x
         while_ :: (ShaderBase (ShaderBaseType a) x -> S x Bool) -> (ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x) -> ShaderBase (ShaderBaseType a) x -> ShaderBase (ShaderBaseType a) x                                 
         while_ bool loopF a = let whileM = memoizeM $ do
-                                           (lifted, decls) <- runWriterT $ shaderbaseDeclare (toBase x (undefined :: a))
+                                           (lifted, decls) <- runWriterT $ shaderbaseDeclare (toBase x (errShaderType :: a))
                                            void $ evalStateT (shaderbaseAssign a) decls
                                            boolDecl <- tellAssignment STypeBool (unS $ bool a)
                                            T.lift $ T.lift $ tell $ mconcat ["while(", boolDecl, "){\n" ]                                           
@@ -412,8 +416,9 @@                                                tellAssignment' boolDecl loopedBoolStr
                                            T.lift $ T.lift $ tell "}\n"
                                            return decls
-                             in evalState (runReaderT (shaderbaseReturn (toBase x (undefined :: a))) whileM) 0
+                             in evalState (runReaderT (shaderbaseReturn (toBase x (errShaderType :: a))) whileM) 0
 
+errShaderType = error "toBase in an instance of ShaderType is not lazy enough! Make sure you use tilde (~) for each pattern match on a data constructor."
 
 --------------------------------------------------------------------------------------------------------------------------------
 --------------------------------------------------------------------------------------------------------------------------------

@@ -333,7 +333,7 @@ -----------
 
 -- | Fill a color image with a constant color value
-clearColorImage :: forall c os f. ColorRenderable c => Image c -> Color c (ColorElement c) -> Render os f ()
+clearColorImage :: forall c os f. ColorRenderable c => Image (Format c) -> Color c (ColorElement c) -> Render os f ()
 clearColorImage i c = do cd <- getRenderContextData
                          key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                          let fbokey = FBOKeys [key] Nothing Nothing
@@ -360,7 +360,7 @@                                                    glEnable GL_SCISSOR_TEST
 
 -- | Fill a depth image with a constant depth value (in the range [0,1])
-clearDepthImage :: DepthRenderable d => Image d -> Float -> Render os f ()
+clearDepthImage :: DepthRenderable d => Image (Format d) -> Float -> Render os f ()
 clearDepthImage i d = do cd <- getRenderContextData
                          key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                          let fbokey = FBOKeys [] (Just key) Nothing
@@ -386,7 +386,7 @@                                                    glEnable GL_SCISSOR_TEST
 
 -- | Fill a depth image with a constant stencil value
-clearStencilImage :: StencilRenderable s => Image s -> Int -> Render os f ()
+clearStencilImage :: StencilRenderable s => Image (Format s) -> Int -> Render os f ()
 clearStencilImage i s = do cd <- getRenderContextData
                            key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                            let fbokey = FBOKeys [] Nothing (Just key)
@@ -412,7 +412,7 @@                                                      glEnable GL_SCISSOR_TEST
 
 -- | Fill a combined depth stencil image with a constant depth value (in the range [0,1]) and a constant stencil value
-clearDepthStencilImage :: Image DepthStencil -> Float -> Int -> Render os f ()
+clearDepthStencilImage :: Image (Format DepthStencil) -> Float -> Int -> Render os f ()
 clearDepthStencilImage i d s = do
                            cd <- getRenderContextData
                            key <- Render $ lift $ lift $ lift $ getImageFBOKey i