packages feed

fwgl (empty) → 0.1.0.0

raw patch · 40 files changed

+6092/−0 lines, 40 filesdep +Yampadep +basedep +ghcjs-basesetup-changed

Dependencies added: Yampa, base, ghcjs-base, hashable, transformers, unordered-containers, vector

Files

+ FWGL.hs view
@@ -0,0 +1,47 @@+{-|+    The main module. You should also import a backend:++        * "FWGL.Backend.JavaScript": GHCJS/WebGL backend+        * FWGL.Backend.GLFW.GLES20: GLFW/OpenGL ES 2.0 backend (WIP)+        * FWGL.Backend.GLFW.GL32: GLFW/OpenGL 3.2 backend (WIP)+++    And a graphics system:++        * "FWGL.Graphics.D2": 2D graphics+        * FWGL.Graphics.D3: 3D graphics (WIP)+        * "FWGL.Graphics.Custom": advanced custom graphics++    "FWGL.Shader" contains the EDSL to make custom shaders.+-}+module FWGL (+        module FWGL.Audio,+        module FWGL.Input,+        module FWGL.Utils,+        module FRP.Yampa,+        Output(..),+        run+) where++import FWGL.Audio+import FWGL.Backend+import FWGL.Input+import FWGL.Internal.GL (evalGL)+import FWGL.Graphics.Draw+import FWGL.Graphics.Types+import FWGL.Utils+import FRP.Yampa++-- | The general output.+data Output = Output [Layer] Audio -- StateT ... IO++-- | Run a FWGL program.+run :: BackendIO+    => SF Input Output  -- ^ Main signal+    -> IO ()+run sigf = setup initState loop sigf+        where initState w h = evalGL $ drawInit w h+              loop (Output scenes _) ctx drawState =+                      flip evalGL ctx . flip execDraw drawState $+                              do drawBegin+                                 mapM_ drawLayer scenes
+ FWGL/Audio.hs view
@@ -0,0 +1,4 @@+module FWGL.Audio where++-- | It doesn't do anything (for now).+data Audio = Audio
+ FWGL/Backend.hs view
@@ -0,0 +1,7 @@+module FWGL.Backend (+        module FWGL.Backend.GLES,+        module FWGL.Backend.IO+) where++import FWGL.Backend.GLES+import FWGL.Backend.IO
+ FWGL/Backend/GLES.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE NullaryTypeClasses, TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}++module FWGL.Backend.GLES where++import Data.Word+import FWGL.Graphics.Color+import FWGL.Vector++class ( Integral GLEnum+      , Integral GLUInt+      , Integral GLInt+      , Integral GLSize+      , Num GLEnum+      , Num GLUInt+      , Num GLInt+      , Num GLPtrDiff+      , Num GLSize) => 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 ActiveInfo+        -- type ShaderPrecisionFormat+        type Array+        type Float32Array+        type Int32Array+        type Image++        true :: GLBool+        false :: GLBool+        nullGLPtr :: GLPtr+        -- arrayGLPtr :: Array -> (GLPtr -> IO a) -> IO a+        toGLString :: String -> GLString+        noBuffer :: Buffer+        noTexture :: Texture+        encodeM2 :: M2 -> IO Float32Array+        encodeM3 :: M3 -> IO Float32Array+        encodeM4 :: M4 -> IO Float32Array+        encodeFloats :: [Float] -> IO Array+        encodeV2s :: [V2] -> IO Array+        encodeV3s :: [V3] -> IO Array+        encodeV4s :: [V4] -> IO Array+        encodeUShorts :: [Word16] -> IO Array+        encodeColors :: [Color] -> IO Array++        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 ()+        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 -> Array -> GLEnum -> IO ()+        glBufferSubData :: Ctx -> GLEnum -> GLPtrDiff -> Array -> 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 -> Array -> IO ()+        glCompressedTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> Array -> 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+        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 ()+        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 ()+        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+        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 -> Array -> 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 ()+        glTexImage2DBuffer :: Ctx -> GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> Array -> IO ()+        glTexImage2DImage :: Ctx -> GLEnum -> GLInt -> GLInt -> GLEnum -> GLEnum -> Image -> IO ()+        glTexParameterf :: Ctx -> GLEnum -> GLEnum -> Float -> IO ()+        glTexParameteri :: Ctx -> GLEnum -> GLEnum -> GLInt -> IO ()+        glTexSubImage2D :: Ctx -> GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> Array -> IO ()+        glUniform1f :: Ctx -> UniformLocation -> Float -> IO ()+        glUniform1fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+        glUniform1i :: Ctx -> UniformLocation -> GLInt -> IO ()+        glUniform1iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+        glUniform2f :: Ctx -> UniformLocation -> Float -> Float -> IO ()+        glUniform2fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+        glUniform2i :: Ctx -> UniformLocation -> GLInt -> GLInt -> IO ()+        glUniform2iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+        glUniform3f :: Ctx -> UniformLocation -> Float -> Float -> Float -> IO ()+        glUniform3fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+        glUniform3i :: Ctx -> UniformLocation -> GLInt -> GLInt -> GLInt -> IO ()+        glUniform3iv :: Ctx -> UniformLocation -> Int32Array -> IO ()+        glUniform4f :: Ctx -> UniformLocation -> Float -> Float -> Float -> Float -> IO ()+        glUniform4fv :: Ctx -> UniformLocation -> Float32Array -> IO ()+        glUniform4i :: Ctx -> UniformLocation -> GLInt -> GLInt -> GLInt -> GLInt -> 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_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_COLOR_ATTACHMENT0 :: 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
+ FWGL/Backend/IO.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE NullaryTypeClasses, TypeFamilies #-}++module FWGL.Backend.IO where++import FRP.Yampa+import FWGL.Backend.GLES+import FWGL.Input++class GLES => BackendIO where+        -- TODO: loadImage may fail+        loadImage :: String -> ((Image, Int, Int) -> IO ()) -> IO ()++        setup :: (Int -> Int -> Ctx -> IO state)+              -> (out -> Ctx -> state -> IO state)+              -> SF Input out+              -> IO ()
+ FWGL/Backend/JavaScript.hs view
@@ -0,0 +1,587 @@+{-# LANGUAGE NullaryTypeClasses, TypeFamilies, UndecidableInstances #-}++{-| The GHCJS/WebGL backend. This just exports the instances for 'BackendIO'+    and 'GLES'. -}+module FWGL.Backend.JavaScript () where++import Control.Applicative+import Control.Concurrent+import qualified Data.HashMap.Strict as H+import Data.IORef+import Data.Word+import FRP.Yampa+import FWGL.Backend+import FWGL.Backend.JavaScript.Event+import qualified FWGL.Backend.JavaScript.WebGL as JS+import FWGL.Graphics.Color+import FWGL.Input+import FWGL.Vector+import GHCJS.Foreign+import GHCJS.Types+import GHCJS.Marshal++foreign import javascript unsafe+        "var img = new Image();                        \+        \img.src = $1;                                 \+        \img.onload = function() { return $2(img); };  "+        loadImageRaw :: JSString -> JSFun (JSRef a -> IO ()) -> IO ()++foreign import javascript unsafe "document.querySelector($1)"+        query :: JSString -> IO (JSRef a)++foreign import javascript unsafe "$2.getAttribute($1)"+        getAttributeRaw :: JSString -> JSRef a -> IO JSString++getAttribute :: String -> JSRef a -> IO String+getAttribute attr e = fromJSString <$> getAttributeRaw (toJSString attr) e++foreign import javascript unsafe "window.requestAnimationFrame($1)"+        requestAnimationFrame :: JSFun (JSRef Double -> IO ()) -> IO ()++foreign import javascript unsafe "$1.focus()" focus :: JSRef a -> IO ()++instance BackendIO where+        loadImage url f = asyncCallback1 NeverRetain callback+                          >>= loadImageRaw (toJSString url) +                where callback img =+                        do (Just w) <- getProp "width" img >>= fromJSRef+                           (Just h) <- getProp "height" img >>= fromJSRef+                           f (img, w, h)++        setup initState draw sigf =+                do element <- query $ toJSString "canvas"+                   eventSrc <- source handledEvents element+                   ctx <- JS.getCtx element+                   (Just w) <- getProp "clientWidth" element >>= fromJSRef+                   (Just h) <- getProp "clientHeight" element >>= fromJSRef+                   focus element -- ... no+                   drawStateRef <- initState w h ctx >>= newIORef+                   reactStateRef <- reactInit (return $ initInput w h)+                                              (\ _ _ -> actuate ctx drawStateRef)+                                              sigf+                   onFrame $ frame reactStateRef eventSrc Nothing+                where frame rsf src last crf =+                        do events <- clear src+                           (Just cur) <- fromJSRef crf+                           let tm = case last of+                                         Just l -> cur - l+                                         Nothing -> 0+                           react rsf (tm, Just $ Input events)+                           -- print tm -- debug+                           onFrame $ frame rsf src (Just cur)+        +                      onFrame handler = asyncCallback1 NeverRetain handler+                                        >>= requestAnimationFrame++                      initInput w h = Input $ H.singleton Resize [+                                EventData {+                                        dataFramebufferSize = Just (w, h),+                                        dataPointer = Nothing,+                                        dataButton = Nothing,+                                        dataKey = Nothing+                                }]+                                     +                      actuate ctx ref out = readIORef ref >>=+                                            draw out ctx >>=+                                         -- execDraw (drawBegin >> drawScene s) >>=+                                            writeIORef ref >> return False+                      handledEvents = [ MouseUp+                                      , MouseDown+                                      , MouseMove+                                      , KeyUp+                                      , KeyDown+                                      , Resize ]++instance GLES where+        type Ctx = JS.Ctx+        type GLEnum = Word+        type GLUInt = Word+        type GLInt = Int+        type GLPtr = Word+        type GLPtrDiff = Word+        type GLSize = Int+        type GLString = JSString+        type GLBool = Bool+        type Buffer = JS.Buffer+        type UniformLocation = JS.UniformLocation+        type Texture = JS.Texture+        type Shader = JS.Shader+        type Program = JS.Program+        type FrameBuffer = JS.FrameBuffer+        type RenderBuffer = JS.RenderBuffer+        -- type ActiveInfo = JS.ActiveInfo+        -- type ShaderPrecisionFormat = JS.ShaderPrecisionFormat+        type Array = JS.ArrayBufferView+        type Float32Array = JS.Float32Array+        type Int32Array = JS.Int32Array+        type Image = JS.Image++        true = True+        false = False+        nullGLPtr = 0+        toGLString = toJSString+        noBuffer = JS.noBuffer+        noTexture = JS.noTexture++        encodeM2 (M2 (V2 a1 a2) (V2 b1 b2)) = JS.listToJSArray [ a1, a2, b1, b2]+                                              >>= JS.float32Array++        encodeM3 (M3 (V3 a1 a2 a3)+                     (V3 b1 b2 b3)+                     (V3 c1 c2 c3)) = JS.listToJSArray [ a1, a2, a3+                                                       , b1, b2, b3+                                                       , c1, c2, c3]+                                      >>= JS.float32Array+        encodeM4 (M4 (V4 a1 a2 a3 a4)+                     (V4 b1 b2 b3 b4)+                     (V4 c1 c2 c3 c4)+                     (V4 d1 d2 d3 d4) ) = JS.listToJSArray [ a1, a2, a3, a4+                                                           , b1, b2, b3, b4+                                                           , c1, c2, c3, c4+                                                           , d1, d2, d3, d4 ]+                                          >>= JS.float32Array+        encodeFloats v = JS.listToJSArray v >>= JS.float32View++        -- TODO: decent implementation+        encodeV2s v = JS.toJSArray next (False, v) >>= JS.float32View+                where next (False, xs@(V2 x _ : _)) = Just (x, (True, xs))+                      next (True, V2 _ y : xs) = Just (y, (False, xs))+                      next (_, []) = Nothing++        encodeV3s v = JS.toJSArray next (0, v) >>= JS.float32View+                where next (0, xs@(V3 x _ _ : _)) = Just (x, (1, xs))+                      next (1, xs@(V3 _ y _ : _)) = Just (y, (2, xs))+                      next (2, V3 _ _ z : xs) = Just (z, (0, xs))+                      next (_, []) = Nothing++        -- TODO+        encodeV4s = error "encodeV4s: TODO"++        encodeUShorts v = JS.listToJSArray v >>= JS.uint16View++        encodeColors v = JS.toJSArray next (0, v) >>= JS.uint8View+                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++        glActiveTexture = JS.glActiveTexture+        glAttachShader = JS.glAttachShader+        glBindAttribLocation = JS.glBindAttribLocation+        glBindBuffer = JS.glBindBuffer+        glBindFramebuffer = JS.glBindFramebuffer+        glBindRenderbuffer = JS.glBindRenderbuffer+        glBindTexture = JS.glBindTexture+        glBlendColor = JS.glBlendColor+        glBlendEquation = JS.glBlendEquation+        glBlendEquationSeparate = JS.glBlendEquationSeparate+        glBlendFunc = JS.glBlendFunc+        glBlendFuncSeparate = JS.glBlendFuncSeparate+        glBufferData = JS.glBufferData+        glBufferSubData = JS.glBufferSubData+        glCheckFramebufferStatus = JS.glCheckFramebufferStatus+        glClear = JS.glClear+        glClearColor = JS.glClearColor+        glClearDepth = JS.glClearDepth+        glClearStencil = JS.glClearStencil+        glColorMask = JS.glColorMask+        glCompileShader = JS.glCompileShader+        glCompressedTexImage2D = JS.glCompressedTexImage2D+        glCompressedTexSubImage2D = JS.glCompressedTexSubImage2D+        glCopyTexImage2D = JS.glCopyTexImage2D+        glCopyTexSubImage2D = JS.glCopyTexSubImage2D+        glCreateBuffer = JS.glCreateBuffer+        glCreateFramebuffer = JS.glCreateFramebuffer+        glCreateProgram = JS.glCreateProgram+        glCreateRenderbuffer = JS.glCreateRenderbuffer+        glCreateShader = JS.glCreateShader+        glCreateTexture = JS.glCreateTexture+        glCullFace = JS.glCullFace+        glDeleteBuffer = JS.glDeleteBuffer+        glDeleteFramebuffer = JS.glDeleteFramebuffer+        glDeleteProgram = JS.glDeleteProgram+        glDeleteRenderbuffer = JS.glDeleteRenderbuffer+        glDeleteShader = JS.glDeleteShader+        glDeleteTexture = JS.glDeleteTexture+        glDepthFunc = JS.glDepthFunc+        glDepthMask = JS.glDepthMask+        glDepthRange = JS.glDepthRange+        glDetachShader = JS.glDetachShader+        glDisable = JS.glDisable+        glDisableVertexAttribArray = JS.glDisableVertexAttribArray+        glDrawArrays = JS.glDrawArrays+        glDrawElements = JS.glDrawElements+        glEnable = JS.glEnable+        glEnableVertexAttribArray = JS.glEnableVertexAttribArray+        glFinish = JS.glFinish+        glFlush = JS.glFlush+        glFramebufferRenderbuffer = JS.glFramebufferRenderbuffer+        glFramebufferTexture2D = JS.glFramebufferTexture2D+        glFrontFace = JS.glFrontFace+        glGenerateMipmap = JS.glGenerateMipmap+        -- glGetActiveAttrib = JS.glGetActiveAttrib+        -- glGetActiveUniform = JS.glGetActiveUniform+        glGetAttribLocation = JS.glGetAttribLocation+        -- glGetBufferParameter = JS.glGetBufferParameter+        -- glGetParameter = JS.glGetParameter+        glGetError = JS.glGetError+        -- glGetFramebufferAttachmentParameter = JS.glGetFramebufferAttachmentParameter+        glGetProgramInfoLog = JS.glGetProgramInfoLog+        -- glGetRenderbufferParameter = JS.glGetRenderbufferParameter+        -- glGetShaderParameter = JS.glGetShaderParameter+        -- glGetShaderPrecisionFormat = JS.glGetShaderPrecisionFormat+        glGetShaderInfoLog = JS.glGetShaderInfoLog+        glGetShaderSource = JS.glGetShaderSource+        -- glGetTexParameter = JS.glGetTexParameter+        -- glGetUniform = JS.glGetUniform+        glGetUniformLocation = JS.glGetUniformLocation+        -- glGetVertexAttrib = JS.glGetVertexAttrib+        -- glGetVertexAttribOffset = JS.glGetVertexAttribOffset+        glHint = JS.glHint+        glIsBuffer = JS.glIsBuffer+        glIsEnabled = JS.glIsEnabled+        glIsFramebuffer = JS.glIsFramebuffer+        glIsProgram = JS.glIsProgram+        glIsRenderbuffer = JS.glIsRenderbuffer+        glIsShader = JS.glIsShader+        glIsTexture = JS.glIsTexture+        glLineWidth = JS.glLineWidth+        glLinkProgram = JS.glLinkProgram+        glPixelStorei = JS.glPixelStorei+        glPolygonOffset = JS.glPolygonOffset+        glReadPixels = JS.glReadPixels+        glRenderbufferStorage = JS.glRenderbufferStorage+        glSampleCoverage = JS.glSampleCoverage+        glScissor = JS.glScissor+        glShaderSource = JS.glShaderSource+        glStencilFunc = JS.glStencilFunc+        glStencilFuncSeparate = JS.glStencilFuncSeparate+        glStencilMask = JS.glStencilMask+        glStencilMaskSeparate = JS.glStencilMaskSeparate+        glStencilOp = JS.glStencilOp+        glStencilOpSeparate = JS.glStencilOpSeparate+        glTexImage2DBuffer = JS.glTexImage2DBuffer+        glTexImage2DImage = JS.glTexImage2DElement+        glTexParameterf = JS.glTexParameterf+        glTexParameteri = JS.glTexParameteri+        glTexSubImage2D = JS.glTexSubImage2D+        glUniform1f = JS.glUniform1f+        glUniform1fv = JS.glUniform1fv+        glUniform1i = JS.glUniform1i+        glUniform1iv = JS.glUniform1iv+        glUniform2f = JS.glUniform2f+        glUniform2fv = JS.glUniform2fv+        glUniform2i = JS.glUniform2i+        glUniform2iv = JS.glUniform2iv+        glUniform3f = JS.glUniform3f+        glUniform3fv = JS.glUniform3fv+        glUniform3i = JS.glUniform3i+        glUniform3iv = JS.glUniform3iv+        glUniform4f = JS.glUniform4f+        glUniform4fv = JS.glUniform4fv+        glUniform4i = JS.glUniform4i+        glUniform4iv = JS.glUniform4iv+        glUniformMatrix2fv = JS.glUniformMatrix2fv+        glUniformMatrix3fv = JS.glUniformMatrix3fv+        glUniformMatrix4fv = JS.glUniformMatrix4fv+        glUseProgram = JS.glUseProgram+        glValidateProgram = JS.glValidateProgram+        glVertexAttrib1f = JS.glVertexAttrib1f+        glVertexAttrib1fv = JS.glVertexAttrib1fv+        glVertexAttrib2f = JS.glVertexAttrib2f+        glVertexAttrib2fv = JS.glVertexAttrib2fv+        glVertexAttrib3f = JS.glVertexAttrib3f+        glVertexAttrib3fv = JS.glVertexAttrib3fv+        glVertexAttrib4f = JS.glVertexAttrib4f+        glVertexAttrib4fv = JS.glVertexAttrib4fv+        glVertexAttribPointer = JS.glVertexAttribPointer+        glViewport = JS.glViewport++        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_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_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
+ FWGL/Backend/JavaScript/Event.hs view
@@ -0,0 +1,200 @@+-- TODO: rewrite everything++module FWGL.Backend.JavaScript.Event (+        InputEvent(..),+        Source,+        source,+        addEvent,+        addEvents,+        events,+        clear+) where++import Control.Applicative+import Data.Char (toLower, toUpper)+import qualified Data.Hashable as H+import qualified Data.HashMap.Strict as H+import Data.IORef++import GHCJS.Foreign+import GHCJS.Marshal+import GHCJS.Types++import FWGL.Input++type Event = InputEvent++data Source = Source {+        element :: JSRef (),+        eventMap :: IORef (H.HashMap Event [EventData])+}++source :: [Event] -> JSRef a -> IO Source+source es j = do+        s <- Source (castRef j) <$> newIORef H.empty+        addEvents es s+        return s++events :: Source -> IO (H.HashMap Event [EventData])+events (Source _ c) = readIORef c++clear :: Source -> IO (H.HashMap Event [EventData])+clear (Source _ c) = atomicModifyIORef' c $ \m -> (H.empty, m)++addEvents :: [Event] -> Source -> IO ()+addEvents es s = mapM_ (flip addEvent s) es++addEvent :: Event -> Source -> IO ()+addEvent e (Source j c) = asyncCallback1 NeverRetain handler >>=+                          addHandler j (toJSString $ eventName e)+        where +                prop p d =  getProp p d >>= fromJSRef+                handler d = do+                        eventData <- EventData+                                        <$> (do w <- prop "clientWidth" j+                                                h <- prop "clientHeight" j+                                                return $ (,) <$> w <*> h)+                                        <*> (do x <- prop "clientX" d+                                                y <- prop "clientY" d+                                                return $ (,) <$> x <*> y)+                                        <*> ((getButton <$>) <$> prop "button" d)+                                        <*> ((getKey <$>) <$> prop "keyCode" d)+                        modifyIORef c $ H.insertWith (flip (++)) e [ eventData ]++eventName :: Event -> String+-- eventName (Other s) = s+-- eventName DoubleClick = "dblclick"+eventName s = map toLower . show $ s++getButton :: Int -> MouseButton+getButton 0 = MouseLeft+getButton 1 = MouseMiddle+getButton 2 = MouseRight++foreign import javascript unsafe "$1.addEventListener($2, $3)"+        addHandler :: JSRef a -> JSString -> JSFun (JSRef b -> IO ()) -> IO ()++getKey :: Int -> Key+getKey 65 = KeyA+getKey 66 = KeyB+getKey 67 = KeyC+getKey 68 = KeyD+getKey 69 = KeyE+getKey 70 = KeyF+getKey 71 = KeyG+getKey 72 = KeyH+getKey 73 = KeyI+getKey 74 = KeyJ+getKey 75 = KeyK+getKey 76 = KeyL+getKey 77 = KeyM+getKey 78 = KeyN+getKey 79 = KeyO+getKey 80 = KeyP+getKey 81 = KeyQ+getKey 82 = KeyR+getKey 83 = KeyS+getKey 84 = KeyT+getKey 85 = KeyU+getKey 86 = KeyV+getKey 87 = KeyW+getKey 88 = KeyX+getKey 89 = KeyY+getKey 90 = KeyZ+getKey 97 = KeyA+getKey 98 = KeyB+getKey 99 = KeyC+getKey 100 = KeyD+getKey 101 = KeyE+getKey 102 = KeyF+getKey 103 = KeyG+getKey 104 = KeyH+getKey 105 = KeyI+getKey 106 = KeyJ+getKey 107 = KeyK+getKey 108 = KeyL+getKey 109 = KeyM+getKey 110 = KeyN+getKey 111 = KeyO+getKey 112 = KeyP+getKey 113 = KeyQ+getKey 114 = KeyR+getKey 115 = KeyS+getKey 116 = KeyT+getKey 117 = KeyU+getKey 118 = KeyV+getKey 119 = KeyW+getKey 120 = KeyX+getKey 121 = KeyY+getKey 122 = KeyZ+getKey 48 = Key0+getKey 49 = Key1+getKey 50 = Key2+getKey 51 = Key3+getKey 52 = Key4+getKey 53 = Key5+getKey 54 = Key6+getKey 55 = Key7+getKey 56 = Key8+getKey 57 = Key9+getKey 32 = KeySpace+getKey 13 = KeyEnter+getKey 9 = KeyTab+getKey 27 = KeyEsc+getKey 8 = KeyBackspace+getKey 16 = KeyShift+getKey 17 = KeyControl+getKey 18 = KeyAlt+getKey 20 = KeyCapsLock+getKey 144 = KeyNumLock+getKey 37 = KeyArrowLeft+getKey 38 = KeyArrowUp+getKey 39 = KeyArrowRight+getKey 40 = KeyArrowDown+getKey 45 = KeyIns+getKey 46 = KeyDel+getKey 36 = KeyHome+getKey 35 = KeyEnd+getKey 33 = KeyPgUp+getKey 34 = KeyPgDown+getKey 112 = KeyF1+getKey 113 = KeyF2+getKey 114 = KeyF3+getKey 115 = KeyF4+getKey 116 = KeyF5+getKey 117 = KeyF6+getKey 118 = KeyF7+getKey 119 = KeyF8+getKey 120 = KeyF9+getKey 121 = KeyF10+getKey 122 = KeyF11+getKey 123 = KeyF12+getKey 46 = KeyPadDel+getKey 45 = KeyPadIns+getKey 35 = KeyPadEnd+getKey 40 = KeyPadDown+getKey 34 = KeyPadPgDown+getKey 37 = KeyPadLeft+getKey 39 = KeyPadRight+getKey 36 = KeyPadHome+getKey 38 = KeyPadUp+getKey 33 = KeyPadPgUp+getKey 107 = KeyPadAdd+getKey 109 = KeyPadSub+getKey 106 = KeyPadMul+getKey 111 = KeyPadDiv+getKey 13 = KeyPadEnter+getKey 46 = KeyPadDot+getKey 48 = KeyPad0+getKey 49 = KeyPad1+getKey 50 = KeyPad2+getKey 51 = KeyPad3+getKey 52 = KeyPad4+getKey 53 = KeyPad5+getKey 54 = KeyPad6+getKey 55 = KeyPad7+getKey 56 = KeyPad8+getKey 57 = KeyPad9+getKey _ = KeyUnknown+-- TODO: letters, numbers+-- TODO: fix overlapping patterns
+ FWGL/Backend/JavaScript/WebGL.hs view
@@ -0,0 +1,5 @@+module FWGL.Backend.JavaScript.WebGL (module W) where++import FWGL.Backend.JavaScript.WebGL.Const as W+import FWGL.Backend.JavaScript.WebGL.Raw as W+import FWGL.Backend.JavaScript.WebGL.Types as W
+ FWGL/Backend/JavaScript/WebGL/Const.hs view
@@ -0,0 +1,886 @@+module FWGL.Backend.JavaScript.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
+ FWGL/Backend/JavaScript/WebGL/Raw.hs view
@@ -0,0 +1,514 @@+module FWGL.Backend.JavaScript.WebGL.Raw where++import Data.Int+import Data.Word++import GHCJS.Types++import FWGL.Backend.JavaScript.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 -> Word -> Word -> IO ()+-}++foreign import javascript unsafe "$1.bufferData($2, $3, $4)"+        glBufferData :: Ctx -> Word -> ArrayBufferView -> 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 -> ArrayBufferView -> 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 -> Int -> 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 -> Int -> Word -> Int -> Int -> Int -> ArrayBufferView -> IO ()++foreign import javascript unsafe "$1.compressedTexSubImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+        glCompressedTexSubImage2D :: Ctx -> Word -> Int -> Int -> Int -> Int -> Int -> Word -> ArrayBufferView -> IO ()++foreign import javascript unsafe "$1.copyTexImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+        glCopyTexImage2D :: Ctx -> Word -> Int -> Word -> Int -> Int -> Int -> Int -> Int -> IO ()++foreign import javascript unsafe "$1.copyTexSubImage2D($2, $3, $4, $5, $6, $7, $8, $9)"+        glCopyTexSubImage2D :: Ctx -> Word -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> 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 -> Int -> Int -> IO ()++foreign import javascript unsafe "$1.drawElements($2, $3, $4, $5)"+        glDrawElements :: Ctx -> Word -> Int -> 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 -> Int -> 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 Int++foreign import javascript unsafe "$1.getBufferParameter($2, $3)"+        glGetBufferParameter :: Ctx -> Word -> Word -> IO (JSRef a)++foreign import javascript unsafe "$1.getParameter($2)"+        glGetParameter :: Ctx -> Word -> IO (JSRef a)++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 (JSRef a)++foreign import javascript unsafe "$1.getShaderParameter($2, $3)"+        glGetShaderParameter :: Ctx -> Shader -> Word -> IO (JSRef a)++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 (JSRef a)++foreign import javascript unsafe "$1.getUniform($2, $3)"+        glGetUniform :: Ctx -> Program -> UniformLocation -> IO (JSRef a)++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 (JSRef a)++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 -> Int -> 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 -> Int -> Int -> Int -> Int -> Word -> Word -> ArrayBufferView -> IO ()++foreign import javascript unsafe "$1.renderbufferStorage($2, $3, $4, $5)"+        glRenderbufferStorage :: Ctx -> Word -> Word -> Int -> Int -> 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 -> Int -> Int -> Int -> Int -> 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 -> Int -> Word -> IO ()++foreign import javascript unsafe "$1.stencilFuncSeparate($2, $3, $4, $5)"+        glStencilFuncSeparate :: Ctx -> Word -> Word -> Int -> 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)"+        glTexImage2DBuffer :: Ctx -> Word -> Int -> Int -> Int -> Int -> Int -> Word -> Word -> ArrayBufferView -> IO ()++foreign import javascript unsafe "$1.texImage2D($2, $3, $4, $5, $6, $7)"+        glTexImage2DElement :: Ctx -> Word -> Int -> Int -> Word -> Word -> Image -> IO ()++{-+foreign import javascript unsafe "$1.texImage2D()"+        glTexImage2D :: Ctx -> Word -> Int -> Word -> Word -> Word -> CanvasElement -> Void ++foreign import javascript unsafe "$1.texImage2D()"+        glTexImage2D :: Ctx -> Word -> Int -> Word -> Word -> Word -> VideoElement -> Void +-}++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 -> Int -> IO ()++foreign import javascript unsafe "$1.texSubImage2D($2, $3, $4, $5, $6, $7, $8, $9, $10)"+        glTexSubImage2D :: Ctx -> Word -> Int -> Int -> Int -> Int -> Int -> Word -> Word -> ArrayBufferView -> IO ()++{-++foreign import javascript unsafe "$1.texSubImage2D()"+        glTexSubImage2D :: Ctx -> Word -> Int -> Int -> Int -> Word -> Word -> CanvasElement -> Void ++foreign import javascript unsafe "$1.texSubImage2D()"+        glTexSubImage2D :: Ctx -> Word -> Int -> Int -> Int -> Word -> Word -> VideoElement -> Void ++-}++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.uniform1fv($2 Sequence Float ->)"+        glUniform1fv :: Ctx -> UniformLocation -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniform1i($2, $3)"+        glUniform1i :: Ctx -> UniformLocation -> Int -> IO ()++foreign import javascript unsafe "$1.uniform1iv($2, $3)"+        glUniform1iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniform1iv($2 Sequence Int ->)"+        glUniform1iv :: Ctx -> UniformLocation -> Sequence Int -> 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.uniform2fv($2 Sequence Float ->)"+        glUniform2fv :: Ctx -> UniformLocation -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniform2i($2, $3, $4)"+        glUniform2i :: Ctx -> UniformLocation -> Int -> Int -> IO ()++foreign import javascript unsafe "$1.uniform2iv($2, $3)"+        glUniform2iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniform2iv($2 Sequence Int ->)"+        glUniform2iv :: Ctx -> UniformLocation -> Sequence Int -> 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.uniform3fv($2 Sequence Float ->)"+        glUniform3fv :: Ctx -> UniformLocation -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniform3i($2, $3, $4, $5)"+        glUniform3i :: Ctx -> UniformLocation -> Int -> Int -> Int -> IO ()++foreign import javascript unsafe "$1.uniform3iv($2, $3)"+        glUniform3iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniform3iv($2 Sequence Int ->)"+        glUniform3iv :: Ctx -> UniformLocation -> Sequence Int -> 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.uniform4fv($2 Sequence Float ->)"+        glUniform4fv :: Ctx -> UniformLocation -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniform4i($2, $3, $4, $5, $6)"+        glUniform4i :: Ctx -> UniformLocation -> Int -> Int -> Int -> Int -> IO ()++foreign import javascript unsafe "$1.uniform4iv($2, $3)"+        glUniform4iv :: Ctx -> UniformLocation -> Int32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniform4iv($2 Sequence Int ->)"+        glUniform4iv :: Ctx -> UniformLocation -> Sequence Int -> IO ()+-}++foreign import javascript unsafe "$1.uniformMatrix2fv($2, $3, $4)"+        glUniformMatrix2fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniformMatrix2fv($2, $3 Sequence Float ->)"+        glUniformMatrix2fv :: Ctx -> UniformLocation -> Bool -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniformMatrix3fv($2, $3, $4)"+        glUniformMatrix3fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniformMatrix3fv($2, $3 Sequence Float ->)"+        glUniformMatrix3fv :: Ctx -> UniformLocation -> Bool -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.uniformMatrix4fv($2, $3, $4)"+        glUniformMatrix4fv :: Ctx -> UniformLocation -> Bool -> Float32Array -> IO ()++{-+foreign import javascript unsafe "$1.uniformMatrix4fv($2, $3 Sequence Float ->)"+        glUniformMatrix4fv :: Ctx -> UniformLocation -> Bool -> Sequence Float -> 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.vertexAttrib1fv($2 Sequence Float ->)"+        glVertexAttrib1fv :: Ctx -> Word -> Sequence Float -> 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.vertexAttrib2fv($2 Sequence Float ->)"+        glVertexAttrib2fv :: Ctx -> Word -> Sequence Float -> 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.vertexAttrib3fv($2 Sequence Float ->)"+        glVertexAttrib3fv :: Ctx -> Word -> Sequence Float -> 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.vertexAttrib4fv($2 Sequence Float ->)"+        vertexAttrib4fv :: Ctx -> Word -> Sequence Float -> IO ()+-}++foreign import javascript unsafe "$1.vertexAttribPointer($2, $3, $4, $5, $6, $7)"+        glVertexAttribPointer :: Ctx -> Word -> Int -> Word -> Bool -> Int -> Word -> IO ()++foreign import javascript unsafe "$1.viewport($2, $3, $4, $5)"+        glViewport :: Ctx -> Int -> Int -> Int -> Int -> IO ()
+ FWGL/Backend/JavaScript/WebGL/Types.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++module FWGL.Backend.JavaScript.WebGL.Types (+        Ctx,+        Image,+        Float32Array,+        Int32Array,+        Uint16Array,+        Program,+        Shader,+        Buffer,+        FrameBuffer,+        RenderBuffer,+        Texture,+        UniformLocation,+        ActiveInfo,+        ShaderPrecisionFormat,+        ArrayBufferView,+        getCtx,+        float32Array,+        int32Array,+        uint16Array,+        uint8Array,+        float32View,+        int32View,+        uint16View,+        uint8View,+        toJSArray,+        listToJSArray,+        noBuffer,+        noTexture+) where++import Data.Int (Int32)+import Data.Word (Word8, Word16)+import GHCJS.Marshal+import GHCJS.Foreign+import GHCJS.Types++data Ctx_+type Ctx = JSRef Ctx_++data Image_+type Image = JSRef Image_++data Float32Array_+type Float32Array = JSRef Float32Array_++data Int32Array_+type Int32Array = JSRef Int32Array_++data Uint16Array_+type Uint16Array = JSRef Uint16Array_++data Uint8Array_+type Uint8Array = JSRef Uint8Array_++data Program_+type Program = JSRef Program_++data Shader_+type Shader = JSRef Shader_++data Buffer_+type Buffer = JSRef Buffer_++data FrameBuffer_+type FrameBuffer = JSRef FrameBuffer_++data RenderBuffer_+type RenderBuffer = JSRef RenderBuffer_++data Texture_+type Texture = JSRef Texture_++data UniformLocation_+type UniformLocation = JSRef UniformLocation_++data ActiveInfo_+type ActiveInfo = JSRef ActiveInfo_++data ShaderPrecisionFormat_+type ShaderPrecisionFormat = JSRef ShaderPrecisionFormat_++data ArrayBufferView_+type ArrayBufferView = JSRef ArrayBufferView_++noBuffer :: Buffer+noBuffer = jsNull++noTexture :: Texture+noTexture = jsNull++float32View :: JSArray Float -> IO ArrayBufferView+float32View = fmap castRef . float32Array++int32View :: JSArray Int32 -> IO ArrayBufferView+int32View = fmap castRef . int32Array++uint16View :: JSArray Word16 -> IO ArrayBufferView+uint16View = fmap castRef . uint16Array++uint8View :: JSArray Word8 -> IO ArrayBufferView+uint8View = fmap castRef . uint8Array++toJSArray :: ToJSRef a => (v -> Maybe (a, v)) -> v -> IO (JSArray a)+toJSArray next iv = newArray >>= iterPush iv+        where iterPush v arr = case next v of+                                        Just (x, v') -> do xRef <- toJSRef x+                                                           pushArray xRef arr+                                                           iterPush v' arr+                                        Nothing -> return arr++listToJSArray :: ToJSRef a => [a] -> IO (JSArray a)+listToJSArray = toJSArray deconstr+        where deconstr (x : xs) = Just (x, xs)+              deconstr [] = Nothing++foreign import javascript unsafe "$r = new Float32Array($1);"+        float32Array :: JSArray Float -> IO Float32Array++foreign import javascript unsafe "$r = new Int32Array($1);"+        int32Array :: JSArray Int32 -> IO Int32Array++foreign import javascript unsafe "$r = new Uint16Array($1);"+        uint16Array :: JSArray Word16 -> IO Uint16Array++foreign import javascript unsafe "$r = new Uint8Array($1);"+        uint8Array :: JSArray Word8 -> IO Uint8Array++foreign import javascript unsafe "$r = $1.getContext(\"webgl\");"+        getCtx :: JSRef a -> IO Ctx
+ FWGL/Geometry.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE GADTs, TypeOperators, KindSignatures, DataKinds,+             MultiParamTypeClasses #-}++module FWGL.Geometry (+        AttrList(..),+        Geometry(..),+        Geometry2,+        Geometry3,+        GPUGeometry(..),+        mkGeometry,+        mkGeometry2,+        mkGeometry3,+        castGeometry,+        facesToArrays,+        arraysToElements,+        triangulate+) where++import Control.Applicative+import Control.Monad.ST+import qualified Data.Hashable as H+import qualified Data.HashMap.Strict as H+import Data.Foldable (Foldable, forM_)+import Data.STRef+import qualified Data.Vector.Storable as V+import Data.Word (Word16, Word)+import Unsafe.Coerce++import FWGL.Internal.GL+import FWGL.Internal.Resource+import FWGL.Shader.CPU+import FWGL.Shader.Default2D (Position2)+import FWGL.Shader.Default3D (Position3, Normal3)+import qualified FWGL.Shader.Default2D as D2+import qualified FWGL.Shader.Default3D as D3+import FWGL.Shader.GLSL (attributeName)+import FWGL.Vector++data AttrList (is :: [*]) where+        AttrListNil :: AttrList '[]+        AttrListCons :: (H.Hashable c, AttributeCPU c g)+                     => g -> [c] -> AttrList gs -> AttrList (g ': gs)++-- ^ A set of attributes and indices.+data Geometry (is :: [*]) = Geometry (AttrList is) [Word16] Int++data GPUGeometry = GPUGeometry {+        attributeBuffers :: [(String, Buffer, GLUInt -> GL ())],+        elementBuffer :: Buffer,+        elementCount :: Int+}++type Geometry3 = '[Position3, D3.UV, Normal3]+type Geometry2 = '[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'++-- | Create a 3D 'Geometry'. The first three lists should have the same length.+mkGeometry3 :: GLES+            => [V3]     -- ^ List of vertices.+            -> [V2]     -- ^ List of UV coordinates.+            -> [V3]     -- ^ List of normals.+            -> [Word16] -- ^ Triangles expressed as triples of indices to the+                        --   three lists above.+            -> Geometry Geometry3+mkGeometry3 v u n = mkGeometry (AttrListCons (undefined :: Position3) v $+                                AttrListCons (undefined :: D3.UV) u $+                                AttrListCons (undefined :: Normal3) n+                                AttrListNil)++-- | Create a 2D 'Geometry'. The first two lists should have the same length.+mkGeometry2 :: GLES+            => [V2]     -- ^ List of vertices.+            -> [V2]     -- ^ List of UV coordinates.+            -> [Word16] -- ^ Triangles expressed as triples of indices to the+                        --   two lists above.+            -> Geometry Geometry2+mkGeometry2 v u = mkGeometry (AttrListCons (undefined :: Position2) v $+                              AttrListCons (undefined :: D2.UV) u+                              AttrListNil)++-- | Create a custom 'Geometry'.+mkGeometry :: GLES => AttrList is -> [Word16] -> Geometry is+mkGeometry al e = Geometry al e $ H.hash al++castGeometry :: Geometry is -> Geometry is'+castGeometry = unsafeCoerce++instance GLES => Resource (Geometry i) GPUGeometry GL where+        -- TODO: err check+        loadResource i f = loadGeometry i $ f . Right+        unloadResource _ = deleteGPUGeometry++loadGeometry :: GLES => Geometry i -> (GPUGeometry -> GL ()) -> GL ()+loadGeometry (Geometry al es _) = asyncGL $+        GPUGeometry <$> loadAttrList al+                    <*> (liftIO (encodeUShorts es) >>=+                            loadBuffer gl_ELEMENT_ARRAY_BUFFER)+                    <*> pure (length es)++loadAttrList :: GLES => AttrList is -> GL [(String, Buffer, GLUInt -> GL ())]+loadAttrList AttrListNil = return []+loadAttrList (AttrListCons g c al) = (:) <$> loadAttribute g c+                                         <*> loadAttrList al+        where loadAttribute g c = do arr <- encodeAttribute g c+                                     buf <- loadBuffer gl_ARRAY_BUFFER arr+                                     return (attributeName g, buf, setAttribute g)++deleteGPUGeometry :: GLES => GPUGeometry -> GL ()+deleteGPUGeometry (GPUGeometry abs eb _) = mapM_ (\(_, buf, _) -> deleteBuffer buf) abs+                                           >> deleteBuffer eb++-- TODO: move+loadBuffer :: GLES => GLEnum -> Array -> GL Buffer+loadBuffer ty bufData =+        do buffer <- createBuffer+           bindBuffer ty buffer+           bufferData ty bufData gl_STATIC_DRAW+           bindBuffer ty noBuffer+           return buffer+++-- TODO: use dlist+arraysToElements :: (Foldable f, GLES) => f (V3, V2, V3) -> Geometry Geometry3+arraysToElements arrays = runST $+        do vs <- newSTRef []+           us <- newSTRef []+           ns <- newSTRef []+           es <- newSTRef []+           triples <- newSTRef H.empty+           len <- newSTRef 0++           forM_ arrays $ \ t@(v, u, n) -> readSTRef triples >>= \ ts ->+                   case H.lookup t ts of+                           Just idx -> modifySTRef es (idx :)+                           Nothing -> do idx <- readSTRef len+                                         writeSTRef len $ idx + 1+                                         writeSTRef triples $ H.insert t idx ts+                                         modifySTRef vs (v :)+                                         modifySTRef us (u :)+                                         modifySTRef ns (n :)+                                         modifySTRef es (idx :)++           mkGeometry3 <$> (reverse <$> readSTRef vs)+                       <*> (reverse <$> readSTRef us)+                       <*> (reverse <$> readSTRef ns)+                       <*> (reverse <$> readSTRef es)++facesToArrays :: V.Vector V3 -> V.Vector V2 -> V.Vector V3+              -> [[(Int, Int, Int)]] -> [(V3, V2, V3)]+facesToArrays ovs ous ons = (>>= toIndex . triangulate)+        where toIndex = (>>= \(v1, v2, v3) -> [ getVertex v1+                                              , getVertex v2+                                              , getVertex v3 ])+              getVertex (v, u, n) = (ovs V.! v, ous V.! u, ons V.! n)++triangulate :: [a] -> [(a, a, a)]+triangulate [] = error "triangulate: empty face"+triangulate (_ : []) = error "triangulate: can't triangulate a point"+triangulate (_ : _ : []) = error "triangulate: can't triangulate an edge"+triangulate (x : y : z : []) = [(x, y, z)]+triangulate (x : y : z : w : []) = [(x, y, z), (x, z, w)]+triangulate _ = error "triangulate: can't triangulate >4 faces"
+ FWGL/Geometry/OBJ.hs view
@@ -0,0 +1,79 @@+module FWGL.Geometry.OBJ where++import Control.Applicative+import Control.Monad (when)+import Control.Monad.ST+import qualified Data.Vector.Storable as V+import Data.STRef++import FWGL.Backend (GLES)+import FWGL.Internal.STVectorLen+import FWGL.Geometry+import FWGL.Vector++data OBJModel = OBJModel {+        objVertices :: V.Vector V3,+        objUVCoords :: V.Vector V2,+        objNormals :: V.Vector V3,+        objFaces :: [[(Int, Int, Int)]]+} deriving (Show)++loadOBJ :: GLES => FilePath -> IO OBJModel+loadOBJ = fmap parseOBJ . readFile -- TODO: substitute with ajax++parseOBJ :: GLES => String -> OBJModel+parseOBJ file = runST $+        do vs <- new+           us <- new+           ns <- new+           fs <- newSTRef []++           flip mapM_ (lines file) $ \ l -> case l of+                   ('v' : ' ' : v3) -> cons (parseV3 v3) vs+                   ('v' : 't' : ' ' : v2) -> cons (parseV2 v2) us+                   ('v' : 'n' : ' ' : v3) -> cons (parseV3 v3) ns+                   ('f' : ' ' : f) -> modifySTRef fs (parseFace f :)+                   _ -> return ()++           usLen <- readSTRef $ snd us+           nsLen <- readSTRef $ snd ns++           when (usLen <= 0) $ cons (V2 0 0) us+           when (nsLen <= 0) $ cons (V3 0 0 0) ns++           OBJModel <$> freeze vs+                    <*> freeze us+                    <*> freeze ns+                    <*> readSTRef fs++        where split s e str = iter str "" []+                where iter (x : xs) cur fnd | x == s = iter xs "" $ +                                                           reverse cur : fnd+                                            | x /= e = iter xs (x : cur) fnd+                      iter _ [] fnd = fnd+                      iter _ cur fnd = reverse cur : fnd+              parseV3 str = case split ' ' '#' str of+                                (z : y : x : _) -> V3 (parseFloat x) +                                                      (parseFloat y)+                                                      (parseFloat z)+                                _ -> error "parseOBJ: invalid vertex/normal"+              parseV2 str = case split ' ' '#' str of+                                (y : x : _) -> V2 (parseFloat x) (parseFloat y)+                                _ -> error "parseOBJ: invalid uv coordinate"+              parseFace = map parseElement . reverse . split ' ' '#'++              parseElement str = case split '/' ' ' str of+                                     (n : t : v : _) -> ( parseInt v - 1+                                                        , parseInt t - 1+                                                        , parseInt n - 1 )+                                     _ -> error "parseOBJ: invalid element"++              parseInt [] = 1+              parseInt s = read s++              parseFloat [] = 0+              parseFloat s = read s++geometryOBJ :: GLES => OBJModel -> Geometry Geometry3+geometryOBJ (OBJModel vs us ns fs) =+        arraysToElements $ facesToArrays vs us ns fs
+ FWGL/Graphics/Color.hs view
@@ -0,0 +1,50 @@+module FWGL.Graphics.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
+ FWGL/Graphics/Custom.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE TypeOperators, DataKinds, ConstraintKinds,+             TypeFamilies, FlexibleContexts #-}++module FWGL.Graphics.Custom (+        module FWGL.Vector,+        Layer,+        Object,+        AttrList(..),+        Geometry,+        Texture,+        Color(..),+        (~~),+        program,+        nothing,+        static,+        global,+        globalDraw,+        globalTexture,+        globalTexSize,+        layer,+        unsafeJoin,+        mkGeometry,+        mkTexture,+        textureURL,+        textureFile,+        colorTex+) where++import Control.Applicative+import Data.Typeable+import FRP.Yampa+import FWGL.Backend (BackendIO, GLES)+import FWGL.Geometry+import FWGL.Graphics.Color+import FWGL.Graphics.Draw+import FWGL.Graphics.Types hiding (program)+import FWGL.Internal.GL (GLES, ActiveTexture)+import FWGL.Internal.TList+import FWGL.Shader.CPU+import FWGL.Shader.Program+import FWGL.Texture+import FWGL.Vector++-- | An empty custom object.+nothing :: Object '[] '[]+nothing = ObjectEmpty++-- | A custom object with a specified 'Geometry'.+static :: Geometry i -> Object '[] i+static = ObjectMesh . StaticGeom++-- | Sets a global (uniform) of an object.+global :: (Typeable g, UniformCPU c g) => g -> c+       -> Object gs is -> Object (g ': gs) is+global g c = globalDraw g $ return c++-- | Sets a global (uniform) of an object using a 'Texture'.+globalTexture :: (BackendIO, Typeable g, UniformCPU ActiveTexture g)+              => g -> Texture -> Object gs is -> Object (g ': gs) is+globalTexture g c = globalDraw g $ textureUniform c++-- | Sets a global (uniform) of an object using the dimensions of a 'Texture'.+globalTexSize :: (BackendIO, Typeable g, UniformCPU c g) => g -> Texture+              -> ((Int, Int) -> c) -> Object gs is -> Object (g ': gs) is+globalTexSize g t fc = globalDraw g $ fc <$> textureSize t++-- | Sets a global (uniform) of an object using the 'Draw' monad.+globalDraw :: (Typeable g, UniformCPU c g) => g -> Draw c+           -> Object gs is -> Object (g ': gs) is+globalDraw = ObjectGlobal++-- | Join two objects.+(~~) :: (Equal gs gs', Equal is is')+     => Object gs is -> Object gs' is'+     -> Object (Union gs gs') (Union is is')+(~~) = ObjectAppend++-- | Join two objects, even if they don't provide the same variables.+unsafeJoin :: (Equal gs'' (Union gs gs'), Equal is'' (Union is is'))+           => Object gs is -> Object gs' is' -> Object gs'' is''+unsafeJoin = ObjectAppend++-- | Associate an object with a program.+layer :: (Subset oi pi, Subset og pg)+      => Program pg pi -> Object og oi -> Layer+layer = Layer++-- | Generate a 1x1 texture.+colorTex :: GLES => Color -> Texture+colorTex c = mkTexture 1 1 [ c ]
+ FWGL/Graphics/D2.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DataKinds, FlexibleContexts, ConstraintKinds, TypeOperators,+             TypeFamilies #-}++{-| Simplified 2D graphics system. -}+module FWGL.Graphics.D2 (+        -- * Elements+        Element,+        rect,+        image,+        depth,+        sprite,+        -- ** Geometry+        Geometry,+        geom,+        mkGeometry2,+        -- * Textures+        module FWGL.Graphics.Color,+        C.textureURL,+        C.textureFile,+        C.colorTex,+        mkTexture,+        -- * Transformations+        V2(..),+        pos,+        rot,+        scale,+        scaleV,+        -- * Layers+        Layer,+        -- ** Element layers+        elements,+        view,+        -- ** Object layers+        layer,+        layerPrg,+        -- * Custom 2D objects+        Object,+        object,+        object1,+        (C.~~),+        -- ** Globals+        C.global,+        C.globalTexture,+        C.globalTexSize,+        viewObject,+        DefaultUniforms2D,+        Image(..),+        Depth(..),+        Transform2(..),+        View2(..),+        -- * 3D matrices+        V3(..),+        M3(..),+        mat3,+        mul3,+        -- ** Transformation matrices+        idMat3,+        transMat3,+        rotMat3,+        scaleMat3+) where++import Control.Applicative+import FWGL.Backend hiding (Texture, Image, Program)+import FWGL.Geometry+import qualified FWGL.Graphics.Custom as C+import FWGL.Graphics.Color+import FWGL.Graphics.Draw+import FWGL.Graphics.Shapes+import FWGL.Graphics.Types+import FWGL.Internal.TList+import FWGL.Shader.Default2D (Image, Depth, Transform2, View2)+import FWGL.Shader.Program+import FWGL.Texture+import FWGL.Vector++-- | A 2D object with a 'Texture', a depth and a transformation.+data Element = Element Float Texture (Draw M3) (Geometry Geometry2)++-- | A rectangle with a specified 'Texture' and size.+rect :: GLES => V2 -> Texture -> Element+rect v t = Element 0 t (return idMat3) $ rectGeometry v++-- | An element with a specified 'Geometry' and 'Texture'.+geom :: Texture -> Geometry Geometry2 -> Element+geom t = Element 0 t $ return idMat3++-- | A rectangle with the aspect ratio adapted to its texture.+image :: BackendIO+      => Float          -- ^ Width.+      -> Texture -> Element+image s t = Element 0 t ((\(w, h) -> scaleMat3 (V2 1 $ h /w)) <$> textureSize t)+                        (rectGeometry $ V2 s s)++-- | Set the depth of an element.+depth :: Float -> Element -> Element+depth d (Element _ t m g) = Element d t m g++-- | A rectangle with the size and aspect ratio adapted to the screen. You+-- have to use the 'FWGL.Utils.screenScale' view matrix.+sprite :: BackendIO => Texture -> Element+sprite t = Element 0 t ((\(w, h) -> scaleMat3 $ V2 w h) <$> textureSize t)+                       (rectGeometry $ V2 1 1)++-- | Create a graphical 'Object' from a list of 'Element's and a view matrix.+object :: BackendIO => M3 -> [Element] -> Object DefaultUniforms2D Geometry2+object m = viewObject m . foldl acc ObjectEmpty+        where acc o e = o C.~~ object1 e++-- | Create a graphical 'Object' from a single 'Element'. This lets you set your+-- own globals individually. If the shader uses the view matrix 'View2' (e.g.+-- the default 2D shader), you have to set it with 'viewObject'.+object1 :: BackendIO => Element -> Object '[Image, Depth, Transform2] Geometry2+object1 (Element d t m g) = C.globalTexture (undefined :: Image) t $+                            C.global (undefined :: Depth) d $+                            C.globalDraw (undefined :: Transform2) m $+                            C.static g++-- | Create a standard 'Layer' from a list of 'Element's.+elements :: BackendIO => [Element] -> Layer+elements = layer . object idMat3++-- | Create a 'Layer' from a view matrix and a list of 'Element's.+view :: BackendIO => M3 -> [Element] -> Layer+view m = layer . object m++-- | Set the value of the view matrix of a 2D 'Object'.+viewObject :: BackendIO => M3 -> Object gs Geometry2+           -> Object (View2 ': gs) Geometry2+viewObject = C.global (undefined :: View2)++-- | Create a 'Layer' from a 2D 'Object', using the default shader.+layer :: BackendIO => Object DefaultUniforms2D Geometry2 -> Layer+layer = layerPrg defaultProgram2D++-- | Create a 'Layer' from a 2D 'Object', using a custom shader.+layerPrg :: (BackendIO, Subset og pg) => Program pg Geometry2+         -> Object og Geometry2 -> Layer+layerPrg = C.layer++-- | Translate an 'Element'.+pos :: V2 -> Element -> Element+pos v = transform $ transMat3 v++-- | Rotate an 'Element'.+rot :: Float -> Element -> Element+rot a = transform $ rotMat3 a++-- | Scale an 'Element'.+scale :: Float -> Element -> Element+scale f = transform $ scaleMat3 (V2 f f)++-- | Scale an 'Element' in two dimensions.+scaleV :: V2 -> Element -> Element+scaleV v = transform $ scaleMat3 v++-- | Transform an 'Element'.+transform :: M3 -> Element -> Element+transform m' (Element d t m g) = Element d t (mul3 <$> m <*> pure m') g
+ FWGL/Graphics/Draw.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE GADTs, DataKinds, FlexibleContexts, TypeSynonymInstances,+             FlexibleInstances, MultiParamTypeClasses #-}++module FWGL.Graphics.Draw (+        Draw,+        DrawState,+        execDraw,+        drawInit,+        drawBegin,+        drawLayer,+        textureUniform,+        textureSize,+        setProgram,+        resize+) where++import FWGL.Geometry+import FWGL.Graphics.Shapes+import FWGL.Graphics.Types+import FWGL.Backend.IO+import FWGL.Internal.GL hiding (Texture, Program, UniformLocation)+import FWGL.Internal.Resource+import FWGL.Shader.CPU+import FWGL.Shader.GLSL+import FWGL.Shader.Program hiding (program)+import FWGL.Texture+import FWGL.Vector++import qualified Data.HashMap.Strict as H+import Data.Typeable+import Data.Word (Word)+import Control.Applicative+import Control.Monad (when)+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.State++drawInit :: (BackendIO, GLES) => Int -> Int -> GL DrawState+drawInit w h = do enable gl_DEPTH_TEST+                  clearColor 0.0 0.0 0.0 1.0+                  depthFunc gl_LESS+                  resize w h+                  return DrawState { program = Nothing+                                   , loadedProgram = Nothing+                                   , programs = newGLResMap+                                   , gpuMeshes = newGLResMap+                                   , uniforms = newGLResMap+                                   , textures = newGLResMap }+        where newGLResMap :: Resource i r GL => ResMap i r+              newGLResMap = newResMap++execDraw :: Draw () -> DrawState -> GL DrawState+execDraw (Draw a) = execStateT a++resize :: GLES => Int -> Int -> GL ()+resize w h = viewport 0 0 (fromIntegral w) (fromIntegral h)++drawBegin :: GLES => Draw ()+drawBegin = gl $ clear gl_COLOR_BUFFER_BIT++drawLayer :: (GLES, BackendIO) => Layer -> Draw ()+drawLayer (Layer prg obj) = setProgram prg >> drawObject obj++drawObject :: (GLES, BackendIO) => Object gs is -> Draw ()+drawObject ObjectEmpty = return ()+drawObject (ObjectMesh m) = drawMesh m+drawObject (ObjectGlobal g c o) = c >>= uniform g >> drawObject o+drawObject (ObjectAppend o o') = drawObject o >> drawObject o'++drawMesh :: GLES => Mesh is -> Draw ()+drawMesh Empty = return ()+drawMesh Cube = drawMesh (StaticGeom cubeGeometry)+drawMesh (StaticGeom g) = withRes_ (getGPUGeometry $ castGeometry g)+                                   drawGPUGeometry+drawMesh (DynamicGeom _ _) = error "drawMesh DynamicGeom: unsupported"+-- drawMesh (DynamicGeom d g) = delete {- removeResource -} d >> drawMesh (StaticGeom g)++uniform :: (GLES, Typeable g, UniformCPU c g) => g -> c -> Draw ()+uniform g c = withRes_ (getUniform g)+                       $ \(UniformLocation l) -> gl $ setUniform l g c++textureUniform :: (GLES, BackendIO) => Texture -> Draw ActiveTexture+textureUniform tex = do withRes_ (getTexture tex)+                                 $ \(LoadedTexture _ _ wtex) ->+                                        gl $ do activeTexture gl_TEXTURE0+                                                bindTexture gl_TEXTURE_2D wtex+                        return $ ActiveTexture 0++textureSize :: (GLES, BackendIO, Num a) => Texture -> Draw (a, a)+textureSize tex = withRes (getTexture tex) (return (0, 0))+                          $ \(LoadedTexture w h _) -> return ( fromIntegral w+                                                             , fromIntegral h)++setProgram :: GLES => Program g i -> Draw ()+setProgram p = do current <- program <$> Draw get+                  when (current /= Just (castProgram p)) $+                        withRes_ (getProgram $ castProgram p) $+                                \lp@(LoadedProgram glp _ _) -> do+                                   Draw . modify $ \s -> s {+                                           program = Just $ castProgram p,+                                           loadedProgram = Just lp+                                   }+                                   gl $ useProgram glp++withRes_ :: Draw (ResStatus a) -> (a -> Draw ()) -> Draw ()+withRes_ drs = withRes drs $ return ()++withRes :: Draw (ResStatus a) -> Draw b -> (a -> Draw b) -> Draw b+withRes drs u l = drs >>= \rs -> case rs of+                                        Loaded r -> l r+                                        _ -> u++getUniform :: (Typeable a, GLES) => a -> Draw (ResStatus UniformLocation)+getUniform g = do mprg <- loadedProgram <$> Draw get+                  case mprg of+                          Just prg ->+                                  getDrawResource gl uniforms+                                                  (\ m s -> s { uniforms = m })+                                                  (prg, globalName g)+                          Nothing -> return $ Error "No loaded program."++getGPUGeometry :: GLES => Geometry '[] -> Draw (ResStatus GPUGeometry)+getGPUGeometry = getDrawResource gl gpuMeshes (\ m s -> s { gpuMeshes = m })++getTexture :: (GLES, BackendIO) => Texture -> Draw (ResStatus LoadedTexture)+getTexture = getDrawResource gl textures (\ m s -> s { textures = m })++getProgram :: GLES => Program '[] '[] -> Draw (ResStatus LoadedProgram)+getProgram = getDrawResource gl programs (\ m s -> s { programs = m })++getDrawResource :: Resource i r m+                => (m (ResStatus r, ResMap i r)+                    -> Draw (ResStatus r, ResMap i r))+                -> (DrawState -> ResMap i r)+                -> (ResMap i r -> DrawState -> DrawState)+                -> i+                -> Draw (ResStatus r)+getDrawResource lft mg ms i = do+        s <- Draw get+        (r, map) <- lft . getResource i $ mg s+        Draw . put $ ms map s+        return r++drawGPUGeometry :: GLES => GPUGeometry -> Draw ()+drawGPUGeometry (GPUGeometry abs eb ec) =+        loadedProgram <$> Draw get >>= \mlp -> case mlp of+                Nothing -> return ()+                Just (LoadedProgram _ locs _) -> gl $ do+                        enabledLocs <- mapM (\(nm, buf, setAttr) ->+                                             let loc = locs H.! nm in+                                                  do bindBuffer gl_ARRAY_BUFFER+                                                                buf+                                                     enableVertexAttribArray $+                                                             fromIntegral loc+                                                     setAttr $ fromIntegral loc+                                                     return loc+                                            ) abs++                        bindBuffer gl_ELEMENT_ARRAY_BUFFER eb+                        drawElements gl_TRIANGLES (fromIntegral ec)+                                     gl_UNSIGNED_SHORT nullGLPtr+                        bindBuffer gl_ELEMENT_ARRAY_BUFFER noBuffer++                        mapM_ (disableVertexAttribArray . fromIntegral)+                              enabledLocs+                        bindBuffer gl_ARRAY_BUFFER noBuffer++instance GLES => Resource (LoadedProgram, String) UniformLocation GL where+        loadResource (LoadedProgram prg _ _, g) f =+                do loc <- getUniformLocation prg $ toGLString g+                   f . Right $ UniformLocation loc+        unloadResource _ _ = return ()++gl :: GL a -> Draw a+gl = Draw . lift
+ FWGL/Graphics/Shapes.hs view
@@ -0,0 +1,106 @@+module FWGL.Graphics.Shapes where++import FWGL.Geometry+import FWGL.Graphics.Types+import FWGL.Internal.GL (GLES)+import FWGL.Vector++rectGeometry :: GLES => V2 -> Geometry Geometry2+rectGeometry (V2 w h) = mkGeometry2 [ V2 (-hw) (-hh)+                                    , V2 hw    (-hh)+                                    , V2 hw    hh+                                    , V2 (-hw) hh ]+                                    [ V2 0 0+                                    , V2 1 0+                                    , V2 1 1+                                    , V2 0 1 ]+                                    [ 0, 1, 2, 0, 3, 2 ]+        where (hw, hh) = (w / 2, h / 2)++cubeGeometry :: GLES => Geometry Geometry3+cubeGeometry =+        mkGeometry3+                [ V3 1.0 1.0 (-0.999999), +                  V3 1.0 (-1.0) (-1.0), +                  V3 (-1.0) 1.0 (-1.0), +                  V3 (-1.0) (-1.0) 1.0, +                  V3 (-1.0) 1.0 1.0, +                  V3 (-1.0) (-1.0) (-1.0), +                  V3 (-1.0) (-1.0) 1.0, +                  V3 1.0 (-1.0) 1.0, +                  V3 (-1.0) 1.0 1.0, +                  V3 1.0 (-1.0) 1.0, +                  V3 1.0 (-1.0) (-1.0), +                  V3 0.999999 1.0 1.000001, +                  V3 1.0 1.0 (-0.999999), +                  V3 (-1.0) 1.0 (-1.0), +                  V3 0.999999 1.0 1.000001, +                  V3 1.0 (-1.0) (-1.0), +                  V3 1.0 (-1.0) 1.0, +                  V3 (-1.0) (-1.0) (-1.0), +                  V3 (-1.0) (-1.0) (-1.0), +                  V3 (-1.0) 1.0 (-1.0), +                  V3 0.999999 1.0 1.000001, +                  V3 1.0 1.0 (-0.999999), +                  V3 (-1.0) 1.0 1.0, +                  V3 (-1.0) (-1.0) 1.0 ]+                [ V2 0.9999 1.0e-4, +                  V2 0.9999 0.9999, +                  V2 1.0e-4 1.0e-4, +                  V2 1.0e-4 0.9999, +                  V2 1.0e-4 1.0e-4, +                  V2 0.9999 0.9999, +                  V2 1.0e-4 1.0e-4, +                  V2 0.9999 1.0e-4, +                  V2 1.0e-4 0.9999, +                  V2 1.0e-4 1.0e-4, +                  V2 0.9999 1.0e-4, +                  V2 1.0e-4 0.9999, +                  V2 0.9999 0.9999, +                  V2 1.0e-4 0.9999, +                  V2 0.9999 1.0e-4, +                  V2 0.9999 0.9999, +                  V2 1.0e-4 0.9999, +                  V2 0.9999 1.0e-4, +                  V2 1.0e-4 0.9999, +                  V2 0.9999 1.0e-4, +                  V2 0.9999 0.9999, +                  V2 0.9999 0.9999, +                  V2 1.0e-4 1.0e-4, +                  V2 1.0e-4 1.0e-4 ]+                [ V3 0.0 0.0 (-1.0), +                  V3 0.0 0.0 (-1.0), +                  V3 0.0 0.0 (-1.0), +                  V3 (-1.0) (-0.0) (-0.0), +                  V3 (-1.0) (-0.0) (-0.0), +                  V3 (-1.0) (-0.0) (-0.0), +                  V3 (-0.0) (-0.0) 1.0, +                  V3 (-0.0) (-0.0) 1.0, +                  V3 (-0.0) (-0.0) 1.0, +                  V3 1.0 (-0.0) 0.0, +                  V3 1.0 (-0.0) 0.0, +                  V3 1.0 (-0.0) 0.0, +                  V3 0.0 1.0 0.0, +                  V3 0.0 1.0 0.0, +                  V3 0.0 1.0 0.0, +                  V3 0.0 (-1.0) 0.0, +                  V3 0.0 (-1.0) 0.0, +                  V3 0.0 (-1.0) 0.0, +                  V3 0.0 0.0 (-1.0), +                  V3 (-1.0) (-0.0) (-0.0), +                  V3 (-0.0) (-0.0) 1.0, +                  V3 1.0 (-0.0) 0.0, +                  V3 0.0 1.0 0.0, +                  V3 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 ]
+ FWGL/Graphics/Types.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators,+             ExistentialQuantification, GeneralizedNewtypeDeriving #-}++module FWGL.Graphics.Types (+        Draw(..),+        DrawState(..),+        UniformLocation(..),+        Geometry(..),+        Mesh(..),+        Light(..),+        Object(..),+        Layer(..)+) where++import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Trans.State+import Data.Typeable+import FWGL.Geometry+import FWGL.Internal.GL hiding (Program, Texture, UniformLocation)+import qualified FWGL.Internal.GL as GL+import FWGL.Internal.TList+import FWGL.Internal.Resource+import FWGL.Shader.CPU+import FWGL.Shader.Program+import FWGL.Texture+import FWGL.Vector++newtype UniformLocation = UniformLocation GL.UniformLocation++data DrawState = DrawState {+        program :: Maybe (Program '[] '[]),+        loadedProgram :: Maybe LoadedProgram,+        programs :: ResMap (Program '[] '[]) LoadedProgram,+        uniforms :: ResMap (LoadedProgram, String) UniformLocation,+        gpuMeshes :: ResMap (Geometry '[]) GPUGeometry,+        textures :: ResMap Texture LoadedTexture+}++newtype Draw a = Draw { unDraw :: StateT DrawState GL a }+        deriving (Functor, Applicative, Monad, MonadIO)++-- | A static or dinamic geometry.+data Mesh is where+        Empty :: Mesh '[]+        Cube :: Mesh Geometry3+        StaticGeom :: Geometry is -> Mesh is+        DynamicGeom :: Geometry is -> Geometry is -> Mesh is++data Light++-- | An object is a set of geometries associated with some uniforms.+data Object (gs :: [*]) (is :: [*]) where+        ObjectEmpty :: Object gs is+        ObjectMesh :: Mesh is -> Object gs is+        ObjectGlobal :: (Typeable g, UniformCPU c g) => g -> Draw c+                     -> Object gs is -> Object gs' is +        ObjectAppend :: Object gs is -> Object gs' is' -> Object gs'' is''++{-+-- | An 'Element' is anything that can be converted to an 'Object'.+class Element o gs is | o -> gs is where+        object :: o -> Object gs is++instance Element (Object gs is) gs is where+        object = id+-}++-- | An object associated with a program.+data Layer = forall oi pi og pg. (Subset oi pi, Subset og pg)+                              => Layer (Program pg pi) (Object og oi)
+ FWGL/Input.hs view
@@ -0,0 +1,118 @@+module FWGL.Input (+        module FWGL.Key,+        Input(..),+        InputEvent(..),+        EventData(..),+        keyUp,+        keyDown,+        key,+        mouseDown,+        mouseUp,+        mouse,+        click,+        pointer,+        resize,+        size+) where++import Data.Maybe+import Data.Hashable+import qualified Data.HashMap.Strict as H+import FWGL.Key+import FRP.Yampa++-- | An event.+data InputEvent = KeyUp | KeyDown | MouseUp | MouseDown | MouseMove | Resize+                  deriving (Show, Eq, Enum)++-- | The data carried by an event.+data EventData = EventData {+        dataFramebufferSize :: Maybe (Int, Int),+        dataPointer :: Maybe (Int, Int),+        dataButton :: Maybe MouseButton,+        dataKey :: Maybe Key+}++-- | The general input.+data Input = Input {+        inputEvents :: H.HashMap InputEvent [EventData]+}++instance Hashable InputEvent where+        hashWithSalt salt = hashWithSalt salt . fromEnum++-- | Keyboard release.+keyUp :: Key -> SF Input (Event ())+keyUp k = evEdge KeyUp $ isKey k++-- | Keyboard press.+keyDown :: Key -> SF Input (Event ())+keyDown k = evEdge KeyDown $ isKey k++-- | Keyboard down.+key :: Key -> SF Input (Event ())+key k = sscan upDown NoEvent <<< keyUp k &&& keyDown k++-- | Mouse press.+mouseDown :: MouseButton -> SF Input (Event (Int, Int))+mouseDown b = evPointer MouseDown $ \d -> dataButton d == Just b++-- | Mouse release.+mouseUp :: MouseButton -> SF Input (Event (Int, Int))+mouseUp b = evPointer MouseUp $ \d -> dataButton d == Just b++-- | Mouse down.+mouse :: MouseButton -> SF Input (Event (Int, Int))+mouse b = sscan upDown NoEvent <<< mouseUp b &&& mouseDown b++-- | Left click.+click :: SF Input (Event (Int, Int))+click = mouseDown MouseLeft++-- | Pointer location in pixels.+pointer :: SF Input (Int, Int)+pointer = evPointer MouseMove (const True) >>> hold (0, 0)++-- | Window/framebuffer/canvas/etc. resize.+resize :: SF Input (Event (Int, Int))+resize = evSearch Resize (isJust . dataFramebufferSize) >>^+         fmap (fromJust . dataFramebufferSize)++-- | Window/framebuffer/canvas size.+size :: SF Input (Int, Int)+size = resize >>> hold (0, 0)++{- keyDownLimited :: KeyCode a => Double -> a -> SF Input (Event ())++keyLimited :: KeyCode a => Double -> a -> SF Input (Event ()) -}++upDown :: Event a -> (Event a, Event a) -> Event a+upDown _ (_, Event x) = Event x+upDown (Event _) (Event _, _) = NoEvent+upDown s _ = s++isKey :: Key -> EventData -> Bool+isKey k ed = case dataKey ed of+                Just k' -> k == k'+                Nothing -> False++evSearch :: InputEvent -> (EventData -> Bool) -> SF Input (Event EventData)+evSearch ev bP = arr $ \ inp -> case H.lookup ev $ inputEvents inp of+                                        Just bs -> eventHead $ filter bP bs+                                        Nothing -> NoEvent++evEdge :: InputEvent -> (EventData -> Bool) -> SF Input (Event ())+evEdge ev bP = evSearch ev bP >>> arr isEvent >>> edge++evPointer :: InputEvent -> (EventData -> Bool) -> SF Input (Event (Int, Int))+evPointer ev bP = evSearch ev bP >>>+                 arr (\ e -> case e of+                        Event ed -> case dataPointer ed of+                                        Just (x, y) -> Event (x, y)+                                        _ -> NoEvent+                        NoEvent -> NoEvent+                  )++eventHead :: [a] -> Event a+eventHead [] = NoEvent+eventHead (x : _) = Event x
+ FWGL/Internal/GL.hs view
@@ -0,0 +1,550 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module FWGL.Internal.GL (+        GL,+        ActiveTexture(..),+        module FWGL.Backend.GLES,+        liftIO,+        evalGL,+        forkGL,+        asyncGL,+        getCtx,+        activeTexture,+        attachShader,+        bindAttribLocation,+        bindBuffer,+        bindFramebuffer,+        bindRenderbuffer,+        bindTexture,+        blendColor,+        blendEquation,+        blendEquationSeparate,+        blendFunc,+        blendFuncSeparate,+        bufferData,+        bufferSubData,+        checkFramebufferStatus,+        clear,+        clearColor,+        clearDepth,+        clearStencil,+        colorMask,+        compileShader,+        compressedTexImage2D,+        compressedTexSubImage2D,+        copyTexImage2D,+        copyTexSubImage2D,+        createBuffer,+        createFramebuffer,+        createProgram,+        createRenderbuffer,+        createShader,+        createTexture,+        cullFace,+        deleteBuffer,+        deleteFramebuffer,+        deleteProgram,+        deleteRenderbuffer,+        deleteShader,+        deleteTexture,+        depthFunc,+        depthMask,+        depthRange,+        detachShader,+        disable,+        disableVertexAttribArray,+        drawArrays,+        drawElements,+        enable,+        enableVertexAttribArray,+        finish,+        flush,+        framebufferRenderbuffer,+        framebufferTexture2D,+        frontFace,+        generateMipmap,+        getAttribLocation,+        getError,+        getProgramInfoLog,+        -- getShaderPrecisionFormat,+        getShaderInfoLog,+        getShaderSource,+        getUniformLocation,+        hint,+        isBuffer,+        isEnabled,+        isFramebuffer,+        isProgram,+        isRenderbuffer,+        isShader,+        isTexture,+        lineWidth,+        linkProgram,+        pixelStorei,+        polygonOffset,+        readPixels,+        renderbufferStorage,+        sampleCoverage,+        scissor,+        shaderSource,+        stencilFunc,+        stencilFuncSeparate,+        stencilMask,+        stencilMaskSeparate,+        stencilOp,+        stencilOpSeparate,+        texImage2DBuffer,+        texImage2DImage,+        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.State+import Data.Word+import FWGL.Backend.GLES+        +-- TODO: context loss+newtype GL a = GL (StateT Ctx IO a)+        deriving (Functor, Applicative, Monad, MonadIO)++newtype ActiveTexture = ActiveTexture Word++evalGL :: GL a -> Ctx -> IO a+evalGL (GL m) = evalStateT m++forkGL :: GLES => GL () -> GL ThreadId+forkGL a = getCtx >>= \ctx -> liftIO . forkIO $ evalGL a ctx++asyncGL :: GLES => GL a -> (a -> GL ()) -> GL ()+asyncGL r f = forkGL (r >>= f) >> return ()++getCtx :: GLES => GL Ctx+getCtx = GL get++activeTexture :: GLES => GLEnum -> GL ()+activeTexture a = GL get >>= \ctx -> liftIO $ glActiveTexture ctx a++attachShader :: GLES => Program -> Shader -> GL ()+attachShader a b = GL get >>= \ctx -> liftIO $ glAttachShader ctx a b++bindAttribLocation :: GLES => Program -> GLUInt -> GLString -> GL ()+bindAttribLocation a b c = GL get >>= \ctx -> liftIO $ glBindAttribLocation ctx a b c++bindBuffer :: GLES => GLEnum -> Buffer -> GL ()+bindBuffer a b = GL get >>= \ctx -> liftIO $ glBindBuffer ctx a b++bindFramebuffer :: GLES => GLEnum -> FrameBuffer -> GL ()+bindFramebuffer a b = GL get >>= \ctx -> liftIO $ glBindFramebuffer ctx a b++bindRenderbuffer :: GLES => GLEnum -> RenderBuffer -> GL ()+bindRenderbuffer a b = GL get >>= \ctx -> liftIO $ glBindRenderbuffer ctx a b++bindTexture :: GLES => GLEnum -> Texture -> GL ()+bindTexture a b = GL get >>= \ctx -> liftIO $ glBindTexture ctx a b++blendColor :: GLES => Float -> Float -> Float -> Float -> GL ()+blendColor a b c d = GL get >>= \ctx -> liftIO $ glBlendColor ctx a b c d++blendEquation :: GLES => GLEnum -> GL ()+blendEquation a = GL get >>= \ctx -> liftIO $ glBlendEquation ctx a++blendEquationSeparate :: GLES => GLEnum -> GLEnum -> GL ()+blendEquationSeparate a b = GL get >>= \ctx -> liftIO $ glBlendEquationSeparate ctx a b++blendFunc :: GLES => GLEnum -> GLEnum -> GL ()+blendFunc a b = GL get >>= \ctx -> liftIO $ glBlendFunc ctx a b++blendFuncSeparate :: GLES => GLEnum -> GLEnum -> GLEnum -> GLEnum -> GL ()+blendFuncSeparate a b c d = GL get >>= \ctx -> liftIO $ glBlendFuncSeparate ctx a b c d++bufferData :: GLES => GLEnum -> Array -> GLEnum -> GL ()+bufferData a b c = GL get >>= \ctx -> liftIO $ glBufferData ctx a b c++bufferSubData :: GLES => GLEnum -> GLPtrDiff -> Array -> GL ()+bufferSubData a b c = GL get >>= \ctx -> liftIO $ glBufferSubData ctx a b c++checkFramebufferStatus :: GLES => GLEnum -> GL GLEnum+checkFramebufferStatus a = GL get >>= \ctx -> liftIO $ glCheckFramebufferStatus ctx a++clear :: GLES => GLEnum -> GL ()+clear a = GL get >>= \ctx -> liftIO $ glClear ctx a++clearColor :: GLES => Float -> Float -> Float -> Float -> GL ()+clearColor a b c d = GL get >>= \ctx -> liftIO $ glClearColor ctx a b c d++clearDepth :: GLES => Float -> GL ()+clearDepth a = GL get >>= \ctx -> liftIO $ glClearDepth ctx a++clearStencil :: GLES => GLInt -> GL ()+clearStencil a = GL get >>= \ctx -> liftIO $ glClearStencil ctx a++colorMask :: GLES => GLBool -> GLBool -> GLBool -> GLBool -> GL ()+colorMask a b c d = GL get >>= \ctx -> liftIO $ glColorMask ctx a b c d++compileShader :: GLES => Shader -> GL ()+compileShader a = GL get >>= \ctx -> liftIO $ glCompileShader ctx a++compressedTexImage2D :: GLES => GLEnum -> GLInt -> GLEnum -> GLSize -> GLSize -> GLInt -> Array -> GL ()+compressedTexImage2D a b c d e f g = GL get >>= \ctx -> liftIO $ glCompressedTexImage2D ctx a b c d e f g++compressedTexSubImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> Array -> GL ()+compressedTexSubImage2D a b c d e f g h = GL get >>= \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 = GL get >>= \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 = GL get >>= \ctx -> liftIO $ glCopyTexSubImage2D ctx a b c d e f g h++createBuffer :: GLES => GL Buffer+createBuffer = GL get >>= liftIO . glCreateBuffer++createFramebuffer :: GLES => GL FrameBuffer+createFramebuffer = GL get >>= liftIO . glCreateFramebuffer++createProgram :: GLES => GL Program+createProgram = GL get >>= liftIO . glCreateProgram++createRenderbuffer :: GLES => GL RenderBuffer+createRenderbuffer = GL get >>= liftIO . glCreateRenderbuffer++createShader :: GLES => GLEnum -> GL Shader+createShader a = GL get >>= \ctx -> liftIO $ glCreateShader ctx a++createTexture :: GLES => GL Texture+createTexture = GL get >>= liftIO . glCreateTexture++cullFace :: GLES => GLEnum -> GL ()+cullFace a = GL get >>= \ctx -> liftIO $ glCullFace ctx a++deleteBuffer :: GLES => Buffer -> GL ()+deleteBuffer a = GL get >>= \ctx -> liftIO $ glDeleteBuffer ctx a++deleteFramebuffer :: GLES => FrameBuffer -> GL ()+deleteFramebuffer a = GL get >>= \ctx -> liftIO $ glDeleteFramebuffer ctx a++deleteProgram :: GLES => Program -> GL ()+deleteProgram a = GL get >>= \ctx -> liftIO $ glDeleteProgram ctx a++deleteRenderbuffer :: GLES => RenderBuffer -> GL ()+deleteRenderbuffer a = GL get >>= \ctx -> liftIO $ glDeleteRenderbuffer ctx a++deleteShader :: GLES => Shader -> GL ()+deleteShader a = GL get >>= \ctx -> liftIO $ glDeleteShader ctx a++deleteTexture :: GLES => Texture -> GL ()+deleteTexture a = GL get >>= \ctx -> liftIO $ glDeleteTexture ctx a++depthFunc :: GLES => GLEnum -> GL ()+depthFunc a = GL get >>= \ctx -> liftIO $ glDepthFunc ctx a++depthMask :: GLES => GLBool -> GL ()+depthMask a = GL get >>= \ctx -> liftIO $ glDepthMask ctx a++depthRange :: GLES => Float -> Float -> GL ()+depthRange a b = GL get >>= \ctx -> liftIO $ glDepthRange ctx a b++detachShader :: GLES => Program -> Shader -> GL ()+detachShader a b = GL get >>= \ctx -> liftIO $ glDetachShader ctx a b++disable :: GLES => GLEnum -> GL ()+disable a = GL get >>= \ctx -> liftIO $ glDisable ctx a++disableVertexAttribArray :: GLES => GLUInt -> GL ()+disableVertexAttribArray a = GL get >>= \ctx -> liftIO $ glDisableVertexAttribArray ctx a++drawArrays :: GLES => GLEnum -> GLInt -> GLSize -> GL ()+drawArrays a b c = GL get >>= \ctx -> liftIO $ glDrawArrays ctx a b c++drawElements :: GLES => GLEnum -> GLSize -> GLEnum -> GLPtr -> GL ()+drawElements a b c d = GL get >>= \ctx -> liftIO $ glDrawElements ctx a b c d++enable :: GLES => GLEnum -> GL ()+enable a = GL get >>= \ctx -> liftIO $ glEnable ctx a++enableVertexAttribArray :: GLES => GLUInt -> GL ()+enableVertexAttribArray a = GL get >>= \ctx -> liftIO $ glEnableVertexAttribArray ctx a++finish :: GLES => GL ()+finish = GL get >>= liftIO . glFinish++flush :: GLES => GL ()+flush = GL get >>= liftIO . glFlush++framebufferRenderbuffer :: GLES => GLEnum -> GLEnum -> GLEnum -> RenderBuffer -> GL ()+framebufferRenderbuffer a b c d = GL get >>= \ctx -> liftIO $ glFramebufferRenderbuffer ctx a b c d++framebufferTexture2D :: GLES => GLEnum -> GLEnum -> GLEnum -> Texture -> GLInt -> GL ()+framebufferTexture2D a b c d e = GL get >>= \ctx -> liftIO $ glFramebufferTexture2D ctx a b c d e++frontFace :: GLES => GLEnum -> GL ()+frontFace a = GL get >>= \ctx -> liftIO $ glFrontFace ctx a++generateMipmap :: GLES => GLEnum -> GL ()+generateMipmap a = GL get >>= \ctx -> liftIO $ glGenerateMipmap ctx a++-- glGetActiveAttrib :: GLES => Program -> GLEnum -> GL ActiveInfo+-- getActiveAttrib a b = GL get >>= \ctx -> liftIO $ glGetActiveAttrib ctx a b++-- glGetActiveUniform :: GLES => Program -> GLEnum -> GL ActiveInfo+-- getActiveUniform a b = GL get >>= \ctx -> liftIO $ glGetActiveUniform ctx a b++getAttribLocation :: GLES => Program -> GLString -> GL GLInt+getAttribLocation a b = GL get >>= \ctx -> liftIO $ glGetAttribLocation ctx a b++-- glGetBufferParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getBufferParameter a b = GL get >>= \ctx -> liftIO $ glGetBufferParameter ctx a b++-- glGetParameter :: GLES => Word -> GL (JSRef a)+-- getParameter a = GL get >>= \ctx -> liftIO $ glGetParameter ctx a++getError :: GLES => GL GLEnum+getError = GL get >>= liftIO . glGetError++-- glGetFramebufferAttachmentParameter :: GLES => GLEnum -> GLEnum -> GL Word+-- getFramebufferAttachmentParameter a b = GL get >>= \ctx -> liftIO $ glGetFramebufferAttachmentParameter ctx a b++getProgramInfoLog :: GLES => Program -> GL GLString+getProgramInfoLog a = GL get >>= \ctx -> liftIO $ glGetProgramInfoLog ctx a++-- glGetRenderbufferParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getRenderbufferParameter a b = GL get >>= \ctx -> liftIO $ glGetRenderbufferParameter ctx a b++-- glGetShaderParameter :: GLES => Shader -> Word -> GL (JSRef a)+-- getShaderParameter a b = GL get >>= \ctx -> liftIO $ glGetShaderParameter ctx a b++-- getShaderPrecisionFormat :: GLES => GLEnum -> GLEnum -> GL ShaderPrecisionFormat+-- getShaderPrecisionFormat a b = GL get >>= \ctx -> liftIO $ glGetShaderPrecisionFormat ctx a b++getShaderInfoLog :: GLES => Shader -> GL GLString+getShaderInfoLog a = GL get >>= \ctx -> liftIO $ glGetShaderInfoLog ctx a++getShaderSource :: GLES => Shader -> GL GLString+getShaderSource a = GL get >>= \ctx -> liftIO $ glGetShaderSource ctx a++-- glGetTexParameter :: GLES => Word -> Word -> GL (JSRef a)+-- getTexParameter a b = GL get >>= \ctx -> liftIO $ glGetTexParameter ctx a b++-- glGetUniform :: GLES => Program -> UniformLocation -> GL (JSRef a)+-- getUniform a b = GL get >>= \ctx -> liftIO $ glGetUniform ctx a b++getUniformLocation :: GLES => Program -> GLString -> GL UniformLocation+getUniformLocation a b = GL get >>= \ctx -> liftIO $ glGetUniformLocation ctx a b++-- glGetVertexAttrib :: GLES => Word -> Word -> GL (JSRef a)+-- getVertexAttrib a b = GL get >>= \ctx -> liftIO $ glGetVertexAttrib ctx a b++-- glGetVertexAttribOffset :: GLES => Word -> GLEnum -> GL Word+-- getVertexAttribOffset a b = GL get >>= \ctx -> liftIO $ glGetVertexAttribOffset ctx a b++hint :: GLES => GLEnum -> GLEnum -> GL ()+hint a b = GL get >>= \ctx -> liftIO $ glHint ctx a b++isBuffer :: GLES => Buffer -> GL GLBool+isBuffer a = GL get >>= \ctx -> liftIO $ glIsBuffer ctx a++isEnabled :: GLES => GLEnum -> GL GLBool+isEnabled a = GL get >>= \ctx -> liftIO $ glIsEnabled ctx a++isFramebuffer :: GLES => FrameBuffer -> GL GLBool+isFramebuffer a = GL get >>= \ctx -> liftIO $ glIsFramebuffer ctx a++isProgram :: GLES => Program -> GL GLBool+isProgram a = GL get >>= \ctx -> liftIO $ glIsProgram ctx a++isRenderbuffer :: GLES => RenderBuffer -> GL GLBool+isRenderbuffer a = GL get >>= \ctx -> liftIO $ glIsRenderbuffer ctx a++isShader :: GLES => Shader -> GL GLBool+isShader a = GL get >>= \ctx -> liftIO $ glIsShader ctx a++isTexture :: GLES => Texture -> GL GLBool+isTexture a = GL get >>= \ctx -> liftIO $ glIsTexture ctx a++lineWidth :: GLES => Float -> GL ()+lineWidth a = GL get >>= \ctx -> liftIO $ glLineWidth ctx a++linkProgram :: GLES => Program -> GL ()+linkProgram a = GL get >>= \ctx -> liftIO $ glLinkProgram ctx a++pixelStorei :: GLES => GLEnum -> GLInt -> GL ()+pixelStorei a b = GL get >>= \ctx -> liftIO $ glPixelStorei ctx a b++polygonOffset :: GLES => Float -> Float -> GL ()+polygonOffset a b = GL get >>= \ctx -> liftIO $ glPolygonOffset ctx a b++readPixels :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> Array -> GL ()+readPixels a b c d e f g = GL get >>= \ctx -> liftIO $ glReadPixels ctx a b c d e f g++renderbufferStorage :: GLES => GLEnum -> GLEnum -> GLSize -> GLSize -> GL ()+renderbufferStorage a b c d = GL get >>= \ctx -> liftIO $ glRenderbufferStorage ctx a b c d++sampleCoverage :: GLES => Float -> GLBool -> GL ()+sampleCoverage a b = GL get >>= \ctx -> liftIO $ glSampleCoverage ctx a b++scissor :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GL ()+scissor a b c d = GL get >>= \ctx -> liftIO $ glScissor ctx a b c d++shaderSource :: GLES => Shader -> GLString -> GL ()+shaderSource a b = GL get >>= \ctx -> liftIO $ glShaderSource ctx a b++stencilFunc :: GLES => GLEnum -> GLInt -> GLUInt -> GL ()+stencilFunc a b c = GL get >>= \ctx -> liftIO $ glStencilFunc ctx a b c++stencilFuncSeparate :: GLES => GLEnum -> GLEnum -> GLInt -> GLUInt -> GL ()+stencilFuncSeparate a b c d = GL get >>= \ctx -> liftIO $ glStencilFuncSeparate ctx a b c d++stencilMask :: GLES => GLUInt -> GL ()+stencilMask a = GL get >>= \ctx -> liftIO $ glStencilMask ctx a++stencilMaskSeparate :: GLES => GLEnum -> GLUInt -> GL ()+stencilMaskSeparate a b = GL get >>= \ctx -> liftIO $ glStencilMaskSeparate ctx a b++stencilOp :: GLES => GLEnum -> GLEnum -> GLEnum -> GL ()+stencilOp a b c = GL get >>= \ctx -> liftIO $ glStencilOp ctx a b c++stencilOpSeparate :: GLES => GLEnum -> GLEnum -> GLEnum -> GLEnum -> GL ()+stencilOpSeparate a b c d = GL get >>= \ctx -> liftIO $ glStencilOpSeparate ctx a b c d++texImage2DBuffer :: GLES => GLEnum -> GLInt -> GLInt -> GLSize -> GLSize -> GLInt -> GLEnum -> GLEnum -> Array -> GL ()+texImage2DBuffer a b c d e f g h i = GL get >>= \ctx -> liftIO $ glTexImage2DBuffer ctx a b c d e f g h i++texImage2DImage :: GLES => GLEnum -> GLInt -> GLInt -> GLEnum -> GLEnum -> Image -> GL ()+texImage2DImage a b c d e f = GL get >>= \ctx -> liftIO $ glTexImage2DImage ctx a b c d e f++texParameterf :: GLES => GLEnum -> GLEnum -> Float -> GL ()+texParameterf a b c = GL get >>= \ctx -> liftIO $ glTexParameterf ctx a b c++texParameteri :: GLES => GLEnum -> GLEnum -> GLInt -> GL ()+texParameteri a b c = GL get >>= \ctx -> liftIO $ glTexParameteri ctx a b c++texSubImage2D :: GLES => GLEnum -> GLInt -> GLInt -> GLInt -> GLSize -> GLSize -> GLEnum -> GLEnum -> Array -> GL ()+texSubImage2D a b c d e f g h i = GL get >>= \ctx -> liftIO $ glTexSubImage2D ctx a b c d e f g h i++uniform1f :: GLES => UniformLocation -> Float -> GL ()+uniform1f a b = GL get >>= \ctx -> liftIO $ glUniform1f ctx a b++uniform1fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform1fv a b = GL get >>= \ctx -> liftIO $ glUniform1fv ctx a b++uniform1i :: GLES => UniformLocation -> GLInt -> GL ()+uniform1i a b = GL get >>= \ctx -> liftIO $ glUniform1i ctx a b++uniform1iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform1iv a b = GL get >>= \ctx -> liftIO $ glUniform1iv ctx a b++uniform2f :: GLES => UniformLocation -> Float -> Float -> GL ()+uniform2f a b c = GL get >>= \ctx -> liftIO $ glUniform2f ctx a b c++uniform2fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform2fv a b = GL get >>= \ctx -> liftIO $ glUniform2fv ctx a b++uniform2i :: GLES => UniformLocation -> GLInt -> GLInt -> GL ()+uniform2i a b c = GL get >>= \ctx -> liftIO $ glUniform2i ctx a b c++uniform2iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform2iv a b = GL get >>= \ctx -> liftIO $ glUniform2iv ctx a b++uniform3f :: GLES => UniformLocation -> Float -> Float -> Float -> GL ()+uniform3f a b c d = GL get >>= \ctx -> liftIO $ glUniform3f ctx a b c d++uniform3fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform3fv a b = GL get >>= \ctx -> liftIO $ glUniform3fv ctx a b++uniform3i :: GLES => UniformLocation -> GLInt -> GLInt -> GLInt -> GL ()+uniform3i a b c d = GL get >>= \ctx -> liftIO $ glUniform3i ctx a b c d++uniform3iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform3iv a b = GL get >>= \ctx -> liftIO $ glUniform3iv ctx a b++uniform4f :: GLES => UniformLocation -> Float -> Float -> Float -> Float -> GL ()+uniform4f a b c d e = GL get >>= \ctx -> liftIO $ glUniform4f ctx a b c d e++uniform4fv :: GLES => UniformLocation -> Float32Array -> GL ()+uniform4fv a b = GL get >>= \ctx -> liftIO $ glUniform4fv ctx a b++uniform4i :: GLES => UniformLocation -> GLInt -> GLInt -> GLInt -> GLInt -> GL ()+uniform4i a b c d e = GL get >>= \ctx -> liftIO $ glUniform4i ctx a b c d e++uniform4iv :: GLES => UniformLocation -> Int32Array -> GL ()+uniform4iv a b = GL get >>= \ctx -> liftIO $ glUniform4iv ctx a b++uniformMatrix2fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix2fv a b c = GL get >>= \ctx -> liftIO $ glUniformMatrix2fv ctx a b c++uniformMatrix3fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix3fv a b c = GL get >>= \ctx -> liftIO $ glUniformMatrix3fv ctx a b c++uniformMatrix4fv :: GLES => UniformLocation -> GLBool -> Float32Array -> GL ()+uniformMatrix4fv a b c = GL get >>= \ctx -> liftIO $ glUniformMatrix4fv ctx a b c++useProgram :: GLES => Program -> GL ()+useProgram a = GL get >>= \ctx -> liftIO $ glUseProgram ctx a++validateProgram :: GLES => Program -> GL ()+validateProgram a = GL get >>= \ctx -> liftIO $ glValidateProgram ctx a++vertexAttrib1f :: GLES => GLUInt -> Float -> GL ()+vertexAttrib1f a b = GL get >>= \ctx -> liftIO $ glVertexAttrib1f ctx a b++vertexAttrib1fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib1fv a b = GL get >>= \ctx -> liftIO $ glVertexAttrib1fv ctx a b++vertexAttrib2f :: GLES => GLUInt -> Float -> Float -> GL ()+vertexAttrib2f a b c = GL get >>= \ctx -> liftIO $ glVertexAttrib2f ctx a b c++vertexAttrib2fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib2fv a b = GL get >>= \ctx -> liftIO $ glVertexAttrib2fv ctx a b++vertexAttrib3f :: GLES => GLUInt -> Float -> Float -> Float -> GL ()+vertexAttrib3f a b c d = GL get >>= \ctx -> liftIO $ glVertexAttrib3f ctx a b c d++vertexAttrib3fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib3fv a b = GL get >>= \ctx -> liftIO $ glVertexAttrib3fv ctx a b++vertexAttrib4f :: GLES => GLUInt -> Float -> Float -> Float -> Float -> GL ()+vertexAttrib4f a b c d e = GL get >>= \ctx -> liftIO $ glVertexAttrib4f ctx a b c d e++vertexAttrib4fv :: GLES => GLUInt -> Float32Array -> GL ()+vertexAttrib4fv a b = GL get >>= \ctx -> liftIO $ glVertexAttrib4fv ctx a b++vertexAttribPointer :: GLES => GLUInt -> GLInt -> GLEnum -> GLBool -> GLSize -> GLPtr -> GL ()+vertexAttribPointer a b c d e f = GL get >>= \ctx -> liftIO $ glVertexAttribPointer ctx a b c d e f++viewport :: GLES => GLInt -> GLInt -> GLSize -> GLSize -> GL ()+viewport a b c d = GL get >>= \ctx -> liftIO $ glViewport ctx a b c d
+ FWGL/Internal/Resource.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,+             FunctionalDependencies #-}++module FWGL.Internal.Resource (+        ResMap,+        ResStatus(..),+        Resource(..),+        newResMap,+        addResource,+        getResource,+        removeResource+) where++import Control.Applicative+import Control.Monad.IO.Class+import Data.IORef+import Data.Functor+import qualified Data.HashMap.Strict as H+import Data.Hashable++data ResMap i r = forall m. Resource i r m =>+                            ResMap (H.HashMap i (IORef (ResStatus r)))++data ResStatus r = Loaded r | Unloaded | Loading | Error String++class (Hashable i, Eq i, Applicative m, MonadIO m) =>+      Resource i r m | i -> r m where+        loadResource :: i -> (Either String r -> m ()) -> m ()+        unloadResource :: i -> r -> m ()++newResMap :: Resource i r m => ResMap i r+newResMap = ResMap H.empty++addResource :: Resource i r m => i -> ResMap i r -> m (ResMap i r)+addResource i m = snd <$> getResource i m++checkResource :: Resource i r m => i -> ResMap i r -> m (ResStatus r)+checkResource i (ResMap map) = case H.lookup i map of+                                        Just ref -> liftIO $ readIORef ref+                                        Nothing -> return $ Unloaded++getResource :: Resource i r m => i -> ResMap i r -> m (ResStatus r, ResMap i r)+getResource i rmap@(ResMap map) =+        do status <- checkResource i rmap+           case status of+                   Unloaded ->+                        do ref <- liftIO $ newIORef Loading+                           loadResource i $ \e -> case e of+                                 Left s -> liftIO . writeIORef ref $ Error s+                                 Right r -> liftIO . writeIORef ref $ Loaded r+                           status' <- liftIO $ readIORef ref+                           return (status', ResMap $ H.insert i ref map)+                   _ -> return (status, rmap)++removeResource :: Resource i r m => i -> ResMap i r -> m (ResMap i r)+removeResource i rmap@(ResMap map) = +        do status <- checkResource i rmap+           case status of+                Loaded r -> unloadResource i r+                Loading -> return () --- XXX+                _ -> return ()+           return . ResMap $ H.delete i map
+ FWGL/Internal/STVectorLen.hs view
@@ -0,0 +1,31 @@+module FWGL.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
+ FWGL/Internal/TList.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies,+             TypeOperators, UndecidableInstances, FlexibleContexts,+             FlexibleInstances, ConstraintKinds, PolyKinds #-}++module FWGL.Internal.TList where++class Subset (xs :: [*]) (ys :: [*])+instance Subset '[] ys+instance (Subset '[x] ys, Subset xs ys) => Subset (x ': xs) ys+-- BUG: Subset x x?++-- class Equal (xs :: [*]) (ys :: [*])+-- instance (Subset xs ys, Subset ys xs) => Equal xs ys+type Equal xs ys = (Subset xs ys, Subset ys xs)++type Member x xs = Subset '[x] xs++type NotMember x xs = IsMember x xs ~ False++type family IsMember x (xs :: [*]) :: Bool where+        IsMember x '[] = False+        IsMember x (x ': xs) = True+        IsMember y (x ': xs) = IsMember y xs++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 family Union (xs :: [*]) (ys :: [*]) where+        Union '[] ys = ys+        Union (x ': xs) ys = Union xs (Insert x ys)++type family TypeEq (x :: k) (y :: k) :: Bool where+        TypeEq x x = True+        TypeEq x y = False
+ FWGL/Key.hs view
@@ -0,0 +1,103 @@+module FWGL.Key where++-- | A mouse button.+data MouseButton = MouseLeft | MouseMiddle | MouseRight deriving (Eq, Show)++-- | A keyboard key.+data Key =+          KeyA+        | KeyB+        | KeyC+        | KeyD+        | KeyE+        | KeyF+        | KeyG+        | KeyH+        | KeyI+        | KeyJ+        | KeyK+        | KeyL+        | KeyM+        | KeyN+        | KeyO+        | KeyP+        | KeyQ+        | KeyR+        | KeyS+        | KeyT+        | KeyU+        | KeyV+        | KeyW+        | KeyX+        | KeyY+        | KeyZ+        | Key0+        | Key1+        | Key2+        | Key3+        | Key4+        | Key5+        | Key6+        | Key7+        | Key8+        | Key9+	| KeySpace+	| KeyEnter+	| KeyTab+	| KeyEsc+	| KeyBackspace+	| KeyShift+	| KeyControl+	| KeyAlt+	| KeyCapsLock+	| KeyNumLock+	| KeyArrowLeft+	| KeyArrowUp+	| KeyArrowRight+	| KeyArrowDown+	| KeyIns+	| KeyDel+	| KeyHome+	| KeyEnd+	| KeyPgUp+	| KeyPgDown+	| KeyF1+	| KeyF2+	| KeyF3+	| KeyF4+	| KeyF5+	| KeyF6+	| KeyF7+	| KeyF8+	| KeyF9+	| KeyF10+	| KeyF11+	| KeyF12+	| KeyPadDel+	| KeyPadIns+	| KeyPadEnd+	| KeyPadDown+	| KeyPadPgDown+	| KeyPadLeft+	| KeyPadRight+	| KeyPadHome+	| KeyPadUp+	| KeyPadPgUp+	| KeyPadAdd+	| KeyPadSub+	| KeyPadMul+	| KeyPadDiv+	| KeyPadEnter+	| KeyPadDot+	| KeyPad0+	| KeyPad1+	| KeyPad2+	| KeyPad3+	| KeyPad4+	| KeyPad5+	| KeyPad6+	| KeyPad7+	| KeyPad8+	| KeyPad9+        | KeyUnknown+        deriving (Eq, Show)
+ FWGL/Shader.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module FWGL.Shader (+        Shader,+        VertexShader,+        FragmentShader,+        Typeable,+        AllTypeable,+        ShaderType,+        UniformCPU,+        AttributeCPU,+        Float,+        Sampler2D,+        V2(..),+        V3(..),+        V4(..),+        M2(..),+        M3(..),+        M4(..),+        CFloat,+        CSampler2D,+        CV2,+        CV3,+        CV4,+        CM2,+        CM3,+        CM4,+        negate,+        fromInteger,+        fromRational,+        (*),+        (/),+        (+),+        (-),+        (^),+        (&&),+        (||),+        (==),+        (>=),+        (<=),+        (<),+        (>),+        abs,+        sign,+        sqrt,+        texture2D,+        (>>=),+        (>>),+        fail,+        return,+        get,+        global,+        put,+        putVertex,+        putFragment,+        (.),+        id,+        const,+        flip,+        ($)+) where++import Data.Typeable (Typeable)+import qualified FWGL.Internal.GL as CPU+import FWGL.Shader.CPU (UniformCPU, AttributeCPU)+import FWGL.Shader.Language+import FWGL.Shader.Monad hiding (Shader)+import FWGL.Shader.Stages+import qualified FWGL.Vector as CPU+import Prelude ((.), id, const, flip, ($))+import qualified Prelude as CPU++type Shader g i o a = PartialShader g i o a++type CFloat = CPU.Float+type CSampler2D = CPU.ActiveTexture+type CV2 = CPU.V2+type CV3 = CPU.V3+type CV4 = CPU.V4+type CM2 = CPU.M2+type CM3 = CPU.M3+type CM4 = CPU.M4
+ FWGL/Shader/CPU.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}++-- FWGL.Shader.Variables? (+ loadUniform, loadAttribute, inputName, etc.)+module FWGL.Shader.CPU where++import Data.Word (Word)+import Data.Typeable+import qualified FWGL.Shader.Language as GPU+import FWGL.Internal.GL as CPU+import qualified FWGL.Vector as CPU+import Prelude as CPU++class Typeable g => UniformCPU c g | g -> c where+        setUniform :: UniformLocation -> g -> c -> GL ()++class Typeable g => AttributeCPU c g | g -> c where+        encodeAttribute :: g -> [c] -> GL Array+        setAttribute :: g -> GLUInt -> GL ()++instance GLES => UniformCPU CPU.Float GPU.Float where+        setUniform l _ v = uniform1f l v++instance GLES => AttributeCPU CPU.Float GPU.Float where+        encodeAttribute _ a = liftIO $ encodeFloats a+        setAttribute _ i = attr i 1++-- TODO+instance GLES => UniformCPU CPU.ActiveTexture GPU.Sampler2D where+        setUniform l _ (CPU.ActiveTexture v) = uniform1i l $ fromIntegral v++instance GLES => UniformCPU CPU.V2 GPU.V2 where+        setUniform l _ (CPU.V2 x y) = uniform2f l x y++instance GLES => AttributeCPU CPU.V2 GPU.V2 where+        encodeAttribute _ a = liftIO $ encodeV2s a+        setAttribute _ i = attr i 2++instance GLES => UniformCPU CPU.V3 GPU.V3 where+        setUniform l _ (CPU.V3 x y z) = uniform3f l x y z++instance GLES => AttributeCPU CPU.V3 GPU.V3 where+        encodeAttribute _ a = liftIO $ encodeV3s a+        setAttribute _ i = attr i 3++instance GLES => UniformCPU CPU.V4 GPU.V4 where+        setUniform l _ (CPU.V4 x y z w) = uniform4f l x y z w++instance GLES => AttributeCPU CPU.V4 GPU.V4 where+        encodeAttribute _ a = liftIO $ encodeV4s a+        setAttribute _ i = attr i 4++instance GLES => UniformCPU CPU.M2 GPU.M2 where+        setUniform l _ m = liftIO (encodeM2 m) >>= uniformMatrix2fv l false++instance GLES => UniformCPU CPU.M3 GPU.M3 where+        setUniform l _ m = liftIO (encodeM3 m) >>= uniformMatrix3fv l false++instance GLES => UniformCPU CPU.M4 GPU.M4 where+        setUniform l _ m = liftIO (encodeM4 m) >>= uniformMatrix4fv l false++attr :: GLES => GLUInt -> GLInt -> GL ()+attr i s = vertexAttribPointer i s gl_FLOAT false 0 nullGLPtr
+ FWGL/Shader/Default2D.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DataKinds,+             FlexibleContexts, RebindableSyntax, TypeFamilies #-}++module FWGL.Shader.Default2D where++import FWGL.Shader++type Uniforms = '[View2, Image, Depth, Transform2]+type Attributes = '[Position2, UV]++-- | An uniform that represents the texture used in the default 2D shader.+newtype Image = Image Sampler2D+        deriving (Typeable, ShaderType, UniformCPU CSampler2D)++-- | An uniform that represents the depth used in the default 2D shader.+newtype Depth = Depth Float+        deriving (Typeable, ShaderType, UniformCPU CFloat)++-- | An uniform that represents the transformation matrix used in the default+-- 2D shader.+newtype Transform2 = Transform2 M3+        deriving (Typeable, ShaderType, UniformCPU CM3)++-- | An uniform that represents the view matrix used in the default 2D shader.+newtype View2 = View2 M3+        deriving (Typeable, ShaderType, UniformCPU CM3)++newtype Position2 = Position2 V2+        deriving (Typeable, ShaderType, AttributeCPU CV2)++newtype UV = UV V2+        deriving (Typeable, ShaderType, AttributeCPU CV2)++vertexShader :: VertexShader '[Transform2, View2, Depth]+                             '[Position2, UV] '[UV]+vertexShader = do (Position2 (V2 x y)) <- get+                  uv@(UV _) <- get+                  Transform2 trans <- global+                  View2 view <- global+                  Depth z <- global+                  let V3 x' y' _ = view * trans * (V3 x y 1)+                  putVertex $ V4 x' y' z 1+                  put uv+                  -- BUG++fragmentShader :: FragmentShader '[Image] '[UV]+fragmentShader = do Image sampler <- global+                    UV (V2 s t) <- get+                    putFragment $ texture2D sampler (V2 s $ 1 - t)
+ FWGL/Shader/Default3D.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DataKinds,+             FlexibleContexts, RebindableSyntax, TypeFamilies #-}++module FWGL.Shader.Default3D where++import FWGL.Shader.CPU+import FWGL.Shader+import qualified FWGL.Vector++type Uniforms = '[Transform3, View3, Texture2]+type Attributes = '[Position3, UV, Normal3]++newtype Texture2 = Texture2 Sampler2D+        deriving (Typeable, ShaderType, UniformCPU CSampler2D)++newtype Transform3 = Transform3 M4+        deriving (Typeable, ShaderType, UniformCPU CM4)++newtype View3 = View3 M4+        deriving (Typeable, ShaderType, UniformCPU CM4)++newtype Position3 = Position3 V3+        deriving (Typeable, ShaderType, AttributeCPU CV3)++newtype Normal3 = Normal3 V3+        deriving (Typeable, ShaderType, AttributeCPU CV3)++newtype UV = UV V2+        deriving (Typeable, ShaderType, AttributeCPU CV2)++vertexShader :: VertexShader '[ Transform3, View3 ]+                             '[ Position3, UV, Normal3 ]+                             '[ UV ]+vertexShader = do v <- applyMatrices+                  get >>= \x@(UV _) -> put x+                  (Normal3 _) <- get+                  putVertex v++applyMatrices :: Shader '[ Transform3, View3 ]+                        '[ Position3 ]+                        '[]+                        V4+applyMatrices = do View3 viewMatrix <- global+                   Transform3 modelMatrix <- global+                   Position3 (V3 x y z) <- get+                   return $+                        viewMatrix * modelMatrix * V4 x y z 1.0++fragmentShader :: FragmentShader '[ Texture2 ] [ UV, Normal3 ]+fragmentShader = do Texture2 sampler <- global+                    UV (V2 s t) <- get+                    putFragment .+                            texture2D sampler $ V2 s (1 - t)
+ FWGL/Shader/GLSL.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts #-}++module FWGL.Shader.GLSL (+        vertexToGLSLAttr,+        vertexToGLSL,+        fragmentToGLSL,+        shaderToGLSL,+        exprToGLSL,+        globalName,+        attributeName+) where++import Data.Typeable+import FWGL.Shader.Monad (Shader(..))+import FWGL.Shader.Language (Expr(..), ShaderType(..))+import FWGL.Shader.Stages (VertexShader, FragmentShader)++type ShaderVars = ( [(String, String)]+                  , [(String, String, Int)]+                  , [(String, String, Expr)])++vertexToGLSLAttr :: VertexShader g i o -> (String, [(String, Int)])+vertexToGLSLAttr v =+        let r@(_, is, _) = snd $ reduce False v+        in ( shaderToGLSL "" "attribute" "varying"+                          r [("hvVertexShaderOutput", "gl_Position")]+           , map (\(t, n, s) -> (n, s)) is)++vertexToGLSL :: VertexShader g i o -> String+vertexToGLSL = fst . vertexToGLSLAttr++fragmentToGLSL :: FragmentShader g i -> String+fragmentToGLSL v = shaderToGLSL "precision mediump float;"+                                "varying" ""+                                (snd $ reduce True v)+                                [("hvFragmentShaderOutput", "gl_FragColor")]++shaderToGLSL :: String -> String -> String -> ShaderVars -> [(String, String)] -> String+shaderToGLSL header ins outs (gs, is, os) predec =+        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(){" +++        concatMap (\(_, n, e) -> replace n predec ++ "=" +++                                 exprToGLSL e ++ ";") os ++ "}"+        where var qual (ty, nm) = qual ++ " " ++ ty ++ " " ++ nm ++ ";"+              replace x xs = case filter ((== x) . fst) xs of+                                        ((_, y) : []) -> y+                                        _ -> x++reduce :: Bool -> Shader g i o a -> (a, ShaderVars)+reduce _ (Pure x) = (x, ([], [], []))+reduce b (Bind s f) = case reduce b s of+                        (x, (gs, is, os)) -> case reduce b $ f x of+                                (y, (gs', is', os')) ->+                                        (y, (gs ++ gs', is ++ is', os ++ os'))+reduce _ (Global :: Shader g i o a) = (fromExpr $ Read nm, ([(ty, nm)], [], []))+        where (ty, nm) = globalTypeAndName (undefined :: a)+reduce isFragment (Get :: Shader g i o a) =+        (fromExpr $ Read nm, ([], [(ty, nm, size (undefined :: a))], []))+        where (ty, nm) = (if isFragment+                                then varyingTypeAndName+                                else attributeTypeAndName) (undefined :: a)+reduce _ (Put x) = ((), ([], [], [(ty, nm, toExpr x)]))+        where (ty, nm) = varyingTypeAndName x++exprToGLSL :: Expr -> String+exprToGLSL Nil = ""+exprToGLSL (Read s) = s+exprToGLSL (Op1 s e) = "(" ++ s ++ exprToGLSL e ++ ")"+exprToGLSL (Op2 s x y) = "(" ++ exprToGLSL x ++ s ++ exprToGLSL y ++ ")"+exprToGLSL (Apply s es) = s ++ "(" ++ tail (es >>= (',' :) . exprToGLSL) ++ ")"+exprToGLSL (X x) = exprToGLSL x ++ ".x"+exprToGLSL (Y x) = exprToGLSL x ++ ".y"+exprToGLSL (Z x) = exprToGLSL x ++ ".z"+exprToGLSL (W x) = exprToGLSL x ++ ".w"+exprToGLSL (Literal s) = s++globalTypeAndName :: (Typeable t, ShaderType t) => t -> (String, String)+globalTypeAndName t = (typeName t, globalName t)++varyingTypeAndName :: (Typeable t, ShaderType t) => t -> (String, String)+varyingTypeAndName t = (typeName t, varyingName t)++attributeTypeAndName :: (Typeable t, ShaderType t) => t -> (String, String)+attributeTypeAndName t = (typeName t, attributeName t)++variableName :: Typeable t => t -> String+variableName = tyConName . typeRepTyCon . typeOf++globalName :: Typeable t => t -> String+globalName = ("hg" ++) . variableName++varyingName :: Typeable t => t -> String+varyingName = ("hv" ++) . variableName++attributeName :: Typeable t => t -> String+attributeName = ("ha" ++) . variableName
+ FWGL/Shader/Language.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, FunctionalDependencies #-}++module FWGL.Shader.Language (+        ShaderType(..),+        Expr(..),+        Float(..),+        Sampler2D(..),+        V2(..),+        V3(..),+        V4(..),+        M2(..),+        M3(..),+        M4(..),+        -- (==), (>=, >, ..), ifThenElse+        fromRational,+        fromInteger,+        negate,+        (*),+        (/),+        (+),+        (-),+        (^),+        (&&),+        (||),+        (==),+        (>=),+        (<=),+        (<),+        (>),+        abs,+        sign,+        texture2D,+        sqrt,+) where++import Data.Typeable+import Prelude (String, (.), ($))+import qualified Prelude+import Text.Printf++data Expr = Nil | Read String | Op1 String Expr | Op2 String Expr Expr+          | Apply String [Expr] | X Expr | Y Expr | Z Expr | W Expr+          | Literal String deriving (Prelude.Eq)++newtype Bool = Bool Expr deriving Typeable+newtype Float = Float Expr deriving Typeable+newtype Sampler2D = Sampler2D Expr deriving Typeable+-- | NB: These are different types from 'FWGL.Vector.V2', 'FWGL.Vector.V3', etc.+data V2 = V2 Float Float deriving (Typeable)+data V3 = V3 Float Float Float deriving (Typeable)+data V4 = V4 Float Float Float Float deriving (Typeable)+data M2 = M2 V2 V2 deriving (Typeable)+data M3 = M3 V3 V3 V3 deriving (Typeable)+data M4 = M4 V4 V4 V4 V4 deriving (Typeable)++infix 4 =!+(=!) :: Prelude.Eq a => a -> a -> Prelude.Bool+(=!) = (Prelude.==)++infixr 3 &&!+(&&!) :: Prelude.Bool -> Prelude.Bool -> Prelude.Bool+(&&!) = (Prelude.&&)++class ShaderType t where+        toExpr :: t -> Expr++        fromExpr :: Expr -> t++        typeName :: t -> String++        size :: t -> Prelude.Int++instance ShaderType Bool where+        toExpr (Bool e) = e++        fromExpr = Bool++        typeName _ = "bool"++        size _ = 1++instance ShaderType Float where+        toExpr (Float e) = e++        fromExpr = Float++        typeName _ = "float"++        size _ = 1++instance ShaderType Sampler2D where+        toExpr (Sampler2D e) = e++        fromExpr = Sampler2D++        typeName _ = "sampler2D"++        size _ = 1++instance ShaderType V2 where+        toExpr (V2 (Float (X v)) (Float (Y v'))) | v =! v' = v+        toExpr (V2 (Float x) (Float y)) = Apply "vec2" [x, y]++        fromExpr v = V2 (Float (X v)) (Float (Y v))++        typeName _ = "vec2"++        size _ = 1++instance ShaderType V3 where+        toExpr (V3 (Float (X v)) (Float (Y v')) (Float (Z v'')))+               | v =! v' &&! v' =! v'' = v+        toExpr (V3 (Float x) (Float y) (Float z)) = Apply "vec3" [x, y, z]++        fromExpr v = V3 (Float (X v)) (Float (Y v)) (Float (Z v))++        typeName _ = "vec3"++        size _ = 1++instance ShaderType V4 where+        toExpr (V4 (Float (X v)) (Float (Y v1)) (Float (Z v2)) (Float (W v3)))+               | v =! v1 &&! v1 =! v2 &&! v2 =! v3 = v+        toExpr (V4 (Float x) (Float y) (Float z) (Float w)) =+                Apply "vec4" [x, y, z, w]++        fromExpr v = V4 (Float (X v)) (Float (Y v)) (Float (Z v)) (Float (W v))++        typeName _ = "vec4"++        size _ = 1++instance ShaderType M2 where+        toExpr (M2 (V2 (Float (X (X m))) (Float (X (Y m1))))+                   (V2 (Float (Y (X m2))) (Float (Y (Y m3)))))+               | m =! m1 &&! m1 =! m2 &&! m2 =! m3 = m+        toExpr (M2 (V2 (Float xx) (Float xy))+                   (V2 (Float yx) (Float yy)))+               = Apply "mat2" [xx, yx, xy, yy]++        fromExpr m = M2 (V2 (Float (X (X m))) (Float (Y (X m))))+                        (V2 (Float (Y (X m))) (Float (Y (Y m))))++        typeName _ = "mat2"++        size _ = 2++instance ShaderType M3 where+        toExpr (M3 (V3 (Float (X (X m)))+                       (Float (X (Y m1)))+                       (Float (X (Z m2))))+                   (V3 (Float (Y (X m3)))+                       (Float (Y (Y m4)))+                       (Float (Y (Z m5))))+                   (V3 (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 = m+        toExpr (M3 (V3 (Float xx) (Float xy) (Float xz))+                   (V3 (Float yx) (Float yy) (Float yz))+                   (V3 (Float zx) (Float zy) (Float zz)))+               = Apply "mat3" [xx, yx, zx, xy, yy, zy, xz, yz, zz]++        fromExpr m = M3 (V3 (Float (X (X m)))+                            (Float (X (Y m)))+                            (Float (X (Z m))))+                        (V3 (Float (Y (X m)))+                            (Float (Y (Y m)))+                            (Float (Y (Z m))))+                        (V3 (Float (Z (X m)))+                            (Float (Z (Y m)))+                            (Float (Z (Z m))))++        typeName _ = "mat3"++        size _ = 3++instance ShaderType M4 where+        toExpr (M4 (V4 (Float (X (X m)))+                       (Float (X (Y m1)))+                       (Float (X (Z m2)))+                       (Float (X (W m3))))+                   (V4 (Float (Y (X m4)))+                       (Float (Y (Y m5)))+                       (Float (Y (Z m6)))+                       (Float (Y (W m7))))+                   (V4 (Float (Z (X m8)))+                       (Float (Z (Y m9)))+                       (Float (Z (Z m10)))+                       (Float (Z (W m11))))+                   (V4 (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 = m+        toExpr (M4 (V4 (Float xx) (Float xy) (Float xz) (Float xw))+                   (V4 (Float yx) (Float yy) (Float yz) (Float yw))+                   (V4 (Float zx) (Float zy) (Float zz) (Float zw))+                   (V4 (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 = M4 (V4 (Float (X (X m)))+                            (Float (X (Y m)))+                            (Float (X (Z m)))+                            (Float (X (W m))))+                        (V4 (Float (Y (X m)))+                            (Float (Y (Y m)))+                            (Float (Y (Z m)))+                            (Float (Y (W m))))+                        (V4 (Float (Z (X m)))+                            (Float (Z (Y m)))+                            (Float (Z (Z m)))+                            (Float (Z (W m))))+                        (V4 (Float (W (X m)))+                            (Float (W (Y m)))+                            (Float (W (Z m)))+                            (Float (W (W m))))++        typeName _ = "mat4"++        size _ = 4++class Vector a+instance Vector V2+instance Vector V3+instance Vector V4++class Matrix a+instance Matrix M2+instance Matrix M3+instance Matrix M4++class Mul a b c | a b -> c+instance Mul Float Float Float+instance Mul V2 V2 V2+instance Mul V3 V3 V3+instance Mul V4 V4 V4+instance Mul V2 Float V2+instance Mul V3 Float V3+instance Mul V4 Float V4+instance Mul Float V2 V2+instance Mul Float V3 V3+instance Mul Float V4 V4+instance Mul M2 M2 M2+instance Mul M3 M3 M3+instance Mul M4 M4 M4+instance Mul M2 Float M2+instance Mul M3 Float M3+instance Mul M4 Float M4+instance Mul Float M2 M2+instance Mul Float M3 M3+instance Mul Float M4 M4+instance Mul M2 V2 V2+instance Mul M3 V3 V3+instance Mul M4 V4 V4+instance Mul V2 M2 V2+instance Mul V3 M3 V3+instance Mul V4 M4 V4++infixl 7 *+(*) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c+x * y = fromExpr $ Op2 "*" (toExpr x) (toExpr y)++infixl 7 /+(/) :: (Mul a b c, ShaderType a, ShaderType b, ShaderType c) => a -> b -> c+x / y = fromExpr $ Op2 "/" (toExpr x) (toExpr y)++class Sum a+instance Sum Float+instance Sum V2+instance Sum V3+instance Sum V4+instance Sum M2+instance Sum M3+instance Sum M4++infixl 6 ++(+) :: (Sum a, ShaderType a) => a -> a -> a+x + y = fromExpr $ Op2 "+" (toExpr x) (toExpr y)++infixl 6 -+(-) :: (Sum a, ShaderType a) => a -> a -> a+x - y = fromExpr $ Op2 "-" (toExpr x) (toExpr y)++infixr 8 ^+-- TODO: type-unsafe?+(^) :: (ShaderType a, ShaderType b) => a -> b -> a+x ^ y = fromExpr $ Apply "pow" [toExpr x, toExpr y]++infixr 3 &&+(&&) :: Bool -> Bool -> Bool+x && y = fromExpr $ Op2 "&&" (toExpr x) (toExpr y)++infixr 2 ||+(||) :: Bool -> Bool -> Bool+x || y = fromExpr $ Op2 "||" (toExpr x) (toExpr y)++infix 4 ==+(==) :: ShaderType a => a -> a -> Bool+x == y = fromExpr $ Op2 "==" (toExpr x) (toExpr y)++infix 4 /=+(/=) :: ShaderType a => a -> a -> Bool+x /= y = fromExpr $ Op2 "!=" (toExpr x) (toExpr y)++infix 4 >=+(>=) :: ShaderType a => a -> a -> Bool+x >= y = fromExpr $ Op2 ">=" (toExpr x) (toExpr y)++infix 4 <=+(<=) :: ShaderType a => a -> a -> Bool+x <= y = fromExpr $ Op2 "<=" (toExpr x) (toExpr y)++infix 4 <+(<) :: ShaderType a => a -> a -> Bool+x < y = fromExpr $ Op2 "<" (toExpr x) (toExpr y)++infix 4 >+(>) :: ShaderType a => a -> a -> Bool+x > y = fromExpr $ Op2 ">" (toExpr x) (toExpr y)++negate :: Float -> Float+negate (Float e) = Float $ Op1 "-" e++fromInteger :: Prelude.Integer -> Float -- Integer+fromInteger = fromRational . Prelude.fromIntegral++fromRational :: Prelude.Rational -> Float+fromRational = Float . Literal+                        . (printf "%f" :: Prelude.Float -> String)+                        . Prelude.fromRational++abs :: Float -> Float+abs (Float e) = Float $ Apply "abs" [e]++sign :: Float -> Float+sign (Float e) = Float $ Apply "sign" [e]++-- TODO: add functions, ifThenElse, etc.++sqrt :: Float -> Float+sqrt (Float e) = Float $ Apply "sqrt" [e]++texture2D :: Sampler2D -> V2 -> V4+texture2D (Sampler2D s) v = fromExpr $ Apply "texture2D" [s, toExpr v]
+ FWGL/Shader/Monad.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators,+             RankNTypes, FlexibleContexts #-}++module FWGL.Shader.Monad (+        Shader(..),+        PartialShader,+        Member,+        AllTypeable,+        Subset,+        Equal,+        Union,+        Insert,+        return,+        get,+        global,+        put,+        (>>),+        (>>=),+        fail+) where++import Data.Typeable+import FWGL.Internal.TList+import FWGL.Shader.Language (ShaderType)+import Prelude (String, error)++data Shader g i o a where+        Pure :: a -> Shader g i o a+        Bind :: Shader g' i' o' b+             -> (b -> Shader g'' i'' o'' a)+             -> Shader g i o a+        Get :: (Member a i, Typeable a, ShaderType a) => Shader g i o a+        Global :: (Member a g, Typeable a, ShaderType a) => Shader g i o a+        -- Put :: (Typeable a, ShaderType a) => a -> Shader g i (a ': o) ()+        Put :: (Member a o, Typeable a, ShaderType a) => a -> Shader g i o ()++type PartialShader g i o a =+        (Subset o o', Subset g g', Subset i i', Subset i' i)+        => Shader g' i' o' a++-- TODO: Shader è una monade e un funtore, non c'è bisogno di rebindare la+-- sintassi+return :: a -> Shader g i o a+return = Pure++get :: (Member a i, Typeable a, ShaderType a) => Shader g i o a+get = Get++global :: (Member a g, Typeable a, ShaderType a) => Shader g i o a+global = Global++put :: (Member a o, Typeable a, ShaderType a) => a -> Shader g i o ()+put = Put++fail :: String -> Shader g i o a+fail = error++(>>=) :: Shader g i o a -> (a -> Shader g i o b) -> Shader g i o b+(>>=) = Bind++(>>) :: Shader g i o a -> Shader g i o b -> Shader g i o b+x >> y = x >>= \_ -> y++class AllTypeable (xs :: [*])+instance AllTypeable '[]+instance (Typeable x, AllTypeable xs) => AllTypeable (x ': xs)
+ FWGL/Shader/Program.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE MultiParamTypeClasses, ExistentialQuantification,+             FunctionalDependencies, KindSignatures, DataKinds,+             RankNTypes, FlexibleInstances, ScopedTypeVariables,+             TypeOperators, ImpredicativeTypes, TypeSynonymInstances #-}++module FWGL.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 FWGL.Shader.Default2D as Default2D+import qualified FWGL.Shader.Default3D as Default3D+import FWGL.Shader.GLSL+import FWGL.Shader.Monad (Subset, Union, Insert)+import FWGL.Shader.Stages+import FWGL.Internal.GL hiding (Program)+import qualified FWGL.Internal.GL as GL+import FWGL.Internal.Resource+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 f = loadProgram i $ f . Right+        unloadResource _ (LoadedProgram p _ _) = deleteProgram p++castProgram :: Program gs is -> Program gs' is'+-- castProgram (Program v f h) = Program v f h+castProgram = unsafeCoerce++-- | Create a 'Program' from the shaders.+program :: (Subset gs' gs, Subset gs'' gs, Subset os' os)+        => VertexShader gs' is os -> FragmentShader gs'' os'+        -> Program gs is+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 -> (LoadedProgram -> GL ()) -> GL ()+loadProgram (Program (vss, attrs) fss h) = asyncGL $ 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
+ FWGL/Shader/Stages.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TypeOperators, DataKinds, GeneralizedNewtypeDeriving,+             DeriveDataTypeable, RankNTypes, FlexibleContexts #-}++module FWGL.Shader.Stages (+        VertexShader,+        FragmentShader,+        putVertex,+        putFragment+) where++import Data.Typeable++import FWGL.Shader.Language+import FWGL.Shader.Monad++type VertexShader g i o = Shader g i (VertexShaderOutput ': o) ()+type FragmentShader g i = Shader g i (FragmentShaderOutput ': '[]) ()++newtype VertexShaderOutput = VSO V4 deriving (Typeable, ShaderType)+newtype FragmentShaderOutput = FSO V4 deriving (Typeable, ShaderType)++putVertex :: Member VertexShaderOutput o => V4 -> Shader g i o ()+-- putVertex :: V4 -> Shader '[] '[] (VertexShaderOutput ': '[]) ()+putVertex = put . VSO++putFragment :: Member FragmentShaderOutput o => V4 -> Shader g i o ()+-- putFragment :: V4 -> Shader '[] '[] (FragmentShaderOutput ': '[]) ()+putFragment = put . FSO
+ FWGL/Texture.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module FWGL.Texture (+        Texture(..),+        LoadedTexture(..),+        mkTexture,+        textureURL,+        textureFile,+        textureHash+) where++import Data.Hashable++import FWGL.Backend.GLES (GLES)+import FWGL.Backend.IO+import FWGL.Graphics.Color+import FWGL.Internal.GL hiding (Texture)+import qualified FWGL.Internal.GL as GL+import FWGL.Internal.Resource++-- | A texture.+data Texture = TexturePixels [Color] GLSize GLSize Int+             | TextureURL String Int++data LoadedTexture = LoadedTexture GLSize GLSize GL.Texture++-- | Creates a 'Texture' from a list of pixels.+mkTexture :: GLES+          => Int      -- ^ Width.+          -> Int      -- ^ Height.+          -> [Color]  -- ^ List of pixels+          -> Texture+mkTexture w h ps = TexturePixels ps (fromIntegral w) (fromIntegral h) $ hash ps++-- | Creates a 'Texture' from an URL (JavaScript only).+textureURL :: String  -- ^ URL+           -> Texture+textureURL url = TextureURL url $ hash url++-- | Creates a 'Texture' from a file (Desktop only).+textureFile :: String -> Texture+textureFile = textureURL++textureHash :: Texture -> Int+textureHash (TexturePixels _ _ _ h) = h+textureHash (TextureURL _ h) = h++instance Hashable Texture where+        hashWithSalt salt tex = hashWithSalt salt $ textureHash tex++instance Eq Texture where+        (TexturePixels _ _ _ h) == (TexturePixels _ _ _ h') = h == h'+        (TextureURL _ h) == (TextureURL _ h') = h == h'+        _ == _ = False++instance (BackendIO, GLES) => Resource Texture LoadedTexture GL where+        loadResource i f = loadTexture i $ f . Right -- TODO: err check+        unloadResource _ (LoadedTexture _ _ t) = deleteTexture t++loadTexture :: (BackendIO, GLES) => Texture -> (LoadedTexture -> GL ()) -> GL ()+loadTexture tex f =+        case tex of+                (TexturePixels ps w h _) -> flip asyncGL f $+                        do t <- setup+                           arr <- liftIO $ encodeColors ps+                           texImage2DBuffer gl_TEXTURE_2D 0+                                            (fromIntegral gl_RGBA)+                                            w h 0+                                            gl_RGBA+                                            gl_UNSIGNED_BYTE+                                            arr+                           return $ LoadedTexture (fromIntegral w)+                                                  (fromIntegral h)+                                                  t+                (TextureURL url _) ->+                        do ctx <- getCtx+                           liftIO $ loadImage url $ \(img, w, h) ->+                                flip evalGL ctx $ do+                                        t <- setup+                                        texImage2DImage gl_TEXTURE_2D 0+                                                        (fromIntegral gl_RGBA)+                                                        gl_RGBA+                                                        gl_UNSIGNED_BYTE+                                                        img+                                        f $ LoadedTexture (fromIntegral w)+                                                          (fromIntegral h)+                                                          t+        where setup = do                  -- XXX+                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+              param :: GLEnum -> GLEnum -> GL ()+              param p v = texParameteri gl_TEXTURE_2D p $ fromIntegral v+
+ FWGL/Utils.hs view
@@ -0,0 +1,55 @@+module FWGL.Utils (+        screenScale+) where++import FRP.Yampa+import FWGL.Input+import FWGL.Graphics.Custom++-- | Generate a view matrix that transforms the pixel coordinates in OpenGL+-- coordinates.+screenScale :: SF Input M3+screenScale = size >>^ \(x, y) -> scaleMat3 (V2 (1 / fromIntegral x)+                                                (1 / fromIntegral y))++-- | Like 'dynamic', but instead of comparing the two objects it checks the+-- event with the new object.+dynamicE :: Object g i -- ^ Initial 'Object'.+         -> SF (Event (Object g i)) (Object g i)+dynamicE = dynamicG $ flip const++-- | Automatically deallocate the previous mesh from the GPU when it changes.+dynamic :: SF (Object g i) (Object g i)+dynamic = undefined+{-+dynamic =+        dynamicG (\ o n -> if objectGeometry o == objectGeometry n+                                then Event n+                                else NoEvent+        ) nothing+-}++dynamicG :: (Object g i -> a -> Event (Object g i)) -> (Object g i) -> SF a (Object g i)+dynamicG = undefined+{-+dynamicG f i = flip sscan i $ \ oldObj inp ->+                case f oldObj inp of+                        Event (SolidObject (Solid (StaticGeom newG) mat tex)) ->+                                SolidObject (+                                        Solid (DynamicGeom (objectGeometry oldObj)+                                                           newG)+                                              mat+                                              tex+                                )+                        NoEvent -> case oldObj of+                                        SolidObject (+                                                Solid (DynamicGeom _ new) mat t+                                                ) -> SolidObject (+                                                        Solid (StaticGeom new)+                                                              mat+                                                              t+                                                        )+                                        _ -> oldObj+                        _ -> error "dynamicG: not a Geometry."+-}+
+ FWGL/Vector.hs view
@@ -0,0 +1,286 @@+module FWGL.Vector (+        V2(..),+        V3(..),+        V4(..),+        M2(..),+        M3(..),+        M4(..),+        vec2,+        vec3,+        vec4,+        mat2,+        mat3,+        mul3,+        mat4,+        mul4,+        transpose4,+        idMat4,+        transMat4,+        rotXMat4,+        rotYMat4,+        rotZMat4,+        rotAAMat4,+        scaleMat4,+        idMat3,+        transMat3,+        rotMat3,+        scaleMat3+) where++import Control.Applicative+import Data.Hashable+import Foreign.Storable+import Foreign.Ptr (castPtr)++-- | Two-dimensional vector.+data V2 = V2 !Float !Float deriving (Show, Eq)++-- | Three-dimensional vector.+data V3 = V3 !Float !Float !Float deriving (Show, Eq)++-- | Four-dimensional vector.+data V4 = V4 !Float !Float !Float !Float deriving (Show, Eq)++-- | 2x2 matrix.+data M2 = M2 !V2 !V2 deriving (Show, Eq)++-- | 3x3 matrix.+data M3 = M3 !V3 !V3 !V3 deriving (Show, Eq)++-- | 4x4 matrix.+data M4 = M4 !V4 !V4 !V4 !V4 deriving (Show, Eq)++instance Hashable V2 where+        hashWithSalt s (V2 x y) = hashWithSalt s (x, y)++instance Hashable V3 where+        hashWithSalt s (V3 x y z) = hashWithSalt s (x, y, z)++instance Hashable V4 where+        hashWithSalt s (V4 x y z w) = hashWithSalt s (x, y, z, w)++instance Storable V2 where+        sizeOf _ = 2 * sizeOf (undefined :: Float)+        alignment _ = alignment (undefined :: Float)+        peek ptr = V2 <$> peek (castPtr ptr)+                      <*> peekElemOff (castPtr ptr) 1+        poke ptr (V2 x y) = poke (castPtr ptr) x >> pokeElemOff (castPtr ptr) 1 y++instance Storable V3 where+        sizeOf _ = 3 * sizeOf (undefined :: Float)+        alignment _ = alignment (undefined :: Float)+        peek ptr = V3 <$> peek (castPtr ptr)+                      <*> peekElemOff (castPtr ptr) 1+                      <*> peekElemOff (castPtr ptr) 2+        poke ptr (V3 x y z) = zipWithM_ (pokeElemOff $ castPtr ptr)+                                        [0 .. 2] [x, y, z]+instance Storable V4 where+        sizeOf _ = 4 * sizeOf (undefined :: Float)+        alignment _ = alignment (undefined :: Float)+        peek ptr = V4 <$> peek (castPtr ptr) +                      <*> peekElemOff (castPtr ptr) 1+                      <*> peekElemOff (castPtr ptr) 2+                      <*> peekElemOff (castPtr ptr) 3+        poke ptr (V4 x y z w) = zipWithM_ (pokeElemOff $ castPtr ptr)+                                          [0 .. 3] [x, y, z, w]++-- | Create a two-dimensional vector.+vec2 :: (Float, Float) -> V2+vec2 = uncurry V2++-- | Create a three-dimensional vector.+vec3 :: (Float, Float, Float) -> V3+vec3 (x, y, z) = V3 x y z++-- | Create a four-dimensional vector.+vec4 :: (Float, Float, Float, Float) -> V4+vec4 (x, y, z, w) = V4 x y z w++-- | Create a 2x2 matrix.+mat2 :: ( Float, Float+        , Float, Float ) -> M2+mat2 (a, a', b, b') = M2 (V2 a a') (V2 b b')++-- | Create a 3x3 matrix.+mat3 :: ( Float, Float, Float+        , Float, Float, Float+        , Float, Float, Float ) -> M3+mat3 (a1, a2, a3, b1, b2, b3, c1, c2, c3) =+        M3 (V3 a1 a2 a3)+           (V3 b1 b2 b3)+           (V3 c1 c2 c3)++mat4from3 :: ( Float, Float, Float+             , Float, Float, Float+             , Float, Float, Float ) -> M4+mat4from3 (a1, a2, a3, b1, b2, b3, c1, c2, c3) =+        M4 (V4 a1 a2 a3 0)+           (V4 b1 b2 b3 0)+           (V4 c1 c2 c3 0)+           (V4 0  0  0  1)++mat3from2 :: (Float, Float, Float, Float) -> M3+mat3from2 (a1, a2, b1, b2) = M3 (V3 a1 a2 0)+                                (V3 b1 b2 0)+                                (V3 0  0  1)++-- | Create a 4x4 matrix.+mat4 :: ( Float, Float, Float, Float+        , Float, Float, Float, Float+        , Float, Float, Float, Float+        , Float, Float, Float, Float ) -> M4+mat4 (a1, a2, a3, a4, b1, b2, b3, b4, c1, c2, c3, c4, d1, d2, d3, d4) =+        M4 (V4 a1 a2 a3 a4)+           (V4 b1 b2 b3 b4)+           (V4 c1 c2 c3 c4)+           (V4 d1 d2 d3 d4)++-- | 3x3 matrix multiplication.+mul3 :: M3 -> M3 -> M3+mul3 (M3 (V3 a11 a12 a13)+         (V3 a21 a22 a23)+         (V3 a31 a32 a33))+     (M3 (V3 b11 b12 b13)+         (V3 b21 b22 b23)+         (V3 b31 b32 b33)) =+        mat3 (+                a11 * b11 + a12 * b21 + a13 * b31,+                a11 * b12 + a12 * b22 + a13 * b32,+                a11 * b13 + a12 * b23 + a13 * b33,++                a21 * b11 + a22 * b21 + a23 * b31,+                a21 * b12 + a22 * b22 + a23 * b32,+                a21 * b13 + a22 * b23 + a23 * b33,++                a31 * b11 + a32 * b21 + a33 * b31,+                a31 * b12 + a32 * b22 + a33 * b32,+                a31 * b13 + a32 * b23 + a33 * b33+             )+++-- | 4x4 matrix multiplication.+mul4 :: M4 -> M4 -> M4+mul4 (M4 (V4 _1 _2 _3 _4)+         (V4 _5 _6 _7 _8)+         (V4 _9 _a _b _c)+         (V4 _d _e _f _g))+     (M4 (V4 a b c d)+	 (V4 e f g h)+	 (V4 i j k l)+	 (V4 m n o p)) =+        mat4 (+                _1 * a + _2 * e + _3 * i + _4 * m,+                _1 * b + _2 * f + _3 * j + _4 * n,+                _1 * c + _2 * g + _3 * k + _4 * o,+                _1 * d + _2 * h + _3 * l + _4 * p,++                _5 * a + _6 * e + _7 * i + _8 * m,+                _5 * b + _6 * f + _7 * j + _8 * n,+                _5 * c + _6 * g + _7 * k + _8 * o,+                _5 * d + _6 * h + _7 * l + _8 * p,++                _9 * a + _a * e + _b * i + _c * m,+                _9 * b + _a * f + _b * j + _c * n,+                _9 * c + _a * g + _b * k + _c * o,+                _9 * d + _a * h + _b * l + _c * p,++                _d * a + _e * e + _f * i + _g * m,+                _d * b + _e * f + _f * j + _g * n,+                _d * c + _e * g + _f * k + _g * o,+                _d * d + _e * h + _f * l + _g * p+        )++-- | Transpose a 4x4 matrix.+transpose4 :: M4 -> M4+transpose4 (M4 (V4 a1 a2 a3 a4)+               (V4 b1 b2 b3 b4)+               (V4 c1 c2 c3 c4)+               (V4 d1 d2 d3 d4)) = M4 (V4 a1 b1 c1 d1)+                                      (V4 a2 b2 c2 d2)+                                      (V4 a3 b3 c3 d3)+                                      (V4 a4 b4 c4 d4)++-- | 4x4 identity matrix.+idMat4 :: M4+idMat4 = mat4from3 ( 1, 0, 0+                   , 0, 1, 0+                   , 0, 0, 1 )++-- | 4x4 translation matrix.+transMat4 :: V3 -> M4+transMat4 (V3 x y z) = mat4 ( 1, 0, 0, 0+                            , 0, 1, 0, 0+                            , 0, 0, 1, 0+                            , x, y, z, 1 )++-- | 4x4 rotation matrix (X axis).+rotXMat4 :: Float -> M4+rotXMat4 a = mat4from3 ( 1, 0, 0+                       , 0, cos a, - sin a+                       , 0, sin a, cos a )++-- | 4x4 rotation matrix (Y axis).+rotYMat4 :: Float -> M4+rotYMat4 a = mat4from3 ( cos a, 0, sin a+                       , 0, 1, 0+                       , - sin a, 0, cos a )++-- | 4x4 rotation matrix (Z axis).+rotZMat4 :: Float -> M4+rotZMat4 a = mat4from3 ( cos a, - sin a, 0+                       , sin a, cos a, 0+                       , 0, 0, 1 )++-- | 4x4 rotation matrix.+rotAAMat4 :: V3         -- ^ Axis.+          -> Float      -- ^ Angle+          -> M4+rotAAMat4 v = quatToMat4 . rotAAQuat v++-- | Rotation quaternion.+rotAAQuat :: V3 -> Float -> V4+rotAAQuat (V3 x y z) a = V4 (x * s) (y * s) (z * s) (cos $ a / 2)+        where s = sin $ a / 2++-- | 4x4 scale matrix.+scaleMat4 :: V3 -> M4+scaleMat4 (V3 x y z) = mat4from3 ( x, 0, 0+                                 , 0, y, 0+                                 , 0, 0, z )++-- | 4x4 perspective matrix.+perspectiveMat4 :: Float -> Float -> Float -> Float -> M4+perspectiveMat4 f n fov ar =+        mat4 ( s / ar , 0 , 0                 , 0+             , 0      , s , 0                 , 0+             , 0      , 0 , (f + n) / (n - f) , (2 * f * n) / (n - f)+             , 0      , 0 , - 1               , 0)+        where s = 1 / tan (fov * pi / 360)++-- | Quaternion to 4x4 matrix.+quatToMat4 :: V4 -> M4+quatToMat4 (V4 x y z w) = mat4from3 (+        1 - 2 * y ^ 2 - 2 * z ^ 2, 2 * x * y - 2 * z * w, 2 * x * z + 2 * y * w,+        2 * x * y + 2 * z * w, 1 - 2 * x ^ 2 - 2 * z ^ 2, 2 * y * z - 2 * x * w,+        2 * x * z - 2 * y * w, 2 * y * z + 2 * x * w, 1 - 2 * x ^ 2 - 2 * y ^ 2)++-- | The identity 3x3 matrix.+idMat3 :: M3+idMat3 = mat3from2 (1, 0, 0, 1)++-- | 3x3 translation matrix.+transMat3 :: V2 -> M3+transMat3 (V2 x y) = mat3 ( 1, 0, 0+                          , 0, 1, 0+                          , x, y, 1 )++-- | 3x3 rotation matrix.+rotMat3 :: Float -> M3+rotMat3 a = mat3from2 (cos a, sin a, - sin a, cos a)++-- | 3x3 scale matrix.+scaleMat3 :: V2 -> M3+scaleMat3 (V2 x y) = mat3from2 (x, 0, 0, y)++zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()+zipWithM_ f xs = sequence_ . zipWith f xs
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014-2015, 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 "ZioCrocifisso" 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fwgl.cabal view
@@ -0,0 +1,22 @@+name:                fwgl+version:             0.1.0.0+synopsis:            FRP 2D/3D game engine+description:         FRP 2D/3D game engine (work in progress)+homepage:            https://github.com/ZioCrocifisso/FWGL+license:             BSD3+license-file:        LICENSE+author:              Luca "ZioCrocifisso" Prezzavento+maintainer:          ziocroc@hotmail.it+category:            Game+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     FWGL, FWGL.Shader, FWGL.Geometry, FWGL.Utils, FWGL.Vector, FWGL.Texture, FWGL.Audio, FWGL.Key, FWGL.Backend, FWGL.Input, FWGL.Graphics.Draw, FWGL.Graphics.D2, FWGL.Graphics.Types, FWGL.Graphics.Color, FWGL.Graphics.Custom, FWGL.Graphics.Shapes, FWGL.Internal.GL, FWGL.Internal.TList, FWGL.Geometry.OBJ, FWGL.Shader.GLSL, FWGL.Shader.Stages, FWGL.Shader.Program, FWGL.Shader.CPU, FWGL.Shader.Default3D, FWGL.Shader.Monad, FWGL.Shader.Language, FWGL.Shader.Default2D, FWGL.Backend.JavaScript+  -- , FWGL.Backend.OpenGL.GL32, FWGL.Backend.OpenGL.Common, FWGL.Backend.OpenGL.GLES20, FWGL.Backend.GLFW.GL32, FWGL.Backend.GLFW.Common, FWGL.Backend.GLFW.GLES20, FWGL.Graphics.D3,+  other-modules:        FWGL.Internal.STVectorLen, FWGL.Internal.Resource, FWGL.Backend.JavaScript.WebGL, FWGL.Backend.JavaScript.Event, FWGL.Backend.JavaScript.WebGL.Const, FWGL.Backend.JavaScript.WebGL.Types, FWGL.Backend.JavaScript.WebGL.Raw, FWGL.Backend.GLES, FWGL.Backend.IO+  other-extensions:    FlexibleContexts, RankNTypes, GADTs, TypeOperators, KindSignatures, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, ConstraintKinds, TypeFamilies, ExistentialQuantification, GeneralizedNewtypeDeriving, PolyKinds, UndecidableInstances, ScopedTypeVariables, OverlappingInstances, FunctionalDependencies, DeriveDataTypeable, ImpredicativeTypes, RebindableSyntax, NullaryTypeClasses, Arrows+  build-depends:       base >=4.7 && <4.8, Yampa >=0.9 && <0.10, hashable >=1.2 && <1.3, unordered-containers >=0.2 && <0.3, vector >=0.10 && <0.11, transformers, ghcjs-base+  -- , gl >=0.6 && <0.7, JuicyPixels >=3.2 && <3.3, GLFW-b >=1.4 && <1.5, random >=1.1 && <1.2+  hs-source-dirs:      .+  default-language:    Haskell2010