on master help sign in
paranoid save
c54cd59John P Mayer Jr
compiler/Generate/JavaScript.hs+6
@@ -1,3 +1,5 @@
1+{-# OPTIONS -Wall #-}
2+
1module Generate.JavaScript where
3module Generate.JavaScript where
2
4
3import Control.Arrow (first,(***))
5import Control.Arrow (first,(***))
@@ -195,6 +197,10 @@ expression (L span expr) =
195 pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
197 pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
196 md = pad ++ MD.toHtml doc ++ pad
198 md = pad ++ MD.toHtml doc ++ pad
197
199
200+ GLShader uid src ->
201+ return . literal $ Str src
202+
203+
198definition :: Def () () -> State Int [Statement ()]
204definition :: Def () () -> State Int [Statement ()]
199definition def =
205definition def =
200 case def of
206 case def of
compiler/Parse/Helpers.hs+12−3
@@ -329,10 +329,15 @@ glShader = try (string "[glShader|") >> closeShader "" where
329 ]
329 ]
330
330
331data GLTipe = V3 | M4
331data GLTipe = V3 | M4
332+
333+glTipeName :: GLTipe -> String
334+glTipeName V3 = "MJS.V3"
335+glTipeName M4 = "MJS.M4x4"
336+
332data GLShaderDecls = GLShaderDecls
337data GLShaderDecls = GLShaderDecls
333 { attribute :: Map String GLTipe
338 { attribute :: Map String GLTipe
334 , uniform :: Map String GLTipe
339 , uniform :: Map String GLTipe
335− , variying :: Map String GLTipe
340+ , varying :: Map String GLTipe
336 }
341 }
337
342
338--glSource :: String -> Maybe [(StorageQualifier, GLTipe, String)]
343--glSource :: String -> Maybe [(StorageQualifier, GLTipe, String)]
@@ -340,11 +345,15 @@ glSource :: String -> Maybe GLShaderDecls
340glSource src =
345glSource src =
341 case GLP.parse src of
346 case GLP.parse src of
342 Right (TranslationUnit decls) ->
347 Right (TranslationUnit decls) ->
343− Just . foldl addGLinput emptyDecls . join . map extractGLinputs $ decls
348+ Just . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls
344 Left e -> Nothing
349 Left e -> Nothing
345 where
350 where
346 emptyDecls = GLShaderDecls Map.empty Map.empty Map.empty
351 emptyDecls = GLShaderDecls Map.empty Map.empty Map.empty
347− addGLinput = error "TODO"
352+ addGLinput (qual,tipe,name) glDecls = case qual of
353+ Attribute -> glDecls { attribute = Map.insert name tipe $ attribute glDecls }
354+ Uniform -> glDecls { uniform = Map.insert name tipe $ uniform glDecls }
355+ Varying -> glDecls { varying = Map.insert name tipe $ varying glDecls }
356+ _ -> error "Should never happen due to below filter"
348 extractGLinputs decl = case decl of
357 extractGLinputs decl = case decl of
349 Declaration (InitDeclaration (TypeDeclarator (FullType (Just (TypeQualSto qual)) (TypeSpec _prec (TypeSpecNoPrecision tipe _mexpr1)))) [InitDecl name _mexpr2 _mexpr3]) ->
358 Declaration (InitDeclaration (TypeDeclarator (FullType (Just (TypeQualSto qual)) (TypeSpec _prec (TypeSpecNoPrecision tipe _mexpr1)))) [InitDecl name _mexpr2 _mexpr3]) ->
350 if elem qual [Attribute, Varying, Uniform]
359 if elem qual [Attribute, Varying, Uniform]
compiler/Type/Constrain/Expression.hs+15−7
@@ -13,7 +13,6 @@ import Control.Monad.Error
13import Control.Monad.State
13import Control.Monad.State
14import Data.Traversable (traverse)
14import Data.Traversable (traverse)
15import qualified Text.PrettyPrint as PP
15import qualified Text.PrettyPrint as PP
16−
17import qualified Parse.Helpers as PH
16import qualified Parse.Helpers as PH
18import SourceSyntax.Location as Loc
17import SourceSyntax.Location as Loc
19import SourceSyntax.Pattern (Pattern(PVar))
18import SourceSyntax.Pattern (Pattern(PVar))
@@ -39,12 +38,21 @@ constrain env (L span expr) tipe =
39 case expr of
38 case expr of
40 Literal lit -> liftIO $ Literal.constrain env span lit tipe
39 Literal lit -> liftIO $ Literal.constrain env span lit tipe
41
40
42− GLShader _ src ->
41+ GLShader _ src -> case declsRecord <$> PH.glSource src of
42+ Nothing -> throwError [PP.text "Some sort of GLSL parse error"]
43− return . L span $ CEqual tipe (glTipe sourceTipe) where
43+ Just sourceTipe -> return . L span $ CEqual tipe (shaderTipe sourceTipe)
44+ where
44− glTipe t = Env.get env Env.types "GLShader" <| t
45+ shaderTipe t = Env.get env Env.types "Graphics.WebGL.GLShader" <| t
45− sourceTipe = declsRecord $ PH.glSource src
46+ glTipe = Env.get env Env.types . PH.glTipeName
46− declsRecord :: Maybe PH.GLShaderDecls -> TermN Variable
47+ declsRecord :: PH.GLShaderDecls -> TermN Variable
47− declsRecord = error "TODO"
48+ declsRecord extractedTipes = record (fields' extractedTipes) (TermN EmptyRecord1)
49+ fields' :: PH.GLShaderDecls -> Map.Map String [Type]
50+ fields' extractedTipes = Map.fromList
51+ [ ("attribute", [record (Map.map (\t -> [glTipe t]) $ PH.attribute extractedTipes) (TermN EmptyRecord1) ] )
52+ , ("uniform", [record (Map.map (\t -> [glTipe t]) $ PH.uniform extractedTipes) (TermN EmptyRecord1) ] )
53+ , ("varying", [record (Map.map (\t -> [glTipe t]) $ PH.varying extractedTipes) (TermN EmptyRecord1) ] )
54+ ]
55+
48
56
49 Var name | name == saveEnvName -> return (L span CSaveEnv)
57 Var name | name == saveEnvName -> return (L span CSaveEnv)
50 | otherwise -> return (name <? tipe)
58 | otherwise -> return (name <? tipe)
compiler/Type/Environment.hs+2−2
@@ -54,8 +54,8 @@ makeTypes datatypes =
54
54
55 builtins :: [(String,Int)]
55 builtins :: [(String,Int)]
56 builtins = concat [ map tuple [0..9]
56 builtins = concat [ map tuple [0..9]
57− , kind 1 ["_List","GLShader"]
57+ , kind 1 ["_List"]
58− , kind 0 ["Int","Float","Char","String","Bool","M4x4","V3"]
58+ , kind 0 ["Int","Float","Char","String","Bool"]
59 ]
59 ]
60
60
61
61
libraries/Graphics/WebGL.elm+9−14
@@ -1,4 +1,4 @@
1−module Graphics.WebGL (makeGL, Vertex, bufferMesh, transform, mesh, webgl) where
1+module Graphics.WebGL (makeGL, linkProgram, linkModel, webgl) where
2
2
3{-| WebGL
3{-| WebGL
4
4
@@ -16,22 +16,17 @@ data GLContext = Fake_Context
16makeGL : Int -> Int -> Signal GLContext
16makeGL : Int -> Int -> Signal GLContext
17makeGL = Native.Graphics.WebGL.makeGL
17makeGL = Native.Graphics.WebGL.makeGL
18
18
19−type Vertex = { pos: V3, color: Color }
19+data GLShader declarations = Fake_GLShader
20−type Triangle = (Vertex,Vertex,Vertex)
20+data GLProgram attributes = Fake_Program
21
21
22−data Mesh = Fake_Mesh
22+linkProgram : GLShader { attribute : a, uniform : u, varying : v } -> GLShader { attribute : {}, uniform : {}, varying : v } -> GLContext -> GLProgram { attribute : a, uniform : u }
23+linkProgram = Native.Graphics.WebGL.linkProgram
23
24
24−bufferMesh : [Triangle] -> GLContext -> Mesh
25+data GLModel = Fake_Model
25−bufferMesh = Native.Graphics.WebGL.bufferMesh
26
26
27−data Scene = SceneNode M4x4 [Scene] | SceneLeaf Mesh
27+linkModel : (GLProgram { attribute : a, uniform : u }) -> u -> [a] -> GLModel
28+linkModel = Native.Graphics.WebGL.linkModel
28
29
29−transform : M4x4 -> [Scene] -> Scene
30+webgl : GLContext -> [GLModel] -> Element
30−transform = SceneNode
31−
32−mesh : Mesh -> Scene
33−mesh = SceneLeaf
34−
35−webgl : GLContext -> Scene -> Element
36webgl = Native.Graphics.WebGL.webgl
31webgl = Native.Graphics.WebGL.webgl
37
32
libraries/Native/Graphics/WebGL.js+34−54
@@ -27,51 +27,19 @@ Elm.Native.Graphics.WebGL.make = function(elm) {
27 return shader;
27 return shader;
28 };
28 };
29
29
30− function linkProgram(gl, program) {
30+ function linkProgram(vSrc, fSrc, context) {
31− var vshader = createShader(gl, program.vshaderSource, gl.VERTEX_SHADER);
31+ var gl = context.gl;
32− var fshader = createShader(gl, program.fshaderSource, gl.FRAGMENT_SHADER);
32+ var vshader = createShader(gl, vSrc, gl.VERTEX_SHADER);
33− gl.attachShader(program, vshader);
34− gl.attachShader(program, fshader);
35− gl.linkProgram(program);
36− if (!gl.getProgramParameter(program, gl.LINK_STATUS)) {
37− throw gl.getProgramInfoLog(program);
38− }
39− }
40−
41− function createProgram(gl, vstr, fstr) {
42− var program = gl.createProgram();
43− var vshader = createShader(gl, vstr, gl.VERTEX_SHADER);
33+ var fshader = createShader(gl, fSrc, gl.FRAGMENT_SHADER);
44− var fshader = createShader(gl, fstr, gl.FRAGMENT_SHADER);
34+ var program = gl.createProgram()
45 gl.attachShader(program, vshader);
35 gl.attachShader(program, vshader);
46 gl.attachShader(program, fshader);
36 gl.attachShader(program, fshader);
47 gl.linkProgram(program);
37 gl.linkProgram(program);
48−
49 if (!gl.getProgramParameter(program, gl.LINK_STATUS)) {
38 if (!gl.getProgramParameter(program, gl.LINK_STATUS)) {
50 throw gl.getProgramInfoLog(program);
39 throw gl.getProgramInfoLog(program);
51 }
40 }
52−
53 return program;
41 return program;
54− };
42+ }
55−
56− var geoVert = "attribute vec3 aVertexPosition;\
57− attribute vec4 aVertexColor;\
58− \
59− uniform mat4 uSceneMatrix;\
60− \
61− varying vec4 vVertexColor;\
62− \
63− void main() {\
64− gl_Position = uSceneMatrix * vec4(aVertexPosition, 1.0);\
65− vVertexColor = aVertexColor;\
66− }"
67−
68− var geoFrag = "precision mediump float;\
69− \
70− varying vec4 vVertexColor;\
71− \
72− void main() {\
73− gl_FragColor = vVertexColor;\
74− }"
75
43
76 function drawGL(model) {
44 function drawGL(model) {
77 var aspect = model.aspect;
45 var aspect = model.aspect;
@@ -117,8 +85,21 @@ Elm.Native.Graphics.WebGL.make = function(elm) {
117 }
85 }
118 }
86 }
119
87
120− var scene = model.scene;
88+ function drawModel(glModel) {
121− drawScene(scene,0);
89+ var program = glModel.program;
90+ var uniforms = glModel.uniforms;
91+ va:q
92+ for (var uName in uniforms) {
93+ var uLoc = gl.getUniformLocation(program, uName);
94+ var active = gl.getActiveUniform(program, uName);
95+ }
96+
97+
98+ var attributes = glModel.attributes;
99+
100+ }
101+
102+ List.each(drawModel, model.glModels);
122
103
123 }
104 }
124
105
@@ -140,17 +121,7 @@ Elm.Native.Graphics.WebGL.make = function(elm) {
140 function makeGL(w,h) {
121 function makeGL(w,h) {
141 var node = newNode('canvas');
122 var node = newNode('canvas');
142 var gl = node.getContext('webgl');
123 var gl = node.getContext('webgl');
143− var programPtr = createProgram(gl, geoVert, geoFrag);
144− var vertexPositionAttribute = gl.getAttribLocation(programPtr,'aVertexPosition');
145− var vertexColorAttribute = gl.getAttribLocation(programPtr,'aVertexColor');
146− var sceneMatrixUniform = gl.getUniformLocation(programPtr, 'uSceneMatrix');
147− var program = {
148− programPtr: programPtr,
149− vertexPositionAttribute: vertexPositionAttribute,
150− vertexColorAttribute: vertexColorAttribute,
151− sceneMatrixUniform: sceneMatrixUniform,
152− };
153− return Signal.constant({w:w,h:h,gl:gl,node:node,program:program});
124+ return Signal.constant({w:w,h:h,gl:gl,node:node});
154 }
125 }
155
126
156 function bufferMesh(triangles, context) {
127 function bufferMesh(triangles, context) {
@@ -200,7 +171,7 @@ Elm.Native.Graphics.WebGL.make = function(elm) {
200
171
201 }
172 }
202
173
203− function webgl(context, scene) {
174+ function webgl(context, glModels) {
204
175
205 return A3(newElement, context.w, context.h, {
176 return A3(newElement, context.w, context.h, {
206 ctor: 'Custom',
177 ctor: 'Custom',
@@ -211,17 +182,26 @@ Elm.Native.Graphics.WebGL.make = function(elm) {
211 aspect: context.w/context.h,
182 aspect: context.w/context.h,
212 node: context.node,
183 node: context.node,
213 gl: context.gl,
184 gl: context.gl,
214− program: context.program,
185+ glModels: glModels,
215− scene: scene,
216 },
186 },
217 });
187 });
218
188
219 }
189 }
220
190
191+ function linkModel(program, uniforms, attributes) {
192+ return {
193+ program: program,
194+ uniforms: uniforms,
195+ attributes: attributes,
196+ };
197+ }
198+
221 return elm.Native.Graphics.WebGL.values = {
199 return elm.Native.Graphics.WebGL.values = {
222 makeGL:F2(makeGL),
200 makeGL:F2(makeGL),
223 bufferMesh:F2(bufferMesh),
201 bufferMesh:F2(bufferMesh),
224 webgl:F2(webgl),
202 webgl:F2(webgl),
203+ linkProgram:F3(linkProgram),
204+ linkModel:F3(linkModel),
225 };
205 };
226
206
227};
207};