git.iko.soy/elk
on master help sign in
Redo crate program with clearer names
17d8b58Evan Czaplicki
tests/compiler/test-files/good/Crate.elm+59−60
compare with master
unifiedsplit
@@ -5,34 +5,60 @@ import Http (..)
5import MJS (..)
5import MJS (..)
6import Graphics.WebGL (..)
6import Graphics.WebGL (..)
7
7
8−pul = {pos=v3 -1 1 0, coord=v3 0 1 0}
8+-- Define the mesh for a crate
9−pur = {pos=v3 1 1 0, coord=v3 1 1 0}
9+crate : [Triangle { pos:V3, coord:V3 }]
10−pbl = {pos=v3 -1 -1 0, coord=v3 0 0 0}
10+crate = concatMap rotatedFace [ (0,0), (90,0), (180,0), (270,0), (0,90), (0,-90) ]
11−pbr = {pos=v3 1 -1 0, coord=v3 1 0 0}
11+
12−
13−face : [Triangle { pos : V3, coord : V3 }]
14−face = [(pul,pur,pbl),(pbl,pur,pbr)]
15−
16−rotFace : Float -> Float -> [Triangle { pos : V3, coord : V3 }]
12+rotatedFace : (Float,Float) -> [Triangle { pos:V3, coord:V3 }]
17−rotFace turnH turnV =
13+rotatedFace (angleX,angleY) =
18− let x = makeRotate (turnV * pi / 2) (v3 1 0 0)
14+ let x = makeRotate (degrees angleX) (v3 1 0 0)
19− y = makeRotate (turnH * pi / 2) (v3 0 1 0)
15+ y = makeRotate (degrees angleY) (v3 0 1 0)
20− s = makeTranslate (v3 0 0 1)
16+ t = x `mul` y `mul` makeTranslate (v3 0 0 1)
21− t = mul (mul x y) s
17+ in
22− in map (mapTriangle (\x -> {x | pos <- mul4x4 t x.pos })) face
18+ map (mapTriangle (\x -> {x | pos <- mul4x4 t x.pos })) face
23−
19+
24−mesh : [Triangle { pos : V3, coord : V3 }]
20+face : [Triangle { pos:V3, coord:V3 }]
25−mesh = concat . map (uncurry rotFace) <|
21+face =
26− [ (0,0)
22+ let topLeft = { pos = v3 -1 1 0, coord = v3 0 1 0 }
27− , (1,0)
23+ topRight = { pos = v3 1 1 0, coord = v3 1 1 0 }
28− , (2,0)
24+ bottomLeft = { pos = v3 -1 -1 0, coord = v3 0 0 0 }
29− , (3,0)
25+ bottomRight = { pos = v3 1 -1 0, coord = v3 1 0 0 }
30− , (0,1)
26+ in
31− , (0,-1)
27+ [ (topLeft,topRight,bottomLeft), (bottomLeft,topRight,bottomRight) ]
32− ]
28+
33−
29+-- View
30+view : Float -> M4x4
31+view angle =
32+ foldr1 mul [ perspective
33+ , camera
34+ , makeRotate (3*angle) (v3 0 1 0)
35+ , makeRotate (2*angle) (v3 1 0 0)
36+ ]
37+
38+perspective : M4x4
39+perspective = makePerspective 45 1 0.01 100
40+
41+camera : M4x4
42+camera = makeLookAt (v3 0 0 5) (v3 0 0 0) (v3 0 1 0)
43+
44+-- Putting it together
45+main : Signal Element
46+main = webgl (400,400) <~ lift2 scene (loadTex "woodCrate.jpg") (view <~ angle)
47+
48+angle : Signal Float
49+angle = foldp (\dt theta -> theta + dt / 10000) 0 (fps 25)
50+
51+scene : Response Texture -> M4x4 -> [Model]
52+scene response view =
53+ case response of
54+ Waiting -> []
55+ Failure _ _ -> []
56+ Success tex -> [model vertexShader fragmentShader crate { crate = tex, view = view }]
57+
58+-- Shaders
34−vert : Shader { pos : V3, coord : V3 } { u | view : M4x4 } { vcoord : V2 }
59+vertexShader : Shader { pos:V3, coord:V3 } { u | view:M4x4 } { vcoord:V2 }
35−vert = [glShader|
60+vertexShader = [glShader|
61+
36attribute vec3 pos;
62attribute vec3 pos;
37attribute vec3 coord;
63attribute vec3 coord;
38uniform mat4 view;
64uniform mat4 view;
@@ -41,44 +67,17 @@ void main () {
41 gl_Position = view * vec4(pos, 1.0);
67 gl_Position = view * vec4(pos, 1.0);
42 vcoord = coord.xy;
68 vcoord = coord.xy;
43}
69}
70+
44|]
71|]
45
72
46−frag : Shader {} { u | crate : Texture } { vcoord : V2 }
73+fragmentShader : Shader {} { u | crate:Texture } { vcoord:V2 }
47−frag = [glShader|
74+fragmentShader = [glShader|
75+
48precision mediump float;
76precision mediump float;
49uniform sampler2D crate;
77uniform sampler2D crate;
50varying vec2 vcoord;
78varying vec2 vcoord;
51void main () {
79void main () {
52 gl_FragColor = texture2D(crate, vcoord);
80 gl_FragColor = texture2D(crate, vcoord);
53}
81}
54−|]
55−
56−crateTex : Signal (Response Texture)
57−crateTex = loadTex "woodCrate.JPG"
58−
59−per : M4x4
60−per = makePerspective 45 1 0.01 100
61−
62−cam : M4x4
63−cam = makeLookAt (v3 0 0 5) (v3 0 0 0) (v3 0 1 0)
64−
65−angle : Signal Float
66−angle = foldp (\_ n -> n + 0.02) 0 (fps 25)
67−
68−view : Float -> M4x4
69−view t =
70− let x = makeRotate (2*t) (v3 1 0 0)
71− y = makeRotate (3*t) (v3 0 1 0)
72− in foldr mul identity [per,cam,y,x]
73−
74−content : Response Texture -> M4x4 -> [Model]
75−content response view = case response of
76− Waiting -> []
77− Failure i s -> []
78− Success tex -> [model vert frag mesh { crate = tex, view = view }]
79−
80−main = webgl (400,400) <~ (content <~ crateTex ~ (view <~ angle))
81−
82−--main = asText (List.length mesh)
83−
84
82
83+|]