Sebastien Mondet avatar Sebastien Mondet committed d3ddafe

demo: import WebGL js_of_ocaml example

Comments (0)

Files changed (1)

   if gl##getError() <> gl##_NO_ERROR
   then error "WebGL error"
 
-let init_canvas canvas_id =
-  let canvas =
-    Opt.get
-      (Opt.bind ( Dom_html.document##getElementById(string canvas_id) )
-         Dom_html.CoerceTo.canvas)
-      (fun () -> error "can't find canvas element %s" canvas_id) in
-  let gl =
-    Opt.get (try WebGL.getContext canvas with e -> null)
-      (fun () -> alert "can't initialise webgl context") in
-  canvas, gl
+module Renderer = struct
+
+
+  let init_canvas canvas_id =
+    let canvas =
+      Opt.get
+        (Opt.bind ( Dom_html.document##getElementById(string canvas_id) )
+           Dom_html.CoerceTo.canvas)
+        (fun () -> error "can't find canvas element %s" canvas_id) in
+    let gl =
+      Opt.get (try WebGL.getContext canvas with e -> null)
+        (fun () -> alert "can't initialise webgl context") in
+    canvas, gl
+
+  let load_shader (gl:WebGL.renderingContext t) shader text =
+    gl##shaderSource(shader,text);
+    gl##compileShader(shader);
+    if not (to_bool gl##getShaderParameter(shader, gl##_COMPILE_STATUS_))
+    then error "An error occurred compiling the shaders: \n%s\n%s"
+        (to_string text)
+        (to_string gl##getShaderInfoLog(shader))
+
+  let create_program (gl:WebGL.renderingContext t) vert_src frag_src =
+    let vertexShader = gl##createShader(gl##_VERTEX_SHADER_) in
+    let fragmentShader = gl##createShader(gl##_FRAGMENT_SHADER_) in
+    load_shader gl vertexShader vert_src;
+    load_shader gl fragmentShader frag_src;
+    let prog = gl##createProgram() in
+    gl##attachShader(prog,vertexShader);
+    gl##attachShader(prog,fragmentShader);
+    gl##linkProgram(prog);
+    if not (to_bool gl##getProgramParameter(prog, gl##_LINK_STATUS_))
+    then error "Unable to link the shader program.";
+    prog
+
+  let get_source src_id =
+    let script = Opt.get
+        (Opt.bind ( Dom_html.document##getElementById(string src_id) )
+           Dom_html.CoerceTo.script)
+        (fun () -> error "can't find script element %s" src_id) in
+    script##text
+
+  let float32array a =
+    let array = jsnew Typed_array.float32Array(Array.length a) in
+    Array.iteri (fun i v -> Typed_array.set array i v) a;
+    array
+  let int16array a =
+    let array = jsnew Typed_array.int16Array(Array.length a) in
+    Array.iteri (fun i v -> Typed_array.set array i v) a;
+    array
+
+  module Proj3D = struct
+    type t = float array
+    let scale x y z =
+      [| x;  0.; 0.; 0.;
+         0.; y ; 0.; 0.;
+         0.; 0.; z ; 0.;
+         0.; 0.; 0.; 1.; |]
+
+    let translate x y z =
+      [| 1.; 0.; 0.; 0.;
+         0.; 1.; 0.; 0.;
+         0.; 0.; 1.; 0.;
+         x ; y ; z ; 1.; |]
+
+    let rotate_x t =
+      [| 1.; 0.;      0.;    0.;
+         0.; cos t;   sin t; 0.;
+         0.; -.sin t; cos t; 0.;
+         0.; 0.;      0.;    1.; |]
+
+    let rotate_y t =
+      [| cos t; 0.; -.sin t; 0.;
+         0.;    1.; 0.;      0.;
+         sin t; 0.; cos t;   0.;
+         0.;    0.; 0.;    1.; |]
+
+    let c i j = i * 4 + j
+    let o i = i/4, i mod 4
+
+    let mult m1 m2 =
+      let v p =
+        let i,j = o p in
+        m1.(c i 0) *. m2.(c 0 j)
+        +. m1.(c i 1) *. m2.(c 1 j)
+        +. m1.(c i 2) *. m2.(c 2 j)
+        +. m1.(c i 3) *. m2.(c 3 j) in
+      Array.init 16 v
+
+    let array m = float32array m
+
+  end
+
+  let start (pos,norm) =
+    let fps_text = Dom_html.document##createTextNode (Js.string "loading") in
+    Opt.iter
+      (Opt.bind ( Dom_html.document##getElementById(string "fps") )
+         Dom_html.CoerceTo.element)
+      (fun span -> Dom.appendChild span fps_text);
+
+    let canvas, gl = init_canvas "canvas" in
+    let prog = create_program gl
+        (get_source "vertex-shader")
+        (get_source "fragment-shader") in
+    gl##useProgram(prog);
+
+    check_error gl;
+    debug "program loaded";
+
+    gl##enable(gl##_DEPTH_TEST_);
+    gl##depthFunc(gl##_LESS);
+
+    let proj_loc = gl##getUniformLocation(prog, string "u_proj") in
+    let lightPos_loc = gl##getUniformLocation(prog, string "u_lightPos") in
+    let ambientLight_loc = gl##getUniformLocation(prog, string "u_ambientLight") in
+
+    let lightPos = float32array [| 3.; 0.; -. 1. |] in
+    let ambientLight = float32array [| 0.1; 0.1; 0.1 |] in
+
+    gl##uniform3fv_typed(lightPos_loc, lightPos);
+    gl##uniform3fv_typed(ambientLight_loc, ambientLight);
+
+    let pos_attr = gl##getAttribLocation(prog, string "a_position") in
+    gl##enableVertexAttribArray(pos_attr);
+
+    let array_buffer = gl##createBuffer() in
+    gl##bindBuffer(gl##_ARRAY_BUFFER_,array_buffer);
+    gl##bufferData(gl##_ARRAY_BUFFER_,pos,gl##_STATIC_DRAW_);
+    gl##vertexAttribPointer(pos_attr, 3, gl##_FLOAT, _false, 0, 0);
+
+    let norm_attr = gl##getAttribLocation(prog, string "a_normal") in
+    gl##enableVertexAttribArray(norm_attr);
+
+    let norm_buffer = gl##createBuffer() in
+    gl##bindBuffer(gl##_ARRAY_BUFFER_,norm_buffer);
+    gl##bufferData(gl##_ARRAY_BUFFER_,norm,gl##_STATIC_DRAW_);
+    gl##vertexAttribPointer(norm_attr, 3, gl##_FLOAT, _false, 0, 0);
+
+    let pi = 4. *. (atan 1.) in
+    let mat =
+      Proj3D.(
+        mult
+          (rotate_x (pi/.2.))
+          (mult
+             (scale 0.5 0.5 0.5)
+             (translate (0.) (0.) 0.))) in
+
+    check_error gl;
+    debug "ready";
+
+    let get_time () = to_float ((jsnew date_now ())##getTime()) in
+    let last_draw = ref (get_time ()) in
+    let draw_times = Queue.create () in
+    let rec f () =
+      let t = to_float (jsnew date_now ())##getTime() /. 1000. in
+      let mat' = Proj3D.mult mat (Proj3D.rotate_y (1. *. t)) in
+      gl##uniformMatrix4fv_typed(proj_loc, _false, Proj3D.array mat');
+
+      gl##clear(gl##_DEPTH_BUFFER_BIT_ lor gl##_COLOR_BUFFER_BIT_);
+      gl##drawArrays(gl##_TRIANGLES, 0, pos##length / 3);
+      check_error gl;
+
+      let now = get_time () in
+      Queue.push (now -. !last_draw) draw_times;
+      last_draw := now;
+      if Queue.length draw_times > 50 then ignore (Queue.pop draw_times);
+      let fps = (1. /. ( Queue.fold (+.) 0. draw_times ))
+                *. (Pervasives.float (Queue.length draw_times))
+                *. 1000. in
+      fps_text##data <- string (Printf.sprintf "%.1f" fps);
+      Lwt_js.sleep 0.02 >>= f
+    in
+    f ()
+
+end
 
 module PDB = struct
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.