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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* Copyright 2001 David MENTRE *)
(* This program is under GNU GPL license *)
(* general structure taken in lablgtk planet.ml from Jacques Garrigues *)
(* OLablgtk/Olabgl adaptation of NeHe's OpenGL tutorial #3:
http://nehe.gamedev.net/tutorials/lesson03.asp *)
let resizeGLScene ~width ~height =
let ok_height =
if height = 0 then 1 else height in
GlDraw.viewport 0 0 width ok_height;
GlMat.mode `projection;
GlMat.load_identity ();
GluMat.perspective ~fovy:45.0
~aspect:((float_of_int width)/.(float_of_int ok_height)) ~z:(0.1, 100.0);
GlMat.mode `modelview;
GlMat.load_identity ()
let initGL () =
GlDraw.shade_model `smooth;
GlClear.color ~alpha:0.0 (0.0, 0.0, 0.0);
GlClear.depth 1.0;
Gl.enable `depth_test;
GlFunc.depth_func `lequal;
GlMisc.hint `perspective_correction `nicest
let drawGLScene area () =
GlClear.clear [`color; `depth];
GlMat.load_identity ();
GlMat.translate ~x:(-1.5) ~y:0.0 ~z:(-6.0) ();
GlDraw.begins `triangles;
GlDraw.color (1.0, 0.0, 0.0);
GlDraw.vertex3 (0.0, 1.0, 0.0);
GlDraw.color (0.0, 1.0, 0.0);
GlDraw.vertex3 (-1.0, -1.0, 0.0);
GlDraw.color (0.0, 0.0, 1.0);
GlDraw.vertex3 (1.0, -1.0, 0.0);
GlDraw.ends ();
GlMat.translate ~x:3.0 ~y:0.0 ~z:0.0 ();
GlDraw.color (0.5, 0.5, 1.0);
GlDraw.begins `quads;
GlDraw.vertex3 (-1.0, 1.0, 0.0);
GlDraw.vertex3 (1.0, 1.0, 0.0);
GlDraw.vertex3 (1.0, -1.0, 0.0);
GlDraw.vertex3 (-1.0, -1.0, 0.0);
GlDraw.ends ();
area#swap_buffers ()
let killGLWindow () =
() (* do nothing *)
let createGLWindow title width height bits fullscreen =
let w = GWindow.window ~title:title () in
w#connect#destroy ~callback:(fun () -> GMain.Main.quit (); exit 0);
w#set_resize_mode `IMMEDIATE;
let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 16;`BUFFER_SIZE bits]
~width:width ~height:height~packing:w#add () in
area#event#add [`KEY_PRESS];
w#event#connect#key_press ~callback:
begin fun ev ->
let key = GdkEvent.Key.keyval ev in
if key = GdkKeysyms._Escape then w#destroy ();
true
end;
area#connect#display ~callback:(drawGLScene area);
area#connect#reshape ~callback:resizeGLScene;
area#connect#realize ~callback:
begin fun () ->
initGL ();
resizeGLScene ~width ~height
end;
w#show ();
w
let main () =
let w = createGLWindow "Tutorial 3" 640 480 16 false in
GMain.Main.main ()
let _ = Printexc.print main ()
|
