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
|
(* $Id: scene.ml,v 1.12 2001/05/08 01:58:26 garrigue Exp $ *)
(* Initialize material property and light source.
*)
let myinit () =
let light_ambient = 0.0, 0.0, 0.0, 1.0
and light_diffuse = 1.0, 1.0, 1.0, 1.0
and light_specular = 1.0, 1.0, 1.0, 1.0
(* light_position is NOT default value *)
and light_position = 1.0, 1.0, 1.0, 0.0
in
GlLight.light ~num:0 (`ambient light_ambient);
GlLight.light ~num:0 (`diffuse light_diffuse);
GlLight.light ~num:0 (`specular light_specular);
GlLight.light ~num:0 (`position light_position);
GlFunc.depth_func `less;
List.iter Gl.enable [`lighting; `light0; `depth_test]
let pi = acos (-1.)
let solid_torus ~inner ~outer =
let slices = 32 and faces = 16 in
let slice_angle = 2.0 *. pi /. float slices
and face_angle = 2.0 *. pi /. float faces in
let vertex ~i ~j =
let angle1 = slice_angle *. float i
and angle2 = face_angle *. float j in
GlDraw.normal3 (cos angle1 *. cos angle2,
-. sin angle1 *. cos angle2,
sin angle2);
GlDraw.vertex3
((outer +. inner *. cos angle2) *. cos angle1,
-. (outer +. inner *. cos angle2) *. sin angle1,
inner *. sin angle2)
in
GlDraw.begins `quads;
for i = 0 to slices - 1 do
for j = 0 to faces - 1 do
vertex ~i ~j;
vertex ~i:(i+1) ~j;
vertex ~i:(i+1) ~j:(j+1);
vertex ~i ~j:(j+1);
done
done;
GlDraw.ends ()
let solid_cone ~radius ~height =
GluQuadric.cylinder ~base:radius ~top:0. ~height ~slices:15 ~stacks:10 ()
let solid_sphere ~radius =
GluQuadric.sphere ~radius ~slices:32 ~stacks:32 ()
let display () =
GlClear.clear [`color; `depth];
GlMat.push ();
GlMat.rotate ~angle:20.0 ~x:1.0 ();
GlMat.push ();
GlMat.translate ~x:(-0.75) ~y:0.5 ();
GlMat.rotate ~angle:90.0 ~x:1.0 ();
solid_torus ~inner:0.275 ~outer:0.85;
GlMat.pop ();
GlMat.push ();
GlMat.translate ~x:(-0.75) ~y:(-0.5) ();
GlMat.rotate ~angle:270.0 ~x:1.0 ();
solid_cone ~radius:1.0 ~height:2.0;
GlMat.pop ();
GlMat.push ();
GlMat.translate ~x:0.75 ~z:(-1.0) ();
solid_sphere ~radius:1.0;
GlMat.pop ();
GlMat.pop ();
Gl.flush ()
let my_reshape ~w ~h =
GlDraw.viewport ~x:0 ~y:0 ~w ~h;
GlMat.mode `projection;
GlMat.load_identity ();
if w <= h then
GlMat.ortho ~x:(-2.5,2.5) ~z:(-10.0,10.0)
~y:(-2.5 *. float h /. float w, 2.5 *. float h /. float w)
else
GlMat.ortho ~y:(-2.5,2.5) ~z:(-10.0,10.0)
~x:(-2.5 *. float w /. float h, 2.5 *. float w /. float h);
GlMat.mode `modelview
(* Main Loop
* Open window with initial window size, title bar,
* RGBA display mode, and handle input events.
*)
open Tk
let main () =
let top = openTk () in
let togl =
Togl.create top ~rgba:true ~depth:true ~width:500 ~height:500 in
Wm.title_set top "Scene";
myinit ();
Togl.reshape_func togl
~cb:(fun () -> my_reshape ~w:(Togl.width togl) ~h:(Togl.height togl));
Togl.display_func togl ~cb:display;
pack [togl] ~expand:true ~fill:`Both;
mainLoop ()
let _ =
begin
Printexc.print main ();
if not !Sys.interactive then begin
exit 0;
end;
end;;
|
