*** empty log message ***

conf/Makefile.sim

@@ -30,7 +30,7 @@
 SRC_ARCH = $(PAPARAZZI_SRC)/sw/airborne/sim
 
 CC = gcc
-OCAMLC = ocamlc -g
+OCAMLC = ocamlc
 SIMDIR = $(PAPARAZZI_SRC)/sw/simulator
 CAMLINCLUDES = -I +lablgtk2 -I $(PAPARAZZI_SRC)/sw/lib/ocaml -I $(SIMDIR)
 SIMSITLML = $(OBJDIR)/simsitl.ml

sw/lib/ocaml/extXml.ml

@@ -83,33 +83,40 @@ let attrib_or_default = fun x a default ->
 
 (** Code patched from xml.ml from xml-light package: PC Data formatting removed *)
 let tmp = Buffer.create 200
-let buffer_attr (n,v) =
+let buffer_attr = fun indent tab (n,v) ->
-        Buffer.add_char tmp ' ';
+  if indent then
-        Buffer.add_string tmp n;
+    Buffer.add_string tmp tab;
-        Buffer.add_string tmp "=\"";
+  Buffer.add_char tmp ' ';
-        let l = String.length v in
+  Buffer.add_string tmp n;
-        for p = 0 to l-1 do
+  Buffer.add_string tmp "=\"";
-                match v.[p] with
+  let l = String.length v in
-                | '\\' -> Buffer.add_string tmp "\\\\"
+  for p = 0 to l-1 do
-                | '"' -> Buffer.add_string tmp "\\\""
+    match v.[p] with
-                | c -> Buffer.add_char tmp c
+    | '\\' -> Buffer.add_string tmp "\\\\"
+    | '"' -> Buffer.add_string tmp "\\\""
+    | c -> Buffer.add_char tmp c
         done;
-        Buffer.add_char tmp '"'
+  Buffer.add_char tmp '"';
+  if indent then
+    Buffer.add_char tmp '\n'
+
 let buffer_pcdata = Buffer.add_string tmp
-let my_to_string_fmt x =
+let my_to_string_fmt = fun tab_attribs x ->
   let rec loop ?(newl=false) tab = function
     | Xml.Element (tag,alist,[]) ->
         Buffer.add_string tmp tab;
         Buffer.add_char tmp '<';
         Buffer.add_string tmp tag;
-        List.iter buffer_attr alist;
+	if tab_attribs then Buffer.add_char tmp '\n';
+        List.iter (buffer_attr tab_attribs tab) alist;
+	if tab_attribs then Buffer.add_string tmp tab;
         Buffer.add_string tmp "/>";
         if newl then Buffer.add_char tmp '\n';
     | Xml.Element (tag,alist,[Xml.PCData text]) ->
         Buffer.add_string tmp tab;
         Buffer.add_char tmp '<';
         Buffer.add_string tmp tag;
-        List.iter buffer_attr alist;
+        List.iter (buffer_attr tab_attribs tab) alist;
         Buffer.add_string tmp ">";
         buffer_pcdata text;
         Buffer.add_string tmp "</";
@@ -120,7 +127,7 @@ let my_to_string_fmt x =
         Buffer.add_string tmp tab;
         Buffer.add_char tmp '<';
         Buffer.add_string tmp tag;
-        List.iter buffer_attr alist;
+        List.iter (buffer_attr tab_attribs tab) alist;
         Buffer.add_string tmp ">\n";
         List.iter (loop ~newl:true (tab^"  ")) l;
         Buffer.add_string tmp tab;
@@ -140,7 +147,7 @@ let my_to_string_fmt x =
 
 
 
-let to_string_fmt = fun xml ->
+let to_string_fmt = fun ?(tab_attribs = false) xml ->
   let l = String.lowercase in
   let rec lower = function
       Xml.PCData _ as x -> x
@@ -148,7 +155,7 @@ let to_string_fmt = fun xml ->
 	Xml.Element(l t,
 		    List.map (fun (a,v) -> (l a, v)) ats,
 		    List.map lower cs) in
-  my_to_string_fmt (lower xml)
+  my_to_string_fmt tab_attribs (lower xml)
 
 
 let subst_attrib = fun attrib value xml ->

sw/lib/ocaml/extXml.mli

@@ -48,8 +48,8 @@ val tag_is : Xml.xml -> string -> bool
 val attrib_or_default : Xml.xml -> string -> string -> string
 (** [get xml attribute_name default_value] *)
 
-val to_string_fmt : Xml.xml -> string
+val to_string_fmt : ?tab_attribs:bool -> Xml.xml -> string
-(** [to_string_fmt xml] Returns a formatted string where tag and attribute
+(** [to_string_fmt tab_attribs xml] Returns a formatted string where tag and attribute
 names are lowercase *)
 
 val subst_attrib : string -> string -> Xml.xml -> Xml.xml

sw/supervision/Makefile

@@ -0,0 +1,30 @@
+# Quiet
+Q=@
+
+OCAMLC = ocamlc
+OCAMLOPT = ocamlopt
+OCAMLLIB = ../lib/ocaml
+INCLUDES= -I $(OCAMLLIB) -I ../multimon -I +lablgtk2 -I +xml-light
+LIBPPRZCMA=$(OCAMLLIB)/lib-pprz.cma
+PAPARAZZICENTERCMO = gui.cmo paparazzicenter.cmo
+
+all: paparazzicenter
+
+paparazzicenter : $(PAPARAZZICENTERCMO) $(OCAMLLIB)/lib-pprz.cma
+	@echo OL $@
+	$(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma gtkInit.cmo lib-pprz.cma $^
+
+gui.ml : paparazzicenter.glade
+	lablgladecc2 -root window $< > $@
+
+program.ml : paparazzicenter.glade
+	lablgladecc2 -root hbox_program $< > $@
+
+%.cmo : %.ml
+	@echo OC $<
+	$(Q)$(OCAMLC) $(INCLUDES) -c $<
+
+paparazzicenter.cmo : gui.cmo
+
+clean:
+	\rm *.cm* gui.ml

sw/supervision/paparazzicenter.ml

@@ -0,0 +1,369 @@
+open Printf
+
+let (//) = Filename.concat
+let bn = Filename.basename
+let conf_dir = Env.paparazzi_home // "conf"
+
+let gcs = Env.paparazzi_src // "sw/ground_segment/cockpit/gcs"
+
+let string_of_gdkcolor = fun c ->
+  sprintf "#%2x%2x%2x" (Gdk.Color.red c) (Gdk.Color.green c) (Gdk.Color.blue c)
+
+let aircraft_sample = fun name ac_id ->
+  Xml.Element ("aircraft",
+	       ["name", name;
+		"ac_id", ac_id;
+		"airframe", "airframes/microjet5.xml";
+		"radio", "radios/cockpitMM.xml";
+		"telemetry", "telemetry/default.xml";
+		"flight_plan", "flight_plans/versatile.xml";
+		"settings", "settings/tuning.xml";
+		"gui_color", "blue"],
+	       [])
+
+				   
+
+let control_panel_xml = Xml.parse_file (conf_dir // "control_panel.xml")
+let programs =
+  let h = Hashtbl.create 7 in
+  let s = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = "programs") control_panel_xml "section" in
+  List.iter 
+    (fun p -> Hashtbl.add h (ExtXml.attrib p "name") p)
+    (Xml.children s);
+  h
+let program_command = fun x ->
+  let xml = Hashtbl.find programs x in
+  ExtXml.attrib xml "command"
+
+let conf_xml_file = conf_dir // "conf.xml"
+let conf_xml = Xml.parse_file conf_xml_file
+let aircrafts = Hashtbl.create 7
+let _ =
+  List.iter (fun aircraft ->
+    Hashtbl.add aircrafts (ExtXml.attrib aircraft "name") aircraft)
+    (Xml.children conf_xml)
+let airframes_dir = conf_dir // "airframes"
+let flight_plans_dir = conf_dir // "flight_plans"
+
+let write_conf_xml = fun () ->
+  Sys.rename conf_xml_file (conf_xml_file^"~");
+  let l = Hashtbl.fold (fun _ a r -> a::r) aircrafts [] in
+  let c = Xml.Element ("conf", [], l) in
+  let f = open_out conf_xml_file in
+  output_string f (ExtXml.to_string_fmt ~tab_attribs:true c);
+  close_out f
+
+let new_ac_id = fun () ->
+  let m = ref 0 in
+  Hashtbl.iter
+    (fun _  x ->
+      m := max !m (int_of_string (ExtXml.attrib x "ac_id")))
+    aircrafts ;
+  !m + 1
+
+
+type combo = GEdit.combo_box * (GTree.list_store * string GTree.column)
+
+let combo = fun ?(others = []) strings vbox ->
+  let strings = others @ strings in
+  let (combo, (tree, column)) =
+    GEdit.combo_box_text ~packing:vbox#add ~strings () in
+  combo#set_active 0;
+  (combo, (tree, column))
+
+let parse_conf_xml = fun vbox ->
+  let strings = ref [] in
+  Hashtbl.iter (fun name _ac -> strings := name :: !strings) aircrafts;
+  combo ~others:[""] !strings vbox
+
+
+let combo_connect = fun ((combo: #GEdit.combo_box), (_,column)) cb ->
+  ignore (combo#connect#changed
+	    (fun () ->
+	      match combo#active_iter with
+	      | None -> ()
+	      | Some row ->
+		  let data = combo#model#get ~row ~column in
+		  cb data))
+	    
+let combo_value = fun ((combo: #GEdit.combo_box), (_,column)) ->
+  match combo#active_iter with
+  | None -> raise Not_found
+  | Some row -> combo#model#get ~row ~column
+      
+let combo_widget = fst
+let combo_model = snd
+
+
+let is_xml_file = fun s ->
+  let n = String.length s in
+  n >= 4 && String.sub s (n-4) 4 = ".xml"
+
+let combo_dir = fun ?others directory vbox ->
+  let files = Array.to_list (Sys.readdir directory) in
+  let xml_files = List.filter is_xml_file files in
+  combo ?others xml_files vbox
+
+
+let command = fun log ac_name target ->
+  let com = sprintf "cd %s; export PATH=/usr/bin:$PATH; make AIRCRAFT=%s %s" Env.paparazzi_home ac_name target in
+  log com;
+  let com_stdout, com_stdin, com_stderr = Unix.open_process_full com [||] in
+  let channel_out = GMain.Io.channel_of_descr (Unix.descr_of_in_channel com_stdout) in
+  let channel_err = GMain.Io.channel_of_descr (Unix.descr_of_in_channel com_stderr) in
+  let cb = fun c _ -> log (input_line c); true in
+  let io_watch_out = Glib.Io.add_watch [`IN] (cb com_stdout) channel_out in
+  let io_watch_err = Glib.Io.add_watch [`IN] (cb com_stderr) channel_err in
+  ignore (Glib.Io.add_watch [`HUP] (fun _ -> Glib.Io.remove io_watch_out; Glib.Io.remove io_watch_err; log "\nDONE\n"; false) channel_out)
+
+
+let run = prerr_endline
+
+
+let editor =
+  try Sys.getenv "EDITOR" with _ -> "gedit"
+
+let edit = fun file ->
+  ignore (Sys.command (sprintf "%s '%s'&" editor file))
+
+
+let gcs_or_edit = fun file ->
+  match GToolbox.question_box ~title:"Flight plan editing" ~default:2 ~buttons:["Text editor"; "GCS"] "Which editor do you want to use ?" with
+    1 -> edit file
+  | 2 -> ignore (Sys.command (sprintf "%s -edit '%s'&" gcs file))
+  | _ -> failwith "Internal error: gcs_or_edit"
+    
+let ac_files = fun gui ->
+  ["airframe", gui#label_airframe, gui#button_browse_airframe, gui#button_edit_airframe, edit;
+   "flight_plan", gui#label_flight_plan, gui#button_browse_flight_plan, gui#button_edit_flight_plan, gcs_or_edit;
+(*    "settings", gui#label_settings, gui#button_browse_settings, gui#button_edit_settings, edit; *)
+   "radio", gui#label_radio, gui#button_browse_radio, gui#button_edit_radio, edit;
+   "telemetry", gui#label_telemetry, gui#button_browse_telemetry, gui#button_edit_telemetry, edit]
+
+
+(* Awful but easier *)
+let current_color = ref "white"
+  
+
+(* Link A/C to airframe & flight_plan labels *)
+let ac_combo_handler = fun gui (ac_combo:combo) target_combo ->
+  combo_connect ac_combo
+    (fun ac_name ->
+      try
+	let sample = aircraft_sample ac_name "42" in
+	let aircraft = Hashtbl.find aircrafts ac_name in
+	let value = fun a ->
+	  try (ExtXml.attrib aircraft a) with _ -> Xml.attrib sample a in
+	List.iter
+	  (fun (a, label, _, _, _) -> label#set_text (value a))
+	  (ac_files gui);
+	gui#entry_settings#set_text
+	  (value "settings");
+	let ac_id = ExtXml.attrib aircraft "ac_id"
+	and gui_color = ExtXml.attrib_or_default aircraft "gui_color" "white" in
+	gui#button_clean#misc#set_sensitive true;
+	gui#button_build#misc#set_sensitive true;
+	gui#eventbox_gui_color#misc#modify_bg [`NORMAL, `NAME gui_color];
+	current_color := gui_color;
+	gui#entry_ac_id#set_text ac_id;
+	(combo_widget target_combo)#misc#set_sensitive true;
+      with
+	Not_found ->
+	  gui#label_airframe#set_text "";
+	  gui#label_flight_plan#set_text "";
+	  gui#button_clean#misc#set_sensitive false;
+	  gui#button_build#misc#set_sensitive false;
+	  (combo_widget target_combo)#misc#set_sensitive false
+    );
+
+  (* New A/C button *)
+  let callback = fun _ ->
+    match GToolbox.input_string ~title:"New A/C" ~text:"MYAC" "New A/C name ?" with
+      None -> ()
+    | Some s ->
+	let (store, column) = combo_model ac_combo in
+	let row = store#append () in
+	store#set ~row ~column s;
+	let a = aircraft_sample s (string_of_int (new_ac_id ())) in
+	Hashtbl.add aircrafts s a;
+	(combo_widget ac_combo)#set_active_iter (Some row)
+  in
+  ignore (gui#button_new_ac#connect#clicked ~callback);
+
+  (* Delete A/C *)
+  let callback = fun _ ->
+    let ac_name = combo_value ac_combo in
+    if ac_name <> "" then
+      match GToolbox.question_box ~title:"Delete A/C" ~buttons:["Cancel"; "Delete"] ~default:2 (sprintf "Delete %s ? (NO undo)" ac_name) with
+	2 -> begin
+	  begin try Hashtbl.remove aircrafts ac_name with _ -> () end;
+	  let combo_box = combo_widget ac_combo in
+	  match combo_box#active_iter with
+	  | None -> ()
+	  | Some row ->
+	      let (store, column) = combo_model ac_combo in
+	      ignore (store#remove row);
+	      combo_box#set_active 1
+	end
+      | _ -> ()
+  in
+  ignore (gui#button_delete_ac#connect#clicked ~callback);
+
+  (* GUI color *)
+  let callback = fun _ ->
+    let csd = GWindow.color_selection_dialog ~show:true () in
+    let callback = fun _ ->
+      let colorname = string_of_gdkcolor csd#colorsel#color in
+      gui#eventbox_gui_color#misc#modify_bg [`NORMAL, `NAME colorname];
+      current_color := colorname;
+      csd#destroy () in
+    ignore (csd#ok_button#connect#clicked ~callback);
+    ignore (csd#cancel_button#connect#clicked ~callback:csd#destroy) in
+  ignore(gui#button_gui_color#connect#clicked ~callback);
+
+  (* Save button *)
+  let callback = fun _ ->
+    match GToolbox.question_box ~title:"Save conf.xml" ~buttons:["Cancel"; "Save"] ~default:2 "Save in conf.xml ? (backup in conf.xml~)" with
+      2 ->
+	let ac_name = combo_value ac_combo in
+	if ac_name <> "" then begin
+	  let color = !current_color in
+	  let aircraft =
+	    Xml.Element ("aircraft",
+			 ["name", ac_name;
+			  "ac_id", gui#entry_ac_id#text;
+			  "airframe", gui#label_airframe#text;
+			  "radio", gui#label_radio#text;
+			  "telemetry", gui#label_telemetry#text;
+			  "flight_plan", gui#label_flight_plan#text;
+			  "settings", gui#entry_settings#text;
+			  "gui_color", color],
+			 []) in
+	  begin try Hashtbl.remove aircrafts ac_name with _ -> () end;
+	  Hashtbl.add aircrafts ac_name aircraft
+	end;
+	write_conf_xml ()
+    | _ -> () in
+  ignore(gui#button_save_ac#connect#clicked ~callback)
+
+
+let build_handler = fun gui ac_combo target_combo log ->
+  (* Link target to upload button *)
+  combo_connect target_combo
+    (fun target ->
+      gui#button_upload#misc#set_sensitive (target <> "sim"));
+
+  (* Clean button *)
+  let callback = fun () ->
+    command log (combo_value ac_combo) "clean_ac" in
+  ignore (gui#button_clean#connect#clicked ~callback);
+  
+  (* Build button *)
+  let callback = fun () ->
+    let ac_name = combo_value ac_combo
+    and target = combo_value target_combo in
+    command log ac_name target in
+  ignore (gui#button_build#connect#clicked ~callback);
+  
+  (* Upload button *)
+  let callback = fun () ->
+    let ac_name = combo_value ac_combo
+    and target = combo_value target_combo in
+    command log ac_name (sprintf "%s.upload" target) in
+  ignore (gui#button_upload#connect#clicked ~callback)
+
+let choose_xml_file = fun title subdir cb ->
+  let dir = conf_dir // subdir in
+  let dialog = GWindow.file_chooser_dialog ~action:`OPEN ~title () in
+  ignore (dialog#set_current_folder dir);
+  dialog#add_filter (GFile.filter ~name:"log" ~patterns:["*.xml"] ());
+  dialog#add_button_stock `CANCEL `CANCEL ;
+  dialog#add_select_button_stock `OPEN `OPEN ;
+  begin match dialog#run (), dialog#filename with
+    `OPEN, Some name ->
+      dialog#destroy ();
+      cb (bn name)
+  | _ -> dialog#destroy ()
+  end
+
+let first_word = fun s ->
+  try
+    let n = String.index s ' ' in
+    String.sub s 0 n
+  with
+    Not_found -> s
+
+let conf_handler = fun gui ->
+  List.iter (fun (name, label, button_browse, button_edit, editor) ->
+    let callback = fun _ ->
+      editor (conf_dir // label#text) in
+    ignore (button_edit#connect#clicked ~callback);
+    let callback = fun _ ->
+      let subdir = Filename.dirname label#text in
+      let cb = fun name -> label#set_text (subdir // name) in
+      choose_xml_file name subdir cb in
+    ignore (button_browse#connect#clicked ~callback))
+    (ac_files gui);
+  (* Special case for settings (not a single file) *)
+  let callback = fun _ ->
+    edit (conf_dir // (first_word gui#entry_settings#text)) in
+  ignore (gui#button_edit_settings#connect#clicked ~callback)
+
+
+let supervision = fun gui ->
+  (* Replay menu *)
+  ()
+
+  (* GCS button
+  let callback = fun () ->
+    match (combo_value session_combo) with
+      "SIM" ->
+	let ac_name = combo_value ac_combo in
+	let sim_com = program_command "sim"
+	and server = program_command "server"
+	and gcs_com = program_command "gcs" in
+	let sim = sprintf "%s -a %s" sim_com ac_name
+	and gcs = sprintf "%s" gcs_com in
+
+	run sim;
+	run server;
+	run gcs
+    | x -> fprintf stderr "%s not yet\n" x
+  in
+  ignore (gui#button_GCS#connect#clicked ~callback);
+*)
+
+   
+
+  
+
+let () =
+  let file = Env.paparazzi_src // "sw" // "supervision" // "paparazzicenter.glade" in
+  let gui = new Gui.window ~file () in
+  ignore (gui#window#connect#destroy ~callback:(fun _ -> exit 0));
+  gui#toplevel#show ();
+
+  let ac_combo = parse_conf_xml gui#vbox_ac
+  and target_combo = combo ["sim";"fbw";"ap"] gui#vbox_target in
+
+  (combo_widget target_combo)#misc#set_sensitive false;
+  gui#button_clean#misc#set_sensitive false;
+  gui#button_build#misc#set_sensitive false;
+
+  ac_combo_handler gui ac_combo target_combo;
+
+  conf_handler gui;
+
+  let log = fun s ->
+    gui#console#buffer#insert s;
+    gui#console#buffer#insert "\n";
+    (* Scroll to the bottom line *)
+    let end_iter = gui#console#buffer#end_iter in
+    let end_mark = gui#console#buffer#create_mark end_iter in
+    gui#console#scroll_mark_onscreen (`MARK end_mark) in
+
+  build_handler gui ac_combo target_combo log;
+
+  supervision gui;
+
+  GMain.Main.main ()

sw/tools/gen_flight_plan.ml

@@ -76,7 +76,12 @@ let lprintf = fun f ->
   printf "%s" (String.make !margin ' ');
   printf f
 
-let float_attrib = fun xml a -> float_of_string (Xml.attrib xml a)
+let float_attrib = fun xml a -> 
+  try
+    float_of_string (Xml.attrib xml a)
+  with
+    Failure "float_of_string" ->
+      failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml))
 let name_of = fun wp -> ExtXml.attrib wp "name"