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
125
126
127
128
129
130
|
(* $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 _ =
begin
main ();
if not !Sys.interactive then begin
exit 0;
end;
end;;
|
