gui color for tracks specified in conf.xml

conf/messages.xml

@@ -316,6 +316,8 @@
     <field name="flight_plan" type="string" unit="url"/>
     <field name="airframe" type="string" unit="url"/>
     <field name="radio" type="string" unit="url"/>
+    <field name="default_gui_color" type="string"/>
+    <field name="ac_name" type="string"/>
   </message>
 
   <message name="FLIGHT_PARAM" ID="11">

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

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)));
 

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

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
 

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

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 

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