Mirrors_Framework/paparazzi
1
0
Fork 0
mirror of https://github.com/paparazzi/paparazzi.git synced 2026-05-09 22:49:53 +08:00
Code Issues Actions 29 Packages Projects Releases Wiki Activity

[ocaml] fix warnings in ubuntu 22.04

Browse Source
This commit is contained in:
Gautier Hattenberger
2023-02-09 14:04:40 +01:00
committed by Fabien-B
parent cf150db155
commit 8dafb7840a
36 changed files with 181 additions and 181 deletions
Download Patch File Download Diff File Expand all files Collapse all files
sw/ground_segment/cockpit/editFP.ml
+6 -6
View File
@@ -24,7 +24,7 @@ let current_fp = ref None
let if_none = fun f ->
match !current_fp with
Some _ ->
GToolbox.message_box "Error" "Only one editable flight plan at a time"
GToolbox.message_box ~title:"Error" "Only one editable flight plan at a time"
| None ->
f ()
@@ -134,7 +134,7 @@ let new_fp = fun geomap editor_frame accel_group () ->
let loading_error = fun xml_file e ->
let m = sprintf "Error while loading %s:\n%s" xml_file e in
GToolbox.message_box "Error" m
GToolbox.message_box ~title:"Error" m
@@ -161,7 +161,7 @@ let load_fp = fun geomap editor_frame accel_group () ->
let create_wp = fun geomap geo ->
match !current_fp with
None ->
GToolbox.message_box "Error" "Load a flight plan first";
GToolbox.message_box ~title:"Error" "Load a flight plan first";
failwith "create_wp"
| Some (fp,_) ->
let w = fp#add_waypoint geo in
@@ -179,7 +179,7 @@ let ref_point_of_waypoint = fun xml ->
(** Calibration of chosen image (requires a dummy flight plan) *)
let calibrate_map = fun (geomap:MapCanvas.widget) editor_frame accel_group () ->
match !current_fp with
| Some (_fp,_) -> GToolbox.message_box "Error" "Close current flight plan before calibration"
| Some (_fp,_) -> GToolbox.message_box ~title:"Error" "Close current flight plan before calibration"
| None ->
match GToolbox.select_file ~filename:(default_path_maps // "") ~title:"Open Image" () with
None -> ()
@@ -188,8 +188,8 @@ let calibrate_map = fun (geomap:MapCanvas.widget) editor_frame accel_group () ->
let pixbuf = GdkPixbuf.from_file image in
let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in
let (x0, y0) = geomap#canvas#get_scroll_offsets in
let (x,y) = geomap#canvas#window_to_world (float x0) (float y0) in
pix#move x y;
let (x,y) = geomap#canvas#window_to_world ~winx:(float x0) ~winy:(float y0) in
pix#move ~x ~y;
(** Open a dummy flight plan *)
let dummy_georef =
sw/ground_segment/cockpit/gcs.ml
+19 -19
View File
@@ -57,7 +57,7 @@ let display_map = fun (geomap:G.widget) xml_map ->
let opacity = try Some (int_of_string (Xml.attrib xml_map "opacity")) with _ -> None in
let current_projection = geomap#projection in
if map_projection <> current_projection then
GToolbox.message_box "Warning" (sprintf "You are loading a map in %s projection while the display use %s" map_projection current_projection);
GToolbox.message_box ~title:"Warning" (sprintf "You are loading a map in %s projection while the display use %s" map_projection current_projection);
let pix_ref = fun p ->
truncate (ExtXml.float_attrib p "x"), truncate (ExtXml.float_attrib p "y") in
@@ -85,9 +85,9 @@ let display_map = fun (geomap:G.widget) xml_map ->
| _ -> failwith (sprintf "display_map: two ref points required")
with
Xml.File_not_found f ->
GToolbox.message_box "Error" (sprintf "File does not exist: %s" f)
GToolbox.message_box ~title:"Error" (sprintf "File does not exist: %s" f)
| ExtXml.Error s ->
GToolbox.message_box "Error" (sprintf "Error in XML file: %s" s)
GToolbox.message_box ~title:"Error" (sprintf "Error in XML file: %s" s)
@@ -104,7 +104,7 @@ let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se ->
None -> ()
| Some xml_file ->
let jpg = Filename.chop_extension xml_file ^ ".png" in
GdkPixbuf.save jpg "png" pixbuf;
GdkPixbuf.save ~filename:jpg ~typ:"png" pixbuf;
let point = fun (x,y) wgs84 ->
Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in
let width = GdkPixbuf.get_width pixbuf
@@ -123,14 +123,14 @@ let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se ->
(****** Creates a calibrated map from the bitmap (selected region) ***********)
let map_from_region = fun (geomap:G.widget) () ->
match geomap#region with
None -> GToolbox.message_box "Error" "Select a region (shift-left drag)"
None -> GToolbox.message_box ~title:"Error" "Select a region (shift-left drag)"
| Some ((xw1,yw1), (xw2,yw2)) ->
let xw1, xw2 = min xw1 xw2, max xw1 xw2
and yw1, yw2 = min yw1 yw2, max yw1 yw2 in
let (xc1, yc1) = geomap#canvas#w2c xw1 yw1
and (xc2, yc2) = geomap#canvas#w2c xw2 yw2 in
let (xc1, yc1) = geomap#canvas#w2c ~wx:xw1 ~wy:yw1
and (xc2, yc2) = geomap#canvas#w2c ~wx:xw2 ~wy:yw2 in
let width = xc2-xc1 and height = yc2-yc1 in
let dest = GdkPixbuf.create width height () in
let dest = GdkPixbuf.create ~width ~height () in
let (x0, y0) = geomap#canvas#get_scroll_offsets in
let src_x = xc1 - x0 and src_y = yc1 - y0 in
GdkPixbuf.get_from_drawable ~dest ~width ~height ~src_x ~src_y
@@ -194,7 +194,7 @@ module GM = struct
(** Creates a calibrated map from the map tiles (selected region) *)
let map_from_tiles = fun (geomap:G.widget) () ->
match geomap#region with
None -> GToolbox.message_box "Error" "Select a region (shift-left drag)"
None -> GToolbox.message_box ~title:"Error" "Select a region (shift-left drag)"
| Some ((xw1,yw1), (xw2,yw2)) ->
let geo1 = geomap#of_world (xw1,yw1)
and geo2 = geomap#of_world (xw2,yw2) in
@@ -241,8 +241,8 @@ let fill_ortho = fun (geomap:G.widget) ->
(** First estimate the coverage of the window *)
let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window
and (xc0, yc0) = geomap#canvas#get_scroll_offsets in
let (xw0, yw0) = geomap#window_to_world (float xc0) (float (yc0+height_c))
and (xw1, yw1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in
let (xw0, yw0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c))
and (xw1, yw1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in
let sw = geomap#of_world (xw0, yw0)
and ne = geomap#of_world (xw1, yw1) in
let lbt2e_sw = lambertIIe_of sw
@@ -274,7 +274,7 @@ let button_press = fun (geomap:G.widget) ev ->
(** Display a map tile from map provider (Google, OSC, ..) or IGN *)
let xc = GdkEvent.Button.x ev
and yc = GdkEvent.Button.y ev in
let (xw,yw) = geomap#window_to_world xc yc in
let (xw,yw) = geomap#window_to_world ~winx:xc ~winy:yc in
let wgs84 = geomap#of_world (xw,yw) in
let display_ign = fun () ->
@@ -297,7 +297,7 @@ let button_press = fun (geomap:G.widget) ev ->
end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then (* create new wp on Ctrl-click *)
let xc = GdkEvent.Button.x ev in
let yc = GdkEvent.Button.y ev in
let xyw = geomap#canvas#window_to_world xc yc in
let xyw = geomap#canvas#window_to_world ~winx:xc ~winy:yc in
let geo = geomap#of_world xyw in
ignore (EditFP.create_wp geomap geo);
true
@@ -397,14 +397,14 @@ let create_geomap = fun switch_fullscreen editor_frame ->
let menu_fact = new GMenu.factory geomap#file_menu in
let accel_group = menu_fact#accel_group in
ignore (geomap#canvas#event#connect#button_press (button_press geomap));
ignore (geomap#canvas#event#connect#motion_notify (motion_notify geomap));
ignore (geomap#canvas#event#connect#any (any_event geomap));
ignore (geomap#canvas#event#connect#button_press ~callback:(button_press geomap));
ignore (geomap#canvas#event#connect#motion_notify ~callback:(motion_notify geomap));
ignore (geomap#canvas#event#connect#any ~callback:(any_event geomap));
ignore (menu_fact#add_check_item "Auto hide FP" ~callback:(fun hide -> Live.auto_hide_fp hide) ~active:!hide_fp);
ignore (menu_fact#add_item "Redraw" ~key:GdkKeysyms._L ~callback:(fun _ -> geomap#canvas#misc#draw None));
let fullscreen = menu_fact#add_image_item ~stock:(`STOCK "gtk-fullscreen") ~callback:switch_fullscreen () in
fullscreen#add_accelerator accel_group GdkKeysyms._F11;
fullscreen#add_accelerator ~group:accel_group GdkKeysyms._F11;
ignore (menu_fact#add_item "Quit" ~key:GdkKeysyms._Q ~callback:quit);
(* Maps handling *)
@@ -447,7 +447,7 @@ let create_geomap = fun switch_fullscreen editor_frame ->
let callback = fun _ -> GM.fill_tiles geomap in
ignore (map_menu_fact#add_item "Maps Fill" ~key:GdkKeysyms._G ~callback);
let b = GButton.button ~packing:geomap#toolbar#add () in
ignore (b#connect#clicked callback);
ignore (b#connect#clicked ~callback);
let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // "googleearth.png") in
ignore (GMisc.image ~pixbuf ~packing:b#add ());
let tooltips = GData.tooltips () in
@@ -818,7 +818,7 @@ let () =
if Sys.file_exists !file_to_edit then
EditFP.load_xml_file geomap editor_frame accel_group !file_to_edit
else
GToolbox.message_box "Error" (sprintf "Error: '%s' file does not exist\n%!" !file_to_edit);
GToolbox.message_box ~title:"Error" (sprintf "Error: '%s' file does not exist\n%!" !file_to_edit);
if !edit then
EditFP.set_window_title geomap;
sw/ground_segment/cockpit/horizon.ml
+1 -1
View File
@@ -211,7 +211,7 @@ object
mi#set [`TEXT (sprintf "%.1f" min_speed)];
mx#set [`TEXT (sprintf "%.1f" max_speed)]
initializer
ignore (speed#connect#event (function
ignore (speed#connect#event ~callback:(function
`BUTTON_PRESS _ev ->
max_speed <- 0.; min_speed <- max_float; true
| _ -> false))
sw/ground_segment/cockpit/lib/mapCanvas.ml
+36 -36
View File
@@ -281,16 +281,16 @@ object (self)
(** callback bindings *)
canvas#coerce#misc#modify_bg [`NORMAL, `BLACK];
ignore (background#connect#event self#background_event);
ignore (background#connect#event ~callback:self#background_event);
ignore (canvas#event#connect#motion_notify self#mouse_motion);
ignore (canvas#event#connect#after#key_press self#key_press) ;
ignore (canvas#event#connect#enter_notify (fun _ -> self#canvas#misc#grab_focus () ; false));
ignore (canvas#event#connect#any self#any_event);
ignore (adj#connect#value_changed (fun () -> if abs_float (adj#value -. zoom_level) >= 0.01 then self#zoom_in_center adj#value));
ignore (canvas#event#connect#motion_notify ~callback:self#mouse_motion);
ignore (canvas#event#connect#after#key_press ~callback:self#key_press) ;
ignore (canvas#event#connect#enter_notify ~callback:(fun _ -> self#canvas#misc#grab_focus () ; false));
ignore (canvas#event#connect#any ~callback:self#any_event);
ignore (adj#connect#value_changed ~callback:(fun () -> if abs_float (adj#value -. zoom_level) >= 0.01 then self#zoom_in_center adj#value));
canvas#set_center_scroll_region false ;
canvas#set_scroll_region (-25000000.) (-25000000.) 25000000. 25000000.;
canvas#set_scroll_region ~x1:(-25000000.) ~y1:(-25000000.) ~x2:25000000. ~y2:25000000.;
)
@@ -387,21 +387,21 @@ object (self)
method moveto = fun wgs84 ->
let (xw, yw) = self#world_of wgs84 in
let (xc, yc) = canvas#world_to_window xw yw in
canvas#scroll_to (truncate xc) (truncate yc)
let (xc, yc) = canvas#world_to_window ~wox:xw ~woy:yw in
canvas#scroll_to ~x:(truncate xc) ~y:(truncate yc)
method center = fun wgs84 ->
let (xw, yw) = self#world_of wgs84 in
let (xc, yc) = canvas#world_to_window xw yw in
let (xc, yc) = canvas#world_to_window ~wox:xw ~woy:yw in
let (xt, yt) = ((truncate xc), (truncate yc)) in
let sx_w, sy_w = Gdk.Drawable.get_size canvas#misc#window in
canvas#scroll_to (xt-sx_w/2) (yt-sy_w/2)
canvas#scroll_to ~x:(xt-sx_w/2) ~y:(yt-sy_w/2)
method get_center = fun () ->
let (x, y) = canvas#get_scroll_offsets
and (sx_w, sy_w) = Gdk.Drawable.get_size canvas#misc#window in
let xc = x + sx_w/2 and yc = y + sy_w/2 in
let (xw, yw) = canvas#window_to_world (float xc) (float yc) in
let (xw, yw) = canvas#window_to_world ~winx:(float xc) ~winy:(float yc) in
self#of_world (xw, yw)
@@ -428,7 +428,7 @@ object (self)
let scale = distance (xw1, yw1) (xw2, yw2) /. distance (x1,y1) (x2,y2) in
let a = atan2 (yw2-.yw1) (xw2-.xw1) -. atan2 (y2-.y1) (x2-.x1) in
let cos_a = cos a *. scale and sin_a = sin a *. scale in
pix#move xw1 yw1;
pix#move ~x:xw1 ~y:yw1;
pix#affine_relative [| cos_a; sin_a; -. sin_a; cos_a; 0.;0.|];
pix
@@ -449,7 +449,7 @@ object (self)
let xc = GdkEvent.Button.x ev
and yc = GdkEvent.Button.y ev
and state = GdkEvent.Button.state ev in
let (xw,yw) = self#window_to_world xc yc in
let (xw,yw) = self#window_to_world ~winx:xc ~winy:yc in
let (xw, yw) = self#fix_bg_coords (xw, yw) in
if Gdk.Convert.test_modifier `SHIFT state then begin
drawing <- Rectangle (xw,yw);
@@ -467,7 +467,7 @@ object (self)
begin
let xc = GdkEvent.Motion.x ev
and yc = GdkEvent.Motion.y ev in
let (xw, yw) = self#window_to_world xc yc in
let (xw, yw) = self#window_to_world ~winx:xc ~winy:yc in
let (xw, yw) = self#fix_bg_coords (xw, yw) in
match drawing with
Rectangle (x1,y1) ->
@@ -483,7 +483,7 @@ object (self)
let dx = zoom_level *. (xc -. x0)
and dy = zoom_level *. (yc -. y0) in
let (x, y) = canvas#get_scroll_offsets in
canvas#scroll_to (x-truncate dx) (y-truncate dy)
canvas#scroll_to ~x:(x-truncate dx) ~y:(y-truncate dy)
| _ -> ()
end;
false
@@ -491,7 +491,7 @@ object (self)
begin
let xc = GdkEvent.Button.x ev in
let yc = GdkEvent.Button.y ev in
let current_point = self#window_to_world xc yc in
let current_point = self#window_to_world ~winx:xc ~winy:yc in
let current_point = self#fix_bg_coords current_point in
match drawing with
Rectangle (x1,y1) ->
@@ -512,7 +512,7 @@ object (self)
if georef <> None then begin
let xc = GdkEvent.Motion.x ev
and yc = GdkEvent.Motion.y ev in
let (xw, yw) = self#window_to_world xc yc in
let (xw, yw) = self#window_to_world ~winx:xc ~winy:yc in
self#display_geo (self#of_world (xw,yw));
self#display_alt (self#of_world (xw,yw));
let (x, y) = canvas#get_scroll_offsets in
@@ -527,10 +527,10 @@ object (self)
method key_press = fun ev ->
let (x, y) = canvas#get_scroll_offsets in
match GdkEvent.Key.keyval ev with
| k when k = GdkKeysyms._Up -> canvas#scroll_to x (y-pan_step) ; true
| k when k = GdkKeysyms._Down -> canvas#scroll_to x (y+pan_step) ; true
| k when k = GdkKeysyms._Left -> canvas#scroll_to (x-pan_step) y ; true
| k when k = GdkKeysyms._Right -> canvas#scroll_to (x+pan_step) y ; true
| k when k = GdkKeysyms._Up -> canvas#scroll_to ~x ~y:(y-pan_step) ; true
| k when k = GdkKeysyms._Down -> canvas#scroll_to ~x ~y:(y+pan_step) ; true
| k when k = GdkKeysyms._Left -> canvas#scroll_to ~x:(x-pan_step) ~y ; true
| k when k = GdkKeysyms._Right -> canvas#scroll_to ~x:(x+pan_step) ~y ; true
| k when k = GdkKeysyms._f -> self#fit_to_window () ; true
| k when k = GdkKeysyms._Page_Up ->
self#zoom_up ();
@@ -552,12 +552,12 @@ object (self)
(* zoom keeping the area under the mouse pointer *)
method zoom_in_place = fun z ->
let (x, y) = canvas#get_scroll_offsets in
canvas#scroll_to (x+last_mouse_x) (y+last_mouse_y);
canvas#scroll_to ~x:(x+last_mouse_x) ~y:(y+last_mouse_y);
self#zoom z;
let (x, y) = canvas#get_scroll_offsets in
canvas#scroll_to (x-last_mouse_x) (y-last_mouse_y)
canvas#scroll_to ~x:(x-last_mouse_x) ~y:(y-last_mouse_y)
@@ -656,18 +656,18 @@ object (self)
initializer
let replace_still = fun _ ->
let (x, y) = canvas#get_scroll_offsets in
let (xc, yc) = canvas#window_to_world (float x) (float y) in
let (xc, yc) = canvas#window_to_world ~winx:(float x) ~winy:(float y) in
let z = 1./.zoom_level in
still#affine_absolute [|z;0.;0.;z;xc;yc|]
in
self#connect_view replace_still;
let move_timer = ref (Glib.Timeout.add 0 (fun _ -> false)) in
let move_timer = ref (Glib.Timeout.add ~ms:0 ~callback:(fun _ -> false)) in
let move dx dy = function
`BUTTON_PRESS _ ->
let scroll = fun _ ->
let (x, y) = canvas#get_scroll_offsets in
canvas#scroll_to (x+dx) (y+dy) ; true in
move_timer := Glib.Timeout.add 50 scroll;
canvas#scroll_to ~x:(x+dx) ~y:(y+dy) ; true in
move_timer := Glib.Timeout.add ~ms:50 ~callback:scroll;
true
| `BUTTON_RELEASE _ ->
Glib.Timeout.remove !move_timer;
@@ -677,10 +677,10 @@ object (self)
and down = move 0 pan_step
and left = move (-pan_step) 0
and right = move pan_step 0 in
ignore (north_arrow#connect#event up);
ignore (south_arrow#connect#event down);
ignore (west_arrow#connect#event left);
ignore (east_arrow#connect#event right)
ignore (north_arrow#connect#event ~callback:up);
ignore (south_arrow#connect#event ~callback:down);
ignore (west_arrow#connect#event ~callback:left);
ignore (east_arrow#connect#event ~callback:right)
end
@@ -725,7 +725,7 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () ->
tooltips#set_tip srtm#coerce ~text:"Display SRTM alt at pointer position (will request for download if not available)";
let b = GButton.button ~packing:toolbar#add () in
ignore (b#connect#clicked (fun _ -> bg_menu#activate ()));
ignore (b#connect#clicked ~callback:(fun _ -> bg_menu#activate ()));
let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // "switch_background.png") in
ignore (GMisc.image ~pixbuf ~packing:b#add ());
tooltips#set_tip b#coerce ~text:"Toggle background";
@@ -735,7 +735,7 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () ->
let callback = self#fit_to_window in
my_menu_item "Fit to window (f)" ~callback ~packing:self#file_menu#append ();
let b = GButton.button ~packing:toolbar#add () in
ignore (b#connect#clicked callback);
ignore (b#connect#clicked ~callback);
ignore (GMisc.image ~stock:(`STOCK "gtk-zoom-fit") ~packing:b#add ());
tooltips#set_tip b#coerce ~text:"Fit to window";
@@ -791,7 +791,7 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () ->
srtm#set_active false;
(*GToolbox.message_box "SRTM" (sprintf "SRTM tile %s not found: %s ?" x (Srtm.error x));*)
let msg = (sprintf "Oups, I can't find SRTM tile %s.\nCan I try to donwload it ?\n(%s)" x (Srtm.error x)) in
match GToolbox.question_box "SRTM" ["Download"; "Cancel"] msg with
match GToolbox.question_box ~title:"SRTM" ~buttons:["Download"; "Cancel"] msg with
| 1 ->
begin try
let tile_zip = x^".SRTMGL1.hgt.zip" in
@@ -804,7 +804,7 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () ->
self#altitude wgs84
with
| Http.Failure _ | Srtm.Tile_not_found _ ->
GToolbox.message_box "SRTM" ("Sorry, tile "^x^" couldn't be downloaded");
GToolbox.message_box ~title:"SRTM" ("Sorry, tile "^x^" couldn't be downloaded");
0
end
| _ -> 0
sw/ground_segment/cockpit/lib/mapGoogle.ml
+2 -2
View File
@@ -114,8 +114,8 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel ->
(** First estimate the coverage of the window *)
let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window
and (xc0, yc0) = geomap#canvas#get_scroll_offsets in
let (xw0, yw0) = geomap#window_to_world (float xc0) (float (yc0+height_c))
and (xw1, yw1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in
let (xw0, yw0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c))
and (xw1, yw1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in
let sw = geomap#of_world (xw0, yw0)
and ne = geomap#of_world (xw1, yw1) in
let west = sw.LL.posn_long /. LL.pi
sw/ground_segment/cockpit/lib/mapTrack.ml
+3 -3
View File
@@ -320,14 +320,14 @@ object (self)
| _ -> ()
end;
true
initializer ignore(aircraft#connect#event self#event)
initializer ignore(aircraft#connect#event ~callback:self#event)
method set_event_cb = fun (cb: string -> unit) -> event_cb <- Some cb
initializer
(* could not properly disconnect adjustment signal, so only calling zoom method if group is still displayed *)
ignore(geomap#zoom_adj#connect#value_changed (fun () -> if not destroyed then self#zoom geomap#zoom_adj#value));
ignore(group#connect#destroy (fun () -> destroyed <- true))
ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () -> if not destroyed then self#zoom geomap#zoom_adj#value));
ignore(group#connect#destroy ~callback:(fun () -> destroyed <- true))
(* destroy method *)
method destroy = fun () -> group#destroy ()
sw/ground_segment/cockpit/lib/mapWaypoints.ml
+6 -6
View File
@@ -63,7 +63,7 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.)
let anim = function
None ->
Some (Glib.Timeout.add 500 (fun () -> Gdk.X.beep (); item#affine_relative rotation_45; true))
Some (Glib.Timeout.add ~ms:500 ~callback:(fun () -> Gdk.X.beep (); item#affine_relative rotation_45; true))
| Some x -> Some x in
@@ -97,7 +97,7 @@ object (self)
method label = label
method xy = let a = wpt_group#i2w_affine in (a.(4), a.(5))
method move dx dy =
wpt_group#move dx dy;
wpt_group#move ~x:dx ~y:dy;
wpt_group#raise_to_top ()
method edit =
let dialog = GWindow.window ~type_hint:`DIALOG ~modal:true ~position:`MOUSE ~border_width:10 ~title:"Waypoint Edit" () in
@@ -152,8 +152,8 @@ object (self)
let plus10= GButton.button ~label:"+10" ~packing:ha#add () in
let change_alt = fun x ->
ea#set_value (ea#value +. x) in
ignore(minus10#connect#pressed (fun _ -> change_alt (-10.)));
ignore(plus10#connect#pressed (fun _ -> change_alt (10.)));
ignore(minus10#connect#pressed ~callback:(fun _ -> change_alt (-10.)));
ignore(plus10#connect#pressed ~callback:(fun _ -> change_alt (10.)));
(* called when ok button is clicked in WP Edit dialog *)
let callback = fun _ ->
@@ -254,7 +254,7 @@ object (self)
| _ -> ()
end;
true
initializer ignore(item#connect#event self#event)
initializer ignore(item#connect#event ~callback:self#event)
method moved = moved <> None
method reset_moved () =
match moved with
@@ -299,7 +299,7 @@ object (self)
wpt_group#affine_absolute a
initializer wpt_group#raise_to_top ()
initializer self#zoom geomap#zoom_adj#value
initializer ignore(geomap#zoom_adj#connect#value_changed (fun () -> self#zoom geomap#zoom_adj#value))
initializer ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () -> self#zoom geomap#zoom_adj#value))
end
let gensym = let n = ref 0 in fun prefix -> incr n; prefix ^ string_of_int !n
sw/ground_segment/cockpit/lib/papget.ml
+14 -14
View File
@@ -188,8 +188,8 @@ object (self)
method renderer = renderer
method xy =
let (x0, y0) = renderer#item#i2w 0. 0. in
renderer#item#parent#w2i x0 y0
let (x0, y0) = renderer#item#i2w ~x:0. ~y:0. in
renderer#item#parent#w2i ~x:x0 ~y:y0
method deleted = deleted
@@ -208,9 +208,9 @@ object (self)
| 1 ->
motion <- false;
let x = GdkEvent.Button.x ev and y = GdkEvent.Button.y ev in
let (xm, ym) = renderer#item#parent#w2i x y in
let (x0, y0) = renderer#item#i2w 0. 0. in
let (xi, yi) = renderer#item#parent#w2i x0 y0 in
let (xm, ym) = renderer#item#parent#w2i ~x ~y in
let (x0, y0) = renderer#item#i2w ~x:0. ~y:0. in
let (xi, yi) = renderer#item#parent#w2i ~x:x0 ~y:y0 in
x_press <- xm -. xi; y_press <- ym -. yi;
let curs = Gdk.Cursor.create `FLEUR in
item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs
@@ -224,7 +224,7 @@ object (self)
motion <- true;
let x = GdkEvent.Motion.x ev
and y = GdkEvent.Motion.y ev in
let (xw, yw) = renderer#item#parent#w2i x y in
let (xw, yw) = renderer#item#parent#w2i ~x ~y in
item#set [`X (xw-.x_press); `Y (yw-.y_press)];
renderer#item#parent#affine_relative [|1.;0.;0.;1.;0.;0.|]
end;
@@ -281,7 +281,7 @@ object (self)
(* Connect the renderer chooser *)
ignore (combo#connect#changed
(fun () ->
~callback:(fun () ->
match combo#active_iter with
| None -> ()
| Some row ->
@@ -289,8 +289,8 @@ object (self)
if data <> renderer#tag then
let new_renderer = List.assoc data tagged_renderers in
let group = renderer#item#parent in
let (x, y) = renderer#item#i2w 0. 0. in
let (x, y) = group#w2i x y in
let (x, y) = renderer#item#i2w ~x:0. ~y:0. in
let (x, y) = group#w2i ~x ~y in
renderer#item#destroy ();
renderer <- new_renderer group x y;
self#connect ();
@@ -298,20 +298,20 @@ object (self)
(* Connect the buttons *)
ignore (dialog#button_delete#connect#clicked
(fun () ->
~callback:(fun () ->
dialog#papget_editor#destroy ();
renderer#item#destroy ();
deleted <- true));
ignore (dialog#button_ok#connect#clicked (fun () -> dialog#papget_editor#destroy ()));
ignore (dialog#button_ok#connect#clicked ~callback:(fun () -> dialog#papget_editor#destroy ()));
dialog_widget <- Some dialog
val mutable connection =
canvas_renderer#item#connect#event (fun _ -> false)
canvas_renderer#item#connect#event ~callback:(fun _ -> false)
method connect = fun () ->
if PC.get_prop "locked" config "false" = "false" then
let item = (renderer#item :> PR.movable_item) in
connection <- item#connect#event self#event
connection <- item#connect#event ~callback:self#event
initializer
self#connect ()
@@ -419,5 +419,5 @@ object (self)
"display", String.lowercase_ascii item#renderer#tag;
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
Xml.Element ("papget", attrs, properties@props)
initializer ignore(adj#connect#value_changed (fun () -> self#update_zoom (string_of_float adj#value)))
initializer ignore(adj#connect#value_changed ~callback:(fun () -> self#update_zoom (string_of_float adj#value)))
end
sw/ground_segment/cockpit/lib/xmlEdit.ml
+1 -1
View File
@@ -323,7 +323,7 @@ let add_context_menu = fun model view ?noselection_menu menu ->
| _ -> false)
let add_delete_key = fun (model:GTree.tree_store) (view:GTree.view) ->
view#event#connect#key_press (fun ev ->
view#event#connect#key_press ~callback:(fun ev ->
if GdkEvent.Key.keyval ev = GdkKeysyms._Delete then
match view#selection#get_selected_rows with
path::_ ->
sw/ground_segment/cockpit/live.ml
+21 -21
View File
@@ -322,11 +322,11 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
None -> geomap#canvas#coerce
| Some pf -> pf#coerce in
let width, height = Gdk.Drawable.get_size frame#misc#window in
let dest = GdkPixbuf.create width height() in
let dest = GdkPixbuf.create ~width ~height() in
GdkPixbuf.get_from_drawable ~dest ~width ~height frame#misc#window;
let name = sprintf "Snapshot-%s-%d_%f_%f_%f.png" ac_id !i lat long (track#last_heading) in
let png = sprintf "%s/var/logs/%s" Env.paparazzi_home name in
GdkPixbuf.save png "png" dest;
GdkPixbuf.save ~filename:png ~typ:"png" dest;
incr i;
(* Computing the footprint: front_left and back_right *)
@@ -340,7 +340,7 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
and (xbr,ybr) = rotate a (width/.2., -.height/.2.) in
let geo_FL = of_utm WGS84 (utm_add utm (xfl,yfl))
and geo_BR = of_utm WGS84 (utm_add utm (xbr,ybr)) in
ignore (point#connect#event (show_snapshot geomap geo_FL geo_BR point dest name))
ignore (point#connect#event ~callback:(show_snapshot geomap geo_FL geo_BR point dest name))
end
| None -> ()
@@ -489,7 +489,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
ac_mi#set_submenu ac_menu;
let ac_menu_fact = new GMenu.factory ac_menu in
let fp_show = ac_menu_fact#add_check_item "Fligh Plan" ~active:true in
ignore (fp_show#connect#toggled (fun () -> show_mission ac_id fp_show#active));
ignore (fp_show#connect#toggled ~callback:(fun () -> show_mission ac_id fp_show#active));
let (icon, size) = get_icon_and_track_size af_xml in
let track = new MapTrack.track ~size ~icon ~name ~color:color ac_id geomap in
@@ -515,9 +515,9 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
GToolbox.build_menu sm ~entries:dl_menu;
let cam = ac_menu_fact#add_check_item "Cam footprint" ~active:false in
ignore (cam#connect#toggled (fun () -> track#set_cam_state cam#active));
ignore (cam#connect#toggled ~callback:(fun () -> track#set_cam_state cam#active));
let params = ac_menu_fact#add_check_item "A/C label" ~active:false in
ignore (params#connect#toggled (fun () -> track#set_params_state params#active));
ignore (params#connect#toggled ~callback:(fun () -> track#set_params_state params#active));
(** Add a new tab in the A/Cs notebook, with a colored label *)
let eb = GBin.event_box () in
@@ -554,7 +554,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
let block = XmlEdit.attrib node "name" in
let id = list_casso block blocks in
jump_to_block ac_id id);
ignore (reset_wp_menu#connect#activate (reset_waypoints fp));
ignore (reset_wp_menu#connect#activate ~callback:(reset_waypoints fp));
(** Monitor waypoints changes *)
List.iter
@@ -611,7 +611,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
GButton.button ~label ()
in
strip#add_widget b#coerce ~group;
ignore (b#connect#clicked (fun _ -> jump_to_block ac_id id))
ignore (b#connect#clicked ~callback:(fun _ -> jump_to_block ac_id id))
with
_ -> ())
(Xml.children (ExtXml.child (ExtXml.child fp_xml_dump "flight_plan") "blocks"));
@@ -619,7 +619,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
(** Handle key shortcuts for block selection *)
let key_press = key_press_event !keys (fun block_id -> jump_to_block ac_id block_id) in
ignore (geomap#canvas#event#connect#after#key_press key_press);
ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press);
(** Insert the flight plan tab *)
@@ -678,14 +678,14 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
(** Connect key shortcuts *)
let key_press = fun ev ->
key_press_event settings_tab#keys (fun commit -> commit ()) ev in
ignore (geomap#canvas#event#connect#after#key_press key_press);
ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press);
let tab_label = GPack.hbox () in
let _label = (GMisc.label ~text:"Settings" ~packing:tab_label#pack ()) in
let button_save_settings = GButton.button ~packing:tab_label#pack () in
ignore (GMisc.image ~stock:`SAVE ~packing:button_save_settings#add ());
button_save_settings#set_border_width 0;
ignore (button_save_settings#connect#clicked (fun () -> settings_tab#save af_file));
ignore (button_save_settings#connect#clicked ~callback:(fun () -> settings_tab#save af_file));
ignore (ac_notebook#append_page ~tab_label:tab_label#coerce settings_tab#widget);
Some settings_tab
with exc ->
@@ -771,7 +771,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
in
if is_int ac_id then
ignore (Glib.Timeout.add 10000 send_wind);
ignore (Glib.Timeout.add ~ms:10000 ~callback:send_wind);
begin
match dl_settings_page with
@@ -815,7 +815,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
with _ -> () end;
true
in
ignore (Glib.Timeout.add 1000 set_appointment)
ignore (Glib.Timeout.add ~ms:1000 ~callback:set_appointment)
with Not_found -> ()
end;
@@ -836,7 +836,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
if ac.got_track_status_timer > 5 then
ac.track#delete_desired_track ();
true in
ignore (Glib.Timeout.add 1000 monitor_track_status);;
ignore (Glib.Timeout.add ~ms:1000 ~callback:monitor_track_status);;
(* since tcl8.6 "green" refers to "darkgreen" and the former "green" is now "lime", but that is not available in older versions, so hardcode the color to #00ff00*)
@@ -1016,8 +1016,8 @@ let draw_altgraph = fun (da_object:Gtk_tools.pixmap_in_drawin_area) (geomap:MapC
(** First estimate the coverage of the window *)
let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window in
let (xc0, yc0) = geomap#canvas#get_scroll_offsets in
let (east, _y0) = geomap#window_to_world (float xc0) (float (yc0+height_c))
and (west, _y1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in
let (east, _y0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c))
and (west, _y1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in
let da = da_object#drawing_area in
let width, height = Gdk.Drawable.get_size da#misc#window in
@@ -1137,7 +1137,7 @@ module GCS_icon = struct
~x1: ~-.radius ~y1: ~-.radius ~x2:radius ~y2:radius
geomap#canvas#root in
(* connect callback on zoom change *)
ignore(geomap#zoom_adj#connect#value_changed (fun () ->
ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () ->
match !status with
| None -> ()
| Some (item, _, wgs84) -> geomap#move_item ~z:geomap#current_zoom item wgs84
@@ -1149,7 +1149,7 @@ module GCS_icon = struct
item#set [`OUTLINE_COLOR color];
let change_color_if_not_updated =
Glib.Timeout.add 10000 (fun () -> item#set [`OUTLINE_COLOR outdated_color]; false) in
Glib.Timeout.add ~ms:10000 ~callback:(fun () -> item#set [`OUTLINE_COLOR outdated_color]; false) in
(* Store the object, the position and the timeout to change its color *)
status := Some (item, change_color_if_not_updated, wgs84);
@@ -1549,7 +1549,7 @@ let listen_acs_and_msgs = fun geomap ac_notebook strips confirm_kill my_alert au
(** Probe live A/Cs *)
let probe = fun () ->
ignore(message_request "gcs" "AIRCRAFTS" [] (fun _sender vs -> _req_aircrafts := false; aircrafts_msg confirm_kill my_alert geomap ac_notebook strips vs)) in
let _ = GMain.Timeout.add 1000 (fun () -> probe (); !_req_aircrafts) in
let _ = GMain.Timeout.add ~ms:1000 ~callback:(fun () -> probe (); !_req_aircrafts) in
(** New aircraft message *)
safe_bind "NEW_AIRCRAFT" (fun _sender vs -> one_new_ac confirm_kill my_alert geomap ac_notebook strips (PprzLink.string_assoc "ac_id" vs));
@@ -1591,7 +1591,7 @@ let listen_acs_and_msgs = fun geomap ac_notebook strips confirm_kill my_alert au
match GdkEvent.Key.keyval ev with
| k when (k = GdkKeysyms._c) || (k = GdkKeysyms._C) -> center_active () ; true
| _ -> false in
ignore (geomap#canvas#event#connect#after#key_press key_press);
ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press);
(* call periodic_handle_intruders every second *)
ignore (Glib.Timeout.add 1000 (fun () -> Intruders.remove_old_intruders (); true));
ignore (Glib.Timeout.add ~ms:1000 ~callback:(fun () -> Intruders.remove_old_intruders (); true));
sw/ground_segment/cockpit/page_settings.ml
+3 -3
View File
@@ -175,7 +175,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
let b = GButton.radio_button ~group ~label ~packing:hbox#add () in
(* Connect the event *)
ignore (b#connect#pressed (fun () -> update_value (ilower + j)));
ignore (b#connect#pressed ~callback:(fun () -> update_value (ilower + j)));
b) in
(callback, fun j -> try buttons.(truncate j - ilower)#set_active true with _ -> ())
else (* no values given, slider or spin button *)
@@ -244,7 +244,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
tooltips#set_tip undo_but#coerce ~text:"Undo";
ignore (auto_but#connect#toggled
(fun () ->
~callback:(fun () ->
commit_but#misc#set_sensitive (not auto_but#active);
undo_but#misc#set_sensitive (not auto_but#active)));
@@ -279,7 +279,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
prerr_endline (Printexc.to_string exc);
GButton.button ~label () in
(strip group b#coerce: unit);
ignore (b#connect#clicked (fun _ -> do_change i sp_value))
ignore (b#connect#clicked ~callback:(fun _ -> do_change i sp_value))
| "key_press" -> add_key x (do_change i) keys
| t -> failwith (sprintf "Page_settings.one_setting, Unexpected tag: '%s'" t))
(Xml.children dl_setting);
sw/ground_segment/cockpit/pages.ml
+3 -3
View File
@@ -131,9 +131,9 @@ object
method connect_reset = fun (callback:int -> unit) ->
hbox#misc#show ();
ignore (hot#connect#clicked (fun () -> callback 0));
ignore (warm#connect#clicked (fun () -> callback 1));
ignore (cold#connect#clicked (fun () -> callback 2))
ignore (hot#connect#clicked ~callback:(fun () -> callback 0));
ignore (warm#connect#clicked ~callback:(fun () -> callback 1));
ignore (cold#connect#clicked ~callback:(fun () -> callback 2))
method svsinfo pacc a =
if visible widget then
sw/ground_segment/cockpit/saveSettings.ml
+3 -3
View File
@@ -229,10 +229,10 @@ let popup = fun airframe_filename settings send_value ->
fill_data model settings airframe_xml;
(** The Cancel button *)
ignore (w#button_cancel#connect#clicked (fun () -> w#save_settings#destroy ()));
ignore (w#button_cancel#connect#clicked ~callback:(fun () -> w#save_settings#destroy ()));
(** Connect the Save button to the write action *)
ignore (w#button_upload#connect#clicked (fun ()-> send_airframe_values model send_value));
ignore (w#button_upload#connect#clicked ~callback:(fun ()-> send_airframe_values model send_value));
(** Connect the Save button to the write action *)
ignore (w#button_save#connect#clicked (fun () -> save_airframe w airframe_filename (write_xml model airframe_filename airframe_xml)))
ignore (w#button_save#connect#clicked ~callback:(fun () -> save_airframe w airframe_filename (write_xml model airframe_filename airframe_xml)))
sw/ground_segment/cockpit/sectors.ml
+2 -2
View File
@@ -38,7 +38,7 @@ let load = fun geomap () ->
with
Dtd.Prove_error(e) ->
let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in
GToolbox.message_box "Error" m
GToolbox.message_box ~title:"Error" m
let load_kml = fun geomap () ->
match GToolbox.select_file ~title:"Load KML" ~filename:(Env.flight_plans_path // "*.kml") () with
@@ -50,4 +50,4 @@ let load_kml = fun geomap () ->
with
| Dtd.Prove_error(e) ->
let m = sprintf "Error while loading KML %s:\n%s" f (Dtd.prove_error e) in
GToolbox.message_box "Error" m
GToolbox.message_box ~title:"Error" m
sw/ground_segment/cockpit/strip.ml
+4 -4
View File
@@ -276,7 +276,7 @@ let add = fun config strip_param (strips:GPack.box) ->
let connect_buttons = fun callback ->
List.iter (fun ((button:GButton.button), value) ->
ignore (button#connect#clicked (fun () -> callback value));
ignore (button#connect#clicked ~callback:(fun () -> callback value));
button#misc#set_sensitive true) in
(* Buttons : setting the icons (the path of the icon is not saved by glade) *)
@@ -323,7 +323,7 @@ object
tooltips#set_tip strip#eventbox_speed#coerce ~text
method connect_mark callback =
ignore (strip#button_mark#connect#clicked callback)
ignore (strip#button_mark#connect#clicked ~callback)
method set_label name value = set_label !strip_labels name value
method set_color name value = set_color !strip_labels name value
@@ -404,7 +404,7 @@ object
let utc = Unix.gmtime (get_ac_unix_time () +. 60.) in
w#spinbutton_hour#set_value (float utc.Unix.tm_hour);
w#spinbutton_min#set_value (float utc.Unix.tm_min);
ignore (w#button_cancel#connect#clicked (fun () -> w#setting_time#destroy ()));
ignore (w#button_cancel#connect#clicked ~callback:(fun () -> w#setting_time#destroy ()));
let callback = fun () ->
let hour = truncate w#spinbutton_hour#value
and min = truncate w#spinbutton_min#value
@@ -412,7 +412,7 @@ object
w#setting_time#destroy ();
let tow = Latlong.gps_tow_of_utc hour min sec in
send_value (float tow) in
ignore (w#button_ok#connect#clicked callback);
ignore (w#button_ok#connect#clicked ~callback);
true
in
ignore(strip#eventbox_RDV#event#connect#button_press ~callback)
sw/ground_segment/joystick/input2ivy.ml
+1 -1
View File
@@ -642,7 +642,7 @@ let () =
ignore (Unix.select [] [] [] 0.1)
done;
ignore (Glib.Timeout.add actions.period_ms (fun () -> execute_actions actions ac_id; true));
ignore (Glib.Timeout.add ~ms:actions.period_ms ~callback:(fun () -> execute_actions actions ac_id; true));
(*ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:(fun x -> execute_kb_action actions x) (Glib.Io.channel_of_descr Unix.stdin));*)
(** Start the main loop *)
sw/ground_segment/tmtc/broadcaster.ml
+2 -2
View File
@@ -39,9 +39,9 @@ let () =
true in
let ginput = GMain.Io.channel_of_descr (Unix.descr_of_in_channel i) in
ignore (Glib.Io.add_watch [`IN] get_tcp ginput);
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:get_tcp ginput);
let hangup = fun _ -> prerr_endline "hangup"; exit 1 in
ignore (Glib.Io.add_watch [`HUP] hangup ginput);
ignore (Glib.Io.add_watch ~cond:[`HUP] ~callback:hangup ginput);
(* Forward datalink on Tcp *)
let get_ivy = fun _ args ->
sw/ground_segment/tmtc/ivy2serial.ml
+2 -2
View File
@@ -107,8 +107,8 @@ let () =
let hangup = fun _ ->
prerr_endline "Serial link disconnected";
exit 1 in
ignore (Glib.Io.add_watch [`HUP] hangup (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch [`IN] get_datalink_message (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch ~cond:[`HUP] ~callback:hangup (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:get_datalink_message (GMain.Io.channel_of_descr fd));
(* Main Loop *)
GMain.main ()
sw/ground_segment/tmtc/ivy2udp.ml
+1 -1
View File
@@ -98,7 +98,7 @@ let () =
true in
let ginput = GMain.Io.channel_of_descr socket in
ignore (Glib.Io.add_watch [`IN] get_datalink_message ginput);
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:get_datalink_message ginput);
(* Main Loop *)
GMain.main ()
sw/ground_segment/tmtc/ivy_tcp_aircraft.ml
+2 -2
View File
@@ -64,10 +64,10 @@ let () =
true in
let ginput = GMain.Io.channel_of_descr (Unix.descr_of_in_channel i) in
ignore (Glib.Io.add_watch [`IN] get_datalink_message ginput);
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:get_datalink_message ginput);
let hangup = fun _ -> prerr_endline "hangup"; exit 1 in
ignore (Glib.Io.add_watch [`HUP] hangup ginput);
ignore (Glib.Io.add_watch ~cond:[`HUP] ~callback:hangup ginput);
(* Main Loop *)
GMain.main ()
sw/ground_segment/tmtc/ivy_tcp_controller.ml
+2 -2
View File
@@ -51,7 +51,7 @@ let () =
true in
let ginput = GMain.Io.channel_of_descr (Unix.descr_of_in_channel i) in
ignore (Glib.Io.add_watch [`IN] get_message ginput);
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:get_message ginput);
(* Forward datalink messages *)
let get_ivy_message = fun _ args ->
@@ -66,7 +66,7 @@ let () =
let _b = Ivy.bind get_ivy_message "^ground_dl (.*)" in
let hangup = fun _ -> prerr_endline "hangup"; exit 1 in
ignore (Glib.Io.add_watch [`HUP] hangup ginput);
ignore (Glib.Io.add_watch ~cond:[`HUP] ~callback:hangup ginput);
(* Main Loop *)
GMain.main ()
sw/ground_segment/tmtc/link.ml
+10 -10
View File
@@ -238,9 +238,9 @@ module XB = struct (** XBee module *)
let init = fun device ->
Debug.trace 'x' "init xbee";
let o = Unix.out_channel_of_descr device.fd in
ignore (Glib.Timeout.add at_init_period (fun () ->
ignore (Glib.Timeout.add ~ms:at_init_period ~callback:(fun () ->
fprintf o "%s%!" Xbee_transport.at_command_sequence;
ignore (Glib.Timeout.add at_init_period (fun () -> switch_to_api device; false));
ignore (Glib.Timeout.add ~ms:at_init_period ~callback:(fun () -> switch_to_api device; false));
false))
(* Array of sent packets for retry: (packet, nb of retries) *)
@@ -272,8 +272,8 @@ module XB = struct (** XBee module *)
if nb_prev_retries < !nb_retries then begin
packets.(frame_id) <- (packet, nb_prev_retries+1);
let o = Unix.out_channel_of_descr device.fd in
ignore (GMain.Timeout.add (10 + Random.int retry_delay)
(fun _ ->
ignore (GMain.Timeout.add ~ms:(10 + Random.int retry_delay)
~callback:(fun _ ->
fprintf o "%s%!" packet;
Debug.call 'y' (fun f -> fprintf f "Resending (%d) %s\n" (nb_prev_retries+1) (Debug.xprint packet));
false));
@@ -522,8 +522,8 @@ let () =
end;
true (* Returns true to be called again *)
in
ignore (Glib.Io.add_watch [`HUP] hangup (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch [`IN] read_fd (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch ~cond:[`HUP] ~callback:hangup (GMain.Io.channel_of_descr fd));
ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:read_fd (GMain.Io.channel_of_descr fd));
if !uplink then begin
message_uplink device
@@ -531,13 +531,13 @@ let () =
(** Init and Periodic tasks *)
begin
ignore (Glib.Timeout.add !status_msg_period (fun () -> send_status_msg (); true));
ignore (Glib.Timeout.add (!status_msg_period / 3) (fun () -> update_ms_since_last_msg (); true));
ignore (Glib.Timeout.add ~ms:!status_msg_period ~callback:(fun () -> send_status_msg (); true));
ignore (Glib.Timeout.add ~ms:(!status_msg_period / 3) ~callback:(fun () -> update_ms_since_last_msg (); true));
if !uplink then begin
let start_ping = fun () ->
ignore (Glib.Timeout.add !ping_msg_period (fun () -> send_ping_msg device; true));
ignore (Glib.Timeout.add ~ms:!ping_msg_period ~callback:(fun () -> send_ping_msg device; true));
false in
ignore (Glib.Timeout.add status_ping_diff start_ping);
ignore (Glib.Timeout.add ~ms:status_ping_diff ~callback:start_ping);
end;
match transport with
| XBee ->
sw/ground_segment/tmtc/messages.ml
+3 -3
View File
@@ -134,10 +134,10 @@ let one_page = fun sender class_name (notebook:GPack.notebook) (topnote:GPack.no
time#set_text t
end;
true in
ignore (GMain.Timeout.add 1000 update_time);
ignore (GMain.Timeout.add ~ms:1000 ~callback:update_time);
let display_values = fun () ->
List.iter (fun f -> f ()) display_values in
ignore (GMain.Timeout.add display_delay (fun () -> display_values (); true));
ignore (GMain.Timeout.add ~ms:display_delay ~callback:(fun () -> display_values (); true));
(** The message is shown only on its first arrival *)
let display = fun _sender values ->
@@ -162,7 +162,7 @@ let one_page = fun sender class_name (notebook:GPack.notebook) (topnote:GPack.no
List.iter2 (fun f x -> f x) update_values (List.rev values);
eb#coerce#misc#set_state `SELECTED;
ignore (GMain.Timeout.add led_delay (fun () -> eb#coerce#misc#set_state `NORMAL; false))
ignore (GMain.Timeout.add ~ms:led_delay ~callback:(fun () -> eb#coerce#misc#set_state `NORMAL; false))
with
Invalid_argument _ ->
Printf.fprintf stderr "%s: expected %d args, got %d\n" id n (List.length values); flush stderr
sw/ground_segment/tmtc/server.ml
+3 -3
View File
@@ -608,7 +608,7 @@ let new_aircraft = fun get_alive_md5sum real_id ->
| _ -> None (* more than one *)
with _ -> None);
ignore (Glib.Timeout.add 1000 (fun _ -> update (); true));
ignore (Glib.Timeout.add ~ms:1000 ~callback:(fun _ -> update (); true));
let messages_xml = ExtXml.parse_file (Env.paparazzi_home // root_dir // "var" // "messages.xml") in
ac, messages_xml
@@ -636,7 +636,7 @@ let wind_clear = fun _sender vs ->
Wind.clear (PprzLink.string_assoc "ac_id" vs)
let periodic = fun period cb ->
Glib.Timeout.add period (fun () -> cb (); true)
Glib.Timeout.add ~ms:period ~callback:(fun () -> cb (); true)
let register_periodic = fun ac x ->
@@ -973,7 +973,7 @@ let () =
ground_to_uplink logging;
(* call periodic_handle_intruders every second *)
ignore (Glib.Timeout.add 1000 (fun () -> periodic_handle_intruders (); true));
ignore (Glib.Timeout.add ~ms:1000 ~callback:(fun () -> periodic_handle_intruders (); true));
(* Waits for client configurations requests on the Ivy bus *)
ivy_server !http;
sw/lib/ocaml/gtk_tools.ml
+1 -1
View File
@@ -106,7 +106,7 @@ let select_in_combo = fun (combo : combo) string ->
let combo_connect = fun ((combo: #GEdit.combo_box), (_,column)) cb ->
ignore (combo#connect#changed
(fun () ->
~callback:(fun () ->
match combo#active_iter with
| None -> ()
| Some row ->
sw/logalizer/export.ml
+3 -3
View File
@@ -303,7 +303,7 @@ let popup = fun ?(no_gui = false) xml log_filename data ->
(* Connect the timestamp chooser to the period entry *)
ignore (combo#connect#changed
(fun () ->
~callback:(fun () ->
let data = get_timestamp () in
w#entry_period#misc#set_sensitive (data = "Periodic")));
@@ -319,7 +319,7 @@ let popup = fun ?(no_gui = false) xml log_filename data ->
| Some row ->
combo#model#get ~row ~column in
ignore (w#button_cancel#connect#clicked (fun () -> w#export#destroy ()));
ignore (w#button_cancel#connect#clicked ~callback:(fun () -> w#export#destroy ()));
(** Connect the Save button to the write action *)
let callback = fun () ->
@@ -339,7 +339,7 @@ let popup = fun ?(no_gui = false) xml log_filename data ->
do_export default_filename
else
save_values w default_filename do_export in
ignore (w#button_save#connect#clicked callback);
ignore (w#button_save#connect#clicked ~callback);
(** Call automatic export or show the popup window *)
if no_gui then begin
sw/logalizer/logplotter.ml
+4 -4
View File
@@ -795,11 +795,11 @@ let open_log = fun ?factor plot menubar curves_fact () ->
let screenshot = fun frame ->
let width, height = Gdk.Drawable.get_size frame#misc#window in
let dest = GdkPixbuf.create width height () in
let dest = GdkPixbuf.create ~width ~height () in
GdkPixbuf.get_from_drawable ~dest ~width ~height frame#misc#window;
save_dialog
"png"
(fun name -> GdkPixbuf.save name "png" dest)
(fun name -> GdkPixbuf.save ~filename:name ~typ:"png" dest)
@@ -859,7 +859,7 @@ let rec plot_window = fun ?export init ->
(* Auto Scale *)
let auto_scale = GButton.check_button ~label:"Auto Scale" ~active:true ~packing:h#pack () in
ignore (auto_scale#connect#toggled (fun () -> plot#set_auto_scale auto_scale#active));
ignore (auto_scale#connect#toggled ~callback:(fun () -> plot#set_auto_scale auto_scale#active));
let bounds = [
("Tmin", plot#min_x, plot#set_min_x);
("Tmax", plot#max_x, plot#set_max_x);
@@ -878,7 +878,7 @@ let rec plot_window = fun ?export init ->
let b = not auto_scale#active in
List.iter (fun entry -> entry#misc#set_sensitive b) entries in
ignore (auto_scale#connect#toggled active_min_maxs);
ignore (auto_scale#connect#toggled ~callback:active_min_maxs);
active_min_maxs ();
(* Constants *)
sw/logalizer/play_core.ml
+1 -1
View File
@@ -186,7 +186,7 @@ let run = fun serial_port log adj i0 speed no_gui ->
adj#set_value t;
if i + 1 < Array.length log then begin
let dt = time_of log.(i+1) -. t in
timer := Some (GMain.Timeout.add (truncate (1000. *. dt /. speed#value)) (fun () -> loop (i+1);false))
timer := Some (GMain.Timeout.add ~ms:(truncate (1000. *. dt /. speed#value)) ~callback:(fun () -> loop (i+1);false))
end else if no_gui then
exit 0
in
sw/logalizer/plotter.ml
+3 -3
View File
@@ -312,7 +312,7 @@ class plot = fun ~size ~update_time ~width ~height ~packing () ->
method set_update_time = fun delay ->
self#stop_timer ();
dt <- delay;
timer <- Some (GMain.Timeout.add (truncate (dt*.1000.)) (fun () ->self#update_curves (); true))
timer <- Some (GMain.Timeout.add ~ms:(truncate (dt*.1000.)) ~callback:(fun () ->self#update_curves (); true))
method button_press = fun ev ->
match GdkEvent.Button.button ev with
@@ -400,8 +400,8 @@ let rec plot_window = fun window ->
let _, max_entry= labelled_entry ~width_chars:5 "Max" "" h in
min_entry#misc#set_sensitive false;
max_entry#misc#set_sensitive false;
ignore (auto_scale#connect#toggled (fun () -> let b = auto_scale#active in plot#set_auto_scale b; min_entry#misc#set_sensitive (not b); max_entry#misc#set_sensitive (not b)));
ignore (GMain.Timeout.add 1000 (fun () -> if plot#auto_scale then begin min_entry#set_text (string_of_float plot#min); max_entry#set_text (string_of_float plot#max) end; true));
ignore (auto_scale#connect#toggled ~callback:(fun () -> let b = auto_scale#active in plot#set_auto_scale b; min_entry#misc#set_sensitive (not b); max_entry#misc#set_sensitive (not b)));
ignore (GMain.Timeout.add ~ms:1000 ~callback:(fun () -> if plot#auto_scale then begin min_entry#set_text (string_of_float plot#min); max_entry#set_text (string_of_float plot#max) end; true));
ignore (min_entry#connect#activate ~callback:(fun () -> if not plot#auto_scale then plot#set_min (float_of_string min_entry#text)));
ignore (max_entry#connect#activate ~callback:(fun () -> if not plot#auto_scale then plot#set_max (float_of_string max_entry#text)));
sw/simulator/gaia.ml
+3 -3
View File
@@ -83,11 +83,11 @@ let _ =
Ground_Pprz.message_send my_id "WORLD_ENV" (world_values []) in
List.iter
(fun (a:GData.adjustment) -> ignore (a#connect#value_changed world_send))
(fun (a:GData.adjustment) -> ignore (a#connect#value_changed ~callback:world_send))
[time_scale_adj; wind_dir_adj; wind_speed_adj; wind_up_adj; infrared_contrast_adj];
ignore (gps_sa#connect#toggled world_send);
ignore (gps_sa#connect#toggled ~callback:world_send);
ignore (Glib.Timeout.add sending_period (fun () -> world_send (); true));
ignore (Glib.Timeout.add ~ms:sending_period ~callback:(fun () -> world_send (); true));
let vbox = GPack.vbox ~packing:window#add () in
sw/simulator/sim.ml
+3 -3
View File
@@ -179,12 +179,12 @@ module Make(AircraftItl : AIRCRAFT_ITL) = struct
"alt", float gps_sol.Gps.alt ] in
let (b, flag) = Ground_Pprz.message_req "sim" "WORLD_ENV" values world_update in
(* unbind manually after 1s if no message received *)
ignore (GMain.Timeout.add 1000 (fun () -> if !flag then Ivy.unbind b; false))
ignore (GMain.Timeout.add ~ms:1000 ~callback:(fun () -> if !flag then Ivy.unbind b; false))
with
exc -> fprintf stderr "Error in sim: %s\n%!" (Printexc.to_string exc)
in
ignore (GMain.Timeout.add 1000 (fun () -> ask_for_world_env (); true));
ignore (GMain.Timeout.add ~ms:1000 ~callback:(fun () -> ask_for_world_env (); true));
let fm_task = fun () ->
@@ -308,7 +308,7 @@ module Make(AircraftItl : AIRCRAFT_ITL) = struct
false
end else
true in
ignore (GMain.Timeout.add 1000 monitor)
ignore (GMain.Timeout.add ~ms:1000 ~callback:monitor)
end else
take_off ();
sw/simulator/simlib.ml
+2 -2
View File
@@ -57,8 +57,8 @@ let timer ?scale p f =
f (); loop next
end else
GMain.Timeout.add
dt
(fun () ->
~ms:dt
~callback:(fun () ->
ignore (loop next);
f ();
false) in
sw/simulator/sitl.ml
+5 -5
View File
@@ -106,11 +106,11 @@ module Make (A:Data.MISSION) (FM: FlightModel.SIG) = struct
let _scale = GRange.scale `HORIZONTAL ~inverted:inv ~adjustment:adj ~packing:hbox#add () in
let update = fun () -> update_channel i adj#value in
ignore (adj#connect#value_changed update);
ignore (adj#connect#value_changed ~callback:update);
update ())
rc_channels;
(* github issue #821: people seems to want sliders always sensitive, even if RC is OFF *)
(* ignore (on_off#connect#toggled (fun () -> sliders#coerce#misc#set_sensitive on_off#active)); *)
(* ignore (on_off#connect#toggled ~callback:(fun () -> sliders#coerce#misc#set_sensitive on_off#active)); *)
on_off#set_active false;
@@ -145,7 +145,7 @@ module Make (A:Data.MISSION) (FM: FlightModel.SIG) = struct
hbox#pack bat_button#coerce;
let tips = GData.tooltips () in
tips#set_tip bat_button#coerce ~text:"Select for auto-decreasing voltage";
ignore (adj_bat#connect#value_changed update);
ignore (adj_bat#connect#value_changed ~callback:update);
update ();
(* Datalink status *)
@@ -154,7 +154,7 @@ module Make (A:Data.MISSION) (FM: FlightModel.SIG) = struct
hbox#pack dl_button#coerce;
let tips = GData.tooltips () in
tips#set_tip dl_button#coerce ~text:"Enable/disable communication with the aircraft";
ignore (dl_button#connect#toggled update);
ignore (dl_button#connect#toggled ~callback:update);
update();
(* ADC1 *)
@@ -164,7 +164,7 @@ module Make (A:Data.MISSION) (FM: FlightModel.SIG) = struct
let adj_adc1 = GData.adjustment ~value:512. ~lower:0. ~upper:1033. ~step_incr:1. () in
let _scale = GRange.scale `HORIZONTAL ~adjustment:adj_adc1 ~packing:hbox#add () in
let update = fun () -> update_adc1 (truncate adj_adc1#value) in
ignore (adj_adc1#connect#value_changed update);
ignore (adj_adc1#connect#value_changed ~callback:update);
update ()
open Latlong
sw/supervision/paparazzicenter.ml
+3 -3
View File
@@ -61,7 +61,7 @@ let read_preferences = fun (gui:Gtk_pc.window) file (ac_combo:Gtk_tools.combo) (
(*********** Window Size *)
read_one "width"
(fun width ->
read_one "height" (fun height -> gui#window#resize (ios width) (ios height)));
read_one "height" (fun height -> gui#window#resize ~width:(ios width) ~height:(ios height)));
(*********** Left pane size *)
read_one "left_pane_width"
@@ -154,7 +154,7 @@ let quit_button_callback = fun gui ac_combo session_combo target_combo ?(confirm
dialog#add_button "Cancel" `CANCEL;
let _ = GMisc.label ~text:"Configuration has been changed since startup.\nIf you want to undo the changes choose [Revert]" ~packing:dialog#vbox#pack () in
let checkbox = GButton.check_button ~label:"Always keep changes" ~active:!always_keep_changes ~packing:dialog#vbox#pack () in
ignore (checkbox#connect#toggled (fun () ->
ignore (checkbox#connect#toggled ~callback:(fun () ->
always_keep_changes := checkbox#active;
gui#menu_item_always_keep_changes#set_active checkbox#active;));
@@ -219,7 +219,7 @@ let () =
s
with _ -> "UNKNOWN" in
let s = gui#statusbar#new_context "env" in
let s = gui#statusbar#new_context ~name:"env" in
ignore (s#push (sprintf "HOME=%s SRC=%s \tVersion=%s \tBuild=%s" Env.paparazzi_home Env.paparazzi_src version_str build_str));
if Sys.file_exists Utils.backup_xml_file then begin
sw/supervision/pc_common.ml
+2 -2
View File
@@ -57,7 +57,7 @@ let run_and_log = fun log exit_cb com ->
if count = 0 then exit_cb true;
true
in
let io_watch_out = Glib.Io.add_watch [`IN] cb channel_out in
let io_watch_out = Glib.Io.add_watch ~cond:[`IN] ~callback:cb channel_out in
pid, channel_out, com_stdout, io_watch_out
let strip_prefix = fun dir file subdir ->
@@ -116,7 +116,7 @@ let run_and_monitor = fun ?(once = false) ?file ?(finished_callback = fun () ->
let io_watch' = Glib.Io.add_watch ~cond:[`HUP] ~callback:
(fun _ ->
(* call with a delay of 200ms, not strictly needed anymore, but seems more pleasing to the eye *)
ignore (Glib.Timeout.add 200 (fun () -> callback true; false));
ignore (Glib.Timeout.add ~ms:200 ~callback:(fun () -> callback true; false));
(* return true to not automatically remove event source,
otherwise will try to remove non existent source in callback, resulting in:
GLib-CRITICAL **: Source ID xxx was not found when attempting to remove it *)
sw/supervision/pc_control_panel.ml
+1 -1
View File
@@ -348,7 +348,7 @@ let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo :
| _ -> compare x y in
let menu = GMenu.menu ()
and sorted_entries = List.sort compare !entries in
GToolbox.build_menu menu sorted_entries;
GToolbox.build_menu menu ~entries:sorted_entries;
gui#programs_menu_item#set_submenu menu;
(* New session *)