-(* $Id$ *)
-
-class planet area = object (self)
- val area : GlGtk.area = area
- 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 ();
- area#swap_buffers ()
-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 ~f:(GlLight.light ~num:0)
- [ `ambient light_ambient; `diffuse light_diffuse;
- `specular light_specular; `position light_position ];
- GlFunc.depth_func `less;
- List.iter ~f:Gl.enable [`lighting; `light0; `depth_test];
- GlDraw.shade_model `smooth
-
-
-let my_reshape ~width:w ~height:h =
- 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 GMain
-open GdkKeysyms
-
-let main () =
- let w = GWindow.window ~title:"Planet" () in
- w#connect#destroy ~callback:(fun () -> Main.quit (); exit 0);
- w#set_resize_mode `IMMEDIATE;
- let hb = GPack.hbox ~packing:w#add () in
- let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 1]
- ~width:700 ~height:500 ~packing:hb#add () in
- area#event#add [`KEY_PRESS];
-
- let planet = new planet area in
- let adjustment = GData.adjustment ~value:0. ~lower:(-90.) ~upper:90.
- ~step_incr:1. ~page_incr:5. ~page_size:5. () in
- let scale = GRange.scale `VERTICAL ~adjustment ~draw_value:false
- ~packing:hb#pack () in
- adjustment#connect#value_changed
- ~callback:(fun () -> planet#eye adjustment#value);
- w#event#connect#key_press ~callback:
- begin fun ev ->
- let key = GdkEvent.Key.keyval ev in
- if key = _Left then planet#year_subtract () else
- if key = _Right then planet#year_add () else
- if key = _Up then planet#day_add () else
- if key = _Down then planet#day_subtract () else
- if key = _Escape then w#destroy ();
- planet#display ();
- true
- end;
-
- Timeout.add ~ms:20 ~callback:
- begin fun () ->
- planet#tick (Sys.time ()); planet#display (); true
- end;
- area#connect#display ~callback:planet#display;
- area#connect#reshape ~callback:my_reshape;
-
- area#connect#realize ~callback:
- begin fun () ->
- myinit ();
- my_reshape ~width:700 ~height:500
- end;
- w#show ();
- Main.main ()
-
-let _ = Printexc.print main ()