]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/GL/planet.ml
...
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20001129-0.1.0 / examples / GL / planet.ml
1 (* $Id$ *)
2
3 class planet area = object (self)
4   val area : GlGtk.area = area
5   val mutable year = 0.0
6   val mutable day = 0.0
7   val mutable eye = 0.0
8   val mutable time = 0.0
9
10   method tick new_time =
11     if time = 0. then time <- new_time else
12     let diff = new_time -. time in
13     time <- new_time;
14     day <- mod_float (day +. diff *. 200.) 360.0;
15     year <- mod_float (year +. diff *. 20.) 360.0
16   method day_add () =
17     day <- mod_float (day +. 10.0) 360.0
18   method day_subtract () =
19     day <- mod_float (day -. 10.0) 360.0
20   method year_add () =
21     year <- mod_float (year +. 5.0) 360.0
22   method year_subtract () =
23     year <- mod_float (year -. 5.0) 360.0
24   method eye x =
25     eye <- x; self#display ()
26
27   method display () =
28     GlClear.clear [`color;`depth];
29
30     GlDraw.color (1.0, 1.0, 1.0);
31     GlMat.push();
32     GlMat.rotate ~angle:eye ~x:1. ();
33 (*      draw sun        *)
34     GlLight.material ~face:`front (`specular (1.0,1.0,0.0,1.0));
35     GlLight.material ~face:`front (`shininess 5.0);
36     GluQuadric.sphere ~radius:1.0 ~slices:32 ~stacks:32 ();
37 (*      draw smaller planet     *)
38     GlMat.rotate ~angle:year ~y:1.0 ();
39     GlMat.translate ~x:3.0 ();
40     GlMat.rotate ~angle:day ~y:1.0 ();
41     GlDraw.color (0.0, 1.0, 1.0);
42     GlDraw.shade_model `flat;
43     GlLight.material ~face:`front(`shininess 128.0);
44     GluQuadric.sphere ~radius:0.2 ~slices:10 ~stacks:10 ();
45     GlDraw.shade_model `smooth;
46     GlMat.pop ();
47     Gl.flush ();
48     area#swap_buffers ()
49 end
50
51 let myinit () =
52   let light_ambient = 0.5, 0.5, 0.5, 1.0
53   and light_diffuse = 1.0, 0.8, 0.2, 1.0
54   and light_specular = 1.0, 1.0, 1.0, 1.0
55   (*  light_position is NOT default value       *)
56   and light_position = 1.0, 1.0, 1.0, 0.0
57   in
58   List.iter ~f:(GlLight.light ~num:0)
59     [ `ambient light_ambient; `diffuse light_diffuse;
60       `specular light_specular; `position light_position ];
61   GlFunc.depth_func `less;
62   List.iter ~f:Gl.enable [`lighting; `light0; `depth_test];
63   GlDraw.shade_model `smooth
64
65
66 let my_reshape ~width:w ~height:h =
67   GlDraw.viewport ~x:0 ~y:0 ~w ~h;
68   GlMat.mode `projection;
69   GlMat.load_identity();
70   GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(1.0,20.0);
71   GlMat.mode `modelview;
72   GlMat.load_identity();
73   GlMat.translate ~z:(-5.0) ()
74
75 (*  Main Loop
76  *  Open window with initial window size, title bar, 
77  *  RGBA display mode, and handle input events.
78  *)
79 open GMain
80 open GdkKeysyms
81
82 let main () =
83   let w = GWindow.window ~title:"Planet" () in
84   w#connect#destroy ~callback:(fun () -> Main.quit (); exit 0);
85   w#set_resize_mode `IMMEDIATE;
86   let hb = GPack.hbox ~packing:w#add () in
87   let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 1]
88       ~width:700 ~height:500 ~packing:hb#add () in
89   area#event#add [`KEY_PRESS];
90
91   let planet = new planet area in
92   let adjustment = GData.adjustment ~value:0. ~lower:(-90.) ~upper:90.
93       ~step_incr:1. ~page_incr:5. ~page_size:5. () in
94   let scale = GRange.scale `VERTICAL ~adjustment ~draw_value:false
95       ~packing:hb#pack () in
96   adjustment#connect#value_changed
97     ~callback:(fun () -> planet#eye adjustment#value);
98   w#event#connect#key_press ~callback:
99     begin fun ev ->
100       let key = GdkEvent.Key.keyval ev in
101       if key = _Left then planet#year_subtract () else
102       if key = _Right then planet#year_add () else
103       if key = _Up then planet#day_add () else
104       if key = _Down then planet#day_subtract () else
105       if key = _Escape then w#destroy ();
106       planet#display ();
107       true
108     end;
109   
110   Timeout.add ~ms:20 ~callback:
111     begin fun () ->
112       planet#tick (Sys.time ()); planet#display (); true
113     end;
114   area#connect#display ~callback:planet#display;
115   area#connect#reshape ~callback:my_reshape;
116
117   area#connect#realize ~callback:
118     begin fun () ->
119       myinit ();
120       my_reshape ~width:700 ~height:500
121     end;
122   w#show ();
123   Main.main ()
124
125 let _ = Printexc.print main ()