d288733 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+1−1

compare with master

unifiedsplit

@@ -176,7 +176,7 @@ expression (L span expr) =

176 md = pad ++ MD.toHtml doc ++ pad

177

178 GLShader _uid src _tipe ->

179− return . literal $ Str src

179+ return $ ObjectLit () [(PropString () "src", literal (Str src))]

180

181 PortIn name tipe ->

182 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 =

33 Literal lit -> liftIO $ Literal.constrain env span lit tipe

34

35 GLShader _uid _src gltipe ->

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)

36− return . L span $ CEqual tipe (shaderTipe attribute uniform varying)

45+ in 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)

43

46

44 Var name | name == saveEnvName -> return (L span CSaveEnv)

47 Var name | name == saveEnvName -> return (L span CSaveEnv)

45 | otherwise -> return (name <? tipe)

48 | otherwise -> return (name <? tipe)

libraries/Graphics/WebGL.elm+3−15

@@ -5,32 +5,20 @@ module Graphics.WebGL (link, mapTriangle, zipTriangle, bind, encapsulate, webgl)

5import Graphics.Element (Element)

6import Native.Graphics.WebGL

7

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−

14type Triangle a = (a,a,a)

8type Triangle a = (a,a,a)

15

9

16−triangle : a -> a -> a -> Triangle a

17−triangle = (,,)

18−

19mapTriangle : (a -> b) -> Triangle a -> Triangle b

10mapTriangle : (a -> b) -> Triangle a -> Triangle b

20mapTriangle f (x,y,z) = (f x, f y, f z)

11mapTriangle f (x,y,z) = (f x, f y, f z)

21

12

22zipTriangle : (a -> b -> c) -> Triangle a -> Triangle b -> Triangle c

13zipTriangle : (a -> b -> c) -> Triangle a -> Triangle b -> Triangle c

23zipTriangle f (x,y,z) (x',y',z') = (f x x', f y y', f z z')

14zipTriangle f (x,y,z) (x',y',z') = (f x x', f y y', f z z')

24

15

25−data Buffer a = Dummy_Buffer

16+data Shader attr unif vary = Dummy_Shader

26−

27−bind : [Triangle a] -> Buffer a

28−bind = Native.Graphics.WebGL.bind

29

17

30data Model = Dummy_Model

18data Model = Dummy_Model

31

19

32−encapsulate : Program a u -> Buffer a -> u -> Model

20+model : Shader attr unif vary -> Shader {} unif vary -> [Triangle attr] -> unif -> Model

33−encapsulate = Native.Graphics.WebGL.encapsulate

21+model = Native.Graphics.WebGL.model

34

22

35webgl : (Int,Int) -> [Model] -> Element

23webgl : (Int,Int) -> [Model] -> Element

36webgl = Native.Graphics.WebGL.webgl

24webgl = Native.Graphics.WebGL.webgl

tests/test-files/good/Box.elm+8−9

@@ -2,7 +2,7 @@

2module Box where

3

4import 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)

6import Window(dimensions)

7

8-- 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

39mesh : [Triangle {pos : V3, color : V3}]

40mesh = zipWith (zipTriangle (\pos color -> { pos = pos, color = color })) positions colors

41

42+vert : Shader {a | pos : V3, color : V3} {b | rot : M4x4, per : M4x4, cam : M4x4} {vcolor : V3}

42vert = [glShader|

43vert = [glShader|

43attribute vec3 pos;

44attribute vec3 pos;

44attribute vec3 color;

45attribute vec3 color;

@@ -52,19 +53,16 @@ void main () {

52}

53}

53|]

54|]

54

55

56+frag : Shader {} {b | shade : Float} {vcolor : V3}

55frag = [glShader|

57frag = [glShader|

56precision mediump float;

58precision mediump float;

59+uniform float shade;

57varying vec3 vcolor;

60varying vec3 vcolor;

58void main () {

61void main () {

59− gl_FragColor = vec4(vcolor, 1.0);

62+ gl_FragColor = shade * vec4(vcolor, 1.0);

60}

63}

61|]

64|]

62

65

63−prog = link vert frag

64−

65−buf : Buffer {pos : V3, color : V3}

66−buf = bind mesh

67−

68per : M4x4

66per : M4x4

69per = makePerspective 45 1 0.01 100

67per = makePerspective 45 1 0.01 100

70

68

@@ -74,10 +72,11 @@ cam = makeLookAt (v3 0 0 5) (v3 0 0 0) (v3 0 1 0)

74angle : Signal Float

72angle : Signal Float

75angle = foldp (\_ n -> n + 0.02) 0 (fps 25)

73angle = foldp (\_ n -> n + 0.02) 0 (fps 25)

76

74

75+rot : Signal { rot : M4x4, per : M4x4, cam : M4x4, shade : Float }

77−rot = (\t -> { rot = mul (makeRotate (3*t) (v3 0 1 0)) (makeRotate (2*t) (v3 1 0 0)), per = per, cam = cam }) <~ angle

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

78

77

79draw : Signal [Model]

78draw : Signal [Model]

80−draw = combine [ (encapsulate prog buf) <~ rot ]

79+draw = combine [ (\rot -> (model vert frag mesh rot)) <~ rot ]

81

80

82main = webgl <~ dimensions ~ draw

81main = webgl <~ dimensions ~ draw

83

82