diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/GPipe.cabal b/GPipe.cabal --- a/GPipe.cabal +++ b/GPipe.cabal @@ -1,5 +1,5 @@ name: GPipe -version: 2.1.2 +version: 2.1.3 cabal-version: >= 1.8 build-type: Simple author: Tobias Bexelius diff --git a/src/Graphics/GPipe/Internal/Expr.hs b/src/Graphics/GPipe/Internal/Expr.hs --- a/src/Graphics/GPipe/Internal/Expr.hs +++ b/src/Graphics/GPipe/Internal/Expr.hs @@ -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." -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- diff --git a/src/Graphics/GPipe/Internal/FrameBuffer.hs b/src/Graphics/GPipe/Internal/FrameBuffer.hs --- a/src/Graphics/GPipe/Internal/FrameBuffer.hs +++ b/src/Graphics/GPipe/Internal/FrameBuffer.hs @@ -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