3 class planet area = object (self)
4 val area : GlGtk.area = area
10 method tick new_time =
11 if time = 0. then time <- new_time else
12 let diff = new_time -. time in
14 day <- mod_float (day +. diff *. 200.) 360.0;
15 year <- mod_float (year +. diff *. 20.) 360.0
17 day <- mod_float (day +. 10.0) 360.0
18 method day_subtract () =
19 day <- mod_float (day -. 10.0) 360.0
21 year <- mod_float (year +. 5.0) 360.0
22 method year_subtract () =
23 year <- mod_float (year -. 5.0) 360.0
25 eye <- x; self#display ()
28 GlClear.clear [`color;`depth];
30 GlDraw.color (1.0, 1.0, 1.0);
32 GlMat.rotate ~angle:eye ~x:1. ();
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;
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
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
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) ()
76 * Open window with initial window size, title bar,
77 * RGBA display mode, and handle input events.
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];
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:
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 ();
110 Timeout.add ~ms:20 ~callback:
112 planet#tick (Sys.time ()); planet#display (); true
114 area#connect#display ~callback:planet#display;
115 area#connect#reshape ~callback:my_reshape;
117 area#connect#realize ~callback:
120 my_reshape ~width:700 ~height:500
125 let _ = Printexc.print main ()