on master help sign in
fixed the compiler and types for the new API cut. TODO Native fix
commitd288733d05f0bc1ec8a3a476fd63b138a40c960d authorJohn P Mayer Jr <john.p.mayer.jr@gmail.com> dateThu 20 Feb 2014, 23:32 (13 years ago) parent7b461c3
4 files changed+22−32
compiler/Generate/JavaScript.hs+1−1 compiler/Type/Constrain/Expression.hs+10−7 libraries/Graphics/WebGL.elm+3−15 tests/test-files/good/Box.elm+8−9
compiler/Generate/JavaScript.hs+1−1
@@ -176,7 +176,7 @@ expression (L span expr) =
176176 md = pad ++ MD.toHtml doc ++ pad
177177
178178 GLShader _uid src _tipe ->
179− return . literal $ Str src
179+ return $ ObjectLit () [(PropString () "src", literal (Str src))]
180180
181181 PortIn name tipe ->
182182 return $ obj "Native.Ports.portIn" `call` [ string name, Port.incoming tipe ]
compiler/Type/Constrain/Expression.hs+10−7
@@ -33,13 +33,16 @@ constrain env (L span expr) tipe =
3333 Literal lit -> liftIO $ Literal.constrain env span lit tipe
3434
3535 GLShader _uid _src gltipe ->
36− return . L span $ CEqual tipe (shaderTipe attribute uniform varying)
37− where
38− shaderTipe a u v = Env.get env Env.types "Graphics.WebGL.Shader" <| a <| u <| v
39− glTipe = Env.get env Env.types . Lit.glTipeName
40− attribute = record (Map.map (\t -> [glTipe t]) $ Lit.attribute gltipe) (TermN EmptyRecord1)
41− uniform = record (Map.map (\t -> [glTipe t]) $ Lit.uniform gltipe) (TermN EmptyRecord1)
42− varying = record (Map.map (\t -> [glTipe t]) $ Lit.varying gltipe) (TermN EmptyRecord1)
36+ exists $ \attr ->
37+ exists $ \unif ->
38+ let
39+ shaderTipe a u v = Env.get env Env.types "Graphics.WebGL.Shader" <| a <| u <| v
40+ glTipe = Env.get env Env.types . Lit.glTipeName
41+ makeRec accessor baseRec = record (Map.map (\t -> [glTipe t]) $ accessor gltipe) baseRec
42+ attribute = makeRec Lit.attribute attr
43+ uniform = makeRec Lit.uniform unif
44+ varying = makeRec Lit.varying (TermN EmptyRecord1)
45+ in return . L span $ CEqual tipe (shaderTipe attribute uniform varying)
4346
4447 Var name | name == saveEnvName -> return (L span CSaveEnv)
4548 | otherwise -> return (name <? tipe)
libraries/Graphics/WebGL.elm+3−15
@@ -5,32 +5,20 @@ module Graphics.WebGL (link, mapTriangle, zipTriangle, bind, encapsulate, webgl)
55import Graphics.Element (Element)
66import Native.Graphics.WebGL
77
8−data Shader a u v = Dummy_Shader
9−data Program a u = Dummy_Program
10−
11−link : Shader a u v -> Shader {} {} v -> Program a u
12−link = Native.Graphics.WebGL.link
13−
148type Triangle a = (a,a,a)
159
16−triangle : a -> a -> a -> Triangle a
17−triangle = (,,)
18−
1910mapTriangle : (a -> b) -> Triangle a -> Triangle b
2011mapTriangle f (x,y,z) = (f x, f y, f z)
2112
2213zipTriangle : (a -> b -> c) -> Triangle a -> Triangle b -> Triangle c
2314zipTriangle f (x,y,z) (x',y',z') = (f x x', f y y', f z z')
2415
25−data Buffer a = Dummy_Buffer
26−
27−bind : [Triangle a] -> Buffer a
28−bind = Native.Graphics.WebGL.bind
16+data Shader attr unif vary = Dummy_Shader
2917
3018data Model = Dummy_Model
3119
32−encapsulate : Program a u -> Buffer a -> u -> Model
33−encapsulate = Native.Graphics.WebGL.encapsulate
20+model : Shader attr unif vary -> Shader {} unif vary -> [Triangle attr] -> unif -> Model
21+model = Native.Graphics.WebGL.model
3422
3523webgl : (Int,Int) -> [Model] -> Element
3624webgl = Native.Graphics.WebGL.webgl
tests/test-files/good/Box.elm+8−9
@@ -2,7 +2,7 @@
22module Box where
33
44import MJS (V3,M4x4,v3,makeRotate,makePerspective,makeLookAt,mul)
5−import Graphics.WebGL (Program, link, Triangle, zipTriangle, Buffer, bind, Model, encapsulate, webgl)
5+import Graphics.WebGL (Triangle, zipTriangle, Shader, Model, model, webgl)
66import Window(dimensions)
77
88-- Define what our geometry looks like
@@ -39,6 +39,7 @@ colors = concat . map (\c -> repeat 2 (c,c,c)) <| [gray,red,green,blue,yellow,pu
3939mesh : [Triangle {pos : V3, color : V3}]
4040mesh = zipWith (zipTriangle (\pos color -> { pos = pos, color = color })) positions colors
4141
42+vert : Shader {a | pos : V3, color : V3} {b | rot : M4x4, per : M4x4, cam : M4x4} {vcolor : V3}
4243vert = [glShader|
4344attribute vec3 pos;
4445attribute vec3 color;
@@ -52,19 +53,16 @@ void main () {
5253}
5354|]
5455
56+frag : Shader {} {b | shade : Float} {vcolor : V3}
5557frag = [glShader|
5658precision mediump float;
59+uniform float shade;
5760varying vec3 vcolor;
5861void main () {
59− gl_FragColor = vec4(vcolor, 1.0);
62+ gl_FragColor = shade * vec4(vcolor, 1.0);
6063}
6164|]
6265
63−prog = link vert frag
64−
65−buf : Buffer {pos : V3, color : V3}
66−buf = bind mesh
67−
6866per : M4x4
6967per = makePerspective 45 1 0.01 100
7068
@@ -74,10 +72,11 @@ cam = makeLookAt (v3 0 0 5) (v3 0 0 0) (v3 0 1 0)
7472angle : Signal Float
7573angle = foldp (\_ n -> n + 0.02) 0 (fps 25)
7674
77−rot = (\t -> { rot = mul (makeRotate (3*t) (v3 0 1 0)) (makeRotate (2*t) (v3 1 0 0)), per = per, cam = cam }) <~ angle
75+rot : Signal { rot : M4x4, per : M4x4, cam : M4x4, shade : Float }
76+rot = (\t -> { rot = mul (makeRotate (3*t) (v3 0 1 0)) (makeRotate (2*t) (v3 1 0 0)), per = per, cam = cam, shade = 0.8 }) <~ angle
7877
7978draw : Signal [Model]
80−draw = combine [ (encapsulate prog buf) <~ rot ]
79+draw = combine [ (\rot -> (model vert frag mesh rot)) <~ rot ]
8180
8281main = webgl <~ dimensions ~ draw
8382