helm/DEVEL/lablgtk/lablgtk_20000829-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 ()