Initial revision

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / examples / GL / planet.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/GL/planet.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/GL/planet.ml
new file mode 100644 (file)
index 0000000..51f947c
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/GL/planet.ml
@@ -0,0 +1,125 @@
+(* $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 ()