ombra (empty) → 0.1.0.0
raw patch · 36 files changed
+8687/−0 lines, 36 filesdep +basedep +ghcjs-basedep +glsetup-changed
Dependencies added: base, ghcjs-base, gl, hashable, hashtables, transformers, unordered-containers, vect, vector
Files
- Graphics/Rendering/Ombra/Backend.hs +577/−0
- Graphics/Rendering/Ombra/Backend/OpenGL.hs +591/−0
- Graphics/Rendering/Ombra/Backend/WebGL.hs +655/−0
- Graphics/Rendering/Ombra/Backend/WebGL/Const.hs +1004/−0
- Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs +430/−0
- Graphics/Rendering/Ombra/Backend/WebGL/Types.hs +68/−0
- Graphics/Rendering/Ombra/Blend.hs +64/−0
- Graphics/Rendering/Ombra/Color.hs +50/−0
- Graphics/Rendering/Ombra/D2.hs +175/−0
- Graphics/Rendering/Ombra/D3.hs +180/−0
- Graphics/Rendering/Ombra/Draw.hs +45/−0
- Graphics/Rendering/Ombra/Draw/Internal.hs +469/−0
- Graphics/Rendering/Ombra/Generic.hs +339/−0
- Graphics/Rendering/Ombra/Geometry.hs +242/−0
- Graphics/Rendering/Ombra/Internal/GL.hs +563/−0
- Graphics/Rendering/Ombra/Internal/Resource.hs +87/−0
- Graphics/Rendering/Ombra/Internal/STVectorLen.hs +31/−0
- Graphics/Rendering/Ombra/Internal/TList.hs +102/−0
- Graphics/Rendering/Ombra/Shader.hs +217/−0
- Graphics/Rendering/Ombra/Shader/CPU.hs +417/−0
- Graphics/Rendering/Ombra/Shader/Default2D.hs +35/−0
- Graphics/Rendering/Ombra/Shader/Default3D.hs +32/−0
- Graphics/Rendering/Ombra/Shader/GLSL.hs +310/−0
- Graphics/Rendering/Ombra/Shader/Language/Functions.hs +648/−0
- Graphics/Rendering/Ombra/Shader/Language/Types.hs +423/−0
- Graphics/Rendering/Ombra/Shader/Program.hs +131/−0
- Graphics/Rendering/Ombra/Shader/ShaderVar.hs +144/−0
- Graphics/Rendering/Ombra/Shader/Stages.hs +112/−0
- Graphics/Rendering/Ombra/Shapes.hs +106/−0
- Graphics/Rendering/Ombra/Texture.hs +70/−0
- Graphics/Rendering/Ombra/Transformation.hs +147/−0
- Graphics/Rendering/Ombra/Types.hs +129/−0
- LICENSE +30/−0
- README.md +14/−0
- Setup.hs +2/−0
- ombra.cabal +48/−0
+ Graphics/Rendering/Ombra/Backend.hs view
@@ -0,0 +1,577 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}++module Graphics.Rendering.Ombra.Backend where++import Control.Concurrent (ThreadId)+import Data.Bits (Bits)+import Data.Vect.Float+import Data.Int+import Data.Word+import Foreign.Storable+import Foreign.Ptr (castPtr)+import Graphics.Rendering.Ombra.Color++data IVec2 = IVec2 !Int32 !Int32 +data IVec3 = IVec3 !Int32 !Int32 !Int32+data IVec4 = IVec4 !Int32 !Int32 !Int32 !Int32++-- Mixed OpenGL ES 2.0/WebGL 1.0/OpenGL 2.0 API, with VAOs and FBOs.+-- | Backend API.+class ( Integral GLEnum+ , Integral GLUInt+ , Integral GLInt+ , Integral GLSize+ , Bits GLEnum+ , Num GLEnum+ , Num GLUInt+ , Num GLInt+ , Num GLPtrDiff+ , Num GLSize+ , Eq GLEnum+ , Eq GLUInt+ , Eq GLInt+ , Eq GLPtrDiff+ , Eq GLSize+ , Eq Texture) => GLES where+ type Ctx+ type GLEnum+ type GLUInt+ type GLInt+ type GLPtr+ type GLPtrDiff+ type GLSize+ type GLString+ type GLBool+ type Buffer+ type UniformLocation+ type Texture+ type Shader+ type Program+ type FrameBuffer+ type RenderBuffer+ type VertexArrayObject+ -- type ActiveInfo+ -- type ShaderPrecisionFormat+ type AnyArray+ type Float32Array+ type Int32Array+ type UInt8Array+ type UInt16Array++ true :: GLBool+ false :: GLBool+ nullGLPtr :: GLPtr+ -- arrayGLPtr :: Array -> (GLPtr -> IO a) -> IO a+ toGLString :: String -> GLString+ noBuffer :: Buffer+ noTexture :: Texture+ noVAO :: VertexArrayObject+ noUInt8Array :: IO UInt8Array+ encodeMat2 :: Mat2 -> IO Float32Array+ encodeMat3 :: Mat3 -> IO Float32Array+ encodeMat4 :: Mat4 -> IO Float32Array+ encodeFloats :: [Float] -> IO Float32Array+ encodeInts :: [Int32] -> IO Int32Array+ encodeVec2s :: [Vec2] -> IO Float32Array+ encodeVec3s :: [Vec3] -> IO Float32Array+ encodeVec4s :: [Vec4] -> IO Float32Array+ encodeIVec2s :: [IVec2] -> IO Int32Array+ encodeIVec3s :: [IVec3] -> IO Int32Array+ encodeIVec4s :: [IVec4] -> IO Int32Array+ encodeUShorts :: [Word16] -> IO UInt16Array+ encodeUInt8s :: [Word8] -> IO UInt8Array++ newByteArray :: Int -> IO UInt8Array+ fromFloat32Array :: Float32Array -> AnyArray+ fromInt32Array :: Int32Array -> AnyArray+ fromUInt8Array :: UInt8Array -> AnyArray+ fromUInt16Array :: UInt16Array -> AnyArray+ decodeBytes :: UInt8Array -> IO [Word8]++ glActiveTexture :: Ctx -> GLEnum -> IO ()+ glAttachShader :: Ctx -> Program -> Shader -> IO ()+ glBindAttribLocation :: Ctx -> Program -> GLUInt -> GLString -> IO ()+ glBindBuffer :: Ctx -> GLEnum -> Buffer -> IO ()+ glBindFramebuffer :: Ctx -> GLEnum -> FrameBuffer -> IO ()+ glBindRenderbuffer :: Ctx -> GLEnum -> RenderBuffer -> IO ()+ glBindTexture :: Ctx -> GLEnum -> Texture -> IO ()+ glBindVertexArray :: Ctx -> VertexArrayObject -> IO ()+ glBlendColor :: Ctx -> Float -> Float -> Float -> Float -> IO ()+ glBlendEquation :: Ctx -> GLEnum -> IO ()+ glBlendEquationSeparate :: Ctx -> GLEnum -> GLEnum -> IO ()+ glBlendFunc :: Ctx -> GLEnum -> GLEnum -> IO ()+ glBlendFuncSeparate :: Ctx -> GLEnum -> GLEnum -> GLEnum -> GLEnum -> IO ()+ glBufferData :: Ctx -> GLEnum -> AnyArray -> GLEnum -> IO ()+ glBufferSubData :: Ctx -> GLEnum -> GLPtrDiff -> AnyArray -> IO ()+ glCheckFramebufferStatus :: Ctx -> GLEnum -> IO GLEnum+ glClear :: Ctx -> GLEnum -> IO ()+ glClearColor :: Ctx -> Float -> Float -> Float -> Float -> IO ()+ glClearDepth :: Ctx -> Float -> IO ()+ glClearStencil :: Ctx -> GLInt -> IO ()+ glColorMask :: Ctx -> GLBool -> GLBool -> GLBool -> GLBool -> IO ()+ glCompileShader :: Ctx -> Shader -> IO ()+ glCompressedTexImage2D :: Ctx -> GLEnum -> GLInt -> GLEnum -> GLSize -> GLSize -> GLInt -> UInt8Array -> IO ()+ glCompressedTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> UInt8Array -> IO ()+ glCopyTexImage2D :: Ctx -> GLEnum -> GLInt -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> IO ()+ glCopyTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> IO ()+ glCreateBuffer :: Ctx -> IO Buffer+ glCreateFramebuffer :: Ctx -> IO FrameBuffer+ glCreateProgram :: Ctx -> IO Program+ glCreateRenderbuffer :: Ctx -> IO RenderBuffer+ glCreateShader :: Ctx -> GLEnum -> IO Shader+ glCreateTexture :: Ctx -> IO Texture+ glCreateVertexArray :: Ctx -> IO VertexArrayObject+ glCullFace :: Ctx -> GLEnum -> IO ()+ glDeleteBuffer :: Ctx -> Buffer -> IO ()+ glDeleteFramebuffer :: Ctx -> FrameBuffer -> IO ()+ glDeleteProgram :: Ctx -> Program -> IO ()+ glDeleteRenderbuffer :: Ctx -> RenderBuffer -> IO ()+ glDeleteShader :: Ctx -> Shader -> IO ()+ glDeleteTexture :: Ctx -> Texture -> IO ()+ glDeleteVertexArray :: Ctx -> VertexArrayObject -> IO ()+ glDepthFunc :: Ctx -> GLEnum -> IO ()+ glDepthMask :: Ctx -> GLBool -> IO ()+ glDepthRange :: Ctx -> Float -> Float -> IO ()+ glDetachShader :: Ctx -> Program -> Shader -> IO ()+ glDisable :: Ctx -> GLEnum -> IO ()+ glDisableVertexAttribArray :: Ctx -> GLUInt -> IO ()+ glDrawArrays :: Ctx -> GLEnum -> GLInt -> GLSize -> IO ()+ glDrawBuffers :: Ctx -> Int32Array -> IO ()+ glDrawElements :: Ctx -> GLEnum -> GLSize -> GLEnum -> GLPtr-> IO ()+ glEnable :: Ctx -> GLEnum -> IO ()+ glEnableVertexAttribArray :: Ctx -> GLUInt -> IO ()+ glFinish :: Ctx -> IO ()+ glFlush :: Ctx -> IO ()+ glFramebufferRenderbuffer :: Ctx -> GLEnum -> GLEnum -> GLEnum -> RenderBuffer -> IO ()+ glFramebufferTexture2D :: Ctx -> GLEnum -> GLEnum -> GLEnum -> Texture -> GLInt -> IO ()+ glFrontFace :: Ctx -> GLEnum -> IO ()+ glGenerateMipmap :: Ctx -> GLEnum -> IO ()+ -- glGetActiveAttrib :: Ctx -> Program -> GLEnum -> IO ActiveInfo+ -- glGetActiveUniform :: Ctx -> Program -> GLEnum -> IO ActiveInfo+ glGetAttribLocation :: Ctx -> Program -> GLString -> IO GLInt+ -- glGetBufferParameter :: Ctx -> Word -> Word -> IO (JSRef a)+ -- glGetParameter :: Ctx -> Word -> IO (JSRef a)+ glGetError :: Ctx -> IO GLEnum+ -- glGetFramebufferAttachmentParameter :: Ctx -> GLEnum -> GLEnum -> IO Word+ glGetProgramInfoLog :: Ctx -> Program -> IO GLString+ -- glGetRenderbufferParameter :: Ctx -> Word -> Word -> IO (JSRef a)+ -- glGetShaderParameter :: Ctx -> Shader -> Word -> IO (JSRef a)+ -- glGetShaderPrecisionFormat :: Ctx -> GLEnum -> GLEnum -> IO ShaderPrecisionFormat+ glGetShaderInfoLog :: Ctx -> Shader -> IO GLString+ glGetShaderSource :: Ctx -> Shader -> IO GLString+ -- glGetTexParameter :: Ctx -> Word -> Word -> IO (JSRef a)+ -- glGetUniform :: Ctx -> Program -> UniformLocation -> IO (JSRef a)+ glGetUniformLocation :: Ctx -> Program -> GLString -> IO UniformLocation+ -- glGetVertexAttrib :: Ctx -> Word -> Word -> IO (JSRef a)+ -- glGetVertexAttribOffset :: Ctx -> Word -> GLEnum -> IO Word+ glHint :: Ctx -> GLEnum -> GLEnum -> IO ()+ glIsBuffer :: Ctx -> Buffer -> IO GLBool+ glIsEnabled :: Ctx -> GLEnum -> IO GLBool+ glIsFramebuffer :: Ctx -> FrameBuffer -> IO GLBool+ glIsProgram :: Ctx -> Program -> IO GLBool+ glIsRenderbuffer :: Ctx -> RenderBuffer -> IO GLBool+ glIsShader :: Ctx -> Shader -> IO GLBool+ glIsTexture :: Ctx -> Texture -> IO GLBool+ glIsVertexArray :: Ctx -> VertexArrayObject -> IO GLBool+ glLineWidth :: Ctx -> Float -> IO ()+ glLinkProgram :: Ctx -> Program -> IO ()+ glPixelStorei :: Ctx -> GLEnum -> GLInt -> IO ()+ glPolygonOffset :: Ctx -> Float -> Float -> IO ()+ glReadPixels :: Ctx -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> UInt8Array -> IO ()+ glRenderbufferStorage :: Ctx -> GLEnum -> GLEnum -> GLSize -> GLSize -> IO ()+ glSampleCoverage :: Ctx -> Float -> GLBool -> IO ()+ glScissor :: Ctx -> GLInt -> GLInt -> GLSize -> GLSize -> IO ()+ glShaderSource :: Ctx -> Shader -> GLString -> IO ()+ glStencilFunc :: Ctx -> GLEnum -> GLInt -> GLUInt -> IO ()+ glStencilFuncSeparate :: Ctx -> GLEnum -> GLEnum -> GLInt -> GLUInt -> IO ()+ glStencilMask :: Ctx -> GLUInt -> IO ()+ 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 ()+ glTexParameterf :: Ctx -> GLEnum -> GLEnum -> Float -> IO ()+ glTexParameteri :: Ctx -> GLEnum -> GLEnum -> GLInt -> IO ()+ glTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> UInt8Array -> IO ()+ glUniform1f :: Ctx -> UniformLocation -> Float -> IO ()+ glUniform1fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+ glUniform1i :: Ctx -> UniformLocation -> Int32 -> IO ()+ glUniform1iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+ glUniform2f :: Ctx -> UniformLocation -> Float -> Float -> IO ()+ glUniform2fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+ glUniform2i :: Ctx -> UniformLocation -> Int32 -> Int32 -> IO ()+ glUniform2iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+ glUniform3f :: Ctx -> UniformLocation -> Float -> Float -> Float -> IO ()+ glUniform3fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+ glUniform3i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> IO ()+ glUniform3iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+ glUniform4f :: Ctx -> UniformLocation -> Float -> Float -> Float -> Float -> IO ()+ glUniform4fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+ glUniform4i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()+ glUniform4iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+ glUniformMatrix2fv :: Ctx -> UniformLocation -> GLBool -> Float32Array -> IO ()+ glUniformMatrix3fv :: Ctx -> UniformLocation -> GLBool -> Float32Array -> IO ()+ glUniformMatrix4fv :: Ctx -> UniformLocation -> GLBool -> Float32Array -> IO ()+ glUseProgram :: Ctx -> Program -> IO ()+ glValidateProgram :: Ctx -> Program -> IO ()+ glVertexAttrib1f :: Ctx -> GLUInt -> Float -> IO ()+ glVertexAttrib1fv :: Ctx -> GLUInt -> Float32Array -> IO ()+ glVertexAttrib2f :: Ctx -> GLUInt -> Float -> Float -> IO ()+ glVertexAttrib2fv :: Ctx -> GLUInt -> Float32Array -> IO ()+ glVertexAttrib3f :: Ctx -> GLUInt -> Float -> Float -> Float -> IO ()+ glVertexAttrib3fv :: Ctx -> GLUInt -> Float32Array -> IO ()+ glVertexAttrib4f :: Ctx -> GLUInt -> Float -> Float -> Float -> Float -> IO ()+ glVertexAttrib4fv :: Ctx -> GLUInt -> Float32Array -> IO ()+ glVertexAttribPointer :: Ctx -> GLUInt -> GLInt -> GLEnum -> GLBool -> GLSize -> GLPtr -> IO ()+ glViewport :: Ctx -> GLInt -> GLInt -> GLSize -> GLSize -> IO ()++ gl_DEPTH_BUFFER_BIT :: GLEnum+ gl_STENCIL_BUFFER_BIT :: GLEnum+ gl_COLOR_BUFFER_BIT :: GLEnum+ gl_POINTS :: GLEnum+ gl_LINES :: GLEnum+ gl_LINE_LOOP :: GLEnum+ gl_LINE_STRIP :: GLEnum+ gl_TRIANGLES :: GLEnum+ gl_TRIANGLE_STRIP :: GLEnum+ gl_TRIANGLE_FAN :: GLEnum+ gl_ZERO :: GLEnum+ gl_ONE :: GLEnum+ gl_SRC_COLOR :: GLEnum+ gl_ONE_MINUS_SRC_COLOR :: GLEnum+ gl_SRC_ALPHA :: GLEnum+ gl_ONE_MINUS_SRC_ALPHA :: GLEnum+ gl_DST_ALPHA :: GLEnum+ gl_ONE_MINUS_DST_ALPHA :: GLEnum+ gl_DST_COLOR :: GLEnum+ gl_ONE_MINUS_DST_COLOR :: GLEnum+ gl_SRC_ALPHA_SATURATE :: GLEnum+ gl_FUNC_ADD :: GLEnum+ gl_BLEND_EQUATION :: GLEnum+ gl_BLEND_EQUATION_RGB :: GLEnum+ gl_BLEND_EQUATION_ALPHA :: GLEnum+ gl_FUNC_SUBTRACT :: GLEnum+ gl_FUNC_REVERSE_SUBTRACT :: GLEnum+ gl_BLEND_DST_RGB :: GLEnum+ gl_BLEND_SRC_RGB :: GLEnum+ gl_BLEND_DST_ALPHA :: GLEnum+ gl_BLEND_SRC_ALPHA :: GLEnum+ gl_CONSTANT_COLOR :: GLEnum+ gl_ONE_MINUS_CONSTANT_COLOR :: GLEnum+ gl_CONSTANT_ALPHA :: GLEnum+ gl_ONE_MINUS_CONSTANT_ALPHA :: GLEnum+ gl_BLEND_COLOR :: GLEnum+ gl_ARRAY_BUFFER :: GLEnum+ gl_ELEMENT_ARRAY_BUFFER :: GLEnum+ gl_ARRAY_BUFFER_BINDING :: GLEnum+ gl_ELEMENT_ARRAY_BUFFER_BINDING :: GLEnum+ gl_STREAM_DRAW :: GLEnum+ gl_STATIC_DRAW :: GLEnum+ gl_DYNAMIC_DRAW :: GLEnum+ gl_BUFFER_SIZE :: GLEnum+ gl_BUFFER_USAGE :: GLEnum+ gl_CURRENT_VERTEX_ATTRIB :: GLEnum+ gl_FRONT :: GLEnum+ gl_BACK :: GLEnum+ gl_FRONT_AND_BACK :: GLEnum+ gl_CULL_FACE :: GLEnum+ gl_BLEND :: GLEnum+ gl_DITHER :: GLEnum+ gl_STENCIL_TEST :: GLEnum+ gl_DEPTH_TEST :: GLEnum+ gl_SCISSOR_TEST :: GLEnum+ gl_POLYGON_OFFSET_FILL :: GLEnum+ gl_SAMPLE_ALPHA_TO_COVERAGE :: GLEnum+ gl_SAMPLE_COVERAGE :: GLEnum+ gl_NO_ERROR :: GLEnum+ gl_INVALID_ENUM :: GLEnum+ gl_INVALID_VALUE :: GLEnum+ gl_INVALID_OPERATION :: GLEnum+ gl_OUT_OF_MEMORY :: GLEnum+ gl_CW :: GLEnum+ gl_CCW :: GLEnum+ gl_LINE_WIDTH :: GLEnum+ gl_ALIASED_POINT_SIZE_RANGE :: GLEnum+ gl_ALIASED_LINE_WIDTH_RANGE :: GLEnum+ gl_CULL_FACE_MODE :: GLEnum+ gl_FRONT_FACE :: GLEnum+ gl_DEPTH_RANGE :: GLEnum+ gl_DEPTH_WRITEMASK :: GLEnum+ gl_DEPTH_CLEAR_VALUE :: GLEnum+ gl_DEPTH_FUNC :: GLEnum+ gl_STENCIL_CLEAR_VALUE :: GLEnum+ gl_STENCIL_FUNC :: GLEnum+ gl_STENCIL_FAIL :: GLEnum+ gl_STENCIL_PASS_DEPTH_FAIL :: GLEnum+ gl_STENCIL_PASS_DEPTH_PASS :: GLEnum+ gl_STENCIL_REF :: GLEnum+ gl_STENCIL_VALUE_MASK :: GLEnum+ gl_STENCIL_WRITEMASK :: GLEnum+ gl_STENCIL_BACK_FUNC :: GLEnum+ gl_STENCIL_BACK_FAIL :: GLEnum+ gl_STENCIL_BACK_PASS_DEPTH_FAIL :: GLEnum+ gl_STENCIL_BACK_PASS_DEPTH_PASS :: GLEnum+ gl_STENCIL_BACK_REF :: GLEnum+ gl_STENCIL_BACK_VALUE_MASK :: GLEnum+ gl_STENCIL_BACK_WRITEMASK :: GLEnum+ gl_VIEWPORT :: GLEnum+ gl_SCISSOR_BOX :: GLEnum+ gl_COLOR_CLEAR_VALUE :: GLEnum+ gl_COLOR_WRITEMASK :: GLEnum+ gl_UNPACK_ALIGNMENT :: GLEnum+ gl_PACK_ALIGNMENT :: GLEnum+ gl_MAX_TEXTURE_SIZE :: GLEnum+ gl_MAX_VIEWPORT_DIMS :: GLEnum+ gl_SUBPIXEL_BITS :: GLEnum+ gl_RED_BITS :: GLEnum+ gl_GREEN_BITS :: GLEnum+ gl_BLUE_BITS :: GLEnum+ gl_ALPHA_BITS :: GLEnum+ gl_DEPTH_BITS :: GLEnum+ gl_STENCIL_BITS :: GLEnum+ gl_POLYGON_OFFSET_UNITS :: GLEnum+ gl_POLYGON_OFFSET_FACTOR :: GLEnum+ gl_TEXTURE_BINDING_2D :: GLEnum+ gl_SAMPLE_BUFFERS :: GLEnum+ gl_SAMPLES :: GLEnum+ gl_SAMPLE_COVERAGE_VALUE :: GLEnum+ gl_SAMPLE_COVERAGE_INVERT :: GLEnum+ gl_COMPRESSED_TEXTURE_FORMATS :: GLEnum+ gl_DONT_CARE :: GLEnum+ gl_FASTEST :: GLEnum+ gl_NICEST :: GLEnum+ gl_GENERATE_MIPMAP_HINT :: GLEnum+ gl_BYTE :: GLEnum+ gl_UNSIGNED_BYTE :: GLEnum+ gl_SHORT :: GLEnum+ gl_UNSIGNED_SHORT :: GLEnum+ gl_INT :: GLEnum+ gl_UNSIGNED_INT :: GLEnum+ gl_FLOAT :: GLEnum+ gl_DEPTH_COMPONENT :: GLEnum+ gl_ALPHA :: GLEnum+ gl_RGB :: GLEnum+ gl_RGBA :: GLEnum+ gl_RGBA32F :: GLEnum+ gl_LUMINANCE :: GLEnum+ gl_LUMINANCE_ALPHA :: GLEnum+ gl_UNSIGNED_SHORT_4_4_4_4 :: GLEnum+ gl_UNSIGNED_SHORT_5_5_5_1 :: GLEnum+ gl_UNSIGNED_SHORT_5_6_5 :: GLEnum+ gl_FRAGMENT_SHADER :: GLEnum+ gl_VERTEX_SHADER :: GLEnum+ gl_MAX_VERTEX_ATTRIBS :: GLEnum+ gl_MAX_VERTEX_UNIFORM_VECTORS :: GLEnum+ gl_MAX_VARYING_VECTORS :: GLEnum+ gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS :: GLEnum+ gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS :: GLEnum+ gl_MAX_TEXTURE_IMAGE_UNITS :: GLEnum+ gl_MAX_FRAGMENT_UNIFORM_VECTORS :: GLEnum+ gl_SHADER_TYPE :: GLEnum+ gl_DELETE_STATUS :: GLEnum+ gl_LINK_STATUS :: GLEnum+ gl_VALIDATE_STATUS :: GLEnum+ gl_ATTACHED_SHADERS :: GLEnum+ gl_ACTIVE_UNIFORMS :: GLEnum+ gl_ACTIVE_ATTRIBUTES :: GLEnum+ gl_SHADING_LANGUAGE_VERSION :: GLEnum+ gl_CURRENT_PROGRAM :: GLEnum+ gl_NEVER :: GLEnum+ gl_LESS :: GLEnum+ gl_EQUAL :: GLEnum+ gl_LEQUAL :: GLEnum+ gl_GREATER :: GLEnum+ gl_NOTEQUAL :: GLEnum+ gl_GEQUAL :: GLEnum+ gl_ALWAYS :: GLEnum+ gl_KEEP :: GLEnum+ gl_REPLACE :: GLEnum+ gl_INCR :: GLEnum+ gl_DECR :: GLEnum+ gl_INVERT :: GLEnum+ gl_INCR_WRAP :: GLEnum+ gl_DECR_WRAP :: GLEnum+ gl_VENDOR :: GLEnum+ gl_RENDERER :: GLEnum+ gl_VERSION :: GLEnum+ gl_NEAREST :: GLEnum+ gl_LINEAR :: GLEnum+ gl_NEAREST_MIPMAP_NEAREST :: GLEnum+ gl_LINEAR_MIPMAP_NEAREST :: GLEnum+ gl_NEAREST_MIPMAP_LINEAR :: GLEnum+ gl_LINEAR_MIPMAP_LINEAR :: GLEnum+ gl_TEXTURE_MAG_FILTER :: GLEnum+ gl_TEXTURE_MIN_FILTER :: GLEnum+ gl_TEXTURE_WRAP_S :: GLEnum+ gl_TEXTURE_WRAP_T :: GLEnum+ gl_TEXTURE_2D :: GLEnum+ gl_TEXTURE :: GLEnum+ gl_TEXTURE_CUBE_MAP :: GLEnum+ gl_TEXTURE_BINDING_CUBE_MAP :: GLEnum+ gl_TEXTURE_CUBE_MAP_POSITIVE_X :: GLEnum+ gl_TEXTURE_CUBE_MAP_NEGATIVE_X :: GLEnum+ gl_TEXTURE_CUBE_MAP_POSITIVE_Y :: GLEnum+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Y :: GLEnum+ gl_TEXTURE_CUBE_MAP_POSITIVE_Z :: GLEnum+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Z :: GLEnum+ gl_MAX_CUBE_MAP_TEXTURE_SIZE :: GLEnum+ gl_TEXTURE0 :: GLEnum+ gl_TEXTURE1 :: GLEnum+ gl_TEXTURE2 :: GLEnum+ gl_TEXTURE3 :: GLEnum+ gl_TEXTURE4 :: GLEnum+ gl_TEXTURE5 :: GLEnum+ gl_TEXTURE6 :: GLEnum+ gl_TEXTURE7 :: GLEnum+ gl_TEXTURE8 :: GLEnum+ gl_TEXTURE9 :: GLEnum+ gl_TEXTURE10 :: GLEnum+ gl_TEXTURE11 :: GLEnum+ gl_TEXTURE12 :: GLEnum+ gl_TEXTURE13 :: GLEnum+ gl_TEXTURE14 :: GLEnum+ gl_TEXTURE15 :: GLEnum+ gl_TEXTURE16 :: GLEnum+ gl_TEXTURE17 :: GLEnum+ gl_TEXTURE18 :: GLEnum+ gl_TEXTURE19 :: GLEnum+ gl_TEXTURE20 :: GLEnum+ gl_TEXTURE21 :: GLEnum+ gl_TEXTURE22 :: GLEnum+ gl_TEXTURE23 :: GLEnum+ gl_TEXTURE24 :: GLEnum+ gl_TEXTURE25 :: GLEnum+ gl_TEXTURE26 :: GLEnum+ gl_TEXTURE27 :: GLEnum+ gl_TEXTURE28 :: GLEnum+ gl_TEXTURE29 :: GLEnum+ gl_TEXTURE30 :: GLEnum+ gl_TEXTURE31 :: GLEnum+ gl_ACTIVE_TEXTURE :: GLEnum+ gl_REPEAT :: GLEnum+ gl_CLAMP_TO_EDGE :: GLEnum+ gl_MIRRORED_REPEAT :: GLEnum+ gl_FLOAT_VEC2 :: GLEnum+ gl_FLOAT_VEC3 :: GLEnum+ gl_FLOAT_VEC4 :: GLEnum+ gl_INT_VEC2 :: GLEnum+ gl_INT_VEC3 :: GLEnum+ gl_INT_VEC4 :: GLEnum+ gl_BOOL :: GLEnum+ gl_BOOL_VEC2 :: GLEnum+ gl_BOOL_VEC3 :: GLEnum+ gl_BOOL_VEC4 :: GLEnum+ gl_FLOAT_MAT2 :: GLEnum+ gl_FLOAT_MAT3 :: GLEnum+ gl_FLOAT_MAT4 :: GLEnum+ gl_SAMPLER_2D :: GLEnum+ gl_SAMPLER_CUBE :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_ENABLED :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_SIZE :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_STRIDE :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_TYPE :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_NORMALIZED :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_POINTER :: GLEnum+ gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING :: GLEnum+ gl_COMPILE_STATUS :: GLEnum+ gl_LOW_FLOAT :: GLEnum+ gl_MEDIUM_FLOAT :: GLEnum+ gl_HIGH_FLOAT :: GLEnum+ gl_LOW_INT :: GLEnum+ gl_MEDIUM_INT :: GLEnum+ gl_HIGH_INT :: GLEnum+ gl_FRAMEBUFFER :: GLEnum+ gl_RENDERBUFFER :: GLEnum+ gl_RGBA4 :: GLEnum+ gl_RGB5_A1 :: GLEnum+ gl_RGB565 :: GLEnum+ gl_DEPTH_COMPONENT16 :: GLEnum+ gl_STENCIL_INDEX8 :: GLEnum+ gl_RENDERBUFFER_WIDTH :: GLEnum+ gl_RENDERBUFFER_HEIGHT :: GLEnum+ gl_RENDERBUFFER_INTERNAL_FORMAT :: GLEnum+ gl_RENDERBUFFER_RED_SIZE :: GLEnum+ gl_RENDERBUFFER_GREEN_SIZE :: GLEnum+ gl_RENDERBUFFER_BLUE_SIZE :: GLEnum+ gl_RENDERBUFFER_ALPHA_SIZE :: GLEnum+ gl_RENDERBUFFER_DEPTH_SIZE :: GLEnum+ gl_RENDERBUFFER_STENCIL_SIZE :: GLEnum+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE :: GLEnum+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME :: GLEnum+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL :: GLEnum+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE :: GLEnum+ gl_MAX_DRAW_BUFFERS :: GLEnum+ gl_DRAW_BUFFER0 :: GLEnum+ gl_DRAW_BUFFER1 :: GLEnum+ gl_DRAW_BUFFER2 :: GLEnum+ gl_DRAW_BUFFER3 :: GLEnum+ gl_DRAW_BUFFER4 :: GLEnum+ gl_DRAW_BUFFER5 :: GLEnum+ gl_DRAW_BUFFER6 :: GLEnum+ gl_DRAW_BUFFER7 :: GLEnum+ gl_DRAW_BUFFER8 :: GLEnum+ gl_DRAW_BUFFER9 :: GLEnum+ gl_DRAW_BUFFER10 :: GLEnum+ gl_DRAW_BUFFER11 :: GLEnum+ gl_DRAW_BUFFER12 :: GLEnum+ gl_DRAW_BUFFER13 :: GLEnum+ gl_DRAW_BUFFER14 :: GLEnum+ gl_DRAW_BUFFER15 :: GLEnum+ gl_MAX_COLOR_ATTACHMENTS :: GLEnum+ gl_COLOR_ATTACHMENT0 :: GLEnum+ gl_COLOR_ATTACHMENT1 :: GLEnum+ gl_COLOR_ATTACHMENT2 :: GLEnum+ gl_COLOR_ATTACHMENT3 :: GLEnum+ gl_COLOR_ATTACHMENT4 :: GLEnum+ gl_COLOR_ATTACHMENT5 :: GLEnum+ gl_COLOR_ATTACHMENT6 :: GLEnum+ gl_COLOR_ATTACHMENT7 :: GLEnum+ gl_COLOR_ATTACHMENT8 :: GLEnum+ gl_COLOR_ATTACHMENT9 :: GLEnum+ gl_COLOR_ATTACHMENT10 :: GLEnum+ gl_COLOR_ATTACHMENT11 :: GLEnum+ gl_COLOR_ATTACHMENT12 :: GLEnum+ gl_COLOR_ATTACHMENT13 :: GLEnum+ gl_COLOR_ATTACHMENT14 :: GLEnum+ gl_COLOR_ATTACHMENT15 :: GLEnum+ gl_DEPTH_ATTACHMENT :: GLEnum+ gl_STENCIL_ATTACHMENT :: GLEnum+ gl_NONE :: GLEnum+ gl_FRAMEBUFFER_COMPLETE :: GLEnum+ gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT :: GLEnum+ gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT :: GLEnum+ gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS :: GLEnum+ gl_FRAMEBUFFER_UNSUPPORTED :: GLEnum+ gl_FRAMEBUFFER_BINDING :: GLEnum+ gl_RENDERBUFFER_BINDING :: GLEnum+ gl_MAX_RENDERBUFFER_SIZE :: GLEnum+ gl_INVALID_FRAMEBUFFER_OPERATION :: GLEnum++instance Storable IVec2 where+ sizeOf _ = 8+ alignment _ = 4+ peek ptr = IVec2 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ poke ptr (IVec2 x y) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y++instance Storable IVec3 where+ sizeOf _ = 12+ alignment _ = 4+ peek ptr = IVec3 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ poke ptr (IVec3 x y z) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z++instance Storable IVec4 where+ sizeOf _ = 16+ alignment _ = 4+ peek ptr = IVec4 <$> peekElemOff (castPtr ptr) 0+ <*> peekElemOff (castPtr ptr) 1+ <*> peekElemOff (castPtr ptr) 2+ <*> peekElemOff (castPtr ptr) 3+ poke ptr (IVec4 x y z w) = do pokeElemOff (castPtr ptr) 0 x+ pokeElemOff (castPtr ptr) 1 y+ pokeElemOff (castPtr ptr) 2 z+ pokeElemOff (castPtr ptr) 3 w
+ Graphics/Rendering/Ombra/Backend/OpenGL.hs view
@@ -0,0 +1,591 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}++module Graphics.Rendering.Ombra.Backend.OpenGL (makeContext) where+ +import Data.Word+import Data.Vect.Float+import Foreign+import Foreign.C.String+import Graphics.Rendering.Ombra.Backend+import qualified Graphics.GL.Standard20 as GL+import qualified Graphics.GL.Ext.ARB.FramebufferObject as GL+import qualified Graphics.GL.Ext.ARB.TextureFloat as GL+import qualified Graphics.GL.Ext.ARB.VertexArrayObject as GL+import qualified Graphics.GL.Ext.EXT.BlendColor as GL+import Graphics.GL.Types as GL++makeContext :: IO ()+makeContext = return ()++genToCreate :: Storable a => (GLsizei -> Ptr a -> IO ()) -> ctx -> IO a+genToCreate gen _ = do ptr <- malloc+ gen 1 ptr+ value <- peek ptr+ free ptr+ return value++deleteToDelete :: Storable a => (GLsizei -> Ptr a -> IO ()) -> ctx -> a -> IO ()+deleteToDelete del _ = flip with $ del 1++getString :: (a -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())+ -> ctx -> a -> IO String+getString f _ x = do cstr <- mallocArray len+ f x (fromIntegral len) nullPtr cstr+ str <- peekCString cstr+ free cstr+ return str+ where len = 4096++uniform :: (a -> GLsizei -> Ptr b -> IO ())+ -> ctx -> a -> (GLsizei, ForeignPtr b) -> IO ()+uniform f _ a (len, fp) = withForeignPtr fp $ f a (quot len 4)++uniformMatrix :: (a -> GLsizei -> GLboolean -> Ptr b -> IO ()) -> GLsizei+ -> ctx -> a -> GLboolean -> (GLsizei, ForeignPtr b) -> IO ()+uniformMatrix f dv _ a b (len, fp) =+ withForeignPtr fp $ f a 1 {- (quot len dv) -} b++vertexAttrib :: (a -> Ptr b -> IO ())+ -> ctx -> a -> (GLsizei, ForeignPtr b) -> IO ()+vertexAttrib f _ a (_, fp) = withForeignPtr fp $ f a++mkArrayLen :: Int -> IO (GLsizei, ForeignPtr b)+mkArrayLen len = do arr <- mallocForeignPtrArray (fromIntegral len)+ :: IO (ForeignPtr Word8)+ return (fromIntegral len, castForeignPtr arr)++arrayToList :: Storable a => (GLsizei, ForeignPtr ()) -> IO [a]+arrayToList (sz, fptr) = withForeignPtr (castForeignPtr fptr) $ \ptr ->+ peekArray (fromIntegral sz) ptr++mkArray :: Storable a => [a] -> IO (GLsizei, ForeignPtr b)+mkArray xs = do arr <- mallocForeignPtrArray len+ withForeignPtr arr $ flip pokeArray xs+ return (fromIntegral size, castForeignPtr arr)+ where len = length xs+ size = len * sizeOf (head xs)++instance GLES where+ type Ctx = ()+ type GLEnum = GLenum+ type GLUInt = GLuint+ type GLInt = GLint+ type GLPtr = Ptr ()+ type GLPtrDiff = GLintptr+ type GLSize = GLsizei+ type GLString = String -- XXX: Foreign CChar?+ type GLBool = GLboolean+ type Buffer = GLuint+ type UniformLocation = GLint+ type Texture = GLuint+ type Shader = GLuint+ type Program = GLuint+ type FrameBuffer = GLuint+ type RenderBuffer = GLuint+ type VertexArrayObject = GLuint+ -- type ShaderPrecisionFormat = GLint+ type AnyArray = (GLsizei, ForeignPtr ())+ type Float32Array = (GLsizei, ForeignPtr GLfloat)+ type Int32Array = (GLsizei, ForeignPtr GLint)+ type UInt16Array = (GLsizei, ForeignPtr GLushort)+ type UInt8Array = (GLsizei, ForeignPtr GLubyte)++ true = 1+ false = 0+ nullGLPtr = nullPtr+ toGLString = id+ noBuffer = 0+ noTexture = 0+ noVAO = 0+ noUInt8Array = fmap ((,) 0) $ newForeignPtr_ nullPtr++ encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) = mkArray [ a1, a2, b1, b2 ]++ encodeMat3 (Mat3 (Vec3 a1 a2 a3)+ (Vec3 b1 b2 b3)+ (Vec3 c1 c2 c3)) = mkArray [ a1, a2, a3+ , b1, b2, b3+ , c1, c2, c3 ]+ encodeMat4 (Mat4 (Vec4 a1 a2 a3 a4)+ (Vec4 b1 b2 b3 b4)+ (Vec4 c1 c2 c3 c4)+ (Vec4 d1 d2 d3 d4) ) = mkArray [ a1, a2, a3, a4+ , b1, b2, b3, b4+ , c1, c2, c3, c4+ , d1, d2, d3, d4 ]++ encodeFloats = mkArray+ encodeVec2s = mkArray+ encodeVec3s = mkArray+ encodeVec4s = mkArray+ encodeInts = mkArray+ encodeIVec2s = mkArray+ encodeIVec3s = mkArray+ encodeIVec4s = mkArray+ encodeUShorts = mkArray+ encodeUInt8s = mkArray++ newByteArray = mkArrayLen+ fromFloat32Array (size, fptr) = (size, castForeignPtr fptr)+ fromInt32Array (size, fptr) = (size, castForeignPtr fptr)+ fromUInt16Array (size, fptr) = (size, castForeignPtr fptr)+ fromUInt8Array (size, fptr) = (size, castForeignPtr fptr)+ decodeBytes (s, f) = arrayToList (s, castForeignPtr f)++ glActiveTexture = const GL.glActiveTexture+ glAttachShader = const GL.glAttachShader+ glBindAttribLocation _ a b c = withCString c $ GL.glBindAttribLocation a b+ glBindBuffer = const GL.glBindBuffer+ glBindFramebuffer = const GL.glBindFramebuffer+ glBindRenderbuffer = const GL.glBindRenderbuffer+ glBindTexture = const GL.glBindTexture+ glBindVertexArray = const GL.glBindVertexArray + glBlendColor = const GL.glBlendColor+ glBlendEquation = const GL.glBlendEquation+ glBlendEquationSeparate = const GL.glBlendEquationSeparate+ glBlendFunc = const GL.glBlendFunc+ glBlendFuncSeparate = const GL.glBlendFuncSeparate+ glBufferData _ a (l, fp) b = withForeignPtr fp $ \p ->+ GL.glBufferData a (fromIntegral l) (castPtr p) b+ glBufferSubData _ a b (l, fp) = withForeignPtr fp $ \p ->+ GL.glBufferSubData a b (fromIntegral l) (castPtr p)+ glCheckFramebufferStatus = const GL.glCheckFramebufferStatus+ glClear = const GL.glClear+ glClearColor = const GL.glClearColor+ glClearDepth _ = GL.glClearDepth . realToFrac+ glClearStencil = const GL.glClearStencil+ glColorMask = const GL.glColorMask+ glCompileShader = const GL.glCompileShader+ glCompressedTexImage2D _ a b c d e f (l, fp) = withForeignPtr fp $+ \p -> GL.glCompressedTexImage2D a b c d e f l (castPtr p)+ glCompressedTexSubImage2D _ a b c d e f g (l, fp) = withForeignPtr fp $+ \p -> GL.glCompressedTexSubImage2D a b c d e f g l (castPtr p)+ glCopyTexImage2D = const GL.glCopyTexImage2D+ glCopyTexSubImage2D = const GL.glCopyTexSubImage2D+ glCreateBuffer = genToCreate GL.glGenBuffers+ glCreateFramebuffer = genToCreate GL.glGenFramebuffers+ glCreateProgram = const GL.glCreateProgram+ glCreateRenderbuffer = genToCreate GL.glGenRenderbuffers+ glCreateShader = const GL.glCreateShader+ glCreateTexture = genToCreate GL.glGenTextures+ glCreateVertexArray = genToCreate GL.glGenVertexArrays+ glCullFace = const GL.glCullFace+ glDeleteBuffer = deleteToDelete GL.glDeleteBuffers+ glDeleteFramebuffer = deleteToDelete GL.glDeleteFramebuffers+ glDeleteProgram = const GL.glDeleteProgram+ glDeleteRenderbuffer = deleteToDelete GL.glDeleteRenderbuffers+ glDeleteShader = const GL.glDeleteShader+ glDeleteTexture = deleteToDelete GL.glDeleteTextures+ glDeleteVertexArray = deleteToDelete GL.glDeleteVertexArrays+ glDepthFunc = const GL.glDepthFunc+ glDepthMask = const GL.glDepthMask+ glDepthRange _ a b = GL.glDepthRange (realToFrac a) (realToFrac b)+ glDetachShader = const GL.glDetachShader+ glDisable = const GL.glDisable+ glDisableVertexAttribArray = const GL.glDisableVertexAttribArray+ glDrawArrays = const GL.glDrawArrays+ glDrawElements = const GL.glDrawElements+ glDrawBuffers _ (l, fp) = withForeignPtr fp $+ \p -> GL.glDrawBuffers (l `quot` 4) $ castPtr p+ glEnable = const GL.glEnable+ glEnableVertexAttribArray = const GL.glEnableVertexAttribArray+ glFinish = const GL.glFinish+ glFlush = const GL.glFlush+ glFramebufferRenderbuffer = const GL.glFramebufferRenderbuffer+ glFramebufferTexture2D = const GL.glFramebufferTexture2D+ glFrontFace = const GL.glFrontFace+ glGenerateMipmap = const GL.glGenerateMipmap+ glGetAttribLocation _ a b = withCString b $ GL.glGetAttribLocation a+ glGetError = const GL.glGetError+ glGetProgramInfoLog = getString GL.glGetProgramInfoLog+ glGetShaderInfoLog = getString GL.glGetShaderInfoLog+ glGetShaderSource = getString GL.glGetShaderSource+ glGetUniformLocation _ a b = withCString b $ GL.glGetUniformLocation a+ glHint = const GL.glHint+ glIsBuffer = const GL.glIsBuffer+ glIsEnabled = const GL.glIsEnabled+ glIsFramebuffer = const GL.glIsFramebuffer+ glIsProgram = const GL.glIsProgram+ glIsRenderbuffer = const GL.glIsRenderbuffer+ glIsShader = const GL.glIsShader+ glIsTexture = const GL.glIsTexture+ glIsVertexArray = const GL.glIsVertexArray+ glLineWidth = const GL.glLineWidth+ glLinkProgram = const GL.glLinkProgram+ glPixelStorei = const GL.glPixelStorei+ glPolygonOffset = const GL.glPolygonOffset+ glReadPixels _ a b c d e f (_, fp) = withForeignPtr fp $+ GL.glReadPixels a b c d e f . castPtr+ glRenderbufferStorage = const GL.glRenderbufferStorage+ glSampleCoverage = const GL.glSampleCoverage+ glScissor = const GL.glScissor+ glShaderSource _ shader src =+ withCString src $ \csrc ->+ with (fromIntegral $ length src) $ \lenptr ->+ with csrc $ \csrcptr ->+ GL.glShaderSource shader 1 csrcptr lenptr+ glStencilFunc = const GL.glStencilFunc+ glStencilFuncSeparate = const GL.glStencilFuncSeparate+ glStencilMask = const GL.glStencilMask+ glStencilMaskSeparate = const GL.glStencilMaskSeparate+ glStencilOp = const GL.glStencilOp+ glStencilOpSeparate = const GL.glStencilOpSeparate+ glTexImage2D _ 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 $+ GL.glTexSubImage2D a b c d e f g h . castPtr+ glUniform1f = const GL.glUniform1f+ glUniform1fv = uniform GL.glUniform1fv+ glUniform1i = const GL.glUniform1i+ glUniform1iv = uniform GL.glUniform1iv+ glUniform2f = const GL.glUniform2f+ glUniform2fv = uniform GL.glUniform2fv+ glUniform2i = const GL.glUniform2i+ glUniform2iv = uniform GL.glUniform2iv+ glUniform3f = const GL.glUniform3f+ glUniform3fv = uniform GL.glUniform3fv+ glUniform3i = const GL.glUniform3i+ glUniform3iv = uniform GL.glUniform3iv+ glUniform4f = const GL.glUniform4f+ glUniform4fv = uniform GL.glUniform4fv+ glUniform4i = const GL.glUniform4i+ glUniform4iv = uniform GL.glUniform4iv+ glUniformMatrix2fv = uniformMatrix GL.glUniformMatrix2fv 4+ glUniformMatrix3fv = uniformMatrix GL.glUniformMatrix3fv 9+ glUniformMatrix4fv = uniformMatrix GL.glUniformMatrix4fv 16+ glUseProgram = const GL.glUseProgram+ glValidateProgram = const GL.glValidateProgram+ glVertexAttrib1f = const GL.glVertexAttrib1f+ glVertexAttrib1fv = vertexAttrib GL.glVertexAttrib1fv+ glVertexAttrib2f = const GL.glVertexAttrib2f+ glVertexAttrib2fv = vertexAttrib GL.glVertexAttrib2fv+ glVertexAttrib3f = const GL.glVertexAttrib3f+ glVertexAttrib3fv = vertexAttrib GL.glVertexAttrib3fv+ glVertexAttrib4f = const GL.glVertexAttrib4f+ glVertexAttrib4fv = vertexAttrib GL.glVertexAttrib4fv+ glVertexAttribPointer = const GL.glVertexAttribPointer+ glViewport = const GL.glViewport++ gl_DEPTH_BUFFER_BIT = GL.GL_DEPTH_BUFFER_BIT+ gl_STENCIL_BUFFER_BIT = GL.GL_STENCIL_BUFFER_BIT+ gl_COLOR_BUFFER_BIT = GL.GL_COLOR_BUFFER_BIT+ gl_POINTS = GL.GL_POINTS+ gl_LINES = GL.GL_LINES+ gl_LINE_LOOP = GL.GL_LINE_LOOP+ gl_LINE_STRIP = GL.GL_LINE_STRIP+ gl_TRIANGLES = GL.GL_TRIANGLES+ gl_TRIANGLE_STRIP = GL.GL_TRIANGLE_STRIP+ gl_TRIANGLE_FAN = GL.GL_TRIANGLE_FAN+ gl_ZERO = GL.GL_ZERO+ gl_ONE = GL.GL_ONE+ gl_SRC_COLOR = GL.GL_SRC_COLOR+ gl_ONE_MINUS_SRC_COLOR = GL.GL_ONE_MINUS_SRC_COLOR+ gl_SRC_ALPHA = GL.GL_SRC_ALPHA+ gl_ONE_MINUS_SRC_ALPHA = GL.GL_ONE_MINUS_SRC_ALPHA+ gl_DST_ALPHA = GL.GL_DST_ALPHA+ gl_ONE_MINUS_DST_ALPHA = GL.GL_ONE_MINUS_DST_ALPHA+ gl_DST_COLOR = GL.GL_DST_COLOR+ 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_RGB = GL.GL_BLEND_EQUATION_RGB+ gl_BLEND_EQUATION_ALPHA = GL.GL_BLEND_EQUATION_ALPHA+ gl_FUNC_SUBTRACT = GL.GL_FUNC_SUBTRACT+ gl_FUNC_REVERSE_SUBTRACT = GL.GL_FUNC_REVERSE_SUBTRACT+ gl_BLEND_DST_RGB = GL.GL_BLEND_DST_RGB+ gl_BLEND_SRC_RGB = GL.GL_BLEND_SRC_RGB+ gl_BLEND_DST_ALPHA = GL.GL_BLEND_DST_ALPHA+ gl_BLEND_SRC_ALPHA = GL.GL_BLEND_SRC_ALPHA+ gl_CONSTANT_COLOR = GL.GL_CONSTANT_COLOR+ gl_ONE_MINUS_CONSTANT_COLOR = GL.GL_ONE_MINUS_CONSTANT_COLOR+ gl_CONSTANT_ALPHA = GL.GL_CONSTANT_ALPHA+ gl_ONE_MINUS_CONSTANT_ALPHA = GL.GL_ONE_MINUS_CONSTANT_ALPHA+ gl_BLEND_COLOR = GL.GL_BLEND_COLOR_EXT+ gl_ARRAY_BUFFER = GL.GL_ARRAY_BUFFER+ gl_ELEMENT_ARRAY_BUFFER = GL.GL_ELEMENT_ARRAY_BUFFER+ gl_ARRAY_BUFFER_BINDING = GL.GL_ARRAY_BUFFER_BINDING+ gl_ELEMENT_ARRAY_BUFFER_BINDING = GL.GL_ELEMENT_ARRAY_BUFFER_BINDING+ gl_STREAM_DRAW = GL.GL_STREAM_DRAW+ gl_STATIC_DRAW = GL.GL_STATIC_DRAW+ gl_DYNAMIC_DRAW = GL.GL_DYNAMIC_DRAW+ gl_BUFFER_SIZE = GL.GL_BUFFER_SIZE+ gl_BUFFER_USAGE = GL.GL_BUFFER_USAGE+ gl_CURRENT_VERTEX_ATTRIB = GL.GL_CURRENT_VERTEX_ATTRIB+ gl_FRONT = GL.GL_FRONT+ gl_BACK = GL.GL_BACK+ gl_FRONT_AND_BACK = GL.GL_FRONT_AND_BACK+ gl_CULL_FACE = GL.GL_CULL_FACE+ gl_BLEND = GL.GL_BLEND+ gl_DITHER = GL.GL_DITHER+ gl_STENCIL_TEST = GL.GL_STENCIL_TEST+ gl_DEPTH_TEST = GL.GL_DEPTH_TEST+ gl_SCISSOR_TEST = GL.GL_SCISSOR_TEST+ gl_POLYGON_OFFSET_FILL = GL.GL_POLYGON_OFFSET_FILL+ gl_SAMPLE_ALPHA_TO_COVERAGE = GL.GL_SAMPLE_ALPHA_TO_COVERAGE+ gl_SAMPLE_COVERAGE = GL.GL_SAMPLE_COVERAGE+ gl_NO_ERROR = GL.GL_NO_ERROR+ gl_INVALID_ENUM = GL.GL_INVALID_ENUM+ gl_INVALID_VALUE = GL.GL_INVALID_VALUE+ gl_INVALID_OPERATION = GL.GL_INVALID_OPERATION+ gl_OUT_OF_MEMORY = GL.GL_OUT_OF_MEMORY+ 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_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+ gl_DEPTH_RANGE = GL.GL_DEPTH_RANGE+ gl_DEPTH_WRITEMASK = GL.GL_DEPTH_WRITEMASK+ gl_DEPTH_CLEAR_VALUE = GL.GL_DEPTH_CLEAR_VALUE+ gl_DEPTH_FUNC = GL.GL_DEPTH_FUNC+ gl_STENCIL_CLEAR_VALUE = GL.GL_STENCIL_CLEAR_VALUE+ gl_STENCIL_FUNC = GL.GL_STENCIL_FUNC+ gl_STENCIL_FAIL = GL.GL_STENCIL_FAIL+ gl_STENCIL_PASS_DEPTH_FAIL = GL.GL_STENCIL_PASS_DEPTH_FAIL+ gl_STENCIL_PASS_DEPTH_PASS = GL.GL_STENCIL_PASS_DEPTH_PASS+ gl_STENCIL_REF = GL.GL_STENCIL_REF+ gl_STENCIL_VALUE_MASK = GL.GL_STENCIL_VALUE_MASK+ gl_STENCIL_WRITEMASK = GL.GL_STENCIL_WRITEMASK+ gl_STENCIL_BACK_FUNC = GL.GL_STENCIL_BACK_FUNC+ gl_STENCIL_BACK_FAIL = GL.GL_STENCIL_BACK_FAIL+ gl_STENCIL_BACK_PASS_DEPTH_FAIL = GL.GL_STENCIL_BACK_PASS_DEPTH_FAIL+ gl_STENCIL_BACK_PASS_DEPTH_PASS = GL.GL_STENCIL_BACK_PASS_DEPTH_PASS+ gl_STENCIL_BACK_REF = GL.GL_STENCIL_BACK_REF+ gl_STENCIL_BACK_VALUE_MASK = GL.GL_STENCIL_BACK_VALUE_MASK+ gl_STENCIL_BACK_WRITEMASK = GL.GL_STENCIL_BACK_WRITEMASK+ gl_VIEWPORT = GL.GL_VIEWPORT+ gl_SCISSOR_BOX = GL.GL_SCISSOR_BOX+ gl_COLOR_CLEAR_VALUE = GL.GL_COLOR_CLEAR_VALUE+ gl_COLOR_WRITEMASK = GL.GL_COLOR_WRITEMASK+ gl_UNPACK_ALIGNMENT = GL.GL_UNPACK_ALIGNMENT+ gl_PACK_ALIGNMENT = GL.GL_PACK_ALIGNMENT+ 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_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+ gl_SAMPLE_BUFFERS = GL.GL_SAMPLE_BUFFERS+ gl_SAMPLES = GL.GL_SAMPLES+ gl_SAMPLE_COVERAGE_VALUE = GL.GL_SAMPLE_COVERAGE_VALUE+ gl_SAMPLE_COVERAGE_INVERT = GL.GL_SAMPLE_COVERAGE_INVERT+ gl_COMPRESSED_TEXTURE_FORMATS = GL.GL_COMPRESSED_TEXTURE_FORMATS+ 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_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_FLOAT = GL.GL_FLOAT+ gl_DEPTH_COMPONENT = GL.GL_DEPTH_COMPONENT+ 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_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_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_SHADER_TYPE = GL.GL_SHADER_TYPE+ gl_DELETE_STATUS = GL.GL_DELETE_STATUS+ gl_LINK_STATUS = GL.GL_LINK_STATUS+ gl_VALIDATE_STATUS = GL.GL_VALIDATE_STATUS+ gl_ATTACHED_SHADERS = GL.GL_ATTACHED_SHADERS+ gl_ACTIVE_UNIFORMS = GL.GL_ACTIVE_UNIFORMS+ gl_ACTIVE_ATTRIBUTES = GL.GL_ACTIVE_ATTRIBUTES+ gl_SHADING_LANGUAGE_VERSION = GL.GL_SHADING_LANGUAGE_VERSION+ gl_CURRENT_PROGRAM = GL.GL_CURRENT_PROGRAM+ gl_NEVER = GL.GL_NEVER+ gl_LESS = GL.GL_LESS+ gl_EQUAL = GL.GL_EQUAL+ gl_LEQUAL = GL.GL_LEQUAL+ gl_GREATER = GL.GL_GREATER+ gl_NOTEQUAL = GL.GL_NOTEQUAL+ gl_GEQUAL = GL.GL_GEQUAL+ gl_ALWAYS = GL.GL_ALWAYS+ gl_KEEP = GL.GL_KEEP+ gl_REPLACE = GL.GL_REPLACE+ gl_INCR = GL.GL_INCR+ gl_DECR = GL.GL_DECR+ gl_INVERT = GL.GL_INVERT+ gl_INCR_WRAP = GL.GL_INCR_WRAP+ gl_DECR_WRAP = GL.GL_DECR_WRAP+ gl_VENDOR = GL.GL_VENDOR+ gl_RENDERER = GL.GL_RENDERER+ gl_VERSION = GL.GL_VERSION+ gl_NEAREST = GL.GL_NEAREST+ gl_LINEAR = GL.GL_LINEAR+ gl_NEAREST_MIPMAP_NEAREST = GL.GL_NEAREST_MIPMAP_NEAREST+ gl_LINEAR_MIPMAP_NEAREST = GL.GL_LINEAR_MIPMAP_NEAREST+ gl_NEAREST_MIPMAP_LINEAR = GL.GL_NEAREST_MIPMAP_LINEAR+ gl_LINEAR_MIPMAP_LINEAR = GL.GL_LINEAR_MIPMAP_LINEAR+ gl_TEXTURE_MAG_FILTER = GL.GL_TEXTURE_MAG_FILTER+ gl_TEXTURE_MIN_FILTER = GL.GL_TEXTURE_MIN_FILTER+ gl_TEXTURE_WRAP_S = GL.GL_TEXTURE_WRAP_S+ gl_TEXTURE_WRAP_T = GL.GL_TEXTURE_WRAP_T+ gl_TEXTURE_2D = GL.GL_TEXTURE_2D+ gl_TEXTURE = GL.GL_TEXTURE+ gl_TEXTURE_CUBE_MAP = GL.GL_TEXTURE_CUBE_MAP+ gl_TEXTURE_BINDING_CUBE_MAP = GL.GL_TEXTURE_BINDING_CUBE_MAP+ gl_TEXTURE_CUBE_MAP_POSITIVE_X = GL.GL_TEXTURE_CUBE_MAP_POSITIVE_X+ gl_TEXTURE_CUBE_MAP_NEGATIVE_X = GL.GL_TEXTURE_CUBE_MAP_NEGATIVE_X+ gl_TEXTURE_CUBE_MAP_POSITIVE_Y = GL.GL_TEXTURE_CUBE_MAP_POSITIVE_Y+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Y = GL.GL_TEXTURE_CUBE_MAP_NEGATIVE_Y+ gl_TEXTURE_CUBE_MAP_POSITIVE_Z = GL.GL_TEXTURE_CUBE_MAP_POSITIVE_Z+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Z = GL.GL_TEXTURE_CUBE_MAP_NEGATIVE_Z+ gl_MAX_CUBE_MAP_TEXTURE_SIZE = GL.GL_MAX_CUBE_MAP_TEXTURE_SIZE+ gl_TEXTURE0 = GL.GL_TEXTURE0+ gl_TEXTURE1 = GL.GL_TEXTURE1+ gl_TEXTURE2 = GL.GL_TEXTURE2+ gl_TEXTURE3 = GL.GL_TEXTURE3+ gl_TEXTURE4 = GL.GL_TEXTURE4+ gl_TEXTURE5 = GL.GL_TEXTURE5+ gl_TEXTURE6 = GL.GL_TEXTURE6+ gl_TEXTURE7 = GL.GL_TEXTURE7+ gl_TEXTURE8 = GL.GL_TEXTURE8+ gl_TEXTURE9 = GL.GL_TEXTURE9+ gl_TEXTURE10 = GL.GL_TEXTURE10+ gl_TEXTURE11 = GL.GL_TEXTURE11+ gl_TEXTURE12 = GL.GL_TEXTURE12+ gl_TEXTURE13 = GL.GL_TEXTURE13+ gl_TEXTURE14 = GL.GL_TEXTURE14+ gl_TEXTURE15 = GL.GL_TEXTURE15+ gl_TEXTURE16 = GL.GL_TEXTURE16+ gl_TEXTURE17 = GL.GL_TEXTURE17+ gl_TEXTURE18 = GL.GL_TEXTURE18+ gl_TEXTURE19 = GL.GL_TEXTURE19+ gl_TEXTURE20 = GL.GL_TEXTURE20+ gl_TEXTURE21 = GL.GL_TEXTURE21+ gl_TEXTURE22 = GL.GL_TEXTURE22+ gl_TEXTURE23 = GL.GL_TEXTURE23+ gl_TEXTURE24 = GL.GL_TEXTURE24+ gl_TEXTURE25 = GL.GL_TEXTURE25+ gl_TEXTURE26 = GL.GL_TEXTURE26+ gl_TEXTURE27 = GL.GL_TEXTURE27+ gl_TEXTURE28 = GL.GL_TEXTURE28+ gl_TEXTURE29 = GL.GL_TEXTURE29+ gl_TEXTURE30 = GL.GL_TEXTURE30+ gl_TEXTURE31 = GL.GL_TEXTURE31+ gl_ACTIVE_TEXTURE = GL.GL_ACTIVE_TEXTURE+ gl_REPEAT = GL.GL_REPEAT+ gl_CLAMP_TO_EDGE = GL.GL_CLAMP_TO_EDGE+ gl_MIRRORED_REPEAT = GL.GL_MIRRORED_REPEAT+ gl_FLOAT_VEC2 = GL.GL_FLOAT_VEC2+ gl_FLOAT_VEC3 = GL.GL_FLOAT_VEC3+ gl_FLOAT_VEC4 = GL.GL_FLOAT_VEC4+ gl_INT_VEC2 = GL.GL_INT_VEC2+ gl_INT_VEC3 = GL.GL_INT_VEC3+ gl_INT_VEC4 = GL.GL_INT_VEC4+ gl_BOOL = GL.GL_BOOL+ gl_BOOL_VEC2 = GL.GL_BOOL_VEC2+ gl_BOOL_VEC3 = GL.GL_BOOL_VEC3+ gl_BOOL_VEC4 = GL.GL_BOOL_VEC4+ gl_FLOAT_MAT2 = GL.GL_FLOAT_MAT2+ gl_FLOAT_MAT3 = GL.GL_FLOAT_MAT3+ gl_FLOAT_MAT4 = GL.GL_FLOAT_MAT4+ gl_SAMPLER_2D = GL.GL_SAMPLER_2D+ gl_SAMPLER_CUBE = GL.GL_SAMPLER_CUBE+ gl_VERTEX_ATTRIB_ARRAY_ENABLED = GL.GL_VERTEX_ATTRIB_ARRAY_ENABLED+ gl_VERTEX_ATTRIB_ARRAY_SIZE = GL.GL_VERTEX_ATTRIB_ARRAY_SIZE+ gl_VERTEX_ATTRIB_ARRAY_STRIDE = GL.GL_VERTEX_ATTRIB_ARRAY_STRIDE+ gl_VERTEX_ATTRIB_ARRAY_TYPE = GL.GL_VERTEX_ATTRIB_ARRAY_TYPE+ gl_VERTEX_ATTRIB_ARRAY_NORMALIZED = GL.GL_VERTEX_ATTRIB_ARRAY_NORMALIZED+ 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_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_DEPTH_COMPONENT16 = GL.GL_DEPTH_COMPONENT16+ gl_STENCIL_INDEX8 = GL.GL_STENCIL_INDEX8+ gl_RENDERBUFFER_WIDTH = GL.GL_RENDERBUFFER_WIDTH+ gl_RENDERBUFFER_HEIGHT = GL.GL_RENDERBUFFER_HEIGHT+ gl_RENDERBUFFER_INTERNAL_FORMAT = GL.GL_RENDERBUFFER_INTERNAL_FORMAT+ gl_RENDERBUFFER_RED_SIZE = GL.GL_RENDERBUFFER_RED_SIZE+ gl_RENDERBUFFER_GREEN_SIZE = GL.GL_RENDERBUFFER_GREEN_SIZE+ gl_RENDERBUFFER_BLUE_SIZE = GL.GL_RENDERBUFFER_BLUE_SIZE+ gl_RENDERBUFFER_ALPHA_SIZE = GL.GL_RENDERBUFFER_ALPHA_SIZE+ gl_RENDERBUFFER_DEPTH_SIZE = GL.GL_RENDERBUFFER_DEPTH_SIZE+ gl_RENDERBUFFER_STENCIL_SIZE = GL.GL_RENDERBUFFER_STENCIL_SIZE+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE = GL.GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME = GL.GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL = GL.GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE = GL.GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE+ gl_MAX_DRAW_BUFFERS = GL.GL_MAX_DRAW_BUFFERS+ gl_DRAW_BUFFER0 = GL.GL_DRAW_BUFFER0+ gl_DRAW_BUFFER1 = GL.GL_DRAW_BUFFER1+ gl_DRAW_BUFFER2 = GL.GL_DRAW_BUFFER2+ gl_DRAW_BUFFER3 = GL.GL_DRAW_BUFFER3+ gl_DRAW_BUFFER4 = GL.GL_DRAW_BUFFER4+ gl_DRAW_BUFFER5 = GL.GL_DRAW_BUFFER5+ gl_DRAW_BUFFER6 = GL.GL_DRAW_BUFFER6+ gl_DRAW_BUFFER7 = GL.GL_DRAW_BUFFER7+ gl_DRAW_BUFFER8 = GL.GL_DRAW_BUFFER8+ gl_DRAW_BUFFER9 = GL.GL_DRAW_BUFFER9+ gl_DRAW_BUFFER10 = GL.GL_DRAW_BUFFER10+ gl_DRAW_BUFFER11 = GL.GL_DRAW_BUFFER11+ gl_DRAW_BUFFER12 = GL.GL_DRAW_BUFFER12+ gl_DRAW_BUFFER13 = GL.GL_DRAW_BUFFER13+ gl_DRAW_BUFFER14 = GL.GL_DRAW_BUFFER14+ gl_DRAW_BUFFER15 = GL.GL_DRAW_BUFFER15+ gl_MAX_COLOR_ATTACHMENTS = GL.GL_MAX_COLOR_ATTACHMENTS+ gl_COLOR_ATTACHMENT0 = GL.GL_COLOR_ATTACHMENT0+ gl_COLOR_ATTACHMENT1 = GL.GL_COLOR_ATTACHMENT1+ gl_COLOR_ATTACHMENT2 = GL.GL_COLOR_ATTACHMENT2+ gl_COLOR_ATTACHMENT3 = GL.GL_COLOR_ATTACHMENT3+ gl_COLOR_ATTACHMENT4 = GL.GL_COLOR_ATTACHMENT4+ gl_COLOR_ATTACHMENT5 = GL.GL_COLOR_ATTACHMENT5+ gl_COLOR_ATTACHMENT6 = GL.GL_COLOR_ATTACHMENT6+ gl_COLOR_ATTACHMENT7 = GL.GL_COLOR_ATTACHMENT7+ gl_COLOR_ATTACHMENT8 = GL.GL_COLOR_ATTACHMENT8+ gl_COLOR_ATTACHMENT9 = GL.GL_COLOR_ATTACHMENT9+ gl_COLOR_ATTACHMENT10 = GL.GL_COLOR_ATTACHMENT10+ gl_COLOR_ATTACHMENT11 = GL.GL_COLOR_ATTACHMENT11+ gl_COLOR_ATTACHMENT12 = GL.GL_COLOR_ATTACHMENT12+ gl_COLOR_ATTACHMENT13 = GL.GL_COLOR_ATTACHMENT13+ gl_COLOR_ATTACHMENT14 = GL.GL_COLOR_ATTACHMENT14+ gl_COLOR_ATTACHMENT15 = GL.GL_COLOR_ATTACHMENT15+ gl_DEPTH_ATTACHMENT = GL.GL_DEPTH_ATTACHMENT+ gl_STENCIL_ATTACHMENT = GL.GL_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_UNSUPPORTED = GL.GL_FRAMEBUFFER_UNSUPPORTED+ gl_FRAMEBUFFER_BINDING = GL.GL_FRAMEBUFFER_BINDING+ gl_RENDERBUFFER_BINDING = GL.GL_RENDERBUFFER_BINDING+ gl_MAX_RENDERBUFFER_SIZE = GL.GL_MAX_RENDERBUFFER_SIZE+ gl_INVALID_FRAMEBUFFER_OPERATION = GL.GL_INVALID_FRAMEBUFFER_OPERATION
+ Graphics/Rendering/Ombra/Backend/WebGL.hs view
@@ -0,0 +1,655 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies,+ UndecidableInstances, OverloadedStrings #-}++{-| The GHCJS/WebGL backend. This just exports the instance for 'GLES'. -}+module Graphics.Rendering.Ombra.Backend.WebGL (+ makeContext+) where++import Control.Applicative+import Control.Concurrent+import Data.Coerce+import Data.Maybe+import qualified Data.HashMap.Strict as H+import Data.Int (Int32)+import Data.IORef+import Data.List (unfoldr)+import Data.JSString (JSString, pack)+import Data.Vect.Float+import Data.Word+import Graphics.Rendering.Ombra.Backend+import qualified Graphics.Rendering.Ombra.Backend.WebGL.Const as JS+import qualified Graphics.Rendering.Ombra.Backend.WebGL.Raw as JS+import qualified Graphics.Rendering.Ombra.Backend.WebGL.Types as JS+import Graphics.Rendering.Ombra.Color+import GHCJS.Foreign hiding (Object)+import GHCJS.Types+import GHCJS.Marshal+import qualified JavaScript.Array as JSArray+import JavaScript.Object hiding (create)+import JavaScript.Object.Internal (Object(..))+import JavaScript.TypedArray hiding (Float32Array, Int32Array)+import qualified JavaScript.TypedArray as JS+import qualified JavaScript.TypedArray.ArrayBuffer as JS+import qualified JavaScript.TypedArray.Internal as JS+import qualified JavaScript.TypedArray.DataView as JSDataView++-- TODO: ??? +foreign import javascript unsafe "eval('null')" nullUInt8Array :: IO UInt8Array++data TagTex = TagTex Int JS.Texture++instance Eq TagTex where+ TagTex t _ == TagTex t' _ = t == t'++makeContext :: JSVal -- ^ Canvas element.+ -> IO Ctx+makeContext element = do ctx <- JS.getCtx element+ counter <- newIORef 0+ JS.getExtension ctx "WEBGL_depth_texture"+ JS.getExtension ctx "WEBGL_color_buffer_float"+ vaoExt <- JS.getExtension ctx "OES_vertex_array_object"+ drawBufsExt <- JS.getExtension ctx "WEBGL_draw_buffers"+ setProp "vaoExt" vaoExt $ Object ctx+ setProp "drawBufs" drawBufsExt $ Object ctx+ return (counter, ctx)++toJSArray :: ToJSVal a => (v -> Maybe (a, v)) -> v -> IO JSArray.JSArray+toJSArray next iv = JSArray.fromList <$> mapM toJSVal list+ where list = unfoldr next iv+ {- + JSArray.create >>= iterPush iv+ where iterPush v arr = case next v of+ Just (x, v') -> do xRef <- toJSVal x+ JSArray.push xRef arr+ iterPush v' arr+ Nothing -> return arr+ -}++instance GLES where+ type Ctx = (IORef Int, JS.Ctx)+ type GLEnum = Word+ type GLUInt = Word+ type GLInt = Int32+ type GLPtr = Word+ type GLPtrDiff = Word+ type GLSize = Int32+ type GLString = JSString+ type GLBool = Bool+ type Buffer = JS.Buffer+ type UniformLocation = JS.UniformLocation+ type Texture = TagTex+ type Shader = JS.Shader+ type Program = JS.Program+ type FrameBuffer = JS.FrameBuffer+ type RenderBuffer = JS.RenderBuffer+ type VertexArrayObject = JS.VertexArrayObject+ -- type ActiveInfo = JS.ActiveInfo+ -- type ShaderPrecisionFormat = JS.ShaderPrecisionFormat+ type AnyArray = JS.ArrayBuffer+ type Float32Array = JS.Float32Array+ type Int32Array = JS.Int32Array+ type UInt8Array = JS.Uint8Array+ type UInt16Array = JS.Uint16Array++ true = True+ false = False+ nullGLPtr = 0+ toGLString = pack+ noBuffer = JS.noBuffer+ noTexture = TagTex (-1) JS.noTexture+ noUInt8Array = nullUInt8Array+ noVAO = JS.noVAO++ encodeMat2 (Mat2 (Vec2 a1 a2) (Vec2 b1 b2)) =+ JSArray.fromList <$> mapM toJSVal [a1, a2, b1, b2]+ >>= JS.float32ArrayFrom++ encodeMat3 (Mat3 (Vec3 a1 a2 a3)+ (Vec3 b1 b2 b3)+ (Vec3 c1 c2 c3)) = JSArray.fromList <$> mapM toJSVal+ [ a1, a2, a3+ , b1, b2, b3+ , c1, c2, c3 ]+ >>= JS.float32ArrayFrom+ encodeMat4 (Mat4 (Vec4 a1 a2 a3 a4)+ (Vec4 b1 b2 b3 b4)+ (Vec4 c1 c2 c3 c4)+ (Vec4 d1 d2 d3 d4) ) =+ JSArray.fromList <$> mapM toJSVal [ a1, a2, a3, a4+ , b1, b2, b3, b4+ , c1, c2, c3, c4+ , d1, d2, d3, d4 ]+ >>= JS.float32ArrayFrom+ encodeFloats v = JSArray.fromList <$> mapM toJSVal v+ >>= JS.float32ArrayFrom+ encodeInts v = JSArray.fromList <$> mapM toJSVal v+ >>= JS.int32ArrayFrom++ -- TODO: decent implementation+ encodeVec2s v = toJSArray next (False, v) >>= JS.float32ArrayFrom+ where next (False, xs@(Vec2 x _ : _)) = Just (x, (True, xs))+ next (True, Vec2 _ y : xs) = Just (y, (False, xs))+ next (_, []) = Nothing++ encodeVec3s v = toJSArray next (0, v) >>= JS.float32ArrayFrom+ where next (0, xs@(Vec3 x _ _ : _)) = Just (x, (1, xs))+ next (1, xs@(Vec3 _ y _ : _)) = Just (y, (2, xs))+ next (2, Vec3 _ _ z : xs) = Just (z, (0, xs))+ next (_, []) = Nothing++ encodeVec4s v = toJSArray next (0, v) >>= JS.float32ArrayFrom+ where next (0, xs@(Vec4 x _ _ _ : _)) = Just (x, (1, xs))+ next (1, xs@(Vec4 _ y _ _ : _)) = Just (y, (2, xs))+ next (2, xs@(Vec4 _ _ z _ : _)) = Just (z, (3, xs))+ next (3, Vec4 _ _ _ w : xs) = Just (w, (0, xs))+ next (_, []) = Nothing++ encodeIVec2s v = toJSArray next (False, v) >>= JS.int32ArrayFrom+ where next (False, xs@(IVec2 x _ : _)) = Just (x, (True, xs))+ next (True, IVec2 _ y : xs) = Just (y, (False, xs))+ next (_, []) = Nothing++ encodeIVec3s v = toJSArray next (0, v) >>= JS.int32ArrayFrom+ where next (0, xs@(IVec3 x _ _ : _)) = Just (x, (1, xs))+ next (1, xs@(IVec3 _ y _ : _)) = Just (y, (2, xs))+ next (2, IVec3 _ _ z : xs) = Just (z, (0, xs))+ next (_, []) = Nothing++ encodeIVec4s v = toJSArray next (0, v) >>= JS.int32ArrayFrom+ where next (0, xs@(IVec4 x _ _ _ : _)) = Just (x, (1, xs))+ next (1, xs@(IVec4 _ y _ _ : _)) = Just (y, (2, xs))+ next (2, xs@(IVec4 _ _ z _ : _)) = Just (z, (3, xs))+ next (3, IVec4 _ _ _ w : xs) = Just (w, (0, xs))+ next (_, []) = Nothing++ encodeUShorts v = JSArray.fromList <$> mapM toJSVal v+ >>= JS.uint16ArrayFrom++ encodeUInt8s v = JSArray.fromList <$> mapM toJSVal v+ >>= JS.uint8ArrayFrom++{-+ encodeColors v = toJSArray next (0, v) >>= JS.uint8ArrayFrom+ where next (0, xs@(Color x _ _ _ : _)) = Just (x, (1, xs))+ next (1, xs@(Color _ y _ _ : _)) = Just (y, (2, xs))+ next (2, xs@(Color _ _ z _ : _)) = Just (z, (3, xs))+ next (3, Color _ _ _ w : xs) = Just (w, (0, xs))+ next (_, []) = Nothing+-}++ -- !+ newByteArray l = do arr <- JSArray.create+ _ <- sequence . replicate l $+ toJSVal (0 :: Word) >>=+ flip JSArray.push arr+ JSArray.unsafeFreeze arr >>= JS.uint8ArrayFrom+ fromFloat32Array = JS.buffer+ fromInt32Array = JS.buffer+ fromUInt8Array = JS.buffer+ fromUInt16Array = JS.buffer+ decodeBytes ar = let dw = JSDataView.dataView $ JS.buffer ar+ in return $ map (flip JSDataView.getUint8 dw)+ [0 .. JS.length ar - 1]++ glActiveTexture = JS.glActiveTexture . snd+ glAttachShader = JS.glAttachShader . snd+ glBindAttribLocation = JS.glBindAttribLocation . snd+ glBindBuffer = JS.glBindBuffer . snd+ glBindFramebuffer = JS.glBindFramebuffer . snd+ glBindRenderbuffer = JS.glBindRenderbuffer . snd+ glBindTexture (_, c) e (TagTex _ t) = JS.glBindTexture c e t+ glBindVertexArray = JS.glBindVertexArrayOES . snd+ glBlendColor = JS.glBlendColor . snd+ glBlendEquation = JS.glBlendEquation . snd+ glBlendEquationSeparate = JS.glBlendEquationSeparate . snd+ glBlendFunc = JS.glBlendFunc . snd+ glBlendFuncSeparate = JS.glBlendFuncSeparate . snd+ glBufferData = JS.glBufferData . snd+ glBufferSubData = JS.glBufferSubData . snd+ glCheckFramebufferStatus = JS.glCheckFramebufferStatus . snd+ glClear = JS.glClear . snd+ glClearColor = JS.glClearColor . snd+ glClearDepth = JS.glClearDepth . snd+ glClearStencil = JS.glClearStencil . snd+ glColorMask = JS.glColorMask . snd+ glCompileShader = JS.glCompileShader . snd+ glCompressedTexImage2D = JS.glCompressedTexImage2D . snd+ glCompressedTexSubImage2D = JS.glCompressedTexSubImage2D . snd+ glCopyTexImage2D = JS.glCopyTexImage2D . snd+ glCopyTexSubImage2D = JS.glCopyTexSubImage2D . snd+ glCreateBuffer = JS.glCreateBuffer . snd+ glCreateFramebuffer = JS.glCreateFramebuffer . snd+ glCreateProgram = JS.glCreateProgram . snd+ glCreateRenderbuffer = JS.glCreateRenderbuffer . snd+ glCreateShader = JS.glCreateShader . snd+ glCreateTexture (r, c) = do t <- JS.glCreateTexture c+ n <- atomicModifyIORef' r $ \n -> (n + 1, n)+ return $ TagTex n t+ glCreateVertexArray = JS.glCreateVertexArrayOES . snd+ glCullFace = JS.glCullFace . snd+ glDeleteBuffer = JS.glDeleteBuffer . snd+ glDeleteFramebuffer = JS.glDeleteFramebuffer . snd+ glDeleteProgram = JS.glDeleteProgram . snd+ glDeleteRenderbuffer = JS.glDeleteRenderbuffer . snd+ glDeleteShader = JS.glDeleteShader . snd+ glDeleteTexture (_, c) (TagTex _ t) = JS.glDeleteTexture c t+ glDeleteVertexArray = JS.glDeleteVertexArrayOES . snd+ glDepthFunc = JS.glDepthFunc . snd+ glDepthMask = JS.glDepthMask . snd+ glDepthRange = JS.glDepthRange . snd+ glDetachShader = JS.glDetachShader . snd+ glDisable = JS.glDisable . snd+ glDisableVertexAttribArray = JS.glDisableVertexAttribArray . snd+ glDrawArrays = JS.glDrawArrays . snd+ glDrawBuffers = JS.glDrawBuffersWEBGL . snd+ glDrawElements = JS.glDrawElements . snd+ glEnable = JS.glEnable . snd+ glEnableVertexAttribArray = JS.glEnableVertexAttribArray . snd+ glFinish = JS.glFinish . snd+ glFlush = JS.glFlush . snd+ glFramebufferRenderbuffer = JS.glFramebufferRenderbuffer . snd+ glFramebufferTexture2D (_, ctx) a b c (TagTex _ t) d =+ JS.glFramebufferTexture2D ctx a b c t d+ glFrontFace = JS.glFrontFace . snd+ glGenerateMipmap = JS.glGenerateMipmap . snd+ -- glGetActiveAttrib = JS.glGetActiveAttrib . snd+ -- glGetActiveUniform = JS.glGetActiveUniform . snd+ glGetAttribLocation = JS.glGetAttribLocation . snd+ -- glGetBufferParameter = JS.glGetBufferParameter . snd+ -- glGetParameter = JS.glGetParameter . snd+ glGetError = JS.glGetError . snd+ -- glGetFramebufferAttachmentParameter = JS.glGetFramebufferAttachmentParameter . snd+ glGetProgramInfoLog = JS.glGetProgramInfoLog . snd+ -- glGetRenderbufferParameter = JS.glGetRenderbufferParameter . snd+ -- glGetShaderParameter = JS.glGetShaderParameter . snd+ -- glGetShaderPrecisionFormat = JS.glGetShaderPrecisionFormat . snd+ glGetShaderInfoLog = JS.glGetShaderInfoLog . snd+ glGetShaderSource = JS.glGetShaderSource . snd+ -- glGetTexParameter = JS.glGetTexParameter . snd+ -- glGetUniform = JS.glGetUniform . snd+ glGetUniformLocation = JS.glGetUniformLocation . snd+ -- glGetVertexAttrib = JS.glGetVertexAttrib . snd+ -- glGetVertexAttribOffset = JS.glGetVertexAttribOffset . snd+ glHint = JS.glHint . snd+ glIsBuffer = JS.glIsBuffer . snd+ glIsEnabled = JS.glIsEnabled . snd+ glIsFramebuffer = JS.glIsFramebuffer . snd+ glIsProgram = JS.glIsProgram . snd+ glIsRenderbuffer = JS.glIsRenderbuffer . snd+ glIsShader = JS.glIsShader . snd+ glIsTexture (_, c) (TagTex _ t) = JS.glIsTexture c t+ glIsVertexArray = JS.glIsVertexArrayOES . snd+ glLineWidth = JS.glLineWidth . snd+ glLinkProgram = JS.glLinkProgram . snd+ glPixelStorei = JS.glPixelStorei . snd+ glPolygonOffset = JS.glPolygonOffset . snd+ glReadPixels = JS.glReadPixels . snd+ glRenderbufferStorage = JS.glRenderbufferStorage . snd+ glSampleCoverage = JS.glSampleCoverage . snd+ glScissor = JS.glScissor . snd+ glShaderSource = JS.glShaderSource . snd+ glStencilFunc = JS.glStencilFunc . snd+ glStencilFuncSeparate = JS.glStencilFuncSeparate . snd+ glStencilMask = JS.glStencilMask . snd+ glStencilMaskSeparate = JS.glStencilMaskSeparate . snd+ glStencilOp = JS.glStencilOp . snd+ glStencilOpSeparate = JS.glStencilOpSeparate . snd+ glTexImage2D = JS.glTexImage2D . snd+ glTexParameterf = JS.glTexParameterf . snd+ glTexParameteri = JS.glTexParameteri . snd+ glTexSubImage2D = JS.glTexSubImage2D . snd+ glUniform1f = JS.glUniform1f . snd+ glUniform1fv = JS.glUniform1fv . snd+ glUniform1i = JS.glUniform1i . snd+ glUniform1iv = JS.glUniform1iv . snd+ glUniform2f = JS.glUniform2f . snd+ glUniform2fv = JS.glUniform2fv . snd+ glUniform2i = JS.glUniform2i . snd+ glUniform2iv = JS.glUniform2iv . snd+ glUniform3f = JS.glUniform3f . snd+ glUniform3fv = JS.glUniform3fv . snd+ glUniform3i = JS.glUniform3i . snd+ glUniform3iv = JS.glUniform3iv . snd+ glUniform4f = JS.glUniform4f . snd+ glUniform4fv = JS.glUniform4fv . snd+ glUniform4i = JS.glUniform4i . snd+ glUniform4iv = JS.glUniform4iv . snd+ -- XXX+ glUniformMatrix2fv (_, c) loc _ arr = JS.glUniformMatrix2fv c loc False arr+ glUniformMatrix3fv (_, c) loc _ arr = JS.glUniformMatrix3fv c loc False arr+ glUniformMatrix4fv (_, c) loc _ arr = JS.glUniformMatrix4fv c loc False arr+ glUseProgram = JS.glUseProgram . snd+ glValidateProgram = JS.glValidateProgram . snd+ glVertexAttrib1f = JS.glVertexAttrib1f . snd+ glVertexAttrib1fv = JS.glVertexAttrib1fv . snd+ glVertexAttrib2f = JS.glVertexAttrib2f . snd+ glVertexAttrib2fv = JS.glVertexAttrib2fv . snd+ glVertexAttrib3f = JS.glVertexAttrib3f . snd+ glVertexAttrib3fv = JS.glVertexAttrib3fv . snd+ glVertexAttrib4f = JS.glVertexAttrib4f . snd+ glVertexAttrib4fv = JS.glVertexAttrib4fv . snd+ glVertexAttribPointer = JS.glVertexAttribPointer . snd+ glViewport = JS.glViewport . snd++ gl_DEPTH_BUFFER_BIT = JS.gl_DEPTH_BUFFER_BIT+ gl_STENCIL_BUFFER_BIT = JS.gl_STENCIL_BUFFER_BIT+ gl_COLOR_BUFFER_BIT = JS.gl_COLOR_BUFFER_BIT+ gl_POINTS = JS.gl_POINTS+ gl_LINES = JS.gl_LINES+ gl_LINE_LOOP = JS.gl_LINE_LOOP+ gl_LINE_STRIP = JS.gl_LINE_STRIP+ gl_TRIANGLES = JS.gl_TRIANGLES+ gl_TRIANGLE_STRIP = JS.gl_TRIANGLE_STRIP+ gl_TRIANGLE_FAN = JS.gl_TRIANGLE_FAN+ gl_ZERO = JS.gl_ZERO+ gl_ONE = JS.gl_ONE+ gl_SRC_COLOR = JS.gl_SRC_COLOR+ gl_ONE_MINUS_SRC_COLOR = JS.gl_ONE_MINUS_SRC_COLOR+ gl_SRC_ALPHA = JS.gl_SRC_ALPHA+ gl_ONE_MINUS_SRC_ALPHA = JS.gl_ONE_MINUS_SRC_ALPHA+ gl_DST_ALPHA = JS.gl_DST_ALPHA+ gl_ONE_MINUS_DST_ALPHA = JS.gl_ONE_MINUS_DST_ALPHA+ gl_DST_COLOR = JS.gl_DST_COLOR+ gl_ONE_MINUS_DST_COLOR = JS.gl_ONE_MINUS_DST_COLOR+ gl_SRC_ALPHA_SATURATE = JS.gl_SRC_ALPHA_SATURATE+ gl_FUNC_ADD = JS.gl_FUNC_ADD+ gl_BLEND_EQUATION = JS.gl_BLEND_EQUATION+ gl_BLEND_EQUATION_RGB = JS.gl_BLEND_EQUATION_RGB+ gl_BLEND_EQUATION_ALPHA = JS.gl_BLEND_EQUATION_ALPHA+ gl_FUNC_SUBTRACT = JS.gl_FUNC_SUBTRACT+ gl_FUNC_REVERSE_SUBTRACT = JS.gl_FUNC_REVERSE_SUBTRACT+ gl_BLEND_DST_RGB = JS.gl_BLEND_DST_RGB+ gl_BLEND_SRC_RGB = JS.gl_BLEND_SRC_RGB+ gl_BLEND_DST_ALPHA = JS.gl_BLEND_DST_ALPHA+ gl_BLEND_SRC_ALPHA = JS.gl_BLEND_SRC_ALPHA+ gl_CONSTANT_COLOR = JS.gl_CONSTANT_COLOR+ gl_ONE_MINUS_CONSTANT_COLOR = JS.gl_ONE_MINUS_CONSTANT_COLOR+ gl_CONSTANT_ALPHA = JS.gl_CONSTANT_ALPHA+ gl_ONE_MINUS_CONSTANT_ALPHA = JS.gl_ONE_MINUS_CONSTANT_ALPHA+ gl_BLEND_COLOR = JS.gl_BLEND_COLOR+ gl_ARRAY_BUFFER = JS.gl_ARRAY_BUFFER+ gl_ELEMENT_ARRAY_BUFFER = JS.gl_ELEMENT_ARRAY_BUFFER+ gl_ARRAY_BUFFER_BINDING = JS.gl_ARRAY_BUFFER_BINDING+ gl_ELEMENT_ARRAY_BUFFER_BINDING = JS.gl_ELEMENT_ARRAY_BUFFER_BINDING+ gl_STREAM_DRAW = JS.gl_STREAM_DRAW+ gl_STATIC_DRAW = JS.gl_STATIC_DRAW+ gl_DYNAMIC_DRAW = JS.gl_DYNAMIC_DRAW+ gl_BUFFER_SIZE = JS.gl_BUFFER_SIZE+ gl_BUFFER_USAGE = JS.gl_BUFFER_USAGE+ gl_CURRENT_VERTEX_ATTRIB = JS.gl_CURRENT_VERTEX_ATTRIB+ gl_FRONT = JS.gl_FRONT+ gl_BACK = JS.gl_BACK+ gl_FRONT_AND_BACK = JS.gl_FRONT_AND_BACK+ gl_CULL_FACE = JS.gl_CULL_FACE+ gl_BLEND = JS.gl_BLEND+ gl_DITHER = JS.gl_DITHER+ gl_STENCIL_TEST = JS.gl_STENCIL_TEST+ gl_DEPTH_TEST = JS.gl_DEPTH_TEST+ gl_SCISSOR_TEST = JS.gl_SCISSOR_TEST+ gl_POLYGON_OFFSET_FILL = JS.gl_POLYGON_OFFSET_FILL+ gl_SAMPLE_ALPHA_TO_COVERAGE = JS.gl_SAMPLE_ALPHA_TO_COVERAGE+ gl_SAMPLE_COVERAGE = JS.gl_SAMPLE_COVERAGE+ gl_NO_ERROR = JS.gl_NO_ERROR+ gl_INVALID_ENUM = JS.gl_INVALID_ENUM+ gl_INVALID_VALUE = JS.gl_INVALID_VALUE+ gl_INVALID_OPERATION = JS.gl_INVALID_OPERATION+ gl_OUT_OF_MEMORY = JS.gl_OUT_OF_MEMORY+ gl_CW = JS.gl_CW+ gl_CCW = JS.gl_CCW+ gl_LINE_WIDTH = JS.gl_LINE_WIDTH+ gl_ALIASED_POINT_SIZE_RANGE = JS.gl_ALIASED_POINT_SIZE_RANGE+ gl_ALIASED_LINE_WIDTH_RANGE = JS.gl_ALIASED_LINE_WIDTH_RANGE+ gl_CULL_FACE_MODE = JS.gl_CULL_FACE_MODE+ gl_FRONT_FACE = JS.gl_FRONT_FACE+ gl_DEPTH_RANGE = JS.gl_DEPTH_RANGE+ gl_DEPTH_WRITEMASK = JS.gl_DEPTH_WRITEMASK+ gl_DEPTH_CLEAR_VALUE = JS.gl_DEPTH_CLEAR_VALUE+ gl_DEPTH_FUNC = JS.gl_DEPTH_FUNC+ gl_STENCIL_CLEAR_VALUE = JS.gl_STENCIL_CLEAR_VALUE+ gl_STENCIL_FUNC = JS.gl_STENCIL_FUNC+ gl_STENCIL_FAIL = JS.gl_STENCIL_FAIL+ gl_STENCIL_PASS_DEPTH_FAIL = JS.gl_STENCIL_PASS_DEPTH_FAIL+ gl_STENCIL_PASS_DEPTH_PASS = JS.gl_STENCIL_PASS_DEPTH_PASS+ gl_STENCIL_REF = JS.gl_STENCIL_REF+ gl_STENCIL_VALUE_MASK = JS.gl_STENCIL_VALUE_MASK+ gl_STENCIL_WRITEMASK = JS.gl_STENCIL_WRITEMASK+ gl_STENCIL_BACK_FUNC = JS.gl_STENCIL_BACK_FUNC+ gl_STENCIL_BACK_FAIL = JS.gl_STENCIL_BACK_FAIL+ gl_STENCIL_BACK_PASS_DEPTH_FAIL = JS.gl_STENCIL_BACK_PASS_DEPTH_FAIL+ gl_STENCIL_BACK_PASS_DEPTH_PASS = JS.gl_STENCIL_BACK_PASS_DEPTH_PASS+ gl_STENCIL_BACK_REF = JS.gl_STENCIL_BACK_REF+ gl_STENCIL_BACK_VALUE_MASK = JS.gl_STENCIL_BACK_VALUE_MASK+ gl_STENCIL_BACK_WRITEMASK = JS.gl_STENCIL_BACK_WRITEMASK+ gl_VIEWPORT = JS.gl_VIEWPORT+ gl_SCISSOR_BOX = JS.gl_SCISSOR_BOX+ gl_COLOR_CLEAR_VALUE = JS.gl_COLOR_CLEAR_VALUE+ gl_COLOR_WRITEMASK = JS.gl_COLOR_WRITEMASK+ gl_UNPACK_ALIGNMENT = JS.gl_UNPACK_ALIGNMENT+ gl_PACK_ALIGNMENT = JS.gl_PACK_ALIGNMENT+ gl_MAX_TEXTURE_SIZE = JS.gl_MAX_TEXTURE_SIZE+ gl_MAX_VIEWPORT_DIMS = JS.gl_MAX_VIEWPORT_DIMS+ gl_SUBPIXEL_BITS = JS.gl_SUBPIXEL_BITS+ gl_RED_BITS = JS.gl_RED_BITS+ gl_GREEN_BITS = JS.gl_GREEN_BITS+ gl_BLUE_BITS = JS.gl_BLUE_BITS+ gl_ALPHA_BITS = JS.gl_ALPHA_BITS+ gl_DEPTH_BITS = JS.gl_DEPTH_BITS+ gl_STENCIL_BITS = JS.gl_STENCIL_BITS+ gl_POLYGON_OFFSET_UNITS = JS.gl_POLYGON_OFFSET_UNITS+ gl_POLYGON_OFFSET_FACTOR = JS.gl_POLYGON_OFFSET_FACTOR+ gl_TEXTURE_BINDING_2D = JS.gl_TEXTURE_BINDING_2D+ gl_SAMPLE_BUFFERS = JS.gl_SAMPLE_BUFFERS+ gl_SAMPLES = JS.gl_SAMPLES+ gl_SAMPLE_COVERAGE_VALUE = JS.gl_SAMPLE_COVERAGE_VALUE+ gl_SAMPLE_COVERAGE_INVERT = JS.gl_SAMPLE_COVERAGE_INVERT+ gl_COMPRESSED_TEXTURE_FORMATS = JS.gl_COMPRESSED_TEXTURE_FORMATS+ gl_DONT_CARE = JS.gl_DONT_CARE+ gl_FASTEST = JS.gl_FASTEST+ gl_NICEST = JS.gl_NICEST+ gl_GENERATE_MIPMAP_HINT = JS.gl_GENERATE_MIPMAP_HINT+ gl_BYTE = JS.gl_BYTE+ gl_UNSIGNED_BYTE = JS.gl_UNSIGNED_BYTE+ gl_SHORT = JS.gl_SHORT+ gl_UNSIGNED_SHORT = JS.gl_UNSIGNED_SHORT+ gl_INT = JS.gl_INT+ gl_UNSIGNED_INT = JS.gl_UNSIGNED_INT+ gl_FLOAT = JS.gl_FLOAT+ gl_DEPTH_COMPONENT = JS.gl_DEPTH_COMPONENT+ gl_ALPHA = JS.gl_ALPHA+ gl_RGB = JS.gl_RGB+ gl_RGBA = JS.gl_RGBA+ gl_RGBA32F = JS.gl_RGBA32F_EXT+ gl_LUMINANCE = JS.gl_LUMINANCE+ gl_LUMINANCE_ALPHA = JS.gl_LUMINANCE_ALPHA+ gl_UNSIGNED_SHORT_4_4_4_4 = JS.gl_UNSIGNED_SHORT_4_4_4_4+ gl_UNSIGNED_SHORT_5_5_5_1 = JS.gl_UNSIGNED_SHORT_5_5_5_1+ gl_UNSIGNED_SHORT_5_6_5 = JS.gl_UNSIGNED_SHORT_5_6_5+ gl_FRAGMENT_SHADER = JS.gl_FRAGMENT_SHADER+ gl_VERTEX_SHADER = JS.gl_VERTEX_SHADER+ gl_MAX_VERTEX_ATTRIBS = JS.gl_MAX_VERTEX_ATTRIBS+ gl_MAX_VERTEX_UNIFORM_VECTORS = JS.gl_MAX_VERTEX_UNIFORM_VECTORS+ gl_MAX_VARYING_VECTORS = JS.gl_MAX_VARYING_VECTORS+ gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS = JS.gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS+ gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS = JS.gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS+ gl_MAX_TEXTURE_IMAGE_UNITS = JS.gl_MAX_TEXTURE_IMAGE_UNITS+ gl_MAX_FRAGMENT_UNIFORM_VECTORS = JS.gl_MAX_FRAGMENT_UNIFORM_VECTORS+ gl_SHADER_TYPE = JS.gl_SHADER_TYPE+ gl_DELETE_STATUS = JS.gl_DELETE_STATUS+ gl_LINK_STATUS = JS.gl_LINK_STATUS+ gl_VALIDATE_STATUS = JS.gl_VALIDATE_STATUS+ gl_ATTACHED_SHADERS = JS.gl_ATTACHED_SHADERS+ gl_ACTIVE_UNIFORMS = JS.gl_ACTIVE_UNIFORMS+ gl_ACTIVE_ATTRIBUTES = JS.gl_ACTIVE_ATTRIBUTES+ gl_SHADING_LANGUAGE_VERSION = JS.gl_SHADING_LANGUAGE_VERSION+ gl_CURRENT_PROGRAM = JS.gl_CURRENT_PROGRAM+ gl_NEVER = JS.gl_NEVER+ gl_LESS = JS.gl_LESS+ gl_EQUAL = JS.gl_EQUAL+ gl_LEQUAL = JS.gl_LEQUAL+ gl_GREATER = JS.gl_GREATER+ gl_NOTEQUAL = JS.gl_NOTEQUAL+ gl_GEQUAL = JS.gl_GEQUAL+ gl_ALWAYS = JS.gl_ALWAYS+ gl_KEEP = JS.gl_KEEP+ gl_REPLACE = JS.gl_REPLACE+ gl_INCR = JS.gl_INCR+ gl_DECR = JS.gl_DECR+ gl_INVERT = JS.gl_INVERT+ gl_INCR_WRAP = JS.gl_INCR_WRAP+ gl_DECR_WRAP = JS.gl_DECR_WRAP+ gl_VENDOR = JS.gl_VENDOR+ gl_RENDERER = JS.gl_RENDERER+ gl_VERSION = JS.gl_VERSION+ gl_NEAREST = JS.gl_NEAREST+ gl_LINEAR = JS.gl_LINEAR+ gl_NEAREST_MIPMAP_NEAREST = JS.gl_NEAREST_MIPMAP_NEAREST+ gl_LINEAR_MIPMAP_NEAREST = JS.gl_LINEAR_MIPMAP_NEAREST+ gl_NEAREST_MIPMAP_LINEAR = JS.gl_NEAREST_MIPMAP_LINEAR+ gl_LINEAR_MIPMAP_LINEAR = JS.gl_LINEAR_MIPMAP_LINEAR+ gl_TEXTURE_MAG_FILTER = JS.gl_TEXTURE_MAG_FILTER+ gl_TEXTURE_MIN_FILTER = JS.gl_TEXTURE_MIN_FILTER+ gl_TEXTURE_WRAP_S = JS.gl_TEXTURE_WRAP_S+ gl_TEXTURE_WRAP_T = JS.gl_TEXTURE_WRAP_T+ gl_TEXTURE_2D = JS.gl_TEXTURE_2D+ gl_TEXTURE = JS.gl_TEXTURE+ gl_TEXTURE_CUBE_MAP = JS.gl_TEXTURE_CUBE_MAP+ gl_TEXTURE_BINDING_CUBE_MAP = JS.gl_TEXTURE_BINDING_CUBE_MAP+ gl_TEXTURE_CUBE_MAP_POSITIVE_X = JS.gl_TEXTURE_CUBE_MAP_POSITIVE_X+ gl_TEXTURE_CUBE_MAP_NEGATIVE_X = JS.gl_TEXTURE_CUBE_MAP_NEGATIVE_X+ gl_TEXTURE_CUBE_MAP_POSITIVE_Y = JS.gl_TEXTURE_CUBE_MAP_POSITIVE_Y+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Y = JS.gl_TEXTURE_CUBE_MAP_NEGATIVE_Y+ gl_TEXTURE_CUBE_MAP_POSITIVE_Z = JS.gl_TEXTURE_CUBE_MAP_POSITIVE_Z+ gl_TEXTURE_CUBE_MAP_NEGATIVE_Z = JS.gl_TEXTURE_CUBE_MAP_NEGATIVE_Z+ gl_MAX_CUBE_MAP_TEXTURE_SIZE = JS.gl_MAX_CUBE_MAP_TEXTURE_SIZE+ gl_TEXTURE0 = JS.gl_TEXTURE0+ gl_TEXTURE1 = JS.gl_TEXTURE1+ gl_TEXTURE2 = JS.gl_TEXTURE2+ gl_TEXTURE3 = JS.gl_TEXTURE3+ gl_TEXTURE4 = JS.gl_TEXTURE4+ gl_TEXTURE5 = JS.gl_TEXTURE5+ gl_TEXTURE6 = JS.gl_TEXTURE6+ gl_TEXTURE7 = JS.gl_TEXTURE7+ gl_TEXTURE8 = JS.gl_TEXTURE8+ gl_TEXTURE9 = JS.gl_TEXTURE9+ gl_TEXTURE10 = JS.gl_TEXTURE10+ gl_TEXTURE11 = JS.gl_TEXTURE11+ gl_TEXTURE12 = JS.gl_TEXTURE12+ gl_TEXTURE13 = JS.gl_TEXTURE13+ gl_TEXTURE14 = JS.gl_TEXTURE14+ gl_TEXTURE15 = JS.gl_TEXTURE15+ gl_TEXTURE16 = JS.gl_TEXTURE16+ gl_TEXTURE17 = JS.gl_TEXTURE17+ gl_TEXTURE18 = JS.gl_TEXTURE18+ gl_TEXTURE19 = JS.gl_TEXTURE19+ gl_TEXTURE20 = JS.gl_TEXTURE20+ gl_TEXTURE21 = JS.gl_TEXTURE21+ gl_TEXTURE22 = JS.gl_TEXTURE22+ gl_TEXTURE23 = JS.gl_TEXTURE23+ gl_TEXTURE24 = JS.gl_TEXTURE24+ gl_TEXTURE25 = JS.gl_TEXTURE25+ gl_TEXTURE26 = JS.gl_TEXTURE26+ gl_TEXTURE27 = JS.gl_TEXTURE27+ gl_TEXTURE28 = JS.gl_TEXTURE28+ gl_TEXTURE29 = JS.gl_TEXTURE29+ gl_TEXTURE30 = JS.gl_TEXTURE30+ gl_TEXTURE31 = JS.gl_TEXTURE31+ gl_ACTIVE_TEXTURE = JS.gl_ACTIVE_TEXTURE+ gl_REPEAT = JS.gl_REPEAT+ gl_CLAMP_TO_EDGE = JS.gl_CLAMP_TO_EDGE+ gl_MIRRORED_REPEAT = JS.gl_MIRRORED_REPEAT+ gl_FLOAT_VEC2 = JS.gl_FLOAT_VEC2+ gl_FLOAT_VEC3 = JS.gl_FLOAT_VEC3+ gl_FLOAT_VEC4 = JS.gl_FLOAT_VEC4+ gl_INT_VEC2 = JS.gl_INT_VEC2+ gl_INT_VEC3 = JS.gl_INT_VEC3+ gl_INT_VEC4 = JS.gl_INT_VEC4+ gl_BOOL = JS.gl_BOOL+ gl_BOOL_VEC2 = JS.gl_BOOL_VEC2+ gl_BOOL_VEC3 = JS.gl_BOOL_VEC3+ gl_BOOL_VEC4 = JS.gl_BOOL_VEC4+ gl_FLOAT_MAT2 = JS.gl_FLOAT_MAT2+ gl_FLOAT_MAT3 = JS.gl_FLOAT_MAT3+ gl_FLOAT_MAT4 = JS.gl_FLOAT_MAT4+ gl_SAMPLER_2D = JS.gl_SAMPLER_2D+ gl_SAMPLER_CUBE = JS.gl_SAMPLER_CUBE+ gl_VERTEX_ATTRIB_ARRAY_ENABLED = JS.gl_VERTEX_ATTRIB_ARRAY_ENABLED+ gl_VERTEX_ATTRIB_ARRAY_SIZE = JS.gl_VERTEX_ATTRIB_ARRAY_SIZE+ gl_VERTEX_ATTRIB_ARRAY_STRIDE = JS.gl_VERTEX_ATTRIB_ARRAY_STRIDE+ gl_VERTEX_ATTRIB_ARRAY_TYPE = JS.gl_VERTEX_ATTRIB_ARRAY_TYPE+ gl_VERTEX_ATTRIB_ARRAY_NORMALIZED = JS.gl_VERTEX_ATTRIB_ARRAY_NORMALIZED+ gl_VERTEX_ATTRIB_ARRAY_POINTER = JS.gl_VERTEX_ATTRIB_ARRAY_POINTER+ gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = JS.gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING+ gl_COMPILE_STATUS = JS.gl_COMPILE_STATUS+ gl_LOW_FLOAT = JS.gl_LOW_FLOAT+ gl_MEDIUM_FLOAT = JS.gl_MEDIUM_FLOAT+ gl_HIGH_FLOAT = JS.gl_HIGH_FLOAT+ gl_LOW_INT = JS.gl_LOW_INT+ gl_MEDIUM_INT = JS.gl_MEDIUM_INT+ gl_HIGH_INT = JS.gl_HIGH_INT+ gl_FRAMEBUFFER = JS.gl_FRAMEBUFFER+ gl_RENDERBUFFER = JS.gl_RENDERBUFFER+ gl_RGBA4 = JS.gl_RGBA4+ gl_RGB5_A1 = JS.gl_RGB5_A1+ gl_RGB565 = JS.gl_RGB565+ gl_DEPTH_COMPONENT16 = JS.gl_DEPTH_COMPONENT16+ gl_STENCIL_INDEX8 = JS.gl_STENCIL_INDEX8+ gl_RENDERBUFFER_WIDTH = JS.gl_RENDERBUFFER_WIDTH+ gl_RENDERBUFFER_HEIGHT = JS.gl_RENDERBUFFER_HEIGHT+ gl_RENDERBUFFER_INTERNAL_FORMAT = JS.gl_RENDERBUFFER_INTERNAL_FORMAT+ gl_RENDERBUFFER_RED_SIZE = JS.gl_RENDERBUFFER_RED_SIZE+ gl_RENDERBUFFER_GREEN_SIZE = JS.gl_RENDERBUFFER_GREEN_SIZE+ gl_RENDERBUFFER_BLUE_SIZE = JS.gl_RENDERBUFFER_BLUE_SIZE+ gl_RENDERBUFFER_ALPHA_SIZE = JS.gl_RENDERBUFFER_ALPHA_SIZE+ gl_RENDERBUFFER_DEPTH_SIZE = JS.gl_RENDERBUFFER_DEPTH_SIZE+ gl_RENDERBUFFER_STENCIL_SIZE = JS.gl_RENDERBUFFER_STENCIL_SIZE+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE = JS.gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE+ gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME = JS.gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL = JS.gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL+ gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE = JS.gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE+ gl_MAX_DRAW_BUFFERS = JS.gl_MAX_DRAW_BUFFERS_WEBGL+ gl_DRAW_BUFFER0 = JS.gl_DRAW_BUFFER0_WEBGL+ gl_DRAW_BUFFER1 = JS.gl_DRAW_BUFFER1_WEBGL+ gl_DRAW_BUFFER2 = JS.gl_DRAW_BUFFER2_WEBGL+ gl_DRAW_BUFFER3 = JS.gl_DRAW_BUFFER3_WEBGL+ gl_DRAW_BUFFER4 = JS.gl_DRAW_BUFFER4_WEBGL+ gl_DRAW_BUFFER5 = JS.gl_DRAW_BUFFER5_WEBGL+ gl_DRAW_BUFFER6 = JS.gl_DRAW_BUFFER6_WEBGL+ gl_DRAW_BUFFER7 = JS.gl_DRAW_BUFFER7_WEBGL+ gl_DRAW_BUFFER8 = JS.gl_DRAW_BUFFER8_WEBGL+ gl_DRAW_BUFFER9 = JS.gl_DRAW_BUFFER9_WEBGL+ gl_DRAW_BUFFER10 = JS.gl_DRAW_BUFFER10_WEBGL+ gl_DRAW_BUFFER11 = JS.gl_DRAW_BUFFER11_WEBGL+ gl_DRAW_BUFFER12 = JS.gl_DRAW_BUFFER12_WEBGL+ gl_DRAW_BUFFER13 = JS.gl_DRAW_BUFFER13_WEBGL+ gl_DRAW_BUFFER14 = JS.gl_DRAW_BUFFER14_WEBGL+ gl_DRAW_BUFFER15 = JS.gl_DRAW_BUFFER15_WEBGL+ gl_MAX_COLOR_ATTACHMENTS = JS.gl_MAX_COLOR_ATTACHMENTS_WEBGL+ gl_COLOR_ATTACHMENT1 = JS.gl_COLOR_ATTACHMENT1_WEBGL+ gl_COLOR_ATTACHMENT2 = JS.gl_COLOR_ATTACHMENT2_WEBGL+ gl_COLOR_ATTACHMENT3 = JS.gl_COLOR_ATTACHMENT3_WEBGL+ gl_COLOR_ATTACHMENT4 = JS.gl_COLOR_ATTACHMENT4_WEBGL+ gl_COLOR_ATTACHMENT5 = JS.gl_COLOR_ATTACHMENT5_WEBGL+ gl_COLOR_ATTACHMENT6 = JS.gl_COLOR_ATTACHMENT6_WEBGL+ gl_COLOR_ATTACHMENT7 = JS.gl_COLOR_ATTACHMENT7_WEBGL+ gl_COLOR_ATTACHMENT8 = JS.gl_COLOR_ATTACHMENT8_WEBGL+ gl_COLOR_ATTACHMENT9 = JS.gl_COLOR_ATTACHMENT9_WEBGL+ gl_COLOR_ATTACHMENT10 = JS.gl_COLOR_ATTACHMENT10_WEBGL+ gl_COLOR_ATTACHMENT11 = JS.gl_COLOR_ATTACHMENT11_WEBGL+ gl_COLOR_ATTACHMENT12 = JS.gl_COLOR_ATTACHMENT12_WEBGL+ gl_COLOR_ATTACHMENT13 = JS.gl_COLOR_ATTACHMENT13_WEBGL+ gl_COLOR_ATTACHMENT14 = JS.gl_COLOR_ATTACHMENT14_WEBGL+ gl_COLOR_ATTACHMENT15 = JS.gl_COLOR_ATTACHMENT15_WEBGL+ gl_COLOR_ATTACHMENT0 = JS.gl_COLOR_ATTACHMENT0+ gl_DEPTH_ATTACHMENT = JS.gl_DEPTH_ATTACHMENT+ gl_STENCIL_ATTACHMENT = JS.gl_STENCIL_ATTACHMENT+ gl_NONE = JS.gl_NONE+ gl_FRAMEBUFFER_COMPLETE = JS.gl_FRAMEBUFFER_COMPLETE+ gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = JS.gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT+ gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT = JS.gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT+ gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS = JS.gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS+ gl_FRAMEBUFFER_UNSUPPORTED = JS.gl_FRAMEBUFFER_UNSUPPORTED+ gl_FRAMEBUFFER_BINDING = JS.gl_FRAMEBUFFER_BINDING+ gl_RENDERBUFFER_BINDING = JS.gl_RENDERBUFFER_BINDING+ gl_MAX_RENDERBUFFER_SIZE = JS.gl_MAX_RENDERBUFFER_SIZE+ gl_INVALID_FRAMEBUFFER_OPERATION = JS.gl_INVALID_FRAMEBUFFER_OPERATION
+ Graphics/Rendering/Ombra/Backend/WebGL/Const.hs view
@@ -0,0 +1,1004 @@+module Graphics.Rendering.Ombra.Backend.WebGL.Const where++gl_DEPTH_BUFFER_BIT :: Num a => a+gl_DEPTH_BUFFER_BIT = 0x00000100++gl_STENCIL_BUFFER_BIT :: Num a => a+gl_STENCIL_BUFFER_BIT = 0x00000400++gl_COLOR_BUFFER_BIT :: Num a => a+gl_COLOR_BUFFER_BIT = 0x00004000++gl_POINTS :: Num a => a+gl_POINTS = 0x0000++gl_LINES :: Num a => a+gl_LINES = 0x0001++gl_LINE_LOOP :: Num a => a+gl_LINE_LOOP = 0x0002++gl_LINE_STRIP :: Num a => a+gl_LINE_STRIP = 0x0003++gl_TRIANGLES :: Num a => a+gl_TRIANGLES = 0x0004++gl_TRIANGLE_STRIP :: Num a => a+gl_TRIANGLE_STRIP = 0x0005++gl_TRIANGLE_FAN :: Num a => a+gl_TRIANGLE_FAN = 0x0006++gl_ZERO :: Num a => a+gl_ZERO = 0++gl_ONE :: Num a => a+gl_ONE = 1++gl_SRC_COLOR :: Num a => a+gl_SRC_COLOR = 0x0300++gl_ONE_MINUS_SRC_COLOR :: Num a => a+gl_ONE_MINUS_SRC_COLOR = 0x0301++gl_SRC_ALPHA :: Num a => a+gl_SRC_ALPHA = 0x0302++gl_ONE_MINUS_SRC_ALPHA :: Num a => a+gl_ONE_MINUS_SRC_ALPHA = 0x0303++gl_DST_ALPHA :: Num a => a+gl_DST_ALPHA = 0x0304++gl_ONE_MINUS_DST_ALPHA :: Num a => a+gl_ONE_MINUS_DST_ALPHA = 0x0305++gl_DST_COLOR :: Num a => a+gl_DST_COLOR = 0x0306++gl_ONE_MINUS_DST_COLOR :: Num a => a+gl_ONE_MINUS_DST_COLOR = 0x0307++gl_SRC_ALPHA_SATURATE :: Num a => a+gl_SRC_ALPHA_SATURATE = 0x0308++gl_FUNC_ADD :: Num a => a+gl_FUNC_ADD = 0x8006++gl_BLEND_EQUATION :: Num a => a+gl_BLEND_EQUATION = 0x8009++gl_BLEND_EQUATION_RGB :: Num a => a+gl_BLEND_EQUATION_RGB = 0x8009 ++gl_BLEND_EQUATION_ALPHA :: Num a => a+gl_BLEND_EQUATION_ALPHA = 0x883D++gl_FUNC_SUBTRACT :: Num a => a+gl_FUNC_SUBTRACT = 0x800A++gl_FUNC_REVERSE_SUBTRACT :: Num a => a+gl_FUNC_REVERSE_SUBTRACT = 0x800B++gl_BLEND_DST_RGB :: Num a => a+gl_BLEND_DST_RGB = 0x80C8++gl_BLEND_SRC_RGB :: Num a => a+gl_BLEND_SRC_RGB = 0x80C9++gl_BLEND_DST_ALPHA :: Num a => a+gl_BLEND_DST_ALPHA = 0x80CA++gl_BLEND_SRC_ALPHA :: Num a => a+gl_BLEND_SRC_ALPHA = 0x80CB++gl_CONSTANT_COLOR :: Num a => a+gl_CONSTANT_COLOR = 0x8001++gl_ONE_MINUS_CONSTANT_COLOR :: Num a => a+gl_ONE_MINUS_CONSTANT_COLOR = 0x8002++gl_CONSTANT_ALPHA :: Num a => a+gl_CONSTANT_ALPHA = 0x8003++gl_ONE_MINUS_CONSTANT_ALPHA :: Num a => a+gl_ONE_MINUS_CONSTANT_ALPHA = 0x8004++gl_BLEND_COLOR :: Num a => a+gl_BLEND_COLOR = 0x8005++gl_ARRAY_BUFFER :: Num a => a+gl_ARRAY_BUFFER = 0x8892++gl_ELEMENT_ARRAY_BUFFER :: Num a => a+gl_ELEMENT_ARRAY_BUFFER = 0x8893++gl_ARRAY_BUFFER_BINDING :: Num a => a+gl_ARRAY_BUFFER_BINDING = 0x8894++gl_ELEMENT_ARRAY_BUFFER_BINDING :: Num a => a+gl_ELEMENT_ARRAY_BUFFER_BINDING = 0x8895++gl_STREAM_DRAW :: Num a => a+gl_STREAM_DRAW = 0x88E0++gl_STATIC_DRAW :: Num a => a+gl_STATIC_DRAW = 0x88E4++gl_DYNAMIC_DRAW :: Num a => a+gl_DYNAMIC_DRAW = 0x88E8++gl_BUFFER_SIZE :: Num a => a+gl_BUFFER_SIZE = 0x8764++gl_BUFFER_USAGE :: Num a => a+gl_BUFFER_USAGE = 0x8765++gl_CURRENT_VERTEX_ATTRIB :: Num a => a+gl_CURRENT_VERTEX_ATTRIB = 0x8626++gl_FRONT :: Num a => a+gl_FRONT = 0x0404++gl_BACK :: Num a => a+gl_BACK = 0x0405++gl_FRONT_AND_BACK :: Num a => a+gl_FRONT_AND_BACK = 0x0408++gl_CULL_FACE :: Num a => a+gl_CULL_FACE = 0x0B44++gl_BLEND :: Num a => a+gl_BLEND = 0x0BE2++gl_DITHER :: Num a => a+gl_DITHER = 0x0BD0++gl_STENCIL_TEST :: Num a => a+gl_STENCIL_TEST = 0x0B90++gl_DEPTH_TEST :: Num a => a+gl_DEPTH_TEST = 0x0B71++gl_SCISSOR_TEST :: Num a => a+gl_SCISSOR_TEST = 0x0C11++gl_POLYGON_OFFSET_FILL :: Num a => a+gl_POLYGON_OFFSET_FILL = 0x8037++gl_SAMPLE_ALPHA_TO_COVERAGE :: Num a => a+gl_SAMPLE_ALPHA_TO_COVERAGE = 0x809E++gl_SAMPLE_COVERAGE :: Num a => a+gl_SAMPLE_COVERAGE = 0x80A0++gl_NO_ERROR :: Num a => a+gl_NO_ERROR = 0++gl_INVALID_ENUM :: Num a => a+gl_INVALID_ENUM = 0x0500++gl_INVALID_VALUE :: Num a => a+gl_INVALID_VALUE = 0x0501++gl_INVALID_OPERATION :: Num a => a+gl_INVALID_OPERATION = 0x0502++gl_OUT_OF_MEMORY :: Num a => a+gl_OUT_OF_MEMORY = 0x0505++gl_CW :: Num a => a+gl_CW = 0x0900++gl_CCW :: Num a => a+gl_CCW = 0x0901++gl_LINE_WIDTH :: Num a => a+gl_LINE_WIDTH = 0x0B21++gl_ALIASED_POINT_SIZE_RANGE :: Num a => a+gl_ALIASED_POINT_SIZE_RANGE = 0x846D++gl_ALIASED_LINE_WIDTH_RANGE :: Num a => a+gl_ALIASED_LINE_WIDTH_RANGE = 0x846E++gl_CULL_FACE_MODE :: Num a => a+gl_CULL_FACE_MODE = 0x0B45++gl_FRONT_FACE :: Num a => a+gl_FRONT_FACE = 0x0B46++gl_DEPTH_RANGE :: Num a => a+gl_DEPTH_RANGE = 0x0B70++gl_DEPTH_WRITEMASK :: Num a => a+gl_DEPTH_WRITEMASK = 0x0B72++gl_DEPTH_CLEAR_VALUE :: Num a => a+gl_DEPTH_CLEAR_VALUE = 0x0B73++gl_DEPTH_FUNC :: Num a => a+gl_DEPTH_FUNC = 0x0B74++gl_STENCIL_CLEAR_VALUE :: Num a => a+gl_STENCIL_CLEAR_VALUE = 0x0B91++gl_STENCIL_FUNC :: Num a => a+gl_STENCIL_FUNC = 0x0B92++gl_STENCIL_FAIL :: Num a => a+gl_STENCIL_FAIL = 0x0B94++gl_STENCIL_PASS_DEPTH_FAIL :: Num a => a+gl_STENCIL_PASS_DEPTH_FAIL = 0x0B95++gl_STENCIL_PASS_DEPTH_PASS :: Num a => a+gl_STENCIL_PASS_DEPTH_PASS = 0x0B96++gl_STENCIL_REF :: Num a => a+gl_STENCIL_REF = 0x0B97++gl_STENCIL_VALUE_MASK :: Num a => a+gl_STENCIL_VALUE_MASK = 0x0B93++gl_STENCIL_WRITEMASK :: Num a => a+gl_STENCIL_WRITEMASK = 0x0B98++gl_STENCIL_BACK_FUNC :: Num a => a+gl_STENCIL_BACK_FUNC = 0x8800++gl_STENCIL_BACK_FAIL :: Num a => a+gl_STENCIL_BACK_FAIL = 0x8801++gl_STENCIL_BACK_PASS_DEPTH_FAIL :: Num a => a+gl_STENCIL_BACK_PASS_DEPTH_FAIL = 0x8802++gl_STENCIL_BACK_PASS_DEPTH_PASS :: Num a => a+gl_STENCIL_BACK_PASS_DEPTH_PASS = 0x8803++gl_STENCIL_BACK_REF :: Num a => a+gl_STENCIL_BACK_REF = 0x8CA3++gl_STENCIL_BACK_VALUE_MASK :: Num a => a+gl_STENCIL_BACK_VALUE_MASK = 0x8CA4++gl_STENCIL_BACK_WRITEMASK :: Num a => a+gl_STENCIL_BACK_WRITEMASK = 0x8CA5++gl_VIEWPORT :: Num a => a+gl_VIEWPORT = 0x0BA2++gl_SCISSOR_BOX :: Num a => a+gl_SCISSOR_BOX = 0x0C10++gl_COLOR_CLEAR_VALUE :: Num a => a+gl_COLOR_CLEAR_VALUE = 0x0C22++gl_COLOR_WRITEMASK :: Num a => a+gl_COLOR_WRITEMASK = 0x0C23++gl_UNPACK_ALIGNMENT :: Num a => a+gl_UNPACK_ALIGNMENT = 0x0CF5++gl_PACK_ALIGNMENT :: Num a => a+gl_PACK_ALIGNMENT = 0x0D05++gl_MAX_TEXTURE_SIZE :: Num a => a+gl_MAX_TEXTURE_SIZE = 0x0D33++gl_MAX_VIEWPORT_DIMS :: Num a => a+gl_MAX_VIEWPORT_DIMS = 0x0D3A++gl_SUBPIXEL_BITS :: Num a => a+gl_SUBPIXEL_BITS = 0x0D50++gl_RED_BITS :: Num a => a+gl_RED_BITS = 0x0D52++gl_GREEN_BITS :: Num a => a+gl_GREEN_BITS = 0x0D53++gl_BLUE_BITS :: Num a => a+gl_BLUE_BITS = 0x0D54++gl_ALPHA_BITS :: Num a => a+gl_ALPHA_BITS = 0x0D55++gl_DEPTH_BITS :: Num a => a+gl_DEPTH_BITS = 0x0D56++gl_STENCIL_BITS :: Num a => a+gl_STENCIL_BITS = 0x0D57++gl_POLYGON_OFFSET_UNITS :: Num a => a+gl_POLYGON_OFFSET_UNITS = 0x2A00++gl_POLYGON_OFFSET_FACTOR :: Num a => a+gl_POLYGON_OFFSET_FACTOR = 0x8038++gl_TEXTURE_BINDING_2D :: Num a => a+gl_TEXTURE_BINDING_2D = 0x8069++gl_SAMPLE_BUFFERS :: Num a => a+gl_SAMPLE_BUFFERS = 0x80A8++gl_SAMPLES :: Num a => a+gl_SAMPLES = 0x80A9++gl_SAMPLE_COVERAGE_VALUE :: Num a => a+gl_SAMPLE_COVERAGE_VALUE = 0x80AA++gl_SAMPLE_COVERAGE_INVERT :: Num a => a+gl_SAMPLE_COVERAGE_INVERT = 0x80AB++gl_COMPRESSED_TEXTURE_FORMATS :: Num a => a+gl_COMPRESSED_TEXTURE_FORMATS = 0x86A3++gl_DONT_CARE :: Num a => a+gl_DONT_CARE = 0x1100++gl_FASTEST :: Num a => a+gl_FASTEST = 0x1101++gl_NICEST :: Num a => a+gl_NICEST = 0x1102++gl_GENERATE_MIPMAP_HINT :: Num a => a+gl_GENERATE_MIPMAP_HINT = 0x8192++gl_BYTE :: Num a => a+gl_BYTE = 0x1400++gl_UNSIGNED_BYTE :: Num a => a+gl_UNSIGNED_BYTE = 0x1401++gl_SHORT :: Num a => a+gl_SHORT = 0x1402++gl_UNSIGNED_SHORT :: Num a => a+gl_UNSIGNED_SHORT = 0x1403++gl_INT :: Num a => a+gl_INT = 0x1404++gl_UNSIGNED_INT :: Num a => a+gl_UNSIGNED_INT = 0x1405++gl_FLOAT :: Num a => a+gl_FLOAT = 0x1406++gl_DEPTH_COMPONENT :: Num a => a+gl_DEPTH_COMPONENT = 0x1902++gl_ALPHA :: Num a => a+gl_ALPHA = 0x1906++gl_RGB :: Num a => a+gl_RGB = 0x1907++gl_RGBA :: Num a => a+gl_RGBA = 0x1908++gl_LUMINANCE :: Num a => a+gl_LUMINANCE = 0x1909++gl_LUMINANCE_ALPHA :: Num a => a+gl_LUMINANCE_ALPHA = 0x190A++gl_UNSIGNED_SHORT_4_4_4_4 :: Num a => a+gl_UNSIGNED_SHORT_4_4_4_4 = 0x8033++gl_UNSIGNED_SHORT_5_5_5_1 :: Num a => a+gl_UNSIGNED_SHORT_5_5_5_1 = 0x8034++gl_UNSIGNED_SHORT_5_6_5 :: Num a => a+gl_UNSIGNED_SHORT_5_6_5 = 0x8363++gl_FRAGMENT_SHADER :: Num a => a+gl_FRAGMENT_SHADER = 0x8B30++gl_VERTEX_SHADER :: Num a => a+gl_VERTEX_SHADER = 0x8B31++gl_MAX_VERTEX_ATTRIBS :: Num a => a+gl_MAX_VERTEX_ATTRIBS = 0x8869++gl_MAX_VERTEX_UNIFORM_VECTORS :: Num a => a+gl_MAX_VERTEX_UNIFORM_VECTORS = 0x8DFB++gl_MAX_VARYING_VECTORS :: Num a => a+gl_MAX_VARYING_VECTORS = 0x8DFC++gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS :: Num a => a+gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS = 0x8B4D++gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS :: Num a => a+gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS = 0x8B4C++gl_MAX_TEXTURE_IMAGE_UNITS :: Num a => a+gl_MAX_TEXTURE_IMAGE_UNITS = 0x8872++gl_MAX_FRAGMENT_UNIFORM_VECTORS :: Num a => a+gl_MAX_FRAGMENT_UNIFORM_VECTORS = 0x8DFD++gl_SHADER_TYPE :: Num a => a+gl_SHADER_TYPE = 0x8B4F++gl_DELETE_STATUS :: Num a => a+gl_DELETE_STATUS = 0x8B80++gl_LINK_STATUS :: Num a => a+gl_LINK_STATUS = 0x8B82++gl_VALIDATE_STATUS :: Num a => a+gl_VALIDATE_STATUS = 0x8B83++gl_ATTACHED_SHADERS :: Num a => a+gl_ATTACHED_SHADERS = 0x8B85++gl_ACTIVE_UNIFORMS :: Num a => a+gl_ACTIVE_UNIFORMS = 0x8B86++gl_ACTIVE_ATTRIBUTES :: Num a => a+gl_ACTIVE_ATTRIBUTES = 0x8B89++gl_SHADING_LANGUAGE_VERSION :: Num a => a+gl_SHADING_LANGUAGE_VERSION = 0x8B8C++gl_CURRENT_PROGRAM :: Num a => a+gl_CURRENT_PROGRAM = 0x8B8D++gl_NEVER :: Num a => a+gl_NEVER = 0x0200++gl_LESS :: Num a => a+gl_LESS = 0x0201++gl_EQUAL :: Num a => a+gl_EQUAL = 0x0202++gl_LEQUAL :: Num a => a+gl_LEQUAL = 0x0203++gl_GREATER :: Num a => a+gl_GREATER = 0x0204++gl_NOTEQUAL :: Num a => a+gl_NOTEQUAL = 0x0205++gl_GEQUAL :: Num a => a+gl_GEQUAL = 0x0206++gl_ALWAYS :: Num a => a+gl_ALWAYS = 0x0207++gl_KEEP :: Num a => a+gl_KEEP = 0x1E00++gl_REPLACE :: Num a => a+gl_REPLACE = 0x1E01++gl_INCR :: Num a => a+gl_INCR = 0x1E02++gl_DECR :: Num a => a+gl_DECR = 0x1E03++gl_INVERT :: Num a => a+gl_INVERT = 0x150A++gl_INCR_WRAP :: Num a => a+gl_INCR_WRAP = 0x8507++gl_DECR_WRAP :: Num a => a+gl_DECR_WRAP = 0x8508++gl_VENDOR :: Num a => a+gl_VENDOR = 0x1F00++gl_RENDERER :: Num a => a+gl_RENDERER = 0x1F01++gl_VERSION :: Num a => a+gl_VERSION = 0x1F02++gl_NEAREST :: Num a => a+gl_NEAREST = 0x2600++gl_LINEAR :: Num a => a+gl_LINEAR = 0x2601++gl_NEAREST_MIPMAP_NEAREST :: Num a => a+gl_NEAREST_MIPMAP_NEAREST = 0x2700++gl_LINEAR_MIPMAP_NEAREST :: Num a => a+gl_LINEAR_MIPMAP_NEAREST = 0x2701++gl_NEAREST_MIPMAP_LINEAR :: Num a => a+gl_NEAREST_MIPMAP_LINEAR = 0x2702++gl_LINEAR_MIPMAP_LINEAR :: Num a => a+gl_LINEAR_MIPMAP_LINEAR = 0x2703++gl_TEXTURE_MAG_FILTER :: Num a => a+gl_TEXTURE_MAG_FILTER = 0x2800++gl_TEXTURE_MIN_FILTER :: Num a => a+gl_TEXTURE_MIN_FILTER = 0x2801++gl_TEXTURE_WRAP_S :: Num a => a+gl_TEXTURE_WRAP_S = 0x2802++gl_TEXTURE_WRAP_T :: Num a => a+gl_TEXTURE_WRAP_T = 0x2803++gl_TEXTURE_2D :: Num a => a+gl_TEXTURE_2D = 0x0DE1++gl_TEXTURE :: Num a => a+gl_TEXTURE = 0x1702++gl_TEXTURE_CUBE_MAP :: Num a => a+gl_TEXTURE_CUBE_MAP = 0x8513++gl_TEXTURE_BINDING_CUBE_MAP :: Num a => a+gl_TEXTURE_BINDING_CUBE_MAP = 0x8514++gl_TEXTURE_CUBE_MAP_POSITIVE_X :: Num a => a+gl_TEXTURE_CUBE_MAP_POSITIVE_X = 0x8515++gl_TEXTURE_CUBE_MAP_NEGATIVE_X :: Num a => a+gl_TEXTURE_CUBE_MAP_NEGATIVE_X = 0x8516++gl_TEXTURE_CUBE_MAP_POSITIVE_Y :: Num a => a+gl_TEXTURE_CUBE_MAP_POSITIVE_Y = 0x8517++gl_TEXTURE_CUBE_MAP_NEGATIVE_Y :: Num a => a+gl_TEXTURE_CUBE_MAP_NEGATIVE_Y = 0x8518++gl_TEXTURE_CUBE_MAP_POSITIVE_Z :: Num a => a+gl_TEXTURE_CUBE_MAP_POSITIVE_Z = 0x8519++gl_TEXTURE_CUBE_MAP_NEGATIVE_Z :: Num a => a+gl_TEXTURE_CUBE_MAP_NEGATIVE_Z = 0x851A++gl_MAX_CUBE_MAP_TEXTURE_SIZE :: Num a => a+gl_MAX_CUBE_MAP_TEXTURE_SIZE = 0x851C++gl_TEXTURE0 :: Num a => a+gl_TEXTURE0 = 0x84C0++gl_TEXTURE1 :: Num a => a+gl_TEXTURE1 = 0x84C1++gl_TEXTURE2 :: Num a => a+gl_TEXTURE2 = 0x84C2++gl_TEXTURE3 :: Num a => a+gl_TEXTURE3 = 0x84C3++gl_TEXTURE4 :: Num a => a+gl_TEXTURE4 = 0x84C4++gl_TEXTURE5 :: Num a => a+gl_TEXTURE5 = 0x84C5++gl_TEXTURE6 :: Num a => a+gl_TEXTURE6 = 0x84C6++gl_TEXTURE7 :: Num a => a+gl_TEXTURE7 = 0x84C7++gl_TEXTURE8 :: Num a => a+gl_TEXTURE8 = 0x84C8++gl_TEXTURE9 :: Num a => a+gl_TEXTURE9 = 0x84C9++gl_TEXTURE10 :: Num a => a+gl_TEXTURE10 = 0x84CA++gl_TEXTURE11 :: Num a => a+gl_TEXTURE11 = 0x84CB++gl_TEXTURE12 :: Num a => a+gl_TEXTURE12 = 0x84CC++gl_TEXTURE13 :: Num a => a+gl_TEXTURE13 = 0x84CD++gl_TEXTURE14 :: Num a => a+gl_TEXTURE14 = 0x84CE++gl_TEXTURE15 :: Num a => a+gl_TEXTURE15 = 0x84CF++gl_TEXTURE16 :: Num a => a+gl_TEXTURE16 = 0x84D0++gl_TEXTURE17 :: Num a => a+gl_TEXTURE17 = 0x84D1++gl_TEXTURE18 :: Num a => a+gl_TEXTURE18 = 0x84D2++gl_TEXTURE19 :: Num a => a+gl_TEXTURE19 = 0x84D3++gl_TEXTURE20 :: Num a => a+gl_TEXTURE20 = 0x84D4++gl_TEXTURE21 :: Num a => a+gl_TEXTURE21 = 0x84D5++gl_TEXTURE22 :: Num a => a+gl_TEXTURE22 = 0x84D6++gl_TEXTURE23 :: Num a => a+gl_TEXTURE23 = 0x84D7++gl_TEXTURE24 :: Num a => a+gl_TEXTURE24 = 0x84D8++gl_TEXTURE25 :: Num a => a+gl_TEXTURE25 = 0x84D9++gl_TEXTURE26 :: Num a => a+gl_TEXTURE26 = 0x84DA++gl_TEXTURE27 :: Num a => a+gl_TEXTURE27 = 0x84DB++gl_TEXTURE28 :: Num a => a+gl_TEXTURE28 = 0x84DC++gl_TEXTURE29 :: Num a => a+gl_TEXTURE29 = 0x84DD++gl_TEXTURE30 :: Num a => a+gl_TEXTURE30 = 0x84DE++gl_TEXTURE31 :: Num a => a+gl_TEXTURE31 = 0x84DF++gl_ACTIVE_TEXTURE :: Num a => a+gl_ACTIVE_TEXTURE = 0x84E0++gl_REPEAT :: Num a => a+gl_REPEAT = 0x2901++gl_CLAMP_TO_EDGE :: Num a => a+gl_CLAMP_TO_EDGE = 0x812F++gl_MIRRORED_REPEAT :: Num a => a+gl_MIRRORED_REPEAT = 0x8370++gl_FLOAT_VEC2 :: Num a => a+gl_FLOAT_VEC2 = 0x8B50++gl_FLOAT_VEC3 :: Num a => a+gl_FLOAT_VEC3 = 0x8B51++gl_FLOAT_VEC4 :: Num a => a+gl_FLOAT_VEC4 = 0x8B52++gl_INT_VEC2 :: Num a => a+gl_INT_VEC2 = 0x8B53++gl_INT_VEC3 :: Num a => a+gl_INT_VEC3 = 0x8B54++gl_INT_VEC4 :: Num a => a+gl_INT_VEC4 = 0x8B55++gl_BOOL :: Num a => a+gl_BOOL = 0x8B56++gl_BOOL_VEC2 :: Num a => a+gl_BOOL_VEC2 = 0x8B57++gl_BOOL_VEC3 :: Num a => a+gl_BOOL_VEC3 = 0x8B58++gl_BOOL_VEC4 :: Num a => a+gl_BOOL_VEC4 = 0x8B59++gl_FLOAT_MAT2 :: Num a => a+gl_FLOAT_MAT2 = 0x8B5A++gl_FLOAT_MAT3 :: Num a => a+gl_FLOAT_MAT3 = 0x8B5B++gl_FLOAT_MAT4 :: Num a => a+gl_FLOAT_MAT4 = 0x8B5C++gl_SAMPLER_2D :: Num a => a+gl_SAMPLER_2D = 0x8B5E++gl_SAMPLER_CUBE :: Num a => a+gl_SAMPLER_CUBE = 0x8B60++gl_VERTEX_ATTRIB_ARRAY_ENABLED :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_ENABLED = 0x8622++gl_VERTEX_ATTRIB_ARRAY_SIZE :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_SIZE = 0x8623++gl_VERTEX_ATTRIB_ARRAY_STRIDE :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_STRIDE = 0x8624++gl_VERTEX_ATTRIB_ARRAY_TYPE :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_TYPE = 0x8625++gl_VERTEX_ATTRIB_ARRAY_NORMALIZED :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_NORMALIZED = 0x886A++gl_VERTEX_ATTRIB_ARRAY_POINTER :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_POINTER = 0x8645++gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING :: Num a => a+gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = 0x889F++gl_COMPILE_STATUS :: Num a => a+gl_COMPILE_STATUS = 0x8B81++gl_LOW_FLOAT :: Num a => a+gl_LOW_FLOAT = 0x8DF0++gl_MEDIUM_FLOAT :: Num a => a+gl_MEDIUM_FLOAT = 0x8DF1++gl_HIGH_FLOAT :: Num a => a+gl_HIGH_FLOAT = 0x8DF2++gl_LOW_INT :: Num a => a+gl_LOW_INT = 0x8DF3++gl_MEDIUM_INT :: Num a => a+gl_MEDIUM_INT = 0x8DF4++gl_HIGH_INT :: Num a => a+gl_HIGH_INT = 0x8DF5++gl_FRAMEBUFFER :: Num a => a+gl_FRAMEBUFFER = 0x8D40++gl_RENDERBUFFER :: Num a => a+gl_RENDERBUFFER = 0x8D41++gl_RGBA4 :: Num a => a+gl_RGBA4 = 0x8056++gl_RGB5_A1 :: Num a => a+gl_RGB5_A1 = 0x8057++gl_RGB565 :: Num a => a+gl_RGB565 = 0x8D62++gl_DEPTH_COMPONENT16 :: Num a => a+gl_DEPTH_COMPONENT16 = 0x81A5++gl_STENCIL_INDEX :: Num a => a+gl_STENCIL_INDEX = 0x1901++gl_STENCIL_INDEX8 :: Num a => a+gl_STENCIL_INDEX8 = 0x8D48++gl_DEPTH_STENCIL :: Num a => a+gl_DEPTH_STENCIL = 0x84F9++gl_RENDERBUFFER_WIDTH :: Num a => a+gl_RENDERBUFFER_WIDTH = 0x8D42++gl_RENDERBUFFER_HEIGHT :: Num a => a+gl_RENDERBUFFER_HEIGHT = 0x8D43++gl_RENDERBUFFER_INTERNAL_FORMAT :: Num a => a+gl_RENDERBUFFER_INTERNAL_FORMAT = 0x8D44++gl_RENDERBUFFER_RED_SIZE :: Num a => a+gl_RENDERBUFFER_RED_SIZE = 0x8D50++gl_RENDERBUFFER_GREEN_SIZE :: Num a => a+gl_RENDERBUFFER_GREEN_SIZE = 0x8D51++gl_RENDERBUFFER_BLUE_SIZE :: Num a => a+gl_RENDERBUFFER_BLUE_SIZE = 0x8D52++gl_RENDERBUFFER_ALPHA_SIZE :: Num a => a+gl_RENDERBUFFER_ALPHA_SIZE = 0x8D53++gl_RENDERBUFFER_DEPTH_SIZE :: Num a => a+gl_RENDERBUFFER_DEPTH_SIZE = 0x8D54++gl_RENDERBUFFER_STENCIL_SIZE :: Num a => a+gl_RENDERBUFFER_STENCIL_SIZE = 0x8D55++gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE :: Num a => a+gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE = 0x8CD0++gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME :: Num a => a+gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME = 0x8CD1++gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL :: Num a => a+gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL = 0x8CD2++gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE :: Num a => a+gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE = 0x8CD3++gl_COLOR_ATTACHMENT0 :: Num a => a+gl_COLOR_ATTACHMENT0 = 0x8CE0++gl_DEPTH_ATTACHMENT :: Num a => a+gl_DEPTH_ATTACHMENT = 0x8D00++gl_STENCIL_ATTACHMENT :: Num a => a+gl_STENCIL_ATTACHMENT = 0x8D20++gl_DEPTH_STENCIL_ATTACHMENT :: Num a => a+gl_DEPTH_STENCIL_ATTACHMENT = 0x821A++gl_NONE :: Num a => a+gl_NONE = 0++gl_FRAMEBUFFER_COMPLETE :: Num a => a+gl_FRAMEBUFFER_COMPLETE = 0x8CD5++gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT :: Num a => a+gl_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = 0x8CD6++gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT :: Num a => a+gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT = 0x8CD7++gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS :: Num a => a+gl_FRAMEBUFFER_INCOMPLETE_DIMENSIONS = 0x8CD9++gl_FRAMEBUFFER_UNSUPPORTED :: Num a => a+gl_FRAMEBUFFER_UNSUPPORTED = 0x8CDD++gl_FRAMEBUFFER_BINDING :: Num a => a+gl_FRAMEBUFFER_BINDING = 0x8CA6++gl_RENDERBUFFER_BINDING :: Num a => a+gl_RENDERBUFFER_BINDING = 0x8CA7++gl_MAX_RENDERBUFFER_SIZE :: Num a => a+gl_MAX_RENDERBUFFER_SIZE = 0x84E8++gl_INVALID_FRAMEBUFFER_OPERATION :: Num a => a+gl_INVALID_FRAMEBUFFER_OPERATION = 0x0506++gl_UNPACK_FLIP_Y_WEBGL :: Num a => a+gl_UNPACK_FLIP_Y_WEBGL = 0x9240++gl_UNPACK_PREMULTIPLY_ALPHA_WEBGL :: Num a => a+gl_UNPACK_PREMULTIPLY_ALPHA_WEBGL = 0x9241++gl_CONTEXT_LOST_WEBGL :: Num a => a+gl_CONTEXT_LOST_WEBGL = 0x9242++gl_UNPACK_COLORSPACE_CONVERSION_WEBGL :: Num a => a+gl_UNPACK_COLORSPACE_CONVERSION_WEBGL = 0x9243++gl_BROWSER_DEFAULT_WEBGL :: Num a => a+gl_BROWSER_DEFAULT_WEBGL = 0x9244++-- WEBGL_draw_buffers++gl_COLOR_ATTACHMENT0_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT0_WEBGL = 0x8CE0++gl_COLOR_ATTACHMENT1_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT1_WEBGL = 0x8CE1++gl_COLOR_ATTACHMENT2_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT2_WEBGL = 0x8CE2++gl_COLOR_ATTACHMENT3_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT3_WEBGL = 0x8CE3++gl_COLOR_ATTACHMENT4_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT4_WEBGL = 0x8CE4++gl_COLOR_ATTACHMENT5_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT5_WEBGL = 0x8CE5++gl_COLOR_ATTACHMENT6_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT6_WEBGL = 0x8CE6++gl_COLOR_ATTACHMENT7_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT7_WEBGL = 0x8CE7++gl_COLOR_ATTACHMENT8_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT8_WEBGL = 0x8CE8++gl_COLOR_ATTACHMENT9_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT9_WEBGL = 0x8CE9++gl_COLOR_ATTACHMENT10_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT10_WEBGL = 0x8CEA++gl_COLOR_ATTACHMENT11_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT11_WEBGL = 0x8CEB++gl_COLOR_ATTACHMENT12_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT12_WEBGL = 0x8CEC++gl_COLOR_ATTACHMENT13_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT13_WEBGL = 0x8CED++gl_COLOR_ATTACHMENT14_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT14_WEBGL = 0x8CEE++gl_COLOR_ATTACHMENT15_WEBGL :: Num a => a+gl_COLOR_ATTACHMENT15_WEBGL = 0x8CEF+++gl_DRAW_BUFFER0_WEBGL :: Num a => a+gl_DRAW_BUFFER0_WEBGL = 0x8825++gl_DRAW_BUFFER1_WEBGL :: Num a => a+gl_DRAW_BUFFER1_WEBGL = 0x8826++gl_DRAW_BUFFER2_WEBGL :: Num a => a+gl_DRAW_BUFFER2_WEBGL = 0x8827++gl_DRAW_BUFFER3_WEBGL :: Num a => a+gl_DRAW_BUFFER3_WEBGL = 0x8828++gl_DRAW_BUFFER4_WEBGL :: Num a => a+gl_DRAW_BUFFER4_WEBGL = 0x8829++gl_DRAW_BUFFER5_WEBGL :: Num a => a+gl_DRAW_BUFFER5_WEBGL = 0x882A++gl_DRAW_BUFFER6_WEBGL :: Num a => a+gl_DRAW_BUFFER6_WEBGL = 0x882B++gl_DRAW_BUFFER7_WEBGL :: Num a => a+gl_DRAW_BUFFER7_WEBGL = 0x882C++gl_DRAW_BUFFER8_WEBGL :: Num a => a+gl_DRAW_BUFFER8_WEBGL = 0x882D++gl_DRAW_BUFFER9_WEBGL :: Num a => a+gl_DRAW_BUFFER9_WEBGL = 0x882E++gl_DRAW_BUFFER10_WEBGL :: Num a => a+gl_DRAW_BUFFER10_WEBGL = 0x882F++gl_DRAW_BUFFER11_WEBGL :: Num a => a+gl_DRAW_BUFFER11_WEBGL = 0x8830++gl_DRAW_BUFFER12_WEBGL :: Num a => a+gl_DRAW_BUFFER12_WEBGL = 0x8831++gl_DRAW_BUFFER13_WEBGL :: Num a => a+gl_DRAW_BUFFER13_WEBGL = 0x8832++gl_DRAW_BUFFER14_WEBGL :: Num a => a+gl_DRAW_BUFFER14_WEBGL = 0x8833++gl_DRAW_BUFFER15_WEBGL :: Num a => a+gl_DRAW_BUFFER15_WEBGL = 0x8834+++gl_MAX_COLOR_ATTACHMENTS_WEBGL :: Num a => a+gl_MAX_COLOR_ATTACHMENTS_WEBGL = 0x8CDF++gl_MAX_DRAW_BUFFERS_WEBGL :: Num a => a+gl_MAX_DRAW_BUFFERS_WEBGL = 0x8824+++-- WEBGL_color_buffer_float++gl_RGBA32F_EXT :: Num a => a+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
+ Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs view
@@ -0,0 +1,430 @@+module Graphics.Rendering.Ombra.Backend.WebGL.Raw where++import Data.Int+import Data.Word++import GHCJS.Types+import JavaScript.TypedArray+import JavaScript.TypedArray.ArrayBuffer++import Graphics.Rendering.Ombra.Backend.WebGL.Types++foreign import javascript unsafe "$1.activeTexture($2)"+ glActiveTexture :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.attachShader($2, $3)"+ glAttachShader :: Ctx -> Program -> Shader -> IO ()++foreign import javascript unsafe "$1.bindAttribLocation($2, $3, $4)"+ glBindAttribLocation :: Ctx -> Program -> Word -> JSString -> IO ()++foreign import javascript unsafe "$1.bindBuffer($2, $3)"+ glBindBuffer :: Ctx -> Word -> Buffer -> IO ()++foreign import javascript unsafe "$1.bindFramebuffer($2, $3)"+ glBindFramebuffer :: Ctx -> Word -> FrameBuffer -> IO ()++foreign import javascript unsafe "$1.bindRenderbuffer($2, $3)"+ glBindRenderbuffer :: Ctx -> Word -> RenderBuffer -> IO ()++foreign import javascript unsafe "$1.bindTexture($2, $3)"+ glBindTexture :: Ctx -> Word -> Texture -> IO ()++foreign import javascript unsafe "$1.blendColor($2, $3, $4, $5)"+ glBlendColor :: Ctx -> Float -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.blendEquation($2)"+ glBlendEquation :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.blendEquationSeparate($2, $3)"+ glBlendEquationSeparate :: Ctx -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.blendFunc($2, $3)"+ glBlendFunc :: Ctx -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.blendFuncSeparate($2, $3, $4, $5)"+ glBlendFuncSeparate :: Ctx -> Word -> Word -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.bufferData($2, $3, $4)"+ glBufferData :: Ctx -> Word -> ArrayBuffer -> Word -> IO ()++foreign import javascript unsafe "$1.bufferSubData($2, $3, $4)"+ glBufferSubData :: Ctx -> Word -> Word -> ArrayBuffer -> IO ()++foreign import javascript unsafe "$1.checkFramebufferStatus($2)"+ glCheckFramebufferStatus :: Ctx -> Word -> IO Word++foreign import javascript unsafe "$1.clear($2)"+ glClear :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.clearColor($2, $3, $4, $5)"+ glClearColor :: Ctx -> Float -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.clearDepth($2)"+ glClearDepth :: Ctx -> Float -> IO ()++foreign import javascript unsafe "$1.clearStencil($2)"+ glClearStencil :: Ctx -> Int32 -> IO ()++foreign import javascript unsafe "$1.colorMask($2, $3, $4, $5)"+ glColorMask :: Ctx -> Bool -> Bool -> Bool -> Bool -> IO ()++foreign import javascript unsafe "$1.compileShader($2)"+ glCompileShader :: Ctx -> Shader -> IO ()++foreign import javascript unsafe "$1.compressedTexImage2D($2, $3, $4, $5, $6, $7, $8)"+ glCompressedTexImage2D :: Ctx -> Word -> Int32 -> Word -> Int32 -> Int32 -> Int32 -> Uint8Array -> IO ()++foreign import javascript unsafe "$1.compressedTexSubImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+ glCompressedTexSubImage2D :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Uint8Array -> IO ()++foreign import javascript unsafe "$1.copyTexImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+ glCopyTexImage2D :: Ctx -> Word -> Int32 -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.copyTexSubImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+ glCopyTexSubImage2D :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.createBuffer()"+ glCreateBuffer :: Ctx -> IO Buffer++foreign import javascript unsafe "$1.createFramebuffer()"+ glCreateFramebuffer :: Ctx -> IO FrameBuffer++foreign import javascript unsafe "$1.createProgram()"+ glCreateProgram :: Ctx -> IO Program++foreign import javascript unsafe "$1.createRenderbuffer()"+ glCreateRenderbuffer :: Ctx -> IO RenderBuffer++foreign import javascript unsafe "$1.createShader($2)"+ glCreateShader :: Ctx -> Word -> IO Shader++foreign import javascript unsafe "$1.createTexture()"+ glCreateTexture :: Ctx -> IO Texture++foreign import javascript unsafe "$1.cullFace($2)"+ glCullFace :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.deleteBuffer($2)"+ glDeleteBuffer :: Ctx -> Buffer -> IO ()++foreign import javascript unsafe "$1.deleteFramebuffer($2)"+ glDeleteFramebuffer :: Ctx -> FrameBuffer -> IO ()++foreign import javascript unsafe "$1.deleteProgram($2)"+ glDeleteProgram :: Ctx -> Program -> IO ()++foreign import javascript unsafe "$1.deleteRenderbuffer($2)"+ glDeleteRenderbuffer :: Ctx -> RenderBuffer -> IO ()++foreign import javascript unsafe "$1.deleteShader($2)"+ glDeleteShader :: Ctx -> Shader -> IO ()++foreign import javascript unsafe "$1.deleteTexture($2)"+ glDeleteTexture :: Ctx -> Texture -> IO ()++foreign import javascript unsafe "$1.depthFunc($2)"+ glDepthFunc :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.depthMask($2)"+ glDepthMask :: Ctx -> Bool -> IO ()++foreign import javascript unsafe "$1.depthRange($2, $3)"+ glDepthRange :: Ctx -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.detachShader($2, $3)"+ glDetachShader :: Ctx -> Program -> Shader -> IO ()++foreign import javascript unsafe "$1.disable($2)"+ glDisable :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.disableVertexAttribArray($2)"+ glDisableVertexAttribArray :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.drawArrays($2, $3, $4)"+ glDrawArrays :: Ctx -> Word -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.drawElements($2, $3, $4, $5)"+ glDrawElements :: Ctx -> Word -> Int32 -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.enable($2)"+ glEnable :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.enableVertexAttribArray($2)"+ glEnableVertexAttribArray :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.finish()"+ glFinish :: Ctx -> IO ()++foreign import javascript unsafe "$1.flush()"+ glFlush :: Ctx -> IO ()++foreign import javascript unsafe "$1.framebufferRenderbuffer($2, $3, $4, $5)"+ glFramebufferRenderbuffer :: Ctx -> Word -> Word -> Word -> RenderBuffer -> IO ()++foreign import javascript unsafe "$1.framebufferTexture2D($2, $3, $4, $5, $6)"+ glFramebufferTexture2D :: Ctx -> Word -> Word -> Word -> Texture -> Int32 -> IO ()++foreign import javascript unsafe "$1.frontFace($2)"+ glFrontFace :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.generateMipmap($2)"+ glGenerateMipmap :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.getActiveAttrib($2, $3)"+ glGetActiveAttrib :: Ctx -> Program -> Word -> IO ActiveInfo++foreign import javascript unsafe "$1.getActiveUniform($2, $3)"+ glGetActiveUniform :: Ctx -> Program -> Word -> IO ActiveInfo++{-+foreign import javascript unsafe "$1.getAttachedShaders($2)"+ glGetAttachedShaders :: Ctx -> Program -> IO (Sequence Shader)+-}++foreign import javascript unsafe "$1.getAttribLocation($2, $3)"+ glGetAttribLocation :: Ctx -> Program -> JSString -> IO Int32++foreign import javascript unsafe "$1.getBufferParameter($2, $3)"+ glGetBufferParameter :: Ctx -> Word -> Word -> IO JSVal++foreign import javascript unsafe "$1.getParameter($2)"+ glGetParameter :: Ctx -> Word -> IO JSVal++foreign import javascript unsafe "$1.getError()"+ glGetError :: Ctx -> IO Word++foreign import javascript unsafe "$1.getFramebufferAttachmentParameter($2, $3)"+ glGetFramebufferAttachmentParameter :: Ctx -> Word -> Word -> IO Word++foreign import javascript unsafe "$1.getProgramInfoLog($2)"+ glGetProgramInfoLog :: Ctx -> Program -> IO JSString++foreign import javascript unsafe "$1.getRenderbufferParameter($2, $3)"+ glGetRenderbufferParameter :: Ctx -> Word -> Word -> IO JSVal++foreign import javascript unsafe "$1.getShaderParameter($2, $3)"+ glGetShaderParameter :: Ctx -> Shader -> Word -> IO JSVal++foreign import javascript unsafe "$1.getShaderPrecisionFormat($2, $3)"+ glGetShaderPrecisionFormat :: Ctx -> Word -> Word -> IO ShaderPrecisionFormat++foreign import javascript unsafe "$1.getShaderInfoLog($2)"+ glGetShaderInfoLog :: Ctx -> Shader -> IO JSString++foreign import javascript unsafe "$1.getShaderSource($2)"+ glGetShaderSource :: Ctx -> Shader -> IO JSString++foreign import javascript unsafe "$1.getTexParameter($2, $3)"+ glGetTexParameter :: Ctx -> Word -> Word -> IO JSVal++foreign import javascript unsafe "$1.getUniform($2, $3)"+ glGetUniform :: Ctx -> Program -> UniformLocation -> IO JSVal++foreign import javascript unsafe "$1.getUniformLocation($2, $3)"+ glGetUniformLocation :: Ctx -> Program -> JSString -> IO UniformLocation++foreign import javascript unsafe "$1.getVertexAttrib($2, $3)"+ glGetVertexAttrib :: Ctx -> Word -> Word -> IO JSVal++foreign import javascript unsafe "$1.getVertexAttribOffset($2, $3)"+ glGetVertexAttribOffset :: Ctx -> Word -> Word -> IO Word++foreign import javascript unsafe "$1.hint($2, $3)"+ glHint :: Ctx -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.isBuffer($2)"+ glIsBuffer :: Ctx -> Buffer -> IO Bool++foreign import javascript unsafe "$1.isEnabled($2)"+ glIsEnabled :: Ctx -> Word -> IO Bool++foreign import javascript unsafe "$1.isFramebuffer($2)"+ glIsFramebuffer :: Ctx -> FrameBuffer -> IO Bool++foreign import javascript unsafe "$1.isProgram($2)"+ glIsProgram :: Ctx -> Program -> IO Bool++foreign import javascript unsafe "$1.isRenderbuffer($2)"+ glIsRenderbuffer :: Ctx -> RenderBuffer -> IO Bool++foreign import javascript unsafe "$1.isShader($2)"+ glIsShader :: Ctx -> Shader -> IO Bool++foreign import javascript unsafe "$1.isTexture($2)"+ glIsTexture :: Ctx -> Texture -> IO Bool++foreign import javascript unsafe "$1.lineWidth($2)"+ glLineWidth :: Ctx -> Float -> IO ()++foreign import javascript unsafe "$1.linkProgram($2)"+ glLinkProgram :: Ctx -> Program -> IO ()++foreign import javascript unsafe "$1.pixelStorei($2, $3)"+ glPixelStorei :: Ctx -> Word -> Int32 -> IO ()++foreign import javascript unsafe "$1.polygonOffset($2, $3)"+ glPolygonOffset :: Ctx -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.readPixels($2, $3, $4, $5, $6, $7, $8)"+ glReadPixels :: Ctx -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Word -> Uint8Array -> IO ()++foreign import javascript unsafe "$1.renderbufferStorage($2, $3, $4, $5)"+ glRenderbufferStorage :: Ctx -> Word -> Word -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.sampleCoverage($2, $3)"+ glSampleCoverage :: Ctx -> Float -> Bool -> IO ()++foreign import javascript unsafe "$1.scissor($2, $3, $4, $5)"+ glScissor :: Ctx -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.shaderSource($2, $3)"+ glShaderSource :: Ctx -> Shader -> JSString -> IO ()++foreign import javascript unsafe "$1.stencilFunc($2, $3, $4)"+ glStencilFunc :: Ctx -> Word -> Int32 -> Word -> IO ()++foreign import javascript unsafe "$1.stencilFuncSeparate($2, $3, $4, $5)"+ glStencilFuncSeparate :: Ctx -> Word -> Word -> Int32 -> Word -> IO ()++foreign import javascript unsafe "$1.stencilMask($2)"+ glStencilMask :: Ctx -> Word -> IO ()++foreign import javascript unsafe "$1.stencilMaskSeparate($2, $3)"+ glStencilMaskSeparate :: Ctx -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.stencilOp($2, $3, $4)"+ glStencilOp :: Ctx -> Word -> Word -> Word -> IO ()++foreign import javascript unsafe "$1.stencilOpSeparate($2, $3, $4, $5)"+ 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 ()++foreign import javascript unsafe "$1.texParameterf($2, $3, $4)"+ glTexParameterf :: Ctx -> Word -> Word -> Float -> IO ()++foreign import javascript unsafe "$1.texParameteri($2, $3, $4)"+ glTexParameteri :: Ctx -> Word -> Word -> Int32 -> IO ()++foreign import javascript unsafe "$1.texSubImage2D($2, $3, $4, $5, $6, $7, $8, $9, $10)"+ glTexSubImage2D :: Ctx -> Word -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Word -> Word -> Uint8Array -> IO ()++foreign import javascript unsafe "$1.uniform1f($2, $3)"+ glUniform1f :: Ctx -> UniformLocation -> Float -> IO ()++foreign import javascript unsafe "$1.uniform1fv($2, $3)"+ glUniform1fv :: Ctx -> UniformLocation -> Float32Array -> IO ()++foreign import javascript unsafe "$1.uniform1i($2, $3)"+ glUniform1i :: Ctx -> UniformLocation -> Int32 -> IO ()++foreign import javascript unsafe "$1.uniform1iv($2, $3)"+ glUniform1iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++foreign import javascript unsafe "$1.uniform2f($2, $3, $4)"+ glUniform2f :: Ctx -> UniformLocation -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.uniform2fv($2, $3)"+ glUniform2fv :: Ctx -> UniformLocation -> Float32Array -> IO ()++foreign import javascript unsafe "$1.uniform2i($2, $3, $4)"+ glUniform2i :: Ctx -> UniformLocation -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.uniform2iv($2, $3)"+ glUniform2iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++foreign import javascript unsafe "$1.uniform3f($2, $3, $4, $5)"+ glUniform3f :: Ctx -> UniformLocation -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.uniform3fv($2, $3)"+ glUniform3fv :: Ctx -> UniformLocation -> Float32Array -> IO ()++foreign import javascript unsafe "$1.uniform3i($2, $3, $4, $5)"+ glUniform3i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.uniform3iv($2, $3)"+ glUniform3iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++foreign import javascript unsafe "$1.uniform4f($2, $3, $4, $5, $6)"+ glUniform4f :: Ctx -> UniformLocation -> Float -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.uniform4fv($2, $3)"+ glUniform4fv :: Ctx -> UniformLocation -> Float32Array -> IO ()++foreign import javascript unsafe "$1.uniform4i($2, $3, $4, $5, $6)"+ glUniform4i :: Ctx -> UniformLocation -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()++foreign import javascript unsafe "$1.uniform4iv($2, $3)"+ glUniform4iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++foreign import javascript unsafe "$1.uniformMatrix2fv($2, $3, $4)"+ glUniformMatrix2fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()++foreign import javascript unsafe "$1.uniformMatrix3fv($2, $3, $4)"+ glUniformMatrix3fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()+++foreign import javascript unsafe "$1.uniformMatrix4fv($2, $3, $4)"+ glUniformMatrix4fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()++foreign import javascript unsafe "$1.useProgram($2)"+ glUseProgram :: Ctx -> Program -> IO ()++foreign import javascript unsafe "$1.validateProgram($2)"+ glValidateProgram :: Ctx -> Program -> IO ()++foreign import javascript unsafe "$1.vertexAttrib1f($2, $3)"+ glVertexAttrib1f :: Ctx -> Word -> Float -> IO ()++foreign import javascript unsafe "$1.vertexAttrib1fv($2, $3)"+ glVertexAttrib1fv :: Ctx -> Word -> Float32Array -> IO ()++foreign import javascript unsafe "$1.vertexAttrib2f($2, $3, $4)"+ glVertexAttrib2f :: Ctx -> Word -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.vertexAttrib2fv($2, $3)"+ glVertexAttrib2fv :: Ctx -> Word -> Float32Array -> IO ()++foreign import javascript unsafe "$1.vertexAttrib3f($2, $3, $4, $5)"+ glVertexAttrib3f :: Ctx -> Word -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.vertexAttrib3fv($2, $3)"+ glVertexAttrib3fv :: Ctx -> Word -> Float32Array -> IO ()++foreign import javascript unsafe "$1.vertexAttrib4f($2, $3, $4, $5, $6)"+ glVertexAttrib4f :: Ctx -> Word -> Float -> Float -> Float -> Float -> IO ()++foreign import javascript unsafe "$1.vertexAttrib4fv($2, $3)"+ glVertexAttrib4fv :: Ctx -> Word -> Float32Array -> IO ()++foreign import javascript unsafe "$1.vertexAttribPointer($2, $3, $4, $5, $6, $7)"+ glVertexAttribPointer :: Ctx -> Word -> Int32 -> Word -> Bool -> Int32 -> Word -> IO ()++foreign import javascript unsafe "$1.viewport($2, $3, $4, $5)"+ glViewport :: Ctx -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()++-- Extensions++foreign import javascript unsafe "$1.getExtension($2)"+ getExtension :: Ctx -> JSString -> IO JSVal++-- OES_vertex_array_object++foreign import javascript unsafe "$1.vaoExt.createVertexArrayOES()"+ glCreateVertexArrayOES :: Ctx -> IO VertexArrayObject++foreign import javascript unsafe "$1.vaoExt.bindVertexArrayOES($2)"+ glBindVertexArrayOES :: Ctx -> VertexArrayObject -> IO()++foreign import javascript unsafe "$1.vaoExt.deleteVertexArrayOES($2)"+ glDeleteVertexArrayOES :: Ctx -> VertexArrayObject -> IO()++foreign import javascript unsafe "$1.vaoExt.isVertexArrayOES($2)"+ glIsVertexArrayOES :: Ctx -> VertexArrayObject -> IO Bool++-- WEBGL_draw_buffers++foreign import javascript unsafe "$1.drawBufs.drawBuffersWEBGL($2)"+ glDrawBuffersWEBGL :: Ctx -> Int32Array -> IO ()
+ Graphics/Rendering/Ombra/Backend/WebGL/Types.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++module Graphics.Rendering.Ombra.Backend.WebGL.Types (+ Ctx,+ Program,+ Shader,+ Buffer,+ FrameBuffer,+ RenderBuffer,+ VertexArrayObject,+ Texture,+ UniformLocation,+ ActiveInfo,+ ShaderPrecisionFormat,+ getCtx,+ noBuffer,+ noTexture,+ noVAO,+) where++import Data.Int (Int32)+import Data.Word (Word8, Word16)+import GHCJS.Marshal+import GHCJS.Foreign+import GHCJS.Types+import JavaScript.Array+import JavaScript.TypedArray++type Ctx = JSVal++type Program = JSVal++type Shader = JSVal++type Buffer = JSVal++type FrameBuffer = JSVal++type RenderBuffer = JSVal++type VertexArrayObject = JSVal++type Texture = JSVal++{-+instance Eq Texture where+ (==) = eqRef+-}++type UniformLocation = JSVal++type ActiveInfo = JSVal++type ShaderPrecisionFormat = JSVal++-- type ArrayBufferView = JSVal++noBuffer :: Buffer+noBuffer = jsNull++noTexture :: Texture+noTexture = jsNull++noVAO :: VertexArrayObject+noVAO = jsNull++foreign import javascript unsafe "$r = $1.getContext(\"webgl\");"+ getCtx :: JSRef a -> IO Ctx
+ Graphics/Rendering/Ombra/Blend.hs view
@@ -0,0 +1,64 @@+module Graphics.Rendering.Ombra.Blend where++import Data.Vect.Float (Vec4(..))+import Data.Vect.Float.Instances+import Graphics.Rendering.Ombra.Internal.GL++-- | Blend mode+data Mode = Mode {+ constantColor :: Maybe Vec4,+ rgbOperator :: Operator,+ rgbParameters :: Maybe (Parameter, Parameter),+ alphaOperator :: Operator,+ alphaParameters :: Maybe (Parameter, Parameter)+} deriving Eq++-- | Blend operator.+data Operator = Add | Subtract | ReverseSubtract {- Min | Max -} deriving Eq++-- | Blend function parameters.+data Parameter = Zero | One | SourceColor | DestinationColor | ConstantColor+ | SourceAlpha | DestinationAlpha | ConstantAlpha+ | OneMinus Parameter deriving Eq++-- | Standard transparency (default).+transparency :: Mode+transparency = Mode Nothing Add (Just (SourceAlpha, OneMinus SourceAlpha))+ Add (Just (SourceAlpha, OneMinus SourceAlpha))++-- | Additive blend mode.+additive :: Mode+additive = Mode Nothing Add (Just (One, One)) Add (Just (One, One))++equation :: GLES => Mode -> (GLEnum, GLEnum)+equation m = (mode $ rgbOperator m, mode $ alphaOperator m)+ where mode Add = gl_FUNC_ADD+ mode Subtract = gl_FUNC_SUBTRACT+ mode ReverseSubtract = gl_FUNC_REVERSE_SUBTRACT+ -- mode Min = gl_MIN+ -- mode Max = gl_MAX++function :: GLES => Mode -> (GLEnum, GLEnum, GLEnum, GLEnum)+function m = (rgbs, rgbd, alphas, alphad)+ where (rgbs, rgbd) = case rgbParameters m of+ Just (p, p') -> (param p, param p')+ Nothing -> (gl_ZERO, gl_ZERO)+ (alphas, alphad) = case alphaParameters m of+ Just (p, p') -> (param p, param p')+ Nothing -> (gl_ZERO, gl_ZERO)+ param Zero = gl_ZERO+ param One = gl_ONE+ param SourceColor = gl_SRC_COLOR+ param DestinationColor = gl_DST_COLOR+ param ConstantColor = gl_CONSTANT_COLOR+ param SourceAlpha = gl_SRC_ALPHA+ param DestinationAlpha = gl_DST_ALPHA+ param ConstantAlpha = gl_CONSTANT_ALPHA+ param (OneMinus Zero) = gl_ONE+ param (OneMinus One) = gl_ZERO+ param (OneMinus SourceColor) = gl_ONE_MINUS_SRC_COLOR+ param (OneMinus DestinationColor) = gl_ONE_MINUS_DST_COLOR+ param (OneMinus ConstantColor) = gl_ONE_MINUS_CONSTANT_COLOR+ param (OneMinus SourceAlpha) = gl_ONE_MINUS_SRC_ALPHA+ param (OneMinus DestinationAlpha) = gl_ONE_MINUS_DST_ALPHA+ param (OneMinus ConstantAlpha) = gl_ONE_MINUS_CONSTANT_ALPHA
+ Graphics/Rendering/Ombra/Color.hs view
@@ -0,0 +1,50 @@+module Graphics.Rendering.Ombra.Color where++import Control.Applicative+import Data.Hashable+import Data.Word (Word8)+import Foreign.Ptr (castPtr)+import Foreign.Storable++-- | An RGBA 32-bit color.+data Color = Color !Word8 !Word8 !Word8 !Word8 deriving (Eq, Show)++instance Hashable Color where+ hashWithSalt salt (Color r g b a) = hashWithSalt salt (r, g, b, a)++instance Storable Color where+ sizeOf _ = 4 * sizeOf (undefined :: Word8)+ alignment _ = alignment (undefined :: Word8)+ peek p = Color <$> peekElemOff bp 0 <*> peekElemOff bp 1+ <*> peekElemOff bp 2 <*> peekElemOff bp 3+ where bp = castPtr p+ poke p (Color r g b a) = do pokeElemOff bp 0 r+ pokeElemOff bp 1 g+ pokeElemOff bp 2 b+ pokeElemOff bp 3 a+ where bp = castPtr p++-- | Create a 'Color' with alpha set to 255.+visible :: Word8 -> Word8 -> Word8 -> Color+visible r g b = Color r g b 255++white :: Color+white = Color 255 255 255 255++black :: Color+black = Color 0 0 0 255++transparent :: Color+transparent = Color 0 0 0 0++red :: Color+red = Color 255 0 0 255++green :: Color+green = Color 0 255 0 255++blue :: Color+blue = Color 0 255 255 255++yellow :: Color+yellow = Color 255 255 0 255
+ Graphics/Rendering/Ombra/D2.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE DataKinds, FlexibleContexts, ConstraintKinds, TypeOperators,+ TypeFamilies #-}++{-| Simplified 2D graphics system. -}+module Graphics.Rendering.Ombra.D2 (+ module Graphics.Rendering.Ombra.Generic,+ module Data.Vect.Float,+ -- * 2D Objects and Groups+ Object2D,+ IsObject2D,+ Group2D,+ IsGroup2D,+ rect,+ image,+ sprite,+ depth,+ -- ** Geometry+ Geometry2D,+ poly,+ mkGeometry2D,+ -- * Transformations+ trans,+ rot,+ scale,+ scaleV,+ scaleTex,+ scaleTexAR,+ transform,+ -- * Layers+ view,+ viewScreen,+ viewVP,+ layerS,+ -- * Transformation matrices+ transMat3,+ rotMat3,+ scaleMat3,+ screenMat3,+ -- * Uniforms+ Uniforms2D,+ Image(..),+ Depth(..),+ Transform2(..),+ View2(..),+) where++import Control.Applicative+import Data.Vect.Float+import Graphics.Rendering.Ombra.Backend hiding (Texture, Image, 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.Internal.TList+import Graphics.Rendering.Ombra.Shader.Default2D (Image(..), Depth(..), Transform2(..), View2(..))+import Graphics.Rendering.Ombra.Shader.Program+import Graphics.Rendering.Ombra.Transformation++type Uniforms2D = '[Image, Depth, Transform2]++-- | A standard 2D object.+type Object2D = Object Uniforms2D Geometry2D++-- | A standard 2D object group.+type Group2D = Group (View2 ': Uniforms2D) Geometry2D++-- | 2D objects compatible with the standard 2D shader program.+type IsObject2D globals inputs = ( Subset Geometry2D inputs+ , Subset Uniforms2D globals+ , Set inputs, Set 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 )++-- | 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 t g = globalTexture Image t :~>+ Depth -= 0 :~>+ Transform2 -= idmtx :~>+ geom g++-- | A rectangle with the aspect ratio adapted to its texture.+image :: GLES => Texture -> Object2D+image t = scaleTexAR t $ rect t++-- | Set the depth of a 2D 'Object'.+depth :: (MemberGlobal Depth gs, GLES)+ => Float -> Object gs is -> Object gs is+depth d obj = const (Depth -= d) ~~> obj++-- | A rectangle with the size and aspect ratio adapted to the screen, assuming+-- that you're using 'viewScreen' or 'screenMat3'.+sprite :: GLES => Texture -> Object2D+sprite t = scaleTex t $ rect t++-- | Create a group of objects with a view matrix.+view :: (Set gs, Set 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)+ => 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)+ => (Vec2 -> Mat3) -> [Object gs is] -> Group (View2 ': gs) is+viewVP mf = globalGroup (globalFramebufferSize View2 mf) . group++-- | A 'Layer' with the standard 2D program.+layerS :: IsGroup2D gs is => Group gs is -> Layer+layerS = layer defaultProgram2D++-- | Translate a 2D 'Object'.+trans :: (MemberGlobal Transform2 gs, GLES)+ => Vec2 -> Object gs is -> Object gs is+trans v = transform $ transMat3 v++-- | Rotate a 2D 'Object'.+rot :: (MemberGlobal Transform2 gs, GLES)+ => Float -> Object gs is -> Object gs is+rot a = transform $ rotMat3 a++-- | Scale a 2D 'Object'.+scale :: (MemberGlobal Transform2 gs, GLES)+ => Float -> Object gs is -> Object gs is+scale f = transform $ scaleMat3 (Vec2 f f)++-- | Scale a 2D 'Object' in two dimensions.+scaleV :: (MemberGlobal Transform2 gs, GLES)+ => Vec2 -> Object gs is -> Object gs is+scaleV v = transform $ scaleMat3 v++-- | Scale an 'Object' so that it has the same size as the 'Texture', assuming+-- 'viewScreen' or 'screenMat3'.+scaleTex :: (MemberGlobal Transform2 gs, GLES)+ => Texture -> Object gs is -> Object gs is+scaleTex t = transformDraw $+ (\(w, h) -> scaleMat3 $ Vec2 w h) <$> textureSize t++-- | Scale an 'Object' so that it has the same aspect ratio as the 'Texture'+-- +-- > scaleV $ Vec2 1 (texture height / texture width).+scaleTexAR :: (MemberGlobal Transform2 gs, GLES)+ => Texture -> Object gs is -> Object gs is+scaleTexAR t = transformDraw $+ (\(w, h) -> scaleMat3 $ Vec2 1 (h / w)) <$> textureSize t++-- | Transform a 2D 'Object'.+transform :: (MemberGlobal Transform2 gs, GLES)+ => Mat3 -> Object gs is -> Object gs is+transform m' o = (\m -> Transform2 := (.*. m') <$> m) ~~> o++-- | Transform a 2D 'Object'.+transformDraw :: (MemberGlobal Transform2 gs, GLES)+ => Draw Mat3 -> Object gs is -> Object gs is+transformDraw m' o = (\m -> Transform2 := (.*.) <$> m <*> m') ~~> o++-- | Convert the screen coordinates to GL coordinates.+screenMat3 :: Vec2 -- ^ Viewport size.+ -> Mat3+screenMat3 (Vec2 w h) = Mat3 (Vec3 (2 / w) 0 0 )+ (Vec3 0 (- 2 / h) 0 )+ (Vec3 (- 1) 1 1 )
+ Graphics/Rendering/Ombra/D3.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DataKinds, FlexibleContexts, ConstraintKinds, TypeOperators,+ TypeFamilies, MultiParamTypeClasses, FlexibleInstances,+ UndecidableInstances #-}++{-| Simplified 3D graphics system. -}+module Graphics.Rendering.Ombra.D3 (+ module Graphics.Rendering.Ombra.Generic,+ module Data.Vect.Float,+ -- * 3D Objects+ Object3D,+ IsObject3D,+ Group3D,+ IsGroup3D,+ cube,+ -- ** Geometry+ Geometry3D,+ mesh,+ mkGeometry3D,+ -- * Transformations+ trans,+ rotX,+ rotY,+ rotZ,+ rot,+ scale,+ scaleV,+ transform,+ -- * Layers+ view,+ viewPersp,+ viewOrtho,+ viewVP,+ layerS,+ -- * Matrices+ -- ** View matrices+ perspectiveMat4,+ perspectiveMat4Size,+ orthoMat4,+ cameraMat4,+ lookAtMat4,+ -- ** Transformation matrices+ transMat4,+ rotXMat4,+ rotYMat4,+ rotZMat4,+ rotMat4,+ scaleMat4,+ -- * Uniforms+ Uniforms3D,+ Texture2(..),+ Transform3(..),+ View3(..),+) where++import Control.Applicative+import Data.Vect.Float+import Graphics.Rendering.Ombra.Backend hiding (Texture, Program)+import Graphics.Rendering.Ombra.Geometry+import Graphics.Rendering.Ombra.Color+import Graphics.Rendering.Ombra.Draw+import Graphics.Rendering.Ombra.Generic+import Graphics.Rendering.Ombra.Shapes+import Graphics.Rendering.Ombra.Types+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]++-- | A standard 3D object.+type Object3D = Object Uniforms3D Geometry3D++-- | A standard 3D group.+type Group3D = Group (View3 ': Uniforms3D) Geometry3D++-- | 3D objects compatible with the standard 3D shader program.+type IsObject3D globals inputs = ( Subset Geometry3D inputs+ , Subset Uniforms3D globals+ , Set inputs, Set 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 )++-- | 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 t g = Transform3 -= idmtx :~> globalTexture Texture2 t :~> geom g++-- | Create a group of objects with a view matrix.+view :: (GLES, Set gs, Set 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)+ => Float -- ^ Near+ -> Float -- ^ Far+ -> Float -- ^ FOV+ -> Mat4 -- ^ View matrix+ -> [Object gs is] -> Group (View3 ': gs) is+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)+ => Float -- ^ Near+ -> Float -- ^ Far+ -> Float -- ^ Left+ -> Float -- ^ Right+ -> Float -- ^ Bottom+ -> Float -- ^ Top+ -> Mat4 -- ^ View matrix+ -> [Object gs is] -> Group (View3 ': gs) is+viewOrtho n f l r b t m = view $ m .*. orthoMat4 n f l r b t++-- | Create a group of objects with a view matrix, depending on the size of the+-- framebuffer.+viewVP :: (GLES, Set gs, Set is)+ => (Vec2 -> Mat4) -> [Object gs is] -> Group (View3 ': gs) is+viewVP mf = globalGroup (globalFramebufferSize View3 mf) . group++-- | A 'Layer' with the standard 3D program.+layerS :: IsGroup3D gs is => Group gs is -> Layer+layerS = layer defaultProgram3D++-- | Translate a 3D Object.+trans :: (MemberGlobal Transform3 gs, GLES) => Vec3+ -> Object gs is -> Object gs is+trans v = transform $ transMat4 v++-- | Rotate a 3D 'Object' around the X axis.+rotX :: (MemberGlobal Transform3 gs, GLES) => Float+ -> Object gs is -> Object gs is+rotX a = transform $ rotXMat4 a++-- | Rotate a 3D 'Object' around the Y axis.+rotY :: (MemberGlobal Transform3 gs, GLES) => Float+ -> Object gs is -> Object gs is+rotY a = transform $ rotYMat4 a++-- | Rotate a 3D 'Object' around the Z axis.+rotZ :: (MemberGlobal Transform3 gs, GLES) => Float+ -> Object gs is -> Object gs is+rotZ a = transform $ rotZMat4 a++-- | Rotate a 3D 'Object' around a vector.+rot :: (MemberGlobal Transform3 gs, GLES) => Vec3+ -> Float+ -> Object gs is -> Object gs is+rot ax ag = transform $ rotMat4 ax ag++-- | Scale a 3D 'Object'.+scale :: (MemberGlobal Transform3 gs, GLES) => Float+ -> Object gs is -> Object gs is+scale f = transform $ scaleMat4 (Vec3 f f f)++-- | Scale a 3D 'Object' in three dimensions.+scaleV :: (MemberGlobal Transform3 gs, GLES) => Vec3+ -> Object gs is -> Object gs is+scaleV v = transform $ scaleMat4 v++-- | Transform a 3D 'Object'.+transform :: (MemberGlobal Transform3 gs, GLES) => Mat4+ -> Object gs is -> Object gs is+transform m' o = (\m -> Transform3 := (.*. m') <$> m) ~~> o++-- | 4x4 perspective projection matrix, using width and height instead of the+-- aspect ratio.+perspectiveMat4Size :: Float -- ^ Near+ -> Float -- ^ Far+ -> Float -- ^ FOV+ -> Vec2 -- ^ Viewport size+ -> Mat4+perspectiveMat4Size n f fov (Vec2 w h) = perspectiveMat4 n f fov $ w / h
+ Graphics/Rendering/Ombra/Draw.hs view
@@ -0,0 +1,45 @@+module Graphics.Rendering.Ombra.Draw (+ refDrawCtx,+ runDrawCtx,+ execDrawCtx,+ evalDrawCtx,+ drawInit,+ drawState,+ drawBegin,+ drawLayer,+ drawEnd,+ drawGet,+ removeGeometry,+ removeTexture,+ removeProgram,+ textureUniform,+ textureSize,+ resizeViewport,+ renderLayer,+ gl+) where++import Data.IORef+import Graphics.Rendering.Ombra.Draw.Internal+import Graphics.Rendering.Ombra.Internal.GL++-- | Run a Draw action using an IORef and a context.+refDrawCtx :: GLES => Ctx -> Draw a -> IORef DrawState -> IO a+refDrawCtx ctx d ref = do state <- readIORef ref+ (ret, state') <- runDrawCtx ctx d state+ writeIORef ref state'+ return ret++runDrawCtx :: GLES+ => 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 d = flip evalGL ctx . execDraw d++evalDrawCtx :: GLES => Ctx -> Draw a -> DrawState -> IO a+evalDrawCtx ctx d = flip evalGL ctx . evalDraw d
+ Graphics/Rendering/Ombra/Draw/Internal.hs view
@@ -0,0 +1,469 @@+{-# LANGUAGE GADTs, DataKinds, FlexibleContexts, TypeSynonymInstances,+ FlexibleInstances, MultiParamTypeClasses, KindSignatures #-}++module Graphics.Rendering.Ombra.Draw.Internal (+ Draw,+ DrawState,+ drawState,+ drawInit,+ drawBegin,+ drawLayer,+ drawGroup,+ drawObject,+ drawEnd,+ removeGeometry,+ removeTexture,+ removeProgram,+ textureUniform,+ textureSize,+ setProgram,+ resizeViewport,+ runDraw,+ execDraw,+ evalDraw,+ gl,+ renderLayer,+ layerToTexture,+ drawGet+) where++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 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 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 Control.Monad (when)+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.State++-- | Create a 'DrawState'.+drawState :: GLES+ => Int -- ^ Viewport width+ -> Int -- ^ Viewport height+ -> IO DrawState+drawState w h = do programs <- newGLResMap+ gpuBuffers <- newGLResMap+ gpuVAOs <- newDrawResMap+ uniforms <- newGLResMap+ textureImages <- newGLResMap+ return DrawState { currentProgram = Nothing+ , loadedProgram = Nothing+ , programs = programs+ , gpuBuffers = gpuBuffers+ , gpuVAOs = gpuVAOs+ , uniforms = uniforms+ , textureImages = textureImages+ , activeTextures =+ V.replicate maxTexs Nothing+ , viewportSize = (w, h)+ , blendMode = Nothing+ , depthTest = True }++ where newGLResMap :: (Hashable i, Resource i r GL) => IO (ResMap i r)+ newGLResMap = newResMap+ + newDrawResMap :: (Hashable i, Resource i r Draw)+ => IO (ResMap i r)+ newDrawResMap = newResMap++drawInit :: GLES => Draw ()+drawInit = viewportSize <$> Draw get >>=+ \(w, h) -> gl $ do clearColor 0.0 0.0 0.0 1.0+ enable gl_DEPTH_TEST+ depthFunc gl_LESS+ viewport 0 0 (fromIntegral w) (fromIntegral h)+++maxTexs :: (Integral a, GLES) => a+maxTexs = 32 -- fromIntegral gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS -- XXX++-- | Run a 'Draw' action.+runDraw :: Draw a+ -> DrawState+ -> GL (a, DrawState)+runDraw (Draw a) = runStateT a++-- | Execute a 'Draw' action.+execDraw :: Draw a -- ^ Action.+ -> DrawState -- ^ State.+ -> GL DrawState+execDraw (Draw a) = execStateT a++-- | Evaluate a 'Draw' action.+evalDraw :: Draw a -- ^ Action.+ -> DrawState -- ^ State.+ -> GL a+evalDraw (Draw a) = evalStateT a++-- | Viewport.+resizeViewport :: GLES+ => Int -- ^ Width.+ -> Int -- ^ Height.+ -> Draw ()+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 ()++-- | 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+-- be allocated again.+removeGeometry :: GLES => Geometry is -> Draw ()+removeGeometry gi = let g = castGeometry gi in+ do removeDrawResource gl gpuBuffers g+ removeDrawResource id gpuVAOs g++-- | Manually delete a 'Texture' from the GPU.+removeTexture :: GLES => Texture -> Draw ()+removeTexture (TextureImage i) = removeDrawResource gl textureImages i+removeTexture (TextureLoaded l) = gl $ unloadResource+ (Nothing :: Maybe TextureImage) l++-- | Manually delete a 'Program' from the GPU.+removeProgram :: GLES => Program gs is -> Draw ()+removeProgram = removeDrawResource gl programs . castProgram++-- | Draw a 'Layer'.+drawLayer :: GLES => Layer -> Draw ()+drawLayer (Layer prg grp) = setProgram prg >> drawGroup grp+drawLayer (SubLayer rl) =+ do (layers, textures) <- renderLayer rl+ mapM_ drawLayer layers+ mapM_ removeTexture textures+drawLayer (MultiLayer layers) = mapM_ drawLayer layers++-- | 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++-- | 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++uniform :: (GLES, ShaderVar g, Uniform s g)+ => proxy (s :: CPUSetterType *) -> g -> CPU s g -> Draw ()+uniform p g c = withUniforms p g c $+ \n ug uc -> withRes_ (getUniform $ uniformName g n) $+ \(UniformLocation l) -> gl $ setUniform l ug uc+ ++-- | This helps you set the uniforms of type 'Graphics.Rendering.Ombra.Shader.Sampler2D'.+textureUniform :: GLES => Texture -> Draw ActiveTexture+textureUniform tex = withRes (getTexture tex) (return $ ActiveTexture 0)+ $ \(LoadedTexture _ _ wtex) ->+ do at <- makeActive tex+ gl $ bindTexture gl_TEXTURE_2D wtex+ return at++-- | Get the dimensions of a 'Texture'.+textureSize :: (GLES, Num a) => Texture -> Draw (a, a)+textureSize tex = withRes (getTexture tex) (return (0, 0))+ $ \(LoadedTexture w h _) -> return ( fromIntegral w+ , fromIntegral h)++-- | Set the program.+setProgram :: GLES => Program g i -> Draw ()+setProgram p = do current <- currentProgram <$> Draw get+ when (current /= Just (castProgram p)) $+ withRes_ (getProgram $ castProgram p) $+ \lp@(LoadedProgram glp _ _) -> do+ Draw . modify $ \s -> s {+ currentProgram = Just $ castProgram p,+ loadedProgram = Just lp+ }+ gl $ useProgram glp++withRes_ :: Draw (Either String a) -> (a -> Draw ()) -> Draw ()+withRes_ drs = withRes drs $ return ()++withRes :: Draw (Either String a) -> Draw b -> (a -> Draw b) -> Draw b+withRes drs u l = drs >>= \rs -> case rs of+ Right r -> l r+ _ -> u++getUniform :: GLES => String -> Draw (Either String UniformLocation)+getUniform name = do mprg <- loadedProgram <$> Draw get+ case mprg of+ Just prg -> getDrawResource gl uniforms (prg, name)+ Nothing -> return $ Left "No loaded program."++getGPUVAOGeometry :: GLES => Geometry '[] -> Draw (Either String GPUVAOGeometry)+getGPUVAOGeometry = getDrawResource id gpuVAOs++getGPUBufferGeometry :: GLES => Geometry '[]+ -> Draw (Either String GPUBufferGeometry)+getGPUBufferGeometry = getDrawResource gl gpuBuffers++getTexture :: GLES => Texture -> Draw (Either String LoadedTexture)+getTexture (TextureLoaded l) = return $ Right l+getTexture (TextureImage t) = getTextureImage t++getTextureImage :: GLES => TextureImage+ -> Draw (Either String LoadedTexture)+getTextureImage = getDrawResource gl textureImages++getProgram :: GLES+ => Program '[] '[] -> Draw (Either String LoadedProgram)+getProgram = getDrawResource gl programs++freeActiveTextures :: GLES => Draw ()+freeActiveTextures = Draw . modify $ \ds ->+ ds { activeTextures = V.replicate maxTexs Nothing }++-- XXX: inefficient+makeActive :: GLES => Texture -> Draw ActiveTexture+makeActive t = do ats <- activeTextures <$> Draw get+ let at@(ActiveTexture atn) =+ case V.elemIndex (Just t) ats of+ Just n -> ActiveTexture $ fi n+ 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+ Draw . modify $ \ds ->+ ds { activeTextures = ats V.// [(fi 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+ 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+ -> Either (Maybe [r])+ ([r] -> Draw (Maybe [r]), Int, Int, Int, Int)+ mayInspect True = Right (return . Just, rx, ry, rw, rh)+ mayInspect False = Left Nothing++-- | Draw a 'Layer' on some textures.+layerToTexture :: (GLES, Integral a)+ => Bool -- ^ Draw buffers+ -> [LayerType] -- ^ Textures contents+ -> a -- ^ Width+ -> a -- ^ Height+ -> Layer -- ^ Layer to draw+ -> Either b ( [Color] -> Draw b+ , Int, Int, Int, Int) -- ^ Color inspecting+ -- function, start x,+ -- start y, width,+ -- height+ -> Either c ( [Word8] -> Draw c+ , Int, Int, Int, Int) -- ^ Depth inspecting,+ -- function, etc.+ -> Draw ([Texture], b ,c)+layerToTexture drawBufs stypes wp hp layer einspc einspd = do+ (ts, (colRes, depthRes)) <- renderToTexture drawBufs (map arguments+ stypes) w h $+ do drawLayer layer+ colRes <- inspect einspc gl_RGBA wordsToColors 4+ depthRes <- inspect einspd gl_DEPTH_COMPONENT id 1+ return (colRes, depthRes)++ return (map (TextureLoaded . LoadedTexture w h) ts, colRes, depthRes)++ where (w, h) = (fromIntegral wp, fromIntegral hp)+ arguments stype =+ case stype of+ ColorLayer -> ( fromIntegral gl_RGBA+ , gl_RGBA+ , gl_UNSIGNED_BYTE+ , gl_COLOR_ATTACHMENT0 )+ DepthLayer -> ( fromIntegral gl_DEPTH_COMPONENT+ , gl_DEPTH_COMPONENT+ , gl_UNSIGNED_SHORT+ , gl_DEPTH_ATTACHMENT )+ BufferLayer n -> ( fromIntegral gl_RGBA32F+ , gl_RGBA+ , gl_FLOAT+ , gl_COLOR_ATTACHMENT0 + + 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 (Right (insp, x, y, rw, rh)) format trans s =+ do arr <- liftIO . newByteArray $+ fromIntegral rw * fromIntegral rh * s+ gl $ readPixels (fromIntegral x)+ (fromIntegral y)+ (fromIntegral rw)+ (fromIntegral rh)+ format gl_UNSIGNED_BYTE arr+ liftIO (decodeBytes arr) >>= insp . trans+ wordsToColors (r : g : b : a : xs) = Color r g b a :+ wordsToColors xs+ wordsToColors _ = []++renderToTexture :: GLES+ => Bool -> [(GLInt, GLEnum, GLEnum, GLEnum)]+ -> 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+ bindTexture gl_TEXTURE_2D t+ texImage2D gl_TEXTURE_2D 0 internalFormat w + h 0 format pixelType arr+ framebufferTexture2D gl_FRAMEBUFFER attachment+ gl_TEXTURE_2D t 0+ return (t, fromIntegral attachment)++ let buffers = filter (/= fromIntegral gl_DEPTH_ATTACHMENT) as+ when drawBufs $ liftIO (encodeInts buffers) >>= gl . drawBuffers++ (sw, sh) <- viewportSize <$> Draw get+ resizeViewport (fromIntegral w) (fromIntegral h)++ drawBegin+ ret <- act+ drawEnd++ resizeViewport sw sh+ gl $ deleteFramebuffer fb++ return (ts, ret)++setBlendMode :: GLES => Maybe Blend.Mode -> Draw ()+setBlendMode Nothing = do m <- blendMode <$> Draw get+ case m of+ Just _ -> gl $ disable gl_BLEND+ Nothing -> return ()+ Draw . modify $ \s -> s { blendMode = Nothing }+setBlendMode (Just newMode) =+ do mOldMode <- blendMode <$> Draw get+ case mOldMode of+ Nothing -> do gl $ enable gl_BLEND+ changeColor >> changeEquation >> changeFunction+ Just oldMode ->+ do when (Blend.constantColor oldMode /= constantColor)+ changeColor+ when (Blend.equation oldMode /= equation)+ changeEquation+ when (Blend.function oldMode /= function)+ changeFunction+ Draw . modify $ \s -> s { blendMode = Just newMode }+ where constantColor = Blend.constantColor newMode+ equation@(rgbEq, alphaEq) = Blend.equation newMode+ function@(rgbs, rgbd, alphas, alphad) = Blend.function newMode+ changeColor = case constantColor of+ Just (Vec4 r g b a) -> gl $ blendColor r g b a+ Nothing -> return ()+ changeEquation = gl $ blendEquationSeparate rgbEq alphaEq+ changeFunction = gl $ blendFuncSeparate rgbs rgbd+ alphas alphad+ +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 }++getDrawResource :: (Resource i r m, Hashable i)+ => (m (Either String r) -> Draw (Either String r))+ -> (DrawState -> ResMap i r)+ -> i+ -> Draw (Either String r)+getDrawResource lft mg i = do+ map <- mg <$> Draw get+ lft $ getResource i map++removeDrawResource :: (Resource i r m, Hashable i)+ => (m () -> Draw ())+ -> (DrawState -> ResMap i r)+ -> i+ -> Draw ()+removeDrawResource lft mg i = do+ s <- mg <$> Draw get+ lft $ removeResource i s++drawGPUVAOGeometry :: GLES => GPUVAOGeometry -> Draw ()+drawGPUVAOGeometry (GPUVAOGeometry _ ec vao) = currentProgram <$> Draw get >>=+ \mcp -> case mcp of+ Just _ -> gl $ do bindVertexArray vao+ drawElements gl_TRIANGLES+ (fromIntegral ec)+ gl_UNSIGNED_SHORT+ nullGLPtr+ bindVertexArray noVAO+ Nothing -> return ()++instance GLES => Resource (LoadedProgram, String) UniformLocation GL where+ loadResource (LoadedProgram prg _ _, g) =+ do loc <- getUniformLocation prg $ toGLString g+ return . Right $ UniformLocation loc+ unloadResource _ _ = return ()++instance GLES => Resource (Geometry '[]) GPUVAOGeometry Draw where+ loadResource g =+ do ge <- getGPUBufferGeometry g+ case ge of+ Left err -> return $ Left err+ Right buf -> gl $ loadResource buf++ unloadResource _ =+ gl . unloadResource (Nothing :: Maybe GPUBufferGeometry)++-- | Perform a 'GL' action in the 'Draw' monad.+gl :: GL a -> Draw a+gl = Draw . lift++-- | Get the 'DrawState'.+drawGet :: Draw DrawState+drawGet = Draw get
+ Graphics/Rendering/Ombra/Generic.hs view
@@ -0,0 +1,339 @@+{-# LANGUAGE TypeOperators, DataKinds, ConstraintKinds, MultiParamTypeClasses,+ TypeFamilies, FlexibleContexts, FlexibleInstances #-}++module Graphics.Rendering.Ombra.Generic (+ -- * Objects+ Object((:~>)),+ MemberGlobal((~~>)),+ RemoveGlobal((*~>)),+ nothing,+ geom,+ modifyGeometry,++ -- * Groups+ Group,+ group,+ (~~),+ unsafeJoin,+ emptyGroup,+ globalGroup,+ depthTest,+ -- ** Blending+ blend,+ noBlend,+ Blend.transparency,+ Blend.additive,+ -- ** Stencil test++ -- * Layers+ Layer,+ layer,+ combineLayers,+ -- ** Sublayers+ subLayer,+ depthSubLayer,+ subRenderLayer,+ -- ** Render layers+ RenderLayer,+ renderColor,+ renderDepth,+ renderColorDepth,+ renderColorInspect,+ renderDepthInspect,+ renderColorDepthInspect,+ renderBuffers,++ -- * Shaders+ Program,+ program,+ Global,+ (-=),+ globalTexture,+ globalTexSize,+ globalFramebufferSize,++ -- * Geometries+ Geometry,+ AttrList(..),+ mkGeometry,+ extend,+ remove,++ -- * Textures+ Texture,+ mkTexture,+ -- ** Colors+ Color(..),+ colorTex,++ GLES,+ module Data.Vect.Float,+ 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 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.Internal.TList+import Graphics.Rendering.Ombra.Shader.CPU+import Graphics.Rendering.Ombra.Shader.Program+import Graphics.Rendering.Ombra.Shader.ShaderVar+import Graphics.Rendering.Ombra.Texture+import Unsafe.Coerce++-- | An empty group.+emptyGroup :: Group is gs+emptyGroup = Empty++-- | Set a global uniform for a 'Group'.+globalGroup :: Global g -> Group gs is -> Group (g ': gs) is+globalGroup = Global++-- | Set the blending mode for a 'Group' of objects.+blend :: Blend.Mode -> Group gs is -> Group gs is+blend m = Blend $ Just m++-- | Disable blending for a 'Group'.+noBlend :: Group gs is -> Group gs is+noBlend = Blend Nothing++-- | Enable/disable the depth test for a 'Group'.+depthTest :: Bool -> Group gs is -> Group gs is+depthTest = DepthTest+++-- | An empty object.+nothing :: Object '[] '[]+nothing = NoMesh++-- | An object with a specified 'Geometry'.+geom :: Geometry i -> Object '[] i+geom = Mesh++class MemberGlobal g gs where+ -- | Modify the global of an 'Object'.+ (~~>) :: (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++instance {-# OVERLAPPABLE #-} ((g == g1) ~ False, MemberGlobal g gs) =>+ MemberGlobal g (g1 ': gs) where+ f ~~> (g :~> o) = g :~> (f ~~> o)++infixr 2 ~~>++class RemoveGlobal g gs gs' where+ -- | Remove a global from an 'Object'.+ (*~>) :: (a -> g) -> Object gs is -> Object gs' is++instance {-# OVERLAPPING #-} RemoveGlobal g (g ': gs) gs where+ _ *~> (_ :~> o) = o++instance {-# OVERLAPPABLE #-} ((g == g1) ~ False, RemoveGlobal g gs gs') =>+ RemoveGlobal g (g1 ': gs) (g1 ': gs') where+ r *~> (g :~> o) = g :~> (r *~> o)++infixr 2 *~>++-- | Modify the geometry of an 'Object'.+modifyGeometry :: (Empty is ~ False)+ => (Geometry is -> Geometry is')+ -> Object gs is -> Object gs is'+modifyGeometry fg (g :~> o) = g :~> modifyGeometry fg o+modifyGeometry fg (Mesh g) = Mesh $ fg g++-- | Create a 'Global' from a pure value. The first argument is ignored,+-- it just provides the type (you can use the constructor of the GPU type).+-- You can use this to set the value of a shader uniform.+(-=) :: (ShaderVar g, Uniform 'S g) => (a -> g) -> CPU 'S g -> Global g+g -= c = g := return c++infixr 4 -=++-- TODO: polymorphic -= instead of globalTexture+-- | Create a 'Global' of CPU type 'ActiveTexture' using a 'Texture'.+globalTexture :: (Uniform 'S g, CPU 'S g ~ ActiveTexture, ShaderVar g, GLES)+ => (a -> g) -> Texture -> Global g+globalTexture g c = g := textureUniform c++-- | Create a 'Global' using the size of a 'Texture'.+globalTexSize :: (ShaderVar g, Uniform 'S g, GLES)+ => (a -> g) -> Texture+ -> ((Int, Int) -> CPU 'S g) -> Global g+globalTexSize g t fc = g := (fc <$> textureSize t)++-- | Create a 'Global' using the size of the framebuffer.+globalFramebufferSize :: (ShaderVar g, Uniform 'S g) => (a -> g)+ -> (Vec2 -> CPU 'S g) -> Global g+globalFramebufferSize g fc = g := (fc . tupleToVec <$>+ (viewportSize <$> drawGet))+ where tupleToVec (x, y) = Vec2 (fromIntegral x) (fromIntegral y)++-- | 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++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)+++-- | Join two groups.+(~~) :: (EqualJoin gs gs' (Text "globals"), EqualJoin 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++-- | 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++-- | Generate a 1x1 texture.+colorTex :: GLES => Color -> Texture+colorTex c = mkTexture 1 1 [ c ]++-- | 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++-- | 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.+ -> Layer+depthSubLayer w h l = subRenderLayer . renderDepth w h l++-- TODO: buffersSubLayer++-- | Generalized version of 'subLayer' and 'depthSubLayer'.+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 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+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.+ -> 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++-- | 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 w h l rx ry rw rh f =+ RenderLayer False [ColorLayer, DepthLayer] w h rx ry+ rw rh True False l $+ \[t, _] (Just c) _ -> f t c++-- | 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 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 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++-- | 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 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
+ Graphics/Rendering/Ombra/Geometry.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE GADTs, TypeOperators, KindSignatures, DataKinds, FlexibleContexts,+ MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables,+ PolyKinds #-}++module Graphics.Rendering.Ombra.Geometry (+ AttrList(..),+ Geometry(..),+ Geometry2D,+ Geometry3D,+ GPUBufferGeometry(..),+ GPUVAOGeometry(..),+ extend,+ remove,+ withGPUBufferGeometry,+ mkGeometry,+ mkGeometry2D,+ mkGeometry3D,+ 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+ AttrListNil :: AttrList '[]+ AttrListCons :: (H.Hashable (CPU S i), Attribute S i)+ => (a -> i)+ -> [CPU S i]+ -> AttrList is+ -> AttrList (i ': is)++-- | A set of attributes and indices.+data Geometry (is :: [*]) = Geometry (AttrList is) [Word16] Int++data GPUBufferGeometry = GPUBufferGeometry {+ attributeBuffers :: [(Buffer, GLUInt, GLUInt -> GL ())],+ elementBuffer :: Buffer,+ elementCount :: Int,+ geometryHash :: Int+}++data GPUVAOGeometry = GPUVAOGeometry {+ vaoBoundBuffers :: [Buffer],+ vaoElementCount :: Int,+ vao :: VertexArrayObject+}++-- | A 3D geometry.+type Geometry3D = '[Position3, D3.UV, Normal3]++-- | A 2D geometry.+type Geometry2D = '[Position2, D2.UV]++instance H.Hashable (AttrList is) where+ hashWithSalt salt AttrListNil = salt+ hashWithSalt salt (AttrListCons _ i is) = H.hashWithSalt salt (i, is)++instance H.Hashable (Geometry is) where+ hashWithSalt salt (Geometry _ _ h) = H.hashWithSalt salt h++instance Eq (Geometry is) where+ (Geometry _ _ h) == (Geometry _ _ h') = h == h'++instance H.Hashable GPUBufferGeometry where+ hashWithSalt salt = H.hashWithSalt salt . geometryHash++instance Eq GPUBufferGeometry where+ g == g' = geometryHash g == geometryHash g'++-- | Create a 3D 'Geometry'. The first three lists should have the same length.+mkGeometry3D :: GLES+ => [Vec3] -- ^ List of vertices.+ -> [Vec2] -- ^ List of UV coordinates.+ -> [Vec3] -- ^ List of normals.+ -> [Word16] -- ^ Triangles expressed as triples of indices to the+ -- three lists above.+ -> Geometry Geometry3D+mkGeometry3D v u n = mkGeometry (AttrListCons D3.Position3 v $+ AttrListCons D3.UV u $+ AttrListCons D3.Normal3 n+ AttrListNil)++-- | Create a 2D 'Geometry'. The first two lists should have the same length.+mkGeometry2D :: GLES+ => [Vec2] -- ^ List of vertices.+ -> [Vec2] -- ^ List of UV coordinates.+ -> [Word16] -- ^ Triangles expressed as triples of indices to the+ -- two lists above.+ -> Geometry Geometry2D+mkGeometry2D v u = mkGeometry (AttrListCons D2.Position2 v $+ AttrListCons D2.UV u+ AttrListNil)+++-- | Add an attribute to a geometry.+extend :: (Attribute 'S i, H.Hashable (CPU 'S i), ShaderType i, GLES)+ => (a -> i) -- ^ Attribute constructor (or any other+ -- function with that type).+ -> [CPU 'S i] -- ^ List of values+ -> Geometry is+ -> Geometry (i ': is)+extend g c (Geometry al es _) = mkGeometry (AttrListCons g c al) es++-- | Remove an attribute from a geometry.+remove :: (RemoveAttr i is is', GLES)+ => (a -> i) -- ^ Attribute constructor (or any other function with+ -- that type).+ -> Geometry is -> Geometry is'+remove g (Geometry al es _) = mkGeometry (removeAttr g al) es++class RemoveAttr i is is' where+ removeAttr :: (a -> i) -> AttrList is -> AttrList is'++instance RemoveAttr i (i ': is) is where+ removeAttr _ (AttrListCons _ _ al) = al++instance RemoveAttr i is is' =>+ RemoveAttr i (i1 ': is) (i1 ': is') where+ removeAttr g (AttrListCons g' c al) =+ AttrListCons g' c $ removeAttr g al++-- | Create a custom 'Geometry'.+mkGeometry :: GLES => 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++loadGPUVAOGeometry :: GLES+ => GPUBufferGeometry+ -> GL GPUVAOGeometry+loadGPUVAOGeometry g =+ do vao <- createVertexArray+ bindVertexArray vao+ (ec, bufs) <- withGPUBufferGeometry g $+ \ec bufs -> bindVertexArray noVAO >> return (ec, bufs)+ return $ GPUVAOGeometry bufs ec vao++loadGeometry :: GLES => Geometry i -> GL GPUBufferGeometry+loadGeometry (Geometry al es h) =+ GPUBufferGeometry <$> loadAttrList al+ <*> (liftIO (encodeUShorts es) >>=+ loadBuffer gl_ELEMENT_ARRAY_BUFFER .+ fromUInt16Array)+ <*> pure (length es)+ <*> pure h++loadAttrList :: GLES => AttrList is -> GL [(Buffer, GLUInt, GLUInt -> GL ())]+loadAttrList = loadFrom 0+ where loadFrom :: GLUInt -> AttrList is+ -> GL [(Buffer, GLUInt, GLUInt -> GL ())]+ loadFrom _ AttrListNil = return []+ loadFrom idx (AttrListCons g c al) =+ do (newIdx, attrInfo) <- loadAttribute idx (g undefined) c+ (attrInfo ++) <$> loadFrom newIdx al+ + loadAttribute :: Attribute 'S g => GLUInt -> g -> [CPU 'S g]+ -> GL (GLUInt, [(Buffer, GLUInt, GLUInt -> GL ())])+ loadAttribute ii g c = flip execStateT (ii, []) $+ withAttributes (Proxy :: Proxy 'S) g c $ \_ (g :: Proxy g) c ->+ do (i, infos) <- get+ arr <- lift $ encodeAttribute g c+ buf <- lift $ loadBuffer gl_ARRAY_BUFFER arr+ put ( i + fromIntegral (size (undefined :: g))+ , (buf, i, setAttribute g) : infos )++withGPUBufferGeometry :: GLES+ => GPUBufferGeometry -> (Int -> [Buffer] -> GL a) -> GL a+withGPUBufferGeometry (GPUBufferGeometry abs eb ec _) f =+ do bindBuffer gl_ARRAY_BUFFER noBuffer+ (locs, bufs) <- unzip <$>+ mapM (\(buf, loc, setAttr) ->+ do bindBuffer gl_ARRAY_BUFFER buf+ enableVertexAttribArray loc+ setAttr loc+ return (loc, buf)+ ) abs++ bindBuffer gl_ELEMENT_ARRAY_BUFFER eb+ r <- f ec $ eb : bufs+ bindBuffer gl_ELEMENT_ARRAY_BUFFER noBuffer+ bindBuffer gl_ARRAY_BUFFER noBuffer+ -- mapM_ (disableVertexAttribArray . fromIntegral) locs+ return r++deleteGPUVAOGeometry :: GLES => GPUVAOGeometry -> GL ()+deleteGPUVAOGeometry (GPUVAOGeometry bufs _ vao) =+ do mapM_ deleteBuffer bufs+ deleteVertexArray vao+++deleteGPUBufferGeometry :: GLES => GPUBufferGeometry -> GL ()+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+ bindBuffer ty buffer+ bufferData ty bufData gl_STATIC_DRAW+ bindBuffer ty noBuffer+ return buffer++instance H.Hashable Vec2 where+ hashWithSalt s (Vec2 x y) = H.hashWithSalt s (x, y)++instance H.Hashable Vec3 where+ hashWithSalt s (Vec3 x y z) = H.hashWithSalt s (x, y, z)++instance H.Hashable Vec4 where+ hashWithSalt s (Vec4 x y z w) = H.hashWithSalt s (x, y, z, w)
+ Graphics/Rendering/Ombra/Internal/GL.hs view
@@ -0,0 +1,563 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Graphics.Rendering.Ombra.Internal.GL (+ GL,+ ActiveTexture(..),+ module Graphics.Rendering.Ombra.Backend,+ liftIO,+ evalGL,+ getCtx,+ activeTexture,+ attachShader,+ bindAttribLocation,+ bindBuffer,+ bindFramebuffer,+ bindRenderbuffer,+ bindTexture,+ bindVertexArray,+ blendColor,+ blendEquation,+ blendEquationSeparate,+ blendFunc,+ blendFuncSeparate,+ bufferData,+ bufferSubData,+ checkFramebufferStatus,+ clear,+ clearColor,+ clearDepth,+ clearStencil,+ colorMask,+ compileShader,+ compressedTexImage2D,+ compressedTexSubImage2D,+ copyTexImage2D,+ copyTexSubImage2D,+ createBuffer,+ createFramebuffer,+ createProgram,+ createRenderbuffer,+ createShader,+ createTexture,+ createVertexArray,+ cullFace,+ deleteBuffer,+ deleteFramebuffer,+ deleteProgram,+ deleteRenderbuffer,+ deleteShader,+ deleteTexture,+ deleteVertexArray,+ depthFunc,+ depthMask,+ depthRange,+ detachShader,+ disable,+ disableVertexAttribArray,+ drawArrays,+ drawBuffers,+ drawElements,+ enable,+ enableVertexAttribArray,+ finish,+ flush,+ framebufferRenderbuffer,+ framebufferTexture2D,+ frontFace,+ generateMipmap,+ getAttribLocation,+ getError,+ getProgramInfoLog,+ -- getShaderPrecisionFormat,+ getShaderInfoLog,+ getShaderSource,+ getUniformLocation,+ hint,+ isBuffer,+ isEnabled,+ isFramebuffer,+ isProgram,+ isRenderbuffer,+ isShader,+ isTexture,+ isVertexArray,+ lineWidth,+ linkProgram,+ pixelStorei,+ polygonOffset,+ readPixels,+ renderbufferStorage,+ sampleCoverage,+ scissor,+ shaderSource,+ stencilFunc,+ stencilFuncSeparate,+ stencilMask,+ stencilMaskSeparate,+ stencilOp,+ stencilOpSeparate,+ texImage2D,+ texParameterf,+ texParameteri,+ texSubImage2D,+ uniform1f,+ uniform1fv,+ uniform1i,+ uniform1iv,+ uniform2f,+ uniform2fv,+ uniform2i,+ uniform2iv,+ uniform3f,+ uniform3fv,+ uniform3i,+ uniform3iv,+ uniform4f,+ uniform4fv,+ uniform4i,+ uniform4iv,+ uniformMatrix2fv,+ uniformMatrix3fv,+ uniformMatrix4fv,+ useProgram,+ validateProgram,+ vertexAttrib1f,+ vertexAttrib1fv,+ vertexAttrib2f,+ vertexAttrib2fv,+ vertexAttrib3f,+ vertexAttrib3fv,+ vertexAttrib4f,+ vertexAttrib4fv,+ vertexAttribPointer,+ 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(..))+ +newtype GL a = GL (ReaderT Ctx IO a)+ deriving (Functor, Applicative, Monad, MonadIO)++newtype ActiveTexture = ActiveTexture Word++instance EmbedIO GL where+ embedIO f a = GL ask >>= \c -> liftIO . f $ evalGL a c++evalGL :: GL a -> Ctx -> IO a+evalGL (GL m) = runReaderT m++getCtx :: GLES => GL Ctx+getCtx = GL ask++activeTexture :: GLES => GLEnum -> GL ()+activeTexture a = getCtx >>= \ctx -> liftIO $ glActiveTexture ctx a++attachShader :: GLES => Program -> Shader -> GL ()+attachShader a b = getCtx >>= \ctx -> liftIO $ glAttachShader ctx a b++bindAttribLocation :: GLES => Program -> GLUInt -> GLString -> GL ()+bindAttribLocation a b c = getCtx >>= \ctx -> liftIO $ glBindAttribLocation ctx a b c++bindBuffer :: GLES => GLEnum -> Buffer -> GL ()+bindBuffer a b = getCtx >>= \ctx -> liftIO $ glBindBuffer ctx a b++bindFramebuffer :: GLES => GLEnum -> FrameBuffer -> GL ()+bindFramebuffer a b = getCtx >>= \ctx -> liftIO $ glBindFramebuffer ctx a b++bindRenderbuffer :: GLES => GLEnum -> RenderBuffer -> GL ()+bindRenderbuffer a b = getCtx >>= \ctx -> liftIO $ glBindRenderbuffer ctx a b++bindTexture :: GLES => GLEnum -> Texture -> GL ()+bindTexture a b = getCtx >>= \ctx -> liftIO $ glBindTexture ctx a b++bindVertexArray :: GLES => VertexArrayObject -> GL ()+bindVertexArray a = getCtx >>= \ctx -> liftIO $ glBindVertexArray ctx a++blendColor :: GLES => Float -> Float -> Float -> Float -> GL ()+blendColor a b c d = getCtx >>= \ctx -> liftIO $ glBlendColor ctx a b c d++blendEquation :: GLES => GLEnum -> GL ()+blendEquation a = getCtx >>= \ctx -> liftIO $ glBlendEquation ctx a++blendEquationSeparate :: GLES => GLEnum -> GLEnum -> GL ()+blendEquationSeparate a b = getCtx >>= \ctx -> liftIO $ glBlendEquationSeparate ctx a b++blendFunc :: GLES => GLEnum -> GLEnum -> GL ()+blendFunc a b = getCtx >>= \ctx -> liftIO $ glBlendFunc ctx a b++blendFuncSeparate :: GLES => GLEnum -> GLEnum -> GLEnum -> GLEnum -> GL ()+blendFuncSeparate a b c d = getCtx >>= \ctx -> liftIO $ glBlendFuncSeparate ctx a b c d++bufferData :: GLES => GLEnum -> AnyArray -> GLEnum -> GL ()+bufferData a b c = getCtx >>= \ctx -> liftIO $ glBufferData ctx a b c++bufferSubData :: GLES => GLEnum -> GLPtrDiff -> AnyArray -> GL ()+bufferSubData a b c = getCtx >>= \ctx -> liftIO $ glBufferSubData ctx a b c++checkFramebufferStatus :: GLES => GLEnum -> GL GLEnum+checkFramebufferStatus a = getCtx >>= \ctx -> liftIO $ glCheckFramebufferStatus ctx a++clear :: GLES => GLEnum -> GL ()+clear a = getCtx >>= \ctx -> liftIO $ glClear ctx a++clearColor :: GLES => Float -> Float -> Float -> Float -> GL ()+clearColor a b c d = getCtx >>= \ctx -> liftIO $ glClearColor ctx a b c d++clearDepth :: GLES => Float -> GL ()+clearDepth a = getCtx >>= \ctx -> liftIO $ glClearDepth ctx a++clearStencil :: GLES => GLInt -> GL ()+clearStencil a = getCtx >>= \ctx -> liftIO $ glClearStencil ctx a++colorMask :: GLES => GLBool -> GLBool -> GLBool -> GLBool -> GL ()+colorMask a b c d = getCtx >>= \ctx -> liftIO $ glColorMask ctx a b c d++compileShader :: GLES => Shader -> GL ()+compileShader a = getCtx >>= \ctx -> liftIO $ glCompileShader ctx a++compressedTexImage2D :: GLES => GLEnum -> GLInt -> GLEnum -> GLSize -> GLSize -> GLInt -> UInt8Array -> GL ()+compressedTexImage2D a b c d e f g = getCtx >>= \ctx -> liftIO $ glCompressedTexImage2D ctx a b c d e f g++compressedTexSubImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> UInt8Array -> GL ()+compressedTexSubImage2D a b c d e f g h = getCtx >>= \ctx -> liftIO $ glCompressedTexSubImage2D ctx a b c d e f g h++copyTexImage2D :: GLES => GLEnum -> GLInt -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GL ()+copyTexImage2D a b c d e f g h = getCtx >>= \ctx -> liftIO $ glCopyTexImage2D ctx a b c d e f g h++copyTexSubImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GL ()+copyTexSubImage2D a b c d e f g h = getCtx >>= \ctx -> liftIO $ glCopyTexSubImage2D ctx a b c d e f g h++createBuffer :: GLES => GL Buffer+createBuffer = getCtx >>= liftIO . glCreateBuffer++createFramebuffer :: GLES => GL FrameBuffer+createFramebuffer = getCtx >>= liftIO . glCreateFramebuffer++createProgram :: GLES => GL Program+createProgram = getCtx >>= liftIO . glCreateProgram++createRenderbuffer :: GLES => GL RenderBuffer+createRenderbuffer = getCtx >>= liftIO . glCreateRenderbuffer++createShader :: GLES => GLEnum -> GL Shader+createShader a = getCtx >>= \ctx -> liftIO $ glCreateShader ctx a++createTexture :: GLES => GL Texture+createTexture = getCtx >>= liftIO . glCreateTexture++createVertexArray :: GLES => GL VertexArrayObject+createVertexArray = getCtx >>= liftIO . glCreateVertexArray++cullFace :: GLES => GLEnum -> GL ()+cullFace a = getCtx >>= \ctx -> liftIO $ glCullFace ctx a++deleteBuffer :: GLES => Buffer -> GL ()+deleteBuffer a = getCtx >>= \ctx -> liftIO $ glDeleteBuffer ctx a++deleteFramebuffer :: GLES => FrameBuffer -> GL ()+deleteFramebuffer a = getCtx >>= \ctx -> liftIO $ glDeleteFramebuffer ctx a++deleteProgram :: GLES => Program -> GL ()+deleteProgram a = getCtx >>= \ctx -> liftIO $ glDeleteProgram ctx a++deleteRenderbuffer :: GLES => RenderBuffer -> GL ()+deleteRenderbuffer a = getCtx >>= \ctx -> liftIO $ glDeleteRenderbuffer ctx a++deleteShader :: GLES => Shader -> GL ()+deleteShader a = getCtx >>= \ctx -> liftIO $ glDeleteShader ctx a++deleteVertexArray :: GLES => VertexArrayObject -> GL ()+deleteVertexArray a = getCtx >>= \ctx -> liftIO $ glDeleteVertexArray ctx a++deleteTexture :: GLES => Texture -> GL ()+deleteTexture a = getCtx >>= \ctx -> liftIO $ glDeleteTexture ctx a++depthFunc :: GLES => GLEnum -> GL ()+depthFunc a = getCtx >>= \ctx -> liftIO $ glDepthFunc ctx a++depthMask :: GLES => GLBool -> GL ()+depthMask a = getCtx >>= \ctx -> liftIO $ glDepthMask ctx a++depthRange :: GLES => Float -> Float -> GL ()+depthRange a b = getCtx >>= \ctx -> liftIO $ glDepthRange ctx a b++detachShader :: GLES => Program -> Shader -> GL ()+detachShader a b = getCtx >>= \ctx -> liftIO $ glDetachShader ctx a b++disable :: GLES => GLEnum -> GL ()+disable a = getCtx >>= \ctx -> liftIO $ glDisable ctx a++disableVertexAttribArray :: GLES => GLUInt -> GL ()+disableVertexAttribArray a = getCtx >>= \ctx -> liftIO $ glDisableVertexAttribArray ctx a++drawArrays :: GLES => GLEnum -> GLInt -> GLSize -> GL ()+drawArrays a b c = getCtx >>= \ctx -> liftIO $ glDrawArrays ctx a b c++drawElements :: GLES => GLEnum -> GLSize -> GLEnum -> GLPtr -> GL ()+drawElements a b c d = getCtx >>= \ctx -> liftIO $ glDrawElements ctx a b c d++drawBuffers :: GLES => Int32Array -> GL ()+drawBuffers a = getCtx >>= \ctx -> liftIO $ glDrawBuffers ctx a++enable :: GLES => GLEnum -> GL ()+enable a = getCtx >>= \ctx -> liftIO $ glEnable ctx a++enableVertexAttribArray :: GLES => GLUInt -> GL ()+enableVertexAttribArray a = getCtx >>= \ctx -> liftIO $ glEnableVertexAttribArray ctx a++finish :: GLES => GL ()+finish = getCtx >>= liftIO . glFinish++flush :: GLES => GL ()+flush = getCtx >>= liftIO . glFlush++framebufferRenderbuffer :: GLES => GLEnum -> GLEnum -> GLEnum -> RenderBuffer -> GL ()+framebufferRenderbuffer a b c d = getCtx >>= \ctx -> liftIO $ glFramebufferRenderbuffer ctx a b c d++framebufferTexture2D :: GLES => GLEnum -> GLEnum -> GLEnum -> Texture -> GLInt -> GL ()+framebufferTexture2D a b c d e = getCtx >>= \ctx -> liftIO $ glFramebufferTexture2D ctx a b c d e++frontFace :: GLES => GLEnum -> GL ()+frontFace a = getCtx >>= \ctx -> liftIO $ glFrontFace ctx a++generateMipmap :: GLES => GLEnum -> GL ()+generateMipmap a = getCtx >>= \ctx -> liftIO $ glGenerateMipmap ctx a++-- glGetActiveAttrib :: GLES => Program -> GLEnum -> GL ActiveInfo+-- getActiveAttrib a b = getCtx >>= \ctx -> liftIO $ glGetActiveAttrib ctx a b++-- glGetActiveUniform :: GLES => Program -> GLEnum -> GL ActiveInfo+-- getActiveUniform a b = getCtx >>= \ctx -> liftIO $ glGetActiveUniform ctx a b++getAttribLocation :: GLES => Program -> GLString -> GL GLInt+getAttribLocation a b = getCtx >>= \ctx -> liftIO $ glGetAttribLocation ctx a b++-- glGetBufferParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getBufferParameter a b = getCtx >>= \ctx -> liftIO $ glGetBufferParameter ctx a b++-- glGetParameter :: GLES => Word -> GL (JSRef a)+-- getParameter a = getCtx >>= \ctx -> liftIO $ glGetParameter ctx a++getError :: GLES => GL GLEnum+getError = getCtx >>= liftIO . glGetError++-- glGetFramebufferAttachmentParameter :: GLES => GLEnum -> GLEnum -> GL Word+-- getFramebufferAttachmentParameter a b = getCtx >>= \ctx -> liftIO $ glGetFramebufferAttachmentParameter ctx a b++getProgramInfoLog :: GLES => Program -> GL GLString+getProgramInfoLog a = getCtx >>= \ctx -> liftIO $ glGetProgramInfoLog ctx a++-- glGetRenderbufferParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getRenderbufferParameter a b = getCtx >>= \ctx -> liftIO $ glGetRenderbufferParameter ctx a b++-- glGetShaderParameter :: GLES => Shader -> Word -> GL (JSRef a)+-- getShaderParameter a b = getCtx >>= \ctx -> liftIO $ glGetShaderParameter ctx a b++-- getShaderPrecisionFormat :: GLES => GLEnum -> GLEnum -> GL ShaderPrecisionFormat+-- getShaderPrecisionFormat a b = getCtx >>= \ctx -> liftIO $ glGetShaderPrecisionFormat ctx a b++getShaderInfoLog :: GLES => Shader -> GL GLString+getShaderInfoLog a = getCtx >>= \ctx -> liftIO $ glGetShaderInfoLog ctx a++getShaderSource :: GLES => Shader -> GL GLString+getShaderSource a = getCtx >>= \ctx -> liftIO $ glGetShaderSource ctx a++-- glGetTexParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getTexParameter a b = getCtx >>= \ctx -> liftIO $ glGetTexParameter ctx a b++-- glGetUniform :: GLES => Program -> UniformLocation -> GL (JSRef a)+-- getUniform a b = getCtx >>= \ctx -> liftIO $ glGetUniform ctx a b++getUniformLocation :: GLES => Program -> GLString -> GL UniformLocation+getUniformLocation a b = getCtx >>= \ctx -> liftIO $ glGetUniformLocation ctx a b++-- glGetVertexAttrib :: GLES => Word -> Word -> GL (JSRef a)+-- getVertexAttrib a b = getCtx >>= \ctx -> liftIO $ glGetVertexAttrib ctx a b++-- glGetVertexAttribOffset :: GLES => Word -> GLEnum -> GL Word+-- getVertexAttribOffset a b = getCtx >>= \ctx -> liftIO $ glGetVertexAttribOffset ctx a b++hint :: GLES => GLEnum -> GLEnum -> GL ()+hint a b = getCtx >>= \ctx -> liftIO $ glHint ctx a b++isBuffer :: GLES => Buffer -> GL GLBool+isBuffer a = getCtx >>= \ctx -> liftIO $ glIsBuffer ctx a++isEnabled :: GLES => GLEnum -> GL GLBool+isEnabled a = getCtx >>= \ctx -> liftIO $ glIsEnabled ctx a++isFramebuffer :: GLES => FrameBuffer -> GL GLBool+isFramebuffer a = getCtx >>= \ctx -> liftIO $ glIsFramebuffer ctx a++isProgram :: GLES => Program -> GL GLBool+isProgram a = getCtx >>= \ctx -> liftIO $ glIsProgram ctx a++isRenderbuffer :: GLES => RenderBuffer -> GL GLBool+isRenderbuffer a = getCtx >>= \ctx -> liftIO $ glIsRenderbuffer ctx a++isShader :: GLES => Shader -> GL GLBool+isShader a = getCtx >>= \ctx -> liftIO $ glIsShader ctx a++isTexture :: GLES => Texture -> GL GLBool+isTexture a = getCtx >>= \ctx -> liftIO $ glIsTexture ctx a++isVertexArray :: GLES => VertexArrayObject -> GL GLBool+isVertexArray a = getCtx >>= \ctx -> liftIO $ glIsVertexArray ctx a++lineWidth :: GLES => Float -> GL ()+lineWidth a = getCtx >>= \ctx -> liftIO $ glLineWidth ctx a++linkProgram :: GLES => Program -> GL ()+linkProgram a = getCtx >>= \ctx -> liftIO $ glLinkProgram ctx a++pixelStorei :: GLES => GLEnum -> GLInt -> GL ()+pixelStorei a b = getCtx >>= \ctx -> liftIO $ glPixelStorei ctx a b++polygonOffset :: GLES => Float -> Float -> GL ()+polygonOffset a b = getCtx >>= \ctx -> liftIO $ glPolygonOffset ctx a b++readPixels :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> UInt8Array -> GL ()+readPixels a b c d e f g = getCtx >>= \ctx -> liftIO $ glReadPixels ctx a b c d e f g++renderbufferStorage :: GLES => GLEnum -> GLEnum -> GLSize -> GLSize -> GL ()+renderbufferStorage a b c d = getCtx >>= \ctx -> liftIO $ glRenderbufferStorage ctx a b c d++sampleCoverage :: GLES => Float -> GLBool -> GL ()+sampleCoverage a b = getCtx >>= \ctx -> liftIO $ glSampleCoverage ctx a b++scissor :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GL ()+scissor a b c d = getCtx >>= \ctx -> liftIO $ glScissor ctx a b c d++shaderSource :: GLES => Shader -> GLString -> GL ()+shaderSource a b = getCtx >>= \ctx -> liftIO $ glShaderSource ctx a b++stencilFunc :: GLES => GLEnum -> GLInt -> GLUInt -> GL ()+stencilFunc a b c = getCtx >>= \ctx -> liftIO $ glStencilFunc ctx a b c++stencilFuncSeparate :: GLES => GLEnum -> GLEnum -> GLInt -> GLUInt -> GL ()+stencilFuncSeparate a b c d = getCtx >>= \ctx -> liftIO $ glStencilFuncSeparate ctx a b c d++stencilMask :: GLES => GLUInt -> GL ()+stencilMask a = getCtx >>= \ctx -> liftIO $ glStencilMask ctx a++stencilMaskSeparate :: GLES => GLEnum -> GLUInt -> GL ()+stencilMaskSeparate a b = getCtx >>= \ctx -> liftIO $ glStencilMaskSeparate ctx a b++stencilOp :: GLES => GLEnum -> GLEnum -> GLEnum -> GL ()+stencilOp a b c = getCtx >>= \ctx -> liftIO $ glStencilOp ctx a b c++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++texParameterf :: GLES => GLEnum -> GLEnum -> Float -> GL ()+texParameterf a b c = getCtx >>= \ctx -> liftIO $ glTexParameterf ctx a b c++texParameteri :: GLES => GLEnum -> GLEnum -> GLInt -> GL ()+texParameteri a b c = getCtx >>= \ctx -> liftIO $ glTexParameteri ctx a b c++texSubImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> UInt8Array -> GL ()+texSubImage2D a b c d e f g h i = getCtx >>= \ctx -> liftIO $ glTexSubImage2D ctx a b c d e f g h i++uniform1f :: GLES => UniformLocation -> Float -> GL ()+uniform1f a b = getCtx >>= \ctx -> liftIO $ glUniform1f ctx a b++uniform1fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform1fv a b = getCtx >>= \ctx -> liftIO $ glUniform1fv ctx a b++uniform1i :: GLES => UniformLocation -> Int32 -> GL ()+uniform1i a b = getCtx >>= \ctx -> liftIO $ glUniform1i ctx a b++uniform1iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform1iv a b = getCtx >>= \ctx -> liftIO $ glUniform1iv ctx a b++uniform2f :: GLES => UniformLocation -> Float -> Float -> GL ()+uniform2f a b c = getCtx >>= \ctx -> liftIO $ glUniform2f ctx a b c++uniform2fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform2fv a b = getCtx >>= \ctx -> liftIO $ glUniform2fv ctx a b++uniform2i :: GLES => UniformLocation -> Int32 -> Int32 -> GL ()+uniform2i a b c = getCtx >>= \ctx -> liftIO $ glUniform2i ctx a b c++uniform2iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform2iv a b = getCtx >>= \ctx -> liftIO $ glUniform2iv ctx a b++uniform3f :: GLES => UniformLocation -> Float -> Float -> Float -> GL ()+uniform3f a b c d = getCtx >>= \ctx -> liftIO $ glUniform3f ctx a b c d++uniform3fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform3fv a b = getCtx >>= \ctx -> liftIO $ glUniform3fv ctx a b++uniform3i :: GLES => UniformLocation -> Int32 -> Int32 -> Int32 -> GL ()+uniform3i a b c d = getCtx >>= \ctx -> liftIO $ glUniform3i ctx a b c d++uniform3iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform3iv a b = getCtx >>= \ctx -> liftIO $ glUniform3iv ctx a b++uniform4f :: GLES => UniformLocation -> Float -> Float -> Float -> Float -> GL ()+uniform4f a b c d e = getCtx >>= \ctx -> liftIO $ glUniform4f ctx a b c d e++uniform4fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform4fv a b = getCtx >>= \ctx -> liftIO $ glUniform4fv ctx a b++uniform4i :: GLES => UniformLocation -> Int32 -> Int32 -> Int32 -> Int32 -> GL ()+uniform4i a b c d e = getCtx >>= \ctx -> liftIO $ glUniform4i ctx a b c d e++uniform4iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform4iv a b = getCtx >>= \ctx -> liftIO $ glUniform4iv ctx a b++uniformMatrix2fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix2fv a b c = getCtx >>= \ctx -> liftIO $ glUniformMatrix2fv ctx a b c++uniformMatrix3fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix3fv a b c = getCtx >>= \ctx -> liftIO $ glUniformMatrix3fv ctx a b c++uniformMatrix4fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix4fv a b c = getCtx >>= \ctx -> liftIO $ glUniformMatrix4fv ctx a b c++useProgram :: GLES => Program -> GL ()+useProgram a = getCtx >>= \ctx -> liftIO $ glUseProgram ctx a++validateProgram :: GLES => Program -> GL ()+validateProgram a = getCtx >>= \ctx -> liftIO $ glValidateProgram ctx a++vertexAttrib1f :: GLES => GLUInt -> Float -> GL ()+vertexAttrib1f a b = getCtx >>= \ctx -> liftIO $ glVertexAttrib1f ctx a b++vertexAttrib1fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib1fv a b = getCtx >>= \ctx -> liftIO $ glVertexAttrib1fv ctx a b++vertexAttrib2f :: GLES => GLUInt -> Float -> Float -> GL ()+vertexAttrib2f a b c = getCtx >>= \ctx -> liftIO $ glVertexAttrib2f ctx a b c++vertexAttrib2fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib2fv a b = getCtx >>= \ctx -> liftIO $ glVertexAttrib2fv ctx a b++vertexAttrib3f :: GLES => GLUInt -> Float -> Float -> Float -> GL ()+vertexAttrib3f a b c d = getCtx >>= \ctx -> liftIO $ glVertexAttrib3f ctx a b c d++vertexAttrib3fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib3fv a b = getCtx >>= \ctx -> liftIO $ glVertexAttrib3fv ctx a b++vertexAttrib4f :: GLES => GLUInt -> Float -> Float -> Float -> Float -> GL ()+vertexAttrib4f a b c d e = getCtx >>= \ctx -> liftIO $ glVertexAttrib4f ctx a b c d e++vertexAttrib4fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib4fv a b = getCtx >>= \ctx -> liftIO $ glVertexAttrib4fv ctx a b++vertexAttribPointer :: GLES => GLUInt -> GLInt -> GLEnum -> GLBool -> GLSize -> GLPtr -> GL ()+vertexAttribPointer a b c d e f = getCtx >>= \ctx -> liftIO $ glVertexAttribPointer ctx a b c d e f++viewport :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GL ()+viewport a b c d = getCtx >>= \ctx -> liftIO $ glViewport ctx a b c d
+ Graphics/Rendering/Ombra/Internal/Resource.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,+ FunctionalDependencies, ScopedTypeVariables #-}++module Graphics.Rendering.Ombra.Internal.Resource (+ ResMap,+ ResStatus(..),+ Resource(..),+ EmbedIO(..),+ newResMap,+ addResource,+ getResource,+ 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++data ResMap i r = forall m. (Resource i r m, Hashable i) =>+ ResMap (H.BasicHashTable Int (Either String r))++data ResStatus r = Loaded r+ | Unloaded+ | Error String++class (Eq i, Applicative m, EmbedIO m) =>+ Resource i r m | i r -> m where+ loadResource :: i -> m (Either String r)+ unloadResource :: Maybe i -> r -> m ()++class MonadIO m => EmbedIO m where+ embedIO :: (IO a -> IO b) -> m a -> m b++newResMap :: (Hashable i, MonadIO io) => Resource i r m => io (ResMap i r)+newResMap = ResMap <$> liftIO H.new++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 i = checkResource' $ hash i++checkResource' :: (Resource i r m, Hashable i)+ => 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+ Just (Left e) -> Error e+ Nothing ->Unloaded++getResource :: (Resource i r m, Hashable i)+ => i -> ResMap i r+ -> m (Either String r)+getResource i rmap@(ResMap map) =+ do status <- checkResource i rmap+ case status of+ Unloaded ->+ do r <- loadResource i++ liftIO $ case r of+ Left s -> H.insert map ihash $ Left s+ Right r -> H.insert map ihash $ Right r++ embedIO (addFinalizer i) $ removeResource' ihash rmap+ Just eRes <- liftIO . H.lookup map $ hash i+ return eRes+ Error s -> return $ Left s+ Loaded r -> return $ Right r+ where ihash = hash i++-- reloadResource++removeResource :: (Resource i r m, Hashable i) => i -> ResMap i r -> m ()+removeResource i = removeResource' $ hash i++removeResource' :: (Resource i r m, Hashable i) => Int -> ResMap i r -> m ()+removeResource' i rmap@(ResMap map :: ResMap i r) = + do status <- checkResource' i rmap+ case status of+ Loaded r -> unloadResource (Nothing :: Maybe i) r+ _ -> return ()+ liftIO $ H.delete map i
+ Graphics/Rendering/Ombra/Internal/STVectorLen.hs view
@@ -0,0 +1,31 @@+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
+ Graphics/Rendering/Ombra/Internal/TList.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies,+ TypeOperators, UndecidableInstances, FlexibleContexts,+ FlexibleInstances, ConstraintKinds, PolyKinds,+ ScopedTypeVariables #-}++module Graphics.Rendering.Ombra.Internal.TList (+ Not,+ Empty,+ Equal,+ IsEqual,+ EqualOrErr,+ Member,+ IsMember,+ NotMemberOrErr,+ Subset,+ IsSubset,+ Remove,+ Difference,+ Append,+ Insert,+ Reverse,+ Union,+ Set,+ module GHC.TypeLits+) where++import GHC.TypeLits (TypeError, ErrorMessage(..))+import GHC.Exts (Constraint)++type Set xs = Union xs xs ~ xs++type family Empty (xs :: [*]) :: Bool where+ Empty '[] = True+ Empty (x ': xs) = False++type family Not (a :: Bool) :: Bool where+ Not True = False+ Not False = True++type IsEqual xs ys = And (IsSubset xs ys) (IsSubset ys xs)+type Equal xs ys = IsEqual xs ys ~ True+type EqualOrErr xs ys err = TrueOrErr (IsEqual xs ys) err++type family TrueOrErr (a :: Bool) (err :: ErrorMessage) :: Constraint where+ TrueOrErr False err = TypeError err+ TrueOrErr a err = a ~ True++type FalseOrErr a err = TrueOrErr (Not a) err++type Member x xs = IsMember x xs ~ True+type MemberOrErr x xs err = TrueOrErr (IsMember x xs) err+type NotMemberOrErr x xs err = FalseOrErr (IsMember x xs) err++type family IsMember x (xs :: [*]) :: Bool where+ IsMember x '[] = False+ IsMember x (x ': xs) = True+ IsMember y (x ': xs) = IsMember y xs++type family IsSubset (xs :: [*]) (ys :: [*]) :: Bool where+ IsSubset xs xs = True+ IsSubset '[] ys = True+ IsSubset (x ': xs) ys = And (IsMember x ys) (IsSubset xs ys)++type Subset xs ys = TrueOrErr (IsSubset xs ys)+ (Text "‘" :<>: ShowType xs :<>:+ Text "’ is not a subset of ‘" :<>:+ ShowType ys :<>: Text "’")++-- class Subset (xs :: [*]) (ys :: [*])+-- instance IsSubset xs ys ~ 'True => Subset xs ys++type family Remove x (xs :: [*]) where+ Remove x '[] = '[]+ Remove x (x ': xs) = Remove x xs+ Remove x (y ': xs) = y ': Remove x xs++type family Difference (xs :: [*]) (ys :: [*]) where+ Difference xs '[] = xs+ Difference xs (y ': ys) = Difference (Remove y xs) ys++type family Append (xs :: [*]) (ys :: [*]) where+ Append '[] ys = ys+ Append (x ': xs) ys = x ': Append xs ys++type family Insert y (xs :: [*]) where+ Insert y '[] = '[y]+ Insert y (y ': xs) = y ': xs+ Insert y (x ': xs) = x ': Insert y xs++type Reverse xs = Reverse' xs '[]++type family Reverse' (xs :: [*]) (ys :: [*]) where+ Reverse' '[] ys = ys+ Reverse' (x ': xs) ys = Reverse' xs (x ': ys)++type family Union (xs :: [*]) (ys :: [*]) where+ Union '[] ys = ys+ Union (x ': xs) ys = Union xs (Insert x ys)++type family And (a :: Bool) (b :: Bool) :: Bool where+ And True True = True+ And a b = False
+ Graphics/Rendering/Ombra/Shader.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}++{-|+An example of shader variable:++@+ data Transform2 = Transform2 Mat3 deriving Generic+@++An example of vertex shader:++@+ vertexShader :: VertexShader+ -- The types of the uniforms:+ '[Transform2, View2, Depth]+ -- The types of the attributes:+ '[Position2, UV]+ -- The types of the varying (outputs), excluding 'VertexShaderOutput'.+ '[UV]+ vertexShader + -- Set of uniforms:+ (Transform2 trans :- View2 view :- Depth z :- N)+ -- Set of attributes:+ (Position2 (Vec2 x y) :- uv@(UV _) :- N) =+ -- Matrix and vector multiplication:+ let Vec3 x' y' _ = view * trans * Vec3 x y 1+ -- Set of outputs:+ in Vertex (Vec4 x' y' z 1) -- Vertex position.+ :- uv :- N+@++Required extensions:++@+\{\-# LANGUAGE DataKinds, RebindableSyntax, DeriveDataTypeable,+ GeneralizedNewtypeDeriving, GADTs #\-\}+@++-}++module Graphics.Rendering.Ombra.Shader (+ -- * Types+ Shader,+ VertexShader,+ FragmentShader,+ VertexShaderOutput(Vertex),+ FragmentShaderOutput(..),+ Uniform,+ Attribute,+ Generic,+ SVList((:-), N),+ -- ** GPU types+ Bool,+ Float,+ Int,+ Sampler2D,+ SamplerCube,+ Vec2(..),+ Vec3(..),+ Vec4(..),+ BVec2(..),+ BVec3(..),+ BVec4(..),+ IVec2(..),+ IVec3(..),+ IVec4(..),+ Mat2(..),+ Mat3(..),+ Mat4(..),+ Array,+ -- * Functions+ loop,+ store,+ texture2D,+ texture2DBias,+ texture2DProj,+ texture2DProjBias,+ texture2DProj4,+ texture2DProjBias4,+ texture2DLod,+ texture2DProjLod,+ texture2DProjLod4,+ arrayLength,+ -- ** Math functions+ radians,+ degrees,+ sin,+ cos,+ tan,+ asin,+ acos,+ atan,+ atan2,+ exp,+ log,+ exp2,+ log2,+ sqrt,+ inversesqrt,+ abs,+ sign,+ floor,+ ceil,+ fract,+ mod,+ min,+ max,+ clamp,+ mix,+ step,+ smoothstep,+ length,+ distance,+ dot,+ cross,+ normalize,+ faceforward,+ reflect,+ refract,+ matrixCompMult,+ -- *** Vector relational functions+ VecOrd,+ VecEq,+ lessThan,+ lessThanEqual,+ greaterThan,+ greaterThanEqual,+ equal,+ notEqual,+ BoolVector,+ anyB,+ allB,+ notB,+ -- ** Constructors+ true,+ false,+ ToBool,+ bool,+ ToInt,+ int,+ ToFloat,+ float,+ Components,+ CompList,+ ToCompList,+ (#),+ ToVec2,+ vec2,+ ToVec3,+ vec3,+ ToVec4,+ vec4,+ ToBVec2,+ bvec2,+ ToBVec3,+ bvec3,+ ToBVec4,+ bvec4,+ ToIVec2,+ ivec2,+ ToIVec3,+ ivec3,+ ToIVec4,+ ivec4,+ ToMat2,+ mat2,+ ToMat3,+ mat3,+ ToMat4,+ mat4,+ -- ** Operators+ (*),+ (/),+ (+),+ (-),+ (^),+ (&&),+ (||),+ (==),+ (>=),+ (<=),+ (<),+ (>),+ (!),+ -- ** Rebinding functions+ fromInteger,+ fromRational,+ ifThenElse,+ negate,+ -- ** Prelude functions+ (.),+ id,+ const,+ flip,+ ($),+ CPU.fst,+ CPU.snd,+ -- * Variables+ position,+ fragData,+ fragCoord,+ 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+import Graphics.Rendering.Ombra.Shader.ShaderVar+import Graphics.Rendering.Ombra.Shader.Stages+import Prelude ((.), id, const, flip, ($))+import qualified Prelude as CPU
+ Graphics/Rendering/Ombra/Shader/CPU.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, DataKinds, TypeOperators,+ FunctionalDependencies, FlexibleInstances, RankNTypes, PolyKinds,+ FlexibleContexts, UndecidableInstances, ScopedTypeVariables #-}++module Graphics.Rendering.Ombra.Shader.CPU (+ CPUSetterType(..),+ CPU(..),+ CPUBase(..),+ BaseUniform(..),+ BaseAttribute(..),+ Uniform(..),+ Attribute(..),+ toGPUBool,+ single,+ mirror+) 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+import GHC.Generics hiding (S)+import qualified GHC.Generics as G+import qualified Data.Vect.Float as CPU+import Prelude as CPU++single :: Proxy S+single = Proxy++mirror :: Proxy M+mirror = Proxy++-- | This kind represents the way you are setting a GPU value.+data CPUSetterType k+ = S -- ^ Single CPU type (only for types with one field)+ | M -- ^ Mirror type (a data type identical to the GPU+ -- one but with CPU single types instead of GPU)++type family CPU (s :: CPUSetterType *) g where+ CPU 'S x = CPUSingle x+ CPU 'M x = CPUMirror x++type family CPUBase g+type family CPUMirror g++-- type family CPUAutoSetter (g :: * -> *) :: CPUSetterType+-- type CPUAuto g = CPU (CPUAutoSetter g) g++-- | CPU types convertible to GPU types (as uniforms).+class BaseUniform g where+ setUniform :: UniformLocation -> proxy g -> CPUBase g -> GL ()++-- | CPU types convertible to GPU types (as attributes).+class GPU.ShaderType g => BaseAttribute g where+ encodeAttribute :: proxy g -> [CPUBase g] -> GL AnyArray+ setAttribute :: proxy g -> GLUInt -> GL ()++class Generic g => Uniform (s :: CPUSetterType *) g where+ withUniforms :: Applicative f+ => proxy s+ -> g+ -> CPU s g+ -> (forall g. BaseUniform g => Int -> Proxy g+ -> CPUBase g -> f ())+ -> f ()++class Generic g => Attribute (s :: CPUSetterType *) g where+ withAttributes :: Applicative f+ => proxy s+ -> g+ -> [CPU s g]+ -> (forall g. BaseAttribute g => Int -> Proxy g+ -> [CPUBase g] -> f ())+ -> f ()++instance (BaseUniform (GCPUValue (Rep g)), Generic g) => Uniform S g where+ withUniforms _ (g :: 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 =+ f 0 (Proxy :: Proxy (GCPUValue (Rep g))) c++instance ( GUniformMirror (Rep g) (Rep (CPUMirror g))+ (TData (Rep (CPUMirror g)))+ (TCons (Rep (CPUMirror g)))+ , Generic g, Generic (CPUMirror g) )+ => Uniform M g where+ withUniforms _ (g :: g) c f =+ fst $ gWithUniformMirror+ (Proxy :: Proxy (MTuple (TData (Rep (CPUMirror g)))+ (TCons (Rep (CPUMirror g)))) )+ 0 (from g) (from c) f++{-+instance ( GAttributeMirror (Rep g) (Rep (CPUMirror g))+ (TData (Rep (CPUMirror g)))+ (TCons (Rep (CPUMirror g)))+ , Generic g, Generic (CPUMirror g) )+ => Attribute M g where+ withAttributes _ (g :: g) c f =+ fst $ gWithAttributeMirror+ (Proxy :: Proxy ( (TData (Rep (CPUMirror g)))+ , (TCons (Rep (CPUMirror g)))) )+ 0 (from g) (from c) f+-}++type family TData (g :: * -> *) :: Meta where+ TData (M1 D d a) = d++type family TCons (g :: * -> *) :: Meta where+ TCons (M1 D d a) = TCons a+ TCons (M1 C c a) = c++type family GCPUValue (g :: * -> *) where+ GCPUValue (M1 i c a) = GCPUValue a+ GCPUValue (K1 i a) = a++type CPUSingle g = GCPUSingle (Rep g)+type GCPUSingle g = CPUBase (GCPUValue g)+++type family GCPUMirror (g :: * -> *) d c :: * -> * where+ GCPUMirror (a :*: b) d c = GCPUMirror a d c :*: GCPUMirror b d c+ GCPUMirror (M1 D gd a) d c = M1 D d (GCPUMirror a d c)+ GCPUMirror (M1 C gc a) d c = M1 C c (GCPUMirror a d c)+ GCPUMirror (M1 G.S s a) d c = M1 G.S s (GCPUMirror a d c)+ GCPUMirror (K1 i a) d c = K1 i (CPUBase a)++data MTuple (d :: k) (c :: k)++class GUniformMirror (g :: * -> *) (m :: * -> *) (d :: Meta) (c :: Meta) where+ gWithUniformMirror :: Applicative f+ => proxy (MTuple d c)+ -> Int+ -> g a+ -> m b+ -> (forall u. BaseUniform u => Int -> Proxy u+ -> CPUBase u -> f ())+ -> (f (), Int)++instance ( GUniformMirror a (GCPUMirror a d c) d c+ , GUniformMirror b (GCPUMirror b d c) d c+ , m ~ GCPUMirror (a :*: b) d c )+ => GUniformMirror (a :*: b) m d c where+ gWithUniformMirror p i (x :*: y) (mx :*: my) f =+ let (a1, i') = gWithUniformMirror p i x mx f+ (a2, i'') = gWithUniformMirror p i' y my f+ in (a1 *> a2, i'')++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++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 =+ (f i (Proxy :: Proxy t) mx, i + 1)++{-+class GAttributeMirror (g :: * -> *) (m :: * -> *) d c where+ gWithAttributeMirror :: Applicative f+ => proxy (MTuple d c)+ -> Int+ -> g a+ -> m b+ -> (forall u. BaseAttribute u => Int -> Proxy u+ -> CPUBase u+ -> f ())+ -> (f (), Int)++instance ( GAttributeMirror a (GCPUMirror a d c) d c+ , GAttributeMirror b (GCPUMirror b d c) d c+ , m ~ GCPUMirror (a :*: b) d c )+ => GAttributeMirror (a :*: b) m d c where+ gWithAttributeMirror p i (x :*: y) (mx :*: my) f =+ let (a1, i') = gWithAttributeMirror p i x mx f+ (a2, i'') = gWithAttributeMirror p i' y my f+ in (a1 *> a2, i'')++instance ( GAttributeMirror a ma d c+ , M1 mi mv ma ~ GCPUMirror (M1 i v a) d c )+ => GAttributeMirror (M1 i v a) (M1 mi mv ma) d c where+ gWithAttributeMirror p i (M1 x) (M1 mx) f =+ gWithAttributeMirror p i x mx f++instance (BaseAttribute a, m ~ GCPUMirror (K1 i a) d c)+ => GAttributeMirror (K1 i a) m d c where+ gWithAttributeMirror _ i (K1 (x :: t)) (K1 mx) f =+ (f i (Proxy :: Proxy t) mx, i + 1)+-}++-- Float++type instance CPUBase GPU.Float = CPU.Float+type instance CPUBase (GPU.Array n GPU.Float) = [CPU.Float]++instance GLES => BaseUniform GPU.Float where+ setUniform l _ v = uniform1f l v++instance GLES => BaseUniform (GPU.Array n GPU.Float) where+ setUniform l _ v = liftIO (encodeFloats v) >>= uniform1fv l++instance GLES => BaseAttribute GPU.Float where+ encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeFloats a+ setAttribute _ i = attr gl_FLOAT i 1++-- Bool++type instance CPUBase GPU.Bool = CPU.Int32+type instance CPUBase (GPU.Array n GPU.Bool) = [CPU.Int32]++instance GLES => BaseUniform GPU.Bool where+ setUniform l _ v = uniform1i l v++instance GLES => BaseUniform (GPU.Array n GPU.Bool) where+ setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l++instance GLES => BaseAttribute GPU.Bool where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a+ setAttribute _ i = attr gl_INT i 1++-- Int++type instance CPUBase GPU.Int = CPU.Int32+type instance CPUBase (GPU.Array n GPU.Int) = [CPU.Int32]++instance GLES => BaseUniform GPU.Int where+ setUniform l _ v = uniform1i l v++instance GLES => BaseUniform (GPU.Array n GPU.Int) where+ setUniform l _ v = liftIO (encodeInts v) >>= uniform1iv l++instance GLES => BaseAttribute GPU.Int where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeInts a+ setAttribute _ i = attr gl_INT i 1++-- TODO: sampler arrays (they're problematic to safely access in the shaders)+-- Samplers++type instance CPUBase GPU.Sampler2D = CPU.ActiveTexture+type instance CPUBase GPU.SamplerCube = CPU.ActiveTexture++instance GLES => BaseUniform GPU.Sampler2D where+ setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v++instance GLES => BaseUniform GPU.SamplerCube where+ setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v++-- Vec2++type instance CPUBase GPU.Vec2 = CPU.Vec2+type instance CPUBase (GPU.Array n GPU.Vec2) = [CPU.Vec2]++instance GLES => BaseUniform GPU.Vec2 where+ setUniform l _ (CPU.Vec2 x y) = uniform2f l x y++instance GLES => BaseUniform (GPU.Array n GPU.Vec2) where+ setUniform l _ v = liftIO (encodeVec2s v) >>= uniform2fv l++instance GLES => BaseAttribute GPU.Vec2 where+ encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec2s a+ setAttribute _ i = attr gl_FLOAT i 2++-- Vec3++type instance CPUBase GPU.Vec3 = CPU.Vec3+type instance CPUBase (GPU.Array n GPU.Vec3) = [CPU.Vec3]++instance GLES => BaseUniform GPU.Vec3 where+ setUniform l _ (CPU.Vec3 x y z) = uniform3f l x y z++instance GLES => BaseUniform (GPU.Array n GPU.Vec3) where+ setUniform l _ v = liftIO (encodeVec3s v) >>= uniform3fv l++instance GLES => BaseAttribute GPU.Vec3 where+ encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec3s a+ setAttribute _ i = attr gl_FLOAT i 3++-- Vec4++type instance CPUBase GPU.Vec4 = CPU.Vec4+type instance CPUBase (GPU.Array n GPU.Vec4) = [CPU.Vec4]++instance GLES => BaseUniform GPU.Vec4 where+ setUniform l _ (CPU.Vec4 x y z w) = uniform4f l x y z w++instance GLES => BaseUniform (GPU.Array n GPU.Vec4) where+ setUniform l _ v = liftIO (encodeVec4s v) >>= uniform4fv l++instance GLES => BaseAttribute GPU.Vec4 where+ encodeAttribute _ a = liftIO . fmap fromFloat32Array $ encodeVec4s a+ setAttribute _ i = attr gl_FLOAT i 4++-- IVec2++type instance CPUBase GPU.IVec2 = CPU.IVec2+type instance CPUBase (GPU.Array n GPU.IVec2) = [CPU.IVec2]++instance GLES => BaseUniform GPU.IVec2 where+ setUniform l _ (CPU.IVec2 x y) = uniform2i l x y++instance GLES => BaseUniform (GPU.Array n GPU.IVec2) where+ setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l++instance GLES => BaseAttribute GPU.IVec2 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a+ setAttribute _ i = attr gl_INT i 2++-- IVec3++type instance CPUBase GPU.IVec3 = CPU.IVec3+type instance CPUBase (GPU.Array n GPU.IVec3) = [CPU.IVec3]++instance GLES => BaseUniform GPU.IVec3 where+ setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z++instance GLES => BaseUniform (GPU.Array n GPU.IVec3) where+ setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l++instance GLES => BaseAttribute GPU.IVec3 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a+ setAttribute _ i = attr gl_INT i 3++-- IVec4++type instance CPUBase GPU.IVec4 = CPU.IVec4+type instance CPUBase (GPU.Array n GPU.IVec4) = [CPU.IVec4]++instance GLES => BaseUniform GPU.IVec4 where+ setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w++instance GLES => BaseUniform (GPU.Array n GPU.IVec4) where+ setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l++instance GLES => BaseAttribute GPU.IVec4 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a+ setAttribute _ i = attr gl_INT i 4++-- BVec2++type instance CPUBase GPU.BVec2 = CPU.IVec2+type instance CPUBase (GPU.Array n GPU.BVec2) = [CPU.IVec2]++instance GLES => BaseUniform GPU.BVec2 where+ setUniform l _ (CPU.IVec2 x y) = uniform2i l x y++instance GLES => BaseUniform (GPU.Array n GPU.BVec2) where+ setUniform l _ v = liftIO (encodeIVec2s v) >>= uniform2iv l++instance GLES => BaseAttribute GPU.BVec2 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec2s a+ setAttribute _ i = attr gl_INT i 2++-- BVec3++type instance CPUBase GPU.BVec3 = CPU.IVec3+type instance CPUBase (GPU.Array n GPU.BVec3) = [CPU.IVec3]++instance GLES => BaseUniform GPU.BVec3 where+ setUniform l _ (CPU.IVec3 x y z) = uniform3i l x y z++instance GLES => BaseUniform (GPU.Array n GPU.BVec3) where+ setUniform l _ v = liftIO (encodeIVec3s v) >>= uniform3iv l++instance GLES => BaseAttribute GPU.BVec3 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec3s a+ setAttribute _ i = attr gl_INT i 3++-- BVec4++type instance CPUBase GPU.BVec4 = CPU.IVec4+type instance CPUBase (GPU.Array n GPU.BVec4) = [CPU.IVec4]++instance GLES => BaseUniform GPU.BVec4 where+ setUniform l _ (CPU.IVec4 x y z w) = uniform4i l x y z w++instance GLES => BaseUniform (GPU.Array n GPU.BVec4) where+ setUniform l _ v = liftIO (encodeIVec4s v) >>= uniform4iv l++instance GLES => BaseAttribute GPU.BVec4 where+ encodeAttribute _ a = liftIO . fmap fromInt32Array $ encodeIVec4s a+ setAttribute _ i = attr gl_INT i 4++-- Matrices++type instance CPUBase GPU.Mat2 = CPU.Mat2+type instance CPUBase GPU.Mat3 = CPU.Mat3+type instance CPUBase GPU.Mat4 = CPU.Mat4++instance GLES => BaseUniform GPU.Mat2 where+ setUniform l _ m = liftIO (encodeMat2 m) >>= uniformMatrix2fv l false++instance GLES => BaseUniform GPU.Mat3 where+ setUniform l _ m = liftIO (encodeMat3 m) >>= uniformMatrix3fv l false++instance GLES => BaseUniform GPU.Mat4 where+ setUniform l _ m = liftIO (encodeMat4 m) >>= uniformMatrix4fv l false++class BaseUniforms (xs :: [*])+instance BaseUniform x => BaseUniforms (x ': '[])+instance (BaseUniform x, BaseUniforms (y ': xs)) =>+ BaseUniforms (x ': y ': xs)++class BaseAttributes (xs :: [*])+instance BaseAttribute x => BaseAttributes (x ': '[])+instance (BaseAttribute x, BaseAttributes (y ': xs)) =>+ BaseAttributes (x ': y ': xs)++attr :: GLES => GLEnum -> GLUInt -> GLInt -> GL ()+attr t i s = vertexAttribPointer i s t false 0 nullGLPtr++toGPUBool :: CPU.Bool -> CPU.Int32+toGPUBool True = 1+toGPUBool False = 0
+ Graphics/Rendering/Ombra/Shader/Default2D.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds, RebindableSyntax, DeriveGeneric, GADTs #-}++module Graphics.Rendering.Ombra.Shader.Default2D where++import Graphics.Rendering.Ombra.Shader++type Uniforms = '[View2, Image, Depth, Transform2]+type Attributes = '[Position2, UV]++-- | An uniform that represents the texture used in the default 2D shader.+data Image = Image Sampler2D deriving Generic++-- | An uniform that represents the depth used in the default 2D shader.+data Depth = Depth Float deriving Generic++-- | An uniform that represents the transformation matrix used in the default+-- 2D shader.+data Transform2 = Transform2 Mat3 deriving Generic+-- | An uniform that represents the view matrix used in the default 2D shader.+data View2 = View2 Mat3 deriving Generic++data Position2 = Position2 Vec2 deriving Generic++data UV = UV Vec2 deriving Generic++vertexShader :: VertexShader '[Transform2, View2, Depth]+ '[Position2, UV] '[UV]+vertexShader (Transform2 trans :- View2 view :- Depth z :- N)+ (Position2 (Vec2 x y) :- uv@(UV _) :- N) =+ let Vec3 x' y' _ = view * trans * Vec3 x y 1+ in Vertex (Vec4 x' y' z 1) :- uv :- N++fragmentShader :: FragmentShader '[Image] '[UV]+fragmentShader (Image sampler :- N) (UV (Vec2 s t) :- N) =+ Fragment (texture2D sampler (Vec2 s $ 1 - t)) :- N
+ Graphics/Rendering/Ombra/Shader/Default3D.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds, RebindableSyntax, DeriveGeneric, GADTs #-}++module Graphics.Rendering.Ombra.Shader.Default3D where++import Graphics.Rendering.Ombra.Shader++type Uniforms = '[View3, Transform3, Texture2]+type Attributes = '[Position3, UV, Normal3]++data Texture2 = Texture2 Sampler2D deriving Generic++data Transform3 = Transform3 Mat4 deriving Generic++data View3 = View3 Mat4 deriving Generic++data Position3 = Position3 Vec3 deriving Generic++data Normal3 = Normal3 Vec3 deriving Generic++data UV = UV Vec2 deriving Generic++vertexShader :: VertexShader '[ Transform3, View3 ]+ '[ Position3, UV, Normal3 ]+ '[ 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++fragmentShader :: FragmentShader '[ Texture2 ] [ UV, Normal3 ]+fragmentShader (Texture2 sampler :- N) (UV (Vec2 s t) :- Normal3 _ :- N) =+ Fragment (texture2D sampler $ Vec2 s (1 - t)) :- N
+ Graphics/Rendering/Ombra/Shader/GLSL.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts,+ KindSignatures, DataKinds, TypeOperators, ConstraintKinds #-}++module Graphics.Rendering.Ombra.Shader.GLSL (+ vertexToGLSLAttr,+ vertexToGLSL,+ fragmentToGLSL,+ shaderToGLSL,+ 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 Text.Printf++data VarPrefix = Global | Varying | Attribute++data ShaderVars = ShaderVars {+ uniformVars :: [(String, String)],+ inputVars :: [(String, String, Int)],+ outputVars :: [(String, String, Expr)]+}++vertexToGLSLAttr :: ValidVertex g i o => VertexShader g i o+ -> (String, [(String, Int)])+vertexToGLSLAttr v =+ let r@(ShaderVars _ is _) = vars False v+ in ( shaderToGLSL "#version 100\n" "attribute" "varying"+ r [("hvVertexShaderOutput0", "gl_Position")]+ , map (\(t, n, s) -> (n, s)) is)++vertexToGLSL :: ValidVertex g i o => VertexShader g i o -> String+vertexToGLSL = fst . vertexToGLSLAttr++fragmentToGLSL :: Valid g i '[] => FragmentShader g i -> String+fragmentToGLSL v =+ shaderToGLSL "#version 100\nprecision mediump float;"+ "varying" "" (vars True v)+ [ ("hvFragmentShaderOutput0", "gl_FragData[0]")+ , ("hvFragmentShaderOutput1", "gl_FragData[1]")+ , ("hvFragmentShaderOutput2", "gl_FragData[2]")+ , ("hvFragmentShaderOutput3", "gl_FragData[3]")+ , ("hvFragmentShaderOutput4", "gl_FragData[4]")+ , ("hvFragmentShaderOutput5", "gl_FragData[5]")+ , ("hvFragmentShaderOutput6", "gl_FragData[6]")+ , ("hvFragmentShaderOutput7", "gl_FragData[7]")+ , ("hvFragmentShaderOutput8", "gl_FragData[8]")+ , ("hvFragmentShaderOutput9", "gl_FragData[9]")+ , ("hvFragmentShaderOutput10", "gl_FragData[10]")+ , ("hvFragmentShaderOutput11", "gl_FragData[11]")+ , ("hvFragmentShaderOutput12", "gl_FragData[12]")+ , ("hvFragmentShaderOutput13", "gl_FragData[13]")+ , ("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+ [ header+ , concatMap (var "uniform") gs+ , concatMap (\(t, n, _) -> var ins (t, n)) is+ , concatMap (\(t, n, _) -> if any ((== n) . fst) predec+ then []+ else var outs (t, n)+ ) os+ , "void main(){"+ , actions+ , concatMap (\(n, s) -> replace n predec ++ "=" ++ s ++ ";")+ compiledOuts+ , "}" ]+ where var qual (ty, nm) = qual ++ " " ++ ty ++ " " ++ nm ++ ";"+ replace x xs = case filter ((== x) . fst) xs of+ ((_, 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 isFragment (shader :: Shader gs is os) =+ ShaderVars (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++ inputPrefix = if isFragment then Varying else Attribute++ globalVar :: ShaderVar v => v -> [(String, String)]+ globalVar var = varToList+ (\n x -> (typeName x, varName Global var n))+ var++ inputVar :: ShaderVar v => v -> [(String, String, Int)]+ inputVar var = varToList (\n x -> ( typeName x+ , varName inputPrefix var n+ , size x )) var++ outputVar :: ShaderVar v => v -> [(String, String, Expr)]+ outputVar var = varToList (\n x -> ( typeName x+ , varName Varying var n+ , toExpr x )) var++ varExpr :: ShaderVar v => VarPrefix -> Proxy v -> v+ varExpr p (pvar :: Proxy v) =+ varBuild (\n -> fromExpr . Read $ varName p var n) pvar+ where var = undefined :: v++type ActionID = Int+type ActionMap = H.HashMap ActionID Action+type ActionSet = H.HashMap ActionID ()++data ActionInfo = ActionInfo {+ actionGenerator :: ActionGenerator,+ actionDeps :: ActionSet,+ actionContext :: ActionContext+}++type ActionGenerator = String -> String++-- | The context is where an action should be put. Only for-loops are considered+-- contexts, because there is no reason to put an action inside another block.+-- Of course, an action could have many contexts (e.g. for(..) { for (..) {+-- act; } }), but only one is actually needed to compile the action.+data ActionContext = ShallowContext ActionSet -- ^ The contexts of the expressions used in the action.+ | DeepContext ActionSet -- ^ All the contexts (including those of the dependencies).+ deriving (Show)++type ActionGraph = H.HashMap ActionID ActionInfo++-- | Compile a list of 'Expr', sharing their actions.+compile :: [Expr] -> (String, [String])+compile exprs = let (strs, deps, _) = unzip3 $ map compileExpr exprs+ depGraph = contextAll deep . buildActionGraph $ H.unions deps+ sorted = sortActions depGraph+ in (sorted >>= uncurry generate, strs)++generate :: ActionGenerator -> ActionGraph -> String+generate gen graph = gen $ sortActions graph >>= uncurry generate++sortActions :: ActionGraph -> [(ActionGenerator, ActionGraph)]+sortActions fullGraph = visitLoop (H.empty, [], fullGraph)+ where visitLoop state@(childrenMap, sortedIDs, graph)+ | H.null graph = map (makePair childrenMap fullGraph) sortedIDs+ | otherwise = visitLoop $ visit (head $ H.keys graph) state++ visit aID state@(_, _, graph) =+ case H.lookup aID graph of+ Nothing -> state+ Just ai -> visitNew aID ai state++ visitNew aID ai (childrenMap, sortedIDs, graph) = + let deps = actionDeps ai+ (childrenMap', sortedIDs', graph') =+ H.foldrWithKey+ (\aID _ state -> visit aID state)+ (childrenMap, sortedIDs, graph)+ deps+ in case actionContext ai of+ DeepContext ctx | H.null ctx ||+ ctx == H.singleton aID () ->+ ( childrenMap', sortedIDs' ++ [aID]+ , H.delete aID graph' )++ DeepContext ctx ->+ let smap = H.map (\_ -> H.singleton aID ai+ ) ctx+ cmap' = H.unionWith H.union smap+ childrenMap'+ in (cmap', sortedIDs', H.delete aID graph')++ makePair childrenMap graph aID = + ( actionGenerator $ graph H.! aID+ , case H.lookup aID childrenMap of+ Just g -> H.map (delDeep aID) g+ Nothing -> H.empty )++ delDeep k ai = let (DeepContext ctx) = actionContext ai+ in ai { actionContext = DeepContext $+ H.delete k ctx }++-- | Build an action graph with shallow contexts.+buildActionGraph :: ActionMap -> ActionGraph+buildActionGraph = flip H.foldrWithKey H.empty $+ \aID act graph ->+ let (info, deps) = compileAction aID act+ in H.union (H.insert aID info graph)+ (buildActionGraph deps)++-- | Transform every context.+contextAll :: (ActionID -> ActionGraph -> (ActionContext, ActionGraph))+ -> ActionGraph -> ActionGraph+contextAll f g = H.foldrWithKey (\aID _ graph -> snd $ f aID graph) g g++-- | Find and build the deep context of this action. Returns a deep context and+-- a new graph with the deep contexts of this action and of its dependencies.+deep :: ActionID -> ActionGraph -> (ActionContext, ActionGraph)+deep aID graph =+ case actionContext act of+ ShallowContext sctx ->+ let (dctx, graph') = H.foldrWithKey addDepContext+ (sctx, graph)+ (actionDeps act)+ ctx' = DeepContext dctx+ in (ctx', H.insert+ aID (act { actionContext = ctx' }) graph')+ ctx -> (ctx, graph)+ where act = graph H.! aID+ addDepContext depID depInfo (ctx, graph) = + let (DeepContext dCtx, graph') = deep depID graph + in (H.union ctx (H.delete depID dCtx), graph')++-- | Compile an 'Expr'. Returns the compiled expression, the map of dependencies+-- and the context.+compileExpr :: Expr -> (String, ActionMap, ActionSet)+compileExpr Empty = ("", H.empty, H.empty)+compileExpr (Read s) = (s, H.empty, H.empty)++compileExpr (Op1 s e) = first3 (\x -> "(" ++ s ++ x ++ ")") $ compileExpr e++compileExpr (Op2 s ex ey) = let (x, ax, cx) = compileExpr ex+ (y, ay, cy) = compileExpr ey+ in ( "(" ++ x ++ s ++ y ++ ")"+ , H.union ax ay, H.union cx cy )++compileExpr (Apply s es) = let (vs, as, cs) = unzip3 $ map compileExpr es+ in ( concat $ [ s, "(" , tail (vs >>= (',' :)), ")" ]+ , H.unions as, H.unions cs)++compileExpr (X e) = first3 (++ "[0]") $ compileExpr e+compileExpr (Y e) = first3 (++ "[1]") $ compileExpr e+compileExpr (Z e) = first3 (++ "[2]") $ compileExpr e+compileExpr (W e) = first3 (++ "[3]") $ compileExpr e+compileExpr (Literal s) = (s, H.empty, H.empty)+compileExpr (Action a) = let h = hash a+ in (actionName h, H.singleton h a, H.empty)+compileExpr (Dummy _) = error "compileExpr: Dummy"+compileExpr (ArrayIndex eArr ei) = let (arr, aArr, cArr) = compileExpr eArr+ (i, ai, ci) = compileExpr ei+ in ( "(" ++ arr ++ "[" ++ i ++ "])"+ , H.union aArr ai, H.union cArr ci )+compileExpr (ContextVar i t) = (contextVarName t i, H.empty, H.singleton i ())++first3 :: (a -> a') -> (a, b, c) -> (a', b, c)+first3 f (a, b, c) = (f a, b, c)++compileAction :: ActionID -> Action -> (ActionInfo, ActionMap)+compileAction aID (Store ty expr) =+ let (eStr, deps, ctxs) = compileExpr expr+ in ( ActionInfo (\c -> concat [ c, ty, " ", actionName aID+ , "=", eStr, ";" ])+ (H.map (const ()) deps)+ (ShallowContext ctxs)+ , deps )++compileAction aID (If cExpr ty tExpr fExpr) =+ let (cStr, cDeps, cCtxs) = compileExpr cExpr+ (tStr, tDeps, tCtxs) = compileExpr tExpr+ (fStr, fDeps, fCtxs) = compileExpr fExpr+ deps = H.unions [cDeps, tDeps, fDeps]+ name = actionName aID+ in ( ActionInfo (\c -> concat [ ty, " ", name, ";if("+ , cStr, "){", c, name, "=", tStr+ , ";}else{" , name, "=", fStr, ";}" ])+ (H.map (const ()) deps)+ (ShallowContext $ H.unions [cCtxs, tCtxs, fCtxs])+ , deps )++compileAction aID (For iters ty initVal body) =+ let iterName = contextVarName LoopIteration aID+ valueName = contextVarName LoopValue aID+ (nExpr, sExpr) = body (ContextVar aID LoopIteration)+ (ContextVar aID LoopValue)+ (iStr, iDeps, iCtxs) = compileExpr initVal+ (nStr, nDeps, nCtxs) = compileExpr nExpr+ (sStr, sDeps, sCtxs) = compileExpr sExpr+ deps = H.unions [iDeps, nDeps, sDeps]+ in ( ActionInfo (\c -> concat [ ty, " ", valueName, "=", iStr, ";"+ , "for(float ", iterName, "=0.0;"+ , iterName, "<", show iters, ".0;"+ , "++", iterName, "){", c+ , "if(", sStr, "){break;}"+ , valueName, "=", nStr, ";}" ])+ (H.map (const ()) deps)+ (ShallowContext $ H.unions [iCtxs, nCtxs, sCtxs])+ , deps )++actionName :: ActionID -> String+actionName = ('a' :) . hashName++contextVarName :: ContextVarType -> ActionID -> String+contextVarName LoopIteration = ('l' :) . hashName+contextVarName LoopValue = actionName++hashName :: ActionID -> String+hashName = printf "%x"++uniformName :: ShaderVar v => v -> Int -> String+uniformName = varName Global++varName :: ShaderVar v => VarPrefix -> v -> Int -> String+varName prefix var n = prefixName prefix ++ varPreName var ++ show n+ where prefixName Global = "hg"+ prefixName Varying = "hv"+ prefixName Attribute = "ha"
+ Graphics/Rendering/Ombra/Shader/Language/Functions.hs view
@@ -0,0 +1,648 @@+{-# LANGUAGE DataKinds, MultiParamTypeClasses, FunctionalDependencies,+ KindSignatures, TypeOperators, TypeFamilies, GADTs,+ FlexibleInstances, UndecidableInstances, + ConstraintKinds, FlexibleContexts #-}+module Graphics.Rendering.Ombra.Shader.Language.Functions where++import Graphics.Rendering.Ombra.Shader.Language.Types++import GHC.Exts (Constraint)+import GHC.TypeLits+import Text.Printf+import Prelude (String, (.), ($), error, Eq)+import qualified Prelude++-- TODO: memoized versions of the functions++class Base a b | a -> b+instance Base Int Int+instance Base IVec2 Int+instance Base IVec3 Int+instance Base IVec4 Int+instance Base Float Float+instance Base Vec2 Float+instance Base Vec3 Float+instance Base Vec4 Float+instance Base Mat2 Float+instance Base Mat3 Float+instance Base Mat4 Float++class (Base a aBase, Base b bBase) =>+ Arithmetic aBase bBase a b result | a b -> result+ , b -> aBase bBase+ , a -> aBase bBase+ , result -> aBase bBase++instance Arithmetic Float Float Float Float Float+instance Arithmetic Float Float Vec2 Vec2 Vec2+instance Arithmetic Float Float Vec3 Vec3 Vec3+instance Arithmetic Float Float Vec4 Vec4 Vec4+instance Arithmetic Float Float Vec2 Float Vec2+instance Arithmetic Float Float Vec3 Float Vec3+instance Arithmetic Float Float Vec4 Float Vec4+instance Arithmetic Float Float Float Vec2 Vec2+instance Arithmetic Float Float Float Vec3 Vec3+instance Arithmetic Float Float Float Vec4 Vec4+instance Arithmetic Float Float Mat2 Mat2 Mat2+instance Arithmetic Float Float Mat3 Mat3 Mat3+instance Arithmetic Float Float Mat4 Mat4 Mat4+instance Arithmetic Float Float Mat2 Float Mat2+instance Arithmetic Float Float Mat3 Float Mat3+instance Arithmetic Float Float Mat4 Float Mat4+instance Arithmetic Float Float Float Mat2 Mat2+instance Arithmetic Float Float Float Mat3 Mat3+instance Arithmetic Float Float Float Mat4 Mat4++instance Arithmetic Int Int Int Int Int+instance Arithmetic Int Int IVec2 IVec2 IVec2+instance Arithmetic Int Int IVec3 IVec3 IVec3+instance Arithmetic Int Int IVec4 IVec4 IVec4+instance Arithmetic Int Int IVec2 Int IVec2+instance Arithmetic Int Int IVec3 Int IVec3+instance Arithmetic Int Int IVec4 Int IVec4+instance Arithmetic Int Int Int IVec2 IVec2+instance Arithmetic Int Int Int IVec3 IVec3+instance Arithmetic Int Int Int IVec4 IVec4++-- | Types that can be multiplied.+class (Base a aBase, Base b bBase) =>+ Mul aBase bBase a b result | a b -> result+ , b -> aBase bBase+ , a -> aBase bBase+ , result -> aBase bBase+instance Mul Float Float Mat2 Vec2 Vec2+instance Mul Float Float Mat3 Vec3 Vec3+instance Mul Float Float Mat4 Vec4 Vec4+instance Mul Float Float Vec2 Mat2 Vec2+instance Mul Float Float Vec3 Mat3 Vec3+instance Mul Float Float Vec4 Mat4 Vec4+instance {-# OVERLAPPABLE #-} + ( Arithmetic aBase bBase a b result+ , Base a aBase, Base b bBase) =>+ Mul aBase bBase a b result++class (ShaderType a, Base a Float) => FloatVec a+instance FloatVec Vec2+instance FloatVec Vec3+instance FloatVec Vec4++-- | Floats or vectors.+class ShaderType a => GenType a+instance {-# OVERLAPS #-} GenType Float+instance {-# OVERLAPPABLE #-} (FloatVec a, ShaderType a) => GenType a++type family GenTypeFloatConstr a b where+ GenTypeFloatConstr a Float = GenType a+ GenTypeFloatConstr a a = GenType a++type GenTypeFloat a b = (GenTypeFloatConstr a b, ShaderType a, ShaderType b)++infixl 7 *+(*) :: (Mul aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+ => a -> b -> c+(*) = op2 "*"++infixl 7 /+(/) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+ => a -> b -> c+(/) = op2 "/"++infixl 6 ++(+) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+ => a -> b -> c+(+) = op2 "+"++infixl 6 -+(-) :: (Arithmetic aBase bBase a b c, ShaderType a, ShaderType b, ShaderType c)+ => a -> b -> c+(-) = op2 "-"++infixr 8 ^+(^) :: (ShaderType a, GenType a) => a -> a -> a+(^) = fun2 "pow"++infixr 3 &&+(&&) :: Bool -> Bool -> Bool+(&&) = op2 "&&"++infixr 2 ||+(||) :: Bool -> Bool -> Bool+(||) = op2 "||"++infix 4 ==+(==) :: ShaderType a => a -> a -> Bool+(==) = op2 "=="++infix 4 /=+(/=) :: ShaderType a => a -> a -> Bool+(/=) = op2 "!="++infix 4 >=+(>=) :: ShaderType a => a -> a -> Bool+(>=) = op2 ">="++infix 4 <=+(<=) :: ShaderType a => a -> a -> Bool+(<=) = op2 "<="++infix 4 <+(<) :: ShaderType a => a -> a -> Bool+(<) = op2 "<"++infix 4 >+(>) :: ShaderType a => a -> a -> Bool+(>) = op2 ">"++class ShaderType a => VecOrd a+instance VecOrd Vec2+instance VecOrd Vec3+instance VecOrd Vec4+instance VecOrd IVec2+instance VecOrd IVec3+instance VecOrd IVec4++class ShaderType a => VecEq a+instance VecEq Vec2+instance VecEq Vec3+instance VecEq Vec4+instance VecEq IVec2+instance VecEq IVec3+instance VecEq IVec4+instance VecEq BVec2+instance VecEq BVec3+instance VecEq BVec4++lessThan :: VecOrd a => a -> a -> Bool+lessThan = fun2 "lessThan"++lessThanEqual :: VecOrd a => a -> a -> Bool+lessThanEqual = fun2 "lessThanEqual"++greaterThan :: VecOrd a => a -> a -> Bool+greaterThan = fun2 "greaterThan"++greaterThanEqual :: VecOrd a => a -> a -> Bool+greaterThanEqual = fun2 "greaterThanEqual"++equal :: VecEq a => a -> a -> Bool+equal = fun2 "equal"++notEqual :: VecEq a => a -> a -> Bool+notEqual = fun2 "notEqual"++class ShaderType a => BoolVector a+instance BoolVector BVec2+instance BoolVector BVec3+instance BoolVector BVec4++anyB :: BoolVector a => a -> Bool+anyB = fun1 "any"++allB :: BoolVector a => a -> Bool+allB = fun1 "all"++notB :: BoolVector a => a -> Bool+notB = fun1 "not"++negate :: GenType a => a -> a+negate = op1 "-"++not :: GenType a => a -> a+not = op1 "!"++class (ShaderType a, Base a a) => Num a where+ fromInteger :: Prelude.Integer -> a++instance Num Float where+ fromInteger = fromRational . Prelude.fromInteger++instance Num Int where+ fromInteger = Int . Literal+ . (printf "%d" :: Prelude.Integer -> String)+ . Prelude.fromInteger++fromRational :: Prelude.Rational -> Float+fromRational = Float . Literal+ . (printf "%f" :: Prelude.Float -> String)+ . Prelude.fromRational++radians :: GenType a => a -> a+radians = fun1 "radians"++degrees :: GenType a => a -> a+degrees = fun1 "degrees"++sin :: GenType a => a -> a+sin = fun1 "sin"++cos :: GenType a => a -> a+cos = fun1 "cos"++tan :: GenType a => a -> a+tan = fun1 "tan"++asin :: GenType a => a -> a+asin = fun1 "asin"++acos :: GenType a => a -> a+acos = fun1 "acos"++atan :: GenType a => a -> a+atan = fun1 "atan"++atan2 :: GenType a => a -> a -> a+atan2 = fun2 "atan"++exp :: GenType a => a -> a+exp = fun1 "exp"++log :: GenType a => a -> a+log = fun1 "log"++exp2 :: GenType a => a -> a+exp2 = fun1 "exp2"++log2 :: GenType a => a -> a+log2 = fun1 "log2"++sqrt :: GenType a => a -> a+sqrt = fun1 "sqrt"++inversesqrt :: GenType a => a -> a+inversesqrt = fun1 "inversesqrt"++abs :: GenType a => a -> a+abs = fun1 "abs"++sign :: GenType a => a -> a+sign = fun1 "sign"++floor :: GenType a => a -> a+floor = fun1 "floor"++ceil :: GenType a => a -> a+ceil = fun1 "ceil"++fract :: GenType a => a -> a+fract = fun1 "fract"++mod :: GenTypeFloat a b => a -> b -> a+mod = fun2 "mod"++min :: GenTypeFloat a b => a -> b -> a+min = fun2 "min"++max :: GenTypeFloat a b => a -> b -> a+max = fun2 "max"++clamp :: GenTypeFloat a b => a -> b -> b -> a+clamp = fun3 "clamp"++mix :: GenTypeFloat a b => a -> a -> b -> a+mix = fun3 "mix"++step :: GenTypeFloat a b => b -> a -> a+step = fun2 "step"++smoothstep :: GenTypeFloat a b => b -> b -> a -> a+smoothstep = fun3 "smoothstep"++length :: GenType a => a -> Float+length = fun1 "length"++arrayLength :: (ShaderType t, KnownNat n) => Array n t -> Int+arrayLength = fun1 "length"++(!) :: (ShaderType t, KnownNat n) => Array n t -> Int -> t+arr ! i = fromExpr $ ArrayIndex (toExpr arr) (toExpr i)++distance :: GenType a => a -> a -> Float+distance = fun2 "distance"++dot :: GenType a => a -> a -> Float+dot = fun2 "dot"++cross :: Vec3 -> Vec3 -> Vec3+cross = fun2 "cross"++normalize :: GenType a => a -> a+normalize = fun1 "normalize"++faceforward :: GenType a => a -> a -> a -> a+faceforward = fun3 "faceforward"++reflect :: GenType a => a -> a -> a+reflect = fun2 "reflect"++refract :: GenType a => a -> a -> Float -> a+refract = fun3 "refract"++class ShaderType a => Matrix a+instance Matrix Mat2+instance Matrix Mat3+instance Matrix Mat4++-- TODO: unsafe+matrixCompMult :: (Matrix a, Matrix b, Matrix c) => a -> b -> c+matrixCompMult = fun2 "matrixCompMult"++-- | Avoid evaluating the expression of the argument more than one time.+-- Conditionals and loops imply it.+store :: ShaderType a => a -> a+store x = fromExpr . Action $ Store (typeName x) (toExpr x)++true :: Bool+true = Bool $ Literal "true"++false :: Bool+false = Bool $ Literal "false"++-- | Rebound if. You don't need to use this function, with -XRebindableSyntax.+ifThenElse :: ShaderType a => Bool -> a -> a -> a+ifThenElse b t f = fromExpr . Action $ If (toExpr b) (typeName t)+ (toExpr t) (toExpr f)++loop :: ShaderType a + => Int -- ^ Maximum number of iterations (should be as low as possible, must be an integer literal)+ -> a -- ^ Initial value+ -> (Int -> a -> (a, Bool)) -- ^ Iteration -> Old value -> (Next, Stop)+ -> a+loop (Int (Literal iters)) iv f =+ fromExpr . Action $+ For (Prelude.read iters :: Prelude.Int)+ (typeName iv)+ (toExpr iv)+ (\ie ve -> let (next, stop) = f (fromExpr ie) (fromExpr ve)+ in (toExpr next, toExpr stop))+loop _ _ _ = error "loop: iteration number is not a literal."++texture2D :: Sampler2D -> Vec2 -> Vec4+texture2D = fun2 "texture2D"++texture2DBias :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DBias = fun3 "texture2DBias"++texture2DProj :: Sampler2D -> Vec3 -> Vec4+texture2DProj = fun2 "texture2DProj"++texture2DProjBias :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjBias = fun3 "texture2DProj"++texture2DProj4 :: Sampler2D -> Vec4 -> Vec4+texture2DProj4 = fun2 "texture2DProj"++texture2DProjBias4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjBias4 = fun3 "texture2DProj"++texture2DLod :: Sampler2D -> Vec2 -> Float -> Vec4+texture2DLod = fun3 "texture2DLod"++texture2DProjLod :: Sampler2D -> Vec3 -> Float -> Vec4+texture2DProjLod = fun3 "texture2DProjLod"++texture2DProjLod4 :: Sampler2D -> Vec4 -> Float -> Vec4+texture2DProjLod4 = fun3 "texture3DProjLod"++textureCube :: SamplerCube -> Vec3 -> Vec4+textureCube = fun2 "textureCube"++textureCubeBias :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeBias = fun3 "textureCube"++textureCubeLod :: SamplerCube -> Vec3 -> Float -> Vec4+textureCubeLod = fun3 "textureCubeLod"++-- | The position of the vertex (only works in the vertex shader).+position :: Vec4+position = fromExpr $ Read "gl_Position"++-- | The data of the fragment (only works in the fragment shader).+fragData :: Array 16 Vec4+fragData = fromExpr $ Read "gl_FragData"++-- | The coordinates of the fragment (only works in the fragment shader).+fragCoord :: Vec4+fragCoord = fromExpr $ Read "gl_FragCoord"++-- | If the fragment belongs to a front-facing primitive (only works in the+-- fragment shader).+fragFrontFacing :: Bool+fragFrontFacing = fromExpr $ Read "gl_FrontFacing"++class ShaderType t => ToInt t+instance ToInt Float+instance ToInt Bool+instance ToInt Int++int :: ToInt t => t -> Int+int = fun1 "int"++class ShaderType t => ToBool t+instance ToBool Float+instance ToBool Bool+instance ToBool Int++bool :: ToBool t => t -> Bool+bool = fun1 "bool"++class ShaderType t => ToFloat t+instance ToFloat Float+instance ToFloat Bool+instance ToFloat Int++float :: ToFloat t => t -> Float+float = fun1 "float"++class ToVec2 t where+ vec2 :: t -> Vec2++instance {-# OVERLAPPING #-} ToVec2 Float where+ vec2 = fun1 "vec2"++instance {-# OVERLAPPABLE #-}+ (Components Vec2 <= n, ToCompList t n) => ToVec2 t where+ vec2 = funCompList "vec2"++class ToVec3 t where+ vec3 :: t -> Vec3++instance {-# OVERLAPPING #-} ToVec3 Float where+ vec3 = fun1 "vec3"++instance {-# OVERLAPPABLE #-}+ (Components Vec3 <= n, ToCompList t n) => ToVec3 t where+ vec3 = funCompList "vec3"++class ToVec4 t where+ vec4 :: t -> Vec4++instance {-# OVERLAPPING #-} ToVec4 Float where+ vec4 = fun1 "vec4"++instance {-# OVERLAPPABLE #-}+ (Components Vec4 <= n, ToCompList t n) => ToVec4 t where+ vec4 = funCompList "vec4"++class ToIVec2 t where+ ivec2 :: t -> IVec2++instance {-# OVERLAPPING #-} ToIVec2 Float where+ ivec2 = fun1 "ivec2"++instance {-# OVERLAPPABLE #-}+ (Components IVec2 <= n, ToCompList t n) => ToIVec2 t where+ ivec2 = funCompList "ivec2"++class ToIVec3 t where+ ivec3 :: t -> IVec3++instance {-# OVERLAPPING #-} ToIVec3 Float where+ ivec3 = fun1 "ivec3"++instance {-# OVERLAPPABLE #-}+ (Components IVec3 <= n, ToCompList t n) => ToIVec3 t where+ ivec3 = funCompList "ivec3"++class ToIVec4 t where+ ivec4 :: t -> IVec4++instance {-# OVERLAPPING #-} ToIVec4 Float where+ ivec4 = fun1 "ivec4"++instance {-# OVERLAPPABLE #-}+ (Components IVec4 <= n, ToCompList t n) => ToIVec4 t where+ ivec4 = funCompList "ivec4"++class ToBVec2 t where+ bvec2 :: t -> BVec2++instance {-# OVERLAPPING #-} ToBVec2 Float where+ bvec2 = fun1 "bvec2"++instance {-# OVERLAPPABLE #-}+ (Components BVec2 <= n, ToCompList t n) => ToBVec2 t where+ bvec2 = funCompList "bvec2"++class ToBVec3 t where+ bvec3 :: t -> BVec3++instance {-# OVERLAPPING #-} ToBVec3 Float where+ bvec3 = fun1 "bvec3"++instance {-# OVERLAPPABLE #-}+ (Components BVec3 <= n, ToCompList t n) => ToBVec3 t where+ bvec3 = funCompList "bvec3"++class ToBVec4 t where+ bvec4 :: t -> BVec4++instance {-# OVERLAPPING #-} ToBVec4 Float where+ bvec4 = fun1 "bvec4"++instance {-# OVERLAPPABLE #-}+ (Components BVec4 <= n, ToCompList t n) => ToBVec4 t where+ bvec4 = funCompList "bvec4"++class ToMat2 t where+ mat2 :: t -> Mat2++instance {-# OVERLAPPING #-} ToMat2 Float where+ mat2 = fun1 "mat2"++instance {-# OVERLAPPABLE #-}+ (Components Mat2 <= n, ToCompList t n) => ToMat2 t where+ mat2 = funCompList "mat2"++class ToMat3 t where+ mat3 :: t -> Mat3++instance {-# OVERLAPPING #-} ToMat3 Float where+ mat3 = fun1 "mat3"++instance {-# OVERLAPPABLE #-}+ (Components Mat3 <= n, ToCompList t n) => ToMat3 t where+ mat3 = funCompList "mat3"++class ToMat4 t where+ mat4 :: t -> Mat4++instance {-# OVERLAPPING #-} ToMat4 Float where+ mat4 = fun1 "mat4"++instance {-# OVERLAPPABLE #-}+ (Components Mat4 <= n, ToCompList t n) => ToMat4 t where+ mat4 = funCompList "mat4"++-- | Useful type for constructing vectors and matrices from scalars, vectors and+-- matrices.+data CompList (count :: Nat) where+ CL :: (1 <= Components t, ShaderType t) => t -> CompList (Components t)+ CLAppend :: CompList x -> CompList y -> CompList (x + y)++class ToCompList x (n :: Nat) | x -> n where+ toCompList :: x -> CompList n++instance {-# OVERLAPPING #-} ToCompList (CompList n) n where+ toCompList = Prelude.id++instance {-# OVERLAPPABLE #-}+ (1 <= n, ShaderType t, n ~ (Components t)) => ToCompList t n where+ toCompList = CL++-- | You can call \*vec\* and mat\* with a single scalar or with a 'CompList'+-- containing enough components. This function helps you create 'CompList's.+--+-- Examples:+--+-- > vec2 0+-- > mat2 $ Vec2 2 4 # Vec2 1 3+-- > vec4 $ mat2 (0 # 1 # vec2 2) # 9 -- 9 is discarded+-- > mat4 $ 5 # vec2 5 # Vec3 1 2 3 # Mat2 (vec2 0) (Vec2 1 2) # mat3 0+-- > vec4 $ 1 # vec2 0 -- Not enough components, fails with "Couldn't match type+-- > -- ‘'Prelude.False’ with 'Prelude.True’" (because+-- > -- Components Vec4 <=? 3 ~ False).+(#) :: (ToCompList x xn, ToCompList y yn) => x -> y -> CompList (xn + yn)+x # y = CLAppend (toCompList x) (toCompList y)++infixr 5 #++type family Components (t :: *) :: Nat where+ Components Int = 1+ Components Float = 1+ Components Bool = 1+ Components Vec2 = 2+ Components IVec2 = 2+ Components BVec2 = 2+ Components Vec3 = 3+ Components IVec3 = 3+ Components BVec3 = 3+ Components Vec4 = 4+ Components IVec4 = 4+ Components BVec4 = 4+ Components Mat2 = 4+ Components Mat3 = 9+ Components Mat4 = 16+ Components x = 0++op1 :: (ShaderType a, ShaderType b) => String -> a -> b+op1 name = fromExpr . Op1 name . toExpr++op2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c+op2 name x y = fromExpr $ Op2 name (toExpr x) (toExpr y)++fun1 :: (ShaderType a, ShaderType b) => String -> a -> b+fun1 name x = fromExpr $ Apply name [toExpr x]++fun2 :: (ShaderType a, ShaderType b, ShaderType c) => String -> a -> b -> c+fun2 name x y = fromExpr $ Apply name [toExpr x, toExpr y]++fun3 :: (ShaderType a, ShaderType b, ShaderType c, ShaderType d)+ => String -> a -> b -> c -> d+fun3 name x y z = fromExpr $ Apply name [toExpr x, toExpr y, toExpr z]++funCompList :: (ToCompList cl n, ShaderType r) => String -> cl -> r+funCompList name = fromExpr . Apply name . toExprList . toCompList+ where toExprList :: CompList n -> [Expr]+ toExprList (CL x) = [toExpr x]+ toExprList (CLAppend c1 c2) =+ toExprList c1 Prelude.++ toExprList c2
+ Graphics/Rendering/Ombra/Shader/Language/Types.hs view
@@ -0,0 +1,423 @@+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, DataKinds,+ KindSignatures, ScopedTypeVariables #-}++module Graphics.Rendering.Ombra.Shader.Language.Types where++import Data.Typeable+import GHC.TypeLits+import Data.Hashable+import Prelude (String, ($), error, Eq(..), (++), (*), fromInteger, (&&))+import qualified Prelude++-- | CPU integer, used in the shader compiler.+type MInt = Prelude.Int++-- | An expression.+data Expr = Empty | Read String | Op1 String Expr | Op2 String Expr Expr+ | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr+ | Literal String | Action Action | Dummy MInt | ArrayIndex Expr Expr+ | ContextVar MInt ContextVarType+ deriving Eq++-- | Expressions that are transformed to statements.+data Action = Store String Expr | If Expr String Expr Expr+ | For MInt String Expr (Expr -> Expr -> (Expr, Expr))++data ContextVarType = LoopIteration | LoopValue deriving Eq++-- | A GPU boolean.+newtype Bool = Bool Expr ++-- | A GPU float.+newtype Float = Float Expr ++-- | A GPU integer.+newtype Int = Int Expr ++-- | A GPU 2D texture handle.+newtype Sampler2D = Sampler2D Expr ++-- | A GPU cube texture handler.+newtype SamplerCube = SamplerCube Expr ++-- | The type of a generic expression.+newtype Unknown = Unknown Expr++-- | A GPU 2D float vector.+-- NB: This is a different type from Data.Vect.Float.'Data.Vect.Float.Vec2'.+data Vec2 = Vec2 Float Float ++-- | A GPU 3D float vector.+data Vec3 = Vec3 Float Float Float ++-- | A GPU 4D float vector.+data Vec4 = Vec4 Float Float Float Float ++-- | A GPU 2D integer vector.+data IVec2 = IVec2 Int Int ++-- | A GPU 3D integer vector.+data IVec3 = IVec3 Int Int Int ++-- | A GPU 4D integer vector.+data IVec4 = IVec4 Int Int Int Int ++-- | A GPU 2D boolean vector.+data BVec2 = BVec2 Bool Bool ++-- | A GPU 3D boolean vector.+data BVec3 = BVec3 Bool Bool Bool ++-- | A GPU 4D boolean vector.+data BVec4 = BVec4 Bool Bool Bool Bool ++-- | A GPU 2x2 float matrix.+data Mat2 = Mat2 Vec2 Vec2 ++-- | A GPU 3x3 float matrix.+data Mat3 = Mat3 Vec3 Vec3 Vec3 ++-- | A GPU 4x4 float matrix.+data Mat4 = Mat4 Vec4 Vec4 Vec4 Vec4 ++-- | A GPU array.+data Array (n :: Nat) t = Array Expr ++-- | A type in the GPU.+class ShaderType t where+ zero :: t++ toExpr :: t -> Expr++ fromExpr :: Expr -> t++ typeName :: t -> String++ size :: t -> MInt++instance ShaderType Unknown where+ zero = error "zero: Unknown type."+ toExpr (Unknown e) = e+ fromExpr = Unknown+ typeName = error "typeName: Unknown type."+ size = error "size: Unknown type."++instance (ShaderType t, KnownNat n) => ShaderType (Array n t) where+ zero = error "zero: Unsupported constant arrays."+ toExpr (Array e) = e+ fromExpr = Array+ typeName (Array _ :: Array n t) =+ typeName (zero :: t) +++ "[" ++ Prelude.show (natVal (Proxy :: Proxy n)) ++ "]"+ size (Array _ :: Array n t) =+ size (zero :: t) * fromInteger (natVal (Proxy :: Proxy n))++instance ShaderType Bool where+ zero = Bool $ Literal "false"++ toExpr (Bool e) = e++ fromExpr = Bool++ typeName _ = "bool"++ size _ = 1++instance ShaderType Int where+ zero = Int $ Literal "0"++ toExpr (Int e) = e++ fromExpr = Int++ typeName _ = "int"++ size _ = 1++instance ShaderType Float where+ zero = Float $ Literal "0.0"++ toExpr (Float e) = e++ fromExpr = Float++ typeName _ = "float"++ size _ = 1++instance ShaderType Sampler2D where+ zero = Sampler2D $ Literal "0"++ toExpr (Sampler2D e) = e++ fromExpr = Sampler2D++ typeName _ = "sampler2D"++ size _ = 1++instance ShaderType SamplerCube where+ zero = SamplerCube $ Literal "0"++ toExpr (SamplerCube e) = e++ fromExpr = SamplerCube++ typeName _ = "samplerCube"++ size _ = 1++instance ShaderType Vec2 where+ zero = Vec2 zero zero++ toExpr (Vec2 (Float (X v)) (Float (Y v'))) | v == v' = Apply "vec2" [v]+ toExpr (Vec2 (Float x) (Float y)) = Apply "vec2" [x, y]++ fromExpr v = Vec2 (Float (X v)) (Float (Y v))++ typeName _ = "vec2"++ size _ = 1++instance ShaderType Vec3 where+ zero = Vec3 zero zero zero++ toExpr (Vec3 (Float (X v)) (Float (Y v')) (Float (Z v'')))+ | v == v' && v' == v'' = Apply "vec3" [v]+ toExpr (Vec3 (Float x) (Float y) (Float z)) = Apply "vec3" [x, y, z]++ fromExpr v = Vec3 (Float (X v)) (Float (Y v)) (Float (Z v))++ typeName _ = "vec3"++ size _ = 1++instance ShaderType Vec4 where+ zero = Vec4 zero zero zero zero++ toExpr (Vec4 (Float (X v)) (Float (Y v1)) (Float (Z v2)) (Float (W v3)))+ | v == v1 && v1 == v2 && v2 == v3 = Apply "vec4" [v]+ toExpr (Vec4 (Float x) (Float y) (Float z) (Float w)) =+ Apply "vec4" [x, y, z, w]++ fromExpr v = Vec4 (Float (X v)) (Float (Y v)) (Float (Z v)) (Float (W v))++ typeName _ = "vec4"++ size _ = 1++instance ShaderType IVec2 where+ zero = IVec2 zero zero++ toExpr (IVec2 (Int (X v)) (Int (Y v'))) | v == v' = Apply "ivec2" [v]+ toExpr (IVec2 (Int x) (Int y)) = Apply "ivec2" [x, y]++ fromExpr v = IVec2 (Int (X v)) (Int (Y v))++ typeName _ = "ivec2"++ size _ = 1++instance ShaderType IVec3 where+ zero = IVec3 zero zero zero++ toExpr (IVec3 (Int (X v)) (Int (Y v')) (Int (Z v'')))+ | v == v' && v' == v'' = Apply "ivec3" [v]+ toExpr (IVec3 (Int x) (Int y) (Int z)) = Apply "ivec3" [x, y, z]++ fromExpr v = IVec3 (Int (X v)) (Int (Y v)) (Int (Z v))++ typeName _ = "ivec3"++ size _ = 1++instance ShaderType IVec4 where+ zero = IVec4 zero zero zero zero++ toExpr (IVec4 (Int (X v)) (Int (Y v1)) (Int (Z v2)) (Int (W v3)))+ | v == v1 && v1 == v2 && v2 == v3 = Apply "ivec4" [v]+ toExpr (IVec4 (Int x) (Int y) (Int z) (Int w)) =+ Apply "ivec4" [x, y, z, w]++ fromExpr v = IVec4 (Int (X v)) (Int (Y v)) (Int (Z v)) (Int (W v))++ typeName _ = "ivec4"++ size _ = 1++instance ShaderType BVec2 where+ zero = BVec2 zero zero++ toExpr (BVec2 (Bool (X v)) (Bool (Y v'))) | v == v' = Apply "bvec2" [v]+ toExpr (BVec2 (Bool x) (Bool y)) = Apply "bvec2" [x, y]++ fromExpr v = BVec2 (Bool (X v)) (Bool (Y v))++ typeName _ = "bvec2"++ size _ = 1++instance ShaderType BVec3 where+ zero = BVec3 zero zero zero++ toExpr (BVec3 (Bool (X v)) (Bool (Y v')) (Bool (Z v'')))+ | v == v' && v' == v'' = Apply "bvec3" [v]+ toExpr (BVec3 (Bool x) (Bool y) (Bool z)) = Apply "bvec3" [x, y, z]++ fromExpr v = BVec3 (Bool (X v)) (Bool (Y v)) (Bool (Z v))++ typeName _ = "bvec3"++ size _ = 1++instance ShaderType BVec4 where+ zero = BVec4 zero zero zero zero++ toExpr (BVec4 (Bool (X v)) (Bool (Y v1)) (Bool (Z v2)) (Bool (W v3)))+ | v == v1 && v1 == v2 && v2 == v3 = Apply "bvec4" [v]+ toExpr (BVec4 (Bool x) (Bool y) (Bool z) (Bool w)) =+ Apply "bvec4" [x, y, z, w]++ fromExpr v = BVec4 (Bool (X v)) (Bool (Y v))+ (Bool (Z v)) (Bool (W v))++ typeName _ = "bvec4"++ size _ = 1++instance ShaderType Mat2 where+ zero = Mat2 zero zero++ toExpr (Mat2 (Vec2 (Float (X (X m))) (Float (X (Y m1))))+ (Vec2 (Float (Y (X m2))) (Float (Y (Y m3)))))+ | m == m1 && m1 == m2 && m2 == m3 = Apply "mat2" [m]+ toExpr (Mat2 (Vec2 (Float xx) (Float xy))+ (Vec2 (Float yx) (Float yy)))+ = Apply "mat2" [xx, yx, xy, yy]++ fromExpr m = Mat2 (Vec2 (Float (X (X m))) (Float (Y (X m))))+ (Vec2 (Float (Y (X m))) (Float (Y (Y m))))++ typeName _ = "mat2"++ size _ = 2++instance ShaderType Mat3 where+ zero = Mat3 zero zero zero++ toExpr (Mat3 (Vec3 (Float (X (X m)))+ (Float (X (Y m1)))+ (Float (X (Z m2))))+ (Vec3 (Float (Y (X m3)))+ (Float (Y (Y m4)))+ (Float (Y (Z m5))))+ (Vec3 (Float (Z (X m6)))+ (Float (Z (Y m7)))+ (Float (Z (Z m8)))))+ | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 &&+ m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 =+ Apply "mat3" [m]+ toExpr (Mat3 (Vec3 (Float xx) (Float xy) (Float xz))+ (Vec3 (Float yx) (Float yy) (Float yz))+ (Vec3 (Float zx) (Float zy) (Float zz)))+ = Apply "mat3" [xx, yx, zx, xy, yy, zy, xz, yz, zz]++ fromExpr m = Mat3 (Vec3 (Float (X (X m)))+ (Float (X (Y m)))+ (Float (X (Z m))))+ (Vec3 (Float (Y (X m)))+ (Float (Y (Y m)))+ (Float (Y (Z m))))+ (Vec3 (Float (Z (X m)))+ (Float (Z (Y m)))+ (Float (Z (Z m))))++ typeName _ = "mat3"++ size _ = 3++instance ShaderType Mat4 where+ zero = Mat4 zero zero zero zero++ toExpr (Mat4 (Vec4 (Float (X (X m)))+ (Float (X (Y m1)))+ (Float (X (Z m2)))+ (Float (X (W m3))))+ (Vec4 (Float (Y (X m4)))+ (Float (Y (Y m5)))+ (Float (Y (Z m6)))+ (Float (Y (W m7))))+ (Vec4 (Float (Z (X m8)))+ (Float (Z (Y m9)))+ (Float (Z (Z m10)))+ (Float (Z (W m11))))+ (Vec4 (Float (W (X m12)))+ (Float (W (Y m13)))+ (Float (W (Z m14)))+ (Float (W (W m15)))))+ | m == m1 && m1 == m2 && m2 == m3 && m3 == m4 &&+ m4 == m5 && m5 == m6 && m6 == m7 && m7 == m8 &&+ m8 == m9 && m9 == m10 && m10 == m11 && m11 == m12 &&+ m12 == m13 && m13 == m14 && m14 == m15 = Apply "mat4" [m]+ toExpr (Mat4 (Vec4 (Float xx) (Float xy) (Float xz) (Float xw))+ (Vec4 (Float yx) (Float yy) (Float yz) (Float yw))+ (Vec4 (Float zx) (Float zy) (Float zz) (Float zw))+ (Vec4 (Float wx) (Float wy) (Float wz) (Float ww)))+ = Apply "mat4" [ xx, yx, zx, wx+ , xy, yy, zy, wy+ , xz, yz, zz, wz+ , xw, yw, zw, ww ]++ fromExpr m = Mat4 (Vec4 (Float (X (X m)))+ (Float (X (Y m)))+ (Float (X (Z m)))+ (Float (X (W m))))+ (Vec4 (Float (Y (X m)))+ (Float (Y (Y m)))+ (Float (Y (Z m)))+ (Float (Y (W m))))+ (Vec4 (Float (Z (X m)))+ (Float (Z (Y m)))+ (Float (Z (Z m)))+ (Float (Z (W m))))+ (Vec4 (Float (W (X m)))+ (Float (W (Y m)))+ (Float (W (Z m)))+ (Float (W (W m))))++ typeName _ = "mat4"++ size _ = 4++instance Hashable Expr where+ hashWithSalt s e = case e of+ Empty -> hash2 s 0 (0 :: MInt)+ 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+ 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+ Dummy i -> hash2 s 11 i+ ContextVar i LoopIteration -> hash2 s 12 i+ ContextVar i LoopValue -> hash2 s 13 i+ ArrayIndex arr i -> hash2 s 14 (arr, i)++instance Hashable Action where+ hashWithSalt s (Store t e) = hash2 s 0 (t, e)+ hashWithSalt s (If eb tt et ef) = hash2 s 1 (eb, tt, et, ef)+ hashWithSalt s (For iters tv iv eFun) =+ let baseHash = hash (iters, tv, iv, eFun (Dummy 0) (Dummy 1))+ in hash2 s 2 ( baseHash+ , eFun (Dummy baseHash)+ (Dummy $ baseHash Prelude.+ 1))++instance Prelude.Eq Action where+ a == a' = hash a == hash a'++hash2 :: Hashable a => MInt -> MInt -> a -> MInt+hash2 s i x = s `hashWithSalt` i `hashWithSalt` x
+ Graphics/Rendering/Ombra/Shader/Program.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE MultiParamTypeClasses, ExistentialQuantification, ConstraintKinds,+ FunctionalDependencies, KindSignatures, DataKinds, GADTs,+ RankNTypes, FlexibleInstances, ScopedTypeVariables,+ TypeOperators, ImpredicativeTypes, TypeSynonymInstances,+ FlexibleContexts #-}++module Graphics.Rendering.Ombra.Shader.Program (+ LoadedProgram(..),+ Program,+ program,+ loadProgram,+ castProgram,+ DefaultUniforms2D,+ DefaultAttributes2D,+ DefaultUniforms3D,+ DefaultAttributes3D,+ defaultProgram3D,+ defaultProgram2D+) where++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.Stages+import Graphics.Rendering.Ombra.Internal.GL hiding (Program)+import qualified Graphics.Rendering.Ombra.Internal.GL as GL+import Graphics.Rendering.Ombra.Internal.Resource+import Graphics.Rendering.Ombra.Internal.TList+import Unsafe.Coerce++-- | A vertex shader associated with a compatible fragment shader.+data Program (gs :: [*]) (is :: [*]) =+ Program (String, [(String, Int)]) String Int++data LoadedProgram = LoadedProgram !GL.Program (H.HashMap String Int) Int+++-- | The uniforms used in the default 3D program.+type DefaultUniforms3D = Default3D.Uniforms++-- | The attributes used in the default 3D program.+type DefaultAttributes3D = Default3D.Attributes++-- | The uniforms used in the default 2D program.+type DefaultUniforms2D = Default2D.Uniforms++-- | The attributes used in the default 2D program.+type DefaultAttributes2D = Default2D.Attributes++instance Hashable (Program gs is) where+ hashWithSalt salt (Program _ _ h) = hashWithSalt salt h++instance Eq (Program gs is) where+ (Program _ _ h) == (Program _ _ h') = h == h'++instance Hashable LoadedProgram where+ hashWithSalt salt (LoadedProgram _ _ h) = hashWithSalt salt h++instance Eq LoadedProgram where+ (LoadedProgram _ _ h) == (LoadedProgram _ _ h') = h == h'++instance GLES => Resource (Program g i) LoadedProgram GL where+ -- TODO: err check!+ loadResource i = Right <$> loadProgram i+ unloadResource _ (LoadedProgram p _ _) = deleteProgram p++castProgram :: Program gs is -> Program gs' is'+-- castProgram (Program v f h) = Program v f h+castProgram = unsafeCoerce++type Compatible pgs vgs fgs =+ EqualOrErr pgs (Union vgs fgs)+ (Text "Incompatible shader uniforms" :$$:+ Text " Vertex shader uniforms: " :<>:+ ShowType vgs :$$:+ Text " Fragment shader uniforms: " :<>:+ ShowType fgs :$$:+ Text " United shader uniforms: " :<>:+ ShowType (Union vgs fgs) :$$:+ Text " Program uniforms: " :<>:+ 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 pgs vis+program vs fs = let (vss, attrs) = vertexToGLSLAttr vs+ fss = fragmentToGLSL fs+ in Program (vss, attrs) fss (hash (vss, fss))++defaultProgram3D :: Program DefaultUniforms3D DefaultAttributes3D+defaultProgram3D = program Default3D.vertexShader Default3D.fragmentShader++defaultProgram2D :: Program DefaultUniforms2D DefaultAttributes2D+defaultProgram2D = program Default2D.vertexShader Default2D.fragmentShader++loadProgram :: GLES => Program g i -> GL LoadedProgram+loadProgram (Program (vss, attrs) fss h) =+ do glp <- createProgram+ + vs <- loadSource gl_VERTEX_SHADER vss+ fs <- loadSource gl_FRAGMENT_SHADER fss+ attachShader glp vs+ attachShader glp fs+ + locs <- bindAttribs glp 0 attrs []+ linkProgram glp+ + -- TODO: ??+ {-+ detachShader glp vs+ detachShader glp fs+ -}+ + return $ LoadedProgram glp (H.fromList locs) h++ where bindAttribs _ _ [] r = return r+ bindAttribs glp i ((nm, sz) : xs) r =+ bindAttribLocation glp (fromIntegral i) (toGLString nm)+ >> bindAttribs glp (i + sz) xs ((nm, i) : r)++loadSource :: GLES => GLEnum -> String -> GL Shader+loadSource ty src =+ do shader <- createShader ty+ shaderSource shader $ toGLString src+ compileShader shader+ return shader
+ Graphics/Rendering/Ombra/Shader/ShaderVar.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators, TypeFamilies,+ RankNTypes, FlexibleContexts, ScopedTypeVariables,+ MultiParamTypeClasses, FlexibleInstances, ConstraintKinds,+ UndecidableInstances #-}++module Graphics.Rendering.Ombra.Shader.ShaderVar (+ Shader(..),+ Valid,+ Member,+ Subset,+ Equal,+ Union,+ Insert,+ SVList(..),+ ShaderVar,+ BaseTypes,+ varPreName,+ varBuild,+ varToList,+ svFold,+ svToList,+ staticSVList+) where++import Data.Typeable (Proxy(..))+import GHC.Generics+import Graphics.Rendering.Ombra.Internal.TList+import Graphics.Rendering.Ombra.Shader.Language.Types (ShaderType)++infixr 4 :-++type NonDuplicate x xs = NotMemberOrErr x xs+ (Text "Duplicate variable: ‘" :<>:+ ShowType x :$$:+ Text "’ In SVList: ... : [" :<>:+ ShowType x :<>:+ Text "] : " :<>:+ ShowType xs)++-- | An heterogeneous set 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)++-- | A function from a (heterogeneous) set of uniforms and a set of inputs+-- (attributes or varyings) to a set of outputs (varyings).+type Shader gs is os = SVList gs -> SVList is -> SVList os++class GShaderVar (g :: * -> *) where+ type GBaseTypes g :: [*]++ gvarPreName :: g c -> String+ gvarBuild :: Int+ -> (forall x. ShaderType x => Int -> x)+ -> Proxy g+ -> (g c, Int)+ gvarToList :: Int+ -> (forall x. ShaderType x => Int -> x -> t)+ -> g c+ -> ([t], Int)+ +instance (GShaderVar a, GShaderVar b) => GShaderVar (a :*: b) where+ type GBaseTypes (a :*: b) = Append (GBaseTypes a) (GBaseTypes b)++ gvarPreName _ = error "gvarPreName: no info in :*:"++ gvarBuild i f (_ :: Proxy (a :*: b)) =+ let (x, i') = gvarBuild i f (Proxy :: Proxy a)+ (y, i'') = gvarBuild i' f (Proxy :: Proxy b)+ in (x :*: y, i'')+ + gvarToList i f (x :*: y) =+ let (l, i') = gvarToList i f x+ (r, i'') = gvarToList i' f y+ in (l ++ r, i'')++instance (GShaderVar a, Datatype dt) => GShaderVar (M1 D dt a) where+ type GBaseTypes (M1 D dt a) = GBaseTypes a+ gvarPreName = datatypeName+ gvarBuild i f (_ :: Proxy (M1 D dt a)) =+ let (x, i') = gvarBuild i f (Proxy :: Proxy a)+ in (M1 x, i') + gvarToList i f (M1 x) = gvarToList i f x++instance GShaderVar a => GShaderVar (M1 S c a) where+ type GBaseTypes (M1 S c a) = GBaseTypes a+ gvarPreName _ = error "gvarPreName: no info in M1 S"+ gvarBuild i f (_ :: Proxy (M1 S c a)) =+ let (x, i') = gvarBuild i f (Proxy :: Proxy a)+ in (M1 x, i') + gvarToList i f (M1 x) = gvarToList i f x++instance GShaderVar a => GShaderVar (M1 C c a) where+ type GBaseTypes (M1 C c a) = GBaseTypes a+ gvarPreName _ = error "gvarPreName: no info in M1 C"+ gvarBuild i f (_ :: Proxy (M1 C c a)) =+ let (x, i') = gvarBuild i f (Proxy :: Proxy a)+ in (M1 x, i') + gvarToList i f (M1 x) = gvarToList i f x++instance {-# OVERLAPPABLE #-} ShaderType a => GShaderVar (K1 i a) where+ type GBaseTypes (K1 i a) = '[a]+ gvarPreName _ = error "gvarPreName: no info in K1"+ gvarBuild i f _ = (K1 $ f i, i + 1)+ gvarToList i f (K1 x) = ([f i x], i + 1)++class ShaderVar g where+ varPreName :: g -> String+ varBuild :: (forall x. ShaderType x => Int -> x) -> Proxy g -> g+ varToList :: (forall x. ShaderType x => Int -> x -> t) -> g -> [t]++type BaseTypes g = GBaseTypes (Rep g)++instance (GShaderVar (Rep g), Generic g) => ShaderVar g where+ varPreName = gvarPreName . from+ varBuild f (_ :: Proxy g) =+ to . fst $ gvarBuild 0 f (Proxy :: Proxy (Rep g))+ varToList f = fst . gvarToList 0 f . from++svFold :: (forall x. ShaderVar x => acc -> x -> acc) -> acc -> SVList xs -> acc+svFold _ acc N = acc+svFold f acc (x :- xs) = svFold f (f acc x) xs++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
+ Graphics/Rendering/Ombra/Shader/Stages.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE TypeOperators, DataKinds, GeneralizedNewtypeDeriving,+ DeriveDataTypeable, RankNTypes, FlexibleContexts,+ TypeFamilies, ConstraintKinds, DeriveGeneric #-}++module Graphics.Rendering.Ombra.Shader.Stages (+ VertexShader,+ ValidVertex,+ FragmentShader,+ VertexShaderOutput(Vertex),+ FragmentShaderOutput(..)+) 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)++-- | 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++-- | The RGBA color of the fragment (1.0 = #FF), or the data of the draw+-- buffers.+data FragmentShaderOutput = Fragment0+ | Fragment Vec4+ | Fragment2 Vec4 Vec4+ | Fragment3 Vec4 Vec4 Vec4+ | Fragment4 Vec4 Vec4 Vec4 Vec4+ | Fragment5 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment6 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment7 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment8 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment9 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4+ | Fragment10 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4+ | Fragment11 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4+ | Fragment12 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4 Vec4+ | Fragment13 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment14 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment15 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ | Fragment16 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4+ Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4 Vec4++instance {-# OVERLAPPING #-} ShaderVar FragmentShaderOutput where+ varPreName _ = "FragmentShaderOutput"+ varBuild _ _ = error "varBuild: can't build a FragmentShaderOutput"+ varToList _ Fragment0 = []+ varToList f (Fragment x0) = f 0 x0 : []+ varToList f (Fragment2 x0 x1) = f 0 x0 : f 1 x1 : []+ varToList f (Fragment3 x0 x1 x2) = f 0 x0 : f 1 x1 : f 2 x2 : []+ varToList f (Fragment4 x0 x1 x2 x3) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : []+ varToList f (Fragment5 x0 x1 x2 x3 x4) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 : []+ varToList f (Fragment6 x0 x1 x2 x3 x4 x5) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 : f 5 x5 : []+ varToList f (Fragment7 x0 x1 x2 x3 x4 x5 x6) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 :+ f 4 x4 : f 5 x5 : f 6 x6 : []+ varToList f (Fragment8 x0 x1 x2 x3 x4 x5 x6 x7) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 :+ f 4 x4 : f 5 x5 : f 6 x6 : f 7 x7 : []+ varToList f (Fragment9 x0 x1 x2 x3 x4 x5 x6 x7 x8) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 :+ f 4 x4 : f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : []+ varToList f (Fragment10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 : []+ varToList f (Fragment11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : []+ varToList f (Fragment12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : f 11 x11 : []+ varToList f (Fragment13 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : f 11 x11 : f 12 x12 : []+ varToList f (Fragment14 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : f 11 x11 : f 12 x12 : f 13 x13 : []+ varToList f (Fragment15 x0 x1 x2 x3 x4 x5 x6 x7+ x8 x9 x10 x11 x12 x13 x14) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : f 11 x11 : f 12 x12 : f 13 x13 :+ f 14 x14 : []+ varToList f (Fragment16 x0 x1 x2 x3 x4 x5 x6 x7 x8+ x9 x10 x11 x12 x13 x14 x15) =+ f 0 x0 : f 1 x1 : f 2 x2 : f 3 x3 : f 4 x4 :+ f 5 x5 : f 6 x6 : f 7 x7 : f 8 x8 : f 9 x9 :+ f 10 x10 : f 11 x11 : f 12 x12 : f 13 x13 :+ f 14 x14 : f 15 x15 : []
+ Graphics/Rendering/Ombra/Shapes.hs view
@@ -0,0 +1,106 @@+module Graphics.Rendering.Ombra.Shapes where++import Data.Vect.Float+import Graphics.Rendering.Ombra.Geometry+import Graphics.Rendering.Ombra.Types+import Graphics.Rendering.Ombra.Internal.GL (GLES)++rectGeometry :: GLES => Vec2 -> Geometry Geometry2D+rectGeometry (Vec2 w h) = mkGeometry2D [ Vec2 (-hw) (-hh)+ , Vec2 hw (-hh)+ , Vec2 hw hh+ , Vec2 (-hw) hh ]+ [ Vec2 0 0+ , Vec2 1 0+ , Vec2 1 1+ , Vec2 0 1 ]+ [ 0, 1, 2, 0, 3, 2 ]+ where (hw, hh) = (w / 2, h / 2)++cubeGeometry :: GLES => Geometry Geometry3D+cubeGeometry =+ mkGeometry3D+ [ Vec3 1.0 1.0 (-0.999999), + Vec3 1.0 (-1.0) (-1.0), + Vec3 (-1.0) 1.0 (-1.0), + Vec3 (-1.0) (-1.0) 1.0, + Vec3 (-1.0) 1.0 1.0, + Vec3 (-1.0) (-1.0) (-1.0), + Vec3 (-1.0) (-1.0) 1.0, + Vec3 1.0 (-1.0) 1.0, + Vec3 (-1.0) 1.0 1.0, + Vec3 1.0 (-1.0) 1.0, + Vec3 1.0 (-1.0) (-1.0), + Vec3 0.999999 1.0 1.000001, + Vec3 1.0 1.0 (-0.999999), + Vec3 (-1.0) 1.0 (-1.0), + Vec3 0.999999 1.0 1.000001, + Vec3 1.0 (-1.0) (-1.0), + Vec3 1.0 (-1.0) 1.0, + Vec3 (-1.0) (-1.0) (-1.0), + Vec3 (-1.0) (-1.0) (-1.0), + Vec3 (-1.0) 1.0 (-1.0), + Vec3 0.999999 1.0 1.000001, + Vec3 1.0 1.0 (-0.999999), + Vec3 (-1.0) 1.0 1.0, + Vec3 (-1.0) (-1.0) 1.0 ]+ [ Vec2 0.9999 1.0e-4, + Vec2 0.9999 0.9999, + Vec2 1.0e-4 1.0e-4, + Vec2 1.0e-4 0.9999, + Vec2 1.0e-4 1.0e-4, + Vec2 0.9999 0.9999, + Vec2 1.0e-4 1.0e-4, + Vec2 0.9999 1.0e-4, + Vec2 1.0e-4 0.9999, + Vec2 1.0e-4 1.0e-4, + Vec2 0.9999 1.0e-4, + Vec2 1.0e-4 0.9999, + Vec2 0.9999 0.9999, + Vec2 1.0e-4 0.9999, + Vec2 0.9999 1.0e-4, + Vec2 0.9999 0.9999, + Vec2 1.0e-4 0.9999, + Vec2 0.9999 1.0e-4, + Vec2 1.0e-4 0.9999, + Vec2 0.9999 1.0e-4, + Vec2 0.9999 0.9999, + Vec2 0.9999 0.9999, + Vec2 1.0e-4 1.0e-4, + Vec2 1.0e-4 1.0e-4 ]+ [ Vec3 0.0 0.0 (-1.0), + Vec3 0.0 0.0 (-1.0), + Vec3 0.0 0.0 (-1.0), + Vec3 (-1.0) (-0.0) (-0.0), + Vec3 (-1.0) (-0.0) (-0.0), + Vec3 (-1.0) (-0.0) (-0.0), + Vec3 (-0.0) (-0.0) 1.0, + Vec3 (-0.0) (-0.0) 1.0, + Vec3 (-0.0) (-0.0) 1.0, + Vec3 1.0 (-0.0) 0.0, + Vec3 1.0 (-0.0) 0.0, + Vec3 1.0 (-0.0) 0.0, + Vec3 0.0 1.0 0.0, + Vec3 0.0 1.0 0.0, + Vec3 0.0 1.0 0.0, + Vec3 0.0 (-1.0) 0.0, + Vec3 0.0 (-1.0) 0.0, + Vec3 0.0 (-1.0) 0.0, + Vec3 0.0 0.0 (-1.0), + Vec3 (-1.0) (-0.0) (-0.0), + Vec3 (-0.0) (-0.0) 1.0, + Vec3 1.0 (-0.0) 0.0, + Vec3 0.0 1.0 0.0, + Vec3 0.0 (-1.0) 0.0 ]+ [ 0, 1, 2,+ 3, 4, 5,+ 6, 7, 8,+ 9, 10, 11,+ 12, 13, 14,+ 15, 16, 17,+ 1, 18, 2,+ 4, 19, 5,+ 7, 20, 8,+ 10, 21, 11,+ 13, 22, 14,+ 16, 23, 17 ]
+ Graphics/Rendering/Ombra/Texture.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Graphics.Rendering.Ombra.Texture (+ mkTexture,+ mkTextureRaw,+ emptyTexture+) where++import Data.Hashable++import Graphics.Rendering.Ombra.Backend (GLES)+import qualified Graphics.Rendering.Ombra.Backend as GL+import Graphics.Rendering.Ombra.Color+import Graphics.Rendering.Ombra.Types+import Graphics.Rendering.Ombra.Internal.GL hiding (Texture)+import qualified Graphics.Rendering.Ombra.Internal.GL as GL+import Graphics.Rendering.Ombra.Internal.Resource++-- | Creates a 'Texture' from a list of pixels.+mkTexture :: GLES+ => Int -- ^ Width.+ -> Int -- ^ Height.+ -> [Color] -- ^ List of pixels+ -> Texture+mkTexture w h ps = TextureImage . TexturePixels ps (fromIntegral w)+ (fromIntegral h)+ $ hash (w, h, ps)++mkTextureRaw :: GLES+ => Int+ -> Int+ -> UInt8Array+ -> Int+ -> Texture+mkTextureRaw w h arr hash = TextureImage $ TextureRaw arr+ (fromIntegral w)+ (fromIntegral h)+ hash++instance GLES => Resource TextureImage LoadedTexture GL where+ loadResource i = Right <$> loadTextureImage i -- TODO: err check+ unloadResource _ (LoadedTexture _ _ t) = deleteTexture t++loadTextureImage :: GLES => TextureImage -> GL LoadedTexture+loadTextureImage (TexturePixels ps w h hash) =+ do arr <- liftIO . encodeUInt8s $+ 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+ 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 ()+ param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v
+ Graphics/Rendering/Ombra/Transformation.hs view
@@ -0,0 +1,147 @@+module Graphics.Rendering.Ombra.Transformation (+ transMat4,+ rotXMat4,+ rotYMat4,+ rotZMat4,+ rotMat4,+ scaleMat4,+ orthoMat4,+ perspectiveMat4,+ cameraMat4,+ lookAtMat4,+ transMat3,+ rotMat3,+ scaleMat3+) where++import Control.Applicative+import Data.Vect.Float+import Foreign.Storable+import Foreign.Ptr (castPtr)++-- | 4x4 translation matrix.+transMat4 :: Vec3 -> Mat4+transMat4 (Vec3 x y z) = Mat4 (Vec4 1 0 0 0)+ (Vec4 0 1 0 0)+ (Vec4 0 0 1 0)+ (Vec4 x y z 1)++-- | 4x4 rotation matrix (X axis).+rotXMat4 :: Float -> Mat4+rotXMat4 a = Mat4 (Vec4 1 0 0 0)+ (Vec4 0 (cos a) (- sin a) 0)+ (Vec4 0 (sin a) (cos a) 0)+ (Vec4 0 0 0 1)++-- | 4x4 rotation matrix (Y axis).+rotYMat4 :: Float -> Mat4+rotYMat4 a = Mat4 (Vec4 (cos a) 0 (sin a) 0)+ (Vec4 0 1 0 0)+ (Vec4 (- sin a) 0 (cos a) 0)+ (Vec4 0 0 0 1)++-- | 4x4 rotation matrix (Z axis).+rotZMat4 :: Float -> Mat4+rotZMat4 a = Mat4 (Vec4 (cos a) (- sin a) 0 0)+ (Vec4 (sin a) (cos a) 0 0)+ (Vec4 0 0 1 0)+ (Vec4 0 0 0 1)++-- | 4x4 rotation matrix.+rotMat4 :: Vec3 -- ^ Axis.+ -> Float -- ^ Angle+ -> Mat4+rotMat4 v a = let (Mat3 x y z) = rotMatrix3 v a+ in Mat4 (extendZero x)+ (extendZero y)+ (extendZero z)+ (Vec4 0 0 0 1)++-- | 4x4 scale matrix.+scaleMat4 :: Vec3 -> Mat4+scaleMat4 (Vec3 x y z) = Mat4 (Vec4 x 0 0 0)+ (Vec4 0 y 0 0)+ (Vec4 0 0 z 0)+ (Vec4 0 0 0 1)++-- | 4x4 perspective projection matrix.+perspectiveMat4 :: Float -- ^ Near+ -> Float -- ^ Far+ -> Float -- ^ FOV+ -> Float -- ^ Aspect ratio+ -> Mat4+perspectiveMat4 n f fov ar =+ Mat4 (Vec4 (s / ar) 0 0 0)+ (Vec4 0 s 0 0)+ (Vec4 0 0 ((f + n) / (n - f)) ((2 * f * n) / (n - f)))+ (Vec4 0 0 (- 1) 0)+ where s = 1 / tan (fov * pi / 360)++-- | 4x4 orthographic projection matrix.+orthoMat4 :: Float -- ^ Near+ -> Float -- ^ Far+ -> Float -- ^ Left+ -> Float -- ^ Right+ -> Float -- ^ Bottom+ -> Float -- ^ Top+ -> Mat4+orthoMat4 n f l r b t =+ Mat4 (Vec4 (2 / (r - l)) 0 0 ((r + l) / (r - l)))+ (Vec4 0 (2 / (t - b)) 0 ((t + b) / (t - b)))+ (Vec4 0 0 (2 / (n - f)) (( f + n) / (n - f)))+ (Vec4 0 0 0 1)++-- | 4x4 FPS camera matrix.+cameraMat4 :: Vec3 -- ^ Eye+ -> Float -- ^ Pitch+ -> Float -- ^ Yaw+ -> Mat4+cameraMat4 eye pitch yaw =+ Mat4 (Vec4 xx yx zx 0)+ (Vec4 xy yy zy 0)+ (Vec4 xz yz zz 0)+ (Vec4 (- dotprod xv eye) (- dotprod yv eye) (- dotprod zv eye) 1)+ where cosPitch = cos pitch+ sinPitch = sin pitch+ cosYaw = cos yaw+ sinYaw = sin yaw+ xv@(Vec3 xx xy xz) = Vec3 cosYaw 0 $ -sinYaw+ yv@(Vec3 yx yy yz) = Vec3 (sinYaw * sinPitch) cosPitch $+ cosYaw * sinPitch+ zv@(Vec3 zx zy zz) = Vec3 (sinYaw * cosPitch) (-sinPitch) $+ cosPitch * cosYaw++-- | 4x4 "look at" camera matrix.+lookAtMat4 :: Vec3 -- ^ Eye+ -> Vec3 -- ^ Target+ -> Vec3 -- ^ Up+ -> Mat4+lookAtMat4 eye target up =+ Mat4 (Vec4 xx yx zx 0)+ (Vec4 xy yy zy 0)+ (Vec4 xz yz zz 0)+ (Vec4 (- dotprod xv eye) (- dotprod yv eye) (- dotprod zv eye) 1)+ where zv@(Vec3 zx zy zz) = normalize $ eye &- target+ xv@(Vec3 xx xy xz) = normalize $ crossprod up zv+ yv@(Vec3 yx yy yz) = crossprod zv xv++-- | 3x3 translation matrix.+transMat3 :: Vec2 -> Mat3+transMat3 (Vec2 x y) = Mat3 (Vec3 1 0 0)+ (Vec3 0 1 0)+ (Vec3 x y 1)++-- | 3x3 rotation matrix.+rotMat3 :: Float -> Mat3+rotMat3 a = Mat3 (Vec3 (cos a) (sin a) 0)+ (Vec3 (- sin a) (cos a) 0)+ (Vec3 0 0 1)++-- | 3x3 scale matrix.+scaleMat3 :: Vec2 -> Mat3+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
+ Graphics/Rendering/Ombra/Types.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators, FlexibleContexts,+ ExistentialQuantification, GeneralizedNewtypeDeriving #-}++module Graphics.Rendering.Ombra.Types (+ Draw(..),+ DrawState(..),+ UniformLocation(..),+ Texture(..),+ TextureImage(..),+ LoadedTexture(..),+ Geometry(..),+ Group(..),+ Object(..),+ Global(..),+ Layer(..),+ RenderLayer(..),+ LayerType(..)+) where++import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State+import Data.Hashable+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 Graphics.Rendering.Ombra.Geometry+import Graphics.Rendering.Ombra.Color+import Graphics.Rendering.Ombra.Internal.GL hiding (Program, Texture, UniformLocation)+import qualified Graphics.Rendering.Ombra.Internal.GL as GL+import Graphics.Rendering.Ombra.Internal.TList+import Graphics.Rendering.Ombra.Internal.Resource+import Graphics.Rendering.Ombra.Shader.CPU+import Graphics.Rendering.Ombra.Shader.Program+import Graphics.Rendering.Ombra.Shader.ShaderVar++newtype UniformLocation = UniformLocation GL.UniformLocation++-- | The state of the 'Draw' monad.+data DrawState = DrawState {+ currentProgram :: Maybe (Program '[] '[]),+ loadedProgram :: Maybe LoadedProgram,+ programs :: ResMap (Program '[] '[]) LoadedProgram,+ uniforms :: ResMap (LoadedProgram, String) UniformLocation,+ gpuBuffers :: ResMap (Geometry '[]) GPUBufferGeometry,+ gpuVAOs :: ResMap (Geometry '[]) GPUVAOGeometry,+ textureImages :: ResMap TextureImage LoadedTexture,+ activeTextures :: Vector (Maybe Texture),+ viewportSize :: (Int, Int),+ blendMode :: Maybe Blend.Mode,+ depthTest :: Bool+}++-- | A state monad on top of 'GL'.+newtype Draw a = Draw { unDraw :: StateT DrawState GL a }+ deriving (Functor, Applicative, Monad, MonadIO)++instance EmbedIO Draw where+ embedIO f (Draw a) = Draw get >>= Draw . lift . embedIO f . evalStateT a++-- | A texture.+data Texture = TextureImage TextureImage+ | TextureLoaded LoadedTexture+ deriving Eq+ +data TextureImage = TexturePixels [Color] GLSize GLSize Int+ | TextureRaw UInt8Array GLSize GLSize Int++data LoadedTexture = LoadedTexture GLSize GLSize GL.Texture++-- | A group of 'Object's.+data Group (gs :: [*]) (is :: [*]) where+ Empty :: Group gs is+ Object :: Object gs is -> Group gs is+ 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+ DepthTest :: Bool -> Group gs is -> Group gs is++-- | A geometry associated with some uniforms.+data Object (gs :: [*]) (is :: [*]) where+ (:~>) :: Global g -> Object gs is -> Object (g ': gs) is+ Mesh :: Geometry is -> Object '[] is+ NoMesh :: Object '[] '[]++infixr 2 :~>++-- | The value of a GPU uniform.+data Global g where+ (:=) :: (ShaderVar g, Uniform 'S g)+ => (a -> g) -> Draw (CPU 'S 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]++-- | Represents a 'Layer' drawn on a 'Texture'.+data RenderLayer a = RenderLayer Bool -- Use drawBuffers+ [LayerType] -- Attachments+ Int Int -- Width, height+ Int Int Int Int -- Inspect rectangle+ Bool Bool -- Inspect color, depth+ Layer -- Layer to draw+ ([Texture] -> Maybe [Color] ->+ Maybe [Word8] -> a) -- Accepting function++data LayerType = ColorLayer | DepthLayer | BufferLayer Int 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'+ _ == _ = False++instance GLES => Eq LoadedTexture where+ LoadedTexture _ _ t == LoadedTexture _ _ t' = t == t'++textureHash :: TextureImage -> Int+textureHash (TexturePixels _ _ _ h) = h+textureHash (TextureRaw _ _ _ h) = h
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014-2016, Luca Prezzavento++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Luca Prezzavento nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,14 @@+Ombra+=====++The **Ombra** render engine.++Features:+ * **Typeful** and mostly **declarative** interface+ * Functional type safe embedded DSL for **shaders**+ * Automatic allocation and deallocation of GPU resources+ * **2D** and **3D** simplified interfaces+ * **OpenGL** and **WebGL** backends+ * Written in **Haskell**++Running examples: [01](http://ziocroc.github.io/Ombra/01/) [02](http://ziocroc.github.io/Ombra/02/) [03](http://ziocroc.github.io/Ombra/03/) [04](http://ziocroc.github.io/Ombra/04/) [05](http://ziocroc.github.io/Ombra/05/) [06](http://ziocroc.github.io/Ombra/06/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ombra.cabal view
@@ -0,0 +1,48 @@+name: ombra+version: 0.1.0.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.+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+copyright: Copyright © 2014-2016 Luca Prezzavento+category: Graphics+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/ziocroc/Ombra+ +flag opengl+ description: Enable the OpenGL backend. Main module: Graphics.Rendering.Ombra.Backend.OpenGL++flag webgl+ 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++ if flag(webgl) && impl(ghcjs)+ exposed-modules: Graphics.Rendering.Ombra.Backend.WebGL+ other-modules: Graphics.Rendering.Ombra.Backend.WebGL.Raw, Graphics.Rendering.Ombra.Backend.WebGL.Types, Graphics.Rendering.Ombra.Backend.WebGL.Const++ if flag(opengl) && !impl(ghcjs)+ exposed-modules: Graphics.Rendering.Ombra.Backend.OpenGL++ other-extensions: TypeOperators, DataKinds, ConstraintKinds, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, RankNTypes, GADTs, TypeSynonymInstances, KindSignatures, UndecidableInstances, ExistentialQuantification, GeneralizedNewtypeDeriving, NullaryTypeClasses, PolyKinds, ScopedTypeVariables, FunctionalDependencies, DeriveDataTypeable, ImpredicativeTypes, RebindableSyntax++ build-depends: base <5.0, vect <0.5, hashable <1.3, unordered-containers <0.3, vector <0.12, transformers <0.6, hashtables <1.4++ if flag(opengl) && !impl(ghcjs)+ build-depends: gl <0.8++ if flag(webgl) && impl(ghcjs)+ build-depends: ghcjs-base++ default-language: Haskell2010