@@ -5,34 +5,60 @@ import Http (..)
55import MJS (..)
66import Graphics.WebGL (..)
77
8−pul = {pos=v3 -1 1 0, coord=v3 0 1 0}
9−pur = {pos=v3 1 1 0, coord=v3 1 1 0}
10−pbl = {pos=v3 -1 -1 0, coord=v3 0 0 0}
11−pbr = {pos=v3 1 -1 0, coord=v3 1 0 0}
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 }]
17−rotFace turnH turnV =
18− let x = makeRotate (turnV * pi / 2) (v3 1 0 0)
19− y = makeRotate (turnH * pi / 2) (v3 0 1 0)
20− s = makeTranslate (v3 0 0 1)
21− t = mul (mul x y) s
22− in map (mapTriangle (\x -> {x | pos <- mul4x4 t x.pos })) face
23−
24−mesh : [Triangle { pos : V3, coord : V3 }]
25−mesh = concat . map (uncurry rotFace) <|
26− [ (0,0)
27− , (1,0)
28− , (2,0)
29− , (3,0)
30− , (0,1)
31− , (0,-1)
32− ]
33−
34−vert : Shader { pos : V3, coord : V3 } { u | view : M4x4 } { vcoord : V2 }
35−vert = [glShader|
8+-- Define the mesh for a crate
9+crate : [Triangle { pos:V3, coord:V3 }]
10+crate = concatMap rotatedFace [ (0,0), (90,0), (180,0), (270,0), (0,90), (0,-90) ]
11+
12+rotatedFace : (Float,Float) -> [Triangle { pos:V3, coord:V3 }]
13+rotatedFace (angleX,angleY) =
14+ let x = makeRotate (degrees angleX) (v3 1 0 0)
15+ y = makeRotate (degrees angleY) (v3 0 1 0)
16+ t = x `mul` y `mul` makeTranslate (v3 0 0 1)
17+ in
18+ map (mapTriangle (\x -> {x | pos <- mul4x4 t x.pos })) face
19+
20+face : [Triangle { pos:V3, coord:V3 }]
21+face =
22+ let topLeft = { pos = v3 -1 1 0, coord = v3 0 1 0 }
23+ topRight = { pos = v3 1 1 0, coord = v3 1 1 0 }
24+ bottomLeft = { pos = v3 -1 -1 0, coord = v3 0 0 0 }
25+ bottomRight = { pos = v3 1 -1 0, coord = v3 1 0 0 }
26+ in
27+ [ (topLeft,topRight,bottomLeft), (bottomLeft,topRight,bottomRight) ]
28+
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
59+vertexShader : Shader { pos:V3, coord:V3 } { u | view:M4x4 } { vcoord:V2 }
60+vertexShader = [glShader|
61+
3662attribute vec3 pos;
3763attribute vec3 coord;
3864uniform mat4 view;
@@ -41,44 +67,17 @@ void main () {
4167 gl_Position = view * vec4(pos, 1.0);
4268 vcoord = coord.xy;
4369}
70+
4471|]
4572
46−frag : Shader {} { u | crate : Texture } { vcoord : V2 }
47−frag = [glShader|
73+fragmentShader : Shader {} { u | crate:Texture } { vcoord:V2 }
74+fragmentShader = [glShader|
75+
4876precision mediump float;
4977uniform sampler2D crate;
5078varying vec2 vcoord;
5179void main () {
5280 gl_FragColor = texture2D(crate, vcoord);
5381}
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−
8482
83+|]