1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* $Id$ *)
open GMain
let main () =
let w = GWindow.window ~title:"LablGL/Gtk" () in
w#connect#destroy ~callback:Main.quit;
let area =
GlGtk.area [`RGBA;`DEPTH_SIZE 1;`DOUBLEBUFFER]
~width:500 ~height:500 ~packing:w#add () in
area#connect#realize ~callback:
begin fun () ->
GlMat.mode `projection;
GlMat.load_identity ();
GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0);
end;
area#connect#display ~callback:
begin fun () ->
GlClear.color (0.0, 0.0, 0.0);
GlClear.clear [`color];
GlDraw.color (1.0, 1.0, 1.0);
GlDraw.begins `polygon;
GlDraw.vertex ~x:(-0.5) ~y:(-0.5) ();
GlDraw.vertex ~x:(-0.5) ~y:(0.5) ();
GlDraw.vertex ~x:(0.5) ~y:(0.5) ();
GlDraw.vertex ~x:(0.5) ~y:(-0.5) ();
GlDraw.ends ();
Gl.flush ();
area#swap_buffers ()
end;
Timeout.add ~ms:10000 ~callback:(fun () -> w#destroy ();false);
w#show ();
Main.main ()
let _ = main ()
|
