-
Notifications
You must be signed in to change notification settings - Fork 1.1k
/
paparazzicenter.ml
323 lines (270 loc) · 12.1 KB
/
paparazzicenter.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
(*
* 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
module Utils = Pc_common
module CP = Pc_control_panel
module AC = Pc_aircraft
let (//) = Filename.concat
let ios = int_of_string
let soi = string_of_int
(*********************** Preferences handling **************************)
let get_entry_value = fun xml name ->
let e = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = name) xml "entry" in
Xml.attrib e "value"
let read_preferences = fun (gui:Gtk_pc.window) file (ac_combo:Gtk_tools.combo) (session_combo:Gtk_tools.combo) (target_combo:Gtk_tools.combo) ->
let xml = ExtXml.parse_file file in
let read_one = fun name use ->
try
let ac_name = get_entry_value xml name in
use ac_name
with Not_found -> () in
(*********** Last A/C *)
read_one "last A/C" (Gtk_tools.select_in_combo ac_combo);
(*********** Last session *)
read_one "last session" (Gtk_tools.select_in_combo session_combo);
(*********** Last target *)
read_one "last target" (Gtk_tools.select_in_combo target_combo);
(*********** Window Size *)
read_one "width"
(fun width ->
read_one "height" (fun height -> gui#window#resize (ios width) (ios height)));
(*********** Left pane size *)
read_one "left_pane_width"
(fun width -> gui#vbox_left_pane#misc#set_size_request ~width:(ios width) ())
let gconf_entry = fun name value ->
Xml.Element ("entry", ["name", name;
"value", value;
"application", "paparazzi center"],
[])
let add_entry = fun xml name value ->
let entry = gconf_entry name value in
let select = fun x -> Xml.attrib x "name" = name in
let xml = ExtXml.remove_child ~select "entry" xml in
Xml.Element (Xml.tag xml, Xml.attribs xml, entry::Xml.children xml)
let write_preferences = fun (gui:Gtk_pc.window) file (ac_combo:Gtk_tools.combo) (session_combo:Gtk_tools.combo) (target_combo:Gtk_tools.combo) ->
let xml = if Sys.file_exists file then ExtXml.parse_file file else Xml.Element ("gconf", [], []) in
(* Save A/C name *)
let xml =
try
let ac_name = Gtk_tools.combo_value ac_combo in
add_entry xml "last A/C" ac_name
with Not_found -> xml in
(* Save session *)
let xml =
let session_name = Gtk_tools.combo_value session_combo in
add_entry xml "last session" session_name in
(* Save target *)
let xml = (
try
let name = Gtk_tools.combo_value target_combo in
add_entry xml "last target" name
with _ -> xml) in
let xml =
try
(* Save window size *)
let width, height = Gdk.Drawable.get_size gui#window#misc#window in
let xml = add_entry xml "width" (soi width) in
let xml = add_entry xml "height" (soi height) in
(* Save left pane width *)
let width = gui#hpaned#position in
let xml = add_entry xml "left_pane_width" (soi width) in
xml
with
Gpointer.Null ->
prerr_endline "Please properly quit to save layout preferences";
xml in
let f = open_out file in
Printf.fprintf f "%s\n" (ExtXml.to_string_fmt xml);
close_out f
let quit_callback = fun gui ac_combo session_combo target_combo _ ->
CP.close_programs gui;
write_preferences gui Env.gconf_file ac_combo session_combo target_combo;
exit 0
let quit_button_callback = fun gui ac_combo session_combo target_combo () ->
if Sys.file_exists Utils.backup_xml_file then begin
let rec question_box = fun () ->
match GToolbox.question_box ~title:"Quit" ~buttons:["Save changes"; "Discard changes"; "View changes"; "Cancel"] ~default:1 "Configuration changes have not been saved" with
| 2 ->
Sys.rename Utils.backup_xml_file Utils.conf_xml_file;
quit_callback gui ac_combo session_combo target_combo ()
| 3 ->
ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file));
question_box ()
| 1 ->
Sys.remove Utils.backup_xml_file;
quit_callback gui ac_combo session_combo target_combo ()
| _ -> () in
question_box ()
end else
match GToolbox.question_box ~title:"Quit" ~buttons:["Cancel"; "Quit"] ~default:2 "Quit ?" with
2 -> quit_callback gui ac_combo session_combo target_combo ()
| _ -> ()
(************************** Main *********************************************)
let () =
let session = ref ""
and fullscreen = ref false in
Arg.parse
["-fullscreen", Arg.Set fullscreen, "Fullscreen window";
"-session", Arg.Set_string session, "<session name> Run a custom session"]
(fun x -> fprintf stderr "Warning: Don't do anything with '%s'\n%!" x)
"Usage: ";
let file = Env.paparazzi_src // "sw" // "supervision" // "paparazzicenter.glade" in
let gui = new Gtk_pc.window ~file () in
if !fullscreen then
gui#window#fullscreen ();
gui#toplevel#show ();
let paparazzi_pixbuf = GdkPixbuf.from_file Env.icon_file in
gui#window#set_icon (Some paparazzi_pixbuf);
(* version string with whitespace/newline at the end stripped *)
let version_str = Env.get_paparazzi_version () in
let build_str =
try
let f = open_in (Env.paparazzi_home ^ "/var/build_version.txt") in
let s = try input_line f with _ -> "UNKNOWN" in
close_in f;
s
with _ -> "UNKNOWN" in
let s = gui#statusbar#new_context "env" in
ignore (s#push (sprintf "HOME=%s SRC=%s \tVersion=%s \tBuild=%s" Env.paparazzi_home Env.paparazzi_src version_str build_str));
if Sys.file_exists Utils.backup_xml_file then begin
let rec question_box = fun () ->
let message = "Configuration changes to conf/conf.xml were not saved during the last session.\nYou can either keep the current version or restore the auto-saved backup from the last session to discard the changes.\nIf you made any manual changes to conf/conf.xml and choose [Restore auto-backup] you will lose these." in
match GToolbox.question_box ~title:"Backup" ~buttons:["Keep current"; "Restore auto-backup"; "View changes"] ~default:2 message with
| 2 -> Sys.rename Utils.backup_xml_file Utils.conf_xml_file
| 3 -> ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box ()
| _ -> Sys.remove Utils.backup_xml_file in
question_box ()
end;
Utils.build_aircrafts ();
let ac_combo = AC.parse_conf_xml gui#vbox_ac
and target_combo = Gtk_tools.combo ~width:50 ["sim";"fbw";"ap"] gui#vbox_target
and flash_combo = Gtk_tools.combo ~width:50 ["Default"] gui#vbox_flash in
(Gtk_tools.combo_widget target_combo)#misc#set_sensitive false;
(Gtk_tools.combo_widget flash_combo)#misc#set_sensitive false;
gui#button_clean#misc#set_sensitive false;
gui#button_build#misc#set_sensitive false;
(* 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))
(* since tcl8.6 "green" refers to "darkgreen" and the former "green" is now "lime", but that is not available in older versions, so hardcode the color to #00ff00*)
["red"; "#00ff00"; "orange"; "cyan"; "yellow"] 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 errors = "red", ["error:"; "error "; "no such file"; "undefined reference"; "failure"; "multiple definition"]
and warnings = "orange", ["warning"]
and minor_warnings = "yellow", ["no srtm data found"]
and info = "#00ff00", ["pragma message"; "info:"]
and version = "cyan", ["paparazzi version"; "build aircraft"] in
let color_regexps =
List.map (fun (color, strings) ->
let s = List.map (fun s -> "\\("^s^"\\)") strings in
let s = String.concat "\\|" s in
let s = ".*\\("^s^"\\)" in
color, Str.regexp_case_fold s)
[errors; warnings; minor_warnings; info; version] in
let compute_tags = fun s ->
let rec loop = function
(color, regexp)::rs ->
if Str.string_match regexp s 0 then
[List.assoc color background_tags]
else
loop rs
| [] -> [] in
loop color_regexps in
let log = fun s ->
let iter = gui#console#buffer#end_iter in
let tags = compute_tags s in
gui#console#buffer#insert ~iter ~tags s;
(* 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
AC.ac_combo_handler gui ac_combo target_combo flash_combo log;
AC.build_handler ~file gui ac_combo target_combo flash_combo log;
let session_combo, execute_session = CP.supervision ~file gui log ac_combo target_combo in
(* Quit button *)
ignore (gui#menu_item_quit#connect#activate ~callback:(quit_button_callback gui ac_combo session_combo target_combo));
ignore (gui#window#event#connect#delete ~callback:(quit_callback gui ac_combo session_combo target_combo));
(* Fullscreen menu entry *)
let callback = fun () ->
fullscreen := not !fullscreen;
if !fullscreen then
gui#window#fullscreen ()
else
gui#window#unfullscreen () in
ignore (gui#menu_item_fullscreen#connect#activate ~callback);
(* Help/About menu entry *)
let aboutDialog = GWindow.about_dialog
~name:"Paparazzi Center"
~logo:paparazzi_pixbuf
~authors:["Pascal Brisset"]
~copyright:"Copyright (C) 2007-2008 ENAC, Pascal Brisset"
~license:"GPLv2"
~website:"http://paparazziuav.org"
~website_label:"http://paparazziuav.org"
(*~version:version_str*)
~position:`CENTER_ON_PARENT
~destroy_with_parent:true
~parent:gui#window
()
in
ignore (gui#menu_item_about#connect#activate ~callback:(fun () -> ignore (aboutDialog#run ()); aboutDialog#misc#hide ()));
let pprzInfoDialog (title,msg) =
(* somehow doen't show the pprz icon, but the default info icon instead *)
let dlg = GWindow.message_dialog
~title:title
~message:msg
~icon:paparazzi_pixbuf
~use_markup:true
~modal:true
~message_type:`INFO
~position:`CENTER_ON_PARENT
~destroy_with_parent:true
~parent:gui#window
~buttons:GWindow.Buttons.close () in
let res = dlg#run () = `CLOSE in
dlg#destroy ();
res
in
(* Help/Get Help menu entry *)
let help_text = "Primary documentation: Paparazzi wiki:\n<a href='https://wiki.paparazziuav.org'>https://wiki.paparazziuav.org</a>\n\nCommunity-based support, mailing list: <a href='https://wiki.paparazziuav.org/wiki/Contact'>Contact</a>\n\nThe Paparazzi auto-generated developer documentation:\n<a href='http://docs.paparazziuav.org'>http://docs.paparazziuav.org</a>\n\nPaparazzi sourcecode and issue tracker:\n<a href='https://github.com/paparazzi/paparazzi'>https://github.com/paparazzi/paparazzi</a>" in
ignore (gui#menu_item_get_help#connect#activate ~callback:(fun () -> ignore (pprzInfoDialog ("Getting Help with Paparazzi",help_text))));
(* Version *)
let version_msg = ("Run version:\t" ^ version_str ^ "\nBuild version:\t" ^ build_str) in
ignore (gui#menu_item_version#connect#activate ~callback:(fun () -> ignore (pprzInfoDialog ("Version",version_msg))));
(* Read preferences *)
if Sys.file_exists Env.gconf_file then begin
read_preferences gui Env.gconf_file ac_combo session_combo target_combo
end;
(* Run the command line session *)
if !session <> "" then begin
Gtk_tools.select_in_combo session_combo !session;
execute_session !session
end;
GMain.Main.main ();;