Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

269 lines (239 sloc) 8.986 kb
(*
* $Id$
*
* Paparazzi center processes handling
*
* Copyright (C) 2007 ENAC, Pascal Brisset, Antoine Drouin
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
open Printf
module Utils = Pc_common
let (//) = Filename.concat
let control_panel_xml_file = Utils.conf_dir // "control_panel.xml"
let control_panel_xml = ExtXml.parse_file control_panel_xml_file
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 ->
try
let xml = Hashtbl.find programs x in
Env.paparazzi_src // ExtXml.attrib xml "command"
with Not_found ->
failwith (sprintf "Fatal Error: Program '%s' not found in control_panel.xml" x)
let sessions =
let h = Hashtbl.create 7 in
let s = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = "sessions") control_panel_xml "section" in
List.iter
(fun p -> Hashtbl.add h (ExtXml.attrib p "name") p)
(Xml.children s);
h
let not_sessions_section = fun x -> ExtXml.attrib x "name" <> "sessions"
let write_control_panel_xml = fun () ->
Sys.rename control_panel_xml_file (control_panel_xml_file^"~");
let l = Hashtbl.fold (fun _ a r -> a::r) sessions [] in
let s = Xml.Element ("section", ["name","sessions"], l) in
let children = List.filter not_sessions_section (Xml.children control_panel_xml) @ [s] in
let c = Xml.Element ("control_panel", Xml.attribs control_panel_xml, children) in
let f = open_out control_panel_xml_file in
output_string f (ExtXml.to_string_fmt ~tab_attribs:false c);
close_out f
let run_and_monitor = fun ?file gui log com_name args ->
Utils.run_and_monitor ?file gui log com_name (program_command com_name) args
let close_programs = fun gui ->
List.iter (fun w ->
gui#vbox_programs#remove w;
w#destroy ())
gui#vbox_programs#children
let parse_process_args = fun (name, args) ->
(* How to do it with a simple regexp split ??? *)
(* Mark spaces into args *)
let marked_space = Char.chr 0 in
let in_quotes = ref false in
for i = 0 to String.length args - 1 do
match args.[i] with
' ' when !in_quotes -> args.[i] <- marked_space
| '"' -> in_quotes := not !in_quotes
| _ -> ()
done;
(* Split *)
let args = Str.split (Str.regexp "[ ]+") args in
(* Restore spaces and remove quotes *)
let restore_spaces = fun s ->
let n = String.length s in
for i = 0 to n - 1 do
if s.[i] = marked_space then s.[i] <- ' '
done;
if n >= 2 && s.[0] = '"' then
String.sub s 1 (n-2)
else
s in
let args = List.map restore_spaces args in
(* Remove the first "arg" which is the command *)
let args = List.tl args in
(* Build the XML arg list *)
let is_option = fun s -> String.length s > 0 && s.[0] = '-' in
let rec xml_args = function
[] -> []
| option::value::l when not (is_option value) ->
Xml.Element("arg", ["flag",option; "constant", value],[])::xml_args l
| option::l ->
Xml.Element("arg", ["flag",option],[])::xml_args l in
Xml.Element("program", ["name", name], xml_args args)
let save_session = fun gui session_combo ->
(* Ask for a session name *)
let text = Gtk_tools.combo_value session_combo in
let text = if text = "" then "My session" else text in
match GToolbox.input_string ~ok:"Save" ~text ~title:"Session name" "Save custom session ?" with
None -> ""
| Some name ->
let current_processes =
List.map (fun hbox ->
let hbox = new GPack.box (Gobject.unsafe_cast hbox#as_widget) in
match hbox#children with
label::entry::_ ->
let label = new GMisc.label (Gobject.unsafe_cast label#as_widget)
and entry = new GEdit.entry (Gobject.unsafe_cast entry#as_widget) in
(label#text, entry#text)
| _ -> failwith "Internal error: save session")
gui#vbox_programs#children in
let current_programs = List.map parse_process_args current_processes in
let session = Xml.Element("session", ["name", name], current_programs) in
begin try Hashtbl.remove sessions name with _ -> () end;
Hashtbl.add sessions name session;
write_control_panel_xml ();
name
let double_quote = fun s ->
if String.contains s ' ' then
sprintf "\"%s\"" s
else
s
let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) ->
let run_gcs = fun () ->
run_and_monitor ?file gui log "GCS" ""
and run_server = fun args ->
run_and_monitor ?file gui log "Server" args
and run_sitl = fun ac_name ->
let args = sprintf "-a %s -boot -norc" ac_name in
run_and_monitor ?file gui log "Simulator" args
in
(* Sessions *)
let session_combo = Gtk_tools.combo [] gui#vbox_session in
let remove_custom_sessions = fun () ->
let (store, _column) = Gtk_tools.combo_model session_combo in
store#clear ()
in
let register_custom_sessions = fun () ->
remove_custom_sessions ();
Gtk_tools.add_to_combo session_combo "Simulation";
Gtk_tools.add_to_combo session_combo "Replay";
Gtk_tools.add_to_combo session_combo Gtk_tools.combo_separator;
Hashtbl.iter
(fun name _session ->
Gtk_tools.add_to_combo session_combo name)
sessions in
register_custom_sessions ();
Gtk_tools.select_in_combo session_combo "Simulation";
let execute_custom = fun session_name ->
let session = try Hashtbl.find sessions session_name with Not_found -> failwith (sprintf "Unknown session: %s" session_name) in
List.iter
(fun program ->
let name = ExtXml.attrib program "name" in
let p = ref "" in
List.iter
(fun arg ->
let constant =
try double_quote (Xml.attrib arg "constant") with _ -> "" in
p := sprintf "%s %s %s" !p (ExtXml.attrib arg "flag") constant)
(Xml.children program);
run_and_monitor ?file gui log name !p)
(Xml.children session)
in
(* Replay session *)
let replay = fun () ->
run_and_monitor ?file gui log "Log File Player" "";
run_server "-n";
run_gcs () in
(* Simulations *)
let simulation = fun () ->
run_gcs ();
run_server "-n";
run_sitl (Gtk_tools.combo_value ac_combo) in
(* Run session *)
let callback = fun () ->
match Gtk_tools.combo_value session_combo with
"Simulation" -> simulation ()
| "Replay" -> replay ()
| custom -> execute_custom custom in
ignore (gui#button_execute#connect#clicked ~callback);
(* Close session *)
let callback = fun () ->
close_programs gui in
ignore (gui#button_remove_all_processes#connect#clicked ~callback);
(* Tools *)
let entries = ref [] in
Hashtbl.iter
(fun name _prog ->
let cb = fun () ->
run_and_monitor ?file gui log name "" in
entries := `I (name, cb) :: !entries)
programs;
let compare = fun x y ->
match x, y with
`I (x, _), `I (y, _) -> compare x y
| _ -> compare x y in
let menu = GMenu.menu ()
and sorted_entries = List.sort compare !entries in
GToolbox.build_menu menu sorted_entries;
gui#programs_menu_item#set_submenu menu;
(* New session *)
let callback = fun () ->
match GToolbox.input_string ~title:"New session" ~text:"My session" "New session name ?" with
None -> ()
| Some s ->
Gtk_tools.add_to_combo session_combo s in
ignore (gui#menu_item_new_session#connect#activate ~callback);
(* Save new session *)
let callback = fun () ->
match save_session gui session_combo with
"" -> ()
| session_name ->
register_custom_sessions ();
Gtk_tools.select_in_combo session_combo session_name
in
ignore (gui#menu_item_save_session#connect#activate ~callback);
(* Remove current session *)
let callback = fun () ->
let session_name = Gtk_tools.combo_value session_combo in
match GToolbox.question_box ~title:"Delete custom session" ~buttons:["Cancel"; "Delete"] ~default:2 (sprintf "Delete '%s' custom session ? (NO undo)" session_name) with
2 ->
if Hashtbl.mem sessions session_name then begin
Hashtbl.remove sessions session_name;
write_control_panel_xml ();
register_custom_sessions ()
end;
close_programs gui
| _ -> ()
in
ignore (gui#menu_item_delete_session#connect#activate ~callback);
session_combo, execute_custom
Jump to Line
Something went wrong with that request. Please try again.