ombra 0.1.0.0 → 0.1.1.0

raw patch · 31 files changed

+972/−458 lines, 31 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Graphics/Rendering/Ombra/Backend.hs +6/−1
• Graphics/Rendering/Ombra/Backend/OpenGL.hs +30/−24
• Graphics/Rendering/Ombra/Backend/WebGL.hs +18/−2
• Graphics/Rendering/Ombra/Backend/WebGL/Const.hs +8/−1
• Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs +4/−1
• Graphics/Rendering/Ombra/Blend.hs +3/−1
• Graphics/Rendering/Ombra/Color.hs +0/−1
• Graphics/Rendering/Ombra/D2.hs +10/−13
• Graphics/Rendering/Ombra/D3.hs +9/−11
• Graphics/Rendering/Ombra/Draw.hs +7/−7
• Graphics/Rendering/Ombra/Draw/Internal.hs +199/−75
• Graphics/Rendering/Ombra/Generic.hs +324/−112
• Graphics/Rendering/Ombra/Geometry.hs +8/−10
• Graphics/Rendering/Ombra/Internal/GL.hs +9/−7
• Graphics/Rendering/Ombra/Internal/Resource.hs +6/−7
• Graphics/Rendering/Ombra/Internal/STVectorLen.hs +0/−31
• Graphics/Rendering/Ombra/Internal/TList.hs +25/−3
• Graphics/Rendering/Ombra/Shader.hs +7/−5
• Graphics/Rendering/Ombra/Shader/CPU.hs +23/−12
• Graphics/Rendering/Ombra/Shader/Default3D.hs +9/−6
• Graphics/Rendering/Ombra/Shader/GLSL.hs +25/−19
• Graphics/Rendering/Ombra/Shader/Language/Functions.hs +1/−2
• Graphics/Rendering/Ombra/Shader/Language/Types.hs +4/−4
• Graphics/Rendering/Ombra/Shader/Program.hs +9/−9
• Graphics/Rendering/Ombra/Shader/ShaderVar.hs +18/−31
• Graphics/Rendering/Ombra/Shader/Stages.hs +6/−10
• Graphics/Rendering/Ombra/Stencil.hs +68/−0
• Graphics/Rendering/Ombra/Texture.hs +73/−31
• Graphics/Rendering/Ombra/Transformation.hs +0/−6
• Graphics/Rendering/Ombra/Types.hs +44/−12
• ombra.cabal +19/−4

@@ -67,6 +67,7 @@         noTexture :: Texture         noVAO :: VertexArrayObject         noUInt8Array :: IO UInt8Array+        noFloat32Array :: IO Float32Array         encodeMat2 :: Mat2 -> IO Float32Array         encodeMat3 :: Mat3 -> IO Float32Array         encodeMat4 :: Mat4 -> IO Float32Array@@ -188,7 +189,8 @@         glStencilMaskSeparate :: Ctx -> GLEnum -> GLUInt -> IO ()         glStencilOp :: Ctx -> GLEnum -> GLEnum -> GLEnum -> IO ()         glStencilOpSeparate :: Ctx -> GLEnum -> GLEnum -> GLEnum -> GLEnum -> IO ()-        glTexImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> UInt8Array -> IO ()+        glTexImage2DUInt :: Ctx -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> UInt8Array -> IO ()+        glTexImage2DFloat :: Ctx -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> Float32Array -> IO ()         glTexParameterf :: Ctx -> GLEnum -> GLEnum -> Float -> IO ()         glTexParameteri :: Ctx -> GLEnum -> GLEnum -> GLInt -> IO ()         glTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> UInt8Array -> IO ()@@ -346,8 +348,10 @@         gl_UNSIGNED_SHORT :: GLEnum         gl_INT :: GLEnum         gl_UNSIGNED_INT :: GLEnum+        gl_UNSIGNED_INT_24_8 :: GLEnum         gl_FLOAT :: GLEnum         gl_DEPTH_COMPONENT :: GLEnum+        gl_DEPTH_STENCIL :: GLEnum         gl_ALPHA :: GLEnum         gl_RGB :: GLEnum         gl_RGBA :: GLEnum@@ -535,6 +539,7 @@         gl_COLOR_ATTACHMENT15 :: GLEnum         gl_DEPTH_ATTACHMENT :: GLEnum         gl_STENCIL_ATTACHMENT :: GLEnum+        gl_DEPTH_STENCIL_ATTACHMENT :: GLEnum         gl_NONE :: GLEnum         gl_FRAMEBUFFER_COMPLETE :: GLEnum         gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT :: GLEnum

@@ -73,7 +73,7 @@         type GLPtr = Ptr ()         type GLPtrDiff = GLintptr         type GLSize = GLsizei-        type GLString = String -- XXX: Foreign CChar?+        type GLString = String         type GLBool = GLboolean         type Buffer = GLuint         type UniformLocation = GLint@@ -98,6 +98,7 @@         noTexture = 0         noVAO = 0         noUInt8Array = fmap ((,) 0) $ newForeignPtr_ nullPtr+        noFloat32Array = fmap ((,) 0) $ newForeignPtr_ nullPtr          encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) = mkArray [ a1, a2, b1, b2 ] @@ -230,8 +231,10 @@         glStencilMaskSeparate = const GL.glStencilMaskSeparate         glStencilOp = const GL.glStencilOp         glStencilOpSeparate = const GL.glStencilOpSeparate-        glTexImage2D _ a b c d e f g h (_, fp) = withForeignPtr fp $+        glTexImage2DUInt _ a b c d e f g h (_, fp) = withForeignPtr fp $                 GL.glTexImage2D a b c d e f g h . castPtr+        glTexImage2DFloat _ a b c d e f g h (_, fp) = withForeignPtr fp $+                GL.glTexImage2D a b c d e f g h . castPtr         glTexParameterf = const GL.glTexParameterf         glTexParameteri = const GL.glTexParameteri         glTexSubImage2D _ a b c d e f g h (_, fp) = withForeignPtr fp $@@ -290,7 +293,7 @@         gl_ONE_MINUS_DST_COLOR = GL.GL_ONE_MINUS_DST_COLOR         gl_SRC_ALPHA_SATURATE = GL.GL_SRC_ALPHA_SATURATE         gl_FUNC_ADD = GL.GL_FUNC_ADD-        gl_BLEND_EQUATION = error "GL_BLEND_EQUATION: not present in OpenGL 3.2"+        gl_BLEND_EQUATION = error "GL_BLEND_EQUATION: not present in OpenGL 2.1"         gl_BLEND_EQUATION_RGB = GL.GL_BLEND_EQUATION_RGB         gl_BLEND_EQUATION_ALPHA = GL.GL_BLEND_EQUATION_ALPHA         gl_FUNC_SUBTRACT = GL.GL_FUNC_SUBTRACT@@ -334,7 +337,7 @@         gl_CW = GL.GL_CW         gl_CCW = GL.GL_CCW         gl_LINE_WIDTH = GL.GL_LINE_WIDTH-        gl_ALIASED_POINT_SIZE_RANGE = error "GL_ALIASED_POINT_SIZE_RANGE: not present in OpenGL 3.2"+        gl_ALIASED_POINT_SIZE_RANGE = error "GL_ALIASED_POINT_SIZE_RANGE: not present in OpenGL 2.1"         gl_ALIASED_LINE_WIDTH_RANGE = GL.GL_ALIASED_LINE_WIDTH_RANGE         gl_CULL_FACE_MODE = GL.GL_CULL_FACE_MODE         gl_FRONT_FACE = GL.GL_FRONT_FACE@@ -366,12 +369,12 @@         gl_MAX_TEXTURE_SIZE = GL.GL_MAX_TEXTURE_SIZE         gl_MAX_VIEWPORT_DIMS = GL.GL_MAX_VIEWPORT_DIMS         gl_SUBPIXEL_BITS = GL.GL_SUBPIXEL_BITS-        gl_RED_BITS = error "GL_RED_BITS: not present in OpenGL 3.2"-        gl_GREEN_BITS = error "GL_GREEN_BITS: not present in OpenGL 3.2"-        gl_BLUE_BITS = error "GL_BLUE_BITS: not present in OpenGL 3.2"-        gl_ALPHA_BITS = error "GL_ALPHA_BITS: not present in OpenGL 3.2"-        gl_DEPTH_BITS = error "GL_DEPTH_BITS: not present in OpenGL 3.2"-        gl_STENCIL_BITS = error "GL_STENCIL_BITS: not present in OpenGL 3.2"+        gl_RED_BITS = error "GL_RED_BITS: not present in OpenGL 2.1"+        gl_GREEN_BITS = error "GL_GREEN_BITS: not present in OpenGL 2.1"+        gl_BLUE_BITS = error "GL_BLUE_BITS: not present in OpenGL 2.1"+        gl_ALPHA_BITS = error "GL_ALPHA_BITS: not present in OpenGL 2.1"+        gl_DEPTH_BITS = error "GL_DEPTH_BITS: not present in OpenGL 2.1"+        gl_STENCIL_BITS = error "GL_STENCIL_BITS: not present in OpenGL 2.1"         gl_POLYGON_OFFSET_UNITS = GL.GL_POLYGON_OFFSET_UNITS         gl_POLYGON_OFFSET_FACTOR = GL.GL_POLYGON_OFFSET_FACTOR         gl_TEXTURE_BINDING_2D = GL.GL_TEXTURE_BINDING_2D@@ -383,33 +386,35 @@         gl_DONT_CARE = GL.GL_DONT_CARE         gl_FASTEST = GL.GL_FASTEST         gl_NICEST = GL.GL_NICEST-        gl_GENERATE_MIPMAP_HINT = error "GL_GENERATE_MIPMAP_HINT: not present in OpenGL 3.2"+        gl_GENERATE_MIPMAP_HINT = error "GL_GENERATE_MIPMAP_HINT: not present in OpenGL 2.1"         gl_BYTE = GL.GL_BYTE         gl_UNSIGNED_BYTE = GL.GL_UNSIGNED_BYTE         gl_SHORT = GL.GL_SHORT         gl_UNSIGNED_SHORT = GL.GL_UNSIGNED_SHORT         gl_INT = GL.GL_INT         gl_UNSIGNED_INT = GL.GL_UNSIGNED_INT+        gl_UNSIGNED_INT_24_8 = GL.GL_UNSIGNED_INT_24_8         gl_FLOAT = GL.GL_FLOAT         gl_DEPTH_COMPONENT = GL.GL_DEPTH_COMPONENT+        gl_DEPTH_STENCIL = GL.GL_DEPTH_STENCIL         gl_ALPHA = GL.GL_ALPHA         gl_RGB = GL.GL_RGB         gl_RGBA = GL.GL_RGBA         gl_RGBA32F = GL.GL_RGBA32F_ARB-        gl_LUMINANCE = error "GL_LUMINANCE: not present in OpenGL 3.2"-        gl_LUMINANCE_ALPHA = error "GL_LUMINANCE_ALPHA: not present in OpenGL 3.2"+        gl_LUMINANCE = error "GL_LUMINANCE: not present in OpenGL 2.1"+        gl_LUMINANCE_ALPHA = error "GL_LUMINANCE_ALPHA: not present in OpenGL 2.1"         gl_UNSIGNED_SHORT_4_4_4_4 = GL.GL_UNSIGNED_SHORT_4_4_4_4         gl_UNSIGNED_SHORT_5_5_5_1 = GL.GL_UNSIGNED_SHORT_5_5_5_1         gl_UNSIGNED_SHORT_5_6_5 = GL.GL_UNSIGNED_SHORT_5_6_5         gl_FRAGMENT_SHADER = GL.GL_FRAGMENT_SHADER         gl_VERTEX_SHADER = GL.GL_VERTEX_SHADER         gl_MAX_VERTEX_ATTRIBS = GL.GL_MAX_VERTEX_ATTRIBS-        gl_MAX_VERTEX_UNIFORM_VECTORS = error "GL_MAX_VERTEX_UNIFORM_VECTORS: not present in OpenGL 3.2"-        gl_MAX_VARYING_VECTORS = error "GL_MAX_VARYING_VECTORS: not present in OpenGL 3.2"+        gl_MAX_VERTEX_UNIFORM_VECTORS = error "GL_MAX_VERTEX_UNIFORM_VECTORS: not present in OpenGL 2.1"+        gl_MAX_VARYING_VECTORS = error "GL_MAX_VARYING_VECTORS: not present in OpenGL 2.1"         gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS = GL.GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS         gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS = GL.GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS         gl_MAX_TEXTURE_IMAGE_UNITS = GL.GL_MAX_TEXTURE_IMAGE_UNITS-        gl_MAX_FRAGMENT_UNIFORM_VECTORS = error "GL_MAX_FRAGMENT_UNIFORM_VECTORS: not present in OpenGL 3.2"+        gl_MAX_FRAGMENT_UNIFORM_VECTORS = error "GL_MAX_FRAGMENT_UNIFORM_VECTORS: not present in OpenGL 2.1"         gl_SHADER_TYPE = GL.GL_SHADER_TYPE         gl_DELETE_STATUS = GL.GL_DELETE_STATUS         gl_LINK_STATUS = GL.GL_LINK_STATUS@@ -517,17 +522,17 @@         gl_VERTEX_ATTRIB_ARRAY_POINTER = GL.GL_VERTEX_ATTRIB_ARRAY_POINTER         gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = GL.GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING         gl_COMPILE_STATUS = GL.GL_COMPILE_STATUS-        gl_LOW_FLOAT = error "GL_LOW_FLOAT: not present in OpenGL 3.2"-        gl_MEDIUM_FLOAT = error "GL_MEDIUM_FLOAT: not present in OpenGL 3.2"-        gl_HIGH_FLOAT = error "GL_HIGH_FLOAT: not present in OpenGL 3.2"-        gl_LOW_INT = error "GL_LOW_INT: not present in OpenGL 3.2"-        gl_MEDIUM_INT = error "GL_MEDIUM_INT: not present in OpenGL 3.2"-        gl_HIGH_INT = error "GL_HIGH_INT: not present in OpenGL 3.2"+        gl_LOW_FLOAT = error "GL_LOW_FLOAT: not present in OpenGL 2.1"+        gl_MEDIUM_FLOAT = error "GL_MEDIUM_FLOAT: not present in OpenGL 2.1"+        gl_HIGH_FLOAT = error "GL_HIGH_FLOAT: not present in OpenGL 2.1"+        gl_LOW_INT = error "GL_LOW_INT: not present in OpenGL 2.1"+        gl_MEDIUM_INT = error "GL_MEDIUM_INT: not present in OpenGL 2.1"+        gl_HIGH_INT = error "GL_HIGH_INT: not present in OpenGL 2.1"         gl_FRAMEBUFFER = GL.GL_FRAMEBUFFER         gl_RENDERBUFFER = GL.GL_RENDERBUFFER         gl_RGBA4 = GL.GL_RGBA4         gl_RGB5_A1 = GL.GL_RGB5_A1-        gl_RGB565 = error "GL_RGB565: not present in OpenGL 3.2"+        gl_RGB565 = error "GL_RGB565: not present in OpenGL 2.1"         gl_DEPTH_COMPONENT16 = GL.GL_DEPTH_COMPONENT16         gl_STENCIL_INDEX8 = GL.GL_STENCIL_INDEX8         gl_RENDERBUFFER_WIDTH = GL.GL_RENDERBUFFER_WIDTH@@ -579,11 +584,12 @@         gl_COLOR_ATTACHMENT15 = GL.GL_COLOR_ATTACHMENT15         gl_DEPTH_ATTACHMENT = GL.GL_DEPTH_ATTACHMENT         gl_STENCIL_ATTACHMENT = GL.GL_STENCIL_ATTACHMENT+        gl_DEPTH_STENCIL_ATTACHMENT = GL.GL_DEPTH_STENCIL_ATTACHMENT         gl_NONE = GL.GL_NONE         gl_FRAMEBUFFER_COMPLETE = GL.GL_FRAMEBUFFER_COMPLETE         gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = GL.GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT         gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT = GL.GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT-        gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS = error "GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS: not present in OpenGL 3.2"+        gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS = error "GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS: not present in OpenGL 2.1"         gl_FRAMEBUFFER_UNSUPPORTED = GL.GL_FRAMEBUFFER_UNSUPPORTED         gl_FRAMEBUFFER_BINDING = GL.GL_FRAMEBUFFER_BINDING         gl_RENDERBUFFER_BINDING = GL.GL_RENDERBUFFER_BINDING

@@ -37,6 +37,8 @@ -- TODO: ???  foreign import javascript unsafe "eval('null')" nullUInt8Array :: IO UInt8Array +foreign import javascript unsafe "eval('null')" nullFloat32Array :: IO Float32Array+ data TagTex = TagTex Int JS.Texture  instance Eq TagTex where@@ -47,13 +49,22 @@ makeContext element = do ctx <- JS.getCtx element                          counter <- newIORef 0                          JS.getExtension ctx "WEBGL_depth_texture"-                         JS.getExtension ctx "WEBGL_color_buffer_float"+                         JS.getExtension ctx "OES_texture_float"+                         floatTexExt <-+                                 JS.getExtension ctx "WEBGL_color_buffer_float"                          vaoExt <- JS.getExtension ctx "OES_vertex_array_object"                          drawBufsExt <- JS.getExtension ctx "WEBGL_draw_buffers"+                         setProp "floatTexExt" floatTexExt $ Object ctx                          setProp "vaoExt" vaoExt $ Object ctx                          setProp "drawBufs" drawBufsExt $ Object ctx                          return (counter, ctx) +hasFloatTextures :: Ctx -> IO Bool+hasFloatTextures = (not . isNull <$>) .  getProp "floatTexExt" . Object . snd++hasDrawBuffers :: Ctx -> IO Bool+hasDrawBuffers = (not . isNull <$>) .  getProp "drawBufs" . Object . snd+ toJSArray :: ToJSVal a => (v -> Maybe (a, v)) -> v -> IO JSArray.JSArray toJSArray next iv = JSArray.fromList <$> mapM toJSVal list         where list = unfoldr next iv@@ -99,6 +110,7 @@         noBuffer = JS.noBuffer         noTexture = TagTex (-1) JS.noTexture         noUInt8Array = nullUInt8Array+        noFloat32Array = nullFloat32Array         noVAO = JS.noVAO          encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) =@@ -295,7 +307,8 @@         glStencilMaskSeparate = JS.glStencilMaskSeparate . snd         glStencilOp = JS.glStencilOp . snd         glStencilOpSeparate = JS.glStencilOpSeparate . snd-        glTexImage2D = JS.glTexImage2D . snd+        glTexImage2DUInt = JS.glTexImage2DUInt . snd+        glTexImage2DFloat = JS.glTexImage2DFloat . snd         glTexParameterf = JS.glTexParameterf . snd         glTexParameteri = JS.glTexParameteri . snd         glTexSubImage2D = JS.glTexSubImage2D . snd@@ -454,8 +467,10 @@         gl_UNSIGNED_SHORT = JS.gl_UNSIGNED_SHORT         gl_INT = JS.gl_INT         gl_UNSIGNED_INT = JS.gl_UNSIGNED_INT+        gl_UNSIGNED_INT_24_8 = JS.gl_UNSIGNED_INT_24_8_WEBGL         gl_FLOAT = JS.gl_FLOAT         gl_DEPTH_COMPONENT = JS.gl_DEPTH_COMPONENT+        gl_DEPTH_STENCIL = JS.gl_DEPTH_STENCIL         gl_ALPHA = JS.gl_ALPHA         gl_RGB = JS.gl_RGB         gl_RGBA = JS.gl_RGBA@@ -643,6 +658,7 @@         gl_COLOR_ATTACHMENT0 = JS.gl_COLOR_ATTACHMENT0         gl_DEPTH_ATTACHMENT = JS.gl_DEPTH_ATTACHMENT         gl_STENCIL_ATTACHMENT = JS.gl_STENCIL_ATTACHMENT+        gl_DEPTH_STENCIL_ATTACHMENT = JS.gl_DEPTH_STENCIL_ATTACHMENT         gl_NONE = JS.gl_NONE         gl_FRAMEBUFFER_COMPLETE = JS.gl_FRAMEBUFFER_COMPLETE         gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = JS.gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT

@@ -995,10 +995,17 @@ -- WEBGL_color_buffer_float  gl_RGBA32F_EXT :: Num a => a-gl_RGBA32F_EXT = 0x8814+gl_RGBA32F_EXT = gl_RGBA+-- XXX: ???+-- gl_RGBA32F_EXT = 0x8814  gl_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE_EXT :: Num a => a gl_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE_EXT = 0x8211  gl_UNSIGNED_NORMALIZED_EXT :: Num a => a gl_UNSIGNED_NORMALIZED_EXT = 0x8C17++-- WEBGL_depth_texture++gl_UNSIGNED_INT_24_8_WEBGL :: Num a => a+gl_UNSIGNED_INT_24_8_WEBGL = 0x84FA

@@ -300,7 +300,10 @@         glStencilOpSeparate :: Ctx -> Word -> Word -> Word -> Word -> IO ()  foreign import javascript unsafe "$1.texImage2D($2, $3, $4, $5, $6, $7, $8, $9, $10)"-        glTexImage2D :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Word -> Uint8Array -> IO ()+        glTexImage2DUInt :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Word -> Uint8Array -> IO ()++foreign import javascript unsafe "$1.texImage2D($2, $3, $4, $5, $6, $7, $8, $9, $10)"+        glTexImage2DFloat :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Word -> Float32Array -> IO ()  foreign import javascript unsafe "$1.texParameterf($2, $3, $4)"         glTexParameterf :: Ctx -> Word -> Word -> Float -> IO ()

@@ -1,7 +1,7 @@ module Graphics.Rendering.Ombra.Blend where  import Data.Vect.Float (Vec4(..))-import Data.Vect.Float.Instances+import Data.Vect.Float.Instances () import Graphics.Rendering.Ombra.Internal.GL  -- | Blend mode@@ -62,3 +62,5 @@               param (OneMinus SourceAlpha) = gl_ONE_MINUS_SRC_ALPHA               param (OneMinus DestinationAlpha) = gl_ONE_MINUS_DST_ALPHA               param (OneMinus ConstantAlpha) = gl_ONE_MINUS_CONSTANT_ALPHA+              param (OneMinus _) =+                      error "Invalid blend function (nested OneMinus)"

@@ -1,6 +1,5 @@ module Graphics.Rendering.Ombra.Color where -import Control.Applicative import Data.Hashable import Data.Word (Word8) import Foreign.Ptr (castPtr)

@@ -44,16 +44,13 @@         View2(..), ) where -import Control.Applicative import Data.Vect.Float-import Graphics.Rendering.Ombra.Backend hiding (Texture, Image, Program)+import Graphics.Rendering.Ombra.Backend hiding (Texture, Program) import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Generic-import Graphics.Rendering.Ombra.Color import Graphics.Rendering.Ombra.Draw import Graphics.Rendering.Ombra.Shapes-import Graphics.Rendering.Ombra.Types hiding (program)-import Graphics.Rendering.Ombra.Texture+import Graphics.Rendering.Ombra.Types import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.Default2D (Image(..), Depth(..), Transform2(..), View2(..)) import Graphics.Rendering.Ombra.Shader.Program@@ -70,19 +67,19 @@ -- | 2D objects compatible with the standard 2D shader program. type IsObject2D globals inputs = ( Subset Geometry2D inputs                                  , Subset Uniforms2D globals-                                 , Set inputs, Set globals )+                                 , ShaderVars inputs, ShaderVars globals+                                 )  -- | 2D object groups compatible with the standard 2D shader program. type IsGroup2D gs is = ( Subset Geometry2D is, Subset (View2 ': Uniforms2D) gs-                       , Set is, Set gs )+                       , ShaderVars is, ShaderVars gs )  -- | A rectangle with a specified 'Texture'. rect :: GLES => Texture -> Object2D rect = flip poly . rectGeometry $ Vec2 1 1  -- | A 2D object with a specified 'Geometry'.-poly :: (IsObject2D Uniforms2D is, GLES)-     => Texture -> Geometry is -> Object Uniforms2D is+poly :: GLES => Texture -> Geometry is -> Object Uniforms2D is poly t g = globalTexture Image t :~>            Depth -= 0 :~>            Transform2 -= idmtx :~>@@ -103,20 +100,20 @@ sprite t = scaleTex t $ rect t  -- | Create a group of objects with a view matrix.-view :: (Set gs, Set is, GLES)+view :: (ShaderVars gs, ShaderVars is, GLES)      => Mat3 -> [Object gs is] -> Group (View2 ': gs) is view m = viewVP $ const m  -- | Create a group of objects with a view matrix and 'screenMat3'.-viewScreen :: (Set gs, Set is, GLES)+viewScreen :: (ShaderVars gs, ShaderVars is, GLES)            => Mat3 -> [Object gs is] -> Group (View2 ': gs) is viewScreen m = viewVP $ \s -> screenMat3 s .*. m  -- | Create a group of objects with a view matrix, depending on the size of the -- framebuffer.-viewVP :: (Set gs, Set is, GLES)+viewVP :: (ShaderVars gs, ShaderVars is, GLES)        => (Vec2 -> Mat3) -> [Object gs is] -> Group (View2 ': gs) is-viewVP mf = globalGroup (globalFramebufferSize View2 mf) . group+viewVP mf = groupGlobal (globalFramebufferSize View2 mf) . group  -- | A 'Layer' with the standard 2D program. layerS :: IsGroup2D gs is => Group gs is -> Layer

@@ -16,6 +16,7 @@         Geometry3D,         mesh,         mkGeometry3D,+        positionOnly,         -- * Transformations         trans,         rotX,@@ -52,7 +53,6 @@         View3(..), ) where -import Control.Applicative import Data.Vect.Float import Graphics.Rendering.Ombra.Backend hiding (Texture, Program) import Graphics.Rendering.Ombra.Geometry@@ -64,7 +64,6 @@ import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.Default3D (Texture2(..), Transform3(..), View3(..)) import Graphics.Rendering.Ombra.Shader.Program hiding (program)-import Graphics.Rendering.Ombra.Texture import Graphics.Rendering.Ombra.Transformation  type Uniforms3D = '[Transform3, Texture2]@@ -78,28 +77,27 @@ -- | 3D objects compatible with the standard 3D shader program. type IsObject3D globals inputs = ( Subset Geometry3D inputs                                  , Subset Uniforms3D globals-                                 , Set inputs, Set globals )+                                 , ShaderVars inputs, ShaderVars globals )  -- | 3D object groups compatible with the standard 3D shader program. type IsGroup3D gs is = ( Subset Geometry3D is, Subset (View3 ': Uniforms3D) gs-                       , Set is, Set gs )+                       , ShaderVars is, ShaderVars gs )  -- | A cube with a specified 'Texture'. cube :: GLES => Texture -> Object3D cube = flip mesh cubeGeometry  -- | A 3D object with a specified 'Geometry'.-mesh :: (IsObject3D Uniforms3D is, GLES)-     => Texture -> Geometry is -> Object Uniforms3D is+mesh :: GLES => Texture -> Geometry is -> Object Uniforms3D is mesh t g = Transform3 -= idmtx :~> globalTexture Texture2 t :~> geom g  -- | Create a group of objects with a view matrix.-view :: (GLES, Set gs, Set is)+view :: (GLES, ShaderVars gs, ShaderVars is)      => Mat4 -> [Object gs is] -> Group (View3 ': gs) is view m = viewVP $ const m  -- | Create a group of objects with a view matrix and perspective projection.-viewPersp :: (GLES, Set gs, Set is)+viewPersp :: (GLES, ShaderVars gs, ShaderVars is)           => Float      -- ^ Near           -> Float      -- ^ Far           -> Float      -- ^ FOV@@ -108,7 +106,7 @@ viewPersp n f fov m = viewVP $ \s -> m .*. perspectiveMat4Size n f fov s  -- | Create a group of objects with a view matrix and orthographic projection.-viewOrtho :: (GLES, Set gs, Set is)+viewOrtho :: (GLES, ShaderVars gs, ShaderVars is)           => Float      -- ^ Near           -> Float      -- ^ Far           -> Float      -- ^ Left@@ -121,9 +119,9 @@  -- | Create a group of objects with a view matrix, depending on the size of the -- framebuffer.-viewVP :: (GLES, Set gs, Set is)+viewVP :: (GLES, ShaderVars gs, ShaderVars is)        => (Vec2 -> Mat4) -> [Object gs is] -> Group (View3 ': gs) is-viewVP mf = globalGroup (globalFramebufferSize View3 mf) . group+viewVP mf = groupGlobal (globalFramebufferSize View3 mf) . group  -- | A 'Layer' with the standard 3D program. layerS :: IsGroup3D gs is => Group gs is -> Layer

@@ -1,13 +1,13 @@ module Graphics.Rendering.Ombra.Draw (+        Buffer(..),         refDrawCtx,         runDrawCtx,         execDrawCtx,         evalDrawCtx,         drawInit,         drawState,-        drawBegin,+        clearBuffers,         drawLayer,-        drawEnd,         drawGet,         removeGeometry,         removeTexture,@@ -21,7 +21,8 @@  import Data.IORef import Graphics.Rendering.Ombra.Draw.Internal-import Graphics.Rendering.Ombra.Internal.GL+import Graphics.Rendering.Ombra.Internal.GL hiding (Buffer)+import Graphics.Rendering.Ombra.Types (Buffer(..))  -- | Run a Draw action using an IORef and a context. refDrawCtx :: GLES => Ctx -> Draw a -> IORef DrawState -> IO a@@ -30,16 +31,15 @@                           writeIORef ref state'                           return ret -runDrawCtx :: GLES-           => Ctx               -- ^ Context (use the appropriate backend+runDrawCtx :: Ctx               -- ^ Context (use the appropriate backend                                 -- functions)            -> Draw a            -- ^ Draw action            -> DrawState         -- ^ State (create it with 'drawState')            -> IO (a, DrawState) runDrawCtx ctx d = flip evalGL ctx . runDraw d -execDrawCtx :: GLES => Ctx -> Draw a -> DrawState -> IO DrawState+execDrawCtx :: Ctx -> Draw a -> DrawState -> IO DrawState execDrawCtx ctx d = flip evalGL ctx . execDraw d -evalDrawCtx :: GLES => Ctx -> Draw a -> DrawState -> IO a+evalDrawCtx :: Ctx -> Draw a -> DrawState -> IO a evalDrawCtx ctx d = flip evalGL ctx . evalDraw d

@@ -6,11 +6,10 @@         DrawState,         drawState,         drawInit,-        drawBegin,+        clearBuffers,         drawLayer,         drawGroup,         drawObject,-        drawEnd,         removeGeometry,         removeTexture,         removeProgram,@@ -30,29 +29,26 @@ import qualified Graphics.Rendering.Ombra.Blend as Blend import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Color-import Graphics.Rendering.Ombra.Shapes import Graphics.Rendering.Ombra.Types import Graphics.Rendering.Ombra.Texture import Graphics.Rendering.Ombra.Backend (GLES) import qualified Graphics.Rendering.Ombra.Backend as GL-import Graphics.Rendering.Ombra.Internal.GL hiding (Texture, Program, UniformLocation)+import Graphics.Rendering.Ombra.Internal.GL hiding (Texture, Program, Buffer,+                                                    UniformLocation, cullFace,+                                                    depthMask, colorMask) import qualified Graphics.Rendering.Ombra.Internal.GL as GL import Graphics.Rendering.Ombra.Internal.Resource import Graphics.Rendering.Ombra.Shader.CPU import Graphics.Rendering.Ombra.Shader.GLSL import Graphics.Rendering.Ombra.Shader.Program import Graphics.Rendering.Ombra.Shader.ShaderVar+import qualified Graphics.Rendering.Ombra.Stencil as Stencil -import Data.Bits ((.|.)) import Data.Hashable (Hashable)-import qualified Data.HashMap.Strict as H import qualified Data.Vector as V-import Data.Typeable import Data.Vect.Float-import Data.Word (Word, Word8)-import Control.Applicative+import Data.Word (Word8) import Control.Monad (when)-import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.State @@ -74,10 +70,15 @@                                     , uniforms = uniforms                                     , textureImages = textureImages                                     , activeTextures =-                                            V.replicate maxTexs Nothing+                                            V.replicate 16 Nothing                                     , viewportSize = (w, h)                                     , blendMode = Nothing-                                    , depthTest = True }+                                    , depthTest = True+                                    , depthMask = True+                                    , stencilMode = Nothing+                                    , cullFace = Just CullBack+                                    , colorMask = (True, True, True, True)+                                    }          where newGLResMap :: (Hashable i, Resource i r GL) => IO (ResMap i r)               newGLResMap = newResMap@@ -94,8 +95,10 @@                               viewport 0 0 (fromIntegral w) (fromIntegral h)  +{- maxTexs :: (Integral a, GLES) => a-maxTexs = 32 -- fromIntegral gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS -- XXX+maxTexs = fromIntegral gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS+-}  -- | Run a 'Draw' action. runDraw :: Draw a@@ -123,13 +126,11 @@ resizeViewport w h = do gl $ viewport 0 0 (fromIntegral w) (fromIntegral h)                         Draw . modify $ \s -> s { viewportSize = (w, h) } --- | Clear the buffers.-drawBegin :: GLES => Draw ()-drawBegin = do freeActiveTextures -- ?-               gl . clear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT--drawEnd :: GLES => Draw ()-drawEnd = return ()+clearBuffers :: GLES => [Buffer] -> Draw ()+clearBuffers = mapM_ $ gl . clear . buffer+        where buffer ColorBuffer = gl_COLOR_BUFFER_BIT+              buffer DepthBuffer = gl_DEPTH_BUFFER_BIT+              buffer StencilBuffer = gl_STENCIL_BUFFER_BIT  -- | Manually delete a 'Geometry' from the GPU (this is automatically done when -- the 'Geometry' becomes unreachable). Note that if you try to draw it, it will@@ -151,33 +152,74 @@  -- | Draw a 'Layer'. drawLayer :: GLES => Layer -> Draw ()-drawLayer (Layer prg grp) = setProgram prg >> drawGroup grp+-- TODO: freeActiveTextures should not be here+drawLayer (Layer prg grp) = freeActiveTextures >>+                            setProgram prg >>+                            drawGroup initialGroupState grp drawLayer (SubLayer rl) =-        do (layers, textures) <- renderLayer rl-           mapM_ drawLayer layers+        do (layer, textures) <- renderLayer rl+           drawLayer layer            mapM_ removeTexture textures-drawLayer (MultiLayer layers) = mapM_ drawLayer layers+drawLayer (OverLayer top behind) = drawLayer behind >> drawLayer top+drawLayer (ClearLayer bufs l) = clearBuffers bufs >> drawLayer l +data GroupState = GroupState {+        hasBlend :: Bool,+        hasStencil :: Bool,+        hasDepthTest :: Bool,+        hasDepthMask :: Bool,+        hasColorMask :: Bool,+        hasCull :: Bool+}++initialGroupState :: GroupState+initialGroupState = GroupState False False False False False False+ -- | Draw a 'Group'.-drawGroup :: GLES => Group gs is -> Draw ()-drawGroup Empty = return ()-drawGroup (Object o) = drawObject o-drawGroup (Global (g := c) o) = c >>= uniform single (g undefined)-                                  >>  drawGroup o-drawGroup (Append g g') = drawGroup g >> drawGroup g'-drawGroup (Blend m g) = blendMode <$> Draw get >>=-                        \om -> setBlendMode m >> drawGroup g >> setBlendMode om-drawGroup (DepthTest d g) = do od <- depthTest <$> Draw get-                               setDepthTest d-                               drawGroup g-                               setDepthTest od+drawGroup :: GLES => GroupState -> Group gs is -> Draw ()+drawGroup _ Empty = return ()+drawGroup _ (Object o) = drawObject o+drawGroup s (Global (g := c) o) = do c >>= uniform single (g undefined)+                                     drawGroup s o+drawGroup s (Global (Mirror g c) o) = do c >>= uniform mirror+                                                  (varBuild (const undefined) g)+                                         drawGroup s o+drawGroup _ (Append g g') = do drawGroup initialGroupState g+                               drawGroup initialGroupState g'+drawGroup s (Blend m g) | hasBlend s = drawGroup s g+                        | otherwise = stateReset blendMode setBlendMode m $+                                drawGroup (s { hasBlend = True }) g+drawGroup s (Stencil m g) | hasStencil s = drawGroup s g+                          | otherwise = stateReset stencilMode setStencilMode m $+                                drawGroup (s { hasStencil = True }) g+drawGroup s (DepthTest d g) | hasDepthTest s = drawGroup s g+                            | otherwise = stateReset depthTest setDepthTest d $+                                drawGroup (s { hasDepthTest = True }) g+drawGroup s (DepthMask d g) | hasDepthTest s = drawGroup s g+                            | otherwise = stateReset depthMask setDepthMask d $+                                drawGroup (s { hasDepthMask = True }) g+drawGroup s (ColorMask d g) | hasColorMask s = drawGroup s g+                            | otherwise = stateReset colorMask setColorMask d $+                                drawGroup (s { hasColorMask = True }) g+drawGroup s (Cull face g) | hasCull s = drawGroup s g+                          | otherwise = stateReset cullFace setCullFace face $+                                drawGroup (s { hasCull = True }) g +stateReset :: (DrawState -> a) -> (a -> Draw ()) -> a -> Draw () -> Draw ()+stateReset getOld set new act = do old <- getOld <$> Draw get+                                   set new+                                   act+                                   set old+ -- | Draw an 'Object'. drawObject :: GLES => Object gs is -> Draw () drawObject NoMesh = return () drawObject (Mesh g) = withRes_ (getGPUVAOGeometry $ castGeometry g)                                  drawGPUVAOGeometry drawObject ((g := c) :~> o) = c >>= uniform single (g undefined) >> drawObject o+drawObject (Mirror g c :~> o) = do c >>= uniform mirror+                                              (varBuild (const undefined) g)+                                   drawObject o  uniform :: (GLES, ShaderVar g, Uniform s g)         => proxy (s :: CPUSetterType *) -> g -> CPU s g -> Draw ()@@ -187,7 +229,7 @@                                                                   -- | This helps you set the uniforms of type 'Graphics.Rendering.Ombra.Shader.Sampler2D'.-textureUniform :: GLES  => Texture -> Draw ActiveTexture+textureUniform :: GLES => Texture -> Draw ActiveTexture textureUniform tex = withRes (getTexture tex) (return $ ActiveTexture 0)                                  $ \(LoadedTexture _ _ wtex) ->                                         do at <- makeActive tex@@ -247,40 +289,41 @@  freeActiveTextures :: GLES => Draw () freeActiveTextures = Draw . modify $ \ds ->-        ds { activeTextures = V.replicate maxTexs Nothing }+        ds { activeTextures = V.replicate 16 Nothing } --- XXX: inefficient makeActive :: GLES => Texture -> Draw ActiveTexture makeActive t = do ats <- activeTextures <$> Draw get-                  let at@(ActiveTexture atn) =+                  let (at@(ActiveTexture atn), ats') =                         case V.elemIndex (Just t) ats of-                                Just n -> ActiveTexture $ fi n+                                Just n -> (ActiveTexture $ fromIntegral n, ats)                                 Nothing ->                                         case V.elemIndex Nothing ats of-                                             Just n -> ActiveTexture $ fi n-                                             -- TODO: Draw () error reporting-                                             Nothing -> ActiveTexture 0-                  gl . activeTexture $ gl_TEXTURE0 + fi atn+                                             Just n -> ( ActiveTexture $+                                                                fromIntegral n+                                                       , ats )+                                             Nothing -> let l = V.length ats+                                                            grow = V.replicate+                                                                    l Nothing+                                                        in ( ActiveTexture $+                                                                fromIntegral l+                                                           , ats V.++ grow )+                  gl . activeTexture $ gl_TEXTURE0 + fromIntegral atn                   Draw . modify $ \ds ->-                          ds { activeTextures = ats V.// [(fi atn, Just t)] }+                          ds { activeTextures =+                                  ats' V.// [(fromIntegral atn, Just t)] }                   return at-        where fi :: (Integral a, Integral b) => a -> b-              fi = fromIntegral   -- | Realize a 'RenderLayer'. It returns the list of allocated 'Texture's so -- that you can free them if you want. renderLayer :: GLES => RenderLayer a -> Draw (a, [Texture])-renderLayer (RenderLayer drawBufs stypes w' h' rx ry rw rh+renderLayer (RenderLayer drawBufs stypes w h rx ry rw rh                          inspCol inspDepth layer f) =         do (ts, mcol, mdepth) <- layerToTexture drawBufs stypes w h layer                                                 (mayInspect inspCol)                                                 (mayInspect inspDepth)            return (f ts mcol mdepth, ts)-        where w = fromIntegral w'-              h = fromIntegral h'--              mayInspect :: Bool+        where mayInspect :: Bool                          -> Either (Maybe [r])                                    ([r] -> Draw (Maybe [r]), Int, Int, Int, Int)               mayInspect True = Right (return . Just, rx, ry, rw, rh)@@ -318,20 +361,31 @@                               ColorLayer -> ( fromIntegral gl_RGBA                                             , gl_RGBA                                             , gl_UNSIGNED_BYTE-                                            , gl_COLOR_ATTACHMENT0 )+                                            , gl_COLOR_ATTACHMENT0+                                            , [ColorBuffer] )                               DepthLayer -> ( fromIntegral gl_DEPTH_COMPONENT                                             , gl_DEPTH_COMPONENT                                             , gl_UNSIGNED_SHORT-                                            , gl_DEPTH_ATTACHMENT )+                                            , gl_DEPTH_ATTACHMENT+                                            , [DepthBuffer] )+                              DepthStencilLayer -> ( fromIntegral+                                                        gl_DEPTH_STENCIL+                                                   , gl_DEPTH_STENCIL+                                                   , gl_UNSIGNED_INT_24_8+                                                   , gl_DEPTH_STENCIL_ATTACHMENT+                                                   , [ DepthBuffer+                                                     , StencilBuffer]+                                                   )                               BufferLayer n -> ( fromIntegral gl_RGBA32F                                                , gl_RGBA                                                , gl_FLOAT                                                , gl_COLOR_ATTACHMENT0 + -                                                 fromIntegral n )+                                                 fromIntegral n+                                               , [] )                inspect :: Either c (a -> Draw c, Int, Int, Int, Int) -> GLEnum                       -> ([Word8] -> a) -> Int -> Draw c-              inspect (Left r) _ _ s = return r+              inspect (Left r) _ _ _ = return r               inspect (Right (insp, x, y, rw, rh)) format trans s =                         do arr <- liftIO . newByteArray $                                         fromIntegral rw * fromIntegral rh * s@@ -346,32 +400,37 @@               wordsToColors _ = []  renderToTexture :: GLES-                => Bool -> [(GLInt, GLEnum, GLEnum, GLEnum)]+                => Bool -> [(GLInt, GLEnum, GLEnum, GLEnum, [Buffer])]                 -> GLSize -> GLSize -> Draw a -> Draw ([GL.Texture], a) renderToTexture drawBufs infos w h act = do         fb <- gl createFramebuffer          gl $ bindFramebuffer gl_FRAMEBUFFER fb -        (ts, as) <- fmap unzip . gl . flip mapM infos $-                \(internalFormat, format, pixelType, attachment) ->-                        do t <- emptyTexture-                           arr <- liftIO $ noUInt8Array+        (ts, attchs, buffersToClear) <- fmap unzip3 . gl . flip mapM infos $+                \(internalFormat, format, pixelType, attachment, buffer) ->+                        do t <- emptyTexture Linear Linear                            bindTexture gl_TEXTURE_2D t-                           texImage2D gl_TEXTURE_2D 0 internalFormat w -                                      h 0 format pixelType arr+                           if pixelType == gl_FLOAT+                           then liftIO noFloat32Array >>=+                                            texImage2DFloat gl_TEXTURE_2D 0+                                                            internalFormat w h+                                                            0 format pixelType+                           else liftIO noUInt8Array >>=+                                     texImage2DUInt gl_TEXTURE_2D 0+                                                    internalFormat w h+                                                    0 format pixelType                            framebufferTexture2D gl_FRAMEBUFFER attachment                                                 gl_TEXTURE_2D t 0-                           return (t, fromIntegral attachment)+                           return (t, fromIntegral attachment, buffer) -        let buffers = filter (/= fromIntegral gl_DEPTH_ATTACHMENT) as-        when drawBufs $ liftIO (encodeInts buffers) >>= gl . drawBuffers+        let buffersToDraw = filter (/= fromIntegral gl_DEPTH_ATTACHMENT) attchs+        when drawBufs $ liftIO (encodeInts buffersToDraw) >>= gl . drawBuffers          (sw, sh) <- viewportSize <$> Draw get         resizeViewport (fromIntegral w) (fromIntegral h) -        drawBegin+        clearBuffers $ concat buffersToClear         ret <- act-        drawEnd          resizeViewport sw sh         gl $ deleteFramebuffer fb@@ -406,14 +465,79 @@               changeEquation = gl $ blendEquationSeparate rgbEq alphaEq               changeFunction = gl $ blendFuncSeparate rgbs rgbd                                                       alphas alphad++setStencilMode :: GLES => Maybe Stencil.Mode -> Draw ()+setStencilMode Nothing = do m <- stencilMode <$> Draw get+                            case m of+                                 Just _ -> gl $ disable gl_STENCIL_TEST+                                 Nothing -> return ()+                            Draw . modify $ \s -> s { stencilMode = Nothing }+setStencilMode (Just newMode@(Stencil.Mode newFun newOp)) =+        do mOldMode <- stencilMode <$> Draw get+           case mOldMode of+                Nothing -> do gl $ enable gl_STENCIL_TEST+                              sides newFun changeFunction+                              sides newOp changeOperation+                Just (Stencil.Mode oldFun oldOp) ->+                        do when (oldFun /= newFun) $+                                sides newFun changeFunction+                           when (oldOp /= newOp) $+                                sides newOp changeOperation+           Draw . modify $ \s -> s { stencilMode = Just newMode }+        where changeFunction face f = let (t, v, m) = Stencil.function f+                                      in gl $ stencilFuncSeparate face t v m+              changeOperation face o = let (s, d, n) = Stencil.operation o+                                       in gl $ stencilOpSeparate face s d n+              sides (Stencil.FrontBack x) f = f gl_FRONT_AND_BACK x+              sides (Stencil.Separate x y) f = f gl_FRONT x >> f gl_BACK y++setCullFace :: GLES => Maybe CullFace -> Draw ()+setCullFace Nothing = do old <- cullFace <$> Draw get+                         case old of+                              Just _ -> gl $ disable gl_CULL_FACE+                              Nothing -> return ()+                         Draw . modify $ \s -> s { cullFace = Nothing }+setCullFace (Just newFace) =+        do old <- cullFace <$> Draw get+           when (old == Nothing) . gl $ enable gl_CULL_FACE+           case old of+                Just oldFace | oldFace == newFace -> return ()+                _ -> gl . GL.cullFace $ case newFace of+                                             CullFront -> gl_FRONT+                                             CullBack -> gl_BACK+                                             CullFrontBack -> gl_FRONT_AND_BACK+           Draw . modify $ \s -> s { cullFace = Just newFace }                     setDepthTest :: GLES => Bool -> Draw ()-setDepthTest new = do old <- depthTest <$> Draw get-                      case (old, new) of-                              (False, True) -> gl $ enable gl_DEPTH_TEST-                              (True, False) -> gl $ disable gl_DEPTH_TEST-                              _ -> return ()-                      Draw . modify $ \s -> s { depthTest = new }+setDepthTest = setFlag depthTest (\x s -> s { depthTest = x })+                       (gl $ enable gl_DEPTH_TEST) (gl $ disable gl_DEPTH_TEST)+                   +setDepthMask :: GLES => Bool -> Draw ()+setDepthMask = setFlag depthMask (\x s -> s { depthMask = x })+                       (gl $ GL.depthMask true) (gl $ GL.depthMask false)++setFlag :: (DrawState -> Bool)+        -> (Bool -> DrawState -> DrawState)+        -> Draw ()+        -> Draw ()+        -> Bool+        -> Draw ()+setFlag getF setF enable disable new =+        do old <- getF <$> Draw get+           case (old, new) of+                   (False, True) -> enable+                   (True, False) -> disable+                   _ -> return ()+           Draw . modify $ setF new++setColorMask :: GLES => (Bool, Bool, Bool, Bool) -> Draw ()+setColorMask new@(r, g, b, a) = do old <- colorMask <$> Draw get+                                   when (old /= new) . gl $+                                           GL.colorMask r' g' b' a'+                                   Draw . modify $ \s -> s { colorMask = new }+        where (r', g', b', a') = (bool r, bool g, bool b, bool a)+              bool True = true+              bool False = false  getDrawResource :: (Resource i r m, Hashable i)                 => (m (Either String r) -> Draw (Either String r))

@@ -14,36 +14,48 @@         Group,         group,         (~~),-        unsafeJoin,-        emptyGroup,-        globalGroup,+        groupEmpty,+        groupGlobal,         depthTest,+        depthMask,+        colorMask,+        ShaderVars,+        VOShaderVars,         -- ** Blending         blend,         noBlend,         Blend.transparency,         Blend.additive,         -- ** Stencil test+        stencil,+        noStencil,+        -- ** Culling+        CullFace(..),+        cull,+        noCull,          -- * Layers+        Buffer(..),         Layer,         layer,-        combineLayers,+        over,+        clear,         -- ** Sublayers         subLayer,+        colorSubLayer,         depthSubLayer,-        subRenderLayer,-        -- ** Render layers-        RenderLayer,-        renderColor,-        renderDepth,-        renderColorDepth,-        renderColorInspect,-        renderDepthInspect,-        renderColorDepthInspect,-        renderBuffers,+        colorDepthSubLayer,+        colorStencilSubLayer,+        colorSubLayer',+        depthSubLayer',+        colorDepthSubLayer',+        colorStencilSubLayer',+        buffersSubLayer,+        buffersDepthSubLayer,+        buffersStencilSubLayer,          -- * Shaders+        Compatible,         Program,         program,         Global,@@ -51,6 +63,9 @@         globalTexture,         globalTexSize,         globalFramebufferSize,+        CPUMirror,+        globalMirror,+        globalMirror',          -- * Geometries         Geometry,@@ -61,7 +76,11 @@          -- * Textures         Texture,+        ActiveTexture,         mkTexture,+        mkTextureFloat,+        Filter(..),+        setFilter,         -- ** Colors         Color(..),         colorTex,@@ -71,34 +90,34 @@         module Graphics.Rendering.Ombra.Color ) where -import Control.Applicative import Data.Typeable import Data.Type.Equality import Data.Vect.Float import Data.Word (Word8) import Graphics.Rendering.Ombra.Backend (GLES) import qualified Graphics.Rendering.Ombra.Blend as Blend+import qualified Graphics.Rendering.Ombra.Stencil as Stencil import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Color import Graphics.Rendering.Ombra.Draw-import Graphics.Rendering.Ombra.Types hiding (program, depthTest)-import Graphics.Rendering.Ombra.Internal.GL (GLES, ActiveTexture)+import Graphics.Rendering.Ombra.Types hiding (depthTest, depthMask, colorMask)+import Graphics.Rendering.Ombra.Internal.GL (ActiveTexture) import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.CPU import Graphics.Rendering.Ombra.Shader.Program import Graphics.Rendering.Ombra.Shader.ShaderVar+import Graphics.Rendering.Ombra.Shader.Stages import Graphics.Rendering.Ombra.Texture-import Unsafe.Coerce  -- | An empty group.-emptyGroup :: Group is gs-emptyGroup = Empty+groupEmpty :: Group gs is+groupEmpty = Empty  -- | Set a global uniform for a 'Group'.-globalGroup :: Global g -> Group gs is -> Group (g ': gs) is-globalGroup = Global+groupGlobal :: Global g -> Group gs is -> Group (g ': gs) is+groupGlobal = Global --- | Set the blending mode for a 'Group' of objects.+-- | Enable blending and set the blending mode for a 'Group' of objects. blend :: Blend.Mode -> Group gs is -> Group gs is blend m = Blend $ Just m @@ -106,11 +125,38 @@ noBlend :: Group gs is -> Group gs is noBlend = Blend Nothing --- | Enable/disable the depth test for a 'Group'.+-- | Enable stencil testing and set the stencil mode for a 'Group' of objects.+stencil :: Stencil.Mode -> Group gs is -> Group gs is+stencil m = Stencil $ Just m++-- | Disable stencil testing on a 'Group' of objects.+noStencil :: Group gs is -> Group gs is+noStencil = Stencil Nothing++-- | Enable/disable depth testing for a 'Group'. depthTest :: Bool -> Group gs is -> Group gs is depthTest = DepthTest +-- | Enable/disable writing into the depth buffer for a 'Group'.+depthMask :: Bool -> Group gs is -> Group gs is+depthMask = DepthMask +-- | Enable/disable writing into the four channels of the color buffer for a+-- 'Group'.+colorMask :: (Bool, Bool, Bool, Bool) -> Group gs is -> Group gs is+colorMask = ColorMask+-- TODO: should search and modify existing DepthMask++-- | Enable face culling.+cull :: CullFace -> Group gs is -> Group gs is+cull m = Cull $ Just m+-- TODO: should search and modify existing Cull++-- | Disable face culling.+noCull :: Group gs is -> Group gs is+noCull = Cull Nothing+-- TODO: should search and modify existing Cull+ -- | An empty object. nothing :: Object '[] '[] nothing = NoMesh@@ -120,14 +166,16 @@ geom = Mesh  class MemberGlobal g gs where-        -- | Modify the global of an 'Object'.+        -- | Modify the global of an 'Object'. This doesn't work with mirror+        -- globals.         (~~>) :: (Uniform 'S g)               => (Draw (CPU 'S g) -> Global g)  -- ^ Changing function               -> Object gs is               -> Object gs is  instance {-# OVERLAPPING #-} MemberGlobal g (g ': gs) where-        f ~~> (g := c :~> o) = f c :~> o+        f ~~> (_ := c :~> o) = f c :~> o+        _ ~~> (glob :~> o) = glob :~> o  instance {-# OVERLAPPABLE #-} ((g == g1) ~ False, MemberGlobal g gs) =>          MemberGlobal g (g1 ': gs) where@@ -180,112 +228,248 @@                       -> (Vec2 -> CPU 'S g) -> Global g globalFramebufferSize g fc = g := (fc . tupleToVec <$>                                             (viewportSize <$> drawGet))-        where tupleToVec (x, y) = Vec2 (fromIntegral x) (fromIntegral y) +tupleToVec :: (Int, Int) -> Vec2+tupleToVec (x, y) = Vec2 (fromIntegral x) (fromIntegral y)++-- | Like '-=' but for mirror types.+globalMirror :: (ShaderVar g, Uniform 'M g) => Proxy g -> CPU 'M g -> Global g+globalMirror g c = Mirror g $ return c++-- | Extended version of 'globalMirror'.+globalMirror' :: (GLES, ShaderVar g, Uniform 'M g)+              => Proxy g+              -> [Texture]      -- ^ Textures to make active. Remember that+                                -- the CPU version of 'Sampler2D' is+                                -- 'ActiveTexture', not 'Texture'.+              -> ([(ActiveTexture, (Int, Int))] -> Vec2 -> CPU 'M g)+                                -- ^ Function that, given a list of active+                                -- textures (the same passed in the second+                                -- argument) and their size, and the+                                -- framebuffer value, build the CPU value of+                                -- the global.+              -> Global g+globalMirror' g ts f = Mirror g $ f <$> mapM ( \t -> (,) <$> textureUniform t+                                                         <*> textureSize t) ts+                                    <*> (tupleToVec . viewportSize <$> drawGet)+ -- | Create a 'Group' from a list of 'Object's.-group :: (Set is, Set gs) => [Object is gs] -> Group is gs-group = foldr (\obj grp -> grp ~~ Object obj) emptyGroup+group :: (ShaderVars gs, ShaderVars is) => [Object gs is] -> Group gs is+group = foldr (\obj grp -> grp ~~ Object obj) groupEmpty -type EqualJoin x y v = EqualOrErr x y (Text "Can't join groups with " :<>:-                                       Text "different " :<>: v :<>:-                                       Text "." :$$:-                                       Text "    Left group " :<>: v :<>:-                                       Text ": " :<>: ShowType x :$$:-                                       Text "    Right group " :<>: v :<>:-                                       Text ": " :<>: ShowType y)+type EqualMerge x y v = EqualOrErr x y (Text "Can't merge groups with " :<>:+                                        Text "different " :<>: v :<>:+                                        Text "." :$$:+                                        Text "    Left group " :<>: v :<>:+                                        Text ": " :<>: ShowType x :$$:+                                        Text "    Right group " :<>: v :<>:+                                        Text ": " :<>: ShowType y)  --- | Join two groups.-(~~) :: (EqualJoin gs gs' (Text "globals"), EqualJoin is is' (Text "inputs"))+-- | Merge two groups.+(~~) :: (EqualMerge gs gs' (Text "globals"), EqualMerge is is' (Text "inputs"))      => Group gs is -> Group gs' is'      -> Group (Union gs gs') (Union is is') (~~) = Append --- | Join two groups, even if they don't provide the same variables.-unsafeJoin :: Group gs is -> Group gs' is'-           -> Group (Union gs gs') (Union is is')-unsafeJoin = Append+{-+-- | Merge two groups, even if they don't provide the same variables.+unsafeMerge :: Group gs is -> Group gs' is'+            -> Group (Union gs gs') (Union is is')+unsafeMerge = Append+-}  -- | Associate a group with a program. layer :: (Subset progAttr grpAttr, Subset progUni grpUni)       => Program progUni progAttr -> Group grpUni grpAttr -> Layer layer = Layer --- | Combine some layers.-combineLayers :: [Layer] -> Layer-combineLayers = MultiLayer+infixl 1 `over`+-- | Draw the first Layer over the second one. The first Layer will use the same+-- buffers (color, depth, stencil) of the second one.+over :: Layer -> Layer -> Layer+over = OverLayer +-- | Clear some buffers before drawing a Layer.+clear :: [Buffer] -> Layer -> Layer+clear = ClearLayer+ -- | Generate a 1x1 texture. colorTex :: GLES => Color -> Texture colorTex c = mkTexture 1 1 [ c ] +-- | Alias for 'colorSubLayer'.+subLayer :: Int -> Int -> Layer -> (Texture -> Layer) -> Layer+subLayer = colorSubLayer+ -- | Use a 'Layer' as a 'Texture' on another.------ > subLayer w h l = subRenderLayer . renderColor w h l-subLayer :: Int                         -- ^ Texture width.-         -> Int                         -- ^ Texture height.-         -> Layer                       -- ^ Layer to draw on a 'Texture'.-         -> (Texture -> [Layer])        -- ^ Layers using the texture.-         -> Layer-subLayer w h l = subRenderLayer . renderColor w h l+colorSubLayer :: Int                    -- ^ Texture width.+              -> Int                    -- ^ Texture height.+              -> Layer                  -- ^ Layer to draw on a 'Texture'.+              -> (Texture -> Layer)     -- ^ Layers using the texture.+              -> Layer+colorSubLayer w h l = subRenderLayer . renderColor w h l  -- | Use a 'Layer' as a depth 'Texture' on another.------ > depthSubLayer w h l = subRenderLayer . renderDepth w h l depthSubLayer :: Int                         -- ^ Texture width.               -> Int                         -- ^ Texture height.               -> Layer                       -- ^ Layer to draw on a                                              -- depth 'Texture'.-              -> (Texture -> [Layer])        -- ^ Layers using the texture.+              -> (Texture -> Layer)          -- ^ Layers using the texture.               -> Layer depthSubLayer w h l = subRenderLayer . renderDepth w h l --- TODO: buffersSubLayer+-- | Combination of 'colorSubLayer' and 'depthSubLayer'.+colorDepthSubLayer :: Int                               -- ^ Texture width.+                   -> Int                               -- ^ Texture height.+                   -> Layer                             -- ^ Layer to draw on the+                                                        -- 'Texture's.+                   -> (Texture -> Texture -> Layer)     -- ^ Color, depth.+                   -> Layer+colorDepthSubLayer w h l = subRenderLayer . renderColorDepth w h l --- | Generalized version of 'subLayer' and 'depthSubLayer'.-subRenderLayer :: RenderLayer [Layer] -> Layer+-- | 'colorSubLayer' with a stencil buffer.+colorStencilSubLayer :: Int                     -- ^ Texture width.+                     -> Int                     -- ^ Texture height.+                     -> Layer                   -- ^ Layer to draw on a 'Texture'+                     -> (Texture -> Layer)      -- ^ Color.+                     -> Layer+colorStencilSubLayer w h l = subRenderLayer . renderColorStencil w h l++-- | Extended version of 'colorSubLayer' that reads and converts the Texture+-- pixels.+colorSubLayer'+        :: Int                          -- ^ Texture width.+        -> Int                          -- ^ Texture height.+        -> Layer                        -- ^ Layer to draw on a 'Texture'.+        -> Int                          -- ^ First pixel to read X+        -> Int                          -- ^ First pixel to read Y+        -> Int                          -- ^ Width of the rectangle to read+        -> Int                          -- ^ Height of the rectangle to read+        -> (Texture -> [Color] -> Layer) -- ^ Function using the texture.+        -> Layer+colorSubLayer' w h l rx ry rw rh =+        subRenderLayer . renderColorInspect w h l rx ry rw rh++-- | Extended version of 'depthSubLayer'. Not supported on WebGL.+depthSubLayer'+        :: Int                          -- ^ Texture width.+        -> Int                          -- ^ Texture height.+        -> Layer                        -- ^ Layer to draw on a depth 'Texture'.+        -> Int                          -- ^ First pixel to read X+        -> Int                          -- ^ First pixel to read Y+        -> Int                          -- ^ Width of the rectangle to read+        -> Int                          -- ^ Height of the rectangle to read+        -> (Texture -> [Word8] -> Layer) -- ^ Layers using the texture.+        -> Layer+depthSubLayer' w h l rx ry rw rh =+        subRenderLayer . renderDepthInspect w h l rx ry rw rh++-- | Extended version of 'colorDepthSubLayer'. Not supported on WebGL.+colorDepthSubLayer'+        :: Int         -- ^ Texture width.+        -> Int         -- ^ Texture height.+        -> Layer       -- ^ Layer to draw on a 'Texture'+        -> Int         -- ^ First pixel to read X+        -> Int         -- ^ First pixel to read Y+        -> Int         -- ^ Width of the rectangle to read+        -> Int         -- ^ Height of the rectangle to read+        -> (Texture -> Texture -> [Color] -> [Word8] -> Layer) -- ^ Layers using+                                                               -- the texture.+        -> Layer+colorDepthSubLayer' w h l rx ry rw rh =+        subRenderLayer . renderColorDepthInspect w h l rx ry rw rh++-- | 'colorSubLayer'' with an additional stencil buffer.+colorStencilSubLayer'+        :: Int                          -- ^ Texture width.+        -> Int                          -- ^ Texture height.+        -> Layer                        -- ^ Layer to draw on a 'Texture'.+        -> Int                          -- ^ First pixel to read X+        -> Int                          -- ^ First pixel to read Y+        -> Int                          -- ^ Width of the rectangle to read+        -> Int                          -- ^ Height of the rectangle to read+        -> (Texture -> [Color] -> Layer) -- ^ Function using the texture.+        -> Layer+colorStencilSubLayer' w h l rx ry rw rh =+        subRenderLayer . renderColorStencilInspect w h l rx ry rw rh++-- | Render a 'Layer' with multiple floating point colors+-- (use 'Fragment2', 'Fragment3', etc.) in some 'Texture's and use them to+-- create another Layer.+buffersSubLayer :: Int                          -- ^ Textures width.+                -> Int                          -- ^ Textures height.+                -> Int                          -- ^ Number of colors.+                -> Layer                        -- ^ Layer to draw.+                -> ([Texture] -> Layer)         -- ^ Function using the textures.+                -> Layer+buffersSubLayer w h n l = subRenderLayer . renderBuffers w h n l++-- | Combination of 'buffersSubLayer' and 'depthSubLayer'.+buffersDepthSubLayer :: Int                             -- ^ Textures width.+                   -> Int                               -- ^ Textures height.+                   -> Int                               -- ^ Number of colors.+                   -> Layer                             -- ^ Layer to draw.+                   -> ([Texture] -> Texture -> Layer)   -- ^ Function using the+                                                        -- buffers textures and+                                                        -- the depth texture.+                   -> Layer+buffersDepthSubLayer w h n l = subRenderLayer . renderBuffersDepth w h n l++-- | 'buffersSubLayer' with an additional stencil buffer.+buffersStencilSubLayer :: Int                   -- ^ Textures width.+                       -> Int                   -- ^ Textures height.+                       -> Int                   -- ^ Number of colors.+                       -> Layer                 -- ^ Layer to draw.+                       -> ([Texture] -> Layer)  -- ^ Function using the texture.+                       -> Layer+buffersStencilSubLayer w h n l = subRenderLayer . renderBuffersStencil w h n l++subRenderLayer :: RenderLayer Layer -> Layer subRenderLayer = SubLayer  -- | Render a 'Layer' in a 'Texture'.-renderColor :: Int                         -- ^ Texture width.-            -> Int                         -- ^ Texture height.-            -> Layer                       -- ^ Layer to draw on a 'Texture'.-            -> (Texture -> a)              -- ^ Function using the texture.-            -> RenderLayer a+renderColor :: Int -> Int -> Layer -> (Texture -> a) -> RenderLayer a renderColor w h l f = RenderLayer False [ColorLayer, DepthLayer] w h 0 0 0 0                                   False False l $ \[t, _] _ _ -> f t --- | Render a 'Layer' in a depth 'Texture'-renderDepth :: Int              -- ^ Texture width.-            -> Int              -- ^ Texture height.-            -> Layer            -- ^ Layer to draw on a depth 'Texture'.-            -> (Texture -> a)   -- ^ Function using the texture.-            -> RenderLayer a+-- | Render a 'Layer' in a depth 'Texture'.+renderDepth :: Int -> Int -> Layer -> (Texture -> a) -> RenderLayer a renderDepth w h l f =         RenderLayer False [DepthLayer] w h 0 0 0 0 False False l $                 \[t] _ _ -> f t  -- | Combination of 'renderColor' and 'renderDepth'.-renderColorDepth :: Int                         -- ^ Texture width.-                 -> Int                         -- ^ Texture height.-                 -> Layer                       -- ^ Layer to draw on a 'Texture'-                 -> (Texture -> Texture -> a)   -- ^ Color, depth.+renderColorDepth :: Int+                 -> Int+                 -> Layer+                 -> (Texture -> Texture -> a)                  -> RenderLayer a renderColorDepth w h l f =         RenderLayer False [ColorLayer, DepthLayer] w h 0 0 0 0 False False l $                     \[ct, dt] _ _ -> f ct dt +-- | 'renderColor' with an additional stencil buffer.+renderColorStencil :: Int+                   -> Int+                   -> Layer+                   -> (Texture -> a)+                   -> RenderLayer a+renderColorStencil w h l f =+        RenderLayer False [ColorLayer, DepthStencilLayer] w h 0 0 0 0+                    False False l $+                    \[ct, _] _ _ -> f ct+ -- | Render a 'Layer' in a 'Texture', reading the content of the texture.-renderColorInspect-        :: Int                          -- ^ Texture width.-        -> Int                          -- ^ Texture height.-        -> Layer                        -- ^ Layer to draw on a 'Texture'.-        -> Int                          -- ^ First pixel to read X-        -> Int                          -- ^ First pixel to read Y-        -> Int                          -- ^ Width of the rectangle to read-        -> Int                          -- ^ Height of the rectangle to read-        -> (Texture -> [Color] -> a)    -- ^ Function using the texture.-        -> RenderLayer a+renderColorInspect :: Int+                   -> Int+                   -> Layer+                   -> Int+                   -> Int+                   -> Int+                   -> Int+                   -> (Texture -> [Color] -> a)+                   -> RenderLayer a renderColorInspect w h l rx ry rw rh f =         RenderLayer False [ColorLayer, DepthLayer] w h rx ry                     rw rh True False l $@@ -293,47 +477,75 @@  -- | Render a 'Layer' in a depth 'Texture', reading the content of the texture. -- Not supported on WebGL.-renderDepthInspect-        :: Int                          -- ^ Texture width.-        -> Int                          -- ^ Texture height.-        -> Layer                        -- ^ Layer to draw on a depth 'Texture'.-        -> Int                          -- ^ First pixel to read X-        -> Int                          -- ^ First pixel to read Y-        -> Int                          -- ^ Width of the rectangle to read-        -> Int                          -- ^ Height of the rectangle to read-        -> (Texture -> [Word8] -> a)    -- ^ Layers using the texture.-        -> RenderLayer a+renderDepthInspect :: Int+                   -> Int+                   -> Layer+                   -> Int+                   -> Int+                   -> Int+                   -> Int+                   -> (Texture -> [Word8] -> a)+                   -> RenderLayer a renderDepthInspect w h l rx ry rw rh f =         RenderLayer False [DepthLayer] w h rx ry rw rh False True l $                     \[t] _ (Just d) -> f t d  -- | Combination of 'renderColorInspect' and 'renderDepthInspect'. Not supported -- on WebGL.-renderColorDepthInspect-        :: Int         -- ^ Texture width.-        -> Int         -- ^ Texture height.-        -> Layer       -- ^ Layer to draw on a 'Texture'-        -> Int         -- ^ First pixel to read X-        -> Int         -- ^ First pixel to read Y-        -> Int         -- ^ Width of the rectangle to read-        -> Int         -- ^ Height of the rectangle to read-        -> (Texture -> Texture -> [Color] -> [Word8] -> a)  -- ^ Layers using-                                                            -- the texture.-        -> RenderLayer a+renderColorDepthInspect :: Int+                        -> Int+                        -> Layer+                        -> Int+                        -> Int+                        -> Int+                        -> Int+                        -> (Texture -> Texture -> [Color] -> [Word8] -> a)++                        -> RenderLayer a renderColorDepthInspect w h l rx ry rw rh f =         RenderLayer False [ColorLayer, DepthLayer] w h rx ry rw rh True True l $                     \[ct, dt] (Just c) (Just d) -> f ct dt c d +-- | 'renderColorInspect' with an additional stencil buffer.+renderColorStencilInspect :: Int+                          -> Int+                          -> Layer+                          -> Int+                          -> Int+                          -> Int+                          -> Int+                          -> (Texture -> [Color] -> a)+                          -> RenderLayer a+renderColorStencilInspect w h l rx ry rw rh f =+        RenderLayer False [ColorLayer, DepthStencilLayer] w h rx ry+                    rw rh True False l $+                    \[t, _] (Just c) _ -> f t c+ -- | Render a 'Layer' with multiple floating point colors -- (use 'Fragment2', 'Fragment3', etc.) in some 'Texture's.-renderBuffers :: Int                           -- ^ Textures width.-              -> Int                           -- ^ Textures height.-              -> Int                           -- ^ Number of colors.-              -> Layer                         -- ^ Layer to draw.-              -> ([Texture] -> a)              -- ^ Function using the texture.-              -> RenderLayer a+renderBuffers :: Int -> Int -> Int -> Layer -> ([Texture] -> a) -> RenderLayer a renderBuffers w h n l f =         RenderLayer True (DepthLayer : map BufferLayer [0 .. n - 1]) w h                     0 0 0 0 False False l $ \(_ : ts) _ _ -> f ts --- TODO: renderBuffersDepth+-- | Combination of 'renderBuffers' and 'renderDepth'.+renderBuffersDepth :: Int+                   -> Int+                   -> Int+                   -> Layer+                   -> ([Texture] -> Texture -> a)+                   -> RenderLayer a+renderBuffersDepth w h n l f =+        RenderLayer True (DepthLayer : map BufferLayer [0 .. n - 1]) w h+                    0 0 0 0 False False l $ \(dt : ts) _ _ -> f ts dt++-- | 'renderBuffers' with an additional stencil buffer.+renderBuffersStencil :: Int+                     -> Int+                     -> Int+                     -> Layer+                     -> ([Texture] -> a)+                     -> RenderLayer a+renderBuffersStencil w h n l f =+        RenderLayer True (DepthStencilLayer : map BufferLayer [0 .. n - 1]) w h+                    0 0 0 0 False False l $ \(_ : ts) _ _ -> f ts

@@ -11,6 +11,7 @@         GPUVAOGeometry(..),         extend,         remove,+        positionOnly,         withGPUBufferGeometry,         mkGeometry,         mkGeometry2D,@@ -18,27 +19,22 @@         castGeometry ) where -import Control.Applicative import Control.Monad.Trans.Class import Control.Monad.Trans.State import qualified Data.Hashable as H-import qualified Data.HashMap.Strict as H import Data.Typeable-import qualified Data.Vector.Storable as V import Data.Vect.Float hiding (Normal3) import Data.Word (Word16) import Unsafe.Coerce  import Graphics.Rendering.Ombra.Internal.GL import Graphics.Rendering.Ombra.Internal.Resource-import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.CPU import Graphics.Rendering.Ombra.Shader.Default2D (Position2) import Graphics.Rendering.Ombra.Shader.Default3D (Position3, Normal3) import qualified Graphics.Rendering.Ombra.Shader.Default2D as D2 import qualified Graphics.Rendering.Ombra.Shader.Default3D as D3 import Graphics.Rendering.Ombra.Shader.Language.Types (ShaderType(size))-import Graphics.Rendering.Ombra.Transformation  -- | A heterogeneous list of attributes. data AttrList (is :: [*]) where@@ -128,6 +124,11 @@        -> Geometry is -> Geometry is' remove g (Geometry al es _) = mkGeometry (removeAttr g al) es +-- | Remove the 'UV' and 'Normal3' attributes from a 3D Geometry.+positionOnly :: Geometry Geometry3D -> Geometry '[Position3]+positionOnly (Geometry (AttrListCons pg pc _) es h) =+        Geometry (AttrListCons pg pc AttrListNil) es h+ class RemoveAttr i is is' where         removeAttr :: (a -> i) -> AttrList is -> AttrList is' @@ -140,19 +141,17 @@                 AttrListCons g' c $ removeAttr g al  -- | Create a custom 'Geometry'.-mkGeometry :: GLES => AttrList is -> [Word16] -> Geometry is+mkGeometry :: AttrList is -> [Word16] -> Geometry is mkGeometry al e = Geometry al e $ H.hash (al, e)  castGeometry :: Geometry is -> Geometry is' castGeometry = unsafeCoerce  instance GLES => Resource (Geometry i) GPUBufferGeometry GL where-        -- TODO: err check         loadResource i = Right <$> loadGeometry i         unloadResource _ = deleteGPUBufferGeometry  instance GLES => Resource GPUBufferGeometry GPUVAOGeometry GL where-        -- TODO: err check         loadResource i = Right <$> loadGPUVAOGeometry i         unloadResource _ = deleteGPUVAOGeometry @@ -198,7 +197,7 @@                       => GPUBufferGeometry -> (Int -> [Buffer] -> GL a) -> GL a withGPUBufferGeometry (GPUBufferGeometry abs eb ec _) f =         do bindBuffer gl_ARRAY_BUFFER noBuffer-           (locs, bufs) <- unzip <$>+           (_, bufs) <- unzip <$>                    mapM (\(buf, loc, setAttr) ->                                      do bindBuffer gl_ARRAY_BUFFER buf                                         enableVertexAttribArray loc@@ -223,7 +222,6 @@ deleteGPUBufferGeometry (GPUBufferGeometry abs eb _ _) =         mapM_ (\(buf, _, _) -> deleteBuffer buf) abs >> deleteBuffer eb --- TODO: move loadBuffer :: GLES => GLEnum -> AnyArray -> GL Buffer loadBuffer ty bufData =         do buffer <- createBuffer

@@ -96,7 +96,8 @@         stencilMaskSeparate,         stencilOp,         stencilOpSeparate,-        texImage2D,+        texImage2DUInt,+        texImage2DFloat,         texParameterf,         texParameteri,         texSubImage2D,@@ -133,12 +134,9 @@         viewport ) where -import Control.Applicative-import Control.Concurrent import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Data.Int (Int32)-import Data.Word  import Graphics.Rendering.Ombra.Backend import Graphics.Rendering.Ombra.Internal.Resource (EmbedIO(..))@@ -146,6 +144,7 @@ newtype GL a = GL (ReaderT Ctx IO a)         deriving (Functor, Applicative, Monad, MonadIO) +-- | A Texture ready to be passed as an uniform. newtype ActiveTexture = ActiveTexture Word  instance EmbedIO GL where@@ -154,7 +153,7 @@ evalGL :: GL a -> Ctx -> IO a evalGL (GL m) = runReaderT m -getCtx :: GLES => GL Ctx+getCtx :: GL Ctx getCtx = GL ask  activeTexture :: GLES => GLEnum -> GL ()@@ -457,8 +456,11 @@ stencilOpSeparate :: GLES => GLEnum -> GLEnum -> GLEnum -> GLEnum -> GL () stencilOpSeparate a b c d = getCtx >>= \ctx -> liftIO $ glStencilOpSeparate ctx a b c d -texImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> UInt8Array -> GL ()-texImage2D a b c d e f g h i = getCtx >>= \ctx -> liftIO $ glTexImage2D ctx a b c d e f g h i+texImage2DUInt :: GLES => GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> UInt8Array -> GL ()+texImage2DUInt a b c d e f g h i = getCtx >>= \ctx -> liftIO $ glTexImage2DUInt ctx a b c d e f g h i++texImage2DFloat :: GLES => GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> Float32Array -> GL ()+texImage2DFloat a b c d e f g h i = getCtx >>= \ctx -> liftIO $ glTexImage2DFloat ctx a b c d e f g h i  texParameterf :: GLES => GLEnum -> GLEnum -> Float -> GL () texParameterf a b c = getCtx >>= \ctx -> liftIO $ glTexParameterf ctx a b c

@@ -12,11 +12,8 @@         removeResource ) where -import Control.Applicative import Control.Monad.IO.Class import qualified Data.HashTable.IO as H-import Data.IORef-import Data.Functor import Data.Hashable import System.Mem.Weak @@ -41,12 +38,14 @@ addResource :: (Resource i r m, Hashable i) => i -> ResMap i r -> m () addResource i m = () <$ getResource i m -checkResource :: (Resource i r m, Hashable i)-              => i -> ResMap i r -> m (ResStatus r)+checkResource :: Hashable i+              => Resource i r m+              => i+              -> ResMap i r+              -> m (ResStatus r) checkResource i = checkResource' $ hash i -checkResource' :: (Resource i r m, Hashable i)-               => Int -> ResMap i r -> m (ResStatus r)+checkResource' :: Resource i r m => Int -> ResMap i r -> m (ResStatus r) checkResource' i (ResMap map) = do m <- liftIO $ H.lookup map i                                    return $ case m of                                                  Just (Right r) -> Loaded r

@@ -1,31 +0,0 @@-module Graphics.Rendering.Ombra.Internal.STVectorLen where--import Control.Applicative-import Control.Monad (when)-import Control.Monad.ST-import Data.STRef-import qualified Data.Vector.Storable as V-import qualified Data.Vector.Storable.Mutable as M--type STVectorLen s a = (STRef s (M.STVector s a), STRef s Int)--new :: V.Storable a => ST s (STVectorLen s a)-new = (,) <$> (M.new 256 >>= newSTRef) <*> newSTRef 0--(!) :: V.Storable a => STVectorLen s a -> Int -> ST s a-(!) (vRef, _) i = readSTRef vRef >>= flip M.read i--cons :: V.Storable a => a -> STVectorLen s a -> ST s ()-cons x (vRef, lenRef) = do len <- readSTRef lenRef-                           v <- readSTRef vRef-                           let maxLen = M.length v-                           when (len >= maxLen) $ -                                   M.grow v (maxLen * 2) >>= writeSTRef vRef-                           v' <- readSTRef vRef-                           M.write v' len x-                           writeSTRef lenRef $ len + 1--freeze :: V.Storable a => STVectorLen s a -> ST s (V.Vector a)-freeze (vRef, lenRef) = do v <- readSTRef vRef >>= V.freeze-                           len <- readSTRef lenRef-                           return $ V.slice 0 len v

@@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies,              TypeOperators, UndecidableInstances, FlexibleContexts,              FlexibleInstances, ConstraintKinds, PolyKinds,-             ScopedTypeVariables #-}+             ScopedTypeVariables, GADTs #-}  module Graphics.Rendering.Ombra.Internal.TList (         Not,@@ -20,14 +20,36 @@         Insert,         Reverse,         Union,-        Set,+        Set(..),+        TypeSet(..),         module GHC.TypeLits ) where +import Data.Proxy (Proxy(..)) import GHC.TypeLits (TypeError, ErrorMessage(..)) import GHC.Exts (Constraint) -type Set xs = Union xs xs ~ xs+data TypeSet (constr :: * -> Constraint) xs where+        PSNil :: TypeSet constr '[]+        PSCons :: (Set constr xs, constr x)+               => Proxy x -> TypeSet constr xs -> TypeSet constr (x ': xs)++class Union xs xs ~ xs => Set (constr :: * -> Constraint) xs where+        typeSet :: TypeSet constr xs+        +instance Set constr '[] where+        typeSet = PSNil++instance ( NotMemberOrErr x xs (Text "Duplicate variable: ‘" :<>:+                                ShowType x :$$:+                                Text "’    In SVList: ... : [" :<>:+                                ShowType x :<>:+                                Text "] : " :<>:+                                ShowType xs)+         , Union (x ': xs) (x ': xs) ~ (x ': xs), Set constr xs, constr x) =>+         Set constr (x ': xs) where+        typeSet = PSCons (Proxy :: Proxy x) (typeSet :: TypeSet constr xs)+                        :: TypeSet constr (x ': xs)  type family Empty (xs :: [*]) :: Bool where         Empty '[] = True

@@ -38,6 +38,11 @@  -} +-- TODO: Alternative version of the module that can be used without+-- RebindableSyntax and with Prelude functions. Use Num for scalars, vect+-- typeclasses for vectors and matrices, and prefixed functions for the other+-- clashing functions.+ module Graphics.Rendering.Ombra.Shader (         -- * Types         Shader,@@ -45,6 +50,8 @@         FragmentShader,         VertexShaderOutput(Vertex),         FragmentShaderOutput(..),+        ShaderVars,+        VOShaderVars,         Uniform,         Attribute,         Generic,@@ -202,12 +209,7 @@         fragFrontFacing ) where -import qualified Data.Int as CPU-import Data.Typeable (Typeable)-import qualified Data.Vect.Float as CPU import GHC.Generics (Generic)-import qualified Graphics.Rendering.Ombra.Internal.GL as CPU-import qualified Graphics.Rendering.Ombra.Backend as CPU import Graphics.Rendering.Ombra.Shader.CPU import Graphics.Rendering.Ombra.Shader.Language.Types import Graphics.Rendering.Ombra.Shader.Language.Functions

@@ -1,11 +1,12 @@ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses, DataKinds, TypeOperators,-             FunctionalDependencies, FlexibleInstances, RankNTypes, PolyKinds,-             FlexibleContexts, UndecidableInstances, ScopedTypeVariables #-}+             FlexibleInstances, RankNTypes, PolyKinds, FlexibleContexts,+             UndecidableInstances, ScopedTypeVariables #-}  module Graphics.Rendering.Ombra.Shader.CPU (         CPUSetterType(..),-        CPU(..),-        CPUBase(..),+        CPU,+        CPUBase,+        CPUMirror,         BaseUniform(..),         BaseAttribute(..),         Uniform(..),@@ -16,7 +17,6 @@ ) where  import qualified Data.Int as CPU-import Data.Word (Word) import Data.Typeable import qualified Graphics.Rendering.Ombra.Shader.Language.Types as GPU import Graphics.Rendering.Ombra.Internal.GL as CPU@@ -42,8 +42,19 @@         CPU 'M x = CPUMirror x  type family CPUBase g++-- | The mirror type of a certain global.+-- +-- For instance:+--+-- @+--      data T = T Vec3 Float -- In the shader module+--      data T = T Vec3 Float -- CPU version of the uniform type+--      type CPUMirror GPU.T = T+-- @ type family CPUMirror g + -- type family CPUAutoSetter (g :: * -> *) :: CPUSetterType -- type CPUAuto g = CPU (CPUAutoSetter g) g @@ -75,11 +86,11 @@                        -> f ()  instance (BaseUniform (GCPUValue (Rep g)), Generic g) => Uniform S g where-        withUniforms _ (g :: g) c f =+        withUniforms _ (_ :: g) c f =                 f 0 (Proxy :: Proxy (GCPUValue (Rep g))) c  instance (BaseAttribute (GCPUValue (Rep g)), Generic g) => Attribute S g where-        withAttributes _ (g :: g) c f =+        withAttributes _ (_ :: g) c f =                 f 0 (Proxy :: Proxy (GCPUValue (Rep g))) c  instance ( GUniformMirror (Rep g) (Rep (CPUMirror g))@@ -152,11 +163,11 @@ instance ( GUniformMirror a ma d c          , M1 mi mv ma ~ GCPUMirror (M1 i v a) d c )         => GUniformMirror (M1 i v a) (M1 mi mv ma) d c where-        gWithUniformMirror p i (M1 x) (M1 mx) f = gWithUniformMirror p i x mx f+        gWithUniformMirror p i (M1 x) (M1 mx) = gWithUniformMirror p i x mx  instance (BaseUniform a, m ~ GCPUMirror (K1 i a) d c)         => GUniformMirror (K1 i a) m d c where-        gWithUniformMirror _ i (K1 (x :: t)) (K1 mx) f =+        gWithUniformMirror _ i (K1 (_ :: t)) (K1 mx) f =                 (f i (Proxy :: Proxy t) mx, i + 1)  {-@@ -198,7 +209,7 @@ type instance CPUBase (GPU.Array n GPU.Float) = [CPU.Float]  instance GLES => BaseUniform GPU.Float where-        setUniform l _ v = uniform1f l v+        setUniform l _ = uniform1f l  instance GLES => BaseUniform (GPU.Array n GPU.Float) where         setUniform l _ v = liftIO (encodeFloats v) >>= uniform1fv l@@ -213,7 +224,7 @@ type instance CPUBase (GPU.Array n GPU.Bool) = [CPU.Int32]  instance GLES => BaseUniform GPU.Bool where-        setUniform l _ v = uniform1i l v+        setUniform l _ = uniform1i l  instance GLES => BaseUniform (GPU.Array n GPU.Bool) where         setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l@@ -228,7 +239,7 @@ type instance CPUBase (GPU.Array n GPU.Int) = [CPU.Int32]  instance GLES => BaseUniform GPU.Int where-        setUniform l _ v = uniform1i l v+        setUniform l _ = uniform1i l  instance GLES => BaseUniform (GPU.Array n GPU.Int) where         setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l

@@ -21,12 +21,15 @@  vertexShader :: VertexShader '[ Transform3, View3 ]                              '[ Position3, UV, Normal3 ]-                             '[ UV, Normal3 ]+                             '[ Position3, UV, Normal3 ] vertexShader (Transform3 modelMatrix :- View3 viewMatrix :- N)-             (Position3 (Vec3 x y z) :- uv@(UV _) :- norm@(Normal3 _) :- N) =-             let v = viewMatrix * modelMatrix * Vec4 x y z 1.0-             in Vertex v :- uv :- norm :- N+             (Position3 pos :- uv :- Normal3 norm :- N) =+             let worldPos = modelMatrix * vec4 (pos # 1.0)+                 viewPos = viewMatrix * worldPos+                 worldNorm = vec3 $ modelMatrix * vec4 (norm # 0.0)+             in Vertex viewPos :- Position3 (vec3 worldPos) :-+                uv :- Normal3 worldNorm :- N -fragmentShader :: FragmentShader '[ Texture2 ] [ UV, Normal3 ]-fragmentShader (Texture2 sampler :- N) (UV (Vec2 s t) :- Normal3 _ :- N) =+fragmentShader :: FragmentShader '[ Texture2 ] [ Position3, UV, Normal3 ]+fragmentShader (Texture2 sampler :- N) (_ :- UV (Vec2 s t) :- _ :- N) =                 Fragment (texture2D sampler $ Vec2 s (1 - t)) :- N

@@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts,-             KindSignatures, DataKinds, TypeOperators, ConstraintKinds #-}+             DataKinds, TypeOperators, ConstraintKinds #-}  module Graphics.Rendering.Ombra.Shader.GLSL (         vertexToGLSLAttr,@@ -9,35 +9,37 @@         uniformName ) where -import Control.Monad import Data.Hashable (hash) -- TODO: use ST hashtables import qualified Data.HashMap.Strict as H import Data.Typeable import Graphics.Rendering.Ombra.Shader.ShaderVar import Graphics.Rendering.Ombra.Shader.Language.Types hiding (Int, Bool)-import Graphics.Rendering.Ombra.Shader.Stages (VertexShader, FragmentShader, ValidVertex)+import Graphics.Rendering.Ombra.Shader.Stages (VertexShader, FragmentShader,+                                               VOShaderVars) import Text.Printf  data VarPrefix = Global | Varying | Attribute -data ShaderVars = ShaderVars {+data SV = SV {         uniformVars :: [(String, String)],         inputVars :: [(String, String, Int)],         outputVars :: [(String, String, Expr)] } -vertexToGLSLAttr :: ValidVertex g i o => VertexShader g i o+vertexToGLSLAttr :: (ShaderVars g, ShaderVars i, VOShaderVars o)+                 => VertexShader g i o                   -> (String, [(String, Int)]) vertexToGLSLAttr v =-        let r@(ShaderVars _ is _) = vars False v+        let r@(SV _ is _) = vars False v         in ( shaderToGLSL "#version 100\n" "attribute" "varying"                           r [("hvVertexShaderOutput0", "gl_Position")]-           , map (\(t, n, s) -> (n, s)) is)+           , map (\(_, n, s) -> (n, s)) is) -vertexToGLSL :: ValidVertex g i o => VertexShader g i o -> String+vertexToGLSL :: (ShaderVars g, ShaderVars i, VOShaderVars o)+             => VertexShader g i o -> String vertexToGLSL = fst . vertexToGLSLAttr -fragmentToGLSL :: Valid g i '[] => FragmentShader g i -> String+fragmentToGLSL :: (ShaderVars g, ShaderVars i) => FragmentShader g i -> String fragmentToGLSL v =         shaderToGLSL "#version 100\nprecision mediump float;"                      "varying" "" (vars True v)@@ -58,8 +60,8 @@                       , ("hvFragmentShaderOutput14", "gl_FragData[14]")                       , ("hvFragmentShaderOutput15", "gl_FragData[15]") ] -shaderToGLSL :: String -> String -> String -> ShaderVars -> [(String, String)] -> String-shaderToGLSL header ins outs (ShaderVars gs is os) predec = concat+shaderToGLSL :: String -> String -> String -> SV -> [(String, String)] -> String+shaderToGLSL header ins outs (SV gs is os) predec = concat         [ header         , concatMap (var "uniform") gs         , concatMap (\(t, n, _) -> var ins (t, n)) is@@ -74,17 +76,18 @@         , "}" ]         where var qual (ty, nm) = qual ++ " " ++ ty ++ " " ++ nm ++ ";"               replace x xs = case filter ((== x) . fst) xs of-                                        ((_, y) : []) -> y+                                        [(_, y)] -> y                                         _ -> x               (_, outNames, outExprs) = unzip3 os               (actions, outStrs) = compile outExprs               compiledOuts = zip outNames outStrs -vars :: Valid gs is os => Bool -> Shader gs is os -> ShaderVars+vars :: (ShaderVars gs, ShaderVars is, ShaderVars os)+     => Bool -> Shader gs is os -> SV vars isFragment (shader :: Shader gs is os) =-        ShaderVars (svToList globalVar globals)-                   (svToList inputVar inputs)-                   (svToList outputVar outputs)+        SV (svToList globalVar globals)+           (svToList inputVar inputs)+           (svToList outputVar outputs)         where globals = staticSVList (Proxy :: Proxy gs) $ varExpr Global               inputs = staticSVList (Proxy :: Proxy is) $ varExpr inputPrefix               outputs = shader globals inputs@@ -108,7 +111,7 @@                varExpr :: ShaderVar v => VarPrefix -> Proxy v -> v               varExpr p (pvar :: Proxy v) =-                      varBuild (\n -> fromExpr . Read $ varName p var n) pvar+                      varBuild (fromExpr . Read . varName p var) pvar                 where var = undefined :: v  type ActionID = Int@@ -158,7 +161,7 @@                       let deps = actionDeps ai                           (childrenMap', sortedIDs', graph') =                                 H.foldrWithKey-                                        (\aID _ state -> visit aID state)+                                        (\aID' _ state -> visit aID' state)                                         (childrenMap, sortedIDs, graph)                                         deps                       in case actionContext ai of@@ -173,6 +176,9 @@                                           cmap' = H.unionWith H.union smap                                                               childrenMap'                                       in (cmap', sortedIDs', H.delete aID graph')+                              ShallowContext _ ->+                                      error "sortActions: unexpected \+                                            \ShallowContext"                makePair childrenMap graph aID =                        ( actionGenerator $ graph H.! aID@@ -211,7 +217,7 @@                                       aID (act { actionContext = ctx' }) graph')                 ctx -> (ctx, graph)         where act = graph H.! aID-              addDepContext depID depInfo (ctx, graph) = +              addDepContext depID _ (ctx, graph) =                        let (DeepContext dCtx, graph') = deep depID graph                        in (H.union ctx (H.delete depID dCtx), graph') 

@@ -6,10 +6,9 @@  import Graphics.Rendering.Ombra.Shader.Language.Types -import GHC.Exts (Constraint) import GHC.TypeLits import Text.Printf-import Prelude (String, (.), ($), error, Eq)+import Prelude (String, (.), ($), error) import qualified Prelude  -- TODO: memoized versions of the functions

@@ -1,5 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, DataKinds,-             KindSignatures, ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses, DataKinds, KindSignatures,+             ScopedTypeVariables #-}  module Graphics.Rendering.Ombra.Shader.Language.Types where @@ -395,13 +395,13 @@                                 Read str -> hash2 s 1 str                                 Op1 str exp -> hash2 s 2 (str, exp)                                 Op2 str exp exp' -> hash2 3 s (str, exp, exp')-                                Apply str exps -> hash2 4 s exps+                                Apply str exps -> hash2 4 s (str, exps)                                 X exp -> hash2 5 s exp                                 Y exp -> hash2 6 s exp                                 Z exp -> hash2 7 s exp                                 W exp -> hash2 8 s exp                                 Literal str -> hash2 s 9 str-                                Action hash -> hash2 s 10 hash+                                Action actHash -> hash2 s 10 actHash                                 Dummy i -> hash2 s 11 i                                 ContextVar i LoopIteration -> hash2 s 12 i                                 ContextVar i LoopValue -> hash2 s 13 i

@@ -1,11 +1,11 @@ {-# LANGUAGE MultiParamTypeClasses, ExistentialQuantification, ConstraintKinds,-             FunctionalDependencies, KindSignatures, DataKinds, GADTs,-             RankNTypes, FlexibleInstances, ScopedTypeVariables,-             TypeOperators, ImpredicativeTypes, TypeSynonymInstances,-             FlexibleContexts #-}+             KindSignatures, DataKinds, GADTs, RankNTypes, FlexibleInstances,+             ScopedTypeVariables, TypeOperators, ImpredicativeTypes,+             TypeSynonymInstances, FlexibleContexts #-}  module Graphics.Rendering.Ombra.Shader.Program (         LoadedProgram(..),+        Compatible,         Program,         program,         loadProgram,@@ -20,11 +20,10 @@  import Data.Hashable import qualified Data.HashMap.Strict as H-import Data.Word (Word) import qualified Graphics.Rendering.Ombra.Shader.Default2D as Default2D import qualified Graphics.Rendering.Ombra.Shader.Default3D as Default3D import Graphics.Rendering.Ombra.Shader.GLSL-import Graphics.Rendering.Ombra.Shader.ShaderVar (Valid)+import Graphics.Rendering.Ombra.Shader.ShaderVar (ShaderVars) import Graphics.Rendering.Ombra.Shader.Stages import Graphics.Rendering.Ombra.Internal.GL hiding (Program) import qualified Graphics.Rendering.Ombra.Internal.GL as GL@@ -38,7 +37,6 @@  data LoadedProgram = LoadedProgram !GL.Program (H.HashMap String Int) Int - -- | The uniforms used in the default 3D program. type DefaultUniforms3D = Default3D.Uniforms @@ -72,6 +70,7 @@ -- castProgram (Program v f h) = Program v f h castProgram = unsafeCoerce +-- | Compatible shaders. type Compatible pgs vgs fgs =         EqualOrErr pgs (Union vgs fgs)                    (Text "Incompatible shader uniforms" :$$:@@ -85,8 +84,9 @@                     ShowType pgs)  -- | Create a 'Program' from the shaders.-program :: (ValidVertex vgs vis vos, Valid fgs vos '[], Compatible pgs vgs fgs)-        => VertexShader vgs vis vos -> FragmentShader fgs vos+program :: ( ShaderVars vgs, ShaderVars vis, VOShaderVars os , ShaderVars fgs+           , Compatible pgs vgs fgs )+        => VertexShader vgs vis os -> FragmentShader fgs os         -> Program pgs vis program vs fs = let (vss, attrs) = vertexToGLSLAttr vs                     fss = fragmentToGLSL fs

@@ -4,8 +4,7 @@              UndecidableInstances #-}  module Graphics.Rendering.Ombra.Shader.ShaderVar (-        Shader(..),-        Valid,+        Shader,         Member,         Subset,         Equal,@@ -13,6 +12,7 @@         Insert,         SVList(..),         ShaderVar,+        ShaderVars,         BaseTypes,         varPreName,         varBuild,@@ -29,26 +29,17 @@  infixr 4 :- -type NonDuplicate x xs = NotMemberOrErr x xs-                                        (Text "Duplicate variable: ‘" :<>:-                                         ShowType x :$$:-                                         Text "’    In SVList: ... : [" :<>:-                                         ShowType x :<>:-                                         Text "] : " :<>:-                                         ShowType xs)+-- | A type-level set of 'ShaderVar's.+type ShaderVars = Set ShaderVar --- | An heterogeneous set of 'ShaderVar's.+-- | An heterogeneous list of 'ShaderVar's. data SVList :: [*] -> * where         N :: SVList '[]-        (:-) :: (ShaderVar a, NonDuplicate a xs)-             => a -> SVList xs -> SVList (a ': xs)---- | The condition for a valid 'Shader'.--type Valid gs is os = (StaticSVList gs, StaticSVList is, StaticSVList os)+        (:-) :: ShaderVar a => a -> SVList xs -> SVList (a ': xs) --- | A function from a (heterogeneous) set of uniforms and a set of inputs--- (attributes or varyings) to a set of outputs (varyings).+-- | A function from a set of uniforms and a set of inputs (attributes or+-- varyings) to a set of outputs (varyings). It can be used to represent a+-- reusable piece of shader code, other than actual shaders. type Shader gs is os = SVList gs -> SVList is -> SVList os  class GShaderVar (g :: * -> *) where@@ -129,16 +120,12 @@ svToList :: (forall x. ShaderVar x => x -> [y]) -> SVList xs -> [y] svToList f = svFold (\acc x -> acc ++ f x) [] -class StaticSVList (xs :: [*]) where-        -- | Create a 'SVList' with a function.-        staticSVList :: Proxy (xs :: [*])-                     -> (forall x. ShaderVar x => Proxy x -> x)-                     -> SVList xs--instance StaticSVList '[] where-        staticSVList (_ :: Proxy '[]) _ = N--instance (ShaderVar x, StaticSVList xs, NonDuplicate x xs) =>-         StaticSVList (x ': xs) where-        staticSVList (_ :: Proxy (x ': xs)) f =-                f (Proxy :: Proxy x) :- staticSVList (Proxy :: Proxy xs) f+-- | Create a 'SVList' with a function.+staticSVList :: ShaderVars xs+             => Proxy (xs :: [*])+             -> (forall x. ShaderVar x => Proxy x -> x)+             -> SVList xs+staticSVList (_ :: Proxy xs) f = tsToSV (typeSet :: TypeSet ShaderVar xs)+        where tsToSV :: TypeSet ShaderVar s -> SVList s+              tsToSV PSNil = N+              tsToSV (PSCons px ts) = f px :- tsToSV ts

@@ -1,30 +1,26 @@-{-# LANGUAGE TypeOperators, DataKinds, GeneralizedNewtypeDeriving,-             DeriveDataTypeable, RankNTypes, FlexibleContexts,+{-# LANGUAGE TypeOperators, DataKinds, RankNTypes, FlexibleContexts,              TypeFamilies, ConstraintKinds, DeriveGeneric #-}  module Graphics.Rendering.Ombra.Shader.Stages (         VertexShader,-        ValidVertex,         FragmentShader,         VertexShaderOutput(Vertex),-        FragmentShaderOutput(..)+        FragmentShaderOutput(..),+        VOShaderVars, ) where -import Data.Typeable- import GHC.Generics-import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Shader.Language.Types import Graphics.Rendering.Ombra.Shader.ShaderVar  -- | A 'Shader' with a 'VertexShaderOutput' output. type VertexShader g i o = Shader g i (VertexShaderOutput ': o) +-- | 'ShaderVars' for the output of 'VartexShader'.+type VOShaderVars o = (ShaderVars o, ShaderVars (VertexShaderOutput ': o))+ -- | A 'Shader' with only a 'FragmentShaderOutput' output. type FragmentShader g i = Shader g i (FragmentShaderOutput ': '[])---- | The condition for a valid 'VertexShader'.-type ValidVertex g i o = (Valid g i o, IsMember VertexShaderOutput o ~ False)  -- | The position of the vertex. data VertexShaderOutput = Vertex Vec4 deriving Generic

@@ -0,0 +1,68 @@+module Graphics.Rendering.Ombra.Stencil where++import Graphics.Rendering.Ombra.Internal.GL++-- | Stencil mode.+data Mode = Mode (Side Function) (Side Operation) deriving Eq++data Side a = FrontBack a       -- ^ Use the same value for both sides.+            | Separate a a      -- ^ Use a different value for each side (front+                                -- and back).+            deriving Eq++-- | Function type, fragment stencil value and mask.+data Function = Function FunctionType Int Word deriving Eq++-- | Operation to perform between the masked fragment stencil value and the+-- masked destination stencil value.+data FunctionType = Never               -- ^ Never pass.+                  | Always              -- ^ Always pass.+                  | Less                -- ^ <+                  | LessOrEqual         -- ^ <=+                  | Greater             -- ^ >+                  | GreaterOrEqual      -- ^ >=+                  | Equal               -- ^ ==+                  | NotEqual            -- ^ /=+                  deriving Eq++-- | Operations to perform if the stencil test fails, if the stencil test passes+-- but the depth test fails, and if both the stencil test and the depth test+-- pass.+data Operation = Operation OperationType OperationType OperationType deriving Eq++-- | Operation to perform to the stencil value in the buffer.+data OperationType = Keep       -- ^ Keep it unchanged.+                   | Invert     -- ^ Invert it.+                   | Zero       -- ^ Set it to zero.+                   | Replace    -- ^ Replace it with the masked fragment value.+                   | Increment  -- ^ Increment it if not maximum.+                   | Decrement  -- ^ Decrement it if not zero.+                   | IncWrap    -- ^ Increment it, wrapping it if it would+                                -- overflow.+                   | DecWrap    -- ^ Decrement it, wrapping it if it would+                                -- underflow.+                   deriving Eq++function :: GLES => Function -> (GLEnum, GLInt, GLUInt)+function (Function ty value mask) = ( getType ty+                                    , fromIntegral value+                                    , fromIntegral mask )+        where getType Never = gl_NEVER+              getType Always = gl_ALWAYS+              getType Less = gl_LESS+              getType LessOrEqual = gl_LEQUAL+              getType Greater = gl_GREATER+              getType GreaterOrEqual = gl_GEQUAL+              getType Equal = gl_EQUAL+              getType NotEqual = gl_NOTEQUAL++operation :: GLES => Operation -> (GLEnum, GLEnum, GLEnum)+operation (Operation sf spdf spdp) = (getOp sf, getOp spdf, getOp spdp)+        where getOp Keep = gl_KEEP+              getOp Invert = gl_INVERT+              getOp Zero = gl_ZERO+              getOp Replace = gl_REPLACE+              getOp Increment = gl_INCR+              getOp Decrement = gl_DECR+              getOp IncWrap = gl_INCR_WRAP+              getOp DecWrap = gl_DECR_WRAP

@@ -3,11 +3,14 @@ module Graphics.Rendering.Ombra.Texture (         mkTexture,         mkTextureRaw,+        mkTextureFloat,+        setFilter,         emptyTexture ) where  import Data.Hashable +import Data.Vect.Float import Graphics.Rendering.Ombra.Backend (GLES) import qualified Graphics.Rendering.Ombra.Backend as GL import Graphics.Rendering.Ombra.Color@@ -22,49 +25,88 @@           -> Int      -- ^ Height.           -> [Color]  -- ^ List of pixels           -> Texture-mkTexture w h ps = TextureImage . TexturePixels ps (fromIntegral w)+mkTexture w h ps = TextureImage . TexturePixels ps Linear Linear+                                                   (fromIntegral w)                                                    (fromIntegral h)-                        $ hash (w, h, ps)+                        $ hash (w, h, take (w * h) ps)  mkTextureRaw :: GLES-             => Int-             -> Int-             -> UInt8Array-             -> Int+             => Int         -- ^ Width.+             -> Int         -- ^ Height.+             -> UInt8Array  -- ^ Array of pixel components.+             -> Int         -- ^ Texture hash              -> Texture-mkTextureRaw w h arr hash = TextureImage $ TextureRaw arr-                                                      (fromIntegral w)-                                                      (fromIntegral h)-                                                      hash+mkTextureRaw w h arr pxhash = TextureImage $ TextureRaw arr Linear Linear+                                                        (fromIntegral w)+                                                        (fromIntegral h)+                                                        $ hash (w, h, pxhash) +-- | Creates a float 'Texture' from a list of vectors.+mkTextureFloat :: GLES+               => Int      -- ^ Width.+               -> Int      -- ^ Height.+               -> [Vec4]   -- ^ List of vectors.+               -> Texture+mkTextureFloat w h vs = TextureImage . TextureFloat ps Linear Linear+                                                       (fromIntegral w)+                                                       (fromIntegral h)+                                $ hash (w, h, take (w * h * 4) ps)+        where ps = vs >>= \(Vec4 x y z w) -> [x, y, z, w]++-- | Change the Texture minifying and magnifying functions. This doesn't work on+-- sublayer textures.+setFilter :: Filter -> Filter -> Texture -> Texture+setFilter min mag (TextureImage (TexturePixels c _ _ w h s)) =+        TextureImage (TexturePixels c min mag w h s)+setFilter min mag (TextureImage (TextureRaw c _ _ w h s)) =+        TextureImage (TextureRaw c min mag w h s)+setFilter min mag (TextureImage (TextureFloat c _ _ w h s)) =+        TextureImage (TextureFloat c min mag w h s)+setFilter _ _ t = t+ instance GLES => Resource TextureImage LoadedTexture GL where-        loadResource i = Right <$> loadTextureImage i -- TODO: err check+        loadResource i = Right <$> loadTextureImage i         unloadResource _ (LoadedTexture _ _ t) = deleteTexture t  loadTextureImage :: GLES => TextureImage -> GL LoadedTexture-loadTextureImage (TexturePixels ps w h hash) =-        do arr <- liftIO . encodeUInt8s $+loadTextureImage (TexturePixels ps min mag w h hash) =+        do arr <- liftIO . encodeUInt8s . take (fromIntegral $ w * h * 4) $                         ps >>= \(Color r g b a) -> [r, g, b, a]-           loadTextureImage $ TextureRaw arr w h hash-loadTextureImage (TextureRaw arr w h _) =-        do t <- emptyTexture-           texImage2D gl_TEXTURE_2D 0-                      (fromIntegral gl_RGBA)-                      w h 0-                      gl_RGBA-                      gl_UNSIGNED_BYTE-                      arr+           loadTextureImage $ TextureRaw arr min mag w h hash+loadTextureImage (TextureRaw arr min mag w h _) =+        do t <- emptyTexture min mag+           texImage2DUInt gl_TEXTURE_2D 0+                          (fromIntegral gl_RGBA)+                          w h 0+                          gl_RGBA+                          gl_UNSIGNED_BYTE+                          arr            return $ LoadedTexture (fromIntegral w)                                   (fromIntegral h)                                   t+loadTextureImage (TextureFloat ps min mag w h hash) =+        do arr <- liftIO . encodeFloats . take (fromIntegral $ w * h * 4) $ ps+           t <- emptyTexture min mag+           texImage2DFloat gl_TEXTURE_2D 0+                           (fromIntegral gl_RGBA32F)+                           w h 0+                           gl_RGBA+                           gl_FLOAT+                           arr+           return $ LoadedTexture (fromIntegral w)+                                  (fromIntegral h)+                                  t -emptyTexture :: GLES => GL GL.Texture-emptyTexture = do t <- createTexture-                  bindTexture gl_TEXTURE_2D t-                  param gl_TEXTURE_MAG_FILTER gl_LINEAR-                  param gl_TEXTURE_MIN_FILTER gl_LINEAR-                  param gl_TEXTURE_WRAP_S gl_REPEAT-                  param gl_TEXTURE_WRAP_T gl_REPEAT-                  return t-        where param :: GLES => GLEnum -> GLEnum -> GL ()+emptyTexture :: GLES => Filter -> Filter -> GL GL.Texture+emptyTexture minf magf = do t <- createTexture+                            bindTexture gl_TEXTURE_2D t+                            param gl_TEXTURE_MIN_FILTER $ f minf+                            param gl_TEXTURE_MAG_FILTER $ f magf+                            param gl_TEXTURE_WRAP_S gl_REPEAT+                            param gl_TEXTURE_WRAP_T gl_REPEAT+                            return t+        where f Linear = gl_LINEAR+              f Nearest = gl_NEAREST++              param :: GLES => GLEnum -> GLEnum -> GL ()               param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v

@@ -14,10 +14,7 @@         scaleMat3 ) where -import Control.Applicative import Data.Vect.Float-import Foreign.Storable-import Foreign.Ptr (castPtr)  -- | 4x4 translation matrix. transMat4 :: Vec3 -> Mat4@@ -142,6 +139,3 @@ scaleMat3 (Vec2 x y) = Mat3 (Vec3 x 0 0)                             (Vec3 0 y 0)                             (Vec3 0 0 1)--zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()-zipWithM_ f xs = sequence_ . zipWith f xs

@@ -7,14 +7,17 @@         UniformLocation(..),         Texture(..),         TextureImage(..),+        Filter(..),         LoadedTexture(..),         Geometry(..),         Group(..),         Object(..),         Global(..),         Layer(..),+        Buffer(..),         RenderLayer(..),-        LayerType(..)+        LayerType(..),+        CullFace(..) ) where  import Control.Applicative@@ -22,14 +25,17 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State import Data.Hashable+import Data.Proxy (Proxy) import Data.Vect.Float hiding (Vector) import Data.Vector (Vector) import Data.Typeable import Data.Word (Word8) import qualified Graphics.Rendering.Ombra.Blend as Blend+import qualified Graphics.Rendering.Ombra.Stencil as Stencil import Graphics.Rendering.Ombra.Geometry import Graphics.Rendering.Ombra.Color-import Graphics.Rendering.Ombra.Internal.GL hiding (Program, Texture, UniformLocation)+import Graphics.Rendering.Ombra.Internal.GL hiding (Program, Texture,+                                                    UniformLocation, Buffer) import qualified Graphics.Rendering.Ombra.Internal.GL as GL import Graphics.Rendering.Ombra.Internal.TList import Graphics.Rendering.Ombra.Internal.Resource@@ -51,7 +57,11 @@         activeTextures :: Vector (Maybe Texture),         viewportSize :: (Int, Int),         blendMode :: Maybe Blend.Mode,-        depthTest :: Bool+        stencilMode :: Maybe Stencil.Mode,+        cullFace :: Maybe CullFace,+        depthTest :: Bool,+        depthMask :: Bool,+        colorMask :: (Bool, Bool, Bool, Bool) }  -- | A state monad on top of 'GL'.@@ -66,9 +76,14 @@              | TextureLoaded LoadedTexture              deriving Eq              -data TextureImage = TexturePixels [Color] GLSize GLSize Int-                  | TextureRaw UInt8Array GLSize GLSize Int+data TextureImage = TexturePixels [Color] Filter Filter GLSize GLSize Int+                  | TextureRaw UInt8Array Filter Filter GLSize GLSize Int+                  | TextureFloat [Float] Filter Filter GLSize GLSize Int +data Filter = Linear    -- ^ Average of the four nearest pixels.+            | Nearest   -- ^ Nearest pixel.+            deriving Eq+ data LoadedTexture = LoadedTexture GLSize GLSize GL.Texture  -- | A group of 'Object's.@@ -78,7 +93,11 @@         Global :: Global g -> Group gs is -> Group (g ': gs) is         Append :: Group gs is -> Group gs' is' -> Group gs'' is''         Blend :: Maybe Blend.Mode -> Group gs is -> Group gs is+        Stencil :: Maybe Stencil.Mode -> Group gs is -> Group gs is+        Cull :: Maybe CullFace -> Group gs is -> Group gs is         DepthTest :: Bool -> Group gs is -> Group gs is+        DepthMask :: Bool -> Group gs is -> Group gs is+        ColorMask :: (Bool, Bool, Bool, Bool) -> Group gs is -> Group gs is  -- | A geometry associated with some uniforms. data Object (gs :: [*]) (is :: [*]) where@@ -92,15 +111,20 @@ data Global g where         (:=) :: (ShaderVar g, Uniform 'S g)              => (a -> g) -> Draw (CPU 'S g) -> Global g+        Mirror :: (ShaderVar g, Uniform 'M g)+               => Proxy g -> Draw (CPU 'M g) -> Global g  infix 3 :=  -- | A 'Group' associated with a program. data Layer = forall oi pi og pg. (Subset pi oi, Subset pg og)                               => Layer (Program pg pi) (Group og oi)-           | SubLayer (RenderLayer [Layer])-           | MultiLayer [Layer]+           | SubLayer (RenderLayer Layer)+           | OverLayer Layer Layer+           | ClearLayer [Buffer] Layer +data Buffer = ColorBuffer | DepthBuffer | StencilBuffer+ -- | Represents a 'Layer' drawn on a 'Texture'. data RenderLayer a = RenderLayer Bool                   -- Use drawBuffers                                  [LayerType]            -- Attachments@@ -111,19 +135,27 @@                                  ([Texture] -> Maybe [Color] ->                                   Maybe [Word8] -> a)   -- Accepting function -data LayerType = ColorLayer | DepthLayer | BufferLayer Int deriving Eq+data LayerType = ColorLayer+               | DepthLayer+               | DepthStencilLayer+               | BufferLayer Int deriving Eq +-- Side(s) to be culled.+data CullFace = CullFront | CullBack | CullFrontBack deriving Eq+ instance Hashable TextureImage where         hashWithSalt salt tex = hashWithSalt salt $ textureHash tex  instance Eq TextureImage where-        (TexturePixels _ _ _ h) == (TexturePixels _ _ _ h') = h == h'-        (TextureRaw _ _ _ h) == (TextureRaw _ _ _ h') = h == h'+        (TexturePixels _ _ _ _ _ h) == (TexturePixels _ _ _ _ _ h') = h == h'+        (TextureRaw _ _ _ _ _ h) == (TextureRaw _ _ _ _ _ h') = h == h'+        (TextureFloat _ _ _ _ _ h) == (TextureFloat _ _ _ _ _ h') = h == h'         _ == _ = False  instance GLES => Eq LoadedTexture where         LoadedTexture _ _ t == LoadedTexture _ _ t' = t == t'  textureHash :: TextureImage -> Int-textureHash (TexturePixels _ _ _ h) = h-textureHash (TextureRaw _ _ _ h) = h+textureHash (TexturePixels _ _ _ _ _ h) = h+textureHash (TextureRaw _ _ _ _ _ h) = h+textureHash (TextureFloat _ _ _ _ _ h) = h

@@ -1,13 +1,28 @@ name:                ombra-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Render engine.-description:         Ombra is a render engine written in Haskell. It provides a purely functional interface for advanced graphics programming, including a type safe embedded DSL for GPU programming. You are not required to know or use OpenGL directly to work with Ombra, you just need a basic knowledge of what vertex/fragment shaders, uniforms and attributes are (if you are going to make a more advanced use of it). Ombra supports both OpenGL and WebGL.+description:         Type-safe render engine, with a purely functional API and a shader EDSL. Ombra supports both OpenGL (2.0 with some extensions) and WebGL, through GHCJS.+                     .+                     .+                     The modules you generally need to use are:+                     .+                     "Graphics.Rendering.Ombra.D3": 3D graphics+                     .+                     "Graphics.Rendering.Ombra.D2": 2D graphics+                     .+                     "Graphics.Rendering.Ombra.Generic": although both D3 and D2 export it, you may want to read the documentation+                     .+                     "Graphics.Rendering.Ombra.Shader": for creating shaders+                     .+                     "Graphics.Rendering.Ombra.Draw": this lets you render the pure objects you create with D2 and D3+                     . homepage:            https://github.com/ziocroc/Ombra bug-reports:         https://github.com/ziocroc/Ombra/issues license:             BSD3 license-file:        LICENSE author:              Luca "ziocroc" Prezzavento maintainer:          ziocroc@gmail.com+stability:           Experimental copyright:           Copyright © 2014-2016 Luca Prezzavento category:            Graphics build-type:          Simple@@ -25,8 +40,8 @@   description: Enable the GHCJS/WebGL backend, if compiled with GHCJS. Main module: Graphics.Rendering.Ombra.Backend.WebGL  library-  exposed-modules:     Graphics.Rendering.Ombra.Generic, Graphics.Rendering.Ombra.Blend, Graphics.Rendering.Ombra.Shader, Graphics.Rendering.Ombra.Transformation, Graphics.Rendering.Ombra.Draw, Graphics.Rendering.Ombra.Draw.Internal, Graphics.Rendering.Ombra.D2, Graphics.Rendering.Ombra.Geometry, Graphics.Rendering.Ombra.D3, Graphics.Rendering.Ombra.Types, Graphics.Rendering.Ombra.Texture, Graphics.Rendering.Ombra.Color, Graphics.Rendering.Ombra.Backend, Graphics.Rendering.Ombra.Shapes, Graphics.Rendering.Ombra.Internal.GL, Graphics.Rendering.Ombra.Shader.ShaderVar, Graphics.Rendering.Ombra.Shader.GLSL, Graphics.Rendering.Ombra.Shader.Stages, Graphics.Rendering.Ombra.Shader.Program, Graphics.Rendering.Ombra.Shader.CPU, Graphics.Rendering.Ombra.Shader.Default3D, Graphics.Rendering.Ombra.Shader.Default2D, Graphics.Rendering.Ombra.Shader.Language.Types, Graphics.Rendering.Ombra.Shader.Language.Functions-  other-modules:       Graphics.Rendering.Ombra.Internal.STVectorLen, Graphics.Rendering.Ombra.Internal.Resource, Graphics.Rendering.Ombra.Internal.TList+  exposed-modules:     Graphics.Rendering.Ombra.Generic, Graphics.Rendering.Ombra.Blend, Graphics.Rendering.Ombra.Stencil, Graphics.Rendering.Ombra.Shader, Graphics.Rendering.Ombra.Transformation, Graphics.Rendering.Ombra.Draw, Graphics.Rendering.Ombra.Draw.Internal, Graphics.Rendering.Ombra.D2, Graphics.Rendering.Ombra.Geometry, Graphics.Rendering.Ombra.D3, Graphics.Rendering.Ombra.Types, Graphics.Rendering.Ombra.Texture, Graphics.Rendering.Ombra.Color, Graphics.Rendering.Ombra.Backend, Graphics.Rendering.Ombra.Shapes, Graphics.Rendering.Ombra.Internal.GL, Graphics.Rendering.Ombra.Shader.ShaderVar, Graphics.Rendering.Ombra.Shader.GLSL, Graphics.Rendering.Ombra.Shader.Stages, Graphics.Rendering.Ombra.Shader.Program, Graphics.Rendering.Ombra.Shader.CPU, Graphics.Rendering.Ombra.Shader.Default3D, Graphics.Rendering.Ombra.Shader.Default2D, Graphics.Rendering.Ombra.Shader.Language.Types, Graphics.Rendering.Ombra.Shader.Language.Functions+  other-modules:       Graphics.Rendering.Ombra.Internal.Resource, Graphics.Rendering.Ombra.Internal.TList    if flag(webgl) && impl(ghcjs)     exposed-modules:   Graphics.Rendering.Ombra.Backend.WebGL