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
114
115
116
117
118
119
120
121
122
123
124
|
(* $Id: double.ml,v 1.11 2001/05/08 01:58:25 garrigue Exp $ *)
class view togl ~title = object (self)
val mutable corner_x = 0.
val mutable corner_y = 0.
val mutable corner_z = 0.
val font_base = Togl.load_bitmap_font togl ~font:`Fixed_8x13
val mutable x_angle = 0.
val mutable y_angle = 0.
val mutable z_angle = 0.
method togl = togl
method reshape =
let width = Togl.width togl and height = Togl.height togl in
let aspect = float width /. float height in
GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height;
(* Set up projection transform *)
GlMat.mode `projection;
GlMat.load_identity ();
GlMat.frustum ~x:(-.aspect, aspect) ~y:(-1.0, 1.0) ~z:(1.0, 10.0);
corner_x <- -. aspect;
corner_y <- -1.0;
corner_z <- -1.1;
(* Change back to model view transform for rendering *)
GlMat.mode `modelview
method print_string s =
GlList.call_lists ~base:font_base(`byte s)
method display =
GlClear.clear [`color;`depth];
GlMat.load_identity(); (* Reset modelview matrix to the identity matrix *)
GlMat.translate ~z:(-3.0) (); (* Move the camera back three units *)
GlMat.rotate ~angle:x_angle ~x:1. (); (* Rotate by X, Y, Z angles *)
GlMat.rotate ~angle:y_angle ~y:1. ();
GlMat.rotate ~angle:z_angle ~z:1. ();
Gl.enable `depth_test;
(* Front face *)
GlDraw.begins `quads;
GlDraw.color (0.0, 0.7, 0.1); (* Green *)
GlDraw.vertex3 (-1.0, 1.0, 1.0);
GlDraw.vertex3(1.0, 1.0, 1.0);
GlDraw.vertex3(1.0, -1.0, 1.0);
GlDraw.vertex3(-1.0, -1.0, 1.0);
(* Back face *)
GlDraw.color (0.9, 1.0, 0.0); (* Yellow *)
GlDraw.vertex3(-1.0, 1.0, -1.0);
GlDraw.vertex3(1.0, 1.0, -1.0);
GlDraw.vertex3(1.0, -1.0, -1.0);
GlDraw.vertex3(-1.0, -1.0, -1.0);
(* Top side face *)
GlDraw.color (0.2, 0.2, 1.0); (* Blue *)
GlDraw.vertex3(-1.0, 1.0, 1.0);
GlDraw.vertex3(1.0, 1.0, 1.0);
GlDraw.vertex3(1.0, 1.0, -1.0);
GlDraw.vertex3(-1.0, 1.0, -1.0);
(* Bottom side face *)
GlDraw.color (0.7, 0.0, 0.1); (* Red *)
GlDraw.vertex3(-1.0, -1.0, 1.0);
GlDraw.vertex3(1.0, -1.0, 1.0);
GlDraw.vertex3(1.0, -1.0, -1.0);
GlDraw.vertex3(-1.0, -1.0, -1.0);
GlDraw.ends();
Gl.disable `depth_test;
GlMat.load_identity();
GlDraw.color( 1.0, 1.0, 1.0 );
GlPix.raster_pos ~x:corner_x ~y:corner_y ~z:corner_z ();
self#print_string title;
Togl.swap_buffers togl
method x_angle a = x_angle <- a; Togl.render togl
method y_angle a = y_angle <- a; Togl.render togl
method z_angle a = z_angle <- a; Togl.render togl
end
let create_view ~parent ~double =
new view
(Togl.create ~width:200 ~height:200 ~depth:true ~rgba:true ~double parent)
open Tk
let main () =
let top = openTk () in
let f = Frame.create top in
let single = create_view ~parent:f ~double:false ~title:"Single buffer"
and double = create_view ~parent:f ~double:true ~title:"Double buffer" in
let sx =
Scale.create ~label:"X Axis" ~min:0. ~max:360. ~orient:`Horizontal
~command:(fun x -> single#x_angle x; double#x_angle x) top
and sy =
Scale.create ~label:"Y Axis" ~min:0. ~max:360. ~orient:`Horizontal
~command:(fun y -> single#y_angle y; double#y_angle y) top
and button =
Button.create ~text:"Quit" ~command:(fun () -> destroy top) top
in
List.iter
(fun o ->
Togl.display_func o#togl ~cb:(fun () -> o#display);
Togl.reshape_func o#togl ~cb:(fun () -> o#reshape);
bind o#togl ~events:[`Modified([`Button1],`Motion)]
~fields:[`MouseX;`MouseY]
~action:(fun ev ->
let width = Togl.width o#togl
and height =Togl.height o#togl
and x = ev.ev_MouseX
and y = ev.ev_MouseY in
let x_angle = 360. *. float y /. float height
and y_angle = 360. *. float (width - x) /. float width in
Scale.set sx x_angle;
Scale.set sy y_angle))
[single;double];
pack ~side:`Left ~padx:3 ~pady:3 ~fill:`Both ~expand:true
[single#togl; double#togl];
pack ~fill:`Both ~expand:true [f];
pack ~fill:`X [coe sx; coe sy; coe button];
mainLoop ()
let _ = main ()
|
