X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2FGL%2Fplanet.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2FGL%2Fplanet.ml;h=0000000000000000000000000000000000000000;hp=51f947c485993838a5db0fddddea5ccdf74fb1fb;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/GL/planet.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/GL/planet.ml deleted file mode 100644 index 51f947c48..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/GL/planet.ml +++ /dev/null @@ -1,125 +0,0 @@ -(* $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 ()