diff --git a/conf/messages.xml b/conf/messages.xml
index bb29aa93ea..0b427d0278 100644
--- a/conf/messages.xml
+++ b/conf/messages.xml
@@ -316,6 +316,8 @@
+
+
diff --git a/sw/configurator/medit.ml b/sw/configurator/medit.ml
index dcdb628cfd..ef8a216f41 100644
--- a/sw/configurator/medit.ml
+++ b/sw/configurator/medit.ml
@@ -391,7 +391,7 @@ let calibrate_map = fun root () ->
p#lower_to_bottom ();
let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in
let v = GPack.vbox ~packing:dialog#add () in
- let _ = GMisc.label ~text:"Choose 3 waypoints (Left Button)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210\nClick the button below to save the XML result file\nExit and restart" ~packing:v#add () in
+ let _ = GMisc.label ~text:"Choose 3 waypoints (CTRL Left Button)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210\nClick the button below to save the XML result file\nExit and restart" ~packing:v#add () in
let h = GPack.hbox ~packing:v#pack () in
let cal = GButton.button ~label:"Calibrate" ~packing:h#add () in
let close = GButton.button ~label:"Exit" ~packing:h#add () in
diff --git a/sw/ground_segment/cockpit/map2d.ml b/sw/ground_segment/cockpit/map2d.ml
index f64a047af0..e7e26cb1b7 100644
--- a/sw/ground_segment/cockpit/map2d.ml
+++ b/sw/ground_segment/cockpit/map2d.ml
@@ -55,6 +55,7 @@ let default_path_missions = home // "conf"
type aircraft = {
+ config : Pprz.values;
track : MapTrack.track;
color: color;
mutable fp_group : (MapWaypoints.group * (int * MapWaypoints.waypoint) list) option
@@ -207,30 +208,18 @@ let ap_status_msg = fun track flight_time ->
track#update_ap_status flight_time
-let new_color =
- let colors = ref ["red"; "blue"; "green"] in
- fun () ->
- match !colors with
- x::xs ->
- colors := xs @ [x];
- x
- | [] -> failwith "new_color"
-
-
-let ask_fp = fun geomap ac ->
- let get_config = fun _sender values ->
- let file = Pprz.string_assoc "flight_plan" values in
+let display_fp = fun geomap ac ->
+ try
let ac = Hashtbl.find live_aircrafts ac in
- try
- ac.fp_group <- Some (load_mission ac.color geomap file)
- with Failure x ->
- GToolbox.message_box ~title:"Error while loading flight plan" x in
- Ground_Pprz.message_req "map2d" "CONFIG" ["ac_id", Pprz.String ac] get_config
+ let file = Pprz.string_assoc "flight_plan" ac.config in
+ ac.fp_group <- Some (load_mission ac.color geomap file)
+ with Failure x ->
+ GToolbox.message_box ~title:"Error while loading flight plan" x
let show_mission = fun geomap ac on_off ->
if on_off then
- ask_fp geomap ac
+ display_fp geomap ac
else
let a = Hashtbl.find live_aircrafts ac in
match a.fp_group with
@@ -267,41 +256,102 @@ let resize_track = fun ac track ->
match GToolbox.input_string ~text:(string_of_int track#size) ~title:ac "Track size" with
None -> ()
| Some s -> track#resize (int_of_string s)
+
+
+
+let canvas_color = fun gdk_color ->
+ let r = Gdk.Color.red gdk_color
+ and g = Gdk.Color.green gdk_color
+ and b = Gdk.Color.blue gdk_color in
+ Printf.sprintf "#%02x%02x%02x" r g b
+
+let gdk_color = fun s ->
+ Gdk.Color.alloc (Gdk.Color.get_system_colormap ()) (`NAME s)
+
+
+let colorsel =
+ let dialog_ref = ref None in
+ fun (track:MapTrack.track) (box:GObj.widget) ->
+ let colordlg =
+ (** Creates the dialog if it has not been done yet *)
+ match !dialog_ref with
+ | None ->
+ let dlg = GWindow.color_selection_dialog ~title:"Select track color" () in
+ dialog_ref := Some dlg;
+ let callback = fun response ->
+ begin
+ match response with
+ `OK ->
+ let c = dlg#colorsel#color in
+ box#coerce#misc#modify_bg [`NORMAL, `COLOR c];
+ track#set_color (canvas_color c)
+ | _ -> ()
+ end;
+ dlg#misc#hide ()
+ in
+ ignore (dlg#connect#response ~callback);
+ dlg
+ | Some dlg -> dlg
+ in
+ let colorsel = colordlg#colorsel in
+
+ colorsel#set_has_palette true;
+ ignore (colordlg#run ())
+
+
+let create_ac = fun (geomap:MapCanvas.widget) (vertical_display:MapCanvas.basic_widget) ac_id config ->
+ let color = Pprz.string_assoc "default_gui_color" config
+ and name = Pprz.string_assoc "ac_name" config in
+ let ac_menu = geomap#factory#add_submenu name in
+ let ac_menu_fact = new GMenu.factory ac_menu in
+ let fp = ac_menu_fact#add_check_item "Fligh Plan" ~active:false in
+ ignore (fp#connect#toggled (fun () -> show_mission geomap ac_id fp#active));
+
+ let track = new MapTrack.track ~name ~color:color geomap vertical_display in
+
+ let eb = GBin.event_box ~width:10 ~height:10 () in
+ eb#coerce#misc#modify_bg [`NORMAL, `NAME color];
+ let col_menu = ac_menu_fact#add_image_item ~label:"Color" ~image:eb#coerce ~callback:(fun () -> () (*** TO FIX colorsel track eb#coerce***) ) () in
+ ignore (ac_menu_fact#add_item "Clear Track" ~callback:(fun () -> track#clear_map2D));
+ ignore (ac_menu_fact#add_item "Resize Track" ~callback:(fun () -> resize_track ac_id track));
+ ignore (ac_menu_fact#add_item "Commit Moves" ~callback:(fun () -> commit_changes ac_id));
+ ignore (ac_menu_fact#add_item "Event 1" ~callback:(fun () -> send_event ac_id 1));
+ ignore (ac_menu_fact#add_item "Event 2" ~callback:(fun () -> send_event ac_id 2));
+ let cam = ac_menu_fact#add_check_item "Cam Display" ~active:false in
+ ignore (cam#connect#toggled (fun () -> track#set_cam_state cam#active));
+ let ac_menu_vertical = vertical_display#factory#add_submenu ac_id in
+ let ac_menu_fact_vertical = new GMenu.factory ac_menu_vertical in
+ let params = ac_menu_fact#add_check_item "flight param. display" ~active:false in
+ ignore (params#connect#toggled (fun () -> track#set_params_state params#active));
+ let v_params = ac_menu_fact_vertical#add_check_item "flight param. display" ~active:false in
+ ignore (v_params#connect#toggled (fun () -> track#set_v_params_state v_params#active));
+ let event_ac = fun e ->
+ match e with
+ `BUTTON_PRESS _ | `BUTTON_RELEASE _ ->
+ Ground_Pprz.message_send "ground" "SELECTED" ["aircraft_id", Pprz.String ac_id];
+ true
+ | _ -> false in
+ ignore (track#aircraft#connect#event event_ac);
+ Hashtbl.add live_aircrafts ac_id { track = track; color = color; fp_group = None ; config = config}
+
+
+
+
+let ask_config = fun geomap vd ac ->
+ let get_config = fun _sender values ->
+ create_ac geomap vd ac values
+ in
+ Ground_Pprz.message_req "map2d" "CONFIG" ["ac_id", Pprz.String ac] get_config
+
let one_new_ac = fun (geomap:MapCanvas.widget)(vertical_display:MapCanvas.basic_widget) ac ->
if not (Hashtbl.mem live_aircrafts ac) then begin
- let ac_menu = geomap#factory#add_submenu ac in
- let ac_menu_fact = new GMenu.factory ac_menu in
- let fp = ac_menu_fact#add_check_item "Fligh Plan" ~active:false in
- ignore (fp#connect#toggled (fun () -> show_mission geomap ac fp#active));
- let color = new_color () in
- let track = new MapTrack.track ~name:ac ~color:color geomap vertical_display in
- ignore (ac_menu_fact#add_item "Clear Track" ~callback:(fun () -> track#clear_map2D));
- ignore (ac_menu_fact#add_item "Resize Track" ~callback:(fun () -> resize_track ac track));
- ignore (ac_menu_fact#add_item "Commit Moves" ~callback:(fun () -> commit_changes ac));
- ignore (ac_menu_fact#add_item "Event 1" ~callback:(fun () -> send_event ac 1));
- ignore (ac_menu_fact#add_item "Event 2" ~callback:(fun () -> send_event ac 2));
- let cam = ac_menu_fact#add_check_item "Cam Display" ~active:false in
- ignore (cam#connect#toggled (fun () -> track#set_cam_state cam#active));
- let ac_menu_vertical = vertical_display#factory#add_submenu ac in
- let ac_menu_fact_vertical = new GMenu.factory ac_menu_vertical in
- let params = ac_menu_fact#add_check_item "flight param. display" ~active:false in
- ignore (params#connect#toggled (fun () -> track#set_params_state params#active));
- let v_params = ac_menu_fact_vertical#add_check_item "flight param. display" ~active:false in
- ignore (v_params#connect#toggled (fun () -> track#set_v_params_state v_params#active));
- let event_ac = fun e ->
- match e with
- `BUTTON_PRESS _ | `BUTTON_RELEASE _ ->
- Ground_Pprz.message_send "ground" "SELECTED" ["aircraft_id", Pprz.String ac];
- true
- | _ -> false in
- ignore (track#aircraft#connect#event event_ac);
- Hashtbl.add live_aircrafts ac { track = track; color = color; fp_group = None }
+ ask_config geomap vertical_display ac
end
-let live_aircrafts_msg = fun (geomap:MapCanvas.widget)(vertical_display:MapCanvas.basic_widget) acs ->
+let live_aircrafts_msg = fun (geomap:MapCanvas.widget) (vertical_display:MapCanvas.basic_widget) acs ->
let acs = Pprz.string_assoc "ac_list" acs in
let acs = Str.split list_separator acs in
List.iter (one_new_ac geomap vertical_display) acs
@@ -430,7 +480,7 @@ let _ =
done;
done;
- ignore (Glib.Timeout.add 5000 (fun () -> Ground_Pprz.message_req "map2d" "AIRCRAFTS" [] (fun _sender vs -> live_aircrafts_msg geomap vertical_display vs); false));
+ ignore (Glib.Timeout.add 2000 (fun () -> Ground_Pprz.message_req "map2d" "AIRCRAFTS" [] (fun _sender vs -> live_aircrafts_msg geomap vertical_display vs); false));
ignore (Ground_Pprz.message_bind "NEW_AIRCRAFT" (fun _sender vs -> one_new_ac geomap vertical_display (Pprz.string_assoc "ac_id" vs)));
diff --git a/sw/ground_segment/tmtc/server.ml b/sw/ground_segment/tmtc/server.ml
index c8ae32ddb1..1c11435820 100644
--- a/sw/ground_segment/tmtc/server.ml
+++ b/sw/ground_segment/tmtc/server.ml
@@ -500,6 +500,9 @@ let ident_msg = fun log id name ->
Ground_Pprz.message_send my_id "NEW_AIRCRAFT" ["ac_id", Pprz.String id]
end
+let new_color = fun () ->
+ sprintf "#%02x%02x%02x" (Random.int 256) (Random.int 256) (Random.int 256)
+
(* Waits for new aircrafts *)
let listen_acs = fun log ->
ignore (Ivy.bind (fun _ args -> ident_msg log args.(0) args.(1)) "^(.*) IDENT +(.*)")
@@ -520,10 +523,15 @@ let send_config = fun http _asker args ->
let fp = prefix ("var" // ac_name // "flight_plan.xml")
and af = prefix ("conf" // ExtXml.attrib conf "airframe")
and rc = prefix ("conf" // ExtXml.attrib conf "radio") in
+ let col = try Xml.attrib conf "gui_color" with _ -> new_color () in
+ let ac_name = try Xml.attrib conf "name" with _ -> "" in
["ac_id", Pprz.String ac_id;
"flight_plan", Pprz.String fp;
"airframe", Pprz.String af;
- "radio", Pprz.String rc]
+ "radio", Pprz.String rc;
+ "default_gui_color", Pprz.String col;
+ "ac_name", Pprz.String ac_name
+ ]
with
Not_found ->
failwith (sprintf "ground UNKNOWN %s" ac_id)
@@ -555,7 +563,7 @@ let _ =
Srtm.add_path srtm_path;
- Ivy.init "Paparazzi receive" "READY" (fun _ _ -> ());
+ Ivy.init "Paparazzi server" "READY" (fun _ _ -> ());
Ivy.start !ivy_bus;
if !logging then
diff --git a/sw/ground_segment/visu3d/Makefile b/sw/ground_segment/visu3d/Makefile
index f064fe7df0..2ee0d537c4 100644
--- a/sw/ground_segment/visu3d/Makefile
+++ b/sw/ground_segment/visu3d/Makefile
@@ -24,10 +24,7 @@ clean:
# Executables
mapGL: mapGL.ml
- $(OCAMLC) $(MLFLAGS) $(STDLIBS) gtkInit.cmo $(ADD_LIBS) -o $@ $< $(CLIBS) # To check
- cat ../../../pprz_src_test.sh > $@
- echo 'ocaml -I +lablgtk2 -I +lablGL -I +camlimages -I $$PAPARAZZI_SRC/sw/lib/ocaml $(STDLIBS) gtkInit.cmo $(ADD_LIBS) $$PAPARAZZI_SRC/sw/ground_segment/visu3d/$< $$*' >> $@
- chmod a+x $@
+ $(OCAMLC) -custom $(MLFLAGS) $(STDLIBS) gtkInit.cmo $(ADD_LIBS) -o $@ $< $(CLIBS)
# Do not edit below this line
diff --git a/sw/ground_segment/visu3d/mapGL.ml b/sw/ground_segment/visu3d/mapGL.ml
index e954647669..c91d453505 100644
--- a/sw/ground_segment/visu3d/mapGL.ml
+++ b/sw/ground_segment/visu3d/mapGL.ml
@@ -102,6 +102,9 @@ let gtk_to_gl_color color =
(float_of_int (Gdk.Color.green t))/.65535.0,
(float_of_int (Gdk.Color.blue t))/.65535.0)
+let gl_color_of_string = fun s -> gtk_to_gl_color (`NAME s)
+
+
(* ========================================================================= *)
(* = Passage de couleur GL vers GTK = *)
(* = = *)
@@ -187,18 +190,43 @@ let add_traj view3d (points, id) =
let color = gtk_to_gl_color id in
view3d#add_object_line l color 2 false false
+
+type aircraft = { color : Gtk_3d.glcolor; mutable last_point : Geometry_3d.pt_3D option }
+let live_aircrafts = Hashtbl.create 3
+
+let create_ac = fun ac config ->
+ let color = Pprz.string_assoc "default_gui_color" config in
+ let gl_color = gl_color_of_string color in
+ Hashtbl.add live_aircrafts ac { color = gl_color; last_point = None }
+
+let one_new_ac = fun ac ->
+ if not (Hashtbl.mem live_aircrafts ac) then begin
+ let get_config = fun _sender values -> create_ac ac values in
+ Ground_Pprz.message_req "map3d" "CONFIG" ["ac_id", Pprz.String ac] get_config
+ end
+
+let list_separator = Str.regexp ","
+let live_aircrafts_msg = fun acs ->
+ let acs = Pprz.string_assoc "ac_list" acs in
+ let acs = Str.split list_separator acs in
+ List.iter one_new_ac acs
+
+
(* Adding one more point to a track *)
-let last_points = Hashtbl.create 11
let add_point (view3d:Gtk_3d.widget_3d) (point, id) =
let p = point3D point in
try
- let (last, color) = Hashtbl.find last_points id in
- let gl_color = gtk_to_gl_color color in
- view3d#display (view3d#add_object_line [last;p] gl_color 2 false false);
- Hashtbl.replace last_points id (p, color)
+ let ac = Hashtbl.find live_aircrafts id in
+ begin
+ match ac.last_point with
+ Some last ->
+ view3d#display (view3d#add_object_line [last;p] ac.color 2 false false)
+ | None -> ()
+ end;
+ ac.last_point <- Some p
with
- Not_found ->
- Hashtbl.add last_points id (p, new_color ())
+ Not_found -> ()
+
(* ========================================================================= *)
(* = Load a map. Use SRTM elevation data to produce a 3d surface = *)
@@ -448,6 +476,10 @@ let build_interface = fun map_file mission_file ->
(* Affichage de la fenetre principale *)
window#show () ;
+ ignore (Ground_Pprz.message_bind "NEW_AIRCRAFT" (fun _sender vs -> one_new_ac (Pprz.string_assoc "ac_id" vs)));
+
+ ignore (Glib.Timeout.add 5000 (fun () -> Ground_Pprz.message_req "map3d" "AIRCRAFTS" [] (fun _sender vs -> live_aircrafts_msg vs); false));
+
let use_fp = fun _sender vs ->
let ac_id = Pprz.string_assoc "ac_id" vs in
let a = fun s -> Pprz.float_assoc s vs in
diff --git a/sw/lib/ocaml/mapTrack.ml b/sw/lib/ocaml/mapTrack.ml
index f205061a8d..325e413742 100644
--- a/sw/lib/ocaml/mapTrack.ml
+++ b/sw/lib/ocaml/mapTrack.ml
@@ -100,8 +100,10 @@ let ac_v_label =
GnoCanvas.text v_group ~props:[`TEXT name; `X 25.; `Y 25.; `ANCHOR `SW; `FILL_COLOR color]
in
- let top = ref 0 and v_top = ref 0 in
+ let top = ref 0
+ and v_top = ref 0 in
object (self)
+ val mutable color = color
val mutable segments = Array.create size empty
val mutable v_segments = Array.create size empty
val mutable last = None
@@ -121,6 +123,8 @@ let ac_v_label =
val mutable v_params_on = false
val mutable desired_track = ((GnoCanvas.ellipse group) :> GnoCanvas.base_item)
val mutable ac_cam_cover = GnoCanvas.rect cam
+ method color = color
+ method set_color c = color <- c
method track = track
method aircraft = aircraft
method set_label = fun s -> ac_label#set [`TEXT s]
@@ -129,9 +133,9 @@ let ac_v_label =
(snd seg.(i))#destroy ();
seg.(i) <- empty
end
- method incr = fun seg top_ ->
+ method incr = fun seg ->
let s = Array.length seg in
- top_ := (!(top_) + 1) mod s
+ top := (!top + 1) mod s
method clear = fun seg top ->
for i = 0 to Array.length seg - 1 do
self#clear_one i seg
@@ -166,7 +170,7 @@ let ac_v_label =
| Some pt ->
seg.((!top)) <- (en, geomap#segment ~group:track ~width:2 ~fill_color:color pt en);
end;
- self#incr (seg) top ;
+ self#incr seg;
set_last_point (Some en)
method clear_map2D = self#clear segments top
diff --git a/sw/lib/ocaml/mapWaypoints.ml b/sw/lib/ocaml/mapWaypoints.ml
index 32d8e2a602..9555147c89 100644
--- a/sw/lib/ocaml/mapWaypoints.ml
+++ b/sw/lib/ocaml/mapWaypoints.ml
@@ -94,7 +94,9 @@ class waypoint = fun (group:group) (name :string) ?(alt=0.) en ->
begin
match GdkEvent.Button.button ev with
| 1 -> self#edit
- | 3 -> self#delete
+ | 3 ->
+ if (GToolbox.question_box ~title:"Confirm delete" ~buttons:["Cancel";"Delete"] ~default:2 (sprintf "Delete '%s' ?" name)) = 2 then
+ self#delete
| 2 ->
let x = GdkEvent.Button.x ev
and y = GdkEvent.Button.y ev in