diff --git a/Graphics/Rendering/Ombra/Backend.hs b/Graphics/Rendering/Ombra/Backend.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Backend/OpenGL.hs b/Graphics/Rendering/Ombra/Backend/OpenGL.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend/OpenGL.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Backend/WebGL.hs b/Graphics/Rendering/Ombra/Backend/WebGL.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend/WebGL.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Backend/WebGL/Const.hs b/Graphics/Rendering/Ombra/Backend/WebGL/Const.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend/WebGL/Const.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs b/Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend/WebGL/Raw.hs @@ -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 () diff --git a/Graphics/Rendering/Ombra/Backend/WebGL/Types.hs b/Graphics/Rendering/Ombra/Backend/WebGL/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Backend/WebGL/Types.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Blend.hs b/Graphics/Rendering/Ombra/Blend.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Blend.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Color.hs b/Graphics/Rendering/Ombra/Color.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Color.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/D2.hs b/Graphics/Rendering/Ombra/D2.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/D2.hs @@ -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 ) diff --git a/Graphics/Rendering/Ombra/D3.hs b/Graphics/Rendering/Ombra/D3.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/D3.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Draw.hs b/Graphics/Rendering/Ombra/Draw.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Draw.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Draw/Internal.hs b/Graphics/Rendering/Ombra/Draw/Internal.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Draw/Internal.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Generic.hs b/Graphics/Rendering/Ombra/Generic.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Generic.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Geometry.hs b/Graphics/Rendering/Ombra/Geometry.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Geometry.hs @@ -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) diff --git a/Graphics/Rendering/Ombra/Internal/GL.hs b/Graphics/Rendering/Ombra/Internal/GL.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Internal/GL.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Internal/Resource.hs b/Graphics/Rendering/Ombra/Internal/Resource.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Internal/Resource.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Internal/STVectorLen.hs b/Graphics/Rendering/Ombra/Internal/STVectorLen.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Internal/STVectorLen.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Internal/TList.hs b/Graphics/Rendering/Ombra/Internal/TList.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Internal/TList.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader.hs b/Graphics/Rendering/Ombra/Shader.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/CPU.hs b/Graphics/Rendering/Ombra/Shader/CPU.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/CPU.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/Default2D.hs b/Graphics/Rendering/Ombra/Shader/Default2D.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Default2D.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/Default3D.hs b/Graphics/Rendering/Ombra/Shader/Default3D.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Default3D.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/GLSL.hs b/Graphics/Rendering/Ombra/Shader/GLSL.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/GLSL.hs @@ -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" diff --git a/Graphics/Rendering/Ombra/Shader/Language/Functions.hs b/Graphics/Rendering/Ombra/Shader/Language/Functions.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Language/Functions.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/Language/Types.hs b/Graphics/Rendering/Ombra/Shader/Language/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Language/Types.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/Program.hs b/Graphics/Rendering/Ombra/Shader/Program.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Program.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/ShaderVar.hs b/Graphics/Rendering/Ombra/Shader/ShaderVar.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/ShaderVar.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Shader/Stages.hs b/Graphics/Rendering/Ombra/Shader/Stages.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shader/Stages.hs @@ -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 : [] diff --git a/Graphics/Rendering/Ombra/Shapes.hs b/Graphics/Rendering/Ombra/Shapes.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Shapes.hs @@ -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 ] diff --git a/Graphics/Rendering/Ombra/Texture.hs b/Graphics/Rendering/Ombra/Texture.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Texture.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Transformation.hs b/Graphics/Rendering/Ombra/Transformation.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Transformation.hs @@ -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 diff --git a/Graphics/Rendering/Ombra/Types.hs b/Graphics/Rendering/Ombra/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Ombra/Types.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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/) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ombra.cabal b/ombra.cabal new file mode 100644 --- /dev/null +++ b/ombra.cabal @@ -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