Commits

Sebastien Mondet  committed 37ec20a

webpdb: display any PDB by URL

  • Participants
  • Parent commits f23eda3

Comments (0)

Files changed (1)

 
   let sphere ~position ~scale = Sphere (position, scale)
 
-  let start scene =
+  type renderer = {
+    gl: WebGL.renderingContext Js.t;
+    prog: WebGL.program Js.t;
+    mutable render: unit -> unit
+  }
+
+  let start () =
     let fps_text = Dom_html.document##createTextNode (Js.string "loading") in
     Opt.iter
       (Opt.bind ( Dom_html.document##getElementById(string "fps") )
     gl##uniform3fv_typed(ambientLight_loc, ambientLight);
 
 
-    (* Load scene: *)
-    let arrays =
-      List.map scene ~f:(function
-        | Sphere (position, scale) ->
-          let scaled_and_translated =
-            Array.mapi Data.sphere_vertices ~f:(fun i coord ->
-                let kind_of_coord = i mod 3 in
-                (coord *. scale) +. position.(kind_of_coord)) in
-          scaled_and_translated, Data.sphere_vertices)
-    in
-    debug "arrays crated";
-    let pos = float32array_concat_map arrays ~f:fst in
-    debug "pos crated";
-    let norm = float32array_concat_map arrays  ~f:snd in
-    debug "pos, norm crated";
-    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 mat =
       (* let pi = 4. *. (atan 1.) in *)
           (* (rotate_x (pi/.2.)) *)
           (rotate_x (0.))
           (mult
-             (scale 0.5 0.5 0.5)
+             (* (scale 0.8 0.8 0.8) *)
+             (scale 1. 1. 1.)
              (translate (0.) (0.) 0.))) in
 
     check_error gl;
     let get_time () = to_float ((jsnew date_now ())##getTime()) in
     let last_draw = ref (get_time ()) in
     let draw_times = Queue.create () in
+    let renderer = { gl; render = (fun () -> ()); prog} 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);
+      renderer.render ();
       check_error gl;
 
       let now = get_time () in
       fps_text##data <- string (Printf.sprintf "%.1f" fps);
       Lwt_js.sleep 0.2 >>= f
     in
-    f ()
+    Lwt.ignore_result (f ());
+    return renderer
+
+  let load_scene ~renderer scene =
+    let arrays =
+      List.map scene ~f:(function
+        | Sphere (position, scale) ->
+          let scaled_and_translated =
+            Array.mapi Data.sphere_vertices ~f:(fun i coord ->
+                let kind_of_coord = i mod 3 in
+                (coord *. scale) +. position.(kind_of_coord)) in
+          scaled_and_translated, Data.sphere_vertices)
+    in
+    debug "arrays crated";
+    let pos = float32array_concat_map arrays ~f:fst in
+    debug "pos crated";
+    let norm = float32array_concat_map arrays  ~f:snd in
+    debug "pos, norm crated";
+    let gl = renderer.gl in
+    let prog = renderer.prog in
+    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);
+
+    renderer.render <- (fun () ->
+        gl##drawArrays(gl##_TRIANGLES, 0, pos##length / 3);
+      );
+    return ()
 
 end
 
     let a = str_array ((string content)##split(string "\n")) in
     (Unsafe.coerce Dom_html.window)##arr <- a;
     let atoms = ref [] in
-    let max = [| 0.;0.;0. |] in
-    let min = [| 0.;0.;0. |] in
+    let max = [| -. infinity; -. infinity; -. infinity |] in
+    let min = [|    infinity;    infinity;    infinity |] in
     array_iter (fun s ->
         let tokens =
           str_array (s##split_regExp(jsnew regExp(string "[ \t]+"))) in
           atoms := (element, [| x;  y;  z |]) :: !atoms;
         );
       ) a;
-    return (List.rev !atoms, min, max)
+    let molecule =
+      ("Z", min) :: ("Z", max) :: List.rev !atoms in
+    return (molecule, min, max)
 
   let to_scene (molecule, aabb_min, aabb_max) =
     let max_coord =
       max (max (aabb_max.(0) -. aabb_min.(0)) (aabb_max.(1) -. aabb_min.(1)))
         (aabb_max.(2) -. aabb_min.(2)) in
-    List.map molecule ~f:(fun (el, position) ->
-        let scale =
-          (try (float_of_int (int_of_char el.[0])) /. 3000. with _ -> 1.) in
-        let position = [|
-          1.6 *. ((position.(0) /. (max_coord *. 0.5)) -. 0.5);
-          1.6 *. ((position.(1) /. (max_coord *. 0.5)) -. 0.5);
-          1.6 *. ((position.(2) /. (max_coord *. 0.5)) -. 0.5);
-        |] in
-        Renderer.sphere ~position ~scale)
+    debug "AABB: min: %f, %f, %f  |  max: %f, %f, %f | max_coord: %f"
+      aabb_min.(0) aabb_min.(1) aabb_min.(2)
+      aabb_max.(0) aabb_max.(1) aabb_max.(2) max_coord;
+    let scale = 0.2 in
+    (
+      Renderer.sphere ~position:[| -1.; -1.; -1. |] ~scale
+      :: Renderer.sphere ~position:[|  1.;  1.;  1. |] ~scale
+      :: Renderer.sphere ~position:[| -1.;  1.;  1. |] ~scale
+      :: Renderer.sphere ~position:[|  1.; -1.;  1. |] ~scale
+      :: Renderer.sphere ~position:[|  1.; -1.; -1. |] ~scale
+      :: Renderer.sphere ~position:[|  1.;  1.; -1. |] ~scale
+      :: Renderer.sphere ~position:[| -1.;  1.; -1. |] ~scale
+      :: Renderer.sphere ~position:[| -1.; -1.;  1. |] ~scale
+      :: List.map molecule ~f:(fun (el, position) ->
+          let scale =
+            (try (float_of_int (int_of_char el.[0])) /. 3000. with _ -> 1.) in
+          let position = [|
+            ((position.(0) -. aabb_min.(0)) /. max_coord) -. 0.5;
+            ((position.(1) -. aabb_min.(1)) /. max_coord) -. 0.5;
+            ((position.(2) -. aabb_min.(2)) /. max_coord) -. 0.5;
+          |] in
+          Renderer.sphere ~position ~scale))
 
 end
 
 
 let default_model =  "http://www.pdb.org/pdb/files/4IS8.pdb"
 
-let setup_download_box () =
+let setup_download_box renderer =
   let interaction_div =
     Opt.get (Dom_html.document##getElementById(string "interaction"))
       (fun () -> failwith "no interaction div")  in
   go_button##onclick <- Dom_html.handler begin fun _ ->
       debug "Go: %s" (to_string input_url##value);
       Lwt.ignore_result begin
-        fetch_model default_model
+        Renderer.load_scene ~renderer []
+        >>= fun () ->
+        fetch_model (to_string input_url##value)
         >|= PDB.to_scene
         >>= fun scene ->
-        debug "got scene";
-        return ()
+        Renderer.load_scene ~renderer scene
       end;
       Js._true
     end;
   ignore (
     catch begin fun () ->
       debug "START !";
-      setup_download_box ()
+      Renderer.start ()
+      >>= fun renderer ->
+      setup_download_box renderer
       >>= fun () ->
       fetch_model default_model
       >|= PDB.to_scene
       >>= fun scene ->
-      Renderer.start scene
+      Renderer.load_scene ~renderer scene
     end
       (fun exn -> error "uncaught exception: %s" (Printexc.to_string exn)));
   _true