mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-06-02 05:17:03 +08:00
paparazzicenter in progress
This commit is contained in:
Pascal Brisset
@@ -6,25 +6,27 @@ 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
|
||||
PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.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 $^
|
||||
$(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma gtkInit.cmo lib-pprz.cma lablgnomeui.cma $^
|
||||
|
||||
gui.ml : paparazzicenter.glade
|
||||
gtk_pc.ml : paparazzicenter.glade
|
||||
lablgladecc2 -root window $< > $@
|
||||
|
||||
program.ml : paparazzicenter.glade
|
||||
lablgladecc2 -root hbox_program $< > $@
|
||||
gtk_process.ml : paparazzicenter.glade
|
||||
lablgladecc2 -root hbox_program $< | grep -B 1000000 " end" > $@
|
||||
|
||||
%.cmo : %.ml
|
||||
@echo OC $<
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -c $<
|
||||
|
||||
paparazzicenter.cmo : gui.cmo
|
||||
paparazzicenter.cmo : gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_control_panel.cmo pc_aircraft.cmo
|
||||
|
||||
pc_control_panel.cmo pc_aircraft.cmo : pc_common.cmo
|
||||
|
||||
clean:
|
||||
\rm *.cm* gui.ml
|
||||
\rm *.cm* gtk_pc.ml gtk_process.ml
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,369 +1,93 @@
|
||||
(*
|
||||
* $Id$
|
||||
*
|
||||
* Paparazzi center main module
|
||||
*
|
||||
* 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
|
||||
open Pc_common
|
||||
module CP = Pc_control_panel
|
||||
module AC = Pc_aircraft
|
||||
|
||||
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));
|
||||
let gui = new Gtk_pc.window ~file () in
|
||||
ignore (gui#window#connect#destroy ~callback:(fun _ -> CP.close_programs gui; exit 0));
|
||||
gui#toplevel#show ();
|
||||
|
||||
let ac_combo = parse_conf_xml gui#vbox_ac
|
||||
let ac_combo = AC.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;
|
||||
AC.ac_combo_handler gui ac_combo target_combo;
|
||||
|
||||
conf_handler gui;
|
||||
AC.conf_handler gui;
|
||||
|
||||
(* Change the buffer of the text view to attach a tag_table *)
|
||||
let background_tags =
|
||||
List.map (fun color ->
|
||||
let tag = GText.tag ~name:color () in
|
||||
tag#set_property (`BACKGROUND color);
|
||||
(color, tag))
|
||||
["red"; "green"] in
|
||||
let tag_table = GText.tag_table () in
|
||||
List.iter (fun (color, tag) -> tag_table#add tag#as_tag) background_tags;
|
||||
let buffer = GText.buffer ~tag_table () in
|
||||
gui#console#set_buffer buffer;
|
||||
|
||||
let error_regexp = Str.regexp_case_fold ".*\\(error\\)\\|\\(no such file\\)" in
|
||||
let compute_tags = fun s ->
|
||||
if Str.string_match error_regexp s 0 then
|
||||
[List.assoc "red" background_tags]
|
||||
else
|
||||
[] in
|
||||
|
||||
let log = fun s ->
|
||||
gui#console#buffer#insert s;
|
||||
gui#console#buffer#insert "\n";
|
||||
let iter = gui#console#buffer#end_iter in
|
||||
let tags = compute_tags s in
|
||||
gui#console#buffer#insert ~iter ~tags s;
|
||||
let iter = gui#console#buffer#end_iter in
|
||||
gui#console#buffer#insert ~iter "\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;
|
||||
AC.build_handler gui ac_combo target_combo log;
|
||||
|
||||
supervision gui;
|
||||
CP.supervision ~file gui log;
|
||||
|
||||
GMain.Main.main ()
|
||||
(* GCS plugin
|
||||
Cannot reattach a new window: hack by kill and remake the socket *)
|
||||
let rec socket = fun () ->
|
||||
let socket_GCS = GWindow.socket ~packing:gui#vbox_GCS#add () in
|
||||
CP.socket_GCS_id := socket_GCS#xwindow;
|
||||
ignore(socket_GCS#connect#plug_removed
|
||||
(fun () -> gui#vbox_GCS#remove socket_GCS#coerce; socket ())) in
|
||||
socket ();
|
||||
|
||||
GMain.Main.main ();;
|
||||
|
||||
@@ -0,0 +1,303 @@
|
||||
(*
|
||||
* $Id$
|
||||
*
|
||||
* Paparazzi center aircraft 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 Pc_common
|
||||
open Printf
|
||||
|
||||
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/basic.xml";
|
||||
"gui_color", "blue"],
|
||||
[])
|
||||
|
||||
|
||||
|
||||
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
|
||||
|
||||
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 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 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;
|
||||
aircrafts_table_has_changed := true;
|
||||
(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;
|
||||
aircrafts_table_has_changed := true;
|
||||
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:combo) (log:string->unit) ->
|
||||
(* Link target to upload button *)
|
||||
combo_connect target_combo
|
||||
(fun target ->
|
||||
gui#button_upload#misc#set_sensitive (target <> "sim"));
|
||||
|
||||
(* New Target button *)
|
||||
let callback = fun _ ->
|
||||
match GToolbox.input_string ~title:"New Target" ~text:"tunnel" "New build target ?" with
|
||||
None -> ()
|
||||
| Some s ->
|
||||
let (store, column) = combo_model target_combo in
|
||||
let row = store#append () in
|
||||
store#set ~row ~column s;
|
||||
(combo_widget target_combo)#set_active_iter (Some row)
|
||||
in
|
||||
ignore (gui#button_new_target#connect#clicked ~callback);
|
||||
|
||||
|
||||
(* 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
|
||||
let target = if target="sim" then target else sprintf "%s.compile" target 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 (Filename.basename 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)
|
||||
@@ -0,0 +1,118 @@
|
||||
(*
|
||||
* $Id$
|
||||
*
|
||||
* Paparazzi center utilities
|
||||
*
|
||||
* 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
|
||||
|
||||
let (//) = Filename.concat
|
||||
let conf_dir = Env.paparazzi_home // "conf"
|
||||
|
||||
(** From OCaml otherlibs/unix/unix.ml *)
|
||||
let my_open_process_in = fun cmd ->
|
||||
let (in_read, in_write) = Unix.pipe () in
|
||||
let inchan = Unix.in_channel_of_descr in_read in
|
||||
let pid = Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; cmd|] Unix.stdin in_write Unix.stderr in
|
||||
Unix.close in_write;
|
||||
pid, inchan
|
||||
|
||||
|
||||
let run_and_log = fun log com ->
|
||||
let com = com ^ " 2>&1" in
|
||||
let pid, com_stdout = my_open_process_in com in
|
||||
let channel_out = GMain.Io.channel_of_descr (Unix.descr_of_in_channel com_stdout) in
|
||||
let cb = fun ev -> if List.mem `IN ev then begin log (input_line com_stdout); true end else begin log (sprintf "\nDONE (%s)\n" com); false end in
|
||||
let _io_watch_out = Glib.Io.add_watch [`IN; `HUP] cb channel_out in
|
||||
pid, channel_out
|
||||
|
||||
let command = fun (log:string->unit) ac_name target ->
|
||||
let com = sprintf "export PATH=/usr/bin:$PATH; make -C %s -f Makefile.ac AIRCRAFT=%s %s" Env.paparazzi_src ac_name target in
|
||||
log com;
|
||||
ignore (run_and_log log com)
|
||||
|
||||
type combo = GEdit.combo_box * (GTree.list_store * string GTree.column)
|
||||
let combo_widget = fst
|
||||
let combo_model = snd
|
||||
|
||||
|
||||
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 conf_is_set = fun home ->
|
||||
Sys.file_exists home &&
|
||||
Sys.file_exists (home // "conf") &&
|
||||
Sys.file_exists (home // "data")
|
||||
|
||||
let druid = fun home ->
|
||||
let w = GWindow.window ~title:"Configuring Paparazzi" () in
|
||||
|
||||
let d = GnoDruid.druid ~packing:w#add () in
|
||||
|
||||
ignore (d#connect#cancel (fun () -> exit 1));
|
||||
|
||||
begin
|
||||
let fp = GnoDruid.druid_page_edge ~position:`START ~aa:true ~title:"Configure Paparazzi !!" () in
|
||||
fp#set_text (sprintf "Configuration files need to be installed in your Paparazzi home (%s). To use another directory, please exit this utility, set the PAPARAZZI_HOME variable to the desired folder and restart." home);
|
||||
d#append_page fp;
|
||||
ignore (fp#connect#next
|
||||
(fun _ ->
|
||||
command prerr_endline "" "init";
|
||||
false
|
||||
))
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
let ep = GnoDruid.druid_page_edge ~position:`FINISH ~aa:true ~title:"The end" () in
|
||||
ep#set_text "You are ready. Congratulations!" ;
|
||||
d#append_page ep ;
|
||||
|
||||
ignore (ep#connect#finish
|
||||
(fun _ ->
|
||||
w#destroy ();
|
||||
GMain.quit ()
|
||||
))
|
||||
end;
|
||||
w#show ();
|
||||
GMain.main ()
|
||||
|
||||
let _ =
|
||||
let home = Env.paparazzi_home in
|
||||
if not (conf_is_set home) then
|
||||
druid home
|
||||
|
||||
let conf_xml_file = conf_dir // "conf.xml"
|
||||
let conf_xml = Xml.parse_file conf_xml_file
|
||||
let aircrafts = Hashtbl.create 7
|
||||
let aircrafts_table_has_changed = ref false
|
||||
let _ =
|
||||
List.iter (fun aircraft ->
|
||||
Hashtbl.add aircrafts (ExtXml.attrib aircraft "name") aircraft)
|
||||
(Xml.children conf_xml);
|
||||
aircrafts_table_has_changed := true
|
||||
@@ -0,0 +1,314 @@
|
||||
(*
|
||||
* $Id$
|
||||
*
|
||||
* Paparazzi center process 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
|
||||
open Pc_common
|
||||
|
||||
let socket_GCS_id = ref (Int32.of_int 0)
|
||||
|
||||
let control_panel_xml_file = conf_dir // "control_panel.xml"
|
||||
let control_panel_xml = Xml.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 ->
|
||||
let xml = Hashtbl.find programs x in
|
||||
Env.paparazzi_src // ExtXml.attrib xml "command"
|
||||
|
||||
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 ?(plugged=false) gui log com_name args ->
|
||||
let com = program_command com_name in
|
||||
let c = sprintf "%s %s" com args in
|
||||
let p = new Gtk_process.hbox_program ?file () in
|
||||
(gui#vbox_programs:GPack.box)#pack p#toplevel#coerce;
|
||||
p#label_com_name#set_text com_name;
|
||||
p#entry_program#set_text c;
|
||||
let pid = ref (-1) in
|
||||
let run = fun callback ->
|
||||
let c = p#entry_program#text in
|
||||
let c = if plugged then sprintf "%s -wid 0x%lx" c !socket_GCS_id else c in
|
||||
if plugged then
|
||||
gui#notebook#goto_page 2; (* FIXME *)
|
||||
log (sprintf "Run '%s'" c);
|
||||
let (pi, out) = run_and_log log ("exec "^c) in
|
||||
pid := pi;
|
||||
ignore (Glib.Io.add_watch [`HUP] (fun _ -> callback true; false) out) in
|
||||
let rec callback = fun stop ->
|
||||
match p#button_stop#label, stop with
|
||||
"gtk-stop", _ ->
|
||||
ignore (Unix.kill !pid Sys.sigkill);
|
||||
p#button_stop#set_label "gtk-redo";
|
||||
p#button_remove#misc#set_sensitive true;
|
||||
if stop && p#checkbutton_autolaunch#active then
|
||||
callback false
|
||||
| "gtk-redo", false ->
|
||||
p#button_stop#set_label "gtk-stop";
|
||||
run callback;
|
||||
p#button_remove#misc#set_sensitive false
|
||||
| _ -> ()
|
||||
in
|
||||
ignore (p#button_stop#connect#clicked ~callback:(fun () -> callback false));
|
||||
run callback;
|
||||
|
||||
(* Stop the program if the box is removed *)
|
||||
let callback = fun w ->
|
||||
callback true in
|
||||
ignore(p#toplevel#connect#destroy ~callback);
|
||||
|
||||
(* Remove button *)
|
||||
let callback = fun () ->
|
||||
gui#vbox_programs#remove p#toplevel#coerce in
|
||||
ignore (p#button_remove#connect#clicked ~callback)
|
||||
|
||||
|
||||
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 ->
|
||||
(* Ask for a session name *)
|
||||
let text = gui#entry_session_name#text in
|
||||
let text = if text = "" then "My session" else text in
|
||||
match GToolbox.input_string ~ok:"Save" ~text ~title:"Session name" "Save user session ?" with
|
||||
None -> false
|
||||
| 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 ();
|
||||
true
|
||||
|
||||
let double_quote = fun s ->
|
||||
if String.contains s ' ' then
|
||||
sprintf "\"%s\"" s
|
||||
else
|
||||
s
|
||||
|
||||
|
||||
let supervision = fun ?file gui log ->
|
||||
let supervision_page = 1 in (* FIXME *)
|
||||
|
||||
let run_gcs = fun () ->
|
||||
run_and_monitor ?file ~plugged:true gui log "gcs" ""
|
||||
and run_server = fun () ->
|
||||
run_and_monitor ?file gui log "server" ""
|
||||
and run_link = fun args ->
|
||||
run_and_monitor ?file gui log "link" args
|
||||
and run_sitl = fun ac_name ->
|
||||
let args = sprintf "-a %s -boot -norc" ac_name in
|
||||
run_and_monitor ?file gui log "sim" args
|
||||
in
|
||||
|
||||
(* Replay menu *)
|
||||
let callback = fun () ->
|
||||
gui#entry_session_name#set_text "Replay";
|
||||
run_and_monitor ?file gui log "play" "";
|
||||
run_server ();
|
||||
run_gcs ()
|
||||
in
|
||||
ignore (gui#replay_menu_item#connect#activate ~callback);
|
||||
|
||||
(* Close session *)
|
||||
let callback = fun () ->
|
||||
close_programs gui in
|
||||
ignore (gui#button_remove_all_processes#connect#clicked ~callback);
|
||||
|
||||
(* Programs *)
|
||||
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 menu = GMenu.menu ()
|
||||
and sorted_entries = List.sort compare !entries in
|
||||
GToolbox.build_menu menu sorted_entries;
|
||||
gui#programs_menu_item#set_submenu menu;
|
||||
|
||||
(* Simulations *)
|
||||
let insert_sims_in_menu = fun num_page ->
|
||||
if num_page = supervision_page && !aircrafts_table_has_changed then
|
||||
let entries = ref [] in
|
||||
Hashtbl.iter
|
||||
(fun ac_name ac ->
|
||||
let cb = fun () ->
|
||||
gui#entry_session_name#set_text (sprintf "Sim %s" ac_name);
|
||||
run_gcs ();
|
||||
run_server ();
|
||||
run_sitl ac_name
|
||||
in
|
||||
entries := `I (ac_name, cb) :: !entries)
|
||||
aircrafts;
|
||||
let menu = GMenu.menu ()
|
||||
and sorted_entries = List.sort compare !entries in
|
||||
GToolbox.build_menu menu sorted_entries;
|
||||
gui#sim_menu_item#set_submenu menu;
|
||||
aircrafts_table_has_changed := false in
|
||||
|
||||
ignore (gui#notebook#connect#switch_page ~callback:insert_sims_in_menu);
|
||||
|
||||
(* Sessions *)
|
||||
let insert_sessions_in_menu = fun () ->
|
||||
let entries = ref [] in
|
||||
let cb = fun name session () ->
|
||||
gui#entry_session_name#set_text name;
|
||||
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 ~plugged:(name="gcs") ?file gui log name !p)
|
||||
(Xml.children session)
|
||||
in
|
||||
Hashtbl.iter
|
||||
(fun name session ->
|
||||
entries := `I (name, cb name session) :: !entries)
|
||||
sessions;
|
||||
let menu = GMenu.menu ()
|
||||
and sorted_entries = List.sort compare !entries in
|
||||
GToolbox.build_menu menu sorted_entries;
|
||||
gui#session_menu_item#set_submenu menu in
|
||||
|
||||
insert_sessions_in_menu ();
|
||||
|
||||
(* Add new session *)
|
||||
let callback = fun () ->
|
||||
if save_session gui then
|
||||
insert_sessions_in_menu () in
|
||||
ignore (gui#button_save_session#connect#clicked ~callback);
|
||||
|
||||
(* Remove current session *)
|
||||
let callback = fun () ->
|
||||
let session_name = gui#entry_session_name#text in
|
||||
match GToolbox.question_box ~title:"Delete user session" ~buttons:["Cancel"; "Delete"] ~default:2 (sprintf "Delete '%s' user session ? (NO undo)" session_name) with
|
||||
2 ->
|
||||
if Hashtbl.mem sessions session_name then begin
|
||||
Hashtbl.remove sessions session_name;
|
||||
write_control_panel_xml ();
|
||||
insert_sessions_in_menu ()
|
||||
end;
|
||||
close_programs gui;
|
||||
gui#entry_session_name#set_text ""
|
||||
| _ -> ()
|
||||
in
|
||||
ignore (gui#button_delete_session#connect#clicked ~callback);
|
||||
|
||||
(* Flights *)
|
||||
let cb = fun name args () ->
|
||||
gui#entry_session_name#set_text (sprintf "Fly with %s" name);
|
||||
run_gcs ();
|
||||
run_server ();
|
||||
run_link args
|
||||
in
|
||||
let entries =
|
||||
[`I ("XBee", cb "XBee" "-transport xbee -uplink");
|
||||
`I ("Aerocomm", cb "Aerocomm" "-s 57600 -aerocomm -uplink");
|
||||
`I ("Serial", cb "Serial" "-uplink")] in
|
||||
let menu = GMenu.menu ()
|
||||
and sorted_entries = List.sort compare entries in
|
||||
GToolbox.build_menu menu sorted_entries;
|
||||
gui#fly_menu_item#set_submenu menu
|
||||
|
||||
Reference in New Issue
Block a user