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
|
(* $Id: planet.ml,v 1.17 2001-09-07 06:50:01 garrigue Exp $ *)
open Unix
class planet togl = object (self)
val togl = togl
val mutable year = 0.0
val mutable day = 0.0
val mutable eye = 0.0
val mutable time = 0.0
method tick new_time =
if time = 0. then time <- new_time else
let diff = new_time -. time in
time <- new_time;
day <- mod_float (day +. diff *. 200.) 360.0;
year <- mod_float (year +. diff *. 20.) 360.0
method day_add =
day <- mod_float (day +. 10.0) 360.0
method day_subtract =
day <- mod_float (day -. 10.0) 360.0
method year_add =
year <- mod_float (year +. 5.0) 360.0
method year_subtract =
year <- mod_float (year -. 5.0) 360.0
method eye x =
eye <- x; self#display
method display =
GlClear.clear [`color;`depth];
GlDraw.color (1.0, 1.0, 1.0);
GlMat.push();
GlMat.rotate ~angle:eye ~x:1. ();
(* draw sun *)
GlLight.material ~face:`front (`specular (1.0,1.0,0.0,1.0));
GlLight.material ~face:`front (`shininess 5.0);
GluQuadric.sphere ~radius:1.0 ~slices:32 ~stacks:32 ();
(* draw smaller planet *)
GlMat.rotate ~angle:year ~y:1.0 ();
GlMat.translate () ~x:3.0;
GlMat.rotate ~angle:day ~y:1.0 ();
GlDraw.color (0.0, 1.0, 1.0);
GlDraw.shade_model `flat;
GlLight.material ~face:`front(`shininess 128.0);
GluQuadric.sphere ~radius:0.2 ~slices:10 ~stacks:10 ();
GlDraw.shade_model `smooth;
GlMat.pop ();
Gl.flush ();
Togl.swap_buffers togl
end
let myinit () =
let light_ambient = 0.5, 0.5, 0.5, 1.0
and light_diffuse = 1.0, 0.8, 0.2, 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
List.iter (GlLight.light ~num:0)
[ `ambient light_ambient; `diffuse light_diffuse;
`specular light_specular; `position light_position ];
GlFunc.depth_func `less;
List.iter Gl.enable [`lighting; `light0; `depth_test];
GlDraw.shade_model `smooth
let my_reshape togl =
let w = Togl.width togl and h = Togl.height togl in
GlDraw.viewport ~x:0 ~y:0 ~w ~h;
GlMat.mode `projection;
GlMat.load_identity();
GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(1.0,20.0);
GlMat.mode `modelview;
GlMat.load_identity();
GlMat.translate () ~z:(-5.0)
(* 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 ~width:700 ~height:500 ~double:true ~rgba:true
~depth:true in
Wm.title_set top "Planet";
myinit ();
let planet = new planet togl in
let scale =
Scale.create top ~min:(-45.) ~max:45. ~orient:`Vertical
~command:(planet#eye) ~showvalue:false ~highlightbackground:`Black in
bind togl ~events:[`Enter] ~action:(fun _ -> Focus.set togl);
bind scale ~events:[`Enter] ~action:(fun _ -> Focus.set scale);
bind togl ~events:[`KeyPress] ~fields:[`KeySymString]
~action:(fun ev ->
begin match ev.ev_KeySymString with
"Left" -> planet#year_subtract
| "Right" -> planet#year_add
| "Up" -> planet#day_add
| "Down" -> planet#day_subtract
| "Escape" -> destroy top; exit 0
| _ -> ()
end;
planet#display);
Togl.timer_func ~ms:20
~cb:(fun () -> planet#tick (Unix.gettimeofday()); planet#display);
Togl.display_func togl ~cb:(fun () -> planet#display);
Togl.reshape_func togl ~cb:(fun () -> my_reshape togl);
my_reshape togl;
pack [togl] ~side:`Left ~expand:true ~fill:`Both;
pack [scale] ~side:`Right ~fill:`Y;
Focus.set togl;
mainLoop ()
let _ = Printexc.print main ()
|
