helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/GL/simple.ml

   1 (* $Id$ *)
   2
   3 open GMain
   4
   5 let main () =
   6   let w = GWindow.window ~title:"LablGL/Gtk" () in
   7   w#connect#destroy ~callback:Main.quit;
   8   let area =
   9     GlGtk.area [`RGBA;`DEPTH_SIZE 1] ~width:500 ~height:500 ~packing:w#add () in
  10   area#connect#realize ~callback:
  11     begin fun () ->
  12       GlMat.mode `projection;
  13       GlMat.load_identity ();
  14       GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0);
  15     end;
  16   area#connect#display ~callback:
  17     begin fun () ->
  18       GlClear.color (0.0, 0.0, 0.0);
  19       GlClear.clear [`color];
  20       GlDraw.color (1.0, 1.0, 1.0);
  21       GlDraw.begins `polygon;
  22       GlDraw.vertex ~x:(-0.5) ~y:(-0.5) ();
  23       GlDraw.vertex ~x:(-0.5) ~y:(0.5) ();
  24       GlDraw.vertex ~x:(0.5) ~y:(0.5) ();
  25       GlDraw.vertex ~x:(0.5) ~y:(-0.5) ();
  26       GlDraw.ends ();
  27       Gl.flush ()
  28     end;
  29   Timeout.add ~ms:10000 ~callback:(fun () -> w#destroy ();false);
  30   w#show ();
  31   Main.main ()
  32
  33 let _ = main ()