diff --git a/Makefile b/Makefile index 0cd46f1310..ee33e1c831 100644 --- a/Makefile +++ b/Makefile @@ -61,7 +61,6 @@ STATICINCLUDE=$(PAPARAZZI_HOME)/var/include CONF=$(PAPARAZZI_SRC)/conf AIRBORNE=sw/airborne SIMULATOR=sw/simulator -COCKPIT=sw/ground_segment/cockpit TMTC=sw/ground_segment/tmtc GENERATORS=$(PAPARAZZI_SRC)/sw/tools/generators JOYSTICK=sw/ground_segment/joystick @@ -72,11 +71,10 @@ TOOLS=sw/tools # build some stuff in subdirs # nothing should depend on these... # -PPRZCENTER=sw/supervision MISC=sw/ground_segment/misc LOGALIZER=sw/logalizer -SUBDIRS = $(PPRZCENTER) $(LOGALIZER) sw/tools +SUBDIRS = $(LOGALIZER) sw/tools SUBDIRS_EXTRA = $(MISC) # @@ -138,9 +136,9 @@ conf/tools/blacklisted: conf/tools/blacklisted_example cp conf/tools/blacklisted_example conf/tools/blacklisted ground_segment: _print_building conf libpprz subdirs static -ground_segment.opt: ground_segment cockpit.opt tmtc.opt +ground_segment.opt: ground_segment tmtc.opt -static: cockpit tmtc generators sim_static joystick static_h +static: tmtc generators sim_static joystick static_h libpprzlink.update: $(MAKE) -C $(EXT) pprzlink.update @@ -151,12 +149,6 @@ libpprzlink.install: libpprz: libpprzlink.update libpprzlink.install _save_build_version $(MAKE) -C $(LIB)/ocaml -cockpit: libpprz - $(MAKE) -C $(COCKPIT) - -cockpit.opt: libpprz - $(MAKE) -C $(COCKPIT) opt - tmtc: libpprz $(MAKE) -C $(TMTC) @@ -193,8 +185,6 @@ $(SUBDIRS): libpprz $(SUBDIRS_EXTRA): libpprz $(MAKE) -C $@ -$(PPRZCENTER): libpprz - $(LOGALIZER): libpprz static_h: pprzlink_protocol $(GEN_HEADERS) @@ -355,7 +345,7 @@ test_full: .PHONY: all print_build_version _print_building _save_build_version init dox ground_segment ground_segment.opt \ -subdirs $(SUBDIRS) conf ext libpprz libpprzlink.update libpprzlink.install cockpit cockpit.opt tmtc tmtc.opt generators\ +subdirs $(SUBDIRS) conf ext libpprz libpprzlink.update libpprzlink.install tmtc tmtc.opt generators\ static sim_static opencv_bebop\ clean cleanspaces ab_clean dist_clean distclean dist_clean_irreversible \ test test_examples test_math test_all_confs diff --git a/conf/tools/gcs.xml b/conf/tools/gcs.xml deleted file mode 100644 index 11a668670d..0000000000 --- a/conf/tools/gcs.xml +++ /dev/null @@ -1,4 +0,0 @@ - - - - diff --git a/conf/tools/pprzgcs.xml b/conf/tools/pprzgcs.xml index a64aa478fd..1bd2611425 100644 --- a/conf/tools/pprzgcs.xml +++ b/conf/tools/pprzgcs.xml @@ -1,2 +1 @@ - - + diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile deleted file mode 100644 index 308662279e..0000000000 --- a/sw/ground_segment/cockpit/Makefile +++ /dev/null @@ -1,170 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- -# -# Copyright (C) 2003 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. -# - -# Quiet compilation -Q=@ - -OCAMLCFLAGS=-thread -ccopt -fPIC - -include ../../Makefile.ocaml -OCAMLPATH:=$(shell echo $(PAPARAZZI_SRC)/sw/ground_segment/cockpit/lib:$(OCAMLPATH)) -export OCAMLPATH - -ifneq ($(USE_LABELGTK),lablgtk2) -all : - @echo Skipping legacy GCS build \(missing lablgtk2\) - -opt : - @echo Skipping legacy GCS.opt build \(missing lablgtk2\) - -else -INCLUDES= -PKG = -package lablgtk2,pprzlink,gcslib -LINKPKG = $(PKG) -linkpkg -dllpath-pkg lablgtk2,pprzlink,gcslib,pprz - -LABLGTK2INIT = $(shell ocamlfind query -p-format lablgtk2.init 2>/dev/null) -ifeq ($(LABLGTK2INIT),) -LABLGTK2INIT = $(shell ocamlfind query -p-format lablgtk2.auto-init 2>/dev/null) -endif - -LABLGTK2GLADE = $(shell ocamlfind query -p-format lablgtk2.glade 2>/dev/null) -LABLGTK2CANVAS = $(shell ocamlfind query -p-format lablgtk2-gnome.gnomecanvas 2>/dev/null) - -ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml intruders.ml shapes.ml live.ml particules.ml papgets.ml gcs.ml -MAIN=gcs -CMO=$(ML:.ml=.cmo) -CMX=$(ML:.ml=.cmx) - -# only compile it lablgtk2 is installed -ifeq ($(LABLGTK2INIT),) -all : - @echo Skipping legacy GCS build \(missing lablgtk2.init\) - -opt : - @echo Skipping legacy GCS.opt build \(missing lablgtk2.init\) - -else - -ifeq ($(LABLGTK2GLADE),) - -all : - @echo Skipping legacy GCS build \(missing lablgtk2.glade\) - -opt : - @echo Skipping legacy GCS.opt build \(missing lablgtk2.glade\) - -else - -ifeq ($(LABLGTK2CANVAS),) - -all : - @echo Skipping legacy GCS build \(missing lablgtk2-gnome.gnomecanvas\) - -opt : - @echo Skipping legacy GCS.opt build \(missing lablgtk2-gnome.gnomecanvas\) - -else -all : $(MAIN) - -opt : $(MAIN).opt - -endif -endif -endif -endif - -gcslib : - $(Q)$(MAKE) -C lib - -$(MAIN) : $(CMO) $(LIBPPRZCMA) $(LIBPPRZLINKCMA) $(XLIBPPRZCMA) gcslib - @echo OL $@ - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LINKPKG) $(CMO) -o $@ - -$(MAIN).opt : $(CMX) $(LIBPPRZCMXA) $(LIBPPRZLINKCMXA) $(XLIBPPRZCMXA) gcslib - @echo OOL $@ - $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -package pprz.xlib,$(LABLGTK2INIT) -linkpkg $(CMX) -o $@ - -%.cmo: %.ml - @echo OC $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< -%.cmi: %.mli - @echo OCI $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< -%.cmx: %.ml - @echo OOC $< - $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< - -saveSettings.cmo : gtk_save_settings.cmo -saveSettings.cmx: gtk_save_settings.cmx - -gtk_strip.ml : gcs.glade - @echo GLADE $@ - $(Q)lablgladecc2 -root eventbox_strip -hide-default $< | grep -B 1000000 " end" > $@ - -gtk_setting_time.ml : gcs.glade - @echo GLADE $@ - $(Q)lablgladecc2 -root setting_time -hide-default $< | grep -B 1000000 " end" > $@ - -gtk_save_settings.ml : gcs.glade - @echo GLADE $@ - $(Q)lablgladecc2 -root save_settings -hide-default $< | grep -B 1000000 " end" > $@ - -strip.cmo : gtk_strip.cmo gtk_setting_time.cmo - -compass : compass.ml - @echo OL $@ - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LINKPKG) gtkInit.cmo $^ -o $@ - - -clean: - $(Q)rm -f *~* *.cm* *.o *.out *.opt map2d gcs .depend gtk_strip.ml gtk_setting_time.ml gtk_save_settings.ml compass ant_track ant_track_pmm ant_track_pmm_gtk3 actuators - $(MAKE) -C lib clean - -.PHONY: all opt clean - - -CC = gcc -CFLAGS=-g -O2 -Wall $(shell pkg-config gtk+-2.0 --cflags) -fPIC -LDFLAGS=$(shell pkg-config gtk+-2.0 --libs) -s -lglibivy -lm -lpcre - - -ant_track : ant_track.c - $(CC) $(CFLAGS) -g -o $@ $^ $(LDFLAGS) - -ant_track_pmm : ant_track_pmm.c - $(CC) -g -O2 -Wall $(shell pkg-config gtk+-3.0 --cflags) -fPIC -g -o $@ $^ $(shell pkg-config gtk+-3.0 --libs) -s -lglibivy -lm -lpcre -rdynamic - -actuators : actuators.c - $(CC) $(CFLAGS) -g -o $@ $^ $(LDFLAGS) - - -# -# Dependencies -# - -.depend: Makefile - @echo DEPEND $@ - $(Q)$(OCAMLDEP) -I $(LIBPPRZDIR) -I lib $(ML) lib/*.mli *.mli > .depend - -ifneq ($(MAKECMDGOALS),clean) --include .depend -endif diff --git a/sw/ground_segment/cockpit/actuators.c b/sw/ground_segment/cockpit/actuators.c deleted file mode 100644 index 8d7a950862..0000000000 --- a/sw/ground_segment/cockpit/actuators.c +++ /dev/null @@ -1,67 +0,0 @@ -#include -#include -#include -#include -#include - -#include -#include - -#include - -gint ac_id = 42; -GtkWidget *spin; /* awfull but a lot easier */ - -void on_scale_value_changed (GtkScale *scale, gpointer user_data) { - gfloat cf = gtk_range_get_value(GTK_RANGE(scale)); - gint c = (gint)rint(cf); - - gfloat sf = gtk_spin_button_get_value (( GtkSpinButton*)spin); - gint s = (gint)rint(sf); - - IvySendMsg("actuators_gtk RAW_DATALINK %d SET_ACTUATOR;%d;%d;%d", ac_id, c, s, ac_id); -} - -GtkWidget* build_gui ( void ) { - GtkWidget *window1; - GtkWidget *vbox1; - - window1 = gtk_window_new (GTK_WINDOW_TOPLEVEL); - gtk_window_set_title (GTK_WINDOW (window1), "Set Actuators"); - gtk_window_set_default_size(GTK_WINDOW (window1), 320, -1); - - vbox1 = gtk_vbox_new (FALSE, 0); - gtk_container_add (GTK_CONTAINER (window1), vbox1); - - GtkWidget *scale = gtk_hscale_new (GTK_ADJUSTMENT (gtk_adjustment_new (1500, 1000, 2000, 1, 1, 0))); - gtk_box_pack_start (GTK_BOX (vbox1), scale, TRUE, TRUE, 0); - gtk_range_set_update_policy (GTK_RANGE (scale), GTK_UPDATE_DELAYED); - g_signal_connect ((gpointer) scale, "value_changed", - G_CALLBACK (on_scale_value_changed), - (gpointer)0); - - spin = gtk_spin_button_new(GTK_ADJUSTMENT (gtk_adjustment_new (0, 0, 8, 1, 1, 0)), 1, 0); - gtk_box_pack_start (GTK_BOX (vbox1), spin, TRUE, TRUE, 0); - - return window1; -} - - -int main (int argc, char** argv) { - gtk_init(&argc, &argv); - - if (argc > 1) { - ac_id = atoi(argv[1]); - } else { - g_message("Warning: A/C id not specified; sending to %d", ac_id); - } - - GtkWidget* window = build_gui(); - gtk_widget_show_all(window); - - IvyInit ("Setup Actuators", "Actuators READY", NULL, NULL, NULL, NULL); - IvyStart("127.255.255.255"); - - gtk_main(); - return 0; -} diff --git a/sw/ground_segment/cockpit/ant_track.c b/sw/ground_segment/cockpit/ant_track.c deleted file mode 100644 index 6332d9143f..0000000000 --- a/sw/ground_segment/cockpit/ant_track.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - * Copyright (C) 2009 - Pascal Brisset, Antoine Drouin - * - * Modified by: Mark Griffin - * - * 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. - * - */ -#include -#include -#include -#include -#include - -#include -#include - -#define MANUAL 0 -#define AUTO 1 - -static double gps_pos_x; -static double gps_pos_y; -static double gps_alt; -static double home_alt; -static double ant_azim; -static double ant_elev; -static int mode; -static int home_found=0; - -GtkWidget *azim_scale; -GtkWidget *elev_scale; - -void on_mode_changed (GtkRadioButton *radiobutton, gpointer user_data) { - mode = gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(radiobutton)) ? MANUAL : AUTO; - IvySendMsg("1ME RAW_DATALINK 80 SETTING;0;0;%d", mode); - g_message("Mode changed to %d" , mode); -} - -#define GLADE_HOOKUP_OBJECT(component,widget,name) \ - g_object_set_data_full (G_OBJECT (component), name, \ - gtk_widget_ref (widget), (GDestroyNotify) gtk_widget_unref) - -#define GLADE_HOOKUP_OBJECT_NO_REF(component,widget,name) \ - g_object_set_data (G_OBJECT (component), name, widget) - -GtkWidget* build_gui ( void ) { - GtkWidget *window1; - GtkWidget *vbox1; - GtkWidget *vbox2; - GtkWidget *table1; - GtkWidget *label1; - GtkWidget *label2; - GtkWidget *label3; - GtkWidget *label4; - GtkWidget *radiobutton1; - GSList *radiobutton1_group = NULL; - GtkWidget *radiobutton2; - GtkWidget *entry1; - - window1 = gtk_window_new (GTK_WINDOW_TOPLEVEL); - gtk_window_set_title (GTK_WINDOW (window1), "tracking antenna"); - - vbox1 = gtk_vbox_new (FALSE, 0); - gtk_widget_show (vbox1); - gtk_container_add (GTK_CONTAINER (window1), vbox1); - - vbox2 = gtk_vbox_new (FALSE, 0); - gtk_widget_show (vbox2); - gtk_box_pack_start (GTK_BOX (vbox1), vbox2, TRUE, TRUE, 0); - - table1 = gtk_table_new (4, 3, FALSE); - gtk_widget_show (table1); - gtk_box_pack_start (GTK_BOX (vbox2), table1, TRUE, TRUE, 0); - gtk_table_set_col_spacings (GTK_TABLE (table1), 5); - - label1 = gtk_label_new ("Azimuth"); - gtk_widget_show (label1); - gtk_table_attach (GTK_TABLE (table1), label1, 0, 1, 1, 2, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_misc_set_alignment (GTK_MISC (label1), 0, 0.5); - - label2 = gtk_label_new ("Elevation"); - gtk_widget_show (label2); - gtk_table_attach (GTK_TABLE (table1), label2, 0, 1, 2, 3, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_misc_set_alignment (GTK_MISC (label2), 0, 0.5); - - label3 = gtk_label_new ("Id"); - gtk_widget_show (label3); - gtk_table_attach (GTK_TABLE (table1), label3, 0, 1, 3, 4, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_misc_set_alignment (GTK_MISC (label3), 0, 0.5); - - label4 = gtk_label_new ("mode"); - gtk_widget_show (label4); - gtk_table_attach (GTK_TABLE (table1), label4, 0, 1, 0, 1, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_misc_set_alignment (GTK_MISC (label4), 0, 0.5); - - radiobutton1 = gtk_radio_button_new_with_mnemonic (NULL, "manual"); - gtk_widget_show (radiobutton1); - gtk_table_attach (GTK_TABLE (table1), radiobutton1, 1, 2, 0, 1, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_radio_button_set_group (GTK_RADIO_BUTTON (radiobutton1), radiobutton1_group); - radiobutton1_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (radiobutton1)); - - radiobutton2 = gtk_radio_button_new_with_mnemonic (NULL, "tracking"); - gtk_widget_show (radiobutton2); - gtk_table_attach (GTK_TABLE (table1), radiobutton2, 2, 3, 0, 1, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - gtk_radio_button_set_group (GTK_RADIO_BUTTON (radiobutton2), radiobutton1_group); - radiobutton1_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (radiobutton2)); - - azim_scale = gtk_hscale_new (GTK_ADJUSTMENT (gtk_adjustment_new (144.7, 0, 360, 1, 1, 1))); - gtk_widget_show (azim_scale); - gtk_table_attach (GTK_TABLE (table1), azim_scale, 1, 3, 1, 2, - (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), - (GtkAttachOptions) (GTK_FILL), 0, 0); - gtk_range_set_update_policy (GTK_RANGE (azim_scale), GTK_UPDATE_DELAYED); - - elev_scale = gtk_hscale_new (GTK_ADJUSTMENT (gtk_adjustment_new (32.3, 0, 90, 1, 1, 1))); - gtk_widget_show (elev_scale); - gtk_table_attach (GTK_TABLE (table1), elev_scale, 1, 3, 2, 3, - (GtkAttachOptions) (GTK_FILL), - (GtkAttachOptions) (GTK_FILL), 0, 0); - - entry1 = gtk_entry_new (); - gtk_widget_show (entry1); - gtk_table_attach (GTK_TABLE (table1), entry1, 1, 3, 3, 4, - (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), - (GtkAttachOptions) (0), 0, 0); - - g_signal_connect ((gpointer) radiobutton1, "toggled", - G_CALLBACK (on_mode_changed), - NULL); - - /* Store pointers to all widgets, for use by lookup_widget(). */ - GLADE_HOOKUP_OBJECT_NO_REF (window1, window1, "window1"); - GLADE_HOOKUP_OBJECT (window1, vbox1, "vbox1"); - GLADE_HOOKUP_OBJECT (window1, vbox2, "vbox2"); - GLADE_HOOKUP_OBJECT (window1, table1, "table1"); - GLADE_HOOKUP_OBJECT (window1, label1, "label1"); - GLADE_HOOKUP_OBJECT (window1, label2, "label2"); - GLADE_HOOKUP_OBJECT (window1, label3, "label3"); - GLADE_HOOKUP_OBJECT (window1, label4, "label4"); - GLADE_HOOKUP_OBJECT (window1, radiobutton1, "radiobutton1"); - GLADE_HOOKUP_OBJECT (window1, radiobutton2, "radiobutton2"); - GLADE_HOOKUP_OBJECT (window1, entry1, "entry1"); - - return window1; -} - -/* jump here when a GPS message is received */ -void on_GPS_STATUS(IvyClientPtr app, void *user_data, int argc, char *argv[]){ - if (home_found == 0) { - if (atof(argv[0]) == 3) { /* wait until we have a valid GPS fix */ - home_alt = atof(argv[4])/100.; /* get the altitude */ - home_found = 1; - } - } - gps_alt = atof(argv[4])/100.; -} - -/* jump here when a NAVIGATION message is received */ -void on_NAV_STATUS(IvyClientPtr app, void *user_data, int argc, char *argv[]){ - - if (mode == AUTO) { - gps_pos_x = atof(argv[2]); - gps_pos_y = atof(argv[3]); - /* calculate azimuth */ - ant_azim = atan2(gps_pos_x, gps_pos_y) * 180. / M_PI; - if (ant_azim < 0) ant_azim += 360.; - /* calculate elevation */ - ant_elev = atan2( (gps_alt-home_alt), sqrt(atof(argv[5])) ) * 180. / M_PI; - if (ant_elev < 0) ant_elev = 0.; - - gtk_range_set_value(azim_scale, ant_azim); - gtk_range_set_value(elev_scale, ant_elev); - } - /*g_message("home_alt %f gps_alt %f azim %f elev %f", home_alt, gps_alt, ant_azim, ant_elev); */ -} - -int main (int argc, char** argv) { - - gtk_init(&argc, &argv); - - GtkWidget* window = build_gui(); - gtk_widget_show_all(window); - - IvyInit ("AntennaTracker", "AntennaTracker READY", NULL, NULL, NULL, NULL); - IvyBindMsg(on_GPS_STATUS, NULL, "^\\S* GPS (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); - IvyBindMsg(on_NAV_STATUS, NULL, "^\\S* NAVIGATION (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); - IvyStart("127.255.255.255"); - - gtk_main(); - return 0; -} diff --git a/sw/ground_segment/cockpit/ant_track_pmm.c b/sw/ground_segment/cockpit/ant_track_pmm.c deleted file mode 100644 index 2040faa7cb..0000000000 --- a/sw/ground_segment/cockpit/ant_track_pmm.c +++ /dev/null @@ -1,795 +0,0 @@ -/* - - * Written by: Chris Efstathiou for the Pololu Micro Mestro usb servo controller 18/February/2021 - * - * 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. - * - * The antenna tracker zero azimuth is to the NORTH (NORTH = 0, EAST = 90 WEST = -90, SOUTH = 180/0 degrees). - * The elevation zero is totally horizontal, 90 is up and 180 is to the back. - * The servo used must be able to do 180 degrees in order to get full 360 degree coverage from the tracker. - */ -#include -#include -#include -#include -#include - -#include -#include - -#include -#include /* UNIX standard function definitions */ -#include /* File control definitions */ -#include /* Error number definitions */ - -#define POLOLU_PROTOCOL_START 0xAA -#define POLOLU_BOARD_ID 12 -#define SET_SERVO_POSITION_COMMAND 0x04 -#define SET_SERVO_SPEED_COMMAND 0x07 -#define SET_SERVO_ACCELERATION_COMMAND 0x09 -#define SET_SERVO_CENTER_COMMAND 0x22 - -#define MANUAL 0 -#define AUTO 1 - -static double gps_pos_x = 0; -static double gps_pos_y = 0; -static double gps_home_pos_x = 0; -static double gps_home_pos_y = 0; -static double gps_alt = 0; -static double home_alt = 0; -static double home_alt_backup = 0; -static double ant_azim = 0; -static double ant_elev = 0; -static int mode; -static int home_found = 0; -static int ant_tracker_pan_mode = 180; -static double theta_servo_pw_span = 0; -static double psi_servo_pw_span = 0; -static double theta_servo_pw_span_default = 1000.; -static double psi_servo_pw_span_default = 1000.; -static double theta_servo_center_pw = 1500; -static double psi_servo_center_pw = 1500; -static char pololu_board_id = 12; -static char servo_acceleration = 3; -static char psi_servo_address = 1; -static char theta_servo_address = 0; - -int fd; /* File descriptor for the port */ -volatile int serial_error = 0; - -double hfov = 180., vfov = 180.; -double hnp = 0., vnp = 0.; -double elevation_trim = 0; -double elev_trim_pw = 0; -double azimuth_trim = 0; -double azim_trim_pw = 0; -unsigned char speed = 0x00; -char str_count[30] = {0}; - - -void set_servos(void); - -GtkBuilder *builder; -GtkWidget *window; -GError *err = NULL; - -GtkWidget *azim_scale; -GtkWidget *elev_scale; -GtkWidget *hnp_scale; -GtkWidget *entry; -GtkWidget *azim_servo_pw_label; -GtkWidget *elev_servo_pw_label; -GtkWidget *elev_trim_scale; -GtkWidget *azim_trim_scale; -GtkWidget *azimuth_pw_span_scale; -GtkWidget *elevation_pw_span_scale; - -const gchar gps_lock[] = "GPS lock 3d achieved"; - -void on_set_home_button_clicked(GtkButton *button, gpointer user_data){ - - gps_home_pos_x = gps_pos_x; - gps_home_pos_y = gps_pos_y; - home_found = 0; - - return; -} - -void on_reset_home_button_clicked(GtkButton *button, gpointer user_data){ - - gps_home_pos_x = 0; - gps_home_pos_y = 0; - home_alt = home_alt_backup; - - return; -} - - -void on_mode_changed(GtkRadioButton *radiobutton, gpointer user_data) -{ - - mode = gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(radiobutton)) ? MANUAL : AUTO; - - if (mode == MANUAL){ - gtk_window_set_title (GTK_WINDOW(window), "Paparazzi Antenna Tracker in MANUAL mode"); - //gtk_entry_set_text((GtkEntry *)entry, "MANUAL MODE"); - } else { - gtk_window_set_title (GTK_WINDOW(window), "Paparazzi Antenna Tracker in AUTO mode"); - //gtk_entry_set_text((GtkEntry *)entry, "AUTO MODE"); - } - //IvySendMsg("1ME RAW_DATALINK 80 SETTING;0;0;%d", mode); - //g_message("Mode changed to %d" , mode); - -return; -} - - -void on_azimuth_changed(GtkAdjustment *hscale, gpointer user_data){ - -//azim_scale = hscale; - if (mode == MANUAL) { - ant_azim = gtk_range_get_value(GTK_RANGE(azim_scale)); - ant_elev = gtk_range_get_value(GTK_RANGE(elev_scale)); - set_servos(); - } - //IvySendMsg("1ME RAW_DATALINK 80 SETTING;0;0;%d", mode); - //g_message("Mode changed to %d" , mode); -} - -//void on_elevation_changed(GtkRange *elev_scale, gpointer user_data) { -void on_elevation_changed(GtkAdjustment *hscale, gpointer user_data){ - - //elev_scale = hscale; - if (mode == MANUAL) { - ant_azim = gtk_range_get_value(GTK_RANGE(azim_scale)); - ant_elev = gtk_range_get_value(GTK_RANGE(elev_scale)); - set_servos(); - } - //IvySendMsg("1ME RAW_DATALINK 80 SETTING;0;0;%d", mode); - //g_message("Mode changed to %d" , mode); - -return; -} - -void on_hnp_changed(GtkAdjustment *hscale, gpointer user_data){ - - hnp = gtk_range_get_value(GTK_RANGE(hnp_scale)); - set_servos(); - -return; -} - -void on_elev_trim_changed(GtkAdjustment *hscale, gpointer user_data){ - - elevation_trim = gtk_range_get_value(GTK_RANGE(elev_trim_scale)); - set_servos(); - -return; -} - - -void on_azim_trim_changed(GtkAdjustment *hscale, gpointer user_data){ - - azimuth_trim = gtk_range_get_value(GTK_RANGE(azim_trim_scale)); - set_servos(); - -return; -} - - -void on_elev_pw_span_changed(GtkAdjustment *hscale, gpointer user_data){ - -int servo_epa = 0; - - servo_epa = gtk_range_get_value(GTK_RANGE(elevation_pw_span_scale)); - servo_epa -= psi_servo_pw_span_default; - psi_servo_pw_span = psi_servo_pw_span_default + servo_epa; - set_servos(); - -return; -} - - -void on_azim_pw_span_changed(GtkAdjustment *hscale, gpointer user_data){ - -int servo_epa = 0; - - servo_epa = gtk_range_get_value(GTK_RANGE(azimuth_pw_span_scale)); - servo_epa -= theta_servo_pw_span_default; - theta_servo_pw_span = theta_servo_pw_span_default + servo_epa; - - theta_servo_pw_span = theta_servo_pw_span_default + servo_epa; - set_servos(); - -return; -} - - -void set_servos(void){ - - double hpos = 0, vpos = 0; - int hservo = theta_servo_center_pw, vservo = psi_servo_center_pw; - - elev_trim_pw = (elevation_trim / vfov) * psi_servo_pw_span; - azim_trim_pw = (azimuth_trim / vfov) * theta_servo_pw_span; - - if (ant_tracker_pan_mode == 180) { - // Take the vertical angle relative to the neutral point "vnp" - vpos = ant_elev - vnp; - if(vpos < 0) { vpos = 0; } - - // keep within the field of view "vfov" - //if (vpos > (vfov / 2)) { vpos = vfov / 2; } else if (-vpos > (vfov / 2)) { vpos = -vfov / 2; } - - // First take the horizontal angle relative to the neutral point "hnp" - hpos = ant_azim - hnp; - - // Keep the range between (-180,180). this is done so that it consistently swaps sides - if (hpos < -180) { hpos += 360; } else if (hpos > 180) { hpos -= 360; } - - // Swap sides to obtain 360 degrees of Azimuth coverage. - if (hpos > 90) { hpos = hpos - 180; vpos = 180 - vpos; } else if (hpos < -90) { hpos = hpos + 180; vpos = 180 - vpos; } - - // keep the range within the field of view "hfov" - if (hpos > (hfov / 2)) { hpos = hfov / 2; } else if (-hpos > (hfov / 2)) { hpos = -hfov / 2; } - - // Convert angles to servo microsecond values suitable for the Pololu micro Maestro servo controller. - vpos = (psi_servo_center_pw - (psi_servo_pw_span / 2)) + (vpos * (psi_servo_pw_span / vfov)); - hpos = theta_servo_center_pw + (hpos * ((theta_servo_pw_span / 2) / (hfov / 2))); - - //convert the values to integer. - hservo = hpos+azim_trim_pw;; - vservo = vpos+elev_trim_pw; - - - } else { - vpos = ant_elev - vnp; - if(vpos < 0) { vpos = 0; } - if(vpos > (hfov/2)) { vpos = hfov/2; } - // First take the horizontal angle relative to the neutral point "hnp" - hpos = ant_azim - hnp; - - // Keep the range between (-180,180). - if (hpos < -180) { hpos += 360; } else if (hpos > 180) { hpos -= 360; } - - // Keep the range between 0 to 360. - //if (hpos < 0) { hpos += 360; } else if (hpos > 360){ hpos -= 360; } - - // keep the range within the field of view "hfov" - if (hpos > (hfov / 2)) { hpos = hfov / 2; } else if (-hpos > (hfov / 2)) { hpos = -hfov / 2; } - - // Convert angles to servo microsecond values suitable for the Pololu micro Maestro servo controller. - vpos = (psi_servo_center_pw - (psi_servo_pw_span / 2)) + (vpos * (psi_servo_pw_span / vfov)); - hpos = theta_servo_center_pw + (hpos * (theta_servo_pw_span / hfov)); - - //convert the values to integer. - hservo = hpos+azim_trim_pw;; - vservo = vpos+elev_trim_pw; - } - - hservo *= 4; //The pololu Maestro uses 0.25 microsecond increments so we need to multiply microseconds by 4. - vservo *= 4; //The pololu Maestro uses 0.25 microsecond increments so we need to multiply microseconds by 4. - //g_message("home_alt %f gps_alt %f azim %f elev %f", home_alt, gps_alt, ant_azim, ant_elev); - - // Send servo position. - char buffer1[] = { POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_POSITION_COMMAND, psi_servo_address, vservo % 128, vservo / 128, - POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_POSITION_COMMAND, theta_servo_address, hservo % 128, hservo / 128 - }; - - serial_error = write(fd, buffer1, 12); - //Divide by 4 so we can have the servo PW with 1 microsecond resolution. - //g_message("vservo %i hservo %i", (int)(vservo / 4), (int)(hservo / 4)); - sprintf(str_count, "%d us", (hservo / 4)); - gtk_label_set_text(GTK_LABEL(azim_servo_pw_label), str_count); - sprintf(str_count, "%d us", (vservo / 4)); - gtk_label_set_text(GTK_LABEL(elev_servo_pw_label), str_count); - - - return; -} - - - -/* jump here when a GPS message is received */ -void on_GPS_STATUS(IvyClientPtr app, void *user_data, int argc, char *argv[]) { - if (home_found == 0) { - if (atof(argv[0]) == 3) { /* wait until we have a valid GPS fix */ - home_alt = atof(argv[4]) / 100.; /* get the altitude */ - home_alt_backup = atof(argv[4]) / 100.; - home_found = 1; - gtk_entry_set_text (GTK_ENTRY(entry), gps_lock); - } else { - gtk_entry_set_text (GTK_ENTRY(entry), "Waiting for GPS lock!"); - } - } - gps_alt = atof(argv[4]) / 100.; - - -return; -} - - -/* jump here when a NAVIGATION message is received */ -void on_NAV_STATUS(IvyClientPtr app, void *user_data, int argc, char *argv[]){ - - if (mode == AUTO) { - gps_pos_x = atof(argv[2]); - gps_pos_y = atof(argv[3]); - gps_pos_x -= gps_home_pos_x; - gps_pos_y -= gps_home_pos_y; - /* calculate azimuth */ - //should be "atan2(gps_pos_y, gps_pos_x)" but it is reversed to give 0 when North. - ant_azim = atan2(gps_pos_x, gps_pos_y) * 180. / M_PI; - - if (ant_azim < 0) { - ant_azim += 360.; - } - - /* calculate elevation */ - ant_elev = atan2((gps_alt - home_alt), sqrt(atof(argv[5]))) * 180. / M_PI; - // Sanity check - if (ant_elev < 0) { ant_elev = 0.; } - gtk_range_set_value(GTK_RANGE(azim_scale), ant_azim); - gtk_range_set_value(GTK_RANGE(elev_scale), ant_elev); - - set_servos(); - - } - - return; -} - -int open_port(char *port){ - - struct termios options; - - // would probably be good to set the port up as an arg. - // The Pololu micro maestro registers two ports /dev/ttyACM0 and /dev/ttyACM1, /dev/ttyACM0 is the data port. - fd = open(port, O_RDWR | O_NOCTTY | O_NDELAY); - if (fd == -1) { - //perror("open_port: Unable to open /dev/ttyUSB1"); - printf("open_port: Unable to open %s \n", port); - serial_error = fd; - - } else { - printf("Success %s %s \n", port, "opened"); - } - fcntl(fd, F_SETFL, 0); - - tcgetattr(fd, &options); - - // Set the baud rates to 19200. This can be between 2,000 to 40,000 - - cfsetispeed(&options, B19200); - cfsetospeed(&options, B19200); - - options.c_cflag |= (CLOCAL | CREAD); - - tcsetattr(fd, TCSANOW, &options); - - // Send initialisation to the pololu micro maestro board. - // if "speed" is nonzero then 1 is the slowest 127 is the fastest. 0 = no speed restriction - char buffer_0[] = { POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_SPEED_COMMAND, psi_servo_address, 0x00, 0x00, - POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_SPEED_COMMAND, theta_servo_address, 0x00, 0x00 - }; - - serial_error = write(fd, buffer_0, 12); - // Set servo acceleration to 3 for protecting the servo gears. Fastest = 0, slowest = 255 - char buffer_1[] = { POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_ACCELERATION_COMMAND, psi_servo_address, (servo_acceleration % 128), - (servo_acceleration / 128), - POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_ACCELERATION_COMMAND, theta_servo_address, (servo_acceleration % 128), - (servo_acceleration / 128) - }; - - serial_error = write(fd, buffer_1, 12); - // Set the two servos to their neutral position, Azimuth = 1500us = EAST = 0 degrees & Elevation = 1000 = parallel to ground. - char buffer_2[] = { POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_POSITION_COMMAND, theta_servo_address, - (((int)theta_servo_center_pw * 4) % 128), (((int)theta_servo_center_pw * 4) / 128), - POLOLU_PROTOCOL_START, pololu_board_id, SET_SERVO_POSITION_COMMAND, psi_servo_address, - (((int)psi_servo_center_pw * 4) % 128), (((int)psi_servo_center_pw * 4) / 128) - }; - - serial_error = write(fd, buffer_2, 12); - - - return (fd); -} - -unsigned char build_gui(void) { - - //DISPLAY THE GUI - builder = gtk_builder_new(); - gtk_builder_add_from_file(builder, "ant_tracker_pmm.glade", NULL); - - if (err != NULL) { - fprintf(stderr, "Unable to read file: %s\n", err->message); - g_error_free(err); - return 1; - } - - window = GTK_WIDGET(gtk_builder_get_object(builder, "window1")); - - if (window == NULL || !GTK_IS_WINDOW(window)) { - fprintf(stderr, "Unable to get window. (window == NULL || window != GtkWindow)\n"); - return 1; - } - //gtk_window_set_title(GTK_WINDOW(window), "tracking antenna"); - - azim_scale = GTK_WIDGET(gtk_builder_get_object(builder, "azimuth_scale")); - if (azim_scale == NULL || !GTK_IS_WIDGET(azim_scale)) { - fprintf(stderr, "Unable to get azimuth scale's address. (azim_scale == NULL || azim_scale != GtkWindow)\n"); - return 1; - } - elev_scale = GTK_WIDGET(gtk_builder_get_object(builder, "elevation_scale")); - if (elev_scale == NULL || !GTK_IS_WIDGET(elev_scale)) { - fprintf(stderr, "Unable to get elevation scale's address. (elev_scale == NULL || elev_scale != GtkWindow)\n"); - return 1; - } - - hnp_scale = GTK_WIDGET(gtk_builder_get_object(builder, "hnp_scale")); - if (hnp_scale == NULL || !GTK_IS_WIDGET(hnp_scale)) { - fprintf(stderr, "Unable to get horizontal neutral point scale's address. (hnp_scale == NULL || hnp_scale != GtkWindow)\n"); - return 1; - } - - elev_trim_scale = GTK_WIDGET(gtk_builder_get_object(builder, "elevation_trim_scale")); - if (elev_trim_scale == NULL || !GTK_IS_WIDGET(elev_trim_scale)) { - fprintf(stderr, "Unable to get Elevation Trim scale's address. (elev_trim_scale == NULL || elev_trim_scale != GtkWindow)\n"); - return 1; - } - - azim_trim_scale = GTK_WIDGET(gtk_builder_get_object(builder, "azimuth_trim_scale")); - if (elev_trim_scale == NULL || !GTK_IS_WIDGET(elev_trim_scale)) { - fprintf(stderr, "Unable to get Elevation Trim scale's address. (azim_trim_scale == NULL || azim_trim_scale != GtkWindow)\n"); - return 1; - } - - elevation_pw_span_scale = GTK_WIDGET(gtk_builder_get_object(builder, "elevation_pw_span_scale")); - if (elevation_pw_span_scale == NULL || !GTK_IS_WIDGET(elevation_pw_span_scale)) { - fprintf(stderr, "Unable to get Elevation PW SPAN scale's address. (elevation_pw_span_scale == NULL || elevation_pw_span_scale != GtkWindow)\n"); - return 1; - } - - azimuth_pw_span_scale = GTK_WIDGET(gtk_builder_get_object(builder, "azimuth_pw_span_scale")); - if (azimuth_pw_span_scale == NULL || !GTK_IS_WIDGET(azimuth_pw_span_scale)) { - fprintf(stderr, "Unable to get Azimuth PW SPAN scale's address. (azimuth_pw_span_scale == NULL || azimuth_pw_span_scale != GtkWindow)\n"); - return 1; - } - //FIXME write error checking as for the above code. - entry = GTK_WIDGET(gtk_builder_get_object(builder, "entry1")); - gtk_entry_set_text((GtkEntry *)entry, "Waiting for GPS lock!"); - - azim_servo_pw_label = GTK_WIDGET(gtk_builder_get_object(builder, "azim_servo_pw_label")); - elev_servo_pw_label = GTK_WIDGET(gtk_builder_get_object(builder, "elev_servo_pw_label")); - - gtk_range_set_value(GTK_RANGE(azimuth_pw_span_scale), (gdouble)theta_servo_pw_span_default); - gtk_range_set_value(GTK_RANGE(elevation_pw_span_scale), (gdouble)psi_servo_pw_span_default); - - if (mode == MANUAL){ - gtk_window_set_title (GTK_WINDOW(window), "Paparazzi Antenna Tracker in MANUAL mode"); - //gtk_entry_set_text((GtkEntry *)entry, "MANUAL MODE"); - } else { - gtk_window_set_title (GTK_WINDOW(window), "Paparazzi Antenna Tracker in AUTO mode"); - //gtk_entry_set_text((GtkEntry *)entry, "AUTO MODE"); - } - - gtk_builder_connect_signals(builder, NULL); - - g_object_unref(builder); - - gtk_widget_show(window); - gtk_main(); - -return(0); -} - - - -int main(int argc, char **argv){ - -int x = 0, y = 0, z = 0; -char buffer[20]; -char serial_open = 0; - - printf("Antenna Tracker for the Paparazzi autopilot \n"); -/* // FIXME if i don't include at least one call to gmessage i get the below error during compilation: - /usr/bin/ld: /usr/lib/gcc/x86_64-linux-gnu/5/../../../x86_64-linux-gnu/libgtk-3.so: undefined reference to symbol 'g_source_remove' - /usr/lib/gcc/x86_64-linux-gnu/5/../../../x86_64-linux-gnu/libglib-2.0.so: error adding symbols: DSO missing from command line - collect2: error: ld returned 1 exit status -*/ - g_message("16/February/2021"); - - if (argc > 1) { - char arg_string1[] = "--help"; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string1, (sizeof(arg_string1) - 1))) == 0) { - printf("OPTIONS \n"); - printf("-------------------------------------------------------------------------------- \n"); - printf("'--help' displays this screen \n"); - printf("'--port=xxx..x' opens port xxx..x, example --port=/dev/ttyACM0 (Default) \n"); - printf("'--pan=xxx' sets pan mode to 180 or 360 degrees. Example --pan=180 (Default) \n"); - printf("'--zero_angle=xxx' set the mechanical zero angle. Default is 0 (North)\n"); - printf("'--id=xx' sets the Pololu board id. Example --id=12 (Default)\n"); - printf("'--servo_acc=xxx' sets the servo acceleration. Example --servo_acc=3 (Default)\n"); - printf("'--pan_servo=x' sets the pan (Theta) servo number. Example --pan_servo=0 (Default)\n"); - printf("'--tilt_servo=x' sets the tilt (Psi) servo number.Example --tilt_servo=1 (Default) \n"); - printf("'--pan_epa=xx..x' sets the Azimuth servo's max travel (Default is 1000us) \n"); - printf("'--tilt_epa=xx..x' sets the elevation servo's max travel (Default is 1000us). \n"); - printf("HINT a negative value EPA value reverses the servo direction \n"); - printf("'--pan_servo_center_pw=xx..x' sets the Azimuth servo's center position (Default is 1500us) \n"); - printf("'--tilt_servo_center_pw=xx..x' sets the elevation servo's center position (Default is 1500us) \n"); - printf("WARNING: The pololu board limit servo travel to 1000-2000 microseconds. \n"); - printf("WARNING: Use the pololu board setup program to change the above limits. \n"); - printf("Example --tilt_epa=1100 sets the PW from 950 to 2050 microseconds \n"); - printf("Example --pan_epa=-1000 sets the PW from 1000 to 2000 microseconds and reverses the servo direction \n"); - printf("An EPA of 1100 sets the servo travel from 1500+(1100/2)=2050us to 1500-(1100/2)=950us. \n"); - printf("Use programmable servos like the Hyperion Atlas. \n"); - printf("You can also use the proportional 360 degree GWS S125-1T as the Theta (Azimuth) \n"); - printf(" \n"); - printf("FOR THE 360 DEGREE PAN MODE: \n"); - printf("Mechanical zero (0 degrees or 1500 ms) is to the NORTH, 90 = EAST, +-180 = SOUTH and -90 = WEST. \n"); - printf("Elevation center is 45 degrees up (1500ms), 0 degrees = horizontal, 90 degrees is vertical (up) \n"); - printf("Of course use this mode if your PAN servo can do a full 360 degrees rotation (GWS S125-1T for example) \n"); - printf(" \n"); - printf("FOR THE 180 DEGREE PAN MODE: \n"); - printf("Mechanical zero (0 degrees or 1500 ms) is to the NORTH, 90 = EAST, -90 = WEST. \n"); - printf("Elevation center is 90 degrees up (1500ms), 0 degrees = horizontal, 180 degrees is horizontal to the opposite side \n"); - printf("When the azimuth is > 90 or < -90 the azimuth and elevation servos swap sides to obtain the full 360 degree coverage. \n"); - printf("Of course your PAN and TILT servos must be true 180 degrees servos like the Hyperion ATLAS servos for example. \n"); - printf(" \n"); - printf("-------------------------------------------------------------------------------- \n"); - printf("Antenna Tracker V1.2 for the Paparazzi autopilot 16/February/2021 \n"); - printf("-------------------------------------------------------------------------------- \n"); - return 0; - } - } - printf("Type '--help' for help \n"); - - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string2[] = "--port="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string2, (sizeof(arg_string2) - 1))) == 0) { - y = sizeof(arg_string2) - 1; - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - printf("Trying to open %s \n", buffer); - open_port(buffer); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string3[] = "--pan="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string3, (sizeof(arg_string3) - 1))) == 0) { - y = (sizeof(arg_string3) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - ant_tracker_pan_mode = atoi(buffer); - if (ant_tracker_pan_mode == 180 || ant_tracker_pan_mode == 360) { - printf("PAN mode set to %i %s \n", ant_tracker_pan_mode, "degrees"); - if (ant_tracker_pan_mode == 360) { hfov = 360; vfov = 90; } else { hfov = 180; vfov = 180; } - - } else { - perror("ERROR: Pan mode can be either 180 or 360 degrees"); - ant_tracker_pan_mode = 180; - hfov = 180; - vfov = 180; - printf("PAN servo set to %i %s \n", ant_tracker_pan_mode, "degrees"); - } - } - } - - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string4[] = "--pan_epa="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string4, (sizeof(arg_string4) - 1))) == 0) { - y = (sizeof(arg_string4) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - theta_servo_pw_span_default = atoi(buffer); - printf("THETA servo EPA set to %i \n", atoi(buffer)); - if (abs(theta_servo_pw_span_default) > 1000) { - printf("REMEMBER TO SET THE MIN/MAX SERVO LIMITS WITH THE POLOLU SETUP PROGRAM \n"); - printf("OTHERWISE THE MAX SERVO MOVEMENT WILL BE RESTRAINED TO 1000 MICROSECONDS \n"); - } - } - } - - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string5[] = "--tilt_epa="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string5, (sizeof(arg_string5) - 1))) == 0) { - y = (sizeof(arg_string5) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - psi_servo_pw_span_default = atoi(buffer); - printf("PSI servo EPA set to %i \n", atoi(buffer)); - if (abs(psi_servo_pw_span_default) > 1000) { - printf("REMEMBER TO SET THE MIN/MAX SERVO LIMITS WITH THE POLOLU SETUP PROGRAM \n"); - printf("OTHERWISE THE MAX SERVO MOVEMENT WILL BE RESTRAINED TO 1000 MICROSECONDS \n"); - } - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string8[] = "--id="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string8, (sizeof(arg_string8) - 1))) == 0) { - y = (sizeof(arg_string8) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - pololu_board_id = (char)atoi(buffer); - printf("Pololu Board id set to %i \n", atoi(buffer)); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string9[] = "--servo_acc="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string9, (sizeof(arg_string9) - 1))) == 0) { - y = (sizeof(arg_string9) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - servo_acceleration = (char)atoi(buffer); - printf("Servo acceleration set to %i \n", atoi(buffer)); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string10[] = "--pan_servo="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string10, (sizeof(arg_string10) - 1))) == 0) { - y = (sizeof(arg_string10) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - theta_servo_address = (char)atoi(buffer); - printf("Pan (Theta) servo number set to %i \n", atoi(buffer)); - } - } - - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string11[] = "--tilt_servo="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string11, (sizeof(arg_string11) - 1))) == 0) { - y = (sizeof(arg_string11) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - psi_servo_address = (char)atoi(buffer); - printf("Tilt (Psi) servo number set to %i \n", atoi(buffer)); - } - } - - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string12[] = "--zero_angle="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string12, (sizeof(arg_string12) - 1))) == 0) { - y = (sizeof(arg_string12) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - hnp = (double)atoi(buffer); - printf("Zero angle is set to %i %s \n", atoi(buffer), "degrees"); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string13[] = "--tilt_servo_center_pw="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string13, (sizeof(arg_string13) - 1))) == 0) { - y = (sizeof(arg_string13) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - psi_servo_center_pw = atoi(buffer); - printf("PSI servo center pulse width set to %i \n", atoi(buffer)); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string14[] = "--pan_servo_center_pw="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string14, (sizeof(arg_string14) - 1))) == 0) { - y = (sizeof(arg_string14) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - theta_servo_center_pw = atoi(buffer); - printf("THETA servo center pulse width set to %i \n", atoi(buffer)); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string15[] = "--hfov="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string15, (sizeof(arg_string15) - 1))) == 0) { - y = (sizeof(arg_string15) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - hfov = atoi(buffer); - printf("Horizontal field of view set to %i %s \n", (int)hfov, "degrees"); - } - } - for (z = 0; z < sizeof(buffer); z++) { buffer[z] = '\0'; } //Reset the buffer. - char arg_string16[] = "--vfov="; - for (x = 1; x < argc; x++) { - if ((strncmp(argv[x], arg_string16, (sizeof(arg_string16) - 1))) == 0) { - y = (sizeof(arg_string16) - 1); - z = 0; - while (1) { - buffer[z] = argv[x][y]; - if (buffer[z] != '\0') { y++; z++; } else { break; } - } - vfov = atoi(buffer); - printf("Vertical field of view set to %i %s \n", (int)vfov, "degrees"); - } - } - } - psi_servo_pw_span = psi_servo_pw_span_default; - theta_servo_pw_span = theta_servo_pw_span_default; - - if (serial_open == 0) { printf("Trying to open /dev/ttyACM0 \n"); open_port("/dev/ttyACM0"); } - - gtk_init(&argc, &argv); - if(build_gui() ) { return(1); } - gtk_main(); - - if (mode == MANUAL) { - ant_azim = gtk_range_get_value(GTK_RANGE(azim_scale)); - ant_elev = gtk_range_get_value(GTK_RANGE(elev_scale)); - set_servos(); - } - - IvyInit("AntennaTracker", "AntennaTracker READY", NULL, NULL, NULL, NULL); - IvyBindMsg( - on_GPS_STATUS, - NULL, - "^\\S* GPS (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); - IvyBindMsg(on_NAV_STATUS, NULL, - "^\\S* NAVIGATION (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); - IvyStart("127.255.255.255"); - - - return 0; -} diff --git a/sw/ground_segment/cockpit/ant_tracker_pmm.glade b/sw/ground_segment/cockpit/ant_tracker_pmm.glade deleted file mode 100644 index 328ce598a3..0000000000 --- a/sw/ground_segment/cockpit/ant_tracker_pmm.glade +++ /dev/null @@ -1,423 +0,0 @@ - - - - - - 600 - 1400 - 1000 - 1 - 10 - - - 360 - 1 - 10 - - - -10 - 10 - 1 - 10 - - - 600 - 1400 - 1000 - 1 - 10 - - - 90 - 1 - 10 - - - -10 - 10 - 1 - 10 - - - 360 - 1 - 10 - - - - antenna_tracker - False - baseline - Paparazzi Antenna Tracker - 650 - 500 - - - ant_track_gui - True - False - baseline - immediate - 400 - 300 - - - Manual - AUTO - 100 - 80 - True - True - False - 0 - True - True - - - - 14 - 1 - - - - - Auto - MANUAL - 100 - 80 - True - True - False - 0 - True - True - radiobutton1 - - - 139 - - - - - azimuth - 421 - 80 - True - True - baseline - azimuth_scale_adjustment - 1 - - - - 120 - 64 - - - - - elevation - 421 - 80 - True - True - center - elevation_scale_adjustment - 1 - - - - 120 - 122 - - - - - entry1 - 481 - 77 - True - True - 43 - - - 50 - 175 - - - - - label1 - 48 - 35 - True - False - id - - - 1 - 196 - - - - - Set Home Here - Set_Home_Here - 125 - 29 - True - True - True - immediate - bottom - - - - 299 - 26 - - - - - horizontal_neutral_point_scale - 420 - 80 - True - True - Used when the antenna tracker cannot be moved to point to the North WHEN AZIMUTH IS SET TO 0 IN MANUAL MODE. -For example use it if the antenna tracker is mounted on a vehicle which cannot be steered to look to the North when the Azimuth servo is centered. -To center the Azimuth servo set mode to MANUAL and then Azimuth scale to 0 - - 0.95999999999999996 - hnp_scale_adjustment - 1 - - - 121 - 229 - - - - - Azimuth_label - 70 - 30 - True - False - Azimuth ° - - - 1 - 96 - - - - - 70 - 30 - True - False - Elevation ° - - - 3 - 154 - - - - - 108 - 30 - True - False - Neutral Heading ° - - - 8 - 261 - - - - - 100 - 29 - True - False - 1500 us - - - 540 - 97 - - - - - 71 - 26 - True - False - 1000 us - - - 556 - 157 - - - - - Reset Home - 116 - 27 - True - True - True - - - - 500 - 28 - - - - - 200 - 50 - True - True - Adjust the elevation of the Antenna in case the best reception is not parallel with the antenna's mechanical longitudinal axis. -This adjustment works realtime in both modes. - elevation_trim_adjustment - True - 1 - - - - 342 - 334 - - - - - 94 - 26 - True - False - Elevation trim ° - - - 398 - 314 - - - - - 200 - 50 - True - True - Adjust the azimuth of the Antenna in case the best reception is not parallel with the antenna's mechanical longitudinal axis. -This adjustment works realtime in both modes. - azimuth_trim_adjustment - True - 1 - - - - 123 - 333 - - - - - 200 - 50 - True - True - After you find the correct setting you can make a shell script and run the Antenna tracker command with the --tilt_epa=xxxx option so the changes became more permanent. -From command prompt run the antenna tracker executable with the --help parameter for more help. - elev_pw_span_adjustment - True - 1 - - - - 341 - 433 - - - - - 200 - 50 - True - True - After you find the correct setting you can make a shell script and run the Antenna tracker command with the --pan_epa=xxxx option so the changes became more permanent. -From command prompt run the antenna tracker executable with the --help parameter for more help. - azim_pw_span_adjustment - True - 1 - - - - 126 - 432 - - - - - 89 - 20 - True - False - Azimuth trim ° - - - 181 - 319 - - - - - 181 - 28 - True - False - Elevation servo PW range (us) - decrease -- increase - - - 354 - 408 - - - - - 176 - 28 - True - False - Azimuth servo PW range (us) - decrease -- increase - - - 143 - 407 - - - - - 69 - 21 - True - False - Servo PW - - - 556 - 76 - - - - - - diff --git a/sw/ground_segment/cockpit/compass.ml b/sw/ground_segment/cockpit/compass.ml deleted file mode 100644 index 21c531f14c..0000000000 --- a/sw/ground_segment/cockpit/compass.ml +++ /dev/null @@ -1,155 +0,0 @@ -(* - * Compass display for a manned vehicle - * - * Copyright (C) 2004-2009 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 Latlong - -module Tm_Pprz = PprzLink.Messages (struct let name = "telemetry" end) - -let width = 200 -let height = width -let background = `NAME "grey" -let fore = `BLACK - -let arrow = [1,1; 2,1; 0,3; -2,1; -1,1; -1,-3; 1,-3; 1,1] - -let rot = fun angle -> - let angle = (Deg>>Rad)(-. angle) in - let ca = cos angle and sa = sin angle in - fun (x,y) -> - let x = float x and y = float y in - (truncate (ca*.x-.sa*.y), truncate (sa*.x+.ca*.y)) - -let n = 100 -let circle = fun (dr:GDraw.pixmap) (x,y) r -> - let r = float r in - let points = Array.init n - (fun i -> - let a = float i /. float n *. 2.*.pi in - (x + truncate (r*.cos a), y + truncate (r*.sin a))) in - dr#polygon (Array.to_list points) - -let draw = fun (da_object:Gtk_tools.pixmap_in_drawin_area) desired_course course_opt distance -> - let da = da_object#drawing_area in - let {Gtk.width=width; height=height} = da#misc#allocation in - let dr = da_object#get_pixmap () in - dr#set_foreground background; - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - let s = (min width height) / 8 in - - (* Text *) - let context = da#misc#create_pango_context in - context#set_font_by_name (sprintf "sans %d" (s/3)); - let print_string = fun x y string -> - let layout = context#create_layout in - let fd = Pango.Context.get_font_description (Pango.Layout.get_context layout) in - Pango.Font.modify fd ~weight:`BOLD (); - context#set_font_description fd; - let from_codeset = "ISO-8859-15" - and to_codeset = "UTF-8" in - Pango.Layout.set_text layout (Glib.Convert.convert ~from_codeset ~to_codeset string); - let (w,h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:(x-w/2) ~y:(y-h/2) ~fore layout in - - let course = match course_opt with None -> 0. | Some c -> c in - let rotation = rot (desired_course -. course) in - let translate = fun (x, y) -> (4*s+x, 4*s-y) in - - (* Arrow *) - if distance > 5. then - match course_opt with - None -> - print_string (4*s) (4*s) "?" - | Some _ -> - let points = List.map (fun (x, y) -> translate (rotation (x*s/2,y*s/2))) arrow in - dr#set_foreground fore; - dr#polygon ~filled:true points; - circle dr (4*s,4*s) (2*s); - circle dr (4*s,4*s) (3*s) - else - print_string (4*s) (4*s) "STOP"; - - (* Distance and bearing to target, current track *) - print_string (7*s) s (sprintf "%.0f m" distance); - print_string (7*s) (s/2) "Dist."; - print_string s s (sprintf "%.0f" desired_course); - print_string s (s/2) "Brg"; - print_string s (7*s) (match course_opt with None -> "---" | _ -> sprintf "%.0f" course); - print_string s (7*s+s/2) "Track"; - - (* Cardinal points *) - let rotation = rot (-. course) in - let cards = [(0, 10, "N"); (0, -10, "S"); (10, 0, "E"); (-10, 0, "W"); - (7, 7, "NE"); (7, -7, "SE");(-7,-7,"SW");(-7,7,"NW")] in - List.iter (fun (x,y,string)-> - let (x,y) = translate (rotation ((x*5*s)/20, (y*5*s)/20)) in - print_string x y string) - cards; - - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - -(*********************** Main ************************************************) -let _ = - let ivy_bus = ref Defivybus.default_ivy_bus in - Arg.parse - [ "-b", Arg.String (fun x -> ivy_bus := x), (sprintf " Default is %s" !ivy_bus)] - (fun x -> prerr_endline ("WARNING: don't do anything with "^x)) - "Usage: "; - - (** Connect to the Ivy bus *) - Ivy.init "Paparazzi UGV Compass" "READY" (fun _ _ -> ()); - Ivy.start !ivy_bus; - - (** Open the window *) - let icon = GdkPixbuf.from_file Env.icon_file in - let window = GWindow.window ~icon ~title:"UGV Compass" () in - let quit = fun () -> GMain.Main.quit (); exit 0 in - ignore (window#connect#destroy ~callback:quit); - - let da = new Gtk_tools.pixmap_in_drawin_area ~width ~height ~packing:window#add () in - da#drawing_area#misc#realize (); - - (* Listening messages *) - let course = ref None in (* deg *) - let desired_course = ref 0. in (* deg *) - let get_navigation = fun _ values -> - let distance = (try sqrt (PprzLink.float_assoc "dist2_wp" values) with _ -> PprzLink.float_assoc "dist_wp" values) in - draw da !desired_course !course distance in - ignore (Tm_Pprz.message_bind "NAVIGATION" get_navigation); - let get_gps = fun _ values -> - (* if speed < 1m/s, the course information is not relevant *) - course := - if PprzLink.int_assoc "speed" values > 100 then - Some (float (PprzLink.int_assoc "course" values) /. 10.) - else - None in - ignore (Tm_Pprz.message_bind "GPS" get_gps); - let get_desired = fun _ values -> - desired_course := (Rad>>Deg) (PprzLink.float_assoc "course" values) in - ignore (Tm_Pprz.message_bind "DESIRED" get_desired); - - (** Start the main loop *) - window#show (); - GMain.main () - diff --git a/sw/ground_segment/cockpit/editFP.ml b/sw/ground_segment/cockpit/editFP.ml deleted file mode 100644 index a78c653620..0000000000 --- a/sw/ground_segment/cockpit/editFP.ml +++ /dev/null @@ -1,228 +0,0 @@ -(***************** Editing ONE (single) flight plan **************************) -open Printf -open Latlong - -let (//) = Filename.concat -let fp_example = Env.flight_plans_path // "example.xml" -let default_path_maps = Env.paparazzi_home // "data" // "maps" - -(** Dummy flight plan (for map calibration) *) -let dummy_fp = fun latlong -> - Xml.Element("flight_plan", - ["lat0", string_of_float ((Rad>>Deg)latlong.posn_lat); - "lon0", string_of_float ((Rad>>Deg)latlong.posn_long); - "alt", "42."; - "MAX_DIST_FROM_HOME", "1000."], - [Xml.Element("waypoints", [],[]); - Xml.Element("blocks", [],[])]) - - - -let current_fp = ref None - -(** Wrapper checking there is currently no flight plan loaded *) -let if_none = fun f -> - match !current_fp with - Some _ -> - GToolbox.message_box ~title:"Error" "Only one editable flight plan at a time" - | None -> - f () - -let set_window_title = fun geomap -> - let title_suffix = - match !current_fp with - None -> "" - | Some (_fp, xml_file) -> sprintf " (%s)" (Filename.basename xml_file) in - match GWindow.toplevel geomap#canvas with - Some w -> - w#set_title (sprintf "Flight Plan Editor%s" title_suffix) - | None -> () - - - -let save_fp = fun geomap -> - match !current_fp with - None -> () (* Nothing to save *) - | Some (fp, filename) -> - match GToolbox.select_file ~title:"Save Flight Plan" ~filename () with - None -> () - | Some file -> - let f = open_out file in - let fp_path = Str.replace_first (Str.regexp Env.flight_plans_path) "" (Filename.dirname file) in - let rel_path = Str.global_replace (Str.regexp (Printf.sprintf "%s[^%s]+" Filename.dir_sep Filename.dir_sep)) (Filename.parent_dir_name // "") fp_path in - fprintf f "\n\n" rel_path "flight_plan.dtd"; - fprintf f "%s\n" (ExtXml.to_string_fmt fp#xml); - close_out f; - current_fp := Some (fp, file); - set_window_title geomap - - -let close_fp = fun geomap -> - match !current_fp with - None -> () (* Nothing to close *) - | Some (fp, _filename) -> - let close = fun () -> - fp#destroy (); - geomap#clear_georefs (); - current_fp := None in - match GToolbox.question_box ~title:"Closing flight plan" ~buttons:["Close"; "Save&Close"; "Cancel"] "Do you want to save/close ?" with - 2 -> save_fp geomap; close () - | 1 -> close () - | _ -> () - -let load_xml_fp = fun geomap editor_frame _accel_group ?(xml_file=Env.flight_plans_path) xml -> - Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml); - let fp = new MapFP.flight_plan ~editable:true ~show_moved:false geomap "red" Env.flight_plan_dtd xml in - editor_frame#add fp#window; - current_fp := Some (fp,xml_file); - - (** Add waypoints as geo references *) - List.iter - (fun w -> - let (_i, w) = fp#index w in - geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : Latlong.geographic >)) - fp#waypoints; - - fp - -let labelled_entry = fun ?width_chars text value h -> - let _ = GMisc.label ~text ~packing:h#add () in - GEdit.entry ?width_chars ~text:value ~packing:h#add () - -let new_fp = fun geomap editor_frame accel_group () -> - if_none (fun () -> - let dialog = GWindow.window ~border_width:10 ~title:"New flight plan" () in - let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in - let h = GPack.hbox ~packing:dvbx#pack () in - let default_latlong = - match geomap#georef with - None -> "WGS84 37.21098 -113.45678" - | Some geo -> Latlong.string_of geo in - let latlong = labelled_entry ~width_chars:25 "Geographic Reference" default_latlong h in - let alt0 = labelled_entry ~width_chars:4 "Ground Alt" "380" h in - let h = GPack.hbox ~packing:dvbx#pack () in - let alt = labelled_entry ~width_chars:4 "Default Alt" "430" h in - let qfu = labelled_entry ~width_chars:4 "QFU" "270" h in - let mdfh = labelled_entry ~width_chars:4 "Max distance from HOME" "500" h in - - let h = GPack.hbox ~packing:dvbx#pack () in - let name = labelled_entry "Name" "Test flight" h in - - let h = GPack.hbox ~packing:dvbx#pack () in - let cancel = GButton.button ~stock:`CANCEL ~packing: h#add () in - ignore(cancel#connect#clicked ~callback:dialog#destroy); - - let createfp = GButton.button ~stock:`OK ~packing: h#add () in - createfp#grab_default (); - ignore(createfp#connect#clicked ~callback: - begin fun _ -> - let xml = ExtXml.parse_file fp_example in - let s = ExtXml.subst_attrib in - let wgs84 = Latlong.of_string latlong#text in - let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in - let xml = s "lon0" (deg_string_of_rad wgs84.posn_long) xml in - let xml = s "ground_alt" alt0#text xml in - let xml = s "qfu" qfu#text xml in - let xml = s "alt" alt#text xml in - let xml = s "max_dist_from_home" mdfh#text xml in - let xml = s "name" name#text xml in - ignore (load_xml_fp geomap editor_frame accel_group xml); - dialog#destroy () - end); - dialog#show ()) - - -let loading_error = fun xml_file e -> - let m = sprintf "Error while loading %s:\n%s" xml_file e in - GToolbox.message_box ~title:"Error" m - - - -let load_xml_file = fun geomap editor_frame accel_group xml_file -> - try - let xml = Xml.parse_file xml_file in - ignore (load_xml_fp geomap editor_frame accel_group ~xml_file xml); - geomap#fit_to_window (); - set_window_title geomap - with - Dtd.Prove_error(e) -> loading_error xml_file (Dtd.prove_error e) - | Dtd.Check_error(e) -> loading_error xml_file (Dtd.check_error e) - | Xml.Error e -> loading_error xml_file (Xml.error e) - - - -(** Loading a flight plan for edition *) -let load_fp = fun geomap editor_frame accel_group () -> - if_none (fun () -> - match GToolbox.select_file ~title:"Open flight plan" ~filename:(Env.flight_plans_path // "*.xml") () with - None -> () - | Some xml_file -> load_xml_file geomap editor_frame accel_group xml_file) - -let create_wp = fun geomap geo -> - match !current_fp with - None -> - GToolbox.message_box ~title:"Error" "Load a flight plan first"; - failwith "create_wp" - | Some (fp,_) -> - let w = fp#add_waypoint geo in - geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : Latlong.geographic >); - w - - - -let ref_point_of_waypoint = fun xml -> - Xml.Element("point", ["x",Xml.attrib xml "x"; - "y",Xml.attrib xml "y"; - "geo", Xml.attrib xml "name"],[]) - - -(** Calibration of chosen image (requires a dummy flight plan) *) -let calibrate_map = fun (geomap:MapCanvas.widget) editor_frame accel_group () -> - match !current_fp with - | Some (_fp,_) -> GToolbox.message_box ~title:"Error" "Close current flight plan before calibration" - | None -> - match GToolbox.select_file ~filename:(default_path_maps // "") ~title:"Open Image" () with - None -> () - | Some image -> - (** Displaying the image in the NW corner *) - let pixbuf = GdkPixbuf.from_file image in - let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in - let (x0, y0) = geomap#canvas#get_scroll_offsets in - let (x,y) = geomap#canvas#window_to_world ~winx:(float x0) ~winy:(float y0) in - pix#move ~x ~y; - - (** Open a dummy flight plan *) - let dummy_georef = - match geomap#georef with - None -> {posn_lat = (Deg>>Rad)43.; posn_long = (Deg>>Rad)1. } - | Some geo -> geo in - let fp_xml = dummy_fp dummy_georef in - let fp = load_xml_fp geomap editor_frame accel_group fp_xml in - - (** Dialog to finish calibration *) - let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in - let v = GPack.vbox ~packing:dialog#add () in - let _ = GMisc.label ~text:"Choose 2 (or more) waypoints (Ctrl-Left)\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\n" ~packing:v#add () in - let h = GPack.hbox ~packing:v#pack () in - let cancel = GButton.button ~stock:`CLOSE ~packing:h#add () in - let cal = GButton.button ~stock:`OK ~packing:h#add () in - let destroy = fun () -> - dialog#destroy (); - close_fp geomap; - pix#destroy () in - ignore(cancel#connect#clicked ~callback:destroy); - ignore(cal#connect#clicked ~callback:(fun _ -> - let points = List.map XmlEdit.xml_of_node fp#waypoints in - let points = List.map ref_point_of_waypoint points in - let xml = Xml.Element ("map", - ["file", Filename.basename image; - "projection", geomap#projection], - points) in - match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save calibrated map" () with - None -> () - | Some xml_file -> - let f = open_out xml_file in - Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); - close_out f)); - cal#grab_default (); - dialog#show () diff --git a/sw/ground_segment/cockpit/editFP.mli b/sw/ground_segment/cockpit/editFP.mli deleted file mode 100644 index 9a851c7dfa..0000000000 --- a/sw/ground_segment/cockpit/editFP.mli +++ /dev/null @@ -1,8 +0,0 @@ -val create_wp : MapCanvas.widget -> Latlong.geographic -> MapWaypoints.waypoint -val calibrate_map : MapCanvas.widget -> GBin.frame -> Gtk.accel_group -> unit -> unit -val new_fp : MapCanvas.widget -> GBin.frame -> Gtk.accel_group -> unit -> unit -val load_fp : MapCanvas.widget -> GBin.frame -> Gtk.accel_group -> unit -> unit -val load_xml_file : MapCanvas.widget -> GBin.frame -> Gtk.accel_group -> string -> unit -val save_fp : MapCanvas.widget -> unit -val close_fp : MapCanvas.widget -> unit -val set_window_title : MapCanvas.widget -> unit diff --git a/sw/ground_segment/cockpit/gcs.glade b/sw/ground_segment/cockpit/gcs.glade deleted file mode 100644 index 1bc9bebfe5..0000000000 --- a/sw/ground_segment/cockpit/gcs.glade +++ /dev/null @@ -1,1152 +0,0 @@ - - - - - - True - strip - - - True - - - True - 0 - in - - - True - 12 - - - True - - - True - - - True - - - True - 3 - 4 - - - 50 - True - 0 - none - - - True - 6 - - - True - Battery level (V) - - - 50 - True - - - - - - - - - True - <i>Bat</i> - True - - - label_item - - - - - 1 - 2 - GTK_FILL - GTK_FILL - - - - - 53 - True - 0 - none - - - True - 6 - - - True - 2 - True - - - True - Navigation mode. Click to get out of HOME mode - - - True - <b>AUTO2</b> - True - - - - - 0 - - - - - True - Radio Command status - - - True - - - - - 1 - - - - - True - GPS status - - - True - 3D - True - center - - - - - 2 - - - - - - - - - True - <i>Status</i> - True - - - label_item - - - - - 1 - 2 - 1 - 3 - GTK_FILL - GTK_FILL - - - - - True - 0 - none - - - True - 6 - - - True - Above Ground Level from SRTM if available, ground reference otherwise (m), climb indicator, vertical speed (m/s) - - - True - - - - - - - - - True - <i>AGL</i> - True - - - label_item - - - - - 2 - 3 - 1 - 2 - GTK_FILL - GTK_FILL - - - - - True - 0 - none - - - True - 6 - - - True - Telemetry status: ratio of connected links to number of links (if multiple links used) or seconds since the last message (if link lost) - - - True - 0 - True - - - - - - - - - True - <i>Link</i> - True - - - label_item - - - - - 2 - 3 - GTK_FILL - GTK_FILL - - - - - True - 0 - none - - - True - 6 - - - True - Current altitude minus target altitude - - - True - <b>-30m</b> - True - - - - - - - - - True - <i>/Target</i> - True - - - label_item - - - - - 2 - 3 - 2 - 3 - GTK_FILL - GTK_FILL - - - - - True - 0 - none - - - True - 6 - - - True - - - True - Current altitude - - - True - <b>185m</b> - True - - - - - False - False - 0 - - - - - True - / - - - False - False - 1 - - - - - True - Target altitude - - - True - <b>215m</b> - True - - - - - False - False - 2 - - - - - - - - - True - <i>Alt</i> - True - - - label_item - - - - - 3 - 4 - 2 - 3 - GTK_FILL - GTK_FILL - - - - - True - 0 - none - - - True - 6 - - - True - 5 - 2 - - - True - 0 - <i>Stage </i> - True - - - 1 - 2 - GTK_FILL - - - - - - True - 0 - <i>Time</i> - True - - - GTK_FILL - - - - - - True - Estimated Time of Arrival: seconds to the next waypoint - - - True - 0 - <i>ETA</i> - True - right - - - - - 2 - 3 - GTK_FILL - - - - - - True - Block time - - - True - 0 - <b>2:20</b> - True - center - - - - - 1 - 2 - GTK_FILL - - - - - - True - Stage time - - - True - 0 - <b>1:10</b> - True - - - - - 1 - 2 - 1 - 2 - GTK_FILL - - - - - - True - Estimated Time of Arrival: seconds to the next waypoint - - - True - 0 - <i>N/A</i> - True - right - - - - - 1 - 2 - 2 - 3 - GTK_FILL - - - - - - True - - - 0 - <b>10:31</b> - True - - - - - 1 - 2 - 3 - 4 - GTK_FILL - - - - - - True - Appointment Time - - - 0 - <i>Apt</i> - True - - - - - 3 - 4 - GTK_FILL - - - - - - Mark - True - True - False - True - - - 1 - 2 - 4 - 5 - GTK_FILL - - - - - - - - - - - - - True - <i>Block</i> - True - - - label_item - - - - - 3 - 4 - 1 - 2 - GTK_FILL - GTK_FILL - - - - - True - Flight time. Click to reset - - - True - 0 - <b>12:10</b> - True - center - - - - - GTK_FILL - - - - - - True - Throttle - - - True - - - - - 2 - 3 - GTK_FILL - GTK_FILL - 2 - - - - - True - Ground speed - - - True - - - - - 1 - 2 - GTK_FILL - GTK_FILL - 2 - - - - - True - Current navigation block - - - 85 - True - 0 - <i>N/A</i> - True - - - - - 3 - 4 - GTK_FILL - - - - - - False - False - 0 - - - - - True - 0 - none - - - True - 6 - - - True - 3 - 3 - - - True - False - True - False - Kill - - - True - gtk-stop - - - - - 1 - 2 - GTK_FILL - - - - - - True - False - True - False - Resurrect - - - True - gtk-redo - - - - - 2 - 3 - GTK_FILL - - - - - - True - False - True - False - - - True - gtk-goto-bottom - - - - - 1 - 2 - GTK_FILL - - - - - - True - False - True - False - - - True - gtk-goto-top - - - - - 1 - 2 - 1 - 2 - GTK_FILL - - - - - - True - False - True - False - Shift 5m left - - - True - gtk-goto-first - - - - - 2 - 3 - GTK_FILL - - - - - - True - False - True - False - Recenter - - - True - gtk-media-pause - - - - - 1 - 2 - 2 - 3 - GTK_FILL - - - - - - True - False - True - False - Shift 5m right - - - True - gtk-goto-last - - - - - 2 - 3 - 2 - 3 - GTK_FILL - - - - - - True - False - True - False - - - True - gtk-go-up - - - - - 2 - 3 - 1 - 2 - GTK_FILL - - - - - - True - False - True - False - Launch - - - 22 - 22 - True - gtk-apply - - - - - GTK_FILL - - - - - - - - - - True - <i>Nav</i> - True - - - label_item - - - - - False - False - 1 - - - - - 0 - - - - - True - - - - - - 1 - - - - - - - - - - - True - <b>MJ6</b> - True - - - label_item - - - - - - - - - True - Setting a Time - mouse - dialog - - - True - - - 25 - True - - - True - Time: - - - False - False - 0 - - - - - True - True - 15 0 23 1 10 10 - 1 - True - - - 1 - - - - - True - True - 42 0 59 1 10 10 - 1 - True - - - 2 - - - - - True - True - 0 0 59 1 10 10 - 1 - True - - - 3 - - - - - 0 - - - - - 35 - True - True - - - gtk-cancel - True - True - False - True - - - False - False - 0 - - - - - gtk-ok - True - True - False - True - - - False - False - 1 - - - - - False - 1 - - - - - - - True - Save Settings - True - dialog - - - True - - - True - True - never - in - - - 191 - True - True - - - - - 0 - - - - - True - - - gtk-cancel - True - True - False - True - - - False - 0 - - - - - True - True - False - Send checked values from the airframe file to the aircraft - - - True - 0 - 0 - - - True - 2 - - - True - gtk-go-up - - - False - False - 0 - - - - - True - Upload - True - - - False - False - 1 - - - - - - - - - False - False - 1 - - - - - gtk-save - True - True - False - Save the checked aircraft values in the airframe file - True - - - False - 2 - - - - - False - 1 - - - - - - diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml deleted file mode 100644 index d36668a60e..0000000000 --- a/sw/ground_segment/cockpit/gcs.ml +++ /dev/null @@ -1,825 +0,0 @@ -(* - * Multi aircrafts map display and flight plan editor - * - * Copyright (C) 2004-2009 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. - * - *) - -module G = MapCanvas -open Printf -open Latlong - - -let locale = GtkMain.Main.init ~setlocale:false () - -let soi = string_of_int - -let home = Env.paparazzi_home -let (//) = Filename.concat -let default_path_maps = home // "data" // "maps" -let layout_path = home // "conf" // "gcs" -let var_maps_path = home // "var" // "maps" -let _ = - ignore (Sys.command (sprintf "mkdir -p %s" var_maps_path)) - -let ign = ref false -let get_bdortho = ref "" -let auto_center_new_ac = ref false -let auto_center_ac = ref "" -let no_alarm = ref false - - -(** Display a calibrated (XML) map *) -let display_map = fun (geomap:G.widget) xml_map -> - try - let dir = Filename.dirname xml_map in - let xml_map = ExtXml.parse_file xml_map in - let image = dir // ExtXml.attrib xml_map "file" in - let map_projection = Xml.attrib xml_map "projection" in - let opacity = try Some (int_of_string (Xml.attrib xml_map "opacity")) with _ -> None in - let current_projection = geomap#projection in - if map_projection <> current_projection then - GToolbox.message_box ~title:"Warning" (sprintf "You are loading a map in %s projection while the display use %s" map_projection current_projection); - - let pix_ref = fun p -> - truncate (ExtXml.float_attrib p "x"), truncate (ExtXml.float_attrib p "y") in - let geo_ref = fun p -> - try Latlong.of_string (Xml.attrib p "geo") with - _ -> (* Compatibility with the old UTM format *) - let utm_x = ExtXml.float_attrib p "utm_x" - and utm_y = ExtXml.float_attrib p "utm_y" in - let utm_zone = ExtXml.int_attrib xml_map "utm_zone" in - let utm = {utm_x = utm_x; utm_y = utm_y; utm_zone = utm_zone } in - Latlong.of_utm WGS84 utm in - - match Xml.children xml_map with - p1::p2::_ -> - let x1y1 = pix_ref p1 - and x2y2 = pix_ref p2 - and geo1 = geo_ref p1 - and geo2 = geo_ref p2 in - - (* Take this point as a reference for the display if none currently *) - Map2d.set_georef_if_none geomap geo1; - - ignore (geomap#display_pixbuf ?opacity ((x1y1),geo1) ((x2y2),geo2) (GdkPixbuf.from_file image)); - geomap#center geo1 - | _ -> failwith (sprintf "display_map: two ref points required") - with - Xml.File_not_found f -> - GToolbox.message_box ~title:"Error" (sprintf "File does not exist: %s" f) - | ExtXml.Error s -> - GToolbox.message_box ~title:"Error" (sprintf "Error in XML file: %s" s) - - - -let load_map = fun (geomap:G.widget) () -> - match GToolbox.select_file ~title:"Open Map" ~filename:(default_path_maps // "*.xml") () with - None -> () - | Some f -> display_map geomap f - - - -(** Save the given pixbuf calibrated with NW and SE corners *) -let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se -> - match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save region map" () with - None -> () - | Some xml_file -> - let jpg = Filename.chop_extension xml_file ^ ".png" in - GdkPixbuf.save ~filename:jpg ~typ:"png" pixbuf; - let point = fun (x,y) wgs84 -> - Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in - let width = GdkPixbuf.get_width pixbuf - and height = GdkPixbuf.get_height pixbuf in - let points = [point (0, 0) nw; point (width, height) se] in - let xml = Xml.Element ("map", - ["file", Filename.basename jpg; - "projection", projection], - points) in - let f = open_out xml_file in - Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); - close_out f - - - -(****** Creates a calibrated map from the bitmap (selected region) ***********) -let map_from_region = fun (geomap:G.widget) () -> - match geomap#region with - None -> GToolbox.message_box ~title:"Error" "Select a region (shift-left drag)" - | Some ((xw1,yw1), (xw2,yw2)) -> - let xw1, xw2 = min xw1 xw2, max xw1 xw2 - and yw1, yw2 = min yw1 yw2, max yw1 yw2 in - let (xc1, yc1) = geomap#canvas#w2c ~wx:xw1 ~wy:yw1 - and (xc2, yc2) = geomap#canvas#w2c ~wx:xw2 ~wy:yw2 in - let width = xc2-xc1 and height = yc2-yc1 in - let dest = GdkPixbuf.create ~width ~height () in - let (x0, y0) = geomap#canvas#get_scroll_offsets in - let src_x = xc1 - x0 and src_y = yc1 - y0 in - GdkPixbuf.get_from_drawable ~dest ~width ~height ~src_x ~src_y - geomap#canvas#misc#window; - let nw = geomap#of_world (xw1,yw1) - and se = geomap#of_world (xw2,yw2) in - save_map geomap dest nw se - - -(** This module could be inserted into Ocaml_toosl; but it requires threads.cma *) -module TodoList = struct - (** A list of functions to call *) - let queue = (Queue.create () : (unit -> unit) Queue.t) - - (** The id of a running thread executing the queue *) - let doer = ref None - - (** A mutex to handle concurrent accesses *) - let mutex = Mutex.create () - - let rec exec_todo_list = fun todo_list -> - Mutex.lock mutex; - if Queue.is_empty todo_list then begin - (** Nothing mode to do: exiting the thread *) - doer := None; - Mutex.unlock mutex - end else - (** Pick a function from the list, call it and continue *) - let f = Queue.take queue in - Mutex.unlock mutex; - f (); - exec_todo_list todo_list - - let add = fun f -> - Mutex.lock mutex; - (** Add the function to the queue *) - Queue.add f queue; - if !doer = None then - (** Nobody is currently running the queue: start a thread *) - doer := Some (Thread.create exec_todo_list queue); - Mutex.unlock mutex -end - - -(************ Maps handling (Google, OSM, MS, etc.) ***********************************) -module GM = struct - (** Fill the visible background with map tiles *) - let zoomlevel = ref 20 - let fill_tiles = fun geomap -> - match geomap#georef with - None -> () - | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap !zoomlevel) - - let auto = ref false - let update = fun geomap -> - if !auto then fill_tiles geomap - let active_auto = fun geomap x -> - auto := x; - update geomap - - (** Creates a calibrated map from the map tiles (selected region) *) - let map_from_tiles = fun (geomap:G.widget) () -> - match geomap#region with - None -> GToolbox.message_box ~title:"Error" "Select a region (shift-left drag)" - | Some ((xw1,yw1), (xw2,yw2)) -> - let geo1 = geomap#of_world (xw1,yw1) - and geo2 = geomap#of_world (xw2,yw2) in - let sw = { posn_lat = min geo1.posn_lat geo2.posn_lat; - posn_long = min geo1.posn_long geo2.posn_long } - and ne = { posn_lat = max geo1.posn_lat geo2.posn_lat; - posn_long = max geo1.posn_long geo2.posn_long } in - let pix = MapGoogle.pixbuf sw ne !zoomlevel in - let nw = { posn_lat = ne.posn_lat; posn_long = sw.posn_long } - and se = { posn_lat = sw.posn_lat; posn_long = ne.posn_long } in - save_map geomap ~projection:"Mercator" pix nw se -end (* GM module *) - -let bdortho_size = 400 -let bdortho_store = Hashtbl.create 97 -let display_bdortho = fun (geomap:G.widget) wgs84 () -> - let r = bdortho_size / 2 in - let { lbt_x = lx; lbt_y = ly} = lambertIIe_of wgs84 in - let lx = lx + r and ly = ly + bdortho_size/2 in - let lx = lx - (lx mod bdortho_size) - and ly = ly - (ly mod bdortho_size) in - let f = sprintf "ortho_%d_%d_%d.jpg" lx ly r in - let f = var_maps_path // f in - if not (Hashtbl.mem bdortho_store f) then begin - Hashtbl.add bdortho_store f true; - let display = fun _ -> - let nw = of_lambertIIe {lbt_x = lx - r; lbt_y = ly + r} - and se = of_lambertIIe {lbt_x = lx + r; lbt_y = ly - r} in - ignore (geomap#display_pixbuf ((0,0), nw) ((bdortho_size, bdortho_size), se) (GdkPixbuf.from_file f)); - - in - if Sys.file_exists f then - display f - else - TodoList.add - (fun () -> - let c = sprintf "%s %d %d %d %s" !get_bdortho lx ly r f in - ignore (Sys.command c); - display f) - end - - -let fill_ortho = fun (geomap:G.widget) -> - (** First estimate the coverage of the window *) - let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window - and (xc0, yc0) = geomap#canvas#get_scroll_offsets in - let (xw0, yw0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c)) - and (xw1, yw1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in - let sw = geomap#of_world (xw0, yw0) - and ne = geomap#of_world (xw1, yw1) in - let lbt2e_sw = lambertIIe_of sw - and lbt2e_ne = lambertIIe_of ne in - let w = lbt2e_ne.lbt_x - lbt2e_sw.lbt_x - and h = lbt2e_ne.lbt_y - lbt2e_sw.lbt_y in - for i = 0 to w / bdortho_size + 1 do - let lbt_x = lbt2e_sw.lbt_x + bdortho_size * i in - for j = 0 to h / bdortho_size + 1 do - let lbt_y = lbt2e_sw.lbt_y + bdortho_size * j in - let geo = of_lambertIIe {lbt_x = lbt_x; lbt_y = lbt_y } in - display_bdortho geomap geo () - done - done - - - - -(******* Mouse motion handling **********************************************) -let motion_notify = fun (_geomap:G.widget) _ev -> false - -(******* Mouse wheel handling ***********************************************) -let any_event = fun (_geomap:G.widget) _ev -> false - -(******* Mouse buttons handling **********************************************) -let button_press = fun (geomap:G.widget) ev -> - let state = GdkEvent.Button.state ev in - if GdkEvent.Button.button ev = 3 then begin - (** Display a map tile from map provider (Google, OSC, ..) or IGN *) - let xc = GdkEvent.Button.x ev - and yc = GdkEvent.Button.y ev in - let (xw,yw) = geomap#window_to_world ~winx:xc ~winy:yc in - - let wgs84 = geomap#of_world (xw,yw) in - let display_ign = fun () -> - TodoList.add (fun () -> MapIGN.display_tile geomap wgs84) - and display_gm = fun () -> - TodoList.add - (fun () -> - try ignore (MapGoogle.display_tile geomap wgs84 !GM.zoomlevel) with - Gm.Not_available -> ()) in - - let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in - let m = - if !get_bdortho <> "" then - (`I ("Load BDORTHO", display_bdortho geomap wgs84))::m - else - m in - GToolbox.popup_menu ~entries:([`I ("Load background tile", display_gm)]@m) - ~button:3 ~time:(Int32.of_int 0); - true - end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then (* create new wp on Ctrl-click *) - let xc = GdkEvent.Button.x ev in - let yc = GdkEvent.Button.y ev in - let xyw = geomap#canvas#window_to_world ~winx:xc ~winy:yc in - let geo = geomap#of_world xyw in - ignore (EditFP.create_wp geomap geo); - true - else - false - - - - - - -(******** Help ***************************************************************) -let keys_help = fun () -> - GToolbox.message_box ~title:"Keys" ~ok:"Close" - "Zoom: Mouse Wheel, PgUp, PgDown\n\ - Pan: Map & keyboard arrows\n\ - Fit to window: f\n\ - Center active A/C: c or C\n\ - Fullscreen: F11\n\ - Load Map Tile: Right\n\ - Create Waypoint: Ctrl-Left\n\ - Move Waypoint: Left drag\n\ - Edit Waypoint: Left click\n" - - - -(***************** MAIN ******************************************************) -let ivy_bus = ref Defivybus.default_ivy_bus -and geo_ref = ref "" -and map_files = ref [] -and center = ref "" -and zoom = ref 1. -and maximize = ref false -and fullscreen = ref false -and projection = ref G.Mercator -and auto_ortho = ref false -and mplayer = ref "" -and plugin_window = ref "" -and layout_file = ref "large_left_col.xml" -and edit = ref false -and display_particules = ref false -and wid = ref None -and srtm = ref false -and hide_fp = ref false -and timestamp = ref false -and confirm_kill = ref true - -let options = - [ - "-auto_ortho", Arg.Set auto_ortho, "IGN tiles path"; - "-b", Arg.String (fun x -> ivy_bus := x),(sprintf " Default is %s" !ivy_bus); - "-center", Arg.Set_string center, "Initial map center (e.g. 'WGS84 43.605 1.443')"; - "-center_ac", Arg.Set auto_center_new_ac, "Centers the map on any new A/C"; - "-center_ac_id", Arg.Set_string auto_center_ac, "continuously centers the map on the AC id"; - "-edit", Arg.Unit (fun () -> edit := true; layout_file := "editor.xml"), "Flight plan editor"; - "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; - "-maps_fill", Arg.Set GM.auto, "Automatically start loading background maps"; - "-maps_zoom", Arg.Set_int GM.zoomlevel, "Background maps zoomlevel (default: 20, min: 18, max: 22)"; - "-ign", Arg.String (fun s -> ign:=true; IGN.data_path := s), "IGN tiles path"; - "-lambertIIe", Arg.Unit (fun () -> projection:=G.LambertIIe),"Switch to LambertIIe projection"; - "-layout", Arg.Set_string layout_file, (sprintf " GUI layout. Default: %s" !layout_file); - "-m", Arg.String (fun x -> map_files := x :: !map_files), "Map XML description file"; - "-maximize", Arg.Set maximize, "Maximize window"; - "-mercator", Arg.Unit (fun () -> projection:=G.Mercator),"Switch to Mercator projection, default"; - "-mplayer", Arg.Set_string mplayer, "Launch mplayer with the given argument as X plugin"; - "-no_alarm", Arg.Set no_alarm, "Disables alarm page"; - "-maps_no_http", Arg.Unit (fun () -> Gm.set_policy Gm.NoHttp), "Switch off downloading of maps, always use cached maps"; - "-ortho", Arg.Set_string get_bdortho, "IGN tiles path"; - "-osm", Arg.Unit (fun () -> Gm.set_maps_source Gm.OSM), "Use OpenStreetMap database (default is Google)"; - "-ms", Arg.Unit (fun () -> Gm.set_maps_source Gm.MS), "Use Microsoft maps database (default is Google)"; - "-particules", Arg.Set display_particules, "Display particules"; - "-plugin", Arg.Set_string plugin_window, "External X application (launched with the id of the plugin window as argument)"; - "-ref", Arg.Set_string geo_ref, "Geographic ref (e.g. 'WGS84 43.605 1.443')"; - "-speech", Arg.Set Speech.active, "Enable vocal messages"; - "-srtm", Arg.Set srtm, "Enable SRTM elevation display"; - "-track_size", Arg.Set_int Live.track_size, (sprintf "Default track length (%d)" !Live.track_size); - "-utm", Arg.Unit (fun () -> projection:=G.UTM),"Switch to UTM local projection"; - "-wid", Arg.String (fun s -> wid := Some (Int32.of_string s)), " Id of an existing window to be attached to"; - "-zoom", Arg.Set_float zoom, "Initial zoom"; - "-auto_hide_fp", Arg.Unit (fun () -> Live.auto_hide_fp true; hide_fp := true), "Automatically hide flight plans of unselected aircraft"; - "-timestamp", Arg.Set timestamp, "Bind on timestampped telemetry messages"; - "-ac_ids", Arg.String (fun s -> Live.filter_ac_ids s), "comma separated list of AC IDs to show in GCS"; - "-no_confirm_kill", Arg.Unit (fun () -> confirm_kill := false), "Disable kill confirmation from strip button"; - ] - - -let quit = fun () -> - match GToolbox.question_box ~title:"Leaving GCS" ~buttons:["Quit"; "Cancel"] "Do you want to quit ?" with - 1 -> - GMain.Main.quit (); - exit 0 - | _ -> () - -let create_geomap = fun switch_fullscreen editor_frame -> - let geomap = new G.widget ~srtm:!srtm ~height:500 ~projection:!projection () in - - let menu_fact = new GMenu.factory geomap#file_menu in - let accel_group = menu_fact#accel_group in - - ignore (geomap#canvas#event#connect#button_press ~callback:(button_press geomap)); - ignore (geomap#canvas#event#connect#motion_notify ~callback:(motion_notify geomap)); - ignore (geomap#canvas#event#connect#any ~callback:(any_event geomap)); - - ignore (menu_fact#add_check_item "Auto hide FP" ~callback:(fun hide -> Live.auto_hide_fp hide) ~active:!hide_fp); - ignore (menu_fact#add_item "Redraw" ~key:GdkKeysyms._L ~callback:(fun _ -> geomap#canvas#misc#draw None)); - let fullscreen = menu_fact#add_image_item ~stock:(`STOCK "gtk-fullscreen") ~callback:switch_fullscreen () in - fullscreen#add_accelerator ~group:accel_group GdkKeysyms._F11; - ignore (menu_fact#add_item "Quit" ~key:GdkKeysyms._Q ~callback:quit); - - (* Maps handling *) - let map_menu = geomap#factory#add_submenu "Maps" in - let map_menu_fact = new GMenu.factory ~accel_group map_menu in - ignore (map_menu_fact#add_item "Load User Map" ~key:GdkKeysyms._M ~callback:(load_map geomap)); - if !edit then - ignore (map_menu_fact#add_item "Calibrate" ~key:GdkKeysyms._C ~callback:(EditFP.calibrate_map geomap editor_frame accel_group)); - - (* Choose the map source *) - let maps_source_menu = map_menu_fact#add_submenu "Maps Source" in - let maps_source_fact = new GMenu.factory maps_source_menu in - let group = ref None in - (* Determine a decent default selected item *) - let active_maps_source = Gm.get_maps_source () in - List.iter - (fun maps_source -> - let callback = fun b -> if b then Gm.set_maps_source maps_source in - let active = (maps_source = active_maps_source) in - let menu_item = maps_source_fact#add_radio_item ~group: !group ~active ~callback (Gm.string_of_maps_source maps_source) in - group := menu_item#group) - Gm.maps_sources; - - (* Choose the map policy *) - let maps_policy_menu = map_menu_fact#add_submenu "Maps Policy" in - let maps_policy_fact = new GMenu.factory maps_policy_menu in - let group = ref None in - (* Determine a decent default selected item *) - let active_policy = if Gm.get_policy () = Gm.NoHttp then Gm.NoHttp - else Gm.CacheOrHttp in - List.iter - (fun policy -> - let callback = fun b -> if b then Gm.set_policy policy in - let active = (policy = active_policy) in - let menu_item = maps_policy_fact#add_radio_item ~group: !group ~active ~callback (Gm.string_of_policy policy) in - group := menu_item#group) - Gm.policies; - - (* Map tiles fill menu entry and toolbar button *) - let callback = fun _ -> GM.fill_tiles geomap in - ignore (map_menu_fact#add_item "Maps Fill" ~key:GdkKeysyms._G ~callback); - let b = GButton.button ~packing:geomap#toolbar#add () in - ignore (b#connect#clicked ~callback); - let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // "googleearth.png") in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); - let tooltips = GData.tooltips () in - tooltips#set_tip b#coerce ~text:"Fill current view with background map tiles"; - - ignore (map_menu_fact#add_check_item "Maps Auto" ~active:!GM.auto ~callback:(GM.active_auto geomap)); - ignore (map_menu_fact#add_item "Map of Region" ~key:GdkKeysyms._R ~callback:(map_from_region geomap)); - ignore (map_menu_fact#add_item "Dump map of Tiles" ~key:GdkKeysyms._T ~callback:(GM.map_from_tiles geomap)); - ignore (map_menu_fact#add_item "Load sector" ~callback:(Sectors.load geomap)); - ignore (map_menu_fact#add_item "Load KML" ~callback:(Sectors.load_kml geomap)); - - (** Connect Maps display to view change *) - geomap#connect_view (fun () -> GM.update geomap); - if !auto_ortho then - geomap#connect_view (fun () -> fill_ortho geomap); - - (** Flight plan editing *) - if !edit then begin - let fp_menu = geomap#factory#add_submenu "Edit" in - let fp_menu_fact = new GMenu.factory ~accel_group fp_menu in - ignore (fp_menu_fact#add_item "New flight plan" ~key:GdkKeysyms._N ~callback:(EditFP.new_fp geomap editor_frame accel_group)); - ignore (fp_menu_fact#add_item "Open flight plan" ~key:GdkKeysyms._O ~callback:(EditFP.load_fp geomap editor_frame accel_group)); - ignore (fp_menu_fact#add_item "Save flight plan" ~key:GdkKeysyms._S ~callback:(fun () -> EditFP.save_fp geomap)); - ignore (fp_menu_fact#add_item "Close flight plan" ~key:GdkKeysyms._W ~callback:(fun () -> EditFP.close_fp geomap)) - end; - - (** Help pushed to the right *) - let mi = GMenu.menu_item ~label:"Help" ~right_justified:true ~packing:geomap#menubar#append () in - let help_menu = GMenu.menu () in - GToolbox.build_menu help_menu ~entries:[`I ("Keys", keys_help)]; - mi#set_submenu help_menu; - - (** Separate from A/C menus *) - ignore (geomap#factory#add_separator ()); - - (** Set the initial zoom *) - geomap#zoom !zoom; - geomap, menu_fact - - - -let resize = fun (widget:GObj.widget) orientation size -> - match size with - Some size -> - if orientation = `HORIZONTAL then - widget#misc#set_size_request ~width:size () - else - widget#misc#set_size_request ~height:size () - | None -> () - - -let rec pack_widgets = fun orientation xml widgets packing -> - let size = try Some (ExtXml.int_attrib xml "size") with _ -> None in - match String.lowercase_ascii (Xml.tag xml) with - "widget" -> - let name = ExtXml.attrib xml "name" in - let widget = - try List.assoc name widgets with - Not_found -> failwith (sprintf "Unknown widget: '%s'" name) - in - resize widget orientation size; - packing widget - | "rows" -> - let resize = match size with None -> fun _ -> () | Some width -> fun (x:GObj.widget) -> x#misc#set_size_request ~width () in - pack_list resize `VERTICAL (Xml.children xml) widgets packing - | "columns" -> - let resize = match size with None -> fun _ -> () | Some height -> fun (x:GObj.widget) -> x#misc#set_size_request ~height () in - pack_list resize `HORIZONTAL (Xml.children xml) widgets packing - | x -> failwith (sprintf "pack_widgets: %s" x) -and pack_list = fun resize orientation xmls widgets packing -> - match xmls with - [] -> () - | x::xs -> - let paned = GPack.paned orientation ~show:true ~packing () in - resize paned#coerce; - pack_widgets orientation x widgets paned#add1; - pack_list resize orientation xs widgets paned#add2 - -let rec find_widget_children = fun name xml -> - let xmls = Xml.children xml in - match String.lowercase_ascii (Xml.tag xml) with - "widget" when ExtXml.attrib xml "name" = name -> xmls - | "rows" | "columns" -> - let rec loop = function - [] -> raise Not_found - | x::xs -> - try find_widget_children name x with - Not_found -> loop xs in - loop xmls - | _ -> raise Not_found - - -let rec replace_widget_children = fun name children xml -> - let xmls = Xml.children xml - and tag = String.lowercase_ascii (Xml.tag xml) in - match tag with - "widget" -> - Xml.Element("widget", - Xml.attribs xml, - if ExtXml.attrib xml "name" = name then children else xmls) - | "rows" | "columns" -> - let rec loop = function - [] -> [] - | x::xs -> - replace_widget_children name children x :: loop xs in - Xml.Element(tag, - Xml.attribs xml, - loop xmls) - | _ -> xml - -let rec update_widget_size = fun orientation widgets xml -> - let get_size = fun (widget:GObj.widget) orientation -> - let rect = widget#misc#allocation in - if orientation = `HORIZONTAL then rect.Gtk.width else rect.Gtk.height - in - let xmls = Xml.children xml - and tag = String.lowercase_ascii (Xml.tag xml) in - match tag with - "widget" -> - let name = ExtXml.attrib xml "name" in - let widget = - try List.assoc name widgets with - Not_found -> failwith (sprintf "Unknown widget: '%s'" name) - in - let size = get_size widget orientation in - let xml = ExtXml.subst_attrib "size" (string_of_int size) xml in - Xml.Element("widget", Xml.attribs xml, xmls) - | "rows" -> - Xml.Element("rows", Xml.attribs xml, List.map (update_widget_size `VERTICAL widgets) xmls) - | "columns" -> - Xml.Element("columns", Xml.attribs xml, List.map (update_widget_size `HORIZONTAL widgets) xmls) - | x -> failwith (sprintf "update_widget_size: %s" x) - - -(* get DTD head line for layout *) -let get_layout_dtd = fun filename -> - let gcs_regexp = Str.regexp (Filename.concat Env.paparazzi_home "conf/gcs") in - let local_dir = Str.replace_first gcs_regexp "" (Filename.dirname filename) in - let split = Str.split (Str.regexp Filename.dir_sep) local_dir in - let layout = List.fold_left (fun s _ -> "../" ^ s ) "layout.dtd" split in - sprintf "" layout - - -let save_layout = fun filename contents -> - let dir = Filename.dirname filename in - let dialog = GWindow.file_chooser_dialog ~action:`SAVE ~title:"Save Layout" () in - ignore (dialog#set_current_folder dir); - dialog#add_filter (GFile.filter ~name:"xml" ~patterns:["*.xml"] ()); - dialog#add_button_stock `CANCEL `CANCEL ; - dialog#add_select_button_stock `SAVE `SAVE ; - let _ = dialog#set_current_name (Filename.basename filename) in - begin match dialog#run (), dialog#filename with - `SAVE, Some name -> - dialog#destroy (); - let f = open_out name in - fprintf f "%s\n\n" (get_layout_dtd name); - fprintf f "%s\n" contents; - close_out f - | _ -> dialog#destroy () - end - -let listen_dropped_papgets = fun (geomap:G.widget) -> - let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0 } ] in - geomap#canvas#drag#dest_set dnd_targets ~actions:[`COPY]; - ignore (geomap#canvas#drag#connect#data_received ~callback:(Papgets.dnd_data_received geomap#still geomap#zoom_adj)) - - - -(************************** MAIN ********************************************) -let () = - let file_to_edit = ref "" in - Arg.parse options - (fun x -> if !edit then file_to_edit := x else Printf.fprintf stderr "Warning: Don't do anything with '%s'\n%!" x) - "Usage: "; - (* *) - if not !edit then begin - Ivy.init "Paparazzi GCS" "READY" (fun _ _ -> ()); - Ivy.start !ivy_bus - end; - - Gm.cache_path := var_maps_path; - IGN.cache_path := var_maps_path; - - let layout_file = layout_path // !layout_file in - let layout = ExtXml.parse_file layout_file in - let width = ExtXml.int_attrib layout "width" - and height = ExtXml.int_attrib layout "height" in - - let pid_plugin = ref None in - let kill_plugin = fun () -> - match !pid_plugin with - None -> () - | Some pid -> - try - Unix.kill pid (-9); - ignore (Unix.waitpid [] pid) - with _ -> () in - let destroy = fun _ -> - kill_plugin (); - exit 0 in - - (** The whole window map2d **) - let window, switch_fullscreen = - match !wid with - None -> - let icon = GdkPixbuf.from_file Env.icon_gcs_file in - let window = GWindow.window ~icon ~title:"GCS" ~border_width:1 ~width ~height ~allow_shrink:true () in - if !maximize then - window#maximize (); - if !fullscreen then - window#fullscreen (); - ignore (window#connect#destroy ~callback:destroy); - let switch_fullscreen = fun () -> - fullscreen := not !fullscreen; - if !fullscreen then - window#fullscreen () - else - window#unfullscreen () in - (window:>GWindow.window_skel),switch_fullscreen - - | Some xid -> - let window = Gdk.Window.native_of_xid xid in - (GWindow.plug ~window ~width ~height ():>GWindow.window_skel), fun _ -> () in - - (* Editor frame *) - let editor_frame = GBin.frame () in - - let geomap, menu_fact = create_geomap switch_fullscreen editor_frame in - - let map_frame = GPack.vbox () in - (** Put the canvas in a frame *) - map_frame#add geomap#frame#coerce; - - (** window for the strip panel *) - let scrolled = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let strips_table = GPack.vbox ~spacing:5 ~packing:scrolled#add_with_viewport () in - - (** Aircraft notebook *) - let ac_notebook = GPack.notebook ~tab_border:0 () in - - (** Alerts text frame *) - let alert_page = GBin.frame () in - let my_alert = new Pages.alert alert_page in - - (** Altitude graph frame *) - let alt_graph = new Gtk_tools.pixmap_in_drawin_area () in - - (** plugin frame *) - let plugin_width = 400 and plugin_height = 300 in - let plugin_frame = GPack.vbox ~width:plugin_width () in - - let widgets = ["map2d", map_frame#coerce; - "strips", scrolled#coerce; - "aircraft", ac_notebook#coerce; - "editor", editor_frame#coerce; - "alarms", alert_page#coerce; - "altgraph", alt_graph#drawing_area#coerce; - "plugin", plugin_frame#coerce] in - - let the_layout = ExtXml.child layout "0" in - pack_widgets `HORIZONTAL the_layout widgets window#add; - - (** packing papgets *) - let papgets = try find_widget_children "map2d" the_layout with Not_found -> [] in - List.iter (Papgets.create geomap#still geomap#zoom_adj) papgets; - listen_dropped_papgets geomap; - - let save_layout = fun () -> - (* Ask if ac_id parameters from papgets should be saved *) - let save_acid = - if Papgets.has_papgets () then - match GToolbox.question_box ~title:"Save Layout" ~buttons:["Yes"; "no"] ~default:1 "Do you want to save A/C id of Papgets if available\nYes: the saved layout will only work with A/C that have the same id (default)\nno: the saved layout will work with any A/C (but will mix data while using multiple A/C)" with - | 2 -> false - | _ -> true - else true - in - let the_new_layout = replace_widget_children "map2d" (Papgets.dump_store save_acid) the_layout in - let width, height = Gdk.Drawable.get_size window#misc#window in - let the_new_layout = update_widget_size `HORIZONTAL widgets the_new_layout in - let new_layout = Xml.Element ("layout", ["width", soi width; "height", soi height], [the_new_layout]) in - save_layout layout_file (Xml.to_string_fmt new_layout) - in - ignore (menu_fact#add_item "Save layout" ~key:GdkKeysyms._S ~callback:save_layout); - - - if !mplayer <> "" then - plugin_window := sprintf "mplayer -really-quiet -nomouseinput %s -wid " !mplayer; - if !plugin_window <> "" then begin - if plugin_frame#misc#parent = None then - failwith "Error: \"plugin\" widget required in layout description"; - let frame = GBin.event_box ~packing:plugin_frame#add ~width:plugin_width ~height:plugin_height () in - let s = GWindow.socket ~packing:frame#add () in - let com = sprintf "%s0x%lx" !plugin_window s#xwindow in - - let restart = fun () -> - begin match !pid_plugin with - None -> () - | Some p -> try Unix.kill p Sys.sigkill with _ -> () - end; - let com = sprintf "exec %s" com in - let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in - pid_plugin := Some (Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; com|] dev_null dev_null dev_null) in - - restart (); - - ignore (menu_fact#add_item "Restart plugin" ~key:GdkKeysyms._P ~callback:restart); - - Plugin.frame := Some frame; - - let swap = fun _ -> - (** Keep the center of the geo canvas *) - let c = geomap#get_center () in - - let child1 = List.hd map_frame#children in - let child2 = List.hd plugin_frame#children in - child2#misc#reparent map_frame#coerce; - child1#misc#reparent plugin_frame#coerce; - - (* Strange: the centering does not work if done inside this callback. - It is postponed to be called by the mainloop(). *) - ignore (GMain.Idle.add (fun () -> geomap#center c; false)); - in - - let callback = fun ev -> - match GdkEvent.Button.button ev with - 1 -> swap (); true - | 3 -> restart (); true - | _ -> false in - - ignore (frame#event#connect#button_press ~callback); - ignore (menu_fact#add_item "Swap plugin/map" ~callback:(fun _ -> swap ())); - end; - - (** Wait for A/Cs and subsequent messages *) - if not !edit then - begin - my_alert#add "Waiting for telemetry..."; - Speech.say "Waiting for telemetry..."; - Live.listen_acs_and_msgs geomap ac_notebook strips_table !confirm_kill my_alert !auto_center_new_ac !auto_center_ac alt_graph !timestamp - end; - - (** Display the window *) - let accel_group = menu_fact#accel_group in - window#add_accel_group accel_group; - window#show (); - - (** Loading an initial map *) - if !geo_ref <> "" then - Map2d.set_georef_if_none geomap (Latlong.of_string !geo_ref); - List.iter (fun map_file -> - let xml_map_file = if map_file.[0] <> '/' then default_path_maps // map_file else map_file in - display_map geomap xml_map_file) - !map_files; - - (** Center the map as required *) - if !center <> "" then begin - Map2d.set_georef_if_none geomap (Latlong.of_string !center); - geomap#center (Latlong.of_string !center) - end; - - Speech.say "Welcome to papa ratsi"; - - if !display_particules then - Particules.listen geomap ; - - if !file_to_edit <> "" then - if Sys.file_exists !file_to_edit then - EditFP.load_xml_file geomap editor_frame accel_group !file_to_edit - else - GToolbox.message_box ~title:"Error" (sprintf "Error: '%s' file does not exist\n%!" !file_to_edit); - - if !edit then - EditFP.set_window_title geomap; - - (** Threaded main loop (map tiles loaded concurently) *) - GtkThread.main () diff --git a/sw/ground_segment/cockpit/horizon.ml b/sw/ground_segment/cockpit/horizon.ml deleted file mode 100644 index b26f70715e..0000000000 --- a/sw/ground_segment/cockpit/horizon.ml +++ /dev/null @@ -1,239 +0,0 @@ -(* - * Multi aircrafts map display and flight plan editor - * - * Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin / 2011 Tobias Muench, Rolf Noellenburg - * - * 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 Latlong - -let affine_pos_and_angle xw yw angle = - let cos_a = cos angle in - let sin_a = sin angle in - [| cos_a ; sin_a ; ~-. sin_a; cos_a; xw; yw |] - - -let affine_pos xw yw = affine_pos_and_angle xw yw 0. - -let arc = fun n r start stop -> - let s = (stop -. start) /. float (n-1) in - Array.init n (fun i -> let a = start+.float i*.s in (r*.cos a, r*.sin a)) - -let floats_of_points = fun ps -> - let n = Array.length ps in - let a = Array.make (2*n) 0. in - for i = 0 to n - 1 do - let (x, y) = ps.(i) in - a.(2*i)<-x; - a.(2*i+1)<-y - done; - a - -let ruler = fun ?(index_on_right=false) ~text_props ~max_value ~scale ~w ~index_width ~step ~h root -> - let r = GnoCanvas.group root in - let height = scale *. float max_value in - - (* Grey background *) - let _ = GnoCanvas.rect ~x1:0. ~y1:(-.height) ~x2:w ~y2:height ~fill_color:"#808080" r in - let props = (text_props@[`ANCHOR `EAST]) in - - (* One step drawer *) - let tab = Array.make (max_value/step) false in - let draw = fun i -> - let i = i * step in - let y = -. scale *. float i in - let text = Printf.sprintf "%d" i in - let _ = GnoCanvas.text ~text ~props ~y ~x:(w*.0.75) r in - let _ = GnoCanvas.line ~points:[|w*.0.8;y;w;y|] ~fill_color:"white" r in - let y = y -. float step /. 2. *. scale in - let _ = GnoCanvas.line ~points:[|w*.0.8;y;w;y|] ~fill_color:"white" r in - () in - - let lazy_drawer = fun v -> - let v = truncate v / step in - for i = max 0 (v - 5) to min (v + 5) (Array.length tab - 1) do (* FIXME *) - if not tab.(i) then begin - tab.(i) <- true; - draw i - end - done in - - (** Yellow index *) - let _ = GnoCanvas.line ~points:[|0.;0.;w;0.|] ~props:[`WIDTH_PIXELS 2] ~fill_color:"yellow" root in - let s = index_width in - let idx = GnoCanvas.polygon ~points:[|0.;0.;-.s;s/.2.;-.s;-.s/.2.|] ~fill_color:"yellow" root in - if index_on_right then - idx#affine_absolute (affine_pos_and_angle w 0. pi); - - (** Mask (bottom & top) *) - let _ = GnoCanvas.rect ~x1:0. ~y1:(-.height) ~x2:w ~y2:(-.h) ~fill_color:"black" root in - let _ = GnoCanvas.rect ~x1:0. ~y1:height ~x2:w ~y2:h ~fill_color:"black" root in - r, lazy_drawer - - -class h = fun ?packing size -> - let canvas = GnoCanvas.canvas ~aa:true ~width:size ~height:size ?packing () in - let _ = - canvas#set_center_scroll_region false; - in - - let size = float size in - let size2 = size /. 2. in - - let left_margin = size2 /. 10. in - let pitch_scale = fun pitch -> pitch *. size2 *. 2. in - let speed_scale = size2 /. 10. in - let alt_scale = size2 /. 50. in - let speed_width = size2/.3. in - let alt_width = size2/.2.25 in - let index_width = size2 /. 10. in - - let xc = left_margin +. speed_width +. size2 - and yc = size2*.1.25 in - - let text_props = [`FONT "Sans 8"; `ANCHOR `CENTER; `FILL_COLOR "white"] in - - let disc = GnoCanvas.group canvas#root in - let _top = GnoCanvas.rect ~x1:(-.size) ~y1:(-.size2*.5.) ~x2:size ~y2:0. ~fill_color:"#0099cb" disc - and _bottom = GnoCanvas.rect ~x1:(-.size) ~y1:0. ~x2:size ~y2:(size2*.5.) ~fill_color:"#986701" disc - and _line = GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|-.size;0.;size;0.|] ~fill_color:"white" disc - and _ = GnoCanvas.line ~points:[|0.;-.size;0.;size|] ~fill_color:"white" disc - in - let grads = fun ?(text=false) n s a b -> - for i = 0 to n do - let deg = float i *. a +. b in - let y = pitch_scale ((Deg>>Rad)deg) in - ignore (GnoCanvas.line ~points:[|-.s; y; s; y|] ~fill_color:"white" disc); - ignore (GnoCanvas.line ~points:[|-.s; -.y; s; -.y|] ~fill_color:"white" disc); - if text then - let text = Printf.sprintf "%d" (truncate deg) - and x = 2.*.s in - ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x disc); - ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x:(-.x) disc); - let text = "-"^text in - ignore (GnoCanvas.text ~props:text_props ~text ~y ~x disc); - ignore (GnoCanvas.text ~props:text_props ~text ~y ~x:(-.x) disc); - done in - - let _ = - grads 10 (size2/.10.) 5. 2.5; - grads 5 (size2/.7.) 10. 5.; - grads ~text:true 5 (size2/.5.) 10. 10. in - - let mask = GnoCanvas.group ~x:xc ~y:yc canvas#root in - let _center = GnoCanvas.ellipse ~x1:(-3.) ~y1:(-.3.) ~x2:3. ~y2:3. ~fill_color:"black" mask in - let pi6 = pi/.6. in - let n = 20 in - let arc_above = arc n size2 pi6 (5.*.pi6) in - let (x, _y) = arc_above.(n-1) in - let rest = [|(x, 0.);(10.*.size, 0.); (10.*.size, 10.*.size); (-.size, 10.*.size);(-.size,0.);(-.x,0.)|] in - let points = floats_of_points (Array.append arc_above rest) in - let _ = - ignore (GnoCanvas.polygon ~fill_color:"black" ~points mask); - for i = 0 to Array.length points / 2 - 1 do - points.(2*i+1) <- -. points.(2*i+1) - done; - ignore (GnoCanvas.polygon ~fill_color:"black" ~points mask); - let s = size2/. 5. in - ignore (GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|-.x;0.;-.x-.s;0.;-.x-.s;s|] ~fill_color:"black" mask); - ignore (GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|x;0.;x+.s;0.;x+.s;s|] ~fill_color:"black" mask); - - (* Top and bottom graduations *) - let g = fun a -> - let l = GnoCanvas.line~props:[`WIDTH_PIXELS 1] ~fill_color:"white" ~points:[|0.;-.size2;0.;-.1.07*.size2|] mask in - l#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in - for i = 1 to 5 do - let a = float (i*10) in - g a; g (-.a) - done; - - let gg = fun a -> - let l = GnoCanvas.line~props:[`WIDTH_PIXELS 2] ~fill_color:"white" ~points:[|0.;-.size2;0.;-.1.15*.size2|] mask in - l#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in - gg 30.; gg (-30.); - gg 0.; gg 0.; - - let _30 = fun a -> - let t = GnoCanvas.text ~text:"30" ~props:text_props ~x:0. ~y:(-1.28*.size2) mask in - t#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in - _30 30.; _30 (-30.) - in - - - (* Speedometer on the left side *) - let speed, mi, mx, lazy_speed = - let g = GnoCanvas.group ~x:left_margin ~y:yc canvas#root in - let r, lazy_ruler = ruler ~text_props ~index_on_right:true ~max_value:50 ~scale:speed_scale ~w:speed_width ~step:2 ~index_width ~h:(0.75*.size2) g in - let mx = - GnoCanvas.text ~x:(speed_width/.2.) ~y:(-0.88*.size2) ~props:text_props g - and mi = - GnoCanvas.text ~x:(speed_width/.2.) ~y:(0.875*.size2) ~props:text_props g in - mx#set [`FILL_COLOR "yellow"]; - mi#set [`FILL_COLOR "yellow"]; - lazy_ruler 0.; - r, mi, mx, lazy_ruler - - (* Altimeter on the right side *) - and alt, lazy_alt = - let g = GnoCanvas.group ~x:(xc+.size2) ~y:yc canvas#root in - ruler ~text_props ~max_value:3000 ~scale:alt_scale ~w:alt_width ~step:10 ~index_width ~h:(0.75*.size2) g - in - -object - method set_attitude = fun roll pitch -> - disc#affine_absolute (affine_pos_and_angle (xc+.((sin roll)*.(pitch_scale pitch))) (yc+.pitch_scale pitch*.(cos roll)) (-.roll)) - val mutable max_speed = 0. - val mutable min_speed = max_float - method set_speed = fun (s:float) -> - speed#affine_absolute (affine_pos 0. 0.); - lazy_speed s; - speed#affine_absolute (affine_pos 0. (speed_scale*.s)); - min_speed <- min min_speed s; - max_speed <- max max_speed s; - mi#set [`TEXT (sprintf "%.1f" min_speed)]; - mx#set [`TEXT (sprintf "%.1f" max_speed)] - initializer - ignore (speed#connect#event ~callback:(function - `BUTTON_PRESS _ev -> - max_speed <- 0.; min_speed <- max_float; true - | _ -> false)) - - method set_alt = fun (s:float) -> - alt#affine_absolute (affine_pos 0. 0.); - lazy_alt s; - alt#affine_absolute (affine_pos 0. (alt_scale*.s)) - -end - -(*****************************************************************************) -(* pfd page *) -(*****************************************************************************) -class pfd ?(visible = fun _ -> true) (widget: GBin.frame) = - let horizon = new h ~packing: widget#add 150 in - let _lazy = fun f x -> if visible widget then f x in - -object - method set_attitude roll pitch = - _lazy (horizon#set_attitude ((Deg>>Rad)roll)) ((Deg>>Rad)pitch) - method set_alt (a:float) = _lazy horizon#set_alt a - method set_climb (_c:float) = () - method set_speed (c:float) = _lazy horizon#set_speed c -end diff --git a/sw/ground_segment/cockpit/horizon.mli b/sw/ground_segment/cockpit/horizon.mli deleted file mode 100644 index 28b3e671d4..0000000000 --- a/sw/ground_segment/cockpit/horizon.mli +++ /dev/null @@ -1,8 +0,0 @@ -class pfd : ?visible:(GBin.frame -> bool) -> GBin.frame -> - object - method set_speed : float -> unit - method set_alt : float -> unit - method set_climb : float -> unit - method set_attitude : float -> float -> unit - end - diff --git a/sw/ground_segment/cockpit/intruders.ml b/sw/ground_segment/cockpit/intruders.ml deleted file mode 100644 index d7a72c1798..0000000000 --- a/sw/ground_segment/cockpit/intruders.ml +++ /dev/null @@ -1,61 +0,0 @@ -(* - * Copyright (C) 2015 Gautier Hattenberger - * - * 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, see - * . - * - *) - -(*open Latlong*) - -type intruder = { - intruder_track : MapTrack.track; - mutable last_update : float -} - -(*let intruders = (string, intruder) Hashtbl.t*) -let intruders = Hashtbl.create 1 - -let new_intruder = fun id name time geomap -> - let track = new MapTrack.track ~size:200 ~icon:"intruder" ~name ~show_carrot:false id geomap in - let intruder = { intruder_track = track; last_update = time } in - Hashtbl.add intruders id intruder - -let remove_intruder = fun id -> - try - let intruder = Hashtbl.find intruders id in - intruder.intruder_track#destroy (); - Hashtbl.remove intruders id - with _ -> () (* no intruder *) - -let update_intruder = fun id wgs84 heading alt speed climb time -> - try - let intruder = Hashtbl.find intruders id in - intruder.intruder_track#move_icon wgs84 heading alt speed climb; - intruder.last_update <- time; - with _ -> () (* no intruder, add a new one ? *) - -let intruder_exist = fun id -> - Hashtbl.mem intruders id - -(* remove old intruders after 20s *) -let remove_old_intruders = fun () -> - Hashtbl.iter - (fun id i -> - if (Unix.gettimeofday () -. i.last_update) > 20.0 then - remove_intruder id - ) intruders - diff --git a/sw/ground_segment/cockpit/lib/.gitignore b/sw/ground_segment/cockpit/lib/.gitignore deleted file mode 100644 index 6121953246..0000000000 --- a/sw/ground_segment/cockpit/lib/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -gtk_*.ml - diff --git a/sw/ground_segment/cockpit/lib/META.gcslib b/sw/ground_segment/cockpit/lib/META.gcslib deleted file mode 100644 index 9f45084798..0000000000 --- a/sw/ground_segment/cockpit/lib/META.gcslib +++ /dev/null @@ -1,8 +0,0 @@ -description = "Paparazzi GCS lib" -requires = "pprz.xlib,pprzlink,lablgtk2-gnome.gnomecanvas,lablgtk2.glade" -version = "1.0" -directory = "" - -archive(byte) = "gcslib-pprz.cma" -archive(native) = "gcslib-pprz.cmxa" - diff --git a/sw/ground_segment/cockpit/lib/Makefile b/sw/ground_segment/cockpit/lib/Makefile deleted file mode 100644 index a785b06777..0000000000 --- a/sw/ground_segment/cockpit/lib/Makefile +++ /dev/null @@ -1,142 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- -# -# Copyright (C) 2003 Pascal Brisset, Antoine Drouin -# Copyright (C) 2022 Gautier Hattenberger -# -# 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. -# - - -Q=@ - -include ../../../Makefile.ocaml - -# verbose ocamlmklib: Print commands before executing them -#VERBOSITY = -verbose -VERBOSITY = - -UNAME = $(shell uname -s) -ifeq ("$(UNAME)","Darwin") - MKTEMP = gmktemp -else - MKTEMP = mktemp -endif - -LABLGTK2GNOMECANVAS = $(shell ocamlfind query -p-format lablgtk2-gnome.gnomecanvas 2>/dev/null) -ifeq ($(LABLGTK2GNOMECANVAS),) -LABLGTK2GNOMECANVAS = $(shell ocamlfind query -p-format lablgtk2.gnomecanvas 2>/dev/null) -endif - -INCLUDES= -PKGCOMMON=pprzlink -XINCLUDES= -XPKGCOMMON=pprzlink,xml-light,glibivy,$(LABLGTK2GNOMECANVAS),lablgtk2.glade - -PKG = -package lablgtk2,pprzlink,pprz.xlib -LINKPKG = $(PKG) -linkpkg -dllpath-pkg lablgtk2,pprz.xlib,pprzlink - -XSRC = contrastLabel.ml acIcon.ml wind_sock.ml gtk_papget_editor.ml gtk_papget_text_editor.ml gtk_papget_gauge_editor.ml gtk_papget_led_editor.ml papget_common.ml papget_renderer.ml papget.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml -XCMO = $(XSRC:.ml=.cmo) -XCMX = $(XSRC:.ml=.cmx) - -all : byte native -byte : gcslib-pprz.cma -native : gcslib-pprz.cmxa - -gcslib-pprz.cma libgcslib-pprz.a: $(XCMO) - @echo OL $@ - $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o gcslib-pprz $^ - -gcslib-pprz.cmxa dllgcslib-pprz.so: $(XCMX) - @echo OOL $@ - $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o gcslib-pprz $^ - -# trying to set correct dependencies for parallel build -# these are order only depedencies -gcslib-pprz.cma: | libgcslib-pprz.a dllgcslib-pprz.so - -gcslib-pprz.cmxa: | libgcslib-pprz.a dllgcslib-pprz.so - -%.o : %.c - @echo OC $< - $(Q)$(OCAMLC) -ccopt -fPIC $(INCLUDES) -package $(PKGCOMMON) -c $< - -$(XCMO) $(XCMX): PKGCOMMON=$(XPKGCOMMON) - - -GTKCFLAGS := $(shell pkg-config --cflags gtk+-2.0) -DGTK_DISABLE_DEPRECATED -ml_gtk_drag.o : ml_gtk_drag.c - @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< - -%.cmo : %.ml - @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< - -%.cmx : %.ml - @echo OOC $< - $(Q)$(OCAMLOPT) $(INCLUDES) $(PKG) -c $< - -%.cmi : %.mli - @echo OC $< - $(Q)$(OCAMLC) $(XINCLUDES) $(INCLUDES) $(PKG) $< - -gtk_papget_editor.ml : widgets.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)lablgladecc2 -root papget_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ - $(Q)rm -f $($@_TMP) - -gtk_papget_text_editor.ml : widgets.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)lablgladecc2 -root table_text_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ - $(Q)rm -f $($@_TMP) - -gtk_papget_gauge_editor.ml : widgets.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)lablgladecc2 -root table_gauge_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ - $(Q)rm -f $($@_TMP) - -gtk_papget_led_editor.ml : widgets.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ - $(Q)rm -f $($@_TMP) - -clean : - $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so gtk_papget_*.ml - -.PHONY: all byte native clean - -# -# Dependencies -# - -.depend: Makefile - @echo DEPEND $@ - $(Q)$(OCAMLDEP) $(XSRC) *.mli >> .depend - -ifneq ($(MAKECMDGOALS),clean) --include .depend -endif diff --git a/sw/ground_segment/cockpit/lib/acIcon.ml b/sw/ground_segment/cockpit/lib/acIcon.ml deleted file mode 100644 index c1775a7e8d..0000000000 --- a/sw/ground_segment/cockpit/lib/acIcon.ml +++ /dev/null @@ -1,214 +0,0 @@ -(* - * A Label with a contrasting outline - * - * Copyright (C) 2013 Piotr Esden-Tempski - * - * 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. - * - *) - -type icon = { - lines : float array list; - ellipse : float array list; - width: int -} - -let icon_fixedwing_template = { - lines = [ - [| 0.; -6.; 0.; 14.|]; - [| -9.; 0.; 9.; 0.|]; - [| -4.; 10.; 4.; 10.|] - ]; - ellipse = []; - width = 4 -} - -let icon_flyingwing_template = { - lines = [ - [| -13.; 4.; 0.; -7.; 13.; 4.|]; - [| -13.; 5.; 0.; 0.; 13.; 5.|]; - ]; - ellipse = []; - width = 4 -} - -let icon_rotorcraft_template = { - lines = [ - [| 0.; -8.; 0.; 8.|]; - [| -8.; 0.; 8.; 0.|]; - [| 6.; -15.; 0.; -24.; -6.; -15.|]; - ]; - ellipse = [ - [| 8.; -5.; 18.; 5.|]; - [| -8.; -5.; -18.; 5.|]; - [| -5.; 8.; 5.; 18.|]; - [| -5.; -8.; 5.; -18.|]; - ]; - width = 2 -} - -let icon_quadrotor_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.; -8.; 8.; 8.|]; (** Center Ring **) - [| 8.; -5.; 18.; 5.|]; - [| -8.; -5.; -18.; 5.|]; - [| -5.; 8.; 5.; 18.|]; - [| -5.; -8.; 5.; -18.|]; - ]; - width = 1 -} - -let icon_hexarotor_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **) - [| 6.26; 1.50; 16.26; 11.50|]; - [| -6.26; -1.50; -16.26; -11.50|]; - [| -5.00; 8.00; 5.00; 18.00|]; - [| -5.00; -8.00; 5.00; -18.00|]; - [| 6.26; -1.50; 16.26; -11.50|]; - [| -6.26; 1.50; -16.26; 11.50|]; - ]; - width = 1 -} - -let icon_octorotor_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **) - [| 8.00; -5.00; 18.00; 5.00|]; - [| -8.00; -5.00; -18.00; 5.00|]; - [| -5.00; 8.00; 5.00; 18.00|]; - [| -5.00; -8.00; 5.00; -18.00|]; - [| 4.19; -4.19; 14.19; -14.19|]; - [| -4.19; 4.19; -14.19; 14.19|]; - [| 14.19; 14.19; 4.19; 4.19|]; - [| -14.19; -14.19; -4.19; -4.19|]; - ]; - width = 1 -} - -let icon_quadrotor_x_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **) - [| 4.19; 4.19; 14.19; 14.19|]; - [| -4.19; -4.19; -14.19; -14.19|]; - [| -4.19; 4.19; -14.19; 14.19|]; - [| 4.19; -4.19; 14.19; -14.19|]; - ]; - width = 1 -} - -let icon_quadrotor_xi_template = { - lines = [ - [| 6.;-15.; 0.;-24.; -6.;-15.|]; (** Front Marker **) - [| 0.; -4.; 0.; 4.|]; - [|-4.; -6.; 0.; -4.; 4.; -6.|]; - [|-4.; 6.; 0.; 4.; 4.; 6.|]; - ]; - ellipse = [ - [| 4.19; 4.19; 14.19; 14.19|]; - [| -4.19; -4.19; -14.19; -14.19|]; - [| -4.19; 4.19; -14.19; 14.19|]; - [| 4.19; -4.19; 14.19; -14.19|]; - ]; - width = 1 -} - -let icon_hexarotor_x_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.0; -8.00; 8.0; 8.00|]; (** Center Ring **) - [| 1.5; 6.26; 11.5; 16.26|]; - [| -1.5; -6.26; -11.5; -16.26|]; - [| 8.0; -5.00; 18.0; 5.00|]; - [| -8.0; -5.00; -18.0; 5.00|]; - [| 1.5; -6.26; 11.5; -16.26|]; - [| -1.5; 6.26; -11.5; 16.26|]; - ]; - width = 1 -} - -let icon_octorotor_x_template = { - lines = [ - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.; -8.; 8.; 8.|]; (** Center Ring **) - [| 0.; 7.; 10.; 17.|]; - [| 7.; 0.; 17.; 10.|]; - [| 0.; -7.; 10.; -17.|]; - [| -7.; 0.; -17.; 10.|]; - [| 0.; 7.; -10.; 17.|]; - [| 7.; 0.; 17.; -10.|]; - [| 0.; -7.; -10.; -17.|]; - [| -7.; 0.; -17.; -10.|]; - ]; - width = 1 -} - -let icon_home_template = { - lines = [ - [| -9.; -9.; -9.; 9.; 9.; 9.; 9.; -9.|]; - [| -12.; -7.; 0.; -15.; 12.; -7.|]; - ]; - ellipse = []; - width = 3; -} - -let icon_intruder_template = { - lines = [ - [| 0.; 0.; 0.; -24. |]; - [| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **) - ]; - ellipse = [ - [| -8.; -8.; 8.; 8.|]; - ]; - width = 1 -} - -class widget = fun ?(color="red") ?(icon_template=icon_fixedwing_template) (group:GnoCanvas.group) -> - let new_line width color points = - GnoCanvas.line ~fill_color:color ~props:[`WIDTH_PIXELS width; `CAP_STYLE `ROUND] ~points:points group in - let new_ellipse width color points = - GnoCanvas.ellipse ~props:[`OUTLINE_COLOR color; `WIDTH_PIXELS width] ~x1:points.(0) ~y1:points.(1) ~x2:points.(2) ~y2:points.(3) group in - let icon_bg = - (List.map (fun points -> new_line (icon_template.width+2) "black" points) icon_template.lines, - List.map (fun points -> new_ellipse (icon_template.width+2) "black" points) icon_template.ellipse) in - let icon = - (List.map (fun points -> new_line icon_template.width color points) icon_template.lines, - List.map (fun points -> new_ellipse icon_template.width color points) icon_template.ellipse) in -object(self) - method set_color color = - List.iter2 (fun segment ellipse -> segment#set [`FILL_COLOR color]; ellipse#set [`FILL_COLOR color]) (fst icon) (snd icon) - method set_bg_color color = - List.iter2 (fun segment ellipse -> segment#set [`FILL_COLOR color]; ellipse#set [`FILL_COLOR color]) (fst icon_bg) (snd icon_bg) -end - diff --git a/sw/ground_segment/cockpit/lib/acIcon.mli b/sw/ground_segment/cockpit/lib/acIcon.mli deleted file mode 100644 index 77d79302c3..0000000000 --- a/sw/ground_segment/cockpit/lib/acIcon.mli +++ /dev/null @@ -1,52 +0,0 @@ -(* - * A Label with a contrasting outline - * - * Copyright (C) 2013 Piotr Esden-Tempski - * - * 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. - * - *) - -type icon = { - lines : float array list; - ellipse : float array list; - width: int -} - -val icon_fixedwing_template : icon -val icon_flyingwing_template : icon -val icon_rotorcraft_template : icon -val icon_quadrotor_template : icon -val icon_hexarotor_template : icon -val icon_octorotor_template : icon -val icon_quadrotor_x_template : icon -val icon_hexarotor_x_template : icon -val icon_octorotor_x_template : icon -val icon_quadrotor_xi_template : icon -val icon_home_template : icon -val icon_intruder_template : icon - -class widget : - ?color : string -> - ?icon_template : icon -> - GnoCanvas.group -> -object - method set_color : string -> unit - method set_bg_color : string -> unit -end - diff --git a/sw/ground_segment/cockpit/lib/contrastLabel.ml b/sw/ground_segment/cockpit/lib/contrastLabel.ml deleted file mode 100644 index 904f05f16c..0000000000 --- a/sw/ground_segment/cockpit/lib/contrastLabel.ml +++ /dev/null @@ -1,60 +0,0 @@ -(* - * A Label with a contrasting outline - * - * Copyright (C) 2013 Piotr Esden-Tempski - * - * 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. - * - *) - -(* - * This module creates labels with outlines by creating 9 - * overlapping labels slightly offset from eachother. Where the 8 - * labels in the background have a different color from last center one. - *) - -let label_offset_matrix = - [ - (* X Y *) - ( 0., -1.); (* N *) - ( 0., 1.); (* S *) - ( 1., 0.); (* E *) - (-1., 0.); (* W *) - ( 1., -1.); (* NE *) - ( 1., 1.); (* SE *) - (-1., 1.); (* SW *) - (-1., -1.); (* NW *) - ( 0., 0.); (* Z *) - ] - -class widget = fun ?(name = "Noname") ?(size = 500) ?(bg_color = "black") ?(color = "white") x y (group:GnoCanvas.group) -> - let new_text offset = - GnoCanvas.text group ~props:[`TEXT name; - `X (x +. (fst offset)); `Y (y +. (snd offset)); - `ANCHOR `SW; - `FILL_COLOR (if offset = (0., 0.) then color else bg_color)] in - let labels = List.map new_text label_offset_matrix in -object(self) - method set_name s = List.iter (fun label -> label#set [`TEXT s]) labels - method set_x x = List.iter2 (fun label offset -> label#set [`X (x +. (fst offset))]) - labels label_offset_matrix - method set_y y = List.iter2 (fun label offset -> label#set [`Y (y +. (snd offset))]) - labels label_offset_matrix - method affine_absolute a = List.iter (fun label -> label#affine_absolute a) labels -end - diff --git a/sw/ground_segment/cockpit/lib/contrastLabel.mli b/sw/ground_segment/cockpit/lib/contrastLabel.mli deleted file mode 100644 index 0f26172da2..0000000000 --- a/sw/ground_segment/cockpit/lib/contrastLabel.mli +++ /dev/null @@ -1,39 +0,0 @@ -(* - * A Label with a contrasting outline - * - * Copyright (C) 2013 Piotr Esden-Tempski - * - * 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. - * - *) - -class widget : - ?name:string -> - ?size:int -> - ?bg_color:string -> - ?color:string -> - float -> - float -> - GnoCanvas.group -> - object - method set_name : string -> unit - method set_x : float -> unit - method set_y : float -> unit - method affine_absolute : float array -> unit - end - diff --git a/sw/ground_segment/cockpit/lib/mapCanvas.ml b/sw/ground_segment/cockpit/lib/mapCanvas.ml deleted file mode 100644 index 4c7a3324c3..0000000000 --- a/sw/ground_segment/cockpit/lib/mapCanvas.ml +++ /dev/null @@ -1,899 +0,0 @@ -(* - * Geographic display - * - * Copyright (C) 2004-2006 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. - * - *) - -module LL = Latlong -open LL -module G2D = Geometry_2d -open Printf -let (//) = Filename.concat - -type world = float * float - -let zoom_factor = 1.5 (* Mouse wheel zoom action *) -let max_zoom = 40. -let pan_step = 50 (* Pan keys speed *) -let pan_arrow_size = 40. - -let grid_color = "#29d3f8" -let size_utm_grid = 10 (* half the horiz/vert size in km *) - -let align = fun x a -> - float (truncate (x /. float a) * a) - -type meter = float - -let distance = fun (x1,y1) (x2,y2) -> sqrt ((x1-.x2)**2.+.(y1-.y2)**2.) - -let affine_pos_and_angle ?(z = 1.) xw yw angle = - let cos_a = cos angle in - let sin_a = sin angle in - [| cos_a /. z; sin_a /. z; ~-. sin_a /. z; cos_a /. z; xw ; yw |] - -type projection = - Mercator (* 1e-6 = 1 world unit, y axis reversed *) - | UTM (* 1m = 1 world unit, y axis reversed *) - | LambertIIe (* 1m = 1 world unit, y axis reversed *) - -let string_of_projection = function -UTM -> "UTM" - | Mercator -> "Mercator" - | LambertIIe -> "LBT2e" - -let mercator_coeff = 5e6 - -let my_check_menu_item = fun label ~active ~callback ~packing () -> - let mi = GMenu.check_menu_item ~label ~active ~packing () in - ignore (mi#connect#toggled ~callback:(fun () -> callback mi#active)); - mi - -let my_menu_item = fun label ~callback ~packing () -> - let mi = GMenu.menu_item ~label ~packing () in - ignore (mi#connect#activate ~callback) - -let my_menu_item_insert = fun label ~menu ~pos ~callback -> - let mi = GMenu.menu_item ~label () in - menu#insert mi ~pos ; - ignore (mi#connect#activate ~callback) - -let set_opacity = fun pixbuf opacity -> - let pixbuf = GdkPixbuf.add_alpha pixbuf in - - let region = GdkPixbuf.get_pixels pixbuf - and w = GdkPixbuf.get_width pixbuf - and h = GdkPixbuf.get_height pixbuf in - let n_channels = GdkPixbuf.get_n_channels pixbuf in - assert(n_channels = 4); - for i = 0 to h - 1 do - for j = 0 to w - 1 do - let pos = n_channels* (i*w + j) + 3 in - Gpointer.set_byte region ~pos opacity - done - done; - pixbuf - - -type drawing = - NotDrawing - | Rectangle of float*float - | Panning of float*float - - -let float_array_of_points = fun l -> - Array.of_list (List.fold_right (fun (x,y) r -> x::y::r) l []) - -let pvect (x1,y1) (x2,y2) = x1*.y2-.y1*.x2 - -let rec convexify = fun l -> - match l with - [] | [_] | [_;_] -> l - | (x1,y1)::(x2,y2)::(x3,y3)::l -> - if pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2) < 0. - then convexify ((x1,y1)::(x3,y3)::l) - else (x1,y1)::convexify ((x2,y2)::(x3,y3)::l) - -let convex = fun l -> - match convexify l with - [] -> [] - | (x3,y3)::ps -> - (** Remove last bad points *) - let rec loop = fun l -> - match l with - [] | [_] -> l - | (x2,y2)::(x1,y1)::pts -> - if pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2) < 0. - then loop ((x1,y1)::pts) - else l in - (x3,y3)::List.rev (loop (List.rev ps)) - -(** Setting Opacity for bitmap *) -let stipple_opacity = fun opacity -> - match opacity with - | 0 -> (1,"\002\001") - | 1 -> (3,"\002\001") - | 2 -> (2,"\002\001") - | 3 -> (1,"\003\001") - | _ -> (1,"\002\001") - -class type geographic = object - method pos : Latlong.geographic -end - - -(** basic canvas with menubar ************************************************) - -(* world_unit: m:pixel at scale 1. *) -class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef () -> - let frame = GPack.vbox ~height ?width () in - - let top_bar = GPack.hbox ~packing:frame#pack () in - - let menubar = GMenu.menu_bar ~packing:(top_bar#pack ~expand:true) () in - let file_menu_item = GMenu.menu_item ~label:"Nav" ~packing:menubar#append () in - let file_menu = GMenu.menu () in - let _ = file_menu_item#set_submenu file_menu in - let factory = new GMenu.factory menubar in - - let toolbar = GPack.hbox ~packing:top_bar#pack () in - - let info = GPack.hbox ~packing:top_bar#pack () in - - let spin_button = GEdit.spin_button ~rate:0. ~digits:2 ~width:50 (*** ~height:20 ***) ~packing:top_bar#pack () in - - let canvas = GnoCanvas.canvas ~packing:(frame#pack ~expand:true) () in - let background = GnoCanvas.group canvas#root - and still = GnoCanvas.group canvas#root in - (* set a black rectangle as background to catch mouse event even without maps loaded *) - let _ = GnoCanvas.rect ~props:[`X1 (-25000000.); `Y1 (-25000000.); `X2 25000000.; `Y2 25000000.; `FILL_COLOR "black"] background in - (* create several layers of canvas group to display the map in correct order *) - let maps = Array.init (Gm.zoom_max - Gm.zoom_min + 1) (fun _ -> GnoCanvas.group background) in - let view_cbs = Hashtbl.create 3 in (* Store for view event callback *) - let region_rectangle = GnoCanvas.rect canvas#root ~props:[`WIDTH_PIXELS 2; `OUTLINE_COLOR "red"] in - - (* Pan arrows *) - let s = pan_arrow_size in - let s2 = s/.2. and s4=s/.4. in - let points = [|0.;0.; s2;s2; s4;s2; s4;s; -.s4;s; -.s4;s2; -.s2;s2|] in - let props = [`FILL_COLOR "#a0a0ff"; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] in - let arrow = fun x y angle -> - let a = GnoCanvas.polygon still ~points ~props in - a#affine_relative (affine_pos_and_angle x y angle); - a in - let north_arrow = arrow (1.5*.s) 0. 0. - and south_arrow = arrow (1.5*.s) (3.*.s) LL.pi - and west_arrow = arrow 0. (1.5*.s) (-.LL.pi/.2.) - and east_arrow = arrow (3.*.s) (1.5*.s) (LL.pi/.2.) in - - (* Biroute *) - let wind_sock = new Wind_sock.item 4. still in - let _ = wind_sock#item#affine_relative (affine_pos_and_angle 60. 60. 0.) in - (* Time *) - let utc_time = GnoCanvas.text ~x:0. ~y:0. ~props:[`TEXT "00:00:00"; `FILL_COLOR "#00ff00"; `ANCHOR `NW] still in - -object (self) - - (** GUI attributes *) - - val background = background - val toolbar = toolbar - method toolbar = toolbar - method background = background - method still = still - method maps = maps - method top_still = 3.5*.s - method utc_time = utc_time - method set_utc_time = fun h m s -> - let string = sprintf "%02d:%02d:%02d" h m s in - utc_time#set [`TEXT string] - - method wind_sock = wind_sock - method set_wind_sock = fun angle_deg string -> - let angle_rad = (Deg>>Rad) (90. +. angle_deg) in - wind_sock#item#affine_absolute (affine_pos_and_angle 60. 60. angle_rad); - wind_sock#label#set [`TEXT string] - - val adj = GData.adjustment - ~value:1. ~lower:0.005 ~upper:max_zoom - ~step_incr:0.25 ~page_incr:1.0 ~page_size:0. () - - method info = info - - (** other attributes *) - - val mutable projection = projection - val mutable georef = georef - val mutable dragging = None - val mutable drawing = NotDrawing - val mutable region = None (* Rectangle selected region *) - val mutable last_mouse_x = 0 - val mutable last_mouse_y = 0 - val mutable zoom_level = 1.; - - val mutable fitted_objects = ([] : geographic list) - - method region = region - method register_to_fit = fun o -> fitted_objects <- o :: fitted_objects - - method fit_to_window () = - let min_lat, max_lat, min_long, max_long = - List.fold_right - (fun p (min_lat, max_lat, min_long, max_long) -> - let pos = p#pos in - let lat = pos.LL.posn_lat - and long = pos.LL.posn_long in - (* Processing over positive longitudes *) - let long = if long < 0. then long +. 2. *. pi else long in - (min min_lat lat, max max_lat lat, - min min_long long, max max_long long)) - fitted_objects - (max_float, -.max_float, max_float, -. max_float) in - - (* Over 0° ? *) - let min_long, max_long = - if max_long -. min_long > pi - then (max_long -. 2. *. pi, min_long) - else (min_long, max_long) in - - (* Longitude is renormalized here *) - let c = LL.make_geo ((min_lat+.max_lat)/.2.) ((min_long+.max_long)/.2.) - and nw_xw, nw_yw = self#world_of (LL.make_geo max_lat min_long) - and se_xw, se_yw = self#world_of (LL.make_geo min_lat max_long) in - let width, height = Gdk.Drawable.get_size canvas#misc#window in - let margin = 10 in - let width = width - 2*margin and height = height - 2*margin in - let zoom = min (float width/.(se_xw-.nw_xw)) (float height/.(se_yw-.nw_yw)) in - self#zoom zoom; - self#center c - - (** initialization of instance attributes *) - - initializer ( - - spin_button#set_adjustment adj; - spin_button#set_value zoom_level; (* this should be done by set_adjustment but seems to fail on ubuntu 13.10 (at least) *) - - utc_time#hide (); - - ignore (GMisc.separator ~packing:(toolbar#pack ~from:`END) `VERTICAL ()); - - (** callback bindings *) - - canvas#coerce#misc#modify_bg [`NORMAL, `BLACK]; - ignore (background#connect#event ~callback:self#background_event); - - ignore (canvas#event#connect#motion_notify ~callback:self#mouse_motion); - ignore (canvas#event#connect#after#key_press ~callback:self#key_press) ; - ignore (canvas#event#connect#enter_notify ~callback:(fun _ -> self#canvas#misc#grab_focus () ; false)); - ignore (canvas#event#connect#any ~callback:self#any_event); - ignore (adj#connect#value_changed ~callback:(fun () -> if abs_float (adj#value -. zoom_level) >= 0.01 then self#zoom_in_center adj#value)); - - canvas#set_center_scroll_region false ; - canvas#set_scroll_region ~x1:(-25000000.) ~y1:(-25000000.) ~x2:25000000. ~y2:25000000.; - - ) - - - - (** methods *) - - (** accessors to instance variables *) - method current_zoom = zoom_level - method canvas = canvas - method frame = frame - method factory = factory - method menubar = menubar - method file_menu = file_menu - method window_to_world = canvas#window_to_world - method root = canvas#root - method zoom_adj = adj - - (** following display functions can be redefined by subclasses. - they do nothing in the basic_widget *) - method display_geo = fun _s -> () - method display_alt = fun _wgs84 -> () - method display_group = fun _s -> () - - method georef = georef - method set_georef = fun wgs84 -> georef <- Some wgs84 - - method projection = string_of_projection projection - - - method world_of = fun wgs84 -> - assert (LL.valid_geo wgs84); - match georef with - Some georef -> begin - match projection with - UTM -> - let utmref = LL.utm_of LL.WGS84 georef - and utm = LL.utm_of LL.WGS84 wgs84 in - let (wx, y) = LL.utm_sub utm utmref in - (wx, -.y) - | Mercator -> - let mlref = LL.mercator_lat georef.LL.posn_lat - and ml = LL.mercator_lat wgs84.LL.posn_lat in - let dl = LL.norm_angle (wgs84.LL.posn_long -. georef.LL.posn_long) in - let xw = dl *. mercator_coeff - and yw = -. (ml -. mlref) *. mercator_coeff in - (xw, yw) - | LambertIIe -> - let lbtref = LL.lambertIIe_of georef - and lbt = LL.lambertIIe_of wgs84 in - let (wx, y) = LL.lbt_sub lbt lbtref in - (wx, -.y) - end - | None -> failwith "#world_of : no georef" - - method pt2D_of = fun wgs84 -> - let (x, y) = self#world_of wgs84 in - {G2D.x2D = x; y2D = y} - - method of_world = fun (wx, wy) -> - match georef with - Some georef -> begin - match projection with - UTM -> - let utmref = LL.utm_of LL.WGS84 georef in - LL.of_utm LL.WGS84 (LL.utm_add utmref (wx, -.wy)) - | LambertIIe -> - let utmref = LL.lambertIIe_of georef in - LL.of_lambertIIe (LL.lbt_add utmref (wx, -.wy)) - | Mercator -> - let mlref = LL.mercator_lat georef.LL.posn_lat in - let ml = mlref -. wy /. mercator_coeff in - let lat = LL.inv_mercator_lat ml - and long = wx /. mercator_coeff +. georef.LL.posn_long in - LL.make_geo lat long - end - | None -> failwith "#of_world : no georef" - - - method convert_positions_to_points = fun geo_arr -> - let getx = fun (x1, y1) -> x1 in - let gety = fun (x1, y1) -> y1 in - let arrlen = (Array.length geo_arr) in - let points = Array.make (arrlen*2) (getx (self#world_of geo_arr.(0))) in - for i = 0 to arrlen - 1 do - points.(i*2) <- getx (self#world_of geo_arr.(i)); - points.((i*2)+1) <- gety (self#world_of geo_arr.(i)); - done; - points - - method move_item = fun ?(z = 1.) (item:GnomeCanvas.re_p GnoCanvas.item) wgs84 -> - let (xw,yw) = self#world_of wgs84 in - item#affine_absolute (affine_pos_and_angle ~z xw yw 0.); - - method moveto = fun wgs84 -> - let (xw, yw) = self#world_of wgs84 in - let (xc, yc) = canvas#world_to_window ~wox:xw ~woy:yw in - canvas#scroll_to ~x:(truncate xc) ~y:(truncate yc) - - method center = fun wgs84 -> - let (xw, yw) = self#world_of wgs84 in - let (xc, yc) = canvas#world_to_window ~wox:xw ~woy:yw in - let (xt, yt) = ((truncate xc), (truncate yc)) in - let sx_w, sy_w = Gdk.Drawable.get_size canvas#misc#window in - canvas#scroll_to ~x:(xt-sx_w/2) ~y:(yt-sy_w/2) - - method get_center = fun () -> - let (x, y) = canvas#get_scroll_offsets - and (sx_w, sy_w) = Gdk.Drawable.get_size canvas#misc#window in - let xc = x + sx_w/2 and yc = y + sy_w/2 in - let (xw, yw) = canvas#window_to_world ~winx:(float xc) ~winy:(float yc) in - self#of_world (xw, yw) - - - method display_pixbuf = fun ?opacity ?level ((x1,y1), geo1) ((x2,y2), geo2) image -> - let x1 = float x1 and x2 = float x2 - and y1 = float y1 and y2 = float y2 in - let image = - match opacity with - None -> image - | Some o -> set_opacity image o in - let map_layer = match level with - | None -> 0 - | Some l -> - if l > Gm.zoom_max then - Array.length maps - 1 - else if l < Gm.zoom_min then - 0 - else l - Gm.zoom_min - in - let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1) ~pixbuf:image ~props:[`ANCHOR `NW] maps.(map_layer) in - let xw1, yw1 = self#world_of geo1 - and xw2, yw2 = self#world_of geo2 in - - let scale = distance (xw1, yw1) (xw2, yw2) /. distance (x1,y1) (x2,y2) in - let a = atan2 (yw2-.yw1) (xw2-.xw1) -. atan2 (y2-.y1) (x2-.x1) in - let cos_a = cos a *. scale and sin_a = sin a *. scale in - pix#move ~x:xw1 ~y:yw1; - pix#affine_relative [| cos_a; sin_a; -. sin_a; cos_a; 0.;0.|]; - pix - - method fix_bg_coords (xw, yw) = (** FIXME: how to do it properly ? *) - ((xw +. 25000000.) *. zoom_level, (yw +. 25000000.) *. zoom_level) - - method zoom = fun value -> - let value = min max_zoom value in - zoom_level <- value; (* must set this before changing adj so that another zoom is not triggered *) - adj#set_value value; - canvas#set_pixels_per_unit value - - (** events *******************************************) - method background_event = fun ev -> - match ev with - | `BUTTON_PRESS ev when GdkEvent.Button.button ev = 1 -> - begin - let xc = GdkEvent.Button.x ev - and yc = GdkEvent.Button.y ev - and state = GdkEvent.Button.state ev in - let (xw,yw) = self#window_to_world ~winx:xc ~winy:yc in - let (xw, yw) = self#fix_bg_coords (xw, yw) in - if Gdk.Convert.test_modifier `SHIFT state then begin - drawing <- Rectangle (xw,yw); - region_rectangle#set [`X1 xw; `Y1 yw; `X2 xw; `Y2 yw]; - region_rectangle#raise_to_top () - end else begin (* panning *) - drawing <- Panning (xc, yc); - let curs = Gdk.Cursor.create `FLEUR in - background#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs - (GdkEvent.Button.time ev) - end; - true - end - | `MOTION_NOTIFY ev -> - begin - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let (xw, yw) = self#window_to_world ~winx:xc ~winy:yc in - let (xw, yw) = self#fix_bg_coords (xw, yw) in - match drawing with - Rectangle (x1,y1) -> - let starting_point = self#of_world (x1,y1) in - let starting_point = LL.utm_of LL.WGS84 starting_point in - let current_point = LL.utm_of LL.WGS84 (self#of_world (xw, yw)) in - let (east, north) = LL.utm_sub current_point starting_point in - region_rectangle#set [`X2 xw; `Y2 yw]; - self#display_group (sprintf "[%.0fm %.0fm]" east north) - | Panning (x0, y0) -> - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let dx = zoom_level *. (xc -. x0) - and dy = zoom_level *. (yc -. y0) in - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to ~x:(x-truncate dx) ~y:(y-truncate dy) - | _ -> () - end; - false - | `BUTTON_RELEASE ev when GdkEvent.Button.button ev = 1 -> - begin - let xc = GdkEvent.Button.x ev in - let yc = GdkEvent.Button.y ev in - let current_point = self#window_to_world ~winx:xc ~winy:yc in - let current_point = self#fix_bg_coords current_point in - match drawing with - Rectangle (x1,y1) -> - region <- Some ((x1,y1), current_point); - self#display_group ""; - drawing <- NotDrawing; - true - | Panning _ -> - drawing <- NotDrawing; - background#ungrab (GdkEvent.Button.time ev); - true - | _ -> false - end - | _ -> false - - - method mouse_motion = fun ev -> - if georef <> None then begin - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let (xw, yw) = self#window_to_world ~winx:xc ~winy:yc in - self#display_geo (self#of_world (xw,yw)); - self#display_alt (self#of_world (xw,yw)); - let (x, y) = canvas#get_scroll_offsets in - last_mouse_x <- truncate xc - x; - last_mouse_y <- truncate yc - y - end; - false - - method switch_background = fun x -> if x then Array.iter (fun m -> m#show ()) maps else Array.iter (fun m -> m#hide ()) maps - - - method key_press = fun ev -> - let (x, y) = canvas#get_scroll_offsets in - match GdkEvent.Key.keyval ev with - | k when k = GdkKeysyms._Up -> canvas#scroll_to ~x ~y:(y-pan_step) ; true - | k when k = GdkKeysyms._Down -> canvas#scroll_to ~x ~y:(y+pan_step) ; true - | k when k = GdkKeysyms._Left -> canvas#scroll_to ~x:(x-pan_step) ~y ; true - | k when k = GdkKeysyms._Right -> canvas#scroll_to ~x:(x+pan_step) ~y ; true - | k when k = GdkKeysyms._f -> self#fit_to_window () ; true - | k when k = GdkKeysyms._Page_Up -> - self#zoom_up (); - true - | k when k = GdkKeysyms._Page_Down -> - self#zoom_down (); - true - | _ -> false - - method connect_view = fun cb -> - Hashtbl.add view_cbs cb () - - (* zoom keeping the center *) - method zoom_in_center = fun z -> - let c = self#get_center () in - self#zoom z; - self#center c - - (* zoom keeping the area under the mouse pointer *) - method zoom_in_place = fun z -> - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to ~x:(x+last_mouse_x) ~y:(y+last_mouse_y); - - self#zoom z; - - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to ~x:(x-last_mouse_x) ~y:(y-last_mouse_y) - - - - method zoom_up () = - self#zoom_in_place (zoom_level*.zoom_factor); - method zoom_down () = - self#zoom_in_place (zoom_level/.zoom_factor); - - method any_event = - let rec last_view = ref (0,0,0,0) in - fun ev -> - let width_c, height_c = Gdk.Drawable.get_size canvas#misc#window - and (xc0, yc0) = canvas#get_scroll_offsets in - let view = (xc0, yc0, width_c, height_c) in - (** View has changed ? *) - if view <> !last_view then begin - last_view := view; - Hashtbl.iter (fun cb _ -> cb ()) view_cbs - end; - try - match GdkEvent.get_type ev with - | `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin - let scroll_event = GdkEvent.Scroll.cast ev in - match GdkEvent.Scroll.direction scroll_event with - `UP -> self#zoom_up (); true - | `DOWN -> self#zoom_down (); true - | _ -> false - end - | _ -> false - with - Invalid_argument _ -> (* Raised GdkEvent.get_type *) - false - - - - method segment = fun ?(group = canvas#root) ?(width=1) ?fill_color geo1 geo2 -> - let (x1, y1) = self#world_of geo1 - and (x2, y2) = self#world_of geo2 in - let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points:[|x1;y1;x2;y2|] group in - l#show (); - l - - method arc = fun ?(nb_points=5) ?(width=1) ?fill_color (xw,yw) r a1 a2 -> - let c = {G2D.x2D = xw; y2D = yw } in - let pts = G2D.arc ~nb_points c r a1 a2 in - let points = Array.init (2*nb_points) - (fun j -> - let i = j / 2 in - if j = i * 2 then pts.(i).G2D.x2D else pts.(i).G2D.y2D) in - let _p = points in - let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points canvas#root in - l#show (); - l - - - method circle = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(opacity=0) ?(color="black") geo radius -> - let (x, y) = self#world_of geo in - let (stpwidth, stpstr) = stipple_opacity opacity in - (** Compute the actual radius in a UTM projection *) - let utm = LL.utm_of LL.WGS84 geo in - let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in - let (xe, _) = self#world_of geo_east in - let rad = xe -. x in - let l = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:stpwidth ~height:stpwidth stpstr)] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in - l#show (); - l - - method polygon = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(opacity=0) ?(color="black") geo_arr -> - (*setting opacity from 0-4 *) - let (stpwidth, stpstr) = stipple_opacity opacity in - let points = self#convert_positions_to_points geo_arr in - let l = GnoCanvas.polygon ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:stpwidth ~height:stpwidth stpstr)] ~points group in - l#show (); - l - - method photoprojection = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") ?(number="1") geo radius -> - let (x, y) = self#world_of geo in - - (** Compute the actual radius in a UTM projection *) - let utm = LL.utm_of LL.WGS84 geo in - let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in - let (xe, _) = self#world_of geo_east in - let rad = xe -. x in - let l1 = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in - let l2 = GnoCanvas.text ~x:(x) ~y:(y) ~text:number ~props:[`FILL_COLOR color; `X_OFFSET 0.0; `Y_OFFSET 0.0] group in - l1#show (); - l2#show (); - l2 - - method text = fun ?(group = canvas#root) ?(fill_color = "blue") ?(x_offset = 0.0) ?(y_offset = 0.0) geo text -> - let (x1, y1) = self#world_of geo in - let t = GnoCanvas.text ~x:x1 ~y:y1 ~text:text ~props:[`FILL_COLOR fill_color; `X_OFFSET x_offset; `Y_OFFSET y_offset] group in - t#show (); - t - - initializer - let replace_still = fun _ -> - let (x, y) = canvas#get_scroll_offsets in - let (xc, yc) = canvas#window_to_world ~winx:(float x) ~winy:(float y) in - let z = 1./.zoom_level in - still#affine_absolute [|z;0.;0.;z;xc;yc|] - in - self#connect_view replace_still; - let move_timer = ref (Glib.Timeout.add ~ms:0 ~callback:(fun _ -> false)) in - let move dx dy = function - `BUTTON_PRESS _ -> - let scroll = fun _ -> - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to ~x:(x+dx) ~y:(y+dy) ; true in - move_timer := Glib.Timeout.add ~ms:50 ~callback:scroll; - true - | `BUTTON_RELEASE _ -> - Glib.Timeout.remove !move_timer; - true - | _ -> false in - let up = move 0 (-pan_step) - and down = move 0 pan_step - and left = move (-pan_step) 0 - and right = move pan_step 0 in - ignore (north_arrow#connect#event ~callback:up); - ignore (south_arrow#connect#event ~callback:down); - ignore (west_arrow#connect#event ~callback:left); - ignore (east_arrow#connect#event ~callback:right) - end - - -(** canvas which inherits from basic_widget ******************** - * - labels for displaying mouse coordinates on the map * - * - background switching * - ****************************************************************) - - -class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () -> - let srtm = GMenu.check_menu_item ~label:"display SRTM alt" ~active:srtm () in - let lbl_xy = GMisc.label () - and lbl_geo = GMisc.label () - and lbl_alt = GMisc.label () - and lbl_group = GMisc.label () in - - let georef_menu = GMenu.menu () - and optmenu = GMenu.option_menu () in - - object(self) - inherit (basic_widget ~height ?width ?projection ?georef ()) - - val mutable utm_grid_group = None - val mutable georefs = [] - val mutable selected_georef = WGS84_dec - - method pack_labels = - self#info#pack lbl_xy#coerce; - self#info#pack optmenu#coerce; - self#info#pack lbl_geo#coerce; - self#info#pack lbl_alt#coerce; - self#info#pack lbl_group#coerce; - - initializer ( - self#pack_labels; - self#file_menu#append (srtm :> GMenu.menu_item); - ignore (my_check_menu_item "UTM Grid" ~active:false ~callback:self#switch_utm_grid ~packing:self#file_menu#append ()); - ignore (my_check_menu_item "UTC Time" ~active:false ~callback:self#switch_utc_time ~packing:self#file_menu#append ()); - let bg_menu = my_check_menu_item "Background" ~active:true ~callback:self#switch_background ~packing:self#file_menu#append () in - - let tooltips = GData.tooltips () in - tooltips#set_tip srtm#coerce ~text:"Display SRTM alt at pointer position (will request for download if not available)"; - - let b = GButton.button ~packing:toolbar#add () in - ignore (b#connect#clicked ~callback:(fun _ -> bg_menu#activate ())); - let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // "switch_background.png") in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); - tooltips#set_tip b#coerce ~text:"Toggle background"; - - my_menu_item "Goto" ~callback:self#goto ~packing:self#file_menu#append (); - - let callback = self#fit_to_window in - my_menu_item "Fit to window (f)" ~callback ~packing:self#file_menu#append (); - let b = GButton.button ~packing:toolbar#add () in - ignore (b#connect#clicked ~callback); - ignore (GMisc.image ~stock:(`STOCK "gtk-zoom-fit") ~packing:b#add ()); - tooltips#set_tip b#coerce ~text:"Fit to window"; - - let set = fun x () -> selected_georef <- x in - my_menu_item "WGS84" ~packing:georef_menu#append ~callback:(set WGS84_dec) (); - my_menu_item "WGS84_dms" ~packing:georef_menu#append ~callback:(set WGS84_dms) (); - my_menu_item "LambertIIe" ~packing:georef_menu#append ~callback:(set LBT2e) (); - optmenu#set_menu georef_menu - ) - - method switch_utc_time = fun flag -> - if flag then self#utc_time#show () else self#utc_time#hide () - - method switch_utm_grid = fun flag -> - match georef with - None -> () - | Some georef -> - match utm_grid_group with - None -> - if flag then (** Create and show *) - let g = GnoCanvas.group self#canvas#root in - let u0 = LL.utm_of LL.WGS84 (self#get_center ()) in - let u0 = { LL.utm_x = align u0.LL.utm_x 1000; - LL.utm_zone = u0.LL.utm_zone; - LL.utm_y = align u0.LL.utm_y 1000 } in - for i = -size_utm_grid to size_utm_grid do - let h = Array.make (2*(2*size_utm_grid+1)) 0. - and v = Array.make (2*(2*size_utm_grid+1)) 0. in - for j = -size_utm_grid to size_utm_grid do - let k = 2*(j+size_utm_grid) in - let p = fun i j -> - let u = LL.utm_add u0 (float (i*1000), float (j*1000)) in - let wgs84 = LL.of_utm LL.WGS84 u in - self#world_of wgs84 in - let (xw,yw) = p i j in - h.(k) <- xw; h.(k+1) <- yw; - let (xw,yw) = p j i in - v.(k) <- xw; v.(k+1) <- yw - done; - let h = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:h g - and v = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:v g in - h#show (); v#show () - done; - utm_grid_group <- Some g - | Some g -> if flag then g#show () else g#hide () - - (** ground altitude extraction from srtm data *) - method altitude = fun wgs84 -> - try - Srtm.of_wgs84 wgs84 - with - Srtm.Tile_not_found x -> - srtm#set_active false; - (*GToolbox.message_box "SRTM" (sprintf "SRTM tile %s not found: %s ?" x (Srtm.error x));*) - let msg = (sprintf "Oups, I can't find SRTM tile %s.\nCan I try to donwload it ?\n(%s)" x (Srtm.error x)) in - match GToolbox.question_box ~title:"SRTM" ~buttons:["Download"; "Cancel"] msg with - | 1 -> - begin try - let tile_zip = x^".SRTMGL1.hgt.zip" in - let url = Srtm.srtm_url // tile_zip in - let dest = Env.paparazzi_home // "data" // "srtm" // tile_zip in - let tmp_dest = Env.paparazzi_home // "var" // tile_zip in - ignore(Http.file_of_url ~dest:tmp_dest url); - Sys.rename tmp_dest dest; - srtm#set_active true; - self#altitude wgs84 - with - | Http.Failure _ | Srtm.Tile_not_found _ -> - GToolbox.message_box ~title:"SRTM" ("Sorry, tile "^x^" couldn't be downloaded"); - 0 - end - | _ -> 0 - - method georefs = georefs - - method add_info_georef = fun name geo -> - (* add to the end so georefs has same order as waypoint list *) - georefs <- List.append georefs [(name, geo)]; - let callback = fun () -> selected_georef <- Bearing geo in - my_menu_item name ~packing:georef_menu#append ~callback (); - - (* change wp name *) - method edit_georef_name = fun oldname newname -> - (* get offset between WP list and menu list *) - let extraitems = (List.length georef_menu#children) - (List.length georefs) in - if newname <> oldname then - georefs <- List.fold_left (fun l (label, geo) -> - if label = oldname then - begin - let callback = fun () -> selected_georef <- Bearing geo in - let pos = List.length l + extraitems in - (* remove item and readd with new name *) - georef_menu#remove (List.nth georef_menu#children pos); - (*my_menu_item_insert newname ~menu:georef_menu ~pos:menupos ~callback;*) - my_menu_item newname ~packing:(georef_menu#insert ~pos) ~callback (); - if selected_georef = (Bearing geo) then optmenu#set_history pos; - List.append l [(newname, geo)] - end - else - List.append l [(label, geo)] - ) [] georefs - - (* Delete item from georefs and from menu *) - method delete_georef = fun name -> - (* get offset between WP list and menu list *) - let extraitems = (List.length georef_menu#children) - (List.length georefs) in - georefs <- List.fold_left (fun l (label, geo) -> - if label = name then - begin - let menupos = List.length l + extraitems in - (* remove item *) - georef_menu#remove (List.nth georef_menu#children menupos); - if selected_georef = (Bearing geo) then - begin - (List.nth georef_menu#children 0)#activate (); - optmenu#set_history 0; - end; - l - end - else - List.append l [(label, geo)] - ) [] georefs - - (* delete all wp, including fitted objects *) - method clear_georefs = fun () -> - (* get offset between WP list and menu list *) - let extraitems = (List.length georef_menu#children) - (List.length georefs) in - (* delete items from georefs and from menu *) - ignore (List.fold_left (fun i v -> - if i >= extraitems then georef_menu#remove v; - i + 1 - ) 0 georef_menu#children); - (List.nth georef_menu#children 0)#activate (); - optmenu#set_history 0; - georefs <- []; - (* finally delete all fitted objects *) - fitted_objects <- []; - - - (** display methods *) - method display_xy = fun s -> lbl_xy#set_text s - method display_geo = fun geo -> - lbl_geo#set_text (LL.string_of_coordinates selected_georef geo) - - - method display_alt = fun wgs84 -> - if srtm#active then - lbl_alt#set_text (sprintf " SRTM:%dm"(self#altitude wgs84)) - else if not (Srtm.available wgs84) then - lbl_alt#set_text (sprintf " SRTM: N/A") - - method display_group = fun s -> lbl_group#set_text s - - method goto = fun () -> - match GToolbox.input_string ~title:"Geo ref" ~text:"WGS84 " "Geo ref" with - Some s -> - let wgs84 = Latlong.of_string s in - if georef = None then - self#set_georef wgs84; - self#moveto wgs84 - | None -> () - -end diff --git a/sw/ground_segment/cockpit/lib/mapCanvas.mli b/sw/ground_segment/cockpit/lib/mapCanvas.mli deleted file mode 100644 index 983f999151..0000000000 --- a/sw/ground_segment/cockpit/lib/mapCanvas.mli +++ /dev/null @@ -1,135 +0,0 @@ -(* - * Geographic display - * - * Copyright (C) 2004-2008 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. - * - *) - -type projection = Mercator | UTM | LambertIIe -class type geographic = object method pos : Latlong.geographic end - -class widget : - ?height:int -> - ?srtm:bool -> - ?width:int -> - ?projection:projection -> - ?georef:Latlong.geographic -> - unit -> - object - method add_info_georef : string -> < pos : Latlong.geographic > -> unit - method edit_georef_name : string -> string -> unit - method delete_georef : string -> unit - method clear_georefs : unit -> unit - method altitude : Latlong.geographic -> int - method any_event : GdkEvent.any -> bool - method arc : - ?nb_points:int -> - ?width:int -> - ?fill_color:string -> - float * float -> float -> float -> float -> GnoCanvas.line - method background : GnoCanvas.group - method background_event : GnoCanvas.item_event -> bool - method maps : GnoCanvas.group array - method canvas : GnoCanvas.canvas - method center : Latlong.geographic -> unit - method circle : - ?group:GnoCanvas.group -> - ?width:int -> - ?fill_color:string -> - ?opacity:int -> - ?color:string -> Latlong.geographic -> Latlong.fmeter -> GnoCanvas.ellipse - method convert_positions_to_points : Latlong.geographic array -> float array - method connect_view : (unit -> unit) -> unit - method current_zoom : float - method display_alt : Latlong.geographic -> unit - method display_geo : Latlong.geographic -> unit - method display_group : string -> unit - method display_pixbuf : - ?opacity:int -> - ?level:int -> - (int * int) * Latlong.geographic -> - (int * int) * Latlong.geographic -> GdkPixbuf.pixbuf -> GnoCanvas.pixbuf - method display_xy : string -> unit - method factory : GMenu.menu_shell GMenu.factory - method file_menu : GMenu.menu - method fit_to_window : unit -> unit - method fix_bg_coords : Latlong.fmeter * Latlong.fmeter -> Latlong.fmeter * Latlong.fmeter - method frame : GPack.box - method georef : Latlong.geographic option - method georefs : (string * < pos : Latlong.geographic >) list - method get_center : unit -> Latlong.geographic - method goto : unit -> unit - method info : GPack.box - method key_press : GdkEvent.Key.t -> bool - method menubar : GMenu.menu_shell - method mouse_motion : GdkEvent.Motion.t -> bool - method move_item : - ?z:float -> - GnomeCanvas.re_p GnoCanvas.item -> Latlong.geographic -> unit - method moveto : Latlong.geographic -> unit - method of_world : Latlong.fmeter * Latlong.fmeter -> Latlong.geographic - method pack_labels : unit - method projection : string - method photoprojection : - ?group:GnoCanvas.group -> - ?width:int -> - ?fill_color:string -> - ?color:string -> - ?number:string -> Latlong.geographic -> Latlong.fmeter -> GnoCanvas.text - method polygon : - ?group:GnoCanvas.group -> - ?width:int -> - ?fill_color:string -> - ?opacity:int -> - ?color:string -> Latlong.geographic array -> GnoCanvas.polygon - method pt2D_of : Latlong.geographic -> Geometry_2d.pt_2D - method region : ((float * float) * (Latlong.fmeter * Latlong.fmeter)) option - method register_to_fit : geographic -> unit - method root : GnoCanvas.group - method segment : - ?group:GnoCanvas.group -> - ?width:int -> - ?fill_color:string -> Latlong.geographic -> Latlong.geographic -> GnoCanvas.line - method set_georef : Latlong.geographic -> unit - method set_utc_time : int -> int -> int -> unit - method set_wind_sock : float -> string -> unit - method still : GnoCanvas.group - method switch_background : bool -> unit - method switch_utc_time : bool -> unit - method switch_utm_grid : bool -> unit - method text : - ?group:GnoCanvas.group -> - ?fill_color:string -> - ?x_offset:float -> - ?y_offset:float -> Latlong.geographic -> string -> GnoCanvas.text - method toolbar : GPack.box - method top_still : float - method utc_time : GnoCanvas.text - method wind_sock : Wind_sock.item - method window_to_world : - winx:float -> winy:float -> Latlong.fmeter * Latlong.fmeter - method world_of : Latlong.geographic -> Latlong.fmeter * Latlong.fmeter - method zoom : float -> unit - method zoom_adj : GData.adjustment - method zoom_down : unit -> unit - method zoom_in_place : float -> unit - method zoom_in_center : float -> unit - method zoom_up : unit -> unit - end diff --git a/sw/ground_segment/cockpit/lib/mapFP.ml b/sw/ground_segment/cockpit/lib/mapFP.ml deleted file mode 100644 index 76cc02a6aa..0000000000 --- a/sw/ground_segment/cockpit/lib/mapFP.ml +++ /dev/null @@ -1,401 +0,0 @@ -(* - * Displaying and editing a flight plan on a MapCanvas - * - * Copyright (C) 2004-2006 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 Latlong - -let (//) = Filename.concat - -let sof = string_of_float -let sof1 = fun x -> sprintf "%.1f" x -let sof6 = fun x -> sprintf "%.6f" x -let float_attr = fun xml a -> float_of_string (ExtXml.attrib xml a) -let rec assoc_nocase at = function -[] -> raise Not_found - | (a, v)::avs -> - if String.uppercase_ascii at = String.uppercase_ascii a then v else assoc_nocase at avs - -(** Returns the WGS84 coordinates of a waypoint, either from its relative x and - y coordinates or from its lat and long *) -let geo_of_xml = fun utm_ref get_attrib -> - try - let x = get_attrib "x" - and y = get_attrib "y" in - Latlong.of_utm WGS84 (utm_add utm_ref (x, y)) - with - Not_found | Xml.No_attribute _ -> - try - let lat = get_attrib "lat" - and lon = get_attrib "lon" in - make_geo_deg lat lon - with - Not_found -> failwith (sprintf "x and y or lat and lon attributes expected in waypoint") - - -(** Connect a change in the XML editor to the graphical rep *) -let update_wp utm_ref (wp:MapWaypoints.waypoint) = function -XmlEdit.Deleted -> wp#delete () - | XmlEdit.New_child _ -> failwith "update_wp" - | XmlEdit.Modified attribs -> - try - let float_attrib = fun a -> float_of_string (assoc_nocase a attribs) in - - let wgs84 = geo_of_xml utm_ref float_attrib in - - wp#geomap#edit_georef_name wp#name (assoc_nocase "name" attribs); - wp#set wgs84; - wp#set_name (assoc_nocase "name" attribs) - with - _ -> () - -let iter_stages = fun f xml_tree -> - let xml_blocks = XmlEdit.child (XmlEdit.root xml_tree) "blocks" in - let rec loop = fun n -> - f n; - List.iter loop (XmlEdit.children n) in - loop xml_blocks - -let try_replace_attrib = fun node tag prev_v v -> - try - if XmlEdit.attrib node tag = prev_v then - XmlEdit.set_attrib node (tag, v) - with - Not_found -> () - -(** Update all the references to waypoint names (attribute "wp") *) -(** FIXME This function is disabled for now since it is making - * a huge mess when reordering the waypoints *) -(*let update_wp_refs previous_name xml_tree = function -XmlEdit.Deleted -> () (** FIXME *) - | XmlEdit.New_child _ -> () - | XmlEdit.Modified attribs -> - try - let new_name = assoc_nocase "name" attribs in - let update = fun node -> - try_replace_attrib node "wp" !previous_name new_name; - try_replace_attrib node "from" !previous_name new_name in - iter_stages update xml_tree; - previous_name := new_name - with - Not_found -> () -*) - -let waypoints_node = fun xml_tree -> - let xml_root = XmlEdit.root xml_tree in - XmlEdit.child xml_root "waypoints" - -let is_relative_waypoint = fun node -> - try - ignore (XmlEdit.attrib node "x"); - ignore (XmlEdit.attrib node "y"); - true - with - Not_found -> false - - -let absolute_coords = fun wp -> - let wgs84 = wp#pos in - [ "lat", sof6 ((Rad>>Deg) wgs84.posn_lat); - "lon", sof6 ((Rad>>Deg) wgs84.posn_long) ] - - -(** Connect a change from the graphical rep to the xml tree *) -let update_xml = fun xml_tree utm0 wp id -> - let xml_wpts = XmlEdit.children (waypoints_node xml_tree) in - let node = List.find (fun w -> XmlEdit.id w = id) xml_wpts in - let default_alt = float_of_string (XmlEdit.attrib (XmlEdit.root xml_tree) "alt") in - if wp#deleted then begin - XmlEdit.delete node - end else - let coords = - if is_relative_waypoint node then - let utm = utm_of WGS84 wp#pos in - try - let (dx, dy) = utm_sub utm utm0 in - ["x",sof1 dx; "y",sof1 dy] - with - _ -> - prerr_endline "MapFP.update_xml: waypoint too far from ref; using absolute geodetic coordinates"; - absolute_coords wp - else (* Absolute waypoint: use lat and lon attributes *) - absolute_coords wp in - - let alt_attrib = - if abs_float (wp#alt -. default_alt) < 1. then [] else ["alt", sof1 wp#alt] in - XmlEdit.set_attribs node (("name",wp#name) :: alt_attrib @ coords) - - - - -let new_wp = fun ?(editable = false) (geomap:MapCanvas.widget) xml_tree waypoints utm_ref ?(alt = 0.) node -> - let float_attrib = fun a -> float_of_string (XmlEdit.attrib node a) in - - let wgs84 = geo_of_xml utm_ref float_attrib in - - let alt = try float_attrib "alt" with _ -> alt in - let name = XmlEdit.attrib node "name" in - let show = editable || name.[0] <> '_' in - let wp = MapWaypoints.waypoint ~show waypoints ~name ~alt wgs84 in - geomap#register_to_fit (wp:>MapCanvas.geographic); - XmlEdit.connect node (update_wp utm_ref wp); - (*XmlEdit.connect node (update_wp_refs (ref name) xml_tree);*) (* FIXME broken functionality *) - let id = XmlEdit.id node in - if editable then - wp#connect (fun () -> update_xml xml_tree utm_ref wp id); - wp - -let gensym = - let x = ref 0 in - fun p -> incr x; Printf.sprintf "%s%d" p !x - -let rec new_gensym = fun p l -> - let s = gensym p in - if List.mem s l then new_gensym p l else s - -let georef_of_xml = fun xml -> - let lat0 = Latlong.deg_of_string (ExtXml.attrib xml "lat0") - and lon0 = Latlong.deg_of_string (ExtXml.attrib xml "lon0") in - { posn_lat = (Deg>>Rad)lat0; posn_long = (Deg>>Rad)lon0 } - - -let display_lines = fun ?group color (geomap:MapCanvas.widget) points -> - let n = Array.length points in - let l = ref [] in - for i = 0 to n - 1 do - l := !l @ [(geomap#segment ?group ~width:3 ~fill_color:color points.(i) points.((i+1)mod n))] - done; - !l - -let space_regexp = Str.regexp " " -let comma_regexp = Str.regexp "," -let wgs84_of_kml_point = fun s -> - match Str.split comma_regexp s with - [long; lat; altitude] -> - let lat = float_of_string lat - and long = float_of_string long in - {posn_lat = (Deg>>Rad) lat; posn_long = (Deg>>Rad) long} - | _ -> failwith (Printf.sprintf "wgs84_of_kml_point: %s" s) - - -(** It should be somewhere else ! *) -let display_kml = fun ?group color geomap xml -> - try - let document = ExtXml.child xml "Document" in - let rec loop = fun child -> - let tag = String.lowercase_ascii (Xml.tag child) in - match tag with - | "linestring" | "linearring" -> - let coordinates = ExtXml.child child "coordinates" in - begin - match Xml.children coordinates with - [Xml.PCData text] -> - let points = Str.split space_regexp text in - let points = List.map wgs84_of_kml_point points in - (* remove a point if polygon (first in this case) since first and last are the same *) - let points = if tag = "linearring" && List.length points > 0 then List.tl points else points in - ignore(display_lines ?group color geomap (Array.of_list points)) - | _ -> failwith "coordinates expected" - end - | "folder" | "placemark" | "polygon" | "outerboundaryis" -> - List.iter loop (Xml.children child) - | _ -> () in - List.iter loop (Xml.children document) - with Xml.Not_element xml -> failwith (Xml.to_string xml) - - - - -class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dtd xml -> - (** Xml Editor *) - let xml_tree_view, xml_window = XmlEdit.create ?format_attribs ?editable (Dtd.parse_file fp_dtd) xml in - let xml_root = XmlEdit.root xml_tree_view in - let xml_wpts = XmlEdit.child xml_root "waypoints" in - - (** Geographic ref *) - let alt = float_attr xml "alt" in - let ref_wgs84 = georef_of_xml xml in - let utm0 = utm_of WGS84 ref_wgs84 in - - (** The graphical waypoints *) - let wpts_group = new MapWaypoints.group ~show_moved ~color ?editable geomap in - - let array_of_waypoints = ref (Array.make 13 None) in - let add_wp_to_array = fun index w -> - let n = Array.length !array_of_waypoints in - if index >= n then begin - let new_array = Array.make (n*2) None in - Array.blit !array_of_waypoints 0 new_array 0 n; - array_of_waypoints := new_array - end; - !array_of_waypoints.(index) <- Some w in - - let yaws = Hashtbl.create 5 in (* Yes Another Waypoints Store *) - let create_wp = - let i = ref 1 in - fun node -> - let w = new_wp ?editable geomap xml_tree_view wpts_group utm0 ~alt node in - Hashtbl.add yaws (XmlEdit.attrib node "name") (!i, w); - add_wp_to_array !i w; - incr i; - w in - - (* The sectors *) - (* Parse and store sectors *) - let sectors = - let waypoints = ExtXml.child xml "waypoints" in - try - List.fold_left (fun l x -> - match String.lowercase_ascii (Xml.tag x) with - "kml" -> - let file = ExtXml.attrib x "file" in - display_kml ~group:wpts_group#group color geomap (ExtXml.parse_file (Env.flight_plans_path // file)); - l - | "sector" -> - let wgs84 = fun wp_name -> - let wp_name = Xml.attrib wp_name "name" in - let select = fun wp -> Xml.attrib wp "name" = wp_name in - let wp = ExtXml.child waypoints ~select "waypoint" in - let float_attr = fun xml a -> float_of_string (Xml.attrib xml a) in - geo_of_xml utm0 (float_attr wp) in - let points = List.map wgs84 (Xml.children x) in - let points = Array.of_list points in - let color_sector = ExtXml.attrib_or_default x "color" color in - let segments = display_lines ~group:wpts_group#group color_sector geomap points in - let wp_names = List.map (fun wp -> Xml.attrib wp "name") (Xml.children x) in - [(wp_names, segments, color_sector)] @ l - | _ -> failwith "Unknown sectors child") - [] (Xml.children (ExtXml.child xml "sectors")) - with Not_found -> [] in - - (* The waypoints *) - let _ = List.iter - (fun wp -> - let w = create_wp wp in - let name = XmlEdit.attrib wp "name" in - if name = "HOME" then begin - let c = ref (GnoCanvas.ellipse geomap#canvas#root) in - let update = fun _ -> - try - let max_dist_from_home = float_of_string (XmlEdit.attrib xml_root "MAX_DIST_FROM_HOME") in - !c#destroy (); - c := geomap#circle ~group:wpts_group#group ~width:5 ~color w#pos max_dist_from_home - with _ -> () in - update (); - w#connect update; - XmlEdit.connect wp update; - XmlEdit.connect xml_root update - end) - (XmlEdit.children xml_wpts) in - - (** Expands the blocks *) - let _ = - XmlEdit.expand_node xml_tree_view xml_root; - let blocks = XmlEdit.child xml_root "blocks" in - XmlEdit.expand_node xml_tree_view blocks in - -object - method georef = ref_wgs84 - method window = xml_window - method destroy () = - wpts_group#group#destroy (); - xml_window#destroy () - method show () = wpts_group#group#show () - method hide () = wpts_group#group#hide () - method index wp = Hashtbl.find yaws (XmlEdit.attrib wp "name") - method get_wp = fun i -> - if i >= Array.length !array_of_waypoints then - raise Not_found; - match !array_of_waypoints.(i) with - None -> raise Not_found - | Some w -> w - method waypoints = XmlEdit.children (waypoints_node xml_tree_view) - method xml = XmlEdit.xml_of_view xml_tree_view - method highlight_stage = fun block_no stage_no -> - let block_no = string_of_int block_no in - let stage_no = string_of_int stage_no in - let blocks = XmlEdit.child xml_root "blocks" in - List.iter - (fun b -> - if XmlEdit.attrib b "no" = block_no then begin - XmlEdit.set_background ~all:true b "#00c000"; - let rec f = fun s -> - try - if XmlEdit.attrib s "no" = stage_no then - XmlEdit.set_background s "#00ff00" - else - List.iter f (XmlEdit.children s) - with - Not_found -> () in - List.iter f (XmlEdit.children b) - end else - XmlEdit.set_background ~all:true b "white") - (XmlEdit.children blocks) - - method add_waypoint (geo:geographic) = - let wpt_names = List.map (fun n -> XmlEdit.attrib n "name") (XmlEdit.children xml_wpts) in - let name = new_gensym "wp" wpt_names in - let utm = utm_of WGS84 geo in - let (dx, dy) = utm_sub utm utm0 in - let node = XmlEdit.add_child xml_wpts "waypoint" ["x",sof dx;"y",sof dy;"name",name] in - create_wp node - - method insert_path = fun path -> - let xml_block = - try XmlEdit.parent (XmlEdit.selection xml_tree_view) "block" with - _ -> - let xml_blocks = XmlEdit.child xml_root "blocks" in - XmlEdit.child xml_blocks "block" in - let path_node = XmlEdit.add_child xml_block "path" ["radius", "42."] in - List.iter - (fun ((wp:MapWaypoints.waypoint), r) -> - let _n = XmlEdit.add_child path_node "path_point" ["wp", wp#name; "radius", sof r] in - () - ) - path - - method connect_activated = fun cb -> XmlEdit.connect_activated xml_tree_view cb - - method update_sectors = fun wp_name -> - List.iter (fun (wps_name, segments, color) -> - let wp_in_sector = List.exists (fun name -> name = wp_name) wps_name in - if wp_in_sector then begin - (* Build WP array *) - let points = List.map (fun n -> let (_, w) = Hashtbl.find yaws n in w#pos) wps_name in - let points = Array.of_list points in - let segments = Array.of_list segments in - let n = Array.length points in - (* Update segments *) - for i = 0 to n - 1 do - let (x1, y1) = geomap#world_of points.(i) - and (x2, y2) = geomap#world_of (points.((i+1)mod n)) in - segments.(i)#set [`POINTS [|x1; y1; x2; y2 |]] - done - end - ) sectors - - initializer ( - (** Create a graphic waypoint when it is created from the xml editor *) - XmlEdit.connect xml_wpts (function XmlEdit.New_child node -> ignore (create_wp node) | _ -> ()) - ) -end diff --git a/sw/ground_segment/cockpit/lib/mapFP.mli b/sw/ground_segment/cockpit/lib/mapFP.mli deleted file mode 100644 index af87d22820..0000000000 --- a/sw/ground_segment/cockpit/lib/mapFP.mli +++ /dev/null @@ -1,56 +0,0 @@ -(* - * Displaying and editing a flight plan on a MapCanvas - * - * Copyright (C) 2004-2006 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. - * - *) - -(** [flight_plan geomap color dtd_tile xml] *) -class flight_plan : - ?format_attribs:((string * string) list -> string) -> - ?editable:bool -> - show_moved:bool -> - MapCanvas.widget -> - string -> - string -> - Xml.xml -> - object - method add_waypoint : Latlong.geographic -> MapWaypoints.waypoint - method destroy : unit -> unit - method georef : Latlong.geographic - method hide : unit -> unit - method index : XmlEdit.node -> int * MapWaypoints.waypoint - method get_wp : int -> MapWaypoints.waypoint (** May raise Not_found *) - method show : unit -> unit - method window : GObj.widget - method waypoints : XmlEdit.node list - method xml : Xml.xml - method insert_path : (MapWaypoints.waypoint * float) list -> unit - method highlight_stage : int -> int -> unit - method connect_activated : (XmlEdit.node->unit) -> unit - method update_sectors : string -> unit - end - -(** Extracts [lat0] and [Lon0] attributes *) -val georef_of_xml : Xml.xml -> Latlong.geographic - -(** Display a polygon based on a kml file *) -val display_kml : ?group:GnoCanvas.group -> string -> MapCanvas.widget -> Xml.xml -> unit - diff --git a/sw/ground_segment/cockpit/lib/mapGoogle.ml b/sw/ground_segment/cockpit/lib/mapGoogle.ml deleted file mode 100644 index 408dc6664a..0000000000 --- a/sw/ground_segment/cockpit/lib/mapGoogle.ml +++ /dev/null @@ -1,219 +0,0 @@ -(* - * Displaying Google Maps on a MapCanvas object - * - * Copyright (C) 2004-2006 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. - * - *) - -let array_forall = fun f a -> - Array.fold_right (fun x r -> f x && r) a true - -open Printf - - -module LL = Latlong - -(** Quadtreee of displayed tiles *) -type tiles_tree = - Empty - | Tile - | Node of tiles_tree array -let gm_tiles = Node (Array.make 4 Empty) - -(** Google Maps paths in the quadtree are coded with q,r,s and t*) -let index_of = function -'q' -> 0 | 'r' -> 1 | 's' -> 2 | 't' -> 3 - | _ -> invalid_arg "index_of" -let char_of = function -0 -> 'q' | 1 -> 'r' | 2 -> 's' | 3 -> 't' - | _ -> invalid_arg "char_of" - -(** Checking that a tile is already displayed *) -let mem_tile = fun tile_key -> - let rec loop = fun i tree -> - tree = Tile || - i < String.length tile_key && - match tree with - Empty -> false - | Tile -> true - | Node sons -> loop (i+1) sons.(index_of tile_key.[i]) in - loop 0 gm_tiles - -(** Adding a tile to the store *) -let add_tile = fun tile_key -> - let rec loop = fun i tree j -> - if i < String.length tile_key then - match tree.(j) with - Empty -> - let sons = Array.make 4 Empty in - tree.(j) <- Node sons; - loop (i+1) sons (index_of tile_key.[i]) - | Tile -> () (* Already there *) - | Node sons -> - loop (i+1) sons (index_of tile_key.[i]) - else - tree.(j) <- Tile in - loop 0 [|gm_tiles|] 0 - - -let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level -> - let south_lat = tile.Gm.sw_corner.LL.posn_lat - and west_long = tile.Gm.sw_corner.LL.posn_long in - let north_lat = south_lat +. tile.Gm.height - and east_long = west_long +. tile.Gm.width in - let ne = LL.make_geo north_lat east_long in - - let (tx, ty) = Gm.tile_size in - try - let pixbuf = GdkPixbuf.from_file jpg_file in - ignore (GMain.Idle.add (fun () -> - let map = geomap#display_pixbuf ((0,tx), tile.Gm.sw_corner) ((ty,0),ne) pixbuf ~level in - map#raise 1; - false)); - add_tile tile.Gm.key - with - GdkPixbuf.GdkPixbufError(_, msg) -> - match GToolbox.question_box ~title:"Corrupted file" ~buttons:["Erase"; "Cancel"] (sprintf "%s. Erase ?" msg) with - 1 -> - Sys.remove jpg_file - | _ -> () - - - -(** Displaying the tile around the given point *) -let display_tile = fun (geomap:MapCanvas.widget) wgs84 level -> - let desired_tile = Gm.tile_of_geo ~level wgs84 1 in - - let key = desired_tile.Gm.key in - if not (mem_tile key) then - let (tile, jpg_file) = Gm.get_image key in - display_the_tile geomap tile jpg_file (String.length tile.Gm.key) - - -exception New_displayed of int -(** [New_displayed zoom] Raised when a new is loadded *) - -let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> - (** First estimate the coverage of the window *) - let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window - and (xc0, yc0) = geomap#canvas#get_scroll_offsets in - let (xw0, yw0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c)) - and (xw1, yw1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in - let sw = geomap#of_world (xw0, yw0) - and ne = geomap#of_world (xw1, yw1) in - let west = sw.LL.posn_long /. LL.pi - and east = ne.LL.posn_long /. LL.pi - and north = LL.mercator_lat ne.LL.posn_lat /. LL.pi - and south = LL.mercator_lat sw.LL.posn_lat /. LL.pi in - - let east = if east < west then east +. 2. else east in - - (** Get Hashtbl from cache *) - let tbl = Gm.get_hashtbl_of_cache () in - - (** Go through the quadtree and look for the holes *) - let rec loop = fun twest tsouth tsize trees i zoom key -> - (* Check for intersection *) - if not (twest > east || (twest+.tsize < west && (east < 1. (* Standard case *) || twest+.2.>east (* Over 180� *))) || tsouth > north || tsouth+.tsize < south) then - let tsize2 = tsize /. 2. in - try - match trees.(i) with - Tile -> () - | Empty -> - if zoom = 1 then - let tile, image = Gm.get_image ~tbl key in - let level = String.length tile.Gm.key in - display_the_tile geomap tile image level; - raise (New_displayed (zoomlevel+1-String.length tile.Gm.key)) - else begin - trees.(i) <- Node (Array.make 4 Empty); - loop twest tsouth tsize trees i zoom key - end - | Node sons -> - let continue = fun j tw ts -> - loop tw ts tsize2 sons j (zoom-1) (key^String.make 1 (char_of j)) in - - continue 0 twest (tsouth+.tsize2); - continue 1 (twest+.tsize2) (tsouth+.tsize2); - continue 2 (twest+.tsize2) tsouth; - continue 3 twest tsouth; - - (* If the current node is complete, replace it by a Tile *) - if array_forall (fun x -> x = Tile) sons then begin - trees.(i) <- Tile - end - with - New_displayed z when z = zoom -> - trees.(i) <- Tile - | Gm.Not_available -> () in - loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t" - - -exception To_copy of int * string - -let gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf = - let dest_x, width, src_x = - if dest_x < 0 then 0, width+dest_x, src_x-dest_x else dest_x, width, src_x in - let dest_y, height, src_y = - if dest_y < 0 then 0, height+dest_y, src_y-dest_y else dest_y, height, src_y in - let width = min width (GdkPixbuf.get_width dest - dest_x) - and height = min height (GdkPixbuf.get_height dest -dest_y) in - GdkPixbuf.copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf - -let pixbuf = fun sw ne zoomlevel-> - assert (sw.LL.posn_lat < ne.LL.posn_lat); - assert (sw.LL.posn_long < ne.LL.posn_long); - let west = sw.LL.posn_long /. LL.pi - and east = ne.LL.posn_long /. LL.pi - and north = LL.mercator_lat ne.LL.posn_lat /. LL.pi - and south = LL.mercator_lat sw.LL.posn_lat /. LL.pi in - - let pixel_size = 1. /. (2. ** 16.) /. 256. in - let width = truncate ((east -. west) /. pixel_size) - and height = truncate ((north -. south) /. pixel_size) in - let dest = GdkPixbuf.create ~width ~height () in - let rec loop = fun twest tsouth tsize zoom key -> - if not (twest > east || twest+.tsize < west || tsouth > north || tsouth+.tsize < south) then - let tsize2 = tsize /. 2. in - try - if zoom = 1 - then - let tile, image = Gm.get_image key in - raise (To_copy (zoomlevel+1-String.length tile.Gm.key, image)) - else begin - let continue = fun j tw ts -> - loop tw ts tsize2 (zoom-1) (key^String.make 1 (char_of j)) in - continue 0 twest (tsouth+.tsize2); - continue 1 (twest+.tsize2) (tsouth+.tsize2); - continue 2 (twest+.tsize2) tsouth; - continue 3 twest tsouth; - end - with - To_copy (z, image) when z = zoom -> - let dest_x = truncate ((twest -. west) /. pixel_size) - and dest_y = truncate ((north -. (tsouth+.tsize)) /. pixel_size) in - let width = truncate (tsize /. pixel_size) in - let src_x = 0 - and src_y = 0 in - let pixbuf = GdkPixbuf.from_file image in - gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height:width ~src_x ~src_y pixbuf - | Gm.Not_available -> () in - loop (-1.) (-1.) 2. zoomlevel "t"; - dest diff --git a/sw/ground_segment/cockpit/lib/mapGoogle.mli b/sw/ground_segment/cockpit/lib/mapGoogle.mli deleted file mode 100644 index 8bb42f0dc9..0000000000 --- a/sw/ground_segment/cockpit/lib/mapGoogle.mli +++ /dev/null @@ -1,32 +0,0 @@ -(* - * Displaying Google Maps on a MapCanvas object - * - * Copyright (C) 2004-2006 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. - * - *) - -val display_tile : MapCanvas.widget -> Latlong.geographic -> int -> unit -(** Displaying the Google Maps tile around the given point (zoom=1) up to max level *) - -val fill_window : MapCanvas.widget -> int -> unit -(** Filling the canvas window with Google Maps tiles at given zoomlevel*) - -val pixbuf : Latlong.geographic -> Latlong.geographic -> int -> GdkPixbuf.pixbuf -(** [pixbuf south_west north_east zoomlevel] Returns a map background of the given area *) diff --git a/sw/ground_segment/cockpit/lib/mapIGN.ml b/sw/ground_segment/cockpit/lib/mapIGN.ml deleted file mode 100644 index 7f0a478982..0000000000 --- a/sw/ground_segment/cockpit/lib/mapIGN.ml +++ /dev/null @@ -1,46 +0,0 @@ -(* - * Displaying IGN Maps on a MapCanvas object - * - * Copyright (C) 2004-2006 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. - * - *) - -module LL = Latlong - -let displayed_tiles = Hashtbl.create 41 -let mem_tile = fun t -> Hashtbl.mem displayed_tiles t.IGN.key -let add_tile = fun t -> Hashtbl.add displayed_tiles t.IGN.key () - - -let opacity = 100 (* FIXME *) - -(** Displaying the tile around the given point *) -let display_tile = fun (geomap:MapCanvas.widget) wgs84 -> - let tile = IGN.tile_of_geo wgs84 in - - if not (mem_tile tile) then - let jpg_file = IGN.get_tile tile in - - let (sx,sy) = IGN.tile_size in - let pixbuf = GdkPixbuf.from_file jpg_file in - - let map = geomap#display_pixbuf ~opacity ((0,sx), tile.IGN.sw_corner) ((sy,0),tile.IGN.ne_corner) pixbuf in - map#raise 1; - add_tile tile diff --git a/sw/ground_segment/cockpit/lib/mapIGN.mli b/sw/ground_segment/cockpit/lib/mapIGN.mli deleted file mode 100644 index 6cd617a9a8..0000000000 --- a/sw/ground_segment/cockpit/lib/mapIGN.mli +++ /dev/null @@ -1,25 +0,0 @@ -(* - * Displaying IGN Maps on a MapCanvas object - * - * Copyright (C) 2004-2006 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. - * - *) - -val display_tile : MapCanvas.widget -> Latlong.geographic -> unit diff --git a/sw/ground_segment/cockpit/lib/mapTrack.ml b/sw/ground_segment/cockpit/lib/mapTrack.ml deleted file mode 100644 index 0587016197..0000000000 --- a/sw/ground_segment/cockpit/lib/mapTrack.ml +++ /dev/null @@ -1,337 +0,0 @@ -(* - * Track objects - * - * Copyright (C) 2004 CENA/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 G2d = Geometry_2d -module LL = Latlong - -module G = MapCanvas - -module CL = ContrastLabel -module ACI = AcIcon - -let affine_pos_and_angle z xw yw angle = - let rad_angle = angle /. 180. *. acos(-1.) in - let cos_a = cos rad_angle in - let sin_a = sin rad_angle in - [| cos_a /. z ; sin_a /. z ; ~-. sin_a /. z; cos_a /. z; xw ; yw |] - -let rec norm_angle_360 = fun alpha -> - if alpha > 360.0 then norm_angle_360 (alpha -. 360.0) - else if alpha < 0.0 then norm_angle_360 (alpha +. 360.0) - else alpha - - -(** variables used for handling cam moves: *) - -let cam_half_aperture = LL.pi /. 6.0 -let half_pi = LL.pi /. 2.0 - -type desired = - NoDesired - | DesiredCircle of LL.geographic*float*GnoCanvas.ellipse - | DesiredSegment of LL.geographic*LL.geographic*GnoCanvas.line - -class track = fun ?(name="Noname") ?(icon="fixedwing") ?(size = 500) ?(color="red") ?(show_carrot=true) (ac_id:string) (geomap:MapCanvas.widget) -> - let group = GnoCanvas.group geomap#canvas#root in - let empty = ({LL.posn_lat=0.; LL.posn_long=0.}, GnoCanvas.line group) in - let v_empty = ({LL.posn_lat=0.; LL.posn_long=0.}, 0.0) in - - let aircraft = GnoCanvas.group group - and track = GnoCanvas.group group in - let icon_template = match icon with - | "home" -> ACI.icon_home_template - | "rotorcraft" -> ACI.icon_rotorcraft_template - | "quadrotor" -> ACI.icon_quadrotor_template - | "hexarotor" -> ACI.icon_hexarotor_template - | "octorotor" -> ACI.icon_octorotor_template - | "quadrotor_x" -> ACI.icon_quadrotor_x_template - | "hexarotor_x" -> ACI.icon_hexarotor_x_template - | "octorotor_x" -> ACI.icon_octorotor_x_template - | "quadrotor_xi" -> ACI.icon_quadrotor_xi_template - | "flyingwing" -> ACI.icon_flyingwing_template - | "intruder" -> ACI.icon_intruder_template - | "fixedwing" | _ -> ACI.icon_fixedwing_template - in - let _ac_icon = new ACI.widget ~color ~icon_template aircraft in - let ac_label = new CL.widget ~name ~color 25. 25. group in - - let carrot = GnoCanvas.group group in - let _ac_carrot = - if show_carrot then - ignore (GnoCanvas.polygon ~points:[|0.;0.;-5.;-10.;5.;-10.|] ~props:[`WIDTH_UNITS 1.;`FILL_COLOR "orange"; `OUTLINE_COLOR "orange"; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] carrot) - else () - in - - let cam = GnoCanvas.group group in - - (** rectangle representing the field covered by the cam *) - let _ac_cam_targeted = - ignore ( GnoCanvas.ellipse ~x1: (-. 2.5) ~y1: (-. 2.5 ) ~x2: 2.5 ~y2: 2.5 ~fill_color:color ~props:[`WIDTH_UNITS 1.; `OUTLINE_COLOR color; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam) in - let _ = cam#hide () in - - let mission_target = GnoCanvas.group group in - - (** red circle : target of the mission *) - let _ac_mission_target = - ignore ( GnoCanvas.ellipse ~x1: (-5.) ~y1: (-5.) ~x2: 5. ~y2: 5. ~fill_color:"red" ~props:[`WIDTH_UNITS 1.; `OUTLINE_COLOR "red"; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] mission_target) in - let _ = mission_target#hide () in - - let _desired_circle = GnoCanvas.ellipse group - and _desired_segment = GnoCanvas.line group in - - let _ = aircraft#raise_to_top () in - -object (self) - val mutable top = 0 - val mutable color = color - val mutable segments = Array.make size empty - val mutable v_segments = Array.make size empty - val mutable v_top = 0 - val mutable v_path = Array.make 10 v_empty - val mutable last = None - val mutable last_heading = 0.0 - val mutable last_altitude = 0.0 - val mutable last_speed = 0.0 - val mutable last_climb = 0.0 - val mutable last_flight_time = 0.0 - val mutable last_x_val = 0.0 - val mutable cam_on = false - val mutable params_on = false - val mutable v_params_on = false - val mutable desired_track = NoDesired - val zone = GnoCanvas.rect group - val mutable ac_cam_cover = GnoCanvas.polygon ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam - val mutable event_cb = None - val mutable destroyed = false - method color = color - method set_color c = color <- c - method track = track - method v_path = v_path - method aircraft = aircraft - method id = ac_id - method name = name - method set_label = fun s -> - ac_label#set_name s - method clear_one = fun i -> - if segments.(i) != empty then begin - (snd segments.(i))#destroy (); - segments.(i) <- empty - end - method incr = fun seg -> - let s = Array.length seg in - top <- (top + 1) mod s - method v_incr = fun path -> - let s = Array.length path in - v_top <- (v_top + 1) mod s - method clear = fun () -> - for i = 0 to Array.length segments - 1 do - self#clear_one i - done; - top <- 0 - method set_cam_state = fun b -> - cam_on <- b; - if b then begin - cam#show (); - mission_target#show () - end else begin - cam#hide (); - mission_target#hide () - end - - method update_ap_status = fun time -> - last_flight_time <- time - method set_params_state = fun b -> - params_on <- b; - if not b then (* Reset to the default simple label *) - ac_label#set_name name; - ac_label#set_y 25. - method set_v_params_state = fun b -> v_params_on <- b - method set_last = fun x -> last <- x - method last = last - method pos = match last with Some pos -> pos | None -> failwith "No pos" - method last_heading = last_heading - method last_altitude = last_altitude - method last_speed = last_speed - method last_climb = last_climb - - method height = fun () -> - match last with - None -> last_altitude - | Some wgs84 -> - let h = try float (Srtm.of_wgs84 wgs84) with _ -> 0. in - last_altitude -. h - - (** add track points on map2D, according to the - track parameter and store altitude for the vertical path *) - method add_point = fun geo alt -> - self#clear_one top; - let last_geo = - match last with - None -> geo - | Some last_geo -> last_geo in - segments.(top) <- (geo, geomap#segment ~group ~fill_color:color last_geo geo); - self#incr segments; - self#set_last (Some geo); - v_path.(v_top) <- (geo, alt); - self#v_incr v_path - - method clear_map2D = self#clear () - - method move_icon = fun wgs84 heading altitude speed climb -> - let (xw,yw) = geomap#world_of wgs84 in - aircraft#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw heading); - last_heading <- heading; - last_altitude <- altitude; - last_speed <- speed ; - last_climb <- climb; - - if params_on then begin - let last_height = self#height () in - ac_label#set_name (sprintf "%s\n%+.0f m\n%.1f m/s" name last_height last_speed); - ac_label#set_y 70. - end; - - ac_label#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.); - self#add_point wgs84 altitude; - - method move_carrot = fun wgs84 -> - let (xw,yw) = geomap#world_of wgs84 in - carrot#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.); - - (** draws the circular path to be followed by the aircraft in circle mode *) - method draw_circle = fun en radius -> - let create = fun () -> - desired_track <- DesiredCircle (en, radius, geomap#circle ~color:"#00ff00" en radius) in - match desired_track with - DesiredCircle (c, r, circle) -> - if c <> en || r <> radius then begin - circle#destroy (); - create () - end - | DesiredSegment (p1,p2,s) -> - s#destroy (); - create () - | NoDesired -> - create () - - (** draws the linear path to be followed by the aircraft between two waypoints *) - method draw_segment = fun en1 en2 -> - let create = fun () -> - desired_track <- DesiredSegment (en1, en2, geomap#segment ~fill_color:"#00ff00" en1 en2) in - match desired_track with - DesiredCircle (c, r, circle) -> - circle#destroy (); - create () - | DesiredSegment (p1,p2,s) -> - if p1 <> en1 || p2 <> en2 then begin - s#destroy (); - create () - end - | NoDesired -> - create () - - method delete_desired_track = fun () -> - begin - match desired_track with - DesiredCircle (c, r, circle) -> - circle#destroy () - | DesiredSegment (p1,p2,s) -> - s#destroy (); - | NoDesired -> - () - end; - desired_track <- NoDesired - - method draw_zone = fun geo1 geo2 -> - let (x1, y1) = geomap#world_of geo1 - and (x2, y2) = geomap#world_of geo2 in - zone#set [`X1 x1; `Y1 y1; `X2 x2; `Y2 y2; `OUTLINE_COLOR "#ffc0c0"; `WIDTH_PIXELS 2] - - (** moves the rectangle representing the field covered by the camera *) - method move_cam = fun positions mission_target_wgs84 -> - match last, cam_on with - Some last_ac, true -> - let points = geomap#convert_positions_to_points positions in - ac_cam_cover#set [`POINTS points; - `OUTLINE_COLOR color]; - let (mission_target_xw, mission_target_yw) = geomap#world_of mission_target_wgs84 in - mission_target#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value mission_target_xw mission_target_yw 0.0) - | _ -> () - method zoom = fun z -> - let a = aircraft#i2w_affine in - let z' = sqrt (a.(0)*.a.(0)+.a.(1)*.a.(1)) in - for i = 0 to 3 do a.(i) <- a.(i) /. z' *. 1./.z done; - aircraft#affine_absolute a - - method resize = fun new_size -> - let a = Array.make new_size empty in - let size = Array.length segments in - let m = min new_size size in - let j = ref ((top - m + size) mod size) in - for i = 0 to m - 1 do - a.(i) <- segments.(!j); - j := (!j + 1) mod size - done; - for i = 1 to size - new_size do (* Never done if new_size > size *) - self#clear_one !j; - j := (!j + 1) mod size - done; - top <- m mod new_size; - segments <- a - - method size = Array.length segments - - method event (ev : GnoCanvas.item_event) = - begin - match ev with - | `BUTTON_PRESS ev -> - begin - match GdkEvent.Button.button ev with - | 1 -> - begin - match event_cb with - | Some cb -> cb ac_id - | None -> () - end - | _ -> () - end - | _ -> () - end; - true - initializer ignore(aircraft#connect#event ~callback:self#event) - - method set_event_cb = fun (cb: string -> unit) -> event_cb <- Some cb - - initializer - (* could not properly disconnect adjustment signal, so only calling zoom method if group is still displayed *) - ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () -> if not destroyed then self#zoom geomap#zoom_adj#value)); - ignore(group#connect#destroy ~callback:(fun () -> destroyed <- true)) - - (* destroy method *) - method destroy = fun () -> group#destroy () - - initializer - Gc.finalise (fun self -> self#destroy ()) self -end diff --git a/sw/ground_segment/cockpit/lib/mapTrack.mli b/sw/ground_segment/cockpit/lib/mapTrack.mli deleted file mode 100644 index d6e28d8d41..0000000000 --- a/sw/ground_segment/cockpit/lib/mapTrack.mli +++ /dev/null @@ -1,74 +0,0 @@ -(* - * Track objects - * - * Copyright (C) 2004-2010 CENA/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. - * - *) - -class track : - ?name:string -> - ?icon:string -> - ?size:int -> - ?color:string -> - ?show_carrot:bool -> - string -> - MapCanvas.widget -> - object - method add_point : Latlong.geographic -> float -> unit - method aircraft : GnoCanvas.group - method id : string - method name : string - method clear : unit -> unit - method clear_map2D : unit - method clear_one : int -> unit - method color : string - method delete_desired_track : unit -> unit - method draw_circle : Latlong.geographic -> Latlong.fmeter -> unit - method draw_segment : Latlong.geographic -> Latlong.geographic -> unit - method draw_zone : Latlong.geographic -> Latlong.geographic -> unit - method height : unit -> float - method incr : (Latlong.geographic * GnoCanvas.line) array -> unit - method last : Latlong.geographic option - method last_altitude : float - method last_climb : float - method last_heading : float - method last_speed : float - method move_cam : Latlong.geographic array -> Latlong.geographic -> unit - method move_carrot : Latlong.geographic -> unit - method move_icon : - Latlong.geographic -> float -> float -> float -> float -> unit - method pos : Latlong.geographic - method resize : int -> unit - method set_cam_state : bool -> unit - method set_color : string -> unit - method set_label : string -> unit - method set_last : Latlong.geographic option -> unit - method set_params_state : bool -> unit - method set_v_params_state : bool -> unit - method size : int - method track : GnoCanvas.group - method update_ap_status : float -> unit - method v_incr : (Latlong.geographic * float) array -> unit - method v_path : (Latlong.geographic * float) array - method zoom : float -> unit - method event : GnoCanvas.item_event -> bool - method set_event_cb : (string -> unit) -> unit - method destroy : unit -> unit - end diff --git a/sw/ground_segment/cockpit/lib/mapWaypoints.ml b/sw/ground_segment/cockpit/lib/mapWaypoints.ml deleted file mode 100644 index 4a3cff1213..0000000000 --- a/sw/ground_segment/cockpit/lib/mapWaypoints.ml +++ /dev/null @@ -1,309 +0,0 @@ -(* - * Waypoints objects - * - * Copyright (C) 2004 CENA/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. - * - *) - -module LL = Latlong -open Printf -open LL - -module CL = ContrastLabel - -(* - * Waypoint label offsets - *) -let s = 6. (* x offset *) - -class group = fun ?(color="red") ?(editable=true) ?(show_moved=false) (geomap:MapCanvas.widget) -> - let g = GnoCanvas.group geomap#canvas#root in -object - method group=g - method geomap=geomap - method color=color - method editable=editable - method show_moved = show_moved -end - -let rotation_45 = - let s = sin (Latlong.pi/.4.) in - [|s;s;-.s;s;0.;0.|] - -class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) wgs84 -> - let geomap=wpts_group#geomap - and color = wpts_group#color - and editable = wpts_group#editable in - let xw, yw = geomap#world_of wgs84 in - let callbacks = Hashtbl.create 5 in - let updated () = - Hashtbl.iter (fun cb _ -> cb ()) callbacks in - - let wpt_group = GnoCanvas.group wpts_group#group in - - let item = - GnoCanvas.rect wpt_group ~x1:(-.s) ~y1:(-.s) ~x2:s ~y2:s ~props:[`FILL_COLOR color; `OUTLINE_COLOR "black"] in - - let anim = function - None -> - Some (Glib.Timeout.add ~ms:500 ~callback:(fun () -> Gdk.X.beep (); item#affine_relative rotation_45; true)) - | Some x -> Some x in - - -object (self) - val mutable x0 = 0. - val mutable y0 = 0. - - val label = new CL.widget ~name:name ~color:"white" s 0. wpt_group - val mutable name = name (* FIXME: already in label ! *) - val mutable alt = alt - val mutable ground_alt = 0. - val mutable moved = None - val mutable deleted = false - val mutable commit_cb = None - initializer - if not show then wpt_group#hide () - initializer - item#affine_absolute rotation_45; - self#move xw yw - method connect = fun (cb:unit -> unit) -> - Hashtbl.add callbacks cb () - method set_commit_callback = fun (cb:unit -> unit) -> commit_cb <- Some cb - method name = name - method set_name n = - if n <> name then begin - name <- n; - label#set_name name - end - method geomap = geomap - method alt = alt - method label = label - method xy = let a = wpt_group#i2w_affine in (a.(4), a.(5)) - method move dx dy = - wpt_group#move ~x:dx ~y:dy; - wpt_group#raise_to_top () - method edit = - let dialog = GWindow.window ~type_hint:`DIALOG ~modal:true ~position:`MOUSE ~border_width:10 ~title:"Waypoint Edit" () in - let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in - - let ename = GEdit.entry ~text:name ~editable ~packing:dvbx#add () in - let hbox = GPack.hbox ~packing:dvbx#add () in - - let optmenu = GMenu.option_menu ~packing:hbox#add () in - let e_pos = GEdit.entry ~width_chars:25 ~packing:hbox#add () in - - (* We would like to share the menu of the map: it does not work ! *) - let selected_georef = ref WGS84_dec in - let display_coordinates = fun () -> - e_pos#set_text (string_of_coordinates !selected_georef self#pos) - and set_coordinates = fun () -> - self#set (geographic_of_coordinates !selected_georef e_pos#text) in - - display_coordinates (); - - let initial_wgs84 = self#pos in - - let menu = GMenu.menu () in - let set = fun kind () -> - set_coordinates (); - selected_georef := kind; - display_coordinates () in - let mi = GMenu.menu_item ~label:"WGS84" ~packing:menu#append () in - ignore (mi#connect#activate ~callback:(set WGS84_dec)); - let mi = GMenu.menu_item ~label:"WGS84_dms" ~packing:menu#append () in - ignore (mi#connect#activate ~callback:(set WGS84_dms)); - let mi = GMenu.menu_item ~label:"LambertIIe" ~packing:menu#append () in - ignore (mi#connect#activate ~callback:(set LBT2e)); - List.iter (fun (label, geo) -> - let mi = GMenu.menu_item ~label ~packing:menu#append () in - ignore (mi#connect#activate ~callback:(set (Bearing geo)))) - geomap#georefs; - optmenu#set_menu menu; - - let ha = GPack.hbox ~packing:dvbx#add () in - let minus10= GButton.button ~label:"-10" ~packing:ha#add () in - (* let ea = GEdit.entry ~text:(string_of_float alt) ~packing:ha#add () in *) - let ea = GEdit.spin_button ~rate:0. ~digits:2 ~width:50 ~packing:ha#add () - and adj = GData.adjustment - ~value:alt ~lower:(-100.) ~upper:10000. - ~step_incr:1. ~page_incr:10.0 ~page_size:0. () in - ea#set_adjustment adj; - ea#set_value alt; (* this should be done by set_adjustment but seems to fail on ubuntu 13.10 (at least) *) - - let agl = alt -. (try float (Srtm.of_wgs84 initial_wgs84) with _ -> ground_alt) in - let agl_lab = GMisc.label ~text:(sprintf " AGL: %4.0fm" agl) ~packing:ha#add () in - let plus10= GButton.button ~label:"+10" ~packing:ha#add () in - let change_alt = fun x -> - ea#set_value (ea#value +. x) in - ignore(minus10#connect#pressed ~callback:(fun _ -> change_alt (-10.))); - ignore(plus10#connect#pressed ~callback:(fun _ -> change_alt (10.))); - - (* called when ok button is clicked in WP Edit dialog *) - let callback = fun _ -> - geomap#edit_georef_name name ename#text; - self#set_name ename#text; - alt <- ea#value; - label#set_name name; - set_coordinates (); - updated (); - if wpts_group#show_moved then - moved <- anim moved; - begin - match commit_cb with - Some cb -> cb () - | None -> () - end; - dialog#destroy () - in - let dhbx = GPack.box `HORIZONTAL ~packing: dvbx#add () in - - let cancel = GButton.button ~stock:`CANCEL ~packing: dhbx#add () in - let destroy = fun () -> - self#set initial_wgs84; - self#reset_moved (); - wpt_group#lower_to_bottom (); - dialog#destroy () in - ignore(cancel#connect#clicked ~callback:destroy); - - (** Delete button for editable waypoints *) - if editable then begin - let delete = GButton.button ~stock:`DELETE ~packing: dhbx#add () in - let delete_callback = fun () -> - dialog#destroy (); - self#delete (); - geomap#delete_georef name; - updated () - in - ignore(delete#connect#clicked ~callback:delete_callback) - end; - - let ok = GButton.button ~stock:`OK ~packing: dhbx#add () in - List.iter - (fun e -> ignore (e#connect#activate ~callback)) - [ename; e_pos]; - ok#grab_default (); - - ignore(ok#connect#clicked ~callback:(fun _ -> callback (); dialog#destroy ())); - - (* Update AGL on pos or alt change *) - let callback = fun _ -> - try - set_coordinates (); - let wgs84 = self#pos in - let agl = ea#value -. (try float (Srtm.of_wgs84 wgs84) with _ -> ground_alt) in - agl_lab#set_text (sprintf " AGL: %4.0fm" agl) - with _ -> () - in - ignore (ea#connect#changed ~callback); - ignore (e_pos#connect#changed ~callback); - dialog#show () - - val mutable motion = false - method event (ev : GnoCanvas.item_event) = - begin - match ev with - | `BUTTON_PRESS ev -> - begin - match GdkEvent.Button.button ev with - | 1 -> - motion <- false; - let x = GdkEvent.Button.x ev - and y = GdkEvent.Button.y ev in - x0 <- x; y0 <- y; - let curs = Gdk.Cursor.create `FLEUR in - item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs - (GdkEvent.Button.time ev) - | _ -> () - end - | `MOTION_NOTIFY ev -> - let state = GdkEvent.Motion.state ev in - if Gdk.Convert.test_modifier `BUTTON1 state then begin - motion <- true; - let x = GdkEvent.Motion.x ev - and y = GdkEvent.Motion.y ev in - let dx = geomap#current_zoom *. (x-. x0) - and dy = geomap#current_zoom *. (y -. y0) in - self#move dx dy ; - updated (); - if wpts_group#show_moved then - moved <- anim moved; - x0 <- x; y0 <- y - end - | `BUTTON_RELEASE ev -> - if GdkEvent.Button.button ev = 1 then begin - item#ungrab (GdkEvent.Button.time ev); - self#edit - end - | _ -> () - end; - true - initializer ignore(item#connect#event ~callback:self#event) - method moved = moved <> None - method reset_moved () = - match moved with - | None -> () - | Some x -> - Glib.Timeout.remove x; - item#affine_absolute rotation_45; - moved <- None - - method deleted = deleted - method item = item - method pos = geomap#of_world self#xy - method set ?altitude ?(update=false) wgs84 = - let (xw, yw) = geomap#world_of wgs84 - and (xw0, yw0) = self#xy - and z = geomap#zoom_adj#value in - - let dx = (xw-.xw0)*.z - and dy = (yw-.yw0)*.z - and dz = match altitude with Some a -> a -. alt | _ -> 0. in - - let current_ecef = ecef_of_geo WGS84 self#pos self#alt - and new_ecef = ecef_of_geo WGS84 wgs84 (alt+.dz) in - - let new_pos = ecef_distance current_ecef new_ecef > 2. in - match moved, new_pos with - | None, _ -> - self#move dx dy; - alt <- alt+.dz; - if update then updated () - | Some _, true -> () - | Some _, false -> self#reset_moved () - method set_ground_alt ga = ground_alt <- ga - method delete () = - deleted <- true; (* BOF *) - geomap#delete_georef name; - wpt_group#destroy () - method zoom (z:float) = - if List.length wpt_group#get_items > 0 then - let a = wpt_group#i2w_affine in - a.(0) <- 1./.z; a.(3) <- 1./.z; - wpt_group#affine_absolute a - initializer wpt_group#raise_to_top () - initializer self#zoom geomap#zoom_adj#value - initializer ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () -> self#zoom geomap#zoom_adj#value)) -end - -let gensym = let n = ref 0 in fun prefix -> incr n; prefix ^ string_of_int !n - -let waypoint = fun ?show group ?(name = gensym "wp") ?alt en -> - new waypoint ?show group name ?alt en - diff --git a/sw/ground_segment/cockpit/lib/mapWaypoints.mli b/sw/ground_segment/cockpit/lib/mapWaypoints.mli deleted file mode 100644 index 0e10bab1bd..0000000000 --- a/sw/ground_segment/cockpit/lib/mapWaypoints.mli +++ /dev/null @@ -1,68 +0,0 @@ -(* - * Waypoints objects - * - * Copyright (C) 2004 CENA/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. - * - *) - -class group : - ?color:string -> - ?editable:bool -> - ?show_moved:bool -> - MapCanvas.widget -> - object - method color : string - method editable : bool - method show_moved : bool - method geomap : MapCanvas.widget - method group : GnoCanvas.group - end - -class waypoint : - ?show:bool -> - group -> - string -> - ?alt:float -> - Latlong.geographic -> - object - method alt : float - method geomap : MapCanvas.widget - method delete : unit -> unit - method edit : unit - method pos : Latlong.geographic - method event : GnoCanvas.item_event -> bool - method item : GnoCanvas.rect - method label : ContrastLabel.widget - method move : float -> float -> unit - method name : string - method set : ?altitude:float -> ?update:bool -> Latlong.geographic -> unit - method set_ground_alt : float -> unit - method set_name : string -> unit - method xy : float * float - method zoom : float -> unit - method moved : bool - method reset_moved : unit -> unit - method deleted : bool - method connect : (unit -> unit) -> unit - method set_commit_callback : (unit -> unit) -> unit - end - - -val waypoint : ?show:bool -> group -> ?name:string -> ?alt:float -> Latlong.geographic -> waypoint diff --git a/sw/ground_segment/cockpit/lib/ml_gtk_drag.c b/sw/ground_segment/cockpit/lib/ml_gtk_drag.c deleted file mode 100644 index 30369d2c9a..0000000000 --- a/sw/ground_segment/cockpit/lib/ml_gtk_drag.c +++ /dev/null @@ -1,32 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include - -extern value Val_GtkTreePath(GtkTreePath*); - -#define Pointer_val(val) ((void*)Field(val,1)) - -#ifdef G_DISABLE_CAST_CHECKS -#define check_cast(f,v) f(Pointer_val(v)) -#else -#define check_cast(f,v) (Pointer_val(v) == NULL ? NULL : f(Pointer_val(v))) -#endif - -#define GtkTreeView_val(val) check_cast(GTK_TREE_VIEW,val) - -CAMLprim value -ml_gtk_tree_view_get_drag_dest_row(value val_tree) { - CAMLparam0(); - CAMLlocal1(ret); - GtkTreePath *path; - GtkTreeViewDropPosition pos; - gtk_tree_view_get_drag_dest_row(GtkTreeView_val(val_tree), &path, &pos); - ret = alloc_tuple(2); - Store_field(ret,0,Val_GtkTreePath(path)); - Store_field(ret,1,Val_int(pos)); - CAMLreturn(ret); -} diff --git a/sw/ground_segment/cockpit/lib/papget.ml b/sw/ground_segment/cockpit/lib/papget.ml deleted file mode 100644 index daa00d387d..0000000000 --- a/sw/ground_segment/cockpit/lib/papget.ml +++ /dev/null @@ -1,423 +0,0 @@ -(* - * Paparazzi widgets - * - * Copyright (C) 2008 ENAC - * - * 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 PC = Papget_common -module PR = Papget_renderer -module E = Expr_syntax -let (//) = Filename.concat - -class type item = object - method config : unit -> Xml.xml - method deleted : bool -end - -class type value = -object - method last_value : string - method connect : (string -> unit) -> unit - method config : unit -> Xml.xml list - method type_ : string -end - - - -(** [index_of_fields s] Returns i if s matches x[i] else 0. *) -let base_and_index = - let field_regexp = Str.regexp "\\([^\\.]+\\)\\[\\([0-9]+\\)\\]" in - fun field_descr -> - if Str.string_match field_regexp field_descr 0 then - ( Str.matched_group 1 field_descr, - int_of_string (Str.matched_group 2 field_descr)) - else - (field_descr, 0) - - -class message_field = fun ?sender ?(class_name="telemetry") msg_name field_descr -> -object - val mutable callbacks = [] - val mutable last_value = "0." - - method last_value = last_value - - method connect = fun cb -> callbacks <- cb :: callbacks - method config = fun () -> - let field = sprintf "%s:%s" msg_name field_descr in - let ac_id = match sender with None -> [] | Some id -> [PC.property "ac_id" id] in - [ PC.property "field" field ] @ ac_id - method type_ = "message_field" - - initializer - let module P = PprzLink.Messages (struct let name = class_name end) in - let process_message = fun _sender values -> - let (field_name, index) = base_and_index field_descr in - let value = - match PprzLink.assoc field_name values with - PprzLink.Array array -> array.(index) - | scalar -> scalar in - - last_value <- PprzLink.string_of_value value; - - List.iter (fun cb -> cb last_value) callbacks in - ignore (P.message_bind ?sender msg_name process_message) -end - - -let hash_vars = fun ?sender expr -> - let htable = Hashtbl.create 3 in - let rec loop = function - E.Ident i -> prerr_endline i - | E.Int _ | E.Float _ -> () - | E.Call (_id, list) | E.CallOperator (_id, list) -> List.iter loop list - | E.Index (_id, e) -> loop e - | E.Deref (_e, _f) as deref -> fprintf stderr "Warning: Deref operator is not allowed in Papgets expressions (%s)" (E.sprint deref) - | E.Field (i, f) -> - if not (Hashtbl.mem htable (i,f)) then - let msg_obj = new message_field ?sender i f in - Hashtbl.add htable (i, f) msg_obj in - loop expr; - htable - - -let wrap = fun f -> - fun x y -> string_of_float (f (float_of_string x) (float_of_string y)) -let eval_bin_op = function - | "*" -> wrap ( *. ) - | "+" -> wrap ( +. ) - | "-" -> wrap ( -. ) - | "/" -> wrap ( /. ) - | "**" -> wrap ( ** ) - | op -> failwith (sprintf "Papget.eval_expr '%s'" op) - -let eval_expr = fun (extra_functions:(string * (string list -> string)) list) h e -> - let rec loop = function - E.Ident ident -> failwith (sprintf "Papget.eval_expr '%s'" ident) - | E.Int int -> string_of_int int - | E.Float float -> string_of_float float - | E.CallOperator (ident, [e1; e2]) -> - eval_bin_op ident (loop e1) (loop e2) - | E.Call (ident, args) when List.mem_assoc ident extra_functions -> - (List.assoc ident extra_functions) (List.map loop args) - | E.Call (ident, _l) | E.CallOperator (ident, _l) -> - failwith (sprintf "Papget.eval_expr '%s(...)'" ident) - | E.Index (ident, _e) -> failwith (sprintf "Papget.eval_expr '%s[...]'" ident) - | E.Deref (_e, _f) as deref -> failwith (sprintf "Papget.eval_expr Deref operator is not allowed in Papgets expressions (%s)" (E.sprint deref)) - | E.Field (i, f) -> - try - (Hashtbl.find h (i,f))#last_value - with - Not_found -> failwith (sprintf "Papget.eval_expr '%s.%s'" i f) - in loop e - - - -class expression = fun ?(extra_functions=[]) ?sender expr -> - let h = hash_vars ?sender expr in -object - val mutable callbacks = [] - val mutable last_value = "0." - - method last_value = last_value - - method connect = fun cb -> callbacks <- cb :: callbacks - - method config = fun () -> - let ac_id = match sender with None -> [] | Some id -> [PC.property "ac_id" id] in - [ PC.property "expr" (Expr_syntax.sprint expr)] @ ac_id - - method type_ = "expression" - - initializer - Hashtbl.iter - (fun (i,f) (msg_obj:value) -> - let val_updated = fun _new_val -> - last_value <- eval_expr extra_functions h expr; - List.iter (fun cb -> cb last_value) callbacks - in - msg_obj#connect val_updated) - h -end - - - - -class type canvas_item_type = -object - method connect : unit -> unit - method deleted : bool - method edit : unit -> unit - method event : GnoCanvas.item_event -> bool - method renderer : Papget_renderer.t - method update : string -> unit - method xy : float * float -end - - -class canvas_item = fun ~config canvas_renderer -> - let canvas_renderer = (canvas_renderer :> PR.t) in -object (self) - val mutable motion = false - val mutable renderer = canvas_renderer - val mutable x_press = 0. - val mutable y_press = 0. - val mutable deleted = false - val mutable dialog_widget = None - - method renderer = renderer - - method xy = - let (x0, y0) = renderer#item#i2w ~x:0. ~y:0. in - renderer#item#parent#w2i ~x:x0 ~y:y0 - - method deleted = deleted - - method update = fun value -> - try - (renderer#update:string->unit) value - with - exc -> prerr_endline (Printexc.to_string exc) - - method event = fun (ev : GnoCanvas.item_event) -> - let item = (renderer#item :> PR.movable_item) in - match ev with - `BUTTON_PRESS ev -> - begin - match GdkEvent.Button.button ev with - | 1 -> - motion <- false; - let x = GdkEvent.Button.x ev and y = GdkEvent.Button.y ev in - let (xm, ym) = renderer#item#parent#w2i ~x ~y in - let (x0, y0) = renderer#item#i2w ~x:0. ~y:0. in - let (xi, yi) = renderer#item#parent#w2i ~x:x0 ~y:y0 in - x_press <- xm -. xi; y_press <- ym -. yi; - let curs = Gdk.Cursor.create `FLEUR in - item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs - (GdkEvent.Button.time ev) - | _ -> () - end; - true - | `MOTION_NOTIFY ev -> - let state = GdkEvent.Motion.state ev in - if Gdk.Convert.test_modifier `BUTTON1 state then begin - motion <- true; - let x = GdkEvent.Motion.x ev - and y = GdkEvent.Motion.y ev in - let (xw, yw) = renderer#item#parent#w2i ~x ~y in - item#set [`X (xw-.x_press); `Y (yw-.y_press)]; - renderer#item#parent#affine_relative [|1.;0.;0.;1.;0.;0.|] - end; - true - | `BUTTON_RELEASE ev -> - if GdkEvent.Button.button ev = 1 then begin - item#ungrab (GdkEvent.Button.time ev); - (* get item and window size *) - let bounds = item#get_bounds in - let w, h = Gdk.Drawable.get_size item#canvas#misc#window in - if not motion then begin - self#edit () - end - else if (truncate bounds.(0) > w) || (truncate bounds.(2) < 0) || (truncate bounds.(1) > h) || (truncate bounds.(3) < 0) then begin - (* delete an item if placed out of the window on the left or top side *) - item#destroy (); - deleted <- true - end; - motion <- false - end; - true - | _ -> false - - method edit = fun () -> - let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in - let dialog = new Gtk_papget_editor.papget_editor ~file () in - - let ac_id = PC.get_prop "ac_id" config "Any" in - dialog#toplevel#set_title ("Papget Editor (A/C: "^ac_id^")"); - - let tagged_renderers = Lazy.force PR.lazy_tagged_renderers in - let strings = List.map fst tagged_renderers in - - let (combo, (tree, column)) = GEdit.combo_box_text ~packing:dialog#box_item_chooser#add ~strings () in - tree#foreach - (fun _path row -> - if tree#get ~row ~column = renderer#tag then begin - combo#set_active_iter (Some row); - true - end else - false); - - let connect_item_editor = fun () -> - begin (* Remove the current child ? *) - try - let child = dialog#box_item_editor#child in - dialog#box_item_editor#remove child - with - Gpointer.Null -> () - end; - renderer#edit dialog#box_item_editor#add in - - connect_item_editor (); - - (* Connect the renderer chooser *) - ignore (combo#connect#changed - ~callback:(fun () -> - match combo#active_iter with - | None -> () - | Some row -> - let data = combo#model#get ~row ~column in - if data <> renderer#tag then - let new_renderer = List.assoc data tagged_renderers in - let group = renderer#item#parent in - let (x, y) = renderer#item#i2w ~x:0. ~y:0. in - let (x, y) = group#w2i ~x ~y in - renderer#item#destroy (); - renderer <- new_renderer group x y; - self#connect (); - connect_item_editor ())); - - (* Connect the buttons *) - ignore (dialog#button_delete#connect#clicked - ~callback:(fun () -> - dialog#papget_editor#destroy (); - renderer#item#destroy (); - deleted <- true)); - ignore (dialog#button_ok#connect#clicked ~callback:(fun () -> dialog#papget_editor#destroy ())); - - dialog_widget <- Some dialog - - val mutable connection = - canvas_renderer#item#connect#event ~callback:(fun _ -> false) - method connect = fun () -> - if PC.get_prop "locked" config "false" = "false" then - let item = (renderer#item :> PR.movable_item) in - connection <- item#connect#event ~callback:self#event - - initializer - self#connect () -end - -class canvas_float_item = fun ~config canvas_renderer -> -object - inherit canvas_item ~config canvas_renderer as super - - val mutable affine = "1" - - method update = fun value -> - let scaled_value = - try - let (a, b) = Ocaml_tools.affine_transform affine - and fvalue = float_of_string value in - string_of_float (fvalue *. a +. b) - with - _ -> value in - super#update scaled_value - - method edit = fun () -> - super#edit (); - match dialog_widget with - None -> () - | Some dialog -> - (* Set the current value *) - dialog#entry_scale#set_text affine; - (* Connect the scale entry *) - let callback = fun () -> - affine <- dialog#entry_scale#text in - ignore (dialog#entry_scale#connect#activate ~callback); - dialog#hbox_scale#misc#show () -end - - -class canvas_display_float_item = fun ~config (msg_obj:value) (canvas_renderer:PR.t) -> -object (self) - inherit canvas_float_item ~config canvas_renderer as item - - initializer - affine <- PC.get_prop "scale" config "1"; - msg_obj#connect self#update_field - - method update_field = fun value -> - if not deleted then begin - item#update value - end - - method config = fun () -> - let renderer_props = renderer#config () - and val_props = msg_obj#config () - and scale_prop = PC.property "scale" affine in - let (x, y) = item#xy in - let attrs = - [ "type", msg_obj#type_; - "display", String.lowercase_ascii item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, scale_prop::val_props@renderer_props) -end - - -(****************************************************************************) -(** A clickable item is not editable: The #edit method is overiden with a - provided callback *) -class canvas_clickable_item = fun type_ properties callback canvas_renderer -> -object - inherit canvas_item ~config:properties canvas_renderer as item - method edit = fun () -> callback () - - method config = fun () -> - let props = renderer#config () in - let (x, y) = item#xy in - let attrs = - [ "type", type_; - "display", String.lowercase_ascii item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, properties@props) -end - - -class canvas_goto_block_item = fun properties callback (canvas_renderer:PR.t) -> -object - inherit canvas_clickable_item "goto_block" properties callback canvas_renderer as item -end - -class canvas_variable_setting_item = fun properties callback (canvas_renderer:PR.t) -> -object - inherit canvas_clickable_item "variable_setting" properties callback canvas_renderer -end - - - -(****************************************************************************) -class canvas_video_plugin_item = fun properties (canvas_renderer:PR.t) (adj:GData.adjustment) -> -object (self) - inherit canvas_item ~config:properties canvas_renderer as item - method update_zoom = fun zoom -> - item#update zoom - method config = fun () -> - let props = renderer#config () in - let (x, y) = item#xy in - let attrs = - [ "type", "video_plugin"; - "display", String.lowercase_ascii item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, properties@props) - initializer ignore(adj#connect#value_changed ~callback:(fun () -> self#update_zoom (string_of_float adj#value))) -end diff --git a/sw/ground_segment/cockpit/lib/papget.mli b/sw/ground_segment/cockpit/lib/papget.mli deleted file mode 100644 index 7ea1192c67..0000000000 --- a/sw/ground_segment/cockpit/lib/papget.mli +++ /dev/null @@ -1,123 +0,0 @@ -(* - * Paparazzi widgets - * - * Copyright (C) 2008 ENAC - * - * 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. - * - *) - -class type item = - object - method config : unit -> Xml.xml - method deleted : bool - end - -class type value = - object - method last_value : string - method connect : (string -> unit) -> unit - method config : unit -> Xml.xml list - method type_ : string - end - -class message_field : - ?sender:string -> - ?class_name:string -> - string -> - string -> - value - -class expression : - ?extra_functions:(string * (string list -> string)) list -> - ?sender:string -> - Expr_syntax.expression -> - value - -class type canvas_item_type = - object - method connect : unit -> unit - method deleted : bool - method edit : unit -> unit - method event : GnoCanvas.item_event -> bool - method renderer : Papget_renderer.t - method update : string -> unit - method xy : float * float - end - -class canvas_display_float_item : - config:Xml.xml list -> - value -> - Papget_renderer.t -> - object - inherit canvas_item_type - - method config : unit -> Xml.xml - method connect : unit -> unit - method update_field : string -> unit - end - -class canvas_goto_block_item : - Xml.xml list -> - (unit -> unit) -> - Papget_renderer.t -> - object - method config : unit -> Xml.xml - method connect : unit -> unit - method deleted : bool - method edit : unit -> unit - method event : GnoCanvas.item_event -> bool - method renderer : Papget_renderer.t - method update : string -> unit - method xy : float * float - end - -class canvas_variable_setting_item : - Xml.xml list -> - (unit -> unit) -> - Papget_renderer.t -> - object - method config : unit -> Xml.xml - method connect : unit -> unit - method deleted : bool - method edit : unit -> unit - method event : GnoCanvas.item_event -> bool - method renderer : Papget_renderer.t - method update : string -> unit - method xy : float * float - end - -class canvas_video_plugin_item : - Xml.xml list -> - Papget_renderer.t -> - GData.adjustment -> - object - inherit canvas_item_type - method config : unit -> Xml.xml - method update_zoom : string -> unit -(* - - method connect : unit -> unit - method deleted : bool - method edit : unit -> unit - method event : GnoCanvas.item_event -> bool - method renderer : Papget_renderer.t - method xy : float * float -*) - end - diff --git a/sw/ground_segment/cockpit/lib/papget_common.ml b/sw/ground_segment/cockpit/lib/papget_common.ml deleted file mode 100644 index 720afd32a7..0000000000 --- a/sw/ground_segment/cockpit/lib/papget_common.ml +++ /dev/null @@ -1,49 +0,0 @@ -(* - * Commons for papgets - * - * Copyright (C) 2008 ENAC - * - * 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. - * - *) - -let get_property = fun attr_name xml -> - let attr = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = attr_name) xml "property" in - ExtXml.attrib attr "value" - - -let get_prop = fun name children default -> - let xml = Xml.Element ("", [], children) in - try get_property name xml with _ -> default - -let property = fun name value -> - Xml.Element("property", [ "name", name; "value", value ], []) - -let xml = fun type_ display_ properties -> - Xml.Element ("papget", ["type", type_; "display", display_], - List.map (fun (x, y) -> property x y) properties) - -let float_property = fun name value -> - property name (string_of_float value) - -let dnd_source = fun (widget:GObj.widget) papget_xml -> - let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0} ] in - widget#drag#source_set dnd_targets ~modi:[`BUTTON1] ~actions:[`COPY]; - let data_get = fun _ (sel:GObj.selection_context) ~info ~time -> - sel#return (Xml.to_string papget_xml) in - ignore (widget#drag#connect#data_get ~callback:data_get); diff --git a/sw/ground_segment/cockpit/lib/papget_common.mli b/sw/ground_segment/cockpit/lib/papget_common.mli deleted file mode 100644 index d88913e6b9..0000000000 --- a/sw/ground_segment/cockpit/lib/papget_common.mli +++ /dev/null @@ -1,34 +0,0 @@ -(* - * Commons for papgets - * - * Copyright (C) 2008 ENAC - * - * 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. - * - *) - -val get_property : string -> Xml.xml -> string -(** [get_property name config] *) - -val get_prop : string -> Xml.xml list -> string -> string -(** [get_prop name config_list default_value] *) - -val property : string -> string -> Xml.xml -val xml : string -> string -> (string * string) list -> Xml.xml -val float_property : string -> float -> Xml.xml -val dnd_source : GObj.widget -> Xml.xml -> unit diff --git a/sw/ground_segment/cockpit/lib/papget_renderer.ml b/sw/ground_segment/cockpit/lib/papget_renderer.ml deleted file mode 100644 index d2d59bf0f0..0000000000 --- a/sw/ground_segment/cockpit/lib/papget_renderer.ml +++ /dev/null @@ -1,392 +0,0 @@ -(* - * Paparazzi widget renderers - * - * Copyright (C) 2008-2009 ENAC, Pascal Brisset - * - * 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 PC = Papget_common -let (//) = Filename.concat - -class type movable_item = -object - inherit GnoCanvas.base_item - method set : GnomeCanvas.group_p list -> unit -end - -class type t = -object - method tag : string - method edit : (GObj.widget -> unit) -> unit - method item : movable_item - method update : string -> unit - method config : unit -> Xml.xml list -end - - -(*************************** Text ***********************************) -class canvas_text = fun ?(config=[]) canvas_group x y -> - let group = GnoCanvas.group ~x ~y canvas_group in - let text = GnoCanvas.text ~text:"_" group in -object (self) - val mutable format = PC.get_prop "format" config "%.2f" - val mutable size = float_of_string (PC.get_prop "size" config "15.") - val mutable color = PC.get_prop "color" config "#00ff00" - - method tag = "Text" - method item = (group :> movable_item) - method config = fun () -> - [ PC.property "format" format; - PC.float_property "size" size; - PC.property "color" color ] - method update = fun (value : string) -> - let renderer = fun x -> - try sprintf (Scanf.format_from_string format "%f") (float_of_string x) with _ -> x in - text#set [`SIZE_POINTS size; `TEXT (renderer value); `FILL_COLOR color; `ANCHOR `NW] - - - method edit = fun (pack:GObj.widget -> unit) -> - let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in - let text_editor = new Gtk_papget_text_editor.table_text_editor ~file () in - pack text_editor#table_text_editor#coerce; - - (* Initialize the entries *) - text_editor#entry_format#set_text format; - text_editor#spinbutton_size#set_value size; - text_editor#comboboxentry_color#set_active 0; - - (* Connect the entries *) - let callback = fun () -> - format <- text_editor#entry_format#text in - ignore (text_editor#entry_format#connect#activate ~callback); - let callback = fun () -> - size <- text_editor#spinbutton_size#value in - ignore (text_editor#spinbutton_size#connect#value_changed ~callback); - let callback = fun () -> - color <- text_editor#comboboxentry_color#entry#text in - ignore (text_editor#comboboxentry_color#connect#changed ~callback); -end - - -(***************************Vertical Ruler ***********************************) -let affine_pos_and_angle xw yw angle = - let cos_a = cos angle in - let sin_a = sin angle in - [| cos_a ; sin_a ; ~-. sin_a; cos_a; xw ; yw |] -let affine_pos xw yw = affine_pos_and_angle xw yw 0. - - -class canvas_ruler = fun ?(config=[]) canvas_group x y -> - let h = float_of_string (PC.get_prop "height" config "100.") - and index_on_right = bool_of_string (PC.get_prop "index_on_right" config "false") - and point_per_unit = float_of_string (PC.get_prop "point_per_unit" config "2.") - and w = float_of_string (PC.get_prop "width" config "32.") - and step = int_of_string (PC.get_prop "step" config "10") in - let text_props=[`ANCHOR `CENTER; `FILL_COLOR "white"] - and index_width = 10. in - - let root = GnoCanvas.group ~x ~y canvas_group in - let r = GnoCanvas.group root in - - let props = (text_props@[`ANCHOR `EAST]) in - - (* One step drawer *) - let draw = fun i value -> - let i = i * step in - let y = -. point_per_unit *. (float i -. value) in - if y >= -. h && y <= h then begin - let text = Printf.sprintf "%d" i in - ignore (GnoCanvas.text ~text ~props ~y ~x:(w*.0.75) r); - ignore (GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r) - end; - let y = y -. float step /. 2. *. point_per_unit in - if y >= -. h && y <= h then - ignore(GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r) - in - - let drawer = fun value -> - (* Remove previous items *) - List.iter (fun i -> i#destroy ()) r#get_items; - let v = truncate value / step in - let k = truncate (h /. point_per_unit) / step in - for i = max 0 (v - k) to (v + k) do - draw i value - done - in - - (** Yellow index *) - let _ = GnoCanvas.line ~points:[|0.;0.;w-.1.;0.|] ~fill_color:"yellow" root in - let s = index_width in - let idx = GnoCanvas.polygon ~points:[|0.;0.;-.s;s/.2.;-.s;-.s/.2.|] ~fill_color:"yellow" root in - let () = - if index_on_right then - idx#affine_absolute (affine_pos_and_angle w 0. Latlong.pi) in - -object - method tag = "Ruler" - method edit = fun (pack:GObj.widget -> unit) -> () - method update = fun value -> - let value = float_of_string value in - drawer value - method item = (root :> movable_item) - method config = fun () -> - [ PC.float_property "height" h; - PC.property "index_on_right" (sprintf "%b" index_on_right); - PC.float_property "width" w; - PC.float_property "point_per_unit" point_per_unit; - PC.property "step" (sprintf "%d" step) ] -end - -(*************************** Gauge ***********************************) -class canvas_gauge = fun ?(config=[]) canvas_group x y -> - let size = PC.get_prop "size" config "50." in - (*let text_props = [`ANCHOR `CENTER; `FILL_COLOR "white"] in*) - - let r1 = max 10. ((float_of_string size) /. 2.) in - let r2 = r1 +. 3. in - let r3 = 3.5 in - let max_rot = 2. *. Latlong.pi /. 3. in - - let root = GnoCanvas.group ~x ~y canvas_group in - (*let gauge = GnoCanvas.group root in*) - - (*let props = (text_props@[`ANCHOR `EAST]) in*) - - let _ = GnoCanvas.ellipse ~x1:r2 ~y1:r2 ~x2:(-.r2) ~y2:(-.r2) - ~props:[`NO_FILL_COLOR; `OUTLINE_COLOR "grey"; `WIDTH_PIXELS 6] root in - let points = [|0.;-.r1;0.;-.r1+.3.|] in - let props = [`WIDTH_PIXELS 2; `FILL_COLOR "red"] in - let _ = GnoCanvas.line ~points ~props root in - let il = GnoCanvas.line ~points ~props root in - let () = il#affine_absolute (affine_pos_and_angle 0. 0. (-. Latlong.pi /. 3.)) in - let ill = GnoCanvas.line ~points ~props root in - let () = ill#affine_absolute (affine_pos_and_angle 0. 0. (-. 2. *. Latlong.pi /. 3.)) in - let ir = GnoCanvas.line ~points ~props root in - let () = ir#affine_absolute (affine_pos_and_angle 0. 0. (Latlong.pi /. 3.)) in - let irr = GnoCanvas.line ~points ~props root in - let () = irr#affine_absolute (affine_pos_and_angle 0. 0. (2. *. Latlong.pi /. 3.)) in - - let idx = GnoCanvas.polygon ~points:[|r3-.0.2;0.;0.;-.r1;-.(r3-.0.2);0.|] - ~props:[`FILL_COLOR "red"; `OUTLINE_COLOR "white"] root in - let _ = GnoCanvas.ellipse ~x1:r3 ~y1:r3 ~x2:(-.r3) ~y2:(-.r3) ~props:[`OUTLINE_COLOR "grey"] ~fill_color:"red" root in - let text_min = GnoCanvas.text ~x:(-.r1) ~y:(r1/.2.) ~props:[`ANCHOR `NE; `FILL_COLOR "#00ff00"] root in - let text_max = GnoCanvas.text ~x:r1 ~y:(r1/.2.) ~props:[`ANCHOR `NW; `FILL_COLOR "#00ff00"] root in - let text_mid = GnoCanvas.text ~x:0. ~y:(-.r2-.3.) ~props:[`ANCHOR `SOUTH; `FILL_COLOR "#00ff00"] root in - let text_text = GnoCanvas.text ~x:0. ~y:(r2+.3.) ~props:[`ANCHOR `NORTH; `FILL_COLOR "#00ff00"] root in - -object - val mutable min = PC.get_prop "min" config "-50." - val mutable max = PC.get_prop "max" config "50." - val mutable text = PC.get_prop "text" config "" - - method tag = "Gauge" - method edit = fun (pack:GObj.widget -> unit) -> - let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in - let gauge_editor = new Gtk_papget_gauge_editor.table_gauge_editor ~file () in - pack gauge_editor#table_gauge_editor#coerce; - - (* Initialize the entries *) - gauge_editor#entry_min#set_text min; - gauge_editor#entry_max#set_text max; - gauge_editor#entry_text#set_text text; - - (* Connect the entries *) - let callback = fun () -> - min <- gauge_editor#entry_min#text in - ignore (gauge_editor#entry_min#connect#activate ~callback); - let callback = fun () -> - max <- gauge_editor#entry_max#text in - ignore (gauge_editor#entry_max#connect#activate ~callback); - let callback = fun () -> - text <- gauge_editor#entry_text#text in - ignore (gauge_editor#entry_text#connect#activate ~callback); - - method update = fun value -> - let value = float_of_string value in - (* Gauge drawer *) - let fmin = float_of_string min in - let fmax = float_of_string max in - let rot = ref (-.max_rot +. 2. *. max_rot *. (value -. fmin) /. (fmax -. fmin)) in - if !rot > max_rot then rot := max_rot; - if !rot < -.max_rot then rot := -.max_rot; - idx#affine_absolute (affine_pos_and_angle 0. 0. !rot); - text_min#set [`TEXT min]; - text_max#set [`TEXT max]; - text_mid#set [`TEXT (string_of_float ((fmin +. fmax)/.2.))]; - text_text#set [`TEXT text] - - method item = (root :> movable_item) - method config = fun () -> - [ PC.property "min" min; - PC.property "max" max; - PC.property "size" size; - PC.property "text" text ] -end - -(*************************** Led ***********************************) -class canvas_led = fun ?(config=[]) canvas_group x y -> - let size = float_of_string (PC.get_prop "size" config "15.") in - - let root = GnoCanvas.group ~x ~y canvas_group in - - let r = (max 2. (size /. 2.)) +. 1. in - let led = GnoCanvas.ellipse ~x1:r ~y1:r ~x2:(-.r) ~y2:(-.r) - ~props:[`NO_FILL_COLOR; `OUTLINE_COLOR "grey"; `WIDTH_UNITS 2.] root in - - let led_text = GnoCanvas.text ~x:(-.r-.3.) ~y:0. ~props:[`ANCHOR `EAST; `FILL_COLOR "#00ff00"] root in - -object - val mutable size = float_of_string (PC.get_prop "size" config "15.") - val mutable text = PC.get_prop "text" config "" - val mutable test_value = float_of_string (PC.get_prop "test_value" config "0.") - val mutable test_inv = bool_of_string (PC.get_prop "test_invert" config "false") - - method tag = "Led" - method edit = fun (pack:GObj.widget -> unit) -> - let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in - let led_editor = new Gtk_papget_led_editor.table_led_editor ~file () in - pack led_editor#table_led_editor#coerce; - - (* Initialize the entries *) - led_editor#entry_text#set_text text; - led_editor#spinbutton_size#set_value size; - led_editor#spinbutton_test#set_value test_value; - - (* Connect the entries *) - let callback = fun () -> - text <- led_editor#entry_text#text in - ignore (led_editor#entry_text#connect#activate ~callback); - let callback = fun () -> - size <- led_editor#spinbutton_size#value in - ignore (led_editor#spinbutton_size#connect#activate ~callback); - let callback = fun () -> - test_value <- led_editor#spinbutton_test#value in - ignore (led_editor#spinbutton_test#connect#activate ~callback); - let callback = fun () -> - test_inv <- led_editor#check_invert#active in - ignore (led_editor#check_invert#connect#toggled ~callback); - - method update = fun value -> - let value = float_of_string value in - let inv = if test_inv then not else (fun x -> x) in - (* Led drawer *) - if inv (value = test_value) then led#set [`FILL_COLOR "red"] - else led#set [`FILL_COLOR "#00ff00"]; - let r = (max 2. (size /. 2.)) +. 1. in - led#set [`X1 r; `Y1 r; `X2 (-.r); `Y2 (-.r)]; - led_text#set [`TEXT text; `SIZE_POINTS size; `X (-.r-.3.)] - - method item = (root :> movable_item) - method config = fun () -> - [ PC.float_property "size" size; - PC.property "text" text ] -end - -(****************************************************************************) -class canvas_button = fun ?(config=[]) canvas_group x y -> - let icon = PC.get_prop "icon" config "icon_file" in - let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in - let group = GnoCanvas.group ~x ~y canvas_group in - let _item = GnoCanvas.pixbuf ~pixbuf group in -object - method tag = "Button" - method item = (group :> movable_item) - method edit = fun (pack:GObj.widget -> unit) -> () - method update = fun (value:string) -> () - method config = fun () -> - [ PC.property "icon" icon] - initializer - group#raise_to_top (); -end - - -(****************************************************************************) -class canvas_mplayer = fun ?(config=[]) canvas_group x y -> - let video_feed = PC.get_prop "video_feed" config "video_URI" in - let width = float_of_string (PC.get_prop "width" config "320.") - and height = float_of_string (PC.get_prop "height" config "240.") in - let socket = GWindow.socket () in - let group = GnoCanvas.group ~x ~y canvas_group in - let item = GnoCanvas.widget ~width ~height ~widget:socket group in - -object - method tag = "Mplayer" - method item = (group :> movable_item) - method edit = fun (pack:GObj.widget -> unit) -> () - method update = fun (value:string) -> - let zoom = try float_of_string value with _ -> 1. in - item#set [`WIDTH (width /. zoom); `HEIGHT (height /. zoom)] - method config = fun () -> - [ PC.property "video_feed" video_feed; - PC.float_property "width" width; - PC.float_property "height" height ] - initializer - group#lower_to_bottom (); - let com = sprintf "exec mplayer -vo xv -really-quiet -nomouseinput %s -wid 0x%lx -geometry %.0fx%.0f" video_feed socket#xwindow width height in - let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in - ignore (Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; com|] dev_null dev_null dev_null) -end - - -(****************************************************************************) -class canvas_plugin = fun ?(config=[]) canvas_group x y -> - let command = PC.get_prop "command" config "missing_plugin_command" in - let width = float_of_string (PC.get_prop "width" config "320.") - and height = float_of_string (PC.get_prop "height" config "240.") in - let socket = GWindow.socket () in - let group = GnoCanvas.group ~x ~y canvas_group in - let item = GnoCanvas.widget ~width ~height ~widget:socket group in - -object - method tag = "Plugin" - method item = (group :> movable_item) - method edit = fun (pack:GObj.widget -> unit) -> () - method update = fun (value:string) -> - let zoom = try float_of_string value with _ -> 1. in - item#set [`WIDTH (width /. zoom); `HEIGHT (height /. zoom) ] - method config = fun () -> - [ PC.property "command" command; - PC.float_property "width" width; - PC.float_property "height" height ] - initializer - group#lower_to_bottom (); - let com = sprintf "exec %s0x%lx" command socket#xwindow in - let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in - ignore (Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; com|] dev_null dev_null dev_null) -end - - - -let renderers = - [ (new canvas_text :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t); - (new canvas_ruler :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t); - (new canvas_gauge :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t); - (new canvas_led :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t) ] - -let lazy_tagged_renderers = lazy - (let x = 0. and y = 0. - and group = (GnoCanvas.canvas ())#root in - List.map - (fun constructor -> - let o = constructor ?config:None group x y in - (o#tag, constructor)) - renderers) - diff --git a/sw/ground_segment/cockpit/lib/papget_renderer.mli b/sw/ground_segment/cockpit/lib/papget_renderer.mli deleted file mode 100644 index 068431b84c..0000000000 --- a/sw/ground_segment/cockpit/lib/papget_renderer.mli +++ /dev/null @@ -1,64 +0,0 @@ -(* - * Paparazzi widget renderers - * - * Copyright (C) 2008 ENAC - * - * 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. - * - *) - -class type movable_item = - object - inherit GnoCanvas.base_item - method set : GnomeCanvas.group_p list -> unit - end - -class type t = - object - method config : unit -> Xml.xml list - method edit : (GObj.widget -> unit) -> unit - method item : movable_item - method tag : string - method update : string -> unit - end - -class canvas_text : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_text config group x y] *) - -class canvas_ruler : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_ruler config group x y] *) - -class canvas_gauge : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_gauge config group x y] *) - -class canvas_led : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_led config group x y] *) - -class canvas_button : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_button config group x y] *) - -class canvas_mplayer : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_mplayer config group x y] *) - -class canvas_plugin : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t -(** [canvas_plugin config group x y] *) - -val lazy_tagged_renderers : - (string * (?config:Xml.xml list -> GnoCanvas.group -> float -> float -> t)) - list lazy_t -(** List of renderers available to display a telemetry field value *) diff --git a/sw/ground_segment/cockpit/lib/widgets.glade b/sw/ground_segment/cockpit/lib/widgets.glade deleted file mode 100644 index bf111e9a43..0000000000 --- a/sw/ground_segment/cockpit/lib/widgets.glade +++ /dev/null @@ -1,399 +0,0 @@ - - - - - - True - Text Papget Properties - mouse - - - True - 3 - 2 - - - True - 0 - Format - - - GTK_FILL - - - - - - True - 0 - Size - right - - - 1 - 2 - GTK_FILL - - - - - - True - 0 - Color - right - - - 2 - 3 - GTK_FILL - - - - - - True - True - ● - - - 1 - 2 - - - - - - True - True - 1 0 100 1 10 0 - 1 - - - 1 - 2 - 1 - 2 - - - - - - True - True - Colors defined in X11 rgb.txt - green -red -blue -yellow -orange -white - - - 1 - 2 - 2 - 3 - - - - - - - - True - Papget Editor (A/C: Any) - True - 300 - - - True - - - True - - - - - - False - 0 - - - - - - - True - Scale - - - False - False - 0 - - - - - True - True - "a+b" to display value x as a.x+b - ● - 1+0 - - - 1 - - - - - 1 - - - - - True - - - - - - 2 - - - - - True - True - - - gtk-delete - True - True - False - True - - - False - False - 0 - - - - - gtk-close - True - True - False - True - - - False - False - 1 - - - - - False - 3 - - - - - - - True - Gauge Papget Properties - mouse - - - True - 3 - 2 - - - True - 0 - Min - - - GTK_FILL - - - - - - True - 0 - Max - - - 1 - 2 - GTK_FILL - - - - - - True - True - ● - - - 1 - 2 - - - - - - True - True - ● - - - 1 - 2 - 1 - 2 - - - - - - True - True - ● - - - 1 - 2 - 2 - 3 - - - - - - True - 0 - Text - - - 2 - 3 - GTK_FILL - - - - - - - - True - Led Papget Properties - mouse - - - True - 4 - 2 - - - True - Text - - - GTK_FILL - - - - - True - Size - - - 1 - 2 - GTK_FILL - - - - - True - True - 15 2 100 1 10 0 - - - 1 - 2 - 1 - 2 - - - - - True - True - - - 1 - 2 - - - - - True - Test invert - - - 3 - 4 - GTK_FILL - - - - - True - True - False - True - - - 1 - 2 - 3 - 4 - - - - - True - Test value - - - 2 - 3 - GTK_FILL - - - - - True - True - 0 0 100 1 10 0 - 1 - - - 1 - 2 - 2 - 3 - - - - - - diff --git a/sw/ground_segment/cockpit/lib/wind_sock.ml b/sw/ground_segment/cockpit/lib/wind_sock.ml deleted file mode 100644 index 1c2732f1af..0000000000 --- a/sw/ground_segment/cockpit/lib/wind_sock.ml +++ /dev/null @@ -1,67 +0,0 @@ - (* - * Wind sock - * - * Copyright (C) 2007 ENAC - * - * 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. - * - *) - - let flatten = fun s a -> - let n = Array.length a in - let b = Array.make (2*n) 0. in - for i = 0 to n - 1 do - let (x, y) = a.(i) in - b.(2*i) <- float x *. s; - b.(2*i+1) <- float y *. s - done; - b - - class item = fun ?(show = false) size_unit group -> - let texture = `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") in - - let group = GnoCanvas.group group in - - (* Text *) - let t = GnoCanvas.text group ~props:[`TEXT "12.1"; `X 0.; `Y 0.; `ANCHOR `CENTER; `FILL_COLOR "black"] in - - (* Red left and right *) - let props = [`FILL_COLOR "red"; texture] in - let points = flatten size_unit [|(-6,4); (-2,3); (-2,-3); (-6,-4)|] in - let _ = GnoCanvas.polygon group ~props ~points in - let points = flatten size_unit [|(2,2); (6,1); (6,-1); (2,-2)|] in - let _ = GnoCanvas.polygon group ~props ~points in - - (* White center *) - let props = [`FILL_COLOR "white"] in - let points = flatten size_unit [|(-2,3); (2,2); (2,-2); (-2,-3)|] in - let _ = GnoCanvas.polygon group ~props ~points in - - (* contour *) - let points = flatten size_unit [|(-6,4); (6,1); (6,-1); (-6,-4)|] in - let props = [`OUTLINE_COLOR "white"; `WIDTH_PIXELS 1] in - let contour = GnoCanvas.polygon group ~props ~points in - - object - method item = group - method label = t - initializer - t#raise_to_top (); - if not show then group#hide () - method set_color = fun color -> contour#set [`OUTLINE_COLOR color] - end diff --git a/sw/ground_segment/cockpit/lib/wind_sock.mli b/sw/ground_segment/cockpit/lib/wind_sock.mli deleted file mode 100644 index 94c93b628d..0000000000 --- a/sw/ground_segment/cockpit/lib/wind_sock.mli +++ /dev/null @@ -1,33 +0,0 @@ -(* - * Wind sock - * - * Copyright (C) 2007 ENAC - * - * 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. - * - *) - -(** [item ?show size_unit group] Length of the wind sock is 6 times - [size_unit] *) -class item : ?show:bool -> float -> #GnoCanvas.group -> - object - method item : GnoCanvas.group - method label : GnoCanvas.text - method set_color : string -> unit - end - diff --git a/sw/ground_segment/cockpit/lib/xmlEdit.ml b/sw/ground_segment/cockpit/lib/xmlEdit.ml deleted file mode 100644 index 298b5ee234..0000000000 --- a/sw/ground_segment/cockpit/lib/xmlEdit.ml +++ /dev/null @@ -1,604 +0,0 @@ -(* - * XML editor - * - * Copyright (C) 2004 CENA/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. - * - *) - - -let default_background = "white" - -type gtkTreeViewDropPosition = - GTK_TREE_VIEW_DROP_BEFORE - | GTK_TREE_VIEW_DROP_AFTER - | GTK_TREE_VIEW_DROP_INTO_OR_BEFORE - | GTK_TREE_VIEW_DROP_INTO_OR_AFTER - -external gtk_tree_view_get_drag_dest_row : 'a Gtk.obj -> Gtk.tree_path * gtkTreeViewDropPosition = "ml_gtk_tree_view_get_drag_dest_row" - -open Printf - -type tag = string -type attribute = string * string -type attributes = attribute list -type t = GTree.tree_store * GTree.view -type node = GTree.tree_store * Gtk.tree_path - -let cols = new GTree.column_list -let attribute = cols#add Gobject.Data.string -let value = cols#add Gobject.Data.string - -let model_of_attribs = fun () -> - GTree.tree_store cols - -let set_attr_value = fun (store:GTree.tree_store) row (a, v) -> - store#set ~row ~column:attribute a; - store#set ~row ~column:value v - -let set_attributes = fun (store:GTree.tree_store) attribs -> - List.iter - (fun (a, v) -> - let row = store#append () in - set_attr_value store row (a,v)) - attribs - -let attribs_of_model = fun (store:GTree.tree_store) -> - let l = ref [] in - store#foreach - (fun _path row -> - l := (store#get ~row ~column:attribute, store#get ~row ~column:value):: !l; - false); - List.rev !l - - -let editable_renderer = fun (model:GTree.tree_store) column -> - let r = GTree.cell_renderer_text [`EDITABLE true] in - let _ = r#connect#edited ~callback: - (fun path s -> - model#set ~row:(model#get_iter path) ~column s - ) in - r - -let attribs_view = fun model -> - let view = GTree.view ~model () in - view#set_rules_hint true; - let r = editable_renderer model attribute in - let col = GTree.view_column ~title:"Attribute" () - ~renderer:(r, ["text",attribute]) in - - ignore (view#append_column col); - col#set_max_width 100; - - let r = editable_renderer model value in - let col = GTree.view_column ~title:"Value" () ~renderer:(r, ["text",value]) in - ignore (view#append_column col); - view#set_headers_visible false; - view - -type event = Deleted | Modified of attributes | New_child of node - -let cols = new GTree.column_list -let tag_col = cols#add Gobject.Data.string -let attributes = cols#add Gobject.Data.caml -let event = cols#add Gobject.Data.caml -let background = cols#add Gobject.Data.string -let id = cols#add Gobject.Data.int - -let string_of_attribs = fun attribs -> - match attribs with - ["PCData", data] -> data - | _ -> - String.concat " " (List.map (fun (a,v) -> sprintf "%s=\"%s\"" a v) attribs) - -type id = int -let gen_id = - let x = ref 0 in - fun () -> incr x; !x - -let set_xml = fun (store:GTree.tree_store) row xml -> - store#set ~row ~column:tag_col (Xml.tag xml); - store#set ~row ~column:background default_background; - store#set ~row ~column:attributes (Xml.attribs xml); - store#set ~row ~column:event (fun _ -> ()); - store#set ~row ~column:id (gen_id ()) - -let encode_crs = - let r = Str.regexp "\n" in - fun s -> - Str.global_replace r "\\n" s - -(** Doesn' work. OCaml bug ? - let recode_crs = - let r = Str.regexp "\\n" in - fun s -> - Str.global_replace r "\n" s -*) - -let recode_crs = fun s -> - let n = String.length s in - let s' = Bytes.create n in - let i = ref 0 and j = ref 0 in - while !i < n do - if !i < n-1 && s.[!i] == '\\' && s.[!i+1] == 'n' then begin - Bytes.set s' (!j) '\n'; - incr i - end else - Bytes.set s' (!j) s.[!i]; - incr i; incr j - done; - Bytes.to_string (Bytes.sub s' 0 !j) - - - - -let rec insert_xml = fun (store:GTree.tree_store) parent xml -> - match xml with - Xml.Element _ -> - let row = store#append ~parent () in - set_xml store row xml; - List.iter (fun x -> insert_xml store row x) (Xml.children xml) - | Xml.PCData data -> - let row = store#append ~parent () in - store#set ~row ~column:tag_col "PCData"; - store#set ~row ~column:background default_background; - store#set ~row ~column:attributes ["PCData", encode_crs data]; - store#set ~row ~column:event (fun _ -> ()); - store#set ~row ~column:id (gen_id ()) - - - -let tree_model_of_xml = fun xml -> - let store = GTree.tree_store cols in - let row = store#append () in - set_xml store row xml; - List.iter (fun x -> insert_xml store row x) (Xml.children xml); - store;; - - -let attrib_cell_data_func = fun format_attribs renderer (model:GTree.model) iter -> - let value = model#get ~row:iter ~column:attributes in - let bg = model#get ~row:iter ~column:background in - renderer#set_properties [`TEXT (format_attribs value); `CELL_BACKGROUND bg] - -let set_bg_color = fun renderer (model:GTree.model) iter -> - let bg = model#get ~row:iter ~column:background in - renderer#set_properties [`CELL_BACKGROUND bg] - -let tree_view = fun format_attribs ?(edit=true) (model:GTree.tree_store) window -> - let view = GTree.view ~model ~enable_search:edit ~reorderable:edit ~packing:window#add () in - let r = GTree.cell_renderer_text [] in - let col = GTree.view_column ~title:"Tag" () ~renderer:(r, ["text",tag_col]) in - col#set_cell_data_func r (set_bg_color r); - let _ = r#connect#edited ~callback: - (fun path s -> - model#set ~row:(model#get_iter path) ~column:tag_col s - ) in - ignore (view#append_column col); - let r = GTree.cell_renderer_text [] in - let col = GTree.view_column ~title:"Attributes" () ~renderer:(r, []) in - col#set_cell_data_func r (attrib_cell_data_func format_attribs r); - col#set_max_width 300; - ignore (view#append_column col); - view#set_headers_visible false; - view - -(** Returns the list of all the tags appearing in the given DTD element *) -let rec tags r = function -Dtd.DTDTag s -> s::r - | Dtd.DTDPCData -> r - | Dtd.DTDOptional dtd_child | Dtd.DTDZeroOrMore dtd_child | Dtd.DTDOneOrMore dtd_child -> - tags r dtd_child - | Dtd.DTDChoice dtd_childs | Dtd.DTDChildren dtd_childs -> - List.fold_right (fun dc r -> tags r dc) dtd_childs r - -(** Returns the list of tags of possible children of the given [tag] *) -let dtd_children = fun tag dtd -> - let rec search = function - Dtd.DTDElement (t,det)::_ when t = tag -> det - | _::is -> search is - | [] -> raise Not_found in - match search dtd with - Dtd.DTDChild dc -> - tags [] dc - | _ -> [] - - -(** Make a submenu with labels from [labels]. Attach the generic [callback] - which argument is the selected label *) -let submenu = fun ?(filter = fun _ -> true) menuitem ss connect -> - let submenu = GMenu.menu () in - List.iter - (fun tag -> - if filter tag then - let menuitem = GMenu.menu_item ~label:tag ~packing:submenu#append () in - let _c = menuitem#connect#activate ~callback:(fun () -> connect tag) in - ()) - ss; - menuitem#set_submenu submenu - -(** Returns the compulsory attributes of a given tag *) -let required_attributes = fun tag dtd -> - let rec filter = function - Dtd.DTDAttribute (t, a, _, (Dtd.DTDDefault s|Dtd.DTDFixed s))::dis when t = tag -> (a,s)::filter dis - | Dtd.DTDAttribute (t, a, _, Dtd.DTDRequired)::dis when t = tag -> (a,"???")::filter dis - | _::dis -> filter dis - | [] -> [] in - filter dtd - -let allowed_attributes = fun tag dtd -> - let rec filter = function - | Dtd.DTDAttribute (t, a, _, _)::dis when t = tag -> a::filter dis - | _::dis -> filter dis - | [] -> [] in - filter dtd - -let attr_submenu = fun ?filter menuitem tag dtd connect -> - submenu ?filter menuitem (allowed_attributes tag dtd) connect - - -let selection = fun (tree_store, tree_view) -> - match tree_view#selection#get_selected_rows with - path::_ -> - tree_store, path - | _ -> raise Not_found - -let attribs_menu_popup = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) (attrib_row:Gtk.tree_iter) -> - let menu = GMenu.menu () in - begin - match tree_view#selection#get_selected_rows with - path::_ -> - let tree_model = tree_view#model in - let row = tree_model#get_iter path in - let current_tag = tree_model#get ~row ~column:tag_col in - let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in - let current_attrib = model#get ~row:attrib_row ~column:attribute in - if not (List.mem_assoc current_attrib (required_attributes current_tag dtd)) then begin - let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in - ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#remove attrib_row))) - end; - - let l = ref [] in - model#foreach (fun _path row -> - l := model#get ~row ~column:attribute :: !l; false); - let filter = fun x -> not (List.mem x !l) in - - let connect = fun a -> - let row = model#insert_after attrib_row in - let av = (a, "???") in - set_attr_value model row av in - attr_submenu ~filter menuitem current_tag dtd connect - | _ -> () - end; - menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) - -let add_one_menu = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) -> - match tree_view#selection#get_selected_rows with - path::_ -> - let tree_model = tree_view#model in - let row = tree_model#get_iter path in - let current_tag = tree_model#get ~row ~column:tag_col in - let menu = GMenu.menu () in - let menuitem = GMenu.menu_item ~label:"Add one" ~packing:menu#append () in - let connect = fun a -> - let row = model#append () in - let av = (a, "???") in - set_attr_value model row av in - attr_submenu menuitem current_tag dtd connect; - menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) - | _ -> () - - - - -let add_context_menu = fun model view ?noselection_menu menu -> - view#event#connect#button_press ~callback: - (fun ev -> - GdkEvent.Button.button ev = 3 - && - match view#selection#get_selected_rows, noselection_menu with - path::_, _ -> - let row = model#get_iter path in - menu model row; - true - | [], Some menu -> - menu model; - true - | _ -> false) - -let add_delete_key = fun (model:GTree.tree_store) (view:GTree.view) -> - view#event#connect#key_press ~callback:(fun ev -> - if GdkEvent.Key.keyval ev = GdkKeysyms._Delete then - match view#selection#get_selected_rows with - path::_ -> - let row = model#get_iter path in - model#get ~row ~column:event Deleted; - ignore (model#remove row); - true - | _ -> false - else false) - - -let root = fun ((model:GTree.tree_store), _) -> - match model#get_iter_first with - None -> invalid_arg "XmlEdit.root" - | Some i -> (model, model#get_path i) - - -let attribs = fun ((model, path):node) -> - let row = model#get_iter path in - model#get ~row ~column:attributes - -let set_attribs = fun ((model, path):node) attribs -> - let row = model#get_iter path in - model#set ~row ~column:attributes attribs - -let rec replace_assoc a v = function -[] -> [(a, v)] - | (a', v')::l -> - if a = String.uppercase_ascii a' - then (a, v)::l - else (a', v')::replace_assoc a v l - -let set_attrib = fun node (a, v) -> - let atbs = attribs node in - set_attribs node (replace_assoc (String.uppercase_ascii a) v atbs) - -let attrib = fun node at -> - let at = String.uppercase_ascii at in - let ats = attribs node in - let rec loop = function - [] -> raise Not_found - | (a,v)::avs -> - if String.uppercase_ascii a = at then v else loop avs in - loop ats - -let tag = fun ((model, path):node) -> - let row = model#get_iter path in - model#get ~row ~column:tag_col - -let children = fun ((model, path):node) -> - let row = model#get_iter path in - if model#iter_has_child row then - let i = model#iter_children (Some row) in - let l = ref [model, model#get_path i] in - while model#iter_next i do - l := (model, model#get_path i):: !l; - done; - List.rev !l - else - [] - -let rec xml_of_node = fun (node:node) -> - let attrs = attribs node - and tag = tag node in - if tag = "PCData" then - match attrs with - ["PCData", data] -> Xml.PCData (sprintf "\n%s\n" (recode_crs data)) - | _ -> failwith (sprintf "Wrong data in %s\n" tag) - else - let children = List.map xml_of_node (children node) in - Xml.Element (tag, List.sort compare attrs, children) - -let xml_of_view = fun (tree:t) -> - xml_of_node (root tree) - -let child = fun ((model, path):node) (t:string) -> - let row = model#get_iter path in - if model#iter_has_child row then - let i = model#iter_children (Some row) in - let rec loop = fun () -> - if model#get ~row:i ~column:tag_col = t then - (model, model#get_path i) - else if model#iter_next i then - loop () - else failwith (sprintf "XmlEdit.child: %s" t) in - loop () - else - failwith (sprintf "XmlEdit.child: %s" t) - -let rec parent = fun ((model, path):node) (t:string) -> - let row = model#get_iter path in - let tag = model#get ~row ~column:tag_col in - if tag = t then - (model, path) - else - match model#iter_parent row with - None -> failwith (sprintf "XmlEdit.parent: %s" t) - | Some p -> - parent (model, model#get_path p) t - - -let delete = fun (model, path) -> - let row = model#get_iter path in - if model#iter_is_valid row then - ignore (model#remove row) - -let add_child = fun ((model, path):node) tag attribs -> - let parent = model#get_iter path in - let row = model#append ~parent () in - set_xml model row (Xml.Element (tag, attribs, [])); - model, model#get_path row - -let id = fun ((model, path):node) -> - let row = model#get_iter path in - model#get ~row ~column:id - -let connect = fun ((model, path):node) cb -> - let row = model#get_iter path in - let current_cb = try model#get ~row ~column:event with _ -> fun _ -> () in - model#set ~row ~column:event (fun e -> cb e; current_cb e) - -let activated_cbs = Hashtbl.create 3 -let connect_activated = fun (model,_) cb -> - let l = try Hashtbl.find activated_cbs model with Not_found -> [] in - Hashtbl.replace activated_cbs model (cb::l) - - - -let expand_node = fun ?all (_, (tree_view:GTree.view)) ((model, path):node) -> - tree_view#expand_row ?all path - -let rec set_background = fun ?(all=false) ((model, path):node) color -> - let row = model#get_iter path in - model#set ~row ~column:background color; - if all then - List.iter (fun x -> set_background ~all x color) (children (model,path)) - - - -let tree_menu_popup = fun dtd (model:GTree.tree_store) (row:Gtk.tree_iter) -> - let menu = GMenu.menu () in - let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in - ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#get ~row ~column:event Deleted; model#remove row))); - let row_tag = model#get ~row ~column:tag_col in - let tags = dtd_children row_tag dtd in - if tags <> [] then begin - let menuitem = GMenu.menu_item ~label:"Add child" ~packing:menu#append () in - let connect = fun t -> - let parent = row in - let row = model#append ~parent () in - let attrs = required_attributes t dtd in - let xml = Xml.Element (t, attrs, []) in - set_xml model row xml; - model#get ~row:parent ~column:event (New_child (model, model#get_path row)) in - submenu menuitem tags connect - end; - begin - match model#iter_parent row with - Some parent -> - let copy = fun () -> - let xml = xml_of_node (model,(model#get_path row)) in - let row = model#insert_after ~parent row in - set_xml model row xml; - model#get ~row:parent ~column:event (New_child (model, model#get_path row)); - List.iter (insert_xml model row) (Xml.children xml) - in - let menuitem = GMenu.menu_item ~label:"Copy after" ~packing:menu#append () in - ignore (menuitem#connect#activate ~callback:copy); - - let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in - let parent_tag = model#get ~row:parent ~column:tag_col in - let connect = fun t -> - let row = model#insert_after ~parent row in - let attrs = required_attributes t dtd in - let xml = Xml.Element (t, attrs, []) in - set_xml model row xml; - model#get ~row:parent ~column:event (New_child (model, model#get_path row)) - in - let tags = dtd_children parent_tag dtd in - submenu menuitem tags connect - | _ -> () - end; - menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) - - - - -let create = fun ?(format_attribs = string_of_attribs) ?(editable=true) ?(width = 400) dtd xml -> - let tree_model = tree_model_of_xml xml in - let attribs_model = model_of_attribs () in - let hbox = GPack.hbox () in - let sw = GBin.scrolled_window ~width ~hpolicy:`AUTOMATIC - ~vpolicy:`AUTOMATIC ~packing:hbox#add () in - let tree_view = tree_view format_attribs ~edit:editable tree_model sw in - tree_view#set_border_width 10; - - let sw = GBin.scrolled_window ~width:150 ~hpolicy:`AUTOMATIC - ~vpolicy:`AUTOMATIC () in - let attribs_view = attribs_view attribs_model in - attribs_view#set_border_width 10; - sw#add attribs_view#coerce; - if editable then - hbox#add sw#coerce; - - let update_tree = fun _path -> - match tree_view#selection#get_selected_rows with - path::_ -> - let row = tree_model#get_iter path in - let new_attribs = attribs_of_model attribs_model in - tree_model#set ~row ~column:attributes new_attribs; - tree_model#get ~row ~column:event (Modified new_attribs) - | _ -> () - in - let _attribs_changed = attribs_model#connect#row_changed ~callback:(fun p _i -> update_tree p) in - ignore (attribs_model#connect#row_deleted ~callback:update_tree); - - let tag_of_last_selection = ref "" in - - let selection_changed = fun () -> - match tree_view#selection#get_selected_rows with - path::_ -> - let row = tree_model#get_iter path in - let attribs = tree_model#get ~row ~column:attributes in - attribs_model#clear (); - tag_of_last_selection := tree_model#get ~row ~column:tag_col; - set_attributes attribs_model attribs - | _ -> () in - - let _c = tree_view#selection#connect#after#changed ~callback:selection_changed in - - let _ = tree_view#connect#after#row_activated ~callback: - (fun path vcol -> - let cbs = try (Hashtbl.find activated_cbs tree_model) with Not_found -> [] in - List.iter (fun cb -> cb (tree_model, path)) cbs) in - - if editable then begin - let _c = add_context_menu tree_model tree_view (tree_menu_popup dtd) in - let _c = add_context_menu attribs_model attribs_view ~noselection_menu:(add_one_menu dtd tree_view) (attribs_menu_popup dtd tree_view) in - - ignore (add_delete_key tree_model tree_view); - ignore (add_delete_key attribs_model attribs_view) - end; - - (* Controlled drag and drop. - Handling of dropable row cannot be done inside motion handling since - the context refers to the whole widget, not the current row. The trick - here is to use a boolean, set during motion and checked in drop event *) - let dropable = ref false in - let motion = fun _context ~x ~y ~time -> - try - let path, i = gtk_tree_view_get_drag_dest_row tree_view#as_widget in - let row = tree_model#get_iter path in - let row_tag = (tree_model#get ~row ~column:tag_col) in - dropable := begin - match i with - GTK_TREE_VIEW_DROP_INTO_OR_BEFORE - | GTK_TREE_VIEW_DROP_INTO_OR_AFTER -> - List.mem !tag_of_last_selection (dtd_children row_tag dtd) - | _ -> - match tree_model#iter_parent row with - None -> false - | Some parent -> - let parent_tag = tree_model#get ~row:parent ~column:tag_col in - List.mem !tag_of_last_selection (dtd_children parent_tag dtd) - end; - false - with - Gpointer.Null -> false in - let drop = fun (context:GObj.drag_context) ~x ~y ~time -> - if !dropable then - false - else begin - context#status None; - true - end in - let _ = tree_view#drag#connect#motion ~callback:motion in - let _ = tree_view#drag#connect#drop ~callback:drop in - (tree_model, tree_view), hbox#coerce diff --git a/sw/ground_segment/cockpit/lib/xmlEdit.mli b/sw/ground_segment/cockpit/lib/xmlEdit.mli deleted file mode 100644 index 85d019f5ba..0000000000 --- a/sw/ground_segment/cockpit/lib/xmlEdit.mli +++ /dev/null @@ -1,79 +0,0 @@ -(* - * XML graphics editor - * - * Copyright (C) 2004 CENA/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. - * - *) - -(** XML types base on the xml-light library *) - -type t -(** The whole XML data structure *) - -type node -(** One data structure node. Warning: it is not an absolute -node designation: it may not remain valid after strucure modifications -(reordering, deletion addition, ... *) - -type tag = string -type attribute = string * string -type attributes = attribute list - -type event = Deleted | Modified of attributes | New_child of node - -val create : ?format_attribs:((string * string) list -> string) -> ?editable:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget) -(** [create ?format_attribs ?editable dtd xml] Opens a display of [xml] with contextual right button -actions constrained by [dtd]. Returns the corresponding model. *) - -val xml_of_node : node -> Xml.xml -val xml_of_view : t -> Xml.xml -(** [xml_of_view v] Returns the XML displayed data structure *) - -val root : t -> node - -val child : node -> tag -> node -val tag : node -> string -val attribs : node -> attributes -val attrib : node -> string -> string (* Safe case match *) -val children : node -> node list -val parent : node -> tag -> node (** May raise Failure *) -(** Xml-light like acces functions *) - -val set_attrib : node -> attribute -> unit -val set_attribs : node -> attributes -> unit -val delete : node -> unit -val add_child : node -> tag -> attributes -> node -(** Modifications *) - -val connect : node -> (event -> unit) -> unit -val connect_activated : t -> (node -> unit) -> unit -(** To be kept informed about modifications *) - -val string_of_attribs : attributes -> string -(** Default formatter for attributes *) - -val selection : t -> node - -val expand_node : ?all:bool -> t -> node -> unit - -val set_background : ?all:bool -> node -> string -> unit - -type id = int -val id : node -> id diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml deleted file mode 100644 index 69d45b2b09..0000000000 --- a/sw/ground_segment/cockpit/live.ml +++ /dev/null @@ -1,1597 +0,0 @@ -(* - * Real time handling of flying A/Cs - * - * Copyright (C) 2004-2006 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. - * - *) - -module G = MapCanvas -open Latlong -module LL = Latlong -open Printf - - -module Tele_Pprz = PprzLink.Messages(struct let name = "telemetry" end) -module Ground_Pprz = PprzLink.Messages(struct let name = "ground" end) -module Alert_Pprz = PprzLink.Messages(struct let name = "alert" end) - - -let (//) = Filename.concat - -let gcs_id = "GCS" - -let approaching_alert_time = 3. -let approaching_alert_dmin = 0.5 -let approaching_alert_slmin = 20. - -let track_size = ref 500 - -let _auto_hide_fp = ref false - -(* request AIRCRAFTS list until got first answer from server *) -let _req_aircrafts = ref true - -let min_height = 200 -let lines_height = 30 - -let is_int = fun x -> - try let _ = int_of_string x in true with _ -> false - -let ok_modes = ["MANUAL"; "AUTO1"; "AUTO2"] - -let rotate = fun a (x, y) -> - let cosa = cos a and sina = sin a in - (cosa *.x +. sina *.y, -. sina*.x +. cosa *. y) - -let rec list_casso x = function -[] -> raise Not_found - | (a,b)::abs -> if x = b then a else list_casso x abs - -let rec list_iter3 = fun f l1 l2 l3 -> - match l1, l2, l3 with - [], [], [] -> () - | x1::x1s, x2::x2s, x3::x3s -> - f x1 x2 x3; - list_iter3 f x1s x2s x3s - | _ -> invalid_arg "list_iter3" - - -type color = string -type gps_acc_level = GPS_ACC_HIGH | GPS_ACC_LOW | GPS_ACC_VERY_LOW | GPS_NO_ACC - -type aircraft = { - ac_name : string; - ac_speech_name : string; - config : PprzLink.values; - track : MapTrack.track; - color: color; - fp_group : MapFP.flight_plan; - fp_show : GMenu.check_menu_item; - wp_HOME : MapWaypoints.waypoint option; - fp : Xml.xml; - blocks : (int * string) list; - mutable last_ap_mode : string; - mutable last_stage : int * int; - ir_page : Pages.infrared; - gps_page : Pages.gps; - pfd_page : Horizon.pfd; - link_page : Pages.link; - misc_page : Pages.misc; - dl_settings_page : Page_settings.settings option; - rc_settings_page : Pages.rc_settings option; - pages : GObj.widget; - notebook_label : GMisc.label; - strip : Strip.t; - rc_max_rate: float; - mutable first_pos : bool; - mutable last_block_name : string; - mutable in_kill_mode : bool; - mutable speed : float; - mutable alt : float; - mutable target_alt : float; - mutable flight_time : int; - mutable wind_speed : float; - mutable wind_dir : float; (* Rad, clockwise from North *) - mutable ground_prox : bool; - mutable got_track_status_timer : int; - mutable last_dist_to_wp : float; - mutable dl_values : string option array; - mutable last_unix_time : float; - mutable airspeed : float; - mutable version : string; - mutable last_gps_acc : gps_acc_level; - mutable last_bat_warn_time : float; - time_link_lost: (string, float) Hashtbl.t -} - -let list_separator = Str.regexp "," -let filter_acs = ref [] - -let aircrafts = Hashtbl.create 3 -exception AC_not_found -let find_ac = fun ac_id -> - try - Hashtbl.find aircrafts ac_id - with - Not_found -> raise AC_not_found - -let active_ac = ref "" -let get_ac = fun vs -> - let ac_id = PprzLink.string_assoc "ac_id" vs in - find_ac ac_id - -let show_fp = fun ac -> - ac.fp_group#show (); - ac.fp_show#set_active true - -let hide_fp = fun ac -> - ac.fp_group#hide (); - ac.fp_show#set_active false - -(* callback for FP check button in menu *) -let show_mission = fun ac on_off -> - let a = find_ac ac in - if on_off then - a.fp_group#show () - else - a.fp_group#hide () - -let auto_hide_fp = fun hide -> - let _hide_fp = fun () -> - Hashtbl.iter (fun _ a -> hide_fp a) aircrafts; - if !active_ac <> "" then begin - let a = find_ac !active_ac in - show_fp a - end; - in - _auto_hide_fp := hide; - if hide then _hide_fp () else Hashtbl.iter (fun _ a -> show_fp a) aircrafts - -let select_ac = fun acs_notebook ac_id -> - if !active_ac <> ac_id then - let ac = Hashtbl.find aircrafts ac_id in - - (* Show the buttons in the active strip and hide the previous active one *) - ac.strip#show_buttons (); - if !active_ac <> "" then begin - let ac' = find_ac !active_ac in - ac'.strip#hide_buttons (); - ac'.notebook_label#set_width_chars (String.length ac'.notebook_label#text); - if !_auto_hide_fp then hide_fp ac' - end; - - (* Set the new active *) - active_ac := ac_id; - if !_auto_hide_fp then show_fp ac; - - (* Select and enlarge the label of the A/C notebook *) - let n = acs_notebook#page_num ac.pages in - acs_notebook#goto_page n; - ac.notebook_label#set_width_chars 20 - -let filter_ac_ids = fun acs -> - let acs = Str.split list_separator acs in - filter_acs := acs; - -module M = Map.Make (struct type t = string let compare = compare end) -let log = - let last = ref M.empty in - fun ?(say = false) (a:Pages.alert) ac_id s -> - if not (M.mem ac_id !last) || M.find ac_id !last <> s then begin - last := M.add ac_id s (M.remove ac_id !last); - if say then Speech.say s; - a#add s - end - -let log_and_say = fun a ac_id s -> log ~say:true a ac_id s - -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 send_move_waypoint_msg = fun ac i w -> - let wgs84 = w#pos in - let vs = ["ac_id", PprzLink.String ac; - "wp_id", PprzLink.Int i; - "lat", PprzLink.Float ((Rad>>Deg)wgs84.posn_lat); - "long", PprzLink.Float ((Rad>>Deg)wgs84.posn_long); - "alt", PprzLink.Float w#alt - ] in - Ground_Pprz.message_send "gcs" "MOVE_WAYPOINT" vs - -let commit_changes = fun ac -> - let a = find_ac ac in - List.iter - (fun w -> - let (i, w) = a.fp_group#index w in - if w#moved then - send_move_waypoint_msg ac i w) - a.fp_group#waypoints - -let center = fun geomap track () -> - match track#last with - None -> () - | Some geo -> - geomap#center geo; - geomap#canvas#misc#draw None - - -let blocks_of_stages = fun stages -> - let blocks = ref [] in - List.iter (fun x -> - let name = ExtXml.attrib x "block_name" - and id = ExtXml.int_attrib x "block" in - if not (List.mem_assoc id !blocks) then - blocks := (id, name) :: !blocks) - (Xml.children stages); - List.sort compare !blocks - -let jump_to_block = fun ac_id id -> - Ground_Pprz.message_send "gcs" "JUMP_TO_BLOCK" - ["ac_id", PprzLink.String ac_id; "block_id", PprzLink.Int id] - -let dl_setting = fun ac_id idx value -> - let vs = ["ac_id", PprzLink.String ac_id; "index", PprzLink.Int idx;"value", PprzLink.Float value] in - Ground_Pprz.message_send "dl" "DL_SETTING" vs - -let dl_emergency_cmd = fun ac_id cmd -> - let vs = ["ac_id", PprzLink.String ac_id; "cmd", PprzLink.Int cmd] in - Ground_Pprz.message_send "dl" "DL_EMERGENCY_CMD" vs - -let get_dl_setting = fun ac_id idx -> - let vs = ["ac_id", PprzLink.String ac_id; "index", PprzLink.Int idx] in - Ground_Pprz.message_send "dl" "GET_DL_SETTING" vs - -let menu_entry_of_block = fun ac_id (id, name) -> - let send_msg = fun () -> jump_to_block ac_id id in - `I (name, send_msg) - -let reset_waypoints = fun fp () -> - List.iter (fun w -> - let (_i, w) = fp#index w in - w#reset_moved ()) - fp#waypoints - -let icon = ref None -let show_snapshot = fun (geomap:G.widget) geo_FL geo_BR point pixbuf name ev -> - match ev with - | `BUTTON_PRESS _ev -> - let image = GMisc.image ~pixbuf () in - let icon = image#coerce in - begin - match GToolbox.question_box ~title:name ~buttons:["Delete"; "Close"] ~icon "" with - 1 -> - point#destroy () - | _ -> () - end; - true - | `LEAVE_NOTIFY _ev -> - begin - match !icon with - None -> () - | Some i -> i#destroy () - end; - false - | `ENTER_NOTIFY _ev -> - let w = GdkPixbuf.get_width pixbuf - and h = GdkPixbuf.get_height pixbuf in - icon := Some (geomap#display_pixbuf ((0,0), geo_FL) ((w,h), geo_BR) pixbuf); - point#raise_to_top (); - false - - | _ -> false - - -let mark = fun (geomap:G.widget) ac_id track plugin_frame -> - let i = ref 1 in fun () -> - match track#last with - Some geo -> - begin - let group = geomap#background in - let point = geomap#circle ~group ~fill_color:"blue" geo 5. in - point#raise_to_top (); - let lat = (Rad>>Deg)geo.posn_lat - and long = (Rad>>Deg)geo.posn_long in - Tele_Pprz.message_send ac_id "MARK" - ["ac_id", PprzLink.String ac_id; - "lat", PprzLink.Float lat; - "long", PprzLink.Float long]; - let frame = - match plugin_frame with - None -> geomap#canvas#coerce - | Some pf -> pf#coerce in - let width, height = Gdk.Drawable.get_size frame#misc#window in - let dest = GdkPixbuf.create ~width ~height() in - GdkPixbuf.get_from_drawable ~dest ~width ~height frame#misc#window; - let name = sprintf "Snapshot-%s-%d_%f_%f_%f.png" ac_id !i lat long (track#last_heading) in - let png = sprintf "%s/var/logs/%s" Env.paparazzi_home name in - GdkPixbuf.save ~filename:png ~typ:"png" dest; - incr i; - - (* Computing the footprint: front_left and back_right *) - let cam_aperture = 2.4/.1.9 in (* width over distance FIXME *) - let alt = track#last_altitude -. float (Srtm.of_wgs84 geo) in - let width = cam_aperture *. alt in - let height = width *. 3. /. 4. in - let utm = utm_of WGS84 geo in - let a = (Deg>>Rad)track#last_heading in - let (xfl,yfl) = rotate a (-.width/.2., height/.2.) - and (xbr,ybr) = rotate a (width/.2., -.height/.2.) in - let geo_FL = of_utm WGS84 (utm_add utm (xfl,yfl)) - and geo_BR = of_utm WGS84 (utm_add utm (xbr,ybr)) in - ignore (point#connect#event ~callback:(show_snapshot geomap geo_FL geo_BR point dest name)) - end - | None -> () - - -(** Light display of attributes in the flight plan. *) -let attributes_pretty_printer = fun attribs -> - (* Remove the optional attributes *) - let valid = fun a -> - let a = String.lowercase_ascii a in - a <> "no" && a <> "strip_icon" && a <> "strip_button" && a <> "pre_call" - && a <> "post_call" && a <> "key" && a <> "group" in - - let sprint_opt = fun b s -> - if String.length b > 0 then - sprintf " %s%s%s" s b s - else - "" - in - let elt = Xml.Element("", attribs, []) in - let pre_call = ExtXml.attrib_or_default elt "pre_call" "" - and post_call = ExtXml.attrib_or_default elt "post_call" "" in - - let attribs = List.filter (fun (a, _) -> valid a) attribs in - - (* Don't print the name of the attribute if there is only one *) - match attribs with - [(_, v)] -> v ^ sprint_opt pre_call "]" ^ sprint_opt post_call "[" - | _ -> XmlEdit.string_of_attribs attribs - - -(** Load a mission. Returns the XML window *) -let load_mission = fun ?editable color geomap xml -> - Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml); - new MapFP.flight_plan ~format_attribs:attributes_pretty_printer ?editable ~show_moved:true geomap color Env.flight_plan_dtd xml - -let get_rc_max_rate = fun af_xml -> - let default_max_rate = 50. in - try - let gcs_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "MISC") "section" in - let fvalue = fun name default-> - try ExtXml.float_attrib (ExtXml.child gcs_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value" with _ -> default in - (fvalue "RC_MAX_RATE" 50.) - with _ -> default_max_rate - -let get_bat_levels = fun af_xml -> - let default_catastrophic_level = 9. - and default_max_level = 12.5 - and default_nb_cell = None in - try - let bat_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "BAT") "section" in - let fvalue = fun name default -> - try ExtXml.float_attrib (ExtXml.child bat_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value" with _ -> default in - let fvalue_opt = fun name default -> - try Some (ExtXml.float_attrib (ExtXml.child bat_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value") with _ -> default in - fvalue "CATASTROPHIC_BAT_LEVEL" default_catastrophic_level, fvalue "MAX_BAT_LEVEL" default_max_level, fvalue_opt "BAT_NB_CELLS" default_nb_cell - with _ -> (default_catastrophic_level, default_max_level, default_nb_cell) - -let get_alt_shift = fun af_xml -> - let default_plus_plus = 30. - and default_plus = 5. - and default_minus = -5. in - try - let gcs_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "GCS") "section" in - let fvalue = fun name default -> - try ExtXml.float_attrib (ExtXml.child gcs_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value" with _ -> default in - fvalue "ALT_SHIFT_PLUS_PLUS" default_plus_plus, - fvalue "ALT_SHIFT_PLUS" default_plus, - fvalue "ALT_SHIFT_MINUS" default_minus - with _ -> (default_plus_plus, default_plus, default_minus) - -let get_speech_name = fun af_xml def_name -> - let default_speech_name = def_name in - try - let gcs_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "GCS") "section" in - let fvalue = fun name default -> - try ExtXml.attrib (ExtXml.child gcs_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value" with _ -> default in - fvalue "SPEECH_NAME" default_speech_name - with _ -> default_speech_name - -let get_icon_and_track_size = fun af_xml -> - (* firmware name as default if fixedwing or rotorcraft *) - let firmware = ExtXml.child af_xml "firmware" in - let firmware_name = ExtXml.attrib firmware "name" in - try - (* search AC_ICON in GCS section *) - let gcs_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "GCS") "section" in - let ac_icon = ExtXml.child gcs_section ~select:(fun x -> ExtXml.attrib x "name" = "AC_ICON") "define" in - match ExtXml.attrib ac_icon "value" with - | "home" -> ("home", 1) (* no track for home icon *) - | x -> (x, !track_size) - with _ -> (firmware_name, !track_size) - -let get_icons_theme = fun af_xml -> - try - let gcs_section = ExtXml.child af_xml ~select:(fun x -> Xml.attrib x "name" = "GCS") "section" in - let fvalue = fun name default -> - try ExtXml.attrib (ExtXml.child gcs_section ~select:(fun x -> ExtXml.attrib x "name" = name) "define") "value" with _ -> default in - fvalue "ICONS_THEME" Env.gcs_default_icons_theme - with _ -> Env.gcs_default_icons_theme - -let key_press_event = fun keys do_action ev -> - try - let (modifiers, action) = List.assoc (GdkEvent.Key.keyval ev) keys in - let ev_modifiers = GdkEvent.Key.state ev in - if List.for_all (fun m -> List.mem m ev_modifiers) modifiers then begin - do_action action; - true - end else - false - with - | _ -> false - - - - -(*****************************************************************************) -let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:GPack.notebook) (strips:GPack.box) (ac_id:string) config -> - let color = PprzLink.string_assoc "default_gui_color" config - and name = PprzLink.string_assoc "ac_name" config in - - (** Get the flight plan **) - let fp_url = PprzLink.string_assoc "flight_plan" config in - let fp_file = Http.file_of_url fp_url in - let fp_xml_dump = ExtXml.parse_file ~noprovedtd:true fp_file in - let stages = ExtXml.child fp_xml_dump "stages" in - let blocks = blocks_of_stages stages in - - (** Get the airframe file *) - let af_url = PprzLink.string_assoc "airframe" config in - let af_file = Http.file_of_url af_url in - (* do not check dtd if it is a http url *) - let via_http = Str.string_match (Str.regexp "http") af_url 0 in - let af_xml = ExtXml.parse_file ~noprovedtd:via_http af_file in - let af_xml = try Airframe.expand_includes ac_id af_xml with _ -> af_xml in - - (** Get an alternate speech name if available *) - let speech_name = get_speech_name af_xml name in - - - (* Aicraft menu decorated with a colored box *) - let image = GBin.event_box ~width:10 ~height:10 () in - image#coerce#misc#modify_bg [`NORMAL, `NAME color]; - let ac_mi = GMenu.image_menu_item ~label:name ~image ~packing:geomap#menubar#append () in - - let ac_menu = GMenu.menu () in - ac_mi#set_submenu ac_menu; - let ac_menu_fact = new GMenu.factory ac_menu in - let fp_show = ac_menu_fact#add_check_item "Fligh Plan" ~active:true in - ignore (fp_show#connect#toggled ~callback:(fun () -> show_mission ac_id fp_show#active)); - - let (icon, size) = get_icon_and_track_size af_xml in - let track = new MapTrack.track ~size ~icon ~name ~color:color ac_id geomap in - track#set_event_cb (select_ac acs_notebook); - geomap#register_to_fit (track:>MapCanvas.geographic); - - let center_ac = center geomap track in - ignore (ac_menu_fact#add_item "Center A/C" ~callback:center_ac); - - 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)); - let reset_wp_menu = ac_menu_fact#add_item "Reset Waypoints" in - - let jump_block_entries = List.map (menu_entry_of_block ac_id) blocks in - - let commit_moves = fun () -> - commit_changes ac_id in - let sm = ac_menu_fact#add_submenu "Datalink" in - let dl_menu = [ - `M ("Jump to block", jump_block_entries); - `I ("Commit Moves", commit_moves)] in - - GToolbox.build_menu sm ~entries:dl_menu; - - let cam = ac_menu_fact#add_check_item "Cam footprint" ~active:false in - ignore (cam#connect#toggled ~callback:(fun () -> track#set_cam_state cam#active)); - let params = ac_menu_fact#add_check_item "A/C label" ~active:false in - ignore (params#connect#toggled ~callback:(fun () -> track#set_params_state params#active)); - - (** Add a new tab in the A/Cs notebook, with a colored label *) - let eb = GBin.event_box () in - let _label = GMisc.label ~text:name ~packing:eb#add () in - eb#coerce#misc#modify_bg [`NORMAL, `NAME color;`ACTIVE, `NAME color]; - - (** Put a notebook for this A/C *) - let ac_frame = GBin.frame () in - ignore (acs_notebook#append_page ~tab_label:eb#coerce ac_frame#coerce); - let ac_notebook = GPack.notebook ~packing: ac_frame#add () in - let visible = fun w -> - ac_notebook#page_num w#coerce = ac_notebook#current_page in - - (** Add a strip *) - let min_bat, max_bat, nb_cell_bat = get_bat_levels af_xml in - let alt_shift_plus_plus, alt_shift_plus, alt_shift_minus = get_alt_shift af_xml in - let icons_theme = get_icons_theme af_xml in - let param = { Strip.color = color; - min_bat = min_bat; max_bat = max_bat; nb_cell_bat = nb_cell_bat; - alt_shift_plus_plus = alt_shift_plus_plus; - alt_shift_plus = alt_shift_plus; - alt_shift_minus = alt_shift_minus; - icons_theme = icons_theme; } in - (*let strip = Strip.add config color min_bat max_bat in*) - let strip = Strip.add config param strips in - strip#connect (fun () -> select_ac acs_notebook ac_id); - strip#connect_mark (mark geomap ac_id track !Plugin.frame); - - (** Build the XML flight plan, connect then "jump_to_block" *) - let fp_xml = ExtXml.child fp_xml_dump "flight_plan" in - let fp = load_mission ~editable:false color geomap fp_xml in - fp#connect_activated (fun node -> - if XmlEdit.tag node = "block" then - let block = XmlEdit.attrib node "name" in - let id = list_casso block blocks in - jump_to_block ac_id id); - ignore (reset_wp_menu#connect#activate ~callback:(reset_waypoints fp)); - - (** Monitor waypoints changes *) - List.iter - (fun w -> - let (i, w) = fp#index w in - w#set_commit_callback (fun () -> send_move_waypoint_msg ac_id i w)) - fp#waypoints; - - (** Add waypoints as geo references *) - List.iter - (fun w -> - let (_i, w) = fp#index w in - geomap#add_info_georef (sprintf "%s.%s" name w#name) (w :> < pos : Latlong.geographic >)) - fp#waypoints; - - (** Add the short cut buttons in the strip *) - let tooltips = GData.tooltips () in - let keys = ref [] in (* Associations between keys and block ids *) - List.iter (fun block -> - let id = ExtXml.int_attrib block "no" in - begin (* Is it a key short cut ? *) - try - let key, modifiers = GtkData.AccelGroup.parse (Env.key_modifiers_of_string (Xml.attrib block "key")) in - keys := (key, (modifiers, id)) :: !keys - with - _ -> () - end; - try (* Is it a strip button ? *) - let label = ExtXml.attrib block "strip_button" - and block_name = ExtXml.attrib block "name" - and group = ExtXml.attrib_or_default block "group" "" in - let b = - try (* Is it an icon ? *) - let icon = Xml.attrib block "strip_icon" in - let b = GButton.button () in - let pixbuf = GdkPixbuf.from_file (Env.get_gcs_icon_path icons_theme icon) in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); - - (* Drag for Drop *) - let papget = Papget_common.xml "goto_block" "button" - [ "block_name", block_name; - "ac_id", ac_id; - "icon", icons_theme // icon] in - Papget_common.dnd_source b#coerce papget; - - (* Associates the label as a tooltip *) - tooltips#set_tip b#coerce ~text:label; - b - with - Xml.No_attribute _ -> (* It's not an icon *) - GButton.button ~label () - | exc -> - fprintf stderr "Error: '%s' Using a standard button" (Printexc.to_string exc); - GButton.button ~label () - in - strip#add_widget b#coerce ~group; - ignore (b#connect#clicked ~callback:(fun _ -> jump_to_block ac_id id)) - with - _ -> ()) - (Xml.children (ExtXml.child (ExtXml.child fp_xml_dump "flight_plan") "blocks")); - - - (** Handle key shortcuts for block selection *) - let key_press = key_press_event !keys (fun block_id -> jump_to_block ac_id block_id) in - ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press); - - - (** Insert the flight plan tab *) - let fp_label = GMisc.label ~text: "Flight Plan" () in - ignore ((ac_notebook:GPack.notebook)#append_page ~tab_label:fp_label#coerce fp#window#coerce); - - let infrared_label = GMisc.label ~text: "Infrared" () in - let infrared_frame = GBin.frame ~show:false ~shadow_type:`NONE () in - ignore (ac_notebook#append_page ~tab_label: infrared_label#coerce infrared_frame#coerce); - let ir_page = new Pages.infrared infrared_frame in - - let gps_label = GMisc.label ~text: "GPS" () in - let gps_frame = GBin.frame ~shadow_type: `NONE () in - ignore (ac_notebook#append_page ~tab_label: gps_label#coerce gps_frame#coerce); - let gps_page = new Pages.gps ~visible gps_frame in - - let pfd_label = GMisc.label ~text: "PFD" () in - let pfd_frame = GBin.frame ~shadow_type: `NONE () in - ignore (ac_notebook#append_page ~tab_label: pfd_label#coerce pfd_frame#coerce); - let pfd_page = new Horizon.pfd pfd_frame - and _pfd_page_num = ac_notebook#page_num pfd_frame#coerce in - - let link_label = GMisc.label ~text: "Link" () in - let link_frame = GBin.frame ~shadow_type: `NONE () in - ignore (ac_notebook#append_page ~tab_label: link_label#coerce link_frame#coerce); - let link_page = new Pages.link ~visible link_frame in - - let misc_label = GMisc.label ~text: "Misc" () in - let misc_frame = GBin.frame ~shadow_type: `NONE () in - ignore (ac_notebook#append_page ~tab_label:misc_label#coerce misc_frame#coerce); - let misc_page = new Pages.misc ~packing:misc_frame#add misc_frame in - - let settings_url = PprzLink.string_assoc "settings" config in - let settings_file = Http.file_of_url settings_url in - let settings_xml = - try - if String.compare "replay" settings_file <> 0 then - ExtXml.parse_file ~noprovedtd:true settings_file - else - Xml.Element("empty", [], []) - with exc -> - prerr_endline (Printexc.to_string exc); - Xml.Element("empty", [], []) - in - let dl_setting_callback = fun idx value -> - if classify_float value = FP_normal || classify_float value = FP_zero then - dl_setting ac_id idx value - else - get_dl_setting ac_id idx - in - let dl_settings_page = - try - let xml_settings = Xml.children (ExtXml.child settings_xml "dl_settings") in - let settings_tab = new Page_settings.settings ~visible xml_settings dl_setting_callback ac_id icons_theme (fun group x -> strip#add_widget ~group x) in - - (** Connect key shortcuts *) - let key_press = fun ev -> - key_press_event settings_tab#keys (fun commit -> commit ()) ev in - ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press); - - let tab_label = GPack.hbox () in - let _label = (GMisc.label ~text:"Settings" ~packing:tab_label#pack ()) in - let button_save_settings = GButton.button ~packing:tab_label#pack () in - ignore (GMisc.image ~stock:`SAVE ~packing:button_save_settings#add ()); - button_save_settings#set_border_width 0; - ignore (button_save_settings#connect#clicked ~callback:(fun () -> settings_tab#save af_file)); - ignore (ac_notebook#append_page ~tab_label:tab_label#coerce settings_tab#widget); - Some settings_tab - with exc -> - log alert ac_id (Printexc.to_string exc); - None in - - let rc_settings_page = - try - let xml_settings = Xml.children (ExtXml.child settings_xml "rc_settings") in - if xml_settings = [] then - raise Exit - else - let settings_tab = new Pages.rc_settings ~visible xml_settings in - let tab_label = (GMisc.label ~text:"RC Settings" ())#coerce in - ignore (ac_notebook#append_page ~tab_label settings_tab#widget); - Some settings_tab - with _ -> None in - - let rc_max_rate = get_rc_max_rate af_xml in - - let wp_HOME = - let rec loop = function - [] -> None - | w::ws -> - let (_i, w) = fp#index w in - if w#name = "HOME" then Some w else loop ws in - loop fp#waypoints in - - let ac = { track = track; color = color; last_dist_to_wp = 0.; - fp_group = fp; fp_show = fp_show ; config = config ; - wp_HOME = wp_HOME; fp = fp_xml; - ac_name = name; ac_speech_name = speech_name; - blocks = blocks; last_ap_mode= ""; - last_stage = (-1,-1); - ir_page = ir_page; flight_time = 0; - gps_page = gps_page; - pfd_page = pfd_page; - link_page = link_page; - misc_page = misc_page; - dl_settings_page = dl_settings_page; - rc_settings_page = rc_settings_page; - strip = strip; first_pos = true; - rc_max_rate = rc_max_rate; - last_block_name = ""; alt = 0.; target_alt = 0.; - in_kill_mode = false; speed = 0.; - wind_dir = 42.; ground_prox = true; - wind_speed = 0.; - pages = ac_frame#coerce; - notebook_label = _label; - got_track_status_timer = 1000; - dl_values = [||]; last_unix_time = 0.; - airspeed = 0.; - version = ""; - last_gps_acc = GPS_NO_ACC; - last_bat_warn_time = 0.; - time_link_lost = Hashtbl.create 1 - } in - Hashtbl.add aircrafts ac_id ac; - select_ac acs_notebook ac_id; - - (** Periodically send the wind estimation through - a WIND_INFO message packed into a RAW_DATALINK *) - let send_wind = fun () -> - if misc_page#periodic_send then begin - (* FIXME: Disabling the timer would be preferable *) - try - let a = (pi/.2. -. ac.wind_dir) - and w = ac.wind_speed in - - let wind_east = sprintf "%.1f" (-. cos a *. w) - and wind_north = sprintf "%.1f" (-. sin a *. w) - and airspeed = sprintf "%.1f" ac.airspeed in - - (* only horizontal wind and airspeed are updated, so bitmask is 0b0000101 = 5 *) - let msg_items = ["WIND_INFO"; ac_id; "5"; wind_east; wind_north; "0.0"; airspeed] in - let value = String.concat ";" msg_items in - let vs = ["ac_id", PprzLink.String ac_id; "message", PprzLink.String value] in - Ground_Pprz.message_send "dl" "RAW_DATALINK" vs; - with - exc -> log alert ac_id (sprintf "send_wind (%s): %s" ac_id (Printexc.to_string exc)) - end; - true - in - - if is_int ac_id then - ignore (Glib.Timeout.add ~ms:10000 ~callback:send_wind); - - begin - match dl_settings_page with - Some settings_tab -> - (** Connect the strip buttons *) - let firmware = ExtXml.child af_xml "firmware" in - let firmware_name = ExtXml.attrib firmware "name" in - let connect = fun ?(warning=true) setting_name strip_connect -> - try - let id = settings_tab#assoc setting_name in - if setting_name = "kill_throttle" then - strip_connect (fun x -> (dl_setting_callback id x; dl_emergency_cmd ac_id 0)) - else - strip_connect (fun x -> dl_setting_callback id x) - with Not_found -> - if setting_name = "kill_throttle" then - strip_connect (fun x -> (if x = 1. then dl_emergency_cmd ac_id 0)); - if warning then - fprintf stderr "Warning: %s not setable from GCS strip (i.e. not listed in the xml settings file)\n" setting_name in - connect "flight_altitude" (fun f -> ac.strip#connect_shift_alt (fun x -> f (ac.target_alt+.x))); - connect "autopilot.launch" ~warning:false ac.strip#connect_launch; - connect "autopilot.kill_throttle" (ac.strip#connect_kill confirm_kill); - (* try to connect either pprz_mode (fixedwing) or autopilot_mode (rotorcraft) *) - begin match firmware_name with - | "fixedwing" -> connect "autopilot.mode" ~warning:false (ac.strip#connect_mode 2.) - | "rotorcraft" -> connect "autopilot.mode" ~warning:false (ac.strip#connect_mode 13.) - | _ -> () - end; - connect "nav_shift" ~warning:false ac.strip#connect_shift_lateral; - connect "autopilot.flight_time" ac.strip#connect_flight_time; - let get_ac_unix_time = fun () -> ac.last_unix_time in - connect ~warning:false "snav_desired_tow" (ac.strip#connect_apt get_ac_unix_time); - begin (* Periodically update the appointment *) - try - let id = settings_tab#assoc "snav_desired_tow" in - let set_appointment = fun _ -> - begin try - let v = match ac.dl_values.(id) with None -> raise Not_found | Some x -> int_of_string x in - let t = Unix.gmtime (Latlong.unix_time_of_tow v) in - ac.strip#set_label "apt" (sprintf "%d:%02d:%02d" t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec) - with _ -> () end; - true - in - ignore (Glib.Timeout.add ~ms:1000 ~callback:set_appointment) - with Not_found -> () - end; - - (** Connect the GPS reset button *) - begin - try - let gps_reset_id = settings_tab#assoc "gps.reset" in - gps_page#connect_reset - (fun x -> dl_setting_callback gps_reset_id (float x)) - with Not_found -> () - end - | None -> () - end; - - (* Monitor track status *) - let monitor_track_status = fun () -> - ac.got_track_status_timer <- ac.got_track_status_timer + 1; - if ac.got_track_status_timer > 5 then - ac.track#delete_desired_track (); - true in - ignore (Glib.Timeout.add ~ms:1000 ~callback:monitor_track_status);; - - -(* 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*) -let ok_color = "#00ff00" -let warning_color = "orange" -let alert_color = "red" - -(** Bind to message while catching all the esceptions of the callback *) -let safe_bind = fun msg cb -> - let safe_cb = fun sender vs -> - try cb sender vs with - AC_not_found -> () (* A/C not yet registed; silently ignore *) - | x -> fprintf stderr "%s: safe_bind (%s:%a): %s\n%!" Sys.argv.(0) msg (fun c vs -> List.iter (fun (_,v) -> fprintf c "%s " (PprzLink.string_of_value v)) vs) vs (Printexc.to_string x) in - ignore (Ground_Pprz.message_bind msg safe_cb) - -let alert_bind = fun msg cb -> - let safe_cb = fun sender vs -> - try cb sender vs with _ -> () in - ignore (Alert_Pprz.message_bind msg safe_cb) - -let tele_bind = fun msg cb timestamp -> - let safe_cb = fun sender vs -> - try cb sender vs with - AC_not_found -> () (* A/C not yet registed; silently ignore *) - | x -> fprintf stderr "tele_bind (%s): %s\n%!" msg (Printexc.to_string x) in - ignore (Tele_Pprz.message_bind ~timestamp msg safe_cb) - -let ask_config = fun confirm_kill alert geomap fp_notebook strips ac -> - let get_config = fun _sender values -> - if not (Hashtbl.mem aircrafts ac) then - create_ac ~confirm_kill alert geomap fp_notebook strips ac values - in - ignore(Ground_Pprz.message_req "gcs" "CONFIG" ["ac_id", PprzLink.String ac] get_config) - - - -let one_new_ac = fun confirm_kill alert (geomap:G.widget) fp_notebook strips ac -> - if (List.length !filter_acs = 0) || (List.mem ac !filter_acs) && not (Hashtbl.mem aircrafts ac) then - ask_config confirm_kill alert geomap fp_notebook strips ac - - -let get_wind_msg = fun (geomap:G.widget) _sender vs -> - let ac = get_ac vs in - let value = fun field_name -> PprzLink.float_assoc field_name vs in - let airspeed = value "mean_aspeed" in - ac.airspeed <- airspeed; - ac.strip#set_airspeed airspeed; - ac.misc_page#set_value "Mean airspeed" (sprintf "%.1f" airspeed); - ac.wind_speed <- value "wspeed"; - let deg_dir = value "dir" in - ac.wind_dir <- (Deg>>Rad)deg_dir; - ac.misc_page#set_value "Wind speed" (sprintf "%.1f" ac.wind_speed); - ac.misc_page#set_value "Wind direction" (sprintf "%.1f" deg_dir); - - let ac_id = PprzLink.string_assoc "ac_id" vs in - if !active_ac = ac_id && ac.wind_speed > 1. then begin - geomap#wind_sock#set_color ac.color; - geomap#wind_sock#item#show (); - geomap#set_wind_sock deg_dir (sprintf "%.1f" ac.wind_speed) - end - - -let get_fbw_msg = fun alarm _sender vs -> - let ac = get_ac vs in - let status = PprzLink.string_assoc "rc_status" vs - and rate = (float_of_int ((PprzLink.int_assoc "rc_rate" vs) * 10) ) /. ac.rc_max_rate in - (* divide by 5 to have normal values between 0 and 10 *) - (* RC rate max approx. 50 Hz *) - ac.strip#set_rc rate status; - let mode = PprzLink.string_assoc "rc_mode" vs in - if mode = "FAILSAFE" then begin - log_and_say alarm ac.ac_name (sprintf "%s, mayday, AP Failure. Switch to manual." ac.ac_speech_name) - end - -let get_telemetry_status = fun alarm _sender vs -> - let ac = get_ac vs in - let link_id = PprzLink.string_assoc "link_id" vs in - let link_id = try if int_of_string link_id = -1 then "single" else link_id with _ -> link_id in - let time_link_lost = PprzLink.float_assoc "time_since_last_msg" vs in - Hashtbl.replace ac.time_link_lost link_id time_link_lost; - if link_id <> "no_id" then - Hashtbl.remove ac.time_link_lost "no_id"; - let time_lost = Hashtbl.fold (fun link_id time best -> - if time < best then time else best - ) ac.time_link_lost 9999.0 in - (* Update link page *) - let rx_msgs_rate = PprzLink.float_assoc "rx_bytes_rate" vs - and downlink_bytes_rate = PprzLink.int_assoc "downlink_rate" vs - and uplink_lost_time = PprzLink.int_assoc "uplink_lost_time" vs in - let ping_time = PprzLink.float_assoc "ping_time" vs in - if (not (ac.link_page#link_exists link_id)) then begin - ac.link_page#add_link link_id; - log_and_say alarm ac.ac_name (sprintf "%s, link %s detected" ac.ac_speech_name link_id) - end; - let link_changed = ac.link_page#update_link link_id time_link_lost ping_time rx_msgs_rate downlink_bytes_rate uplink_lost_time in - (* Update color and lost time in the strip *) - let (links_up, total_links) = ac.link_page#links_ratio () in - let link_ratio_string = - if ac.link_page#multiple_links () then sprintf "%i/%i" links_up total_links else "" in - ac.strip#set_label "telemetry_status" (if time_lost > 2. then sprintf "%.0f" time_lost else link_ratio_string); - ac.strip#set_color "telemetry_status" (if time_lost > 5. then alert_color else if links_up < total_links then warning_color else ok_color); - match (link_changed, links_up) with - (_, 0) -> log_and_say alarm ac.ac_name (sprintf "%s, all links lost" ac.ac_speech_name) - | (Pages.Linkup, _)-> log_and_say alarm ac.ac_name (sprintf "%s, link %s re-connected" ac.ac_speech_name link_id) - | (Pages.Nochange, _) -> () - | (Pages.Linkdown, _) -> log_and_say alarm ac.ac_name (sprintf "%s, link %s lost" ac.ac_speech_name link_id) - -let get_engine_status_msg = fun _sender vs -> - let ac = get_ac vs in - ac.strip#set_throttle ~kill:ac.in_kill_mode (PprzLink.float_assoc "throttle" vs); - ac.strip#set_bat (PprzLink.float_assoc "bat" vs) - -let get_if_calib_msg = fun _sender vs -> - let ac = get_ac vs in - match ac.rc_settings_page with - None -> () - | Some p -> - p#set_rc_setting_mode (PprzLink.string_assoc "if_mode" vs); - p#set (PprzLink.float_assoc "if_value1" vs) (PprzLink.float_assoc "if_value2" vs) - -let listen_wind_msg = fun (geomap:G.widget) -> - safe_bind "WIND" (get_wind_msg geomap) - -let listen_fbw_msg = fun a -> - safe_bind "FLY_BY_WIRE" (get_fbw_msg a) - -let listen_engine_status_msg = fun () -> - safe_bind "ENGINE_STATUS" get_engine_status_msg - -let listen_if_calib_msg = fun () -> - safe_bind "INFLIGH_CALIB" get_if_calib_msg - -let listen_telemetry_status = fun a -> - safe_bind "TELEMETRY_STATUS" (get_telemetry_status a) - -let aircrafts_msg = fun confirm_kill alert (geomap:G.widget) fp_notebook strips acs -> - let acs = PprzLink.string_assoc "ac_list" acs in - let acs = Str.split list_separator acs in - List.iter (one_new_ac confirm_kill alert geomap fp_notebook strips) acs - - -let listen_dl_value = fun () -> - let get_dl_value = fun _sender vs -> - let ac = get_ac vs in - match ac.dl_settings_page with - Some settings -> - let csv = PprzLink.string_assoc "values" vs in - let string_value = fun v -> match v with "?" -> None | _ -> Some v in - let values = Array.map string_value (Array.of_list (Str.split list_separator csv)) in - ac.dl_values <- values; - for i = 0 to min (Array.length values) settings#length - 1 do - try - settings#set i values.(i) - with _ -> () - done - | None -> () in - safe_bind "DL_VALUES" get_dl_value - - -let highlight_fp = fun ac b s -> - if (b, s) <> ac.last_stage then begin - ac.last_stage <- (b, s); - ac.fp_group#highlight_stage b s - end - - -let ac_alt_graph = [14,0;-5,0;-7,-6] -let translate = fun l dx dy -> List.map (fun (x, y) -> (x + dx, y + dy)) l -let rotate_and_translate = fun l angle dx dy -> - translate (List.map (fun (x, y) -> ( - truncate ((cos angle) *. (float x) -. (sin angle) *. (float y)), - truncate ((sin angle) *. (float x) +. (cos angle) *. (float y))) - ) l) dx dy -let flip = fun l -> List.map (fun (x, y) -> (-x, y)) l - -let draw_altgraph = fun (da_object:Gtk_tools.pixmap_in_drawin_area) (geomap:MapCanvas.widget) aircrafts -> - (** First estimate the coverage of the window *) - let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window in - let (xc0, yc0) = geomap#canvas#get_scroll_offsets in - let (east, _y0) = geomap#window_to_world ~winx:(float xc0) ~winy:(float (yc0+height_c)) - and (west, _y1) = geomap#window_to_world ~winx:(float (xc0+width_c)) ~winy:(float yc0) in - - let da = da_object#drawing_area in - let width, height = Gdk.Drawable.get_size da#misc#window in - let dr = da_object#get_pixmap () in - dr#set_background `BLACK; - dr#set_foreground `BLACK; - - (* Background *) - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - - (* Text *) - let context = da#misc#create_pango_context in - let print_string = fun x y string color -> - let layout = context#create_layout in - let from_codeset = "ISO-8859-15" - and to_codeset = "UTF-8" in - Pango.Layout.set_text layout (Glib.Convert.convert ~from_codeset ~to_codeset string); - let (_w,h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x ~y:(y-h) ~fore:(`NAME color) layout in - - (* find min and max alt *) - let max_alt = ref 0 - and min_alt = ref 35786000 in - Hashtbl.iter (fun _ac_id ac -> - let track = ac.track in - let alt = (truncate track#last_altitude) in - let ground_alt = alt - (truncate (track#height ())) in - if ground_alt < !min_alt then min_alt := ground_alt; - if alt > !max_alt then max_alt := alt - ) aircrafts; - min_alt := min !min_alt !max_alt; - if (!min_alt mod lines_height) < (min 10 (lines_height / 2)) then - min_alt := (!min_alt / lines_height - 1) * lines_height - else - min_alt := (!min_alt / lines_height) * lines_height; - min_alt := max !min_alt 0; - let height_alt = max (!max_alt - !min_alt + 10) min_height in - - (* lines *) - dr#set_foreground (`NAME "grey"); - let n = height_alt / lines_height in - for i = 0 to n do - let y = height - i * height / n in - dr#line ~x:0 ~y ~x:width ~y; - print_string 6 y (sprintf "%d" (!min_alt + i * lines_height)) "red"; - done; - - (* aircrafts *) - Hashtbl.iter (fun _ac_id ac -> - dr#set_foreground (`NAME ac.color); - let track = ac.track in - match track#last with - Some pos -> - let (xac, _yac) = geomap#world_of pos in - let w = float width in - let eac = (truncate (w *. (xac -. east) /. (west -. east))) in - let alt = (truncate track#last_altitude) in - let aac = height - height * (alt - !min_alt) / height_alt in - let h = track#last_heading in - let climb_angle = ref 0. in - if track#last_speed > 0. then - climb_angle := (atan2 track#last_climb track#last_speed); - - dr#set_line_attributes ~width:4 ~cap:`ROUND (); - dr#set_foreground (`NAME "white"); - if h > 0. && h <= 180. then begin - dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); - dr#set_line_attributes ~width:2 (); - dr#set_foreground (`NAME ac.color); - dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); - end - else begin - dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); - dr#set_line_attributes ~width:2 (); - dr#set_foreground (`NAME ac.color); - dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); - end; - - (* altitude from ground if available *) - let alt_from_ground = truncate (track#height ()) in - let gac = aac + height * alt_from_ground / height_alt in - dr#set_line_attributes ~width:1 ~cap:`NOT_LAST (); - dr#line ~x:eac ~y:aac ~x:eac ~y:gac; - - (* history *) - let v_path = track#v_path in - for i = 0 to Array.length v_path - 1 do - let (x, _y) = geomap#world_of (fst v_path.(i)) in - let e = (truncate (w *. (x -. east) /. (west -. east))) in - let a = height - height * ((truncate (snd v_path.(i))) - !min_alt) / height_alt in - dr#point ~x:e ~y:a; - done - | None -> () - ) aircrafts; - - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - - -(****** Display the position provided by a connected GPS receiver (../tmtc/gpsd2ivy) *******************) -module GCS_icon = struct - let status = ref None - let color = "black" - let fill_color = "brown" - let radius = 5. - let outdated_color = "red" - let timeout = 10000 (* ms : time before changing to outdated color *) - - let display = fun (geomap:G.widget) vs -> - let lat = PprzLink.float_assoc "lat" vs - and lon = PprzLink.float_assoc "long" vs in - let wgs84 = LL.make_geo_deg lat lon in - - let item = - match !status with - None -> (* First call, create the graphical object *) - let item = GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 2] - ~x1: ~-.radius ~y1: ~-.radius ~x2:radius ~y2:radius - geomap#canvas#root in - (* connect callback on zoom change *) - ignore(geomap#zoom_adj#connect#value_changed ~callback:(fun () -> - match !status with - | None -> () - | Some (item, _, wgs84) -> geomap#move_item ~z:geomap#current_zoom item wgs84 - )); - item - | Some (item, timeout_handle, _) -> (* Remove the timeouted color modification *) - Glib.Timeout.remove timeout_handle; - item in - - item#set [`OUTLINE_COLOR color]; - let change_color_if_not_updated = - Glib.Timeout.add ~ms:10000 ~callback:(fun () -> item#set [`OUTLINE_COLOR outdated_color]; false) in - - (* Store the object, the position and the timeout to change its color *) - status := Some (item, change_color_if_not_updated, wgs84); - - geomap#move_item ~z:geomap#current_zoom item wgs84 -end (* module GCS_icon *) - - -(******************************** FLIGHT_PARAMS ******************************) -let listen_flight_params = fun geomap auto_center_new_ac auto_center_ac alert alt_graph -> - let get_fp = fun _sender vs -> - let ac_id = PprzLink.string_assoc "ac_id" vs in - if ac_id = gcs_id then - GCS_icon.display geomap vs - else - let ac = get_ac vs in - let pfd_page = ac.pfd_page in - let a = fun s -> PprzLink.float_assoc s vs in - let alt = a "alt" - and climb = a "climb" - and speed = a "speed" in - pfd_page#set_attitude (a "roll") (a "pitch"); - pfd_page#set_alt alt; - pfd_page#set_climb climb; - pfd_page#set_speed speed; - - let wgs84 = { posn_lat=(Deg>>Rad)(a "lat"); posn_long = (Deg>>Rad)(a "long") } in - ac.track#move_icon wgs84 (a "heading") alt speed climb; - ac.speed <- speed; - - let unix_time = a "unix_time" in - if unix_time > ac.last_unix_time then begin - let utc = Unix.gmtime unix_time in - geomap#set_utc_time utc.Unix.tm_hour utc.Unix.tm_min utc.Unix.tm_sec; - ac.last_unix_time <- unix_time - end; - - if auto_center_new_ac && ac.first_pos then begin - center geomap ac.track (); - ac.first_pos <- false - end; - if auto_center_ac = ac_id then begin - center geomap ac.track (); - end; - - let set_label = fun lbl_name value -> - ac.strip#set_label lbl_name (sprintf "%.0fm" value) - in - set_label "altitude" alt; - ac.strip#set_speed speed; - ac.strip#set_climb climb; - let agl = (a "agl") in - ac.alt <- alt; - ac.strip#set_agl agl; - if not ac.ground_prox && ac.flight_time > 10 && agl < 20. then begin - log_and_say alert ac.ac_name (sprintf "%s, %s" ac.ac_speech_name "Ground Proximity Warning"); - ac.ground_prox <- true - end else if agl > 25. then - ac.ground_prox <- false; - try - if not (alt_graph#drawing_area#misc#parent = None) then - draw_altgraph alt_graph geomap aircrafts - with _ -> () - - in - safe_bind "FLIGHT_PARAM" get_fp; - - let get_ns = fun _sender vs -> - let ac = get_ac vs in - let a = fun s -> PprzLink.float_assoc s vs in - let wgs84 = { posn_lat = (Deg>>Rad)(a "target_lat"); posn_long = (Deg>>Rad)(a "target_long") } in - ac.track#move_carrot wgs84; - let cur_block = PprzLink.int_assoc "cur_block" vs - and cur_stage = PprzLink.int_assoc "cur_stage" vs in - highlight_fp ac cur_block cur_stage; - let set_label = fun l f -> - ac.strip#set_label l (sprintf "%.0fm" (PprzLink.float_assoc f vs)) in - set_label "target_altitude" "target_alt"; - let target_alt = PprzLink.float_assoc "target_alt" vs in - ac.strip#set_label "diff_target_alt" (sprintf "%+.0fm" (ac.alt -. target_alt)); - ac.target_alt <- target_alt; - let b = try List.assoc cur_block ac.blocks with Not_found -> failwith (sprintf "Error: unknown block %d for A/C %s" cur_block ac.ac_name) in - if b <> ac.last_block_name then begin - log_and_say alert ac.ac_name (sprintf "%s, %s" ac.ac_speech_name b); - ac.last_block_name <- b; - ac.strip#set_label "block_name" b - end; - let block_time = Int64.to_int (PprzLink.uint32_assoc "block_time" vs) - and stage_time = Int64.to_int (PprzLink.uint32_assoc "stage_time" vs) in - let bt = sprintf "%02d:%02d" (block_time / 60) (block_time mod 60) in - ac.strip#set_label "block_time" bt; - let st = sprintf "%02d:%02d" (stage_time / 60) (stage_time mod 60) in - ac.strip#set_label "stage_time" st; - - (* Estimated Time Arrival to next waypoint *) - let d = PprzLink.float_assoc "dist_to_wp" vs in - let label = - if d < 0.5 || ac.speed < 0.5 then - "N/A" - else - sprintf "%.0fs" (d /. ac.speed) in - ac.strip#set_label "eta_time" label; - ac.last_dist_to_wp <- d; - - (* Estimated Time to HOME *) - try - match ac.wp_HOME with - Some wp_HOME -> - let (bearing_to_HOME_deg, d) = Latlong.bearing ac.track#pos wp_HOME#pos in - let bearing_to_HOME = (Deg>>Rad)bearing_to_HOME_deg in - let wind_north = -. ac.wind_speed *. cos ac.wind_dir - and wind_east = -. ac.wind_speed *. sin ac.wind_dir in - let c = ac.wind_speed *. ac.wind_speed -. ac.airspeed *. ac.airspeed - and scal = wind_east *. sin bearing_to_HOME +. wind_north *. cos bearing_to_HOME in - let delta = 4. *. (scal*.scal -. c) in - let ground_speed_to_HOME = scal +. sqrt delta /. 2. in - let time_to_HOME = d /. ground_speed_to_HOME in - ac.misc_page#set_value "Time to HOME" (sprintf "%.0fs" time_to_HOME) - | _ -> () - with - _NotSoImportant -> () - in - safe_bind "NAV_STATUS" get_ns; - - let get_cam_status = fun _sender vs -> - let ac = get_ac vs in - let a = fun s -> PprzLink.float_assoc s vs in - let lats_str = PprzLink.string_assoc "lats" vs in - let longs_str = PprzLink.string_assoc "longs" vs in - - let lats = List.map float_of_string (Str.split list_separator lats_str) in - let longs = List.map float_of_string (Str.split list_separator longs_str) in - - let target_wgs84 = { posn_lat = (Deg>>Rad)(a "cam_target_lat"); posn_long = (Deg>>Rad)(a "cam_target_long") } in - - let geo_1 = { posn_lat = (Deg>>Rad)(List.nth lats 0); posn_long = (Deg>>Rad)(List.nth longs 0) } - and geo_2 = { posn_lat = (Deg>>Rad)(List.nth lats 1); posn_long = (Deg>>Rad)(List.nth longs 1) } - and geo_3 = { posn_lat = (Deg>>Rad)(List.nth lats 2); posn_long = (Deg>>Rad)(List.nth longs 2) } - and geo_4 = { posn_lat = (Deg>>Rad)(List.nth lats 3); posn_long = (Deg>>Rad)(List.nth longs 3) } in - - ac.track#move_cam [|geo_1; geo_2; geo_3; geo_4|] target_wgs84 - in - safe_bind "CAM_STATUS" get_cam_status; - - let get_circle_status = fun _sender vs -> - let ac = get_ac vs in - ac.got_track_status_timer <- 0; - let a = fun s -> PprzLink.float_assoc s vs in - let wgs84 = { posn_lat = (Deg>>Rad)(a "circle_lat"); posn_long = (Deg>>Rad)(a "circle_long") } in - ac.track#draw_circle wgs84 (float_of_string (PprzLink.string_assoc "radius" vs)) - in - safe_bind "CIRCLE_STATUS" get_circle_status; - - let get_segment_status = fun _sender vs -> - let ac = get_ac vs in - ac.got_track_status_timer <- 0; - let a = fun s -> PprzLink.float_assoc s vs in - let geo1 = { posn_lat = (Deg>>Rad)(a "segment1_lat"); posn_long = (Deg>>Rad)(a "segment1_long") } - and geo2 = { posn_lat = (Deg>>Rad)(a "segment2_lat"); posn_long = (Deg>>Rad)(a "segment2_long") } in - ac.track#draw_segment geo1 geo2; - in - safe_bind "SEGMENT_STATUS" get_segment_status; - - - let get_survey_status = fun _sender vs -> - let ac = get_ac vs in - let a = fun s -> PprzLink.float_assoc s vs in - let geo1 = { posn_lat = (Deg>>Rad)(a "south_lat"); posn_long = (Deg>>Rad)(a "west_long") } - and geo2 = { posn_lat = (Deg>>Rad)(a "north_lat"); posn_long = (Deg>>Rad)(a "east_long") } in - ac.track#draw_zone geo1 geo2 - in - safe_bind "SURVEY_STATUS" get_survey_status; - - - let get_ap_status = fun _sender vs -> - let ac = get_ac vs in - let flight_time = Int64.to_int (PprzLink.uint32_assoc "flight_time" vs) in - ac.track#update_ap_status (float_of_int flight_time); - ac.flight_time <- flight_time; - let ap_mode = PprzLink.string_assoc "ap_mode" vs in - if ap_mode <> ac.last_ap_mode then begin - log_and_say alert ac.ac_name (sprintf "%s, %s" ac.ac_speech_name ap_mode); - ac.last_ap_mode <- ap_mode; - let label = PprzLink.string_assoc "ap_mode" vs in - ac.strip#set_label "AP" (if label="MANUAL" then "MANU" else label); - let color = - match ap_mode with - "AUTO2" | "NAV" -> ok_color - | "AUTO1" | "R_RCC" | "A_RCC" | "ATT_C" | "R_ZH" | "A_ZH" | "HOVER" | "HOV_C" | "H_ZH" | "MODULE" -> "#10F0E0" - | "MANUAL" | "RATE" | "ATT" | "RC_D" | "CF" | "FWD" | "FLIP" | "GUIDED" -> warning_color - | _ -> alert_color in - ac.strip#set_color "AP" color; - end; - let status_filter_mode = PprzLink.string_assoc "state_filter_mode" vs in - let gps_mode = - if (status_filter_mode <> "UNKNOWN") && (status_filter_mode <> "OK") && (status_filter_mode <> "GPS_LOST") - then status_filter_mode - else PprzLink.string_assoc "gps_mode" vs in - ac.strip#set_label "GPS" gps_mode; - ac.strip#set_color "GPS" (if gps_mode<>"3D" && gps_mode<>"DGPS" && gps_mode<>"RTK" then alert_color else ok_color); - let ft = - sprintf "%02d:%02d:%02d" (flight_time / 3600) ((flight_time / 60) mod 60) (flight_time mod 60) in - ac.strip#set_label "flight_time" ft; - let kill_mode = PprzLink.string_assoc "kill_mode" vs in - if kill_mode <> "OFF" then begin - if not ac.in_kill_mode then - log_and_say alert ac.ac_name (sprintf "%s, mayday, kill mode" ac.ac_speech_name); - ac.in_kill_mode <- true - end else - ac.in_kill_mode <- false; - match ac.rc_settings_page with - None -> () - | Some p -> - p#set_rc_mode ap_mode - in - safe_bind "AP_STATUS" get_ap_status; - - listen_dl_value ();; - -let listen_waypoint_moved = fun () -> - let get_values = fun _sender vs -> - let ac = get_ac vs in - let wp_id = PprzLink.int_assoc "wp_id" vs in - let a = fun s -> PprzLink.float_assoc s vs in - let geo = { posn_lat = (Deg>>Rad)(a "lat"); posn_long = (Deg>>Rad)(a "long") } - and altitude = a "alt" - and ground_alt = a "ground_alt" in - - try - let w = ac.fp_group#get_wp wp_id in - w#set_ground_alt ground_alt; - w#set ~altitude ~update:true geo; - ac.fp_group#update_sectors w#name - with - Not_found -> () (* Silently ignore unknown waypoints *) - in - safe_bind "WAYPOINT_MOVED" get_values - -let get_alert_bat_low = fun a _sender vs -> - let ac = get_ac vs in - let level = PprzLink.string_assoc "level" vs in - let unix_time = Unix.gettimeofday() in - if unix_time > (ac.last_bat_warn_time +. 10.) then begin - log_and_say a ac.ac_name (sprintf "%s, %s %s" ac.ac_speech_name "BAT LOW" level); - ac.last_bat_warn_time <- unix_time - end - -let listen_alert = fun a -> - alert_bind "BAT_LOW" (get_alert_bat_low a) - -let get_svsinfo = fun alarm _sender vs -> - let ac = get_ac vs in - let gps_page = ac.gps_page in - let svids = Str.split list_separator (PprzLink.string_assoc "svid" vs) - and cn0s = Str.split list_separator (PprzLink.string_assoc "cno" vs) - and flagss = Str.split list_separator (PprzLink.string_assoc "flags" vs) - and ages = Str.split list_separator (PprzLink.string_assoc "msg_age" vs) in - - let a = Array.make (List.length svids) (0,0,0,0) in - let rec loop = fun i s c f ages -> - match (s, c, f, ages) with - [], [], [], [] -> () - | s::ss, c::cs, f::fs, age::ages -> - a.(i) <- (int_of_string s, int_of_string c, int_of_string f, int_of_string age); - loop (i+1) ss cs fs ages - | _ -> assert false in - loop 0 svids cn0s flagss ages; - - let pacc = PprzLink.int_assoc "pacc" vs in - - gps_page#svsinfo pacc a; - - let new_acc = - if pacc <= 1000 then GPS_ACC_HIGH - else if pacc > 1000 && pacc < 2000 then GPS_ACC_LOW - else if pacc > 999 then GPS_NO_ACC else GPS_ACC_VERY_LOW in - if ac.last_gps_acc <> new_acc then begin - match new_acc, ac.last_gps_acc with - | GPS_ACC_HIGH, GPS_NO_ACC -> () (* nothing if pacc is good from the start *) - | GPS_ACC_HIGH, _ -> log_and_say alarm "gcs" (sprintf "%s, GPS accuracy better than 10 meter" ac.ac_speech_name) - | GPS_ACC_LOW, _ -> log_and_say alarm "gcs" (sprintf "%s, low GPS accuracy" ac.ac_speech_name) - | GPS_ACC_VERY_LOW, _ -> log_and_say alarm "gcs" (sprintf "%s, Warning: GPS accuracy worse than 20 meter" ac.ac_speech_name) - | _, _ -> () - end; - ac.last_gps_acc <- new_acc - -let listen_svsinfo = fun a -> safe_bind "SVSINFO" (get_svsinfo a) - -let message_request = Ground_Pprz.message_req - -let mark_dcshot = fun (geomap:G.widget) _sender vs -> - let ac = find_ac !active_ac in - let photonumber = PprzLink.string_assoc "photo_nr" vs in - try - let lat = PprzLink.int_assoc "lat" vs - and lon = PprzLink.int_assoc "lon" vs in - let wgs84 = LL.make_geo_deg (float lat /. 1e7) (float lon /. 1e7) in - let group = geomap#background in - let point = geomap#photoprojection ~group ~fill_color:"yellow" ~number:photonumber wgs84 3. in - point#raise_to_top () - with _ -> - match ac.track#last with - Some geo -> - begin - let group = geomap#background in - let point = geomap#photoprojection ~group ~fill_color:"yellow" ~number:photonumber geo 3. in - point#raise_to_top () - end - | None -> () - -(* mark geomap ac.ac_name track !Plugin.frame *) - - -let listen_dcshot = fun _geom timestamp -> - tele_bind "DC_SHOT" (mark_dcshot _geom) timestamp - -let listen_error = fun a -> - let get_error = fun _sender vs -> - let msg = PprzLink.string_assoc "message" vs in - log_and_say a "gcs" msg in - safe_bind "TELEMETRY_ERROR" get_error - -let listen_info_msg = fun a timestamp -> - let get_msg = fun a _sender vs -> - let ac = find_ac _sender in - let msg_array = PprzLink.assoc "msg" vs in - log_and_say a ac.ac_name (PprzLink.string_of_value msg_array) in - tele_bind "INFO_MSG" (get_msg a) timestamp - -let listen_autopilot_version_msg = fun a timestamp -> - let get_msg = fun a _sender vs -> - let ac = find_ac _sender in - let desc_array = PprzLink.assoc "desc" vs in - let version = PprzLink.string_of_value desc_array in - if ac.version <> version then - log a ac.ac_name (sprintf "%s version:\n%s" ac.ac_name version); - ac.version <- version in - tele_bind "AUTOPILOT_VERSION" (get_msg a) timestamp - -let listen_tcas = fun a timestamp -> - let get_alarm_tcas = fun a txt _sender vs -> - let ac = find_ac _sender in - let other_ac = get_ac vs in - let resolve = try - match PprzLink.int_assoc "resolve" vs with - 1 -> "=> LEVEL" - | 2 -> "=> CLIMB" - | 3 -> "=> DESCEND" - | _ -> "" - with _ -> "" in - log_and_say a ac.ac_name (sprintf "%s : %s -> %s %s" txt ac.ac_speech_name other_ac.ac_speech_name resolve) - in - tele_bind "TCAS_TA" (get_alarm_tcas a "tcas TA") timestamp; - tele_bind "TCAS_RA" (get_alarm_tcas a "TCAS RA") timestamp - -let get_intruders = fun (geomap:G.widget) _sender vs -> - let f = fun s -> PprzLink.float_assoc s vs in - let i = fun s -> float (PprzLink.int_assoc s vs) in - let name = PprzLink.string_assoc "name" vs - and id = PprzLink.string_assoc "id" vs - and time = Unix.gettimeofday () - and lat = (i "lat") /. 1e7 - and lon = (i "lon") /. 1e7 in - let pos = { posn_lat=(Deg>>Rad)lat; posn_long=(Deg>>Rad)lon } in - if not (Intruders.intruder_exist id) then - Intruders.new_intruder id name time geomap; - Intruders.update_intruder id pos (f "course") ((i "alt") /. 1000.) (f "speed") (f "climb") time - -let listen_intruders = fun (geomap:G.widget) -> - safe_bind "INTRUDER" (get_intruders geomap) - -open Shapes - -let get_shapes = fun (geomap:G.widget)_sender vs -> - let f = fun s -> PprzLink.float_assoc s vs in - let i = fun s -> PprzLink.int_assoc s vs in - let st = fun s -> PprzLink.string_assoc s vs in - let string_to_scaled_float = fun v -> (float (int_of_string v))/. 1e7 in - let floatarr = fun s -> Array.map string_to_scaled_float (Array.of_list (Str.split list_separator (st s))) in - let data = { - shid = i "id"; - shlinecolor = st "linecolor"; - shfillcolor = st "fillcolor"; - shopacity = i "opacity"; - shtype = int2shtype (i "shape"); - shstatus = int2shstatus (i "status"); - shlatarr = floatarr "latarr"; - shlonarr = floatarr "lonarr"; - shradius = f "radius"; - shtext = st "text"} in - new_shmsg data geomap - -let listen_shapes = fun (geomap:G.widget) -> - safe_bind "SHAPE" (get_shapes geomap) - -let listen_acs_and_msgs = fun geomap ac_notebook strips confirm_kill my_alert auto_center_new_ac auto_center_ac alt_graph timestamp -> - (** Probe live A/Cs *) - let probe = fun () -> - ignore(message_request "gcs" "AIRCRAFTS" [] (fun _sender vs -> _req_aircrafts := false; aircrafts_msg confirm_kill my_alert geomap ac_notebook strips vs)) in - let _ = GMain.Timeout.add ~ms:1000 ~callback:(fun () -> probe (); !_req_aircrafts) in - - (** New aircraft message *) - safe_bind "NEW_AIRCRAFT" (fun _sender vs -> one_new_ac confirm_kill my_alert geomap ac_notebook strips (PprzLink.string_assoc "ac_id" vs)); - - (** Listen for all messages on ivy *) - listen_flight_params geomap auto_center_new_ac auto_center_ac my_alert alt_graph; - listen_wind_msg geomap; - listen_fbw_msg my_alert; - listen_engine_status_msg (); - listen_telemetry_status my_alert; - listen_if_calib_msg (); - listen_waypoint_moved (); - listen_svsinfo my_alert; - listen_alert my_alert; - listen_error my_alert; - listen_info_msg my_alert timestamp; - listen_autopilot_version_msg my_alert timestamp; - listen_tcas my_alert timestamp; - listen_dcshot geomap timestamp; - listen_intruders geomap; - listen_shapes geomap; - - (** Select the active aircraft on notebook page selection *) - let callback = fun i -> - let ac_page = ac_notebook#get_nth_page i in - Hashtbl.iter - (fun ac_id ac -> - if ac.pages#get_oid = ac_page#get_oid - then select_ac ac_notebook ac_id) - aircrafts in - ignore (ac_notebook#connect#switch_page ~callback); - - (** Center the active aircraft *) - let center_active = fun () -> - if !active_ac <> "" then - let ac = find_ac !active_ac in - center geomap ac.track () in - let key_press = fun ev -> - match GdkEvent.Key.keyval ev with - | k when (k = GdkKeysyms._c) || (k = GdkKeysyms._C) -> center_active () ; true - | _ -> false in - ignore (geomap#canvas#event#connect#after#key_press ~callback:key_press); - - (* call periodic_handle_intruders every second *) - ignore (Glib.Timeout.add ~ms:1000 ~callback:(fun () -> Intruders.remove_old_intruders (); true)); diff --git a/sw/ground_segment/cockpit/live.mli b/sw/ground_segment/cockpit/live.mli deleted file mode 100644 index 8e4c87ae7b..0000000000 --- a/sw/ground_segment/cockpit/live.mli +++ /dev/null @@ -1,93 +0,0 @@ -(* -* Real time handling of flying A/Cs -* -* Copyright (C) 2004-2006 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. -* -*) - - -type color = string -type gps_acc_level = GPS_ACC_HIGH | GPS_ACC_LOW | GPS_ACC_VERY_LOW | GPS_NO_ACC - -type aircraft = private { - ac_name : string; - ac_speech_name : string; - config : PprzLink.values; - track : MapTrack.track; - color: color; - fp_group : MapFP.flight_plan; - fp_show : GMenu.check_menu_item; - wp_HOME : MapWaypoints.waypoint option; - fp : Xml.xml; - blocks : (int * string) list; - mutable last_ap_mode : string; - mutable last_stage : int * int; - ir_page : Pages.infrared; - gps_page : Pages.gps; - pfd_page : Horizon.pfd; - link_page : Pages.link; - misc_page : Pages.misc; - dl_settings_page : Page_settings.settings option; - rc_settings_page : Pages.rc_settings option; - pages : GObj.widget; - notebook_label : GMisc.label; - strip : Strip.t; - rc_max_rate : float; - mutable first_pos : bool; - mutable last_block_name : string; - mutable in_kill_mode : bool; - mutable speed : float; - mutable alt : float; - mutable target_alt : float; - mutable flight_time : int; - mutable wind_speed : float; - mutable wind_dir : float; (* Rad *) - mutable ground_prox : bool; - mutable got_track_status_timer : int; - mutable last_dist_to_wp : float; - mutable dl_values : string option array; - mutable last_unix_time : float; - mutable airspeed : float; - mutable version : string; - mutable last_gps_acc : gps_acc_level; - mutable last_bat_warn_time : float; - time_link_lost: (string, float) Hashtbl.t - } - -val aircrafts : (string, aircraft) Hashtbl.t - -val safe_bind : string -> (string -> PprzLink.values -> unit) -> unit - -val track_size : int ref -(** Default length for A/C tracks on the 2D view *) - -val auto_hide_fp : bool -> unit -(** Automatically hide flight plan of not selected ac *) - -val listen_acs_and_msgs : MapCanvas.widget -> GPack.notebook -> GPack.box -> bool -> Pages.alert -> bool -> string -> Gtk_tools.pixmap_in_drawin_area -> bool -> unit -(** [listen_acs_and_msgs geomap aircraft_notebook confirm_kill alert_page auto_center_new_ac alt_graph timestamp] *) - -val jump_to_block : string -> int -> unit -(** [jump_to_block ac_id block_id] Sends a JUMP_TO_BLOCK message *) - -val dl_setting : string -> int -> float -> unit -(** [dl_setting ac_id var_index value] Sends a DL_SETTING message *) - -val filter_ac_ids: string -> unit diff --git a/sw/ground_segment/cockpit/map2d.ml b/sw/ground_segment/cockpit/map2d.ml deleted file mode 100644 index 7dbc287597..0000000000 --- a/sw/ground_segment/cockpit/map2d.ml +++ /dev/null @@ -1,28 +0,0 @@ -(* - * Copyright (C) 2004-2006 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. - * - *) - -let set_georef_if_none = fun geomap wgs84 -> - match geomap#georef with - None -> - geomap#set_georef wgs84; - geomap#center wgs84 - | Some _ -> () diff --git a/sw/ground_segment/cockpit/map2d.mli b/sw/ground_segment/cockpit/map2d.mli deleted file mode 100644 index a76ef806b8..0000000000 --- a/sw/ground_segment/cockpit/map2d.mli +++ /dev/null @@ -1,23 +0,0 @@ -(* -* Copyright (C) 2004-2006 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. -* -*) - -val set_georef_if_none : MapCanvas.widget -> Latlong.geographic -> unit diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml deleted file mode 100644 index c635c1fd35..0000000000 --- a/sw/ground_segment/cockpit/page_settings.ml +++ /dev/null @@ -1,369 +0,0 @@ -(* - * Widget to pack settings buttons - * - * Copyright (C) 2004-2009 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 - - -class setting = fun (i:int) (xml:Xml.xml) (current_value:GMisc.label) set_default -> -object - method index = i - method xml = xml - val mutable last_known_value = None - method last_known_value = - match last_known_value with - | None -> raise Not_found - | Some v -> - let auc = PprzLink.alt_unit_coef_of_xml xml in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - (v -. alt_b) /. alt_a - method current_value = - let auc = PprzLink.alt_unit_coef_of_xml xml in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - (float_of_string current_value#text -. alt_b) /. alt_a - method update = fun s -> - (* if not yet confirmed, display "?" *) - if s = "?" then - current_value#set_text "?" - else - if current_value#text <> s then begin - current_value#set_text s; - try - let v = float_of_string s in - last_known_value <- Some v; - set_default v - with Failure _ -> () - end -end - -let pipe_regexp = Str.regexp "|" -let values_of_dl_setting = fun dl_setting -> - try - Array.of_list (Str.split pipe_regexp (Xml.attrib dl_setting "values")) - with - _ -> [||] - - -(* Look for the index of a value in a array. May raise Not_found *) -let search_index = fun value array -> - let i = ref 0 in - while !i < Array.length array && value <> array.(!i) do incr i done; - if !i < Array.length array then !i else raise Not_found - - -let add_key = fun xml do_change keys -> - let key, modifiers = GtkData.AccelGroup.parse (Env.key_modifiers_of_string (Xml.attrib xml "key")) - and value = ExtXml.float_attrib xml "value" in - keys := (key, (modifiers, fun () -> do_change value)) :: !keys - - - -let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_setting (tooltips:GData.tooltips) icons_theme strip keys -> - let f = fun a -> float_of_string (ExtXml.attrib dl_setting a) in - let lower = f "min" - and upper = f "max" - and step_incr = - try f "step" with _ -> - fprintf stderr "Warning: 'step' attribute missing in '%s' setting. Default to 1\n%!" (Xml.to_string dl_setting); - 1. - in - (* get number of digits after decimal dot *) - let digits = try String.length (ExtXml.attrib dl_setting "step") - String.index (ExtXml.attrib dl_setting "step") '.' - 1 with _ -> 0 in - let page_incr = step_incr - and page_size = step_incr - and show_auto = try ExtXml.attrib dl_setting "auto" = "true" with _ -> false in - let auc = PprzLink.alt_unit_coef_of_xml dl_setting in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - - let hbox = GPack.hbox ~packing () in - let varname = ExtXml.attrib dl_setting "var" in - let text = try ExtXml.attrib dl_setting "shortname" with _ -> varname in - let _l = GMisc.label ~width:100 ~text ~packing:hbox#pack () in - let eb = GBin.event_box ~packing:hbox#pack () in - let current_value = GMisc.label ~width:80 ~text:"N/A" ~packing:eb#add () in - - let auto_but = GButton.check_button ~label:"Auto" ~active:false () in - - (** Either choose type of widged explicitly by 'widget' attribute: - Allowed attribute values: "radio_button", "combo_box", "slider", "spin_button" - For a small number of values, radio buttons, - For a large number of values, combo box, - For float values with range up to 2^16, slider - else spin button. - *) - let values = values_of_dl_setting dl_setting - and modified = ref false in - let widget_attrib = try ExtXml.attrib dl_setting "widget" with _ -> "auto" in - let widget_t = - if Str.string_match (Str.regexp_case_fold "radio.*") widget_attrib 0 then - "radio_button" - else if Str.string_match (Str.regexp_case_fold "combo.*") widget_attrib 0 then - "combo_box" - else if Str.string_match (Str.regexp_case_fold "slider.*") widget_attrib 0 then - "slider" - else if Str.string_match (Str.regexp_case_fold "spin.*") widget_attrib 0 then - "spin_button" - else (* auto *) - if step_incr = 1. && upper -. lower <= 2. || Array.length values > 0 then - if Array.length values > 2 then (* Combo box *) - "combo_box" - else (* radio buttons *) - "radio_button" - else (* no values given, slider or spin button *) - let range = upper -. lower in - if range > 65536. then (* spin button *) - "spin_button" - else - "slider" - in - let commit, set_default = - if widget_t = "radio_button" || widget_t = "combo_box" then - (* Discrete values *) - let value = ref lower in - let callback = fun () -> do_change i !value in - let update_value = fun index -> - modified := true; - value := float index; - if auto_but#active then callback () in - if widget_t = "combo_box" then (* Combo box *) - let strings = Array.to_list values in - let combo = Gtk_tools.combo strings hbox in - - let update_string = fun string -> - try - update_value ((search_index string values) + truncate lower) - with - Not_found -> failwith (sprintf "Internal error: Settings, %s not found" string) in - Gtk_tools.combo_connect combo update_string; - - (callback, fun j -> try Gtk_tools.select_in_combo combo values.(truncate j) with _ -> ()) - else (* radio buttons *) - let ilower = truncate lower - and iupper = truncate upper in - let callback = fun _ -> do_change i !value in - let group = (GButton.radio_button ())#group in (* Group shared by the buttons *) - let buttons = Array.init (iupper-ilower+1) - (fun j -> - (* Build the button *) - let label = - if Array.length values = 0 - then Printf.sprintf "%d" (ilower + j) - else values.(j) in - let b = GButton.radio_button ~group ~label ~packing:hbox#add () in - - (* Connect the event *) - ignore (b#connect#pressed ~callback:(fun () -> update_value (ilower + j))); - b) in - (callback, fun j -> try buttons.(truncate j - ilower)#set_active true with _ -> ()) - else (* no values given, slider or spin button *) - let value = (lower +. upper) /. 2. in - if widget_t = "spin_button" then - let adj = GData.adjustment ~value ~lower ~upper:(upper+.step_incr) ~step_incr ~page_incr ~page_size:0. () in - let _spinbutton = GEdit.spin_button ~adjustment:adj ~digits ~numeric:true ~packing:hbox#add () in - let f = fun _ -> do_change i ((adj#value-.alt_b)/.alt_a) in - let callback = fun () -> modified := true; if auto_but#active then f () in - ignore (adj#connect#value_changed ~callback); - ignore (auto_but#connect#toggled ~callback); - (f, fun x -> try adj#set_value x with _ -> ()) - else - let adj = GData.adjustment ~value ~lower ~upper:(upper+.step_incr) ~step_incr ~page_incr ~page_size () in - let _scale = GRange.scale `HORIZONTAL ~digits ~update_policy:`DELAYED ~adjustment:adj ~packing:hbox#add () in - let f = fun _ -> do_change i ((adj#value-.alt_b)/.alt_a) in - let callback = fun () -> modified := true; if auto_but#active then f () in - ignore (adj#connect#value_changed ~callback); - ignore (auto_but#connect#toggled ~callback); - (f, fun x -> try adj#set_value x with _ -> ()) - in - let set_default = fun x -> - if not !modified then set_default x else () in - - (* build setting *) - let setting = new setting i dl_setting current_value set_default in - - (* click current_value label to request an update, a value of infinity for do_change requests new value *) - let callback = fun _ -> - do_change i infinity; - current_value#set_text "?"; - true in - ignore (eb#event#connect#button_press ~callback); - - (* Auto check button *) - if show_auto then begin - hbox#pack auto_but#coerce - end; - (* Apply button *) - let prev_value = ref None in - let commit_but = GButton.button ~packing:hbox#pack () in - commit_but#set_border_width 2; - let _icon = GMisc.image ~stock:`APPLY ~packing:commit_but#add () in - let idx = ref 0 in - let callback = fun x -> - prev_value := (try Some setting#last_known_value with _ -> - idx := -1; - Array.iteri (fun i v -> if current_value#text = v then idx := i) values; - if !idx >= 0 then Some (lower +. (float_of_int !idx)) else None); - commit x; - current_value#set_text "?" - in - ignore (commit_but#connect#clicked ~callback); - tooltips#set_tip commit_but#coerce ~text:"Commit"; - tooltips#set_tip current_value#coerce ~text:"Current value, click to request update."; - tooltips#set_tip _l#coerce ~text:text; - - (* Undo button *) - let undo_but = GButton.button ~packing:hbox#pack () in - let _icon = GMisc.image ~stock:`UNDO ~packing:undo_but#add () in - let callback = fun _ -> - match !prev_value with - None -> () - | Some v -> current_value#set_text "?"; do_change i v in - ignore (undo_but#connect#clicked ~callback); - tooltips#set_tip undo_but#coerce ~text:"Undo"; - - ignore (auto_but#connect#toggled - ~callback:(fun () -> - commit_but#misc#set_sensitive (not auto_but#active); - undo_but#misc#set_sensitive (not auto_but#active))); - - (** Insert the related buttons in the strip and prepare the papgets DnD *) - List.iter (fun x -> - match String.lowercase_ascii (Xml.tag x) with - "strip_button" -> - let label = ExtXml.attrib x "name" - and sp_value = ExtXml.float_attrib x "value" - and group = ExtXml.attrib_or_default x "group" "" in - let b = - try (* Is it an icon ? *) - let icon = Xml.attrib x "icon" in - let b = GButton.button () in - let pixbuf = GdkPixbuf.from_file (Env.get_gcs_icon_path icons_theme icon) in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); - - (* Drag for Drop *) - let papget = Papget_common.xml "variable_setting" "button" - ["variable", varname; - "value", ExtXml.attrib x "value"; - "ac_id", ac_id; - "icon", icons_theme // icon] in - Papget_common.dnd_source b#coerce papget; - - (* Associates the label as a tooltip *) - tooltips#set_tip b#coerce ~text:label; - b - with - Xml.No_attribute "icon" -> GButton.button ~label () - | exc -> - prerr_endline (Printexc.to_string exc); - GButton.button ~label () in - (strip group b#coerce: unit); - ignore (b#connect#clicked ~callback:(fun _ -> do_change i sp_value)) - | "key_press" -> add_key x (do_change i) keys - | t -> failwith (sprintf "Page_settings.one_setting, Unexpected tag: '%s'" t)) - (Xml.children dl_setting); - - (* return setting *) - setting - - - -let same_tag_for_all = function - [] -> failwith "Page_settings: unreachable, empty dl_settings element" - | x::xs -> - let tag_first = Xml.tag x in - List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs; - String.lowercase_ascii tag_first - - -(** Build the tree of settings *) -let rec build_settings = fun do_change ac_id i flat_list keys xml_settings packing tooltips icons_theme strip -> - match same_tag_for_all xml_settings with - "dl_setting" -> - List.iter - (fun dl_setting -> - let label_value = one_setting !i do_change ac_id packing dl_setting tooltips icons_theme strip keys in - flat_list := label_value :: !flat_list; - incr i) - xml_settings - | "dl_settings" -> - let n = GPack.notebook ~packing ~scrollable:true () in - - List.iter (fun dl_settings -> - let text = ExtXml.attrib dl_settings "name" in - let _sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let vbox = GPack.vbox () in - - let tab_label = (GMisc.label ~text ())#coerce in - ignore (n#append_page ~tab_label vbox#coerce); - - let children = Xml.children dl_settings in - build_settings do_change ac_id i flat_list keys children vbox#pack tooltips icons_theme strip) - xml_settings - | tag -> failwith (sprintf "Page_settings.build_settings, unexpected tag '%s'" tag) - - -class settings = fun ?(visible = fun _ -> true) xml_settings do_change ac_id icons_theme strip -> - let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let vbox = GPack.vbox ~packing:sw#add_with_viewport () in - let tooltips = GData.tooltips () in - let i = ref 0 and l = ref [] and keys = ref [] in - let ordered_list = - build_settings do_change ac_id i l keys xml_settings vbox#add tooltips icons_theme strip; - List.rev !l in - let variables = Array.of_list ordered_list in - let length = Array.length variables in - let assocs = - List.map (fun setting -> (ExtXml.attrib setting#xml "var", setting#index)) ordered_list in -object (self) - method widget = sw#coerce - method length = length - method keys = !keys - method set = fun i value -> - if visible self#widget then - let setting = variables.(i) in - let s, v = match value with - | None -> "?", -1 - | Some x -> - let v = try float_of_string x with _ -> failwith (sprintf "Pages.settings#set:wrong values.(%d) = %s" i x) in - let auc = PprzLink.alt_unit_coef_of_xml setting#xml in - let (alt_a, alt_b) = Ocaml_tools.affine_transform auc in - let v = alt_a *. v +. alt_b in - string_of_float v, truncate v - in - if i < 0 || i >= Array.length variables then - failwith (sprintf "Pages.settings#set: %d out of bounnds (length=%d)" i (Array.length variables)); - let s = - let values = values_of_dl_setting setting#xml in - try - let lower = int_of_string (ExtXml.attrib setting#xml "min") in - values.(v - lower) - with - _ -> s in - setting#update s - method assoc var = List.assoc var assocs - method save = fun airframe_filename -> - let settings = Array.fold_right (fun setting r -> try (setting#index, setting#xml, setting#last_known_value)::r with _ -> r) variables [] in - SaveSettings.popup airframe_filename (Array.of_list settings) do_change -end diff --git a/sw/ground_segment/cockpit/page_settings.mli b/sw/ground_segment/cockpit/page_settings.mli deleted file mode 100644 index 4f8d5d0550..0000000000 --- a/sw/ground_segment/cockpit/page_settings.mli +++ /dev/null @@ -1,37 +0,0 @@ -(* -* Widget to pack settings buttons -* -* Copyright (C) 2004-2009 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. -* -*) - -(** [new Page_settings.settings ?visible dl_settings callback short_button_receiver] *) -class settings : ?visible:(GObj.widget -> bool) -> Xml.xml list -> (int -> float -> unit) -> string -> string -> (string -> GObj.widget -> unit) -> - object - method length : int (** Total number of settings *) - method set : int -> string option -> unit (** Set the current value *) - method assoc : string -> int - method widget : GObj.widget - method save : string -> unit - (** [save airframe_filename] *) - method keys : (Gdk.keysym * (Gdk.Tags.modifier list * (unit -> unit))) list - (** (key, (modifiers, action)) list *) - end - diff --git a/sw/ground_segment/cockpit/pages.ml b/sw/ground_segment/cockpit/pages.ml deleted file mode 100644 index 46bc694fae..0000000000 --- a/sw/ground_segment/cockpit/pages.ml +++ /dev/null @@ -1,409 +0,0 @@ -(* - * Copyright (C) 2006 ENAC, Pierre-Sélim Huard, 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. - * - *) - -(*****************************************************************************) -(* Information pages such as alert, infrared, gps, artificial horizon *) -(*****************************************************************************) - -let (//) = Filename.concat - -open Latlong -open Printf - -(** alert page *) -class alert (widget: GBin.frame) = - let scrolled = GBin.scrolled_window - ~hpolicy: `AUTOMATIC - ~vpolicy: `AUTOMATIC - ~packing: widget#add - () - in - let view = GText.view ~editable:false ~packing: scrolled#add () in - (* the object itselft *) -object - val mutable last = "" - method add text = - if text <> last then begin - (* end of the buffer, so we don't insert in the middle if cursor was placed there *) - let end_iter = view#buffer#end_iter in - - let l = Unix.localtime (Unix.gettimeofday ()) in - view#buffer#insert ~iter:end_iter (sprintf "%02d:%02d:%02d " l.Unix.tm_hour l.Unix.tm_min l.Unix.tm_sec); - view#buffer#insert ~iter:end_iter text; - view#buffer#insert ~iter:end_iter "\n"; - - (* Scroll to the bottom line *) - let end_mark = view#buffer#create_mark end_iter in - view#scroll_mark_onscreen (`MARK end_mark); - - last <- text - end -end - -(*****************************************************************************) -(* infrared page *) -(*****************************************************************************) -class infrared (widget: GBin.frame) = - let table = GPack.table - ~rows: 4 - ~columns: 2 - ~row_spacings: 5 - ~col_spacings: 5 - ~packing: widget#add - () - in - let contrast_status = - GMisc.label ~text: "" ~packing: (table#attach ~top:0 ~left: 1) () - in - let contrast_value = - GMisc.label ~text: "" ~packing: (table#attach ~top:1 ~left: 1) () - in - let gps_hybrid_mode = - GMisc.label ~text: "" ~packing: (table#attach ~top:2 ~left: 1) () - in - let gps_hybrid_factor = - GMisc.label ~text: "" ~packing: (table#attach ~top:3 ~left: 1) () - in - let _init = - ignore (GMisc.label ~text: "contrast status" ~packing: (table#attach ~top:0 ~left: 0) ()); - ignore (GMisc.label ~text: "contrast" ~packing: (table#attach ~top:1 ~left: 0) ()); - ignore (GMisc.label ~text: "gps hybrid mode" ~packing: (table#attach ~top:2 ~left: 0) ()); - ignore (GMisc.label ~text: "gps hybrid factor" ~packing: (table#attach ~top:3 ~left: 0) ()) - in -object - val parent = widget - val table = table - - val contrast_status = contrast_status - val contrast_value = contrast_value - val gps_hybrid_mode = gps_hybrid_mode - val gps_hybrid_factor = gps_hybrid_factor - - method set_contrast_status (s:string) = - contrast_status#set_label s - method set_contrast_value (s:int) = - contrast_value#set_label (Printf.sprintf "%d" s) - method set_gps_hybrid_mode (s:string) = - gps_hybrid_mode#set_label s - method set_gps_hybrid_factor (s:float) = - gps_hybrid_factor#set_label (Printf.sprintf "%.8f" s) -end - -(*****************************************************************************) -(* gps page *) -(*****************************************************************************) -class gps ?(visible = fun _ -> true) (widget: GBin.frame) = - let vbox = GPack.vbox ~packing:widget#add () in - - let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:vbox#add () in - - let da_object = new Gtk_tools.pixmap_in_drawin_area ~packing:sw#add_with_viewport () in - - (* Reset buttons *) - let hbox = GPack.hbox ~packing:vbox#pack ~show:false () in - let _ = GMisc.label ~text:"Reset: " ~packing:hbox#add () in - let hot = GButton.button ~label:"Hostart" ~packing:hbox#add () in - let warm = GButton.button ~label:"Warmstart" ~packing:hbox#add () in - let cold = GButton.button ~label:"Coldstart" ~packing:hbox#add () in - -object - val mutable active_cno = [] - val mutable active_flags = [] - - method connect_reset = fun (callback:int -> unit) -> - hbox#misc#show (); - ignore (hot#connect#clicked ~callback:(fun () -> callback 0)); - ignore (warm#connect#clicked ~callback:(fun () -> callback 1)); - ignore (cold#connect#clicked ~callback:(fun () -> callback 2)) - - method svsinfo pacc a = - if visible widget then - let da = da_object#drawing_area in - let {Gtk.width=width; height=height} = da#misc#allocation in - - (* Background *) - let dr = da_object#get_pixmap () in - dr#set_foreground (`NAME "white"); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - - let context = da#misc#create_pango_context in - context#set_font_by_name ("sans " ^ string_of_int 10); - let layout = context#create_layout in - - let n = Array.length a in - let sep_size = 3 in - let indic_size = min 25 ((width-(n+1)*sep_size)/n) in - let max_cn0 = 50 in - - Pango.Layout.set_text layout "Dummy"; - let (_, h) = Pango.Layout.get_pixel_size layout in - - let size = fun cn0 -> (max 20 cn0 - 20) * 2 in - - let y = sep_size + h + (size max_cn0) in - for i = 0 to n - 1 do - let (id, cn0, flags, age) = a.(i) in - if age < 60 then - let x = sep_size + i * (sep_size+indic_size) in - - (* level *) - Pango.Layout.set_text layout (sprintf "% 2d" cn0); - dr#put_layout ~x ~y:0 ~fore:`BLACK layout; - - (* bar *) - let color = if age > 5 then "grey" else if flags land 0x01 = 1 then "#00ff00" else "red" in - dr#set_foreground (`NAME color); - let height = size cn0 in - dr#rectangle ~filled:true ~x ~y:(y-height) ~width:indic_size ~height (); - (* SV id *) - Pango.Layout.set_text layout (sprintf "% 2d" id); - dr#put_layout ~x ~y ~fore:`BLACK layout - done; - - (* Pacc *) - let max_pacc = 2000 in - dr#set_foreground (`NAME "red"); - let w = min width ((pacc*width)/max_pacc) in - dr#rectangle ~filled:true ~x:0 ~y:(y+h) ~width:w ~height:h (); - Pango.Layout.set_text layout (if pacc = 0 then "Pos accuracy: N/A" else sprintf "Pos accuracy: %.1fm" (float pacc/.100.)); - let (_, h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:((width-w)/2) ~y:(y+h) ~fore:`BLACK layout; - - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap -end - -(*****************************************************************************) -(* Misc page *) -(*****************************************************************************) -let misc_fields = [|"Wind speed"; "Wind direction"; "Mean airspeed"; "Time to HOME"; "Send periodically"|] -let index_of = fun label -> - let rec search = fun i -> - if i < Array.length misc_fields then - if misc_fields.(i) = label then i else search (i+1) - else - failwith (sprintf "Unknown label in Misc.index_of: %s" label) - in - search 0 - -class misc ~packing (widget: GBin.frame) = - let rows = Array.length misc_fields in - let table = GPack.table ~rows ~columns:2 ~row_spacings:5 ~col_spacings:40 ~packing () in - let label = fun text i j -> GMisc.label ~text ~packing:(table#attach ~top:i ~left:j) () in - let values = - Array.init rows (fun i -> - ignore (label misc_fields.(i) i 0); - label "N/A" i 1) in - (* Overwrite the "Send periodically" value with a check box *) - let periodic_send = - let top = index_of "Send periodically" in - values.(top)#destroy (); - GButton.check_button ~active:true ~packing:(table#attach ~top ~left:1) () in -object - method set_value label s = values.(index_of label)#set_text s - method periodic_send = periodic_send#active -end - -type rc_mode = string -type rc_setting_mode = string - -let rc_setting_index = function -"gain_1_up" -> 0, 0 - | "gain_1_down" -> 1, 0 - | "gain_2_up" -> 0, 1 - | "gain_2_down" -> 1, 1 - | x -> failwith (sprintf "Unknown rc_setting: %s" x) - -let rc_mode_index = function -"AUTO1" -> 0 | "AUTO2" -> 1 - | _x -> -1 - -let rc_setting_mode_index = function -"UP" -> 0 | "DOWN" -> 1 - | _x -> -1 - -let one_rc_mode = fun (table:GPack.table) rc_mode -> - let i = rc_mode_index (ExtXml.attrib rc_mode "name") in - List.iter (fun rc_setting -> - let name = ExtXml.attrib rc_setting "rc" - and text = ExtXml.attrib rc_setting "var" in - let (j, k) = rc_setting_index name in - ignore (GMisc.label ~text ~packing:(table#attach ~top:(1+2*j+k) ~left:(1+2*i)) ()) - ) - (Xml.children rc_mode) - - -class rc_settings = fun ?(visible = fun _ -> true) xmls -> - let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let table = GPack.table ~rows:5 ~columns:5 ~row_spacings:8 ~packing:sw#add_with_viewport () in - let auto1 = GBin.event_box ~packing:(table#attach ~top:0 ~left:1 ~right:3) () in - let _ = GMisc.label ~text:"AUTO1" ~packing:auto1#add () in - let auto2 = GBin.event_box ~packing:(table#attach ~top:0 ~left:3 ~right:5) () in - let _ = GMisc.label ~text:"AUTO2" ~packing:auto2#add () in - let up = GBin.event_box ~packing:(table#attach ~top:1 ~bottom:3 ~left:0) () in - let _ = GMisc.label ~text:"UP" ~packing:up#add () in - let down = GBin.event_box ~packing:(table#attach ~top:3 ~bottom:5 ~left:0) () in - let _ = GMisc.label ~text:"DOWN" ~packing:down#add () in - let update_bg = fun ev active -> - ev#coerce#misc#modify_bg [`NORMAL, `NAME (if active then "#00ff00" else "white")] in - (* first index is auto1/auto2, second is up/down, third is value 1/2 *) - let values = Array.init 2 (fun i -> Array.init 2 (fun j -> Array.init 2 (fun k -> GMisc.label ~text:" N/A " ~packing:(table#attach ~top:(1+j*2+k) ~left:(2+i*2)) ()))) in - - let _ = List.iter (one_rc_mode table) xmls in - - object (self) - val mutable rc_mode = "N/A" - val mutable rc_setting_mode = "N/A" - method set_rc_mode m = - rc_mode <- m; - update_bg auto1 (m="AUTO1"); - update_bg auto2 (m="AUTO2") - - method set_rc_setting_mode m = - rc_setting_mode <- m; - update_bg up (m="UP"); - update_bg down (m="DOWN") - - method widget = sw#coerce - method set = fun v1 v2 -> - if visible self#widget then - let i = rc_mode_index rc_mode - and j = rc_setting_mode_index rc_setting_mode in - if i >= 0 && j >= 0 then - let s1 = string_of_float v1 in - let s2 = string_of_float v2 in - - values.(i).(j).(0)#set_text s1; - values.(i).(j).(1)#set_text s2 - end - -(*****************************************************************************) -(* link page *) -(*****************************************************************************) -type link_change = Linkup | Nochange | Linkdown - -class link ?(visible = fun _ -> true) (widget: GBin.frame) = - let scrolled = GBin.scrolled_window - ~hpolicy: `AUTOMATIC - ~vpolicy: `AUTOMATIC - ~packing: widget#add - () - in - let table = GPack.table ~rows:1 ~columns:1 ~row_spacings:5 ~col_spacings:10 ~packing:scrolled#add_with_viewport () in - let _init = - ignore (GMisc.label ~text: "Link id:" ~justify: `RIGHT ~packing: (table#attach ~top:0 ~left: 0) ()); - ignore (GMisc.label ~text: "Status:" ~justify: `RIGHT ~packing: (table#attach ~top:1 ~left: 0) ()); - ignore (GMisc.label ~text: "Ping time [ms]:" ~justify: `RIGHT ~packing: (table#attach ~top:2 ~left: 0) ()); - ignore (GMisc.label ~text: "Link Rx [Byte/s]:" ~justify: `RIGHT ~packing: (table#attach ~top:3 ~left: 0) ()); - ignore (GMisc.label ~text: "Downlink [Byte/s]:" ~justify: `RIGHT ~packing: (table#attach ~top:4 ~left: 0) ()); - ignore (GMisc.label ~text: "Uplink lost [s]:" ~justify: `RIGHT ~packing: (table#attach ~top:5 ~left: 0) ()); - in - object - val table = table - val mutable links = [] (* Stores the GUI elements that need to be updated and whether the link is connected or not*) - val mutable links_up = 0 (* Stores the number of links that are connected*) - - method link_exists link_id = List.mem_assoc link_id links - - method add_link link_id = - (* replace the no_id link if needed *) - if List.mem_assoc "no_id" links - then begin - let (_, link_id_label, dummy1, dummy2, dummy3, dummy4, dummy5, dummy6) = List.assoc "no_id" links in - link_id_label#set_text (sprintf "%s" link_id); - links <- (link_id, (true, link_id_label, dummy1, dummy2, dummy3, dummy4, dummy5, dummy6)) :: (List.remove_assoc "no_id" links) - end - else begin - let number_of_links = List.length links in - let link_id_label = GMisc.label ~text: (sprintf "%s" link_id) ~packing: (table#attach ~top:0 ~left: (number_of_links+1) ) () in - let link_status_eventbox = GBin.event_box ~width: 50 ~packing: (table#attach ~top:1 ~left: (number_of_links+1) ) () in - let link_status_label = GMisc.label ~text: " " ~packing: link_status_eventbox#add () in - let ping_time_label = GMisc.label ~text: " " ~packing: (table#attach ~top:2 ~left: (number_of_links+1) ) () in - let rx_bytes_rate_label = GMisc.label ~text: " " ~packing: (table#attach ~top:3 ~left: (number_of_links+1) ) () in - let downlink_bytes_rate_label = GMisc.label ~text: " " ~packing: (table#attach ~top:4 ~left: (number_of_links+1) ) () in - let uplink_lost_label = GMisc.label ~text: " " ~packing: (table#attach ~top:5 ~left: (number_of_links+1) ) () in - let up = true in - ignore (links <- (link_id, (up, link_id_label, link_status_eventbox, link_status_label, ping_time_label, rx_bytes_rate_label, downlink_bytes_rate_label, uplink_lost_label)) :: links); - links_up <- links_up + 1; - end - - - method update_link link_id time_since_last_msg ping_time rx_bytes_rate downlink_bytes_rate uplink_lost_time = - let (up, link_id_label, link_status_event_box, link_status_label, ping_time_label, rx_bytes_rate_label, downlink_bytes_rate_label, uplink_lost_label) = List.assoc link_id links in - begin - if visible widget then begin (* display only if page is visible *) - let link_status_string = sprintf "%.0f" time_since_last_msg in - if link_status_label#text <> link_status_string then (* Updating the link status light*) - begin - link_status_label#set_label (if time_since_last_msg > 2. then link_status_string else " "); - let color = (if time_since_last_msg > 5. then "red" else if uplink_lost_time > 10 then "orange" else "#00ff00") in - link_status_event_box#coerce#misc#modify_bg [`NORMAL, `NAME color]; - end; - - let ping_time_string = sprintf "%.1f" ping_time in - if ping_time_label#text <> ping_time_string then (* Updating the ping_time field*) - ping_time_label#set_label ping_time_string; - - let rx_bytes_rate_string = sprintf "%.1f" rx_bytes_rate in - if rx_bytes_rate_label#text <> rx_bytes_rate_string then (* Updating the rx_bytes_rate field*) - rx_bytes_rate_label#set_label rx_bytes_rate_string; - - let downlink_bytes_rate_string = sprintf "%d" downlink_bytes_rate in - if downlink_bytes_rate_label#text <> downlink_bytes_rate_string then (* Updating the downlink_bytes_rate field*) - downlink_bytes_rate_label#set_label downlink_bytes_rate_string; - - let uplink_lost_string = sprintf "%d" uplink_lost_time in - if uplink_lost_label#text <> uplink_lost_string then (* Updating the uplink_lost_time field*) - uplink_lost_label#set_label uplink_lost_string; - - () - end; - - let update_list = fun list_to_update up -> - let (_, id_label, dummy1, dummy2, dummy3, dummy4, dummy5, dummy6) = List.assoc link_id list_to_update in - (link_id, (up, id_label, dummy1, dummy2, dummy3, dummy4, dummy5, dummy6)) :: List.remove_assoc link_id list_to_update in - if up then (* Updating the stored value of whether this link is connected or not*) - if time_since_last_msg > 5. then - begin - links <- update_list links false; - links_up <- links_up -1; - Linkdown; - end - else - Nochange - else - if time_since_last_msg < 5. then - begin - links <- update_list links true; - links_up <- links_up + 1; - Linkup - end - else - Nochange - end - - method links_ratio () = - (links_up, List.length links) - - method multiple_links () = - (List.length links) > 1 - - end;; diff --git a/sw/ground_segment/cockpit/pages.mli b/sw/ground_segment/cockpit/pages.mli deleted file mode 100644 index 63f72d9f52..0000000000 --- a/sw/ground_segment/cockpit/pages.mli +++ /dev/null @@ -1,73 +0,0 @@ -(* -* Widgets of the aircraft notebook -* -* Copyright (C) 2004-2006 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. -* -*) - -class alert : GBin.frame -> - object - method add : string -> unit - end - -class infrared : GBin.frame -> - object - method set_contrast_status : string -> unit - method set_contrast_value : int -> unit - method set_gps_hybrid_factor : float -> unit - method set_gps_hybrid_mode : string -> unit - end - -class gps : ?visible:(GBin.frame -> bool) -> GBin.frame -> - object - method svsinfo : int -> (int*int*int*int) array -> unit - method connect_reset : (int -> unit) -> unit - end - -class misc : - packing:(GObj.widget -> unit) -> - GBin.frame -> - object - method set_value : string -> string -> unit - method periodic_send : bool - end - -type rc_mode = string -type rc_setting_mode = string -class rc_settings : - ?visible:(GObj.widget -> bool) -> - Xml.xml list -> - object - method set : float -> float -> unit - method set_rc_mode : rc_mode -> unit - method set_rc_setting_mode : rc_setting_mode -> unit - method widget : GObj.widget - end - -type link_change = Linkup | Nochange | Linkdown -class link : ?visible:(GBin.frame -> bool) -> GBin.frame -> - object - method link_exists : string -> bool - method add_link : string -> unit - method update_link : string -> float -> float -> float -> int -> int -> link_change - method links_ratio : unit -> (int * int) - method multiple_links : unit -> bool - end - diff --git a/sw/ground_segment/cockpit/papgets.ml b/sw/ground_segment/cockpit/papgets.ml deleted file mode 100644 index 2a520e274f..0000000000 --- a/sw/ground_segment/cockpit/papgets.ml +++ /dev/null @@ -1,245 +0,0 @@ -(* - * Handling papgets in the geomap canvas - * - * Copyright (C) 2008 ENAC - * - * 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 PC = Papget_common - -let filter_acid = fun save conf -> - let filtered = List.filter (fun x -> - (* keep element if save is true or save is false and attrib name is not ac_id *) - if (ExtXml.attrib_or_default x "name" "" = "ac_id") && (not save) then false - else true) (Xml.children conf) in - Xml.Element (Xml.tag conf, Xml.attribs conf, filtered) - -let papgets = Hashtbl.create 5 -let register_papget = fun p -> Hashtbl.add papgets p p -let dump_store = fun save_id -> - Hashtbl.fold - (fun _ p r -> - if not p#deleted then - (filter_acid save_id (p#config ()))::r - else - r) - papgets - [] - -let has_papgets = fun () -> - (Hashtbl.fold (fun _ p n -> if p#deleted then n else n + 1) papgets 0) > 0 - -let papget_listener = - let sep = Str.regexp "[:\\.]" in - fun papget -> - try - let field = Papget_common.get_property "field" papget in - let sender = try Some (Papget_common.get_property "ac_id" papget) with _ -> None in - match Str.split sep field with - [msg_name; field_name] -> - (new Papget.message_field ?sender msg_name field_name) - | _ -> failwith (sprintf "Unexpected field spec: %s" field) - with - _ -> failwith (sprintf "field attr expected in '%s" (Xml.to_string papget)) - - -let block_name_of_index = function -[ i ] -> - let i = sprintf "%.0f" (float_of_string i) in - if Hashtbl.length Live.aircrafts = 1 then - Hashtbl.fold - (fun ac_id ac _r -> - let blocks = ExtXml.child ac.Live.fp "blocks" in - let block = ExtXml.child blocks i in - ExtXml.attrib block "name") - Live.aircrafts - "N/A" - else - "N/A" - | _ -> failwith "Papgets.block_name_of_index" - -let extra_functions = - ["BlockName", block_name_of_index ] - - -let expression_listener = fun papget -> - let expr = Papget_common.get_property "expr" papget in - let expr = Expr_lexer.parse expr in - let sender = try Some (Papget_common.get_property "ac_id" papget) with _ -> None in - new Papget.expression ~extra_functions ?sender expr - - - -let display_float_papget = fun canvas_group config display x y listener -> - let renderer = - match display with - "text" -> - (new Papget_renderer.canvas_text ~config canvas_group x y :> Papget_renderer.t) - | "ruler" -> - (new Papget_renderer.canvas_ruler canvas_group ~config x y :> Papget_renderer.t) - | "gauge" -> - (new Papget_renderer.canvas_gauge ~config canvas_group x y :> Papget_renderer.t) - | "led" -> - (new Papget_renderer.canvas_led ~config canvas_group x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - - let p = new Papget.canvas_display_float_item ~config listener renderer in - let p = (p :> Papget.item) in - register_papget p - - - -let locked = fun config -> - try - [PC.property "locked" (PC.get_property "locked" config)] - with _ -> [] - -let ac_id_prop = fun config -> - try - [PC.property "ac_id" (PC.get_property "ac_id" config)] - with _ -> [] - -let create = fun canvas_group zoom_adj papget -> - try - let type_ = ExtXml.attrib papget "type" - and display = ExtXml.attrib papget "display" - and x = ExtXml.float_attrib papget "x" - and y = ExtXml.float_attrib papget "y" - and config = Xml.children papget in - match type_ with - "expression" -> - let expr_listener = expression_listener papget in - display_float_papget canvas_group config display x y expr_listener - - | "message_field" -> - let msg_listener = papget_listener papget in - display_float_papget canvas_group config display x y msg_listener - - | "goto_block" -> - let renderer = - match display with - "button" -> - (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - let block_name = Papget_common.get_property "block_name" papget in - let clicked = fun () -> - let jump_to_block = fun ac_id ac -> - let blocks = ExtXml.child ac.Live.fp "blocks" in - let block = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = block_name) blocks "block" in - let block_id = ExtXml.int_attrib block "no" in - Live.jump_to_block ac_id block_id - in - let sender = try Some (Papget_common.get_property "ac_id" papget) with _ -> None in - match sender with - Some ac_id -> begin try jump_to_block ac_id (Hashtbl.find Live.aircrafts ac_id) with _ -> () end - | None -> - prerr_endline "Warning: goto_block papget sends to all active A/C"; - Hashtbl.iter jump_to_block Live.aircrafts - in - let properties = - [ Papget_common.property "block_name" block_name ] @ locked papget @ ac_id_prop papget in - - let p = new Papget.canvas_goto_block_item properties clicked renderer in - let p = (p :> Papget.item) in - register_papget p - | "variable_setting" -> - let renderer = - match display with - "button" -> - (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - - let varname = Papget_common.get_property "variable" papget - and value = float_of_string (Papget_common.get_property "value" papget) in - - let clicked = fun () -> - let send_setting = fun ac_id ac -> - match ac.Live.dl_settings_page with - None -> () - | Some settings -> - let var_id = settings#assoc varname in - Live.dl_setting ac_id var_id value - in - let sender = try Some (Papget_common.get_property "ac_id" papget) with _ -> None in - match sender with - Some ac_id -> begin try send_setting ac_id (Hashtbl.find Live.aircrafts ac_id) with _ -> () end - | None -> - prerr_endline "Warning: variable_setting papget sending to all active A/C"; - Hashtbl.iter send_setting Live.aircrafts - in - let properties = - [ Papget_common.property "variable" varname; - Papget_common.float_property "value" value ] - @ locked papget @ ac_id_prop papget in - let p = new Papget.canvas_variable_setting_item properties clicked renderer in - let p = (p :> Papget.item) in - register_papget p - - | "video_plugin" -> - let renderer = - match display with - "mplayer" -> - (new Papget_renderer.canvas_mplayer canvas_group ~config x y :> Papget_renderer.t) - | "plugin" -> - (new Papget_renderer.canvas_plugin canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - - let properties = locked papget in - let p = new Papget.canvas_video_plugin_item properties renderer zoom_adj in - let p = (p :> Papget.item) in - register_papget p - - | _ -> failwith (sprintf "Unexpected papget type: %s" type_) - with - exc -> fprintf stderr "Papgets.create: %s\n%!" (Printexc.to_string exc) - - -exception Parse_message_dnd of string -(* Drag and drop handler for papgets *) -let parse_message_dnd = - let sep = Str.regexp ":" in - fun s -> - match Str.split sep s with - [s; c; m; f;scale] -> (s, c, m, f,scale) - | _ -> raise (Parse_message_dnd (Printf.sprintf "parse_dnd: %s" s)) -let dnd_data_received = fun canvas_group zoom_adj _context ~x ~y data ~info ~time -> - try (* With the format sent by Messages *) - let (sender, _class_name, msg_name, field_name,scale) = parse_message_dnd data#data in - let attrs = - [ "type", "message_field"; - "display", "text"; - "x", sprintf "%d" x; "y", sprintf "%d" y ] - and props = - [ Papget_common.property "field" (sprintf "%s:%s" msg_name field_name); - Papget_common.property "ac_id" sender; - Papget_common.property "scale" scale ] in - let papget_xml = Xml.Element ("papget", attrs, props) in - create canvas_group zoom_adj papget_xml - with - Parse_message_dnd _ -> - try (* XML spec *) - let xml = Xml.parse_string data#data in - (* Add x and y attributes *) - let attrs = Xml.attribs xml @ ["x", string_of_int x; "y", string_of_int y] in - let papget_xml = Xml.Element (Xml.tag xml,attrs,Xml.children xml) in - create canvas_group zoom_adj papget_xml - with - exc -> prerr_endline (Printexc.to_string exc) diff --git a/sw/ground_segment/cockpit/papgets.mli b/sw/ground_segment/cockpit/papgets.mli deleted file mode 100644 index 4640181b52..0000000000 --- a/sw/ground_segment/cockpit/papgets.mli +++ /dev/null @@ -1,30 +0,0 @@ -(* -* Handling papgets in the geomap canvas -* -* Copyright (C) 2008 ENAC -* -* 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. -* -*) - -val dump_store : bool -> Xml.xml list -val has_papgets : unit -> bool -val create : #GnoCanvas.group -> GData.adjustment -> Xml.xml -> unit -val dnd_data_received : - #GnoCanvas.group -> GData.adjustment -> - 'a -> x:int -> y:int -> < data : string; .. > -> info:'b -> time:'c -> unit diff --git a/sw/ground_segment/cockpit/particules.ml b/sw/ground_segment/cockpit/particules.ml deleted file mode 100644 index da79bffb94..0000000000 --- a/sw/ground_segment/cockpit/particules.ml +++ /dev/null @@ -1,55 +0,0 @@ -open Printf -open Latlong - -(* 255 -> red, 0 -> blue *) -let color_name = fun x -> - let x = if x < 0 then 0 else if x > 255 then 255 else x in - sprintf "#%02x%02x%02x" x 0 (255-x) - - -let fos = float_of_string -let ios = int_of_string - -let particules = (Hashtbl.create 97: (int, GnomeCanvas.re_p GnoCanvas.item) Hashtbl.t) - -let move_particule = fun (geomap:MapCanvas.widget) id geo value -> - let fill_color = color_name value in - if geomap#georef <> None then - try - let item = Hashtbl.find particules id in - geomap#move_item item geo; - item#set [`FILL_COLOR fill_color] - with - Not_found -> - let group = geomap#background in - let p = GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 1; `OUTLINE_COLOR "black"] ~x1:(-3.) ~y1:(-3.) ~x2:3. ~y2:3. group in - (* geomap#circle ~group ~fill_color:"red" geo 10. in *) - p#raise_to_top (); - Hashtbl.add particules id (p:>GnomeCanvas.re_p GnoCanvas.item) - -let list_separator = Str.regexp "," - - - -let listen = fun (geomap:MapCanvas.widget) -> - let plumes_msg = fun _sender vs -> - let split_val = fun tag -> Str.split list_separator (PprzLink.string_assoc tag vs) in - let ids = split_val "ids" - and xs = split_val "lats" - and ys = split_val "longs" - and vs = split_val "values" in - - let rec loop = fun ids xs ys vs -> - match ids, xs, ys, vs with - [], [], [], [] -> () - | id::ids, x::xs, y::ys, v::vs -> - let id = int_of_string id - and wgs84 = {posn_lat=(Deg>>Rad)(fos x); posn_long=(Deg>>Rad)(fos y)} in - move_particule geomap id wgs84 (ios v); - loop ids xs ys vs - | _ -> failwith "Particules.listen loop" - in - loop ids xs ys vs - in - - Live.safe_bind "PLUMES" plumes_msg diff --git a/sw/ground_segment/cockpit/plugin.ml b/sw/ground_segment/cockpit/plugin.ml deleted file mode 100644 index f695797ec6..0000000000 --- a/sw/ground_segment/cockpit/plugin.ml +++ /dev/null @@ -1 +0,0 @@ -let frame = ref (None: GBin.event_box option) diff --git a/sw/ground_segment/cockpit/plugin.mli b/sw/ground_segment/cockpit/plugin.mli deleted file mode 100644 index 9c549450e0..0000000000 --- a/sw/ground_segment/cockpit/plugin.mli +++ /dev/null @@ -1 +0,0 @@ -val frame : GBin.event_box option ref diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml deleted file mode 100644 index ced5841bc5..0000000000 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ /dev/null @@ -1,238 +0,0 @@ -(* - * GUI to save settings in the airframe file - * - * Copyright (C) 2008, Cyril Allignol, Pascal Brisset - * - * 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. - * - *) - - -module U = Unix - -(** How to have them local ? *) -let cols = new GTree.column_list -let col_index = cols#add Gobject.Data.int -let col_param = cols#add Gobject.Data.string -and col_airframe_value = cols#add Gobject.Data.string -and col_settings_value = cols#add Gobject.Data.string -and col_airframe_value_new = cols#add Gobject.Data.string -and col_code_value = cols#add Gobject.Data.float -and col_to_save = cols#add Gobject.Data.boolean -and col_integer = cols#add Gobject.Data.boolean - -let (//) = Filename.concat - -(** Float not equal to 0.1% *) -let floats_not_equal = fun f1 f2 -> - f2 = 0. && f1 <> 0. || - let r = abs_float (f1 /. f2) in - r < 0.999 || r > 1.001 - - -(** The save file dialog box *) -let save_airframe = fun w filename save -> - match GToolbox.select_file ~title:"Save Airframe" ~filename () with - None -> () - | Some file -> - save file; - w#save_settings#destroy () - -(** Toggling a tree element *) -let item_toggled ~(model : GTree.tree_store) ~column path = - let row = model#get_iter path in - let b = model#get ~row ~column in - model#set ~row ~column (not b) - - -let display_columns = fun w model -> - let renderer = GTree.cell_renderer_text [`XALIGN 0.] in - let vc = GTree.view_column ~title:"Parameter" ~renderer:(renderer, ["text", col_param]) () in - ignore (w#treeview_settings#append_column vc); - let text_columns = [(col_airframe_value, "Airframe Value"); (col_settings_value, "Setting Value")] in - List.iter (fun (col, title) -> - let renderer = GTree.cell_renderer_text [`XALIGN 0.] in - let vc = GTree.view_column ~title ~renderer:(renderer, ["text", col]) () in - vc#set_clickable true; - ignore (w#treeview_settings#append_column vc)) - text_columns; - let renderer = GTree.cell_renderer_toggle [`XALIGN 0.] in - let vc = GTree.view_column ~renderer:(renderer, ["active", col_to_save]) () in - let save_all = GButton.check_button ~draw_indicator:true ~active:false () in - vc#set_widget (Some save_all#coerce); - vc#set_clickable true; - - (* Connect the column header click to the save_all check button *) - ignore (vc#connect#clicked ~callback:(fun () -> save_all#clicked ())); - ignore (renderer#connect#toggled ~callback:(item_toggled ~model ~column:col_to_save)); - ignore (w#treeview_settings#append_column vc); - - (** Connect the save_all button to all the rows*) - let callback = fun () -> - model#foreach (fun _path row -> - model#set ~row ~column:col_to_save save_all#active; false) in - ignore (save_all#connect#toggled ~callback) - - - -let write_xml = fun (model:GTree.tree_store) old_file airframe_xml file -> - let new_xml = ref airframe_xml in - model#foreach (fun _path row -> - if model#get ~row ~column:col_to_save then begin - let new_value = model#get ~row ~column:col_airframe_value_new - and param = model#get ~row ~column:col_param in - new_xml := EditAirframe.set !new_xml param new_value - end; - false); - if old_file = file then begin - let now = U.localtime (Unix.gettimeofday ()) in - let backup_file = Printf.sprintf "%s.%d-%02d-%02d_%02d%02d%02d" old_file (now.U.tm_year + 1900) (now.U.tm_mon+1) now.U.tm_mday now.U.tm_hour now.U.tm_min now.U.tm_sec in - Sys.rename old_file backup_file - end; - XmlCom.to_file !new_xml file - - - -let send_airframe_values = fun (model:GTree.tree_store) send_value -> - model#foreach (fun _path row -> - if model#get ~row ~column:col_to_save then begin - let index = model#get ~row ~column:col_index - and code_value = model#get ~row ~column:col_code_value in - send_value index code_value - end; - false) - - - -let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> - let not_in_airframe_file = ref [] in - Array.iter (fun (index, dl_setting, value) -> - let attrib = fun a -> Xml.attrib dl_setting a in - try - let param = attrib "param" in - let (airframe_value, airframe_unit, code_unit) = EditAirframe.get airframe_xml param in - (* - * Get the scaling between the unit set in the airframe file to the real unit used (code_unit) - * Print error and use a factor of 1 when code_unit (in airframe file) and unit (in settings file) not equal - *) - let unit_setting = try Some (attrib "unit") with _ -> None in - let airframe_scale = - try - let unit_code = - match code_unit, unit_setting with - | Some uc, Some us -> - if uc = us then uc - else invalid_arg (Printf.sprintf "Warning: code unit in airframe (%s) and setting file (%s) are not matching for param %s\n" uc us param) (* raise Invalid_argument *) - | Some u, None | None, Some u -> u - | None, None -> "" - and unit_airframe = - match airframe_unit with - | Some u -> u - | None -> "" - in - (* Printf.fprintf stderr "param %s: unit_code=%s unit_airframe=%s\n" param unit_code unit_airframe; flush stderr; *) - PprzLink.scale_of_units unit_airframe unit_code - with - | Invalid_argument s -> prerr_endline s; flush stderr; raise Exit - | _ -> 1. - in - (* - * settings are displayed in alt_unit specified in settings file - * first try the alt_coef, otherwise try to convert the units - *) - let display_scale = float_of_string (PprzLink.alt_unit_coef_of_xml dl_setting) in - let val_list = Str.split (Str.regexp "[ ()]+") airframe_value in - let (scale_macros, str_val) = List.partition (fun x -> Str.string_match (Str.regexp "RadOfDeg\\|DegOfRad") x 0) val_list in - let extra_scale = - try - match (List.hd scale_macros) with - "RadOfDeg" -> Latlong.pi /. 180. - | "DegOfRad" -> 180. /. Latlong.pi - | _ -> 1. - with - _ -> 1. in - let airframe_value_scaled = - try - float_of_string (List.hd str_val) *. airframe_scale *. extra_scale - with - Failure _ -> raise (EditAirframe.No_param param) - in - let airframe_value_new = value /. airframe_scale in - (* test if is has to be saved as integer or float *) - let integer = try ignore(int_of_string (attrib "step")); true with _ -> false in - (* Printf.fprintf stderr "param %s: airframe_scale=%f display_scale=%f extra_scale=%f\n" param airframe_scale display_scale extra_scale; flush stderr; *) - let row = model#append () in - model#set ~row ~column:col_index index; - model#set ~row ~column:col_param param; - model#set ~row ~column:col_airframe_value (string_of_float (airframe_value_scaled *. display_scale)); - if integer then begin - model#set ~row ~column:col_settings_value (string_of_int (truncate (floor (value *. display_scale +. 0.5)))); - model#set ~row ~column:col_airframe_value_new (string_of_int (truncate (floor (airframe_value_new +. 0.5)))) - end - else begin - model#set ~row ~column:col_settings_value (string_of_float (value *. display_scale)); - model#set ~row ~column:col_airframe_value_new (string_of_float airframe_value_new) - end; - model#set ~row ~column:col_code_value value; - model#set ~row ~column:col_to_save (floats_not_equal airframe_value_scaled value); - model#set ~row ~column:col_integer integer - with - Xml.No_attribute _ | Exit -> () - | EditAirframe.No_param param -> - not_in_airframe_file := param :: !not_in_airframe_file ) (* Not savable *) - settings; - - (* Warning if needed *) - if !not_in_airframe_file <> [] then begin - GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (String.concat "\n" !not_in_airframe_file)); - end - - - - -(** The popup window displaying airframe and settings values *) -let popup = fun airframe_filename settings send_value -> - (* Build the list window *) - let file = Env.paparazzi_src // "sw" // "ground_segment" // "cockpit" // "gcs.glade" in - let w = new Gtk_save_settings.save_settings ~file () in - let icon = GdkPixbuf.from_file Env.icon_file in - w#save_settings#set_icon (Some icon); - - (* Build the tree model *) - let model = GTree.tree_store cols in - - (** Attach the model to the view *) - w#treeview_settings#set_model (Some model#coerce); - - (** Render the columns *) - display_columns w model; - - (* Parse the airframe file *) - let airframe_xml = XmlCom.parse_file airframe_filename in - - (** Insert the row data in the tree *) - fill_data model settings airframe_xml; - - (** The Cancel button *) - ignore (w#button_cancel#connect#clicked ~callback:(fun () -> w#save_settings#destroy ())); - - (** Connect the Save button to the write action *) - ignore (w#button_upload#connect#clicked ~callback:(fun ()-> send_airframe_values model send_value)); - - (** Connect the Save button to the write action *) - ignore (w#button_save#connect#clicked ~callback:(fun () -> save_airframe w airframe_filename (write_xml model airframe_filename airframe_xml))) diff --git a/sw/ground_segment/cockpit/saveSettings.mli b/sw/ground_segment/cockpit/saveSettings.mli deleted file mode 100644 index 6a4e0a2cbc..0000000000 --- a/sw/ground_segment/cockpit/saveSettings.mli +++ /dev/null @@ -1,26 +0,0 @@ -(* - * GUI to save settings in the airframe file - * - * Copyright (C) 2008, Cyril Allignol, Pascal Brisset - * - * 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. - * - *) - -val popup : string -> (int*Xml.xml*float) array -> (int -> float -> unit) -> unit -(** [popup airframe_filename settings send_value] *) diff --git a/sw/ground_segment/cockpit/sectors.ml b/sw/ground_segment/cockpit/sectors.ml deleted file mode 100644 index 3a4cfc182f..0000000000 --- a/sw/ground_segment/cockpit/sectors.ml +++ /dev/null @@ -1,53 +0,0 @@ -(******** Sectors **********************************************************) - -open Printf - - -let (//) = Filename.concat - -let rec display = fun (geomap:MapCanvas.widget) r -> - - match String.lowercase_ascii (Xml.tag r) with - "disc" -> - let rad = float_of_string (ExtXml.attrib r "radius") - and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in - ignore (geomap#circle ~width:5 ~color:"red" geo rad) - | "union" -> - List.iter (display geomap) (Xml.children r) - | "polygon" -> - let pts = List.map (fun x -> Latlong.of_string (ExtXml.attrib x "pos")) (Xml.children r) in - let pts = Array.of_list pts in - let n = Array.length pts in - for i = 0 to n - 1 do - ignore (geomap#segment ~width:5 ~fill_color:"red" pts.(i) pts.((i+1)mod n)) - done - |x -> fprintf stderr "Sector.display: '%s' not yet\n%!" x - - -let display_sector = fun (geomap:MapCanvas.widget) sector -> - display geomap (ExtXml.child sector "0") - - -let load = fun geomap () -> - match GToolbox.select_file ~title:"Load sectors" ~filename:(Env.flight_plans_path // "*.xml") () with - None -> () - | Some f -> - try - let xml = Xml.parse_file f in - List.iter (display_sector geomap) (Xml.children xml) - with - Dtd.Prove_error(e) -> - let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in - GToolbox.message_box ~title:"Error" m - -let load_kml = fun geomap () -> - match GToolbox.select_file ~title:"Load KML" ~filename:(Env.flight_plans_path // "*.kml") () with - None -> () - | Some f -> - try - let xml = Xml.parse_file f in - MapFP.display_kml "red" geomap xml - with - | Dtd.Prove_error(e) -> - let m = sprintf "Error while loading KML %s:\n%s" f (Dtd.prove_error e) in - GToolbox.message_box ~title:"Error" m diff --git a/sw/ground_segment/cockpit/sectors.mli b/sw/ground_segment/cockpit/sectors.mli deleted file mode 100644 index 63176294e9..0000000000 --- a/sw/ground_segment/cockpit/sectors.mli +++ /dev/null @@ -1,2 +0,0 @@ -val load : MapCanvas.widget -> unit -> unit -val load_kml : MapCanvas.widget -> unit -> unit diff --git a/sw/ground_segment/cockpit/shapes.ml b/sw/ground_segment/cockpit/shapes.ml deleted file mode 100644 index d83a9ecc32..0000000000 --- a/sw/ground_segment/cockpit/shapes.ml +++ /dev/null @@ -1,165 +0,0 @@ -(* - * 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, see - * . - * - *) - -open Latlong - -type shstatus = Update - | Delete - -type shtype = Circle - | Polygon - | Segment - | Text - -type shdata = { - shid : int; - shlinecolor : string; - shfillcolor : string; - shtype : shtype; - shstatus : shstatus; - shlatarr : float array; - shlonarr : float array; - shradius : float; - shtext : string; - shopacity : int} - -let int2shtype = fun i -> - match i with - | 0 -> Circle - | 1 -> Polygon - | 2 -> Segment - | 3 -> Text - | _ -> Text - -let int2shstatus = fun i -> - match i with - | 0 -> Update - | 1 -> Delete - | _ -> Delete - - -let circleshapes = Hashtbl.create 1 -let polygonshapes = Hashtbl.create 1 -let lineshapes = Hashtbl.create 1 -let textshapes = Hashtbl.create 1 - -let circle_exist = fun id -> - Hashtbl.mem circleshapes id - -let polygon_exist = fun id -> - Hashtbl.mem polygonshapes id - -let line_exist = fun id -> - Hashtbl.mem lineshapes id - -let text_exist = fun id -> - Hashtbl.mem textshapes id - -let update_circle = fun id wgs84 opacity fill_color color radius (geomap:MapCanvas.widget) -> - try - let gencircle = geomap#circle ~group:geomap#background ~width:2 ~fill_color ~opacity ~color wgs84.(0) radius in - if (circle_exist id) then - let shape = Hashtbl.find circleshapes id in - shape#destroy (); - Hashtbl.add circleshapes id gencircle; - else - Hashtbl.add circleshapes id gencircle; - with _ -> () - -let update_polygon = fun id positionarr opacity fill_color color (geomap:MapCanvas.widget) -> - try - let genpolygon = geomap#polygon ~group:geomap#background ~width:2 ~fill_color ~opacity ~color positionarr in - if (polygon_exist id) then - let shape = Hashtbl.find polygonshapes id in - shape#destroy (); - Hashtbl.add polygonshapes id genpolygon; - else - Hashtbl.add polygonshapes id genpolygon - with _ -> () - -let update_line = fun id positionarr color (geomap:MapCanvas.widget) -> - try - let genline = geomap#segment ~group:geomap#background ~width:2 ~fill_color:color positionarr.(0) positionarr.(1) in - if (line_exist id) then - let shape = Hashtbl.find lineshapes id in - shape#destroy (); - Hashtbl.add lineshapes id genline; - else - Hashtbl.add lineshapes id genline - with _ -> () - -let update_text = fun id positionarr color text (geomap:MapCanvas.widget)-> - try - let gentext = geomap#text ~group:geomap#background ~fill_color:color positionarr.(0) text in - if (text_exist id) then - let shape = Hashtbl.find textshapes id in - shape#destroy (); - Hashtbl.add textshapes id gentext; - else - Hashtbl.add textshapes id gentext - with _ -> () - -let convert_to_positions = fun raw -> - let position = fun lat lon -> { posn_lat=(Deg>>Rad)lat; posn_long=(Deg>>Rad)lon } in - let arrlen = Array.length raw.shlatarr in - let positionarr = Array.make arrlen (position raw.shlatarr.(1) raw.shlonarr.(1)) in - for i = 0 to arrlen - 1 do positionarr.(i) <- position raw.shlatarr.(i) raw.shlonarr.(i) done; - positionarr - -let del_text = fun raw -> - try - let shape = Hashtbl.find textshapes (raw.shid, raw.shtype) in - Hashtbl.remove textshapes (raw.shid, raw.shtype); - shape#destroy () - with _ -> () - -let update_shape = fun raw positions geomap -> - try - if raw.shtext = "NULL" then del_text raw else update_text (raw.shid, raw.shtype) positions raw.shlinecolor raw.shtext geomap; - match raw.shtype with - | Circle -> update_circle raw.shid positions raw.shopacity raw.shfillcolor raw.shlinecolor raw.shradius geomap; - | Polygon -> update_polygon raw.shid positions raw.shopacity raw.shfillcolor raw.shlinecolor geomap; - | Segment -> update_line raw.shid positions raw.shlinecolor geomap; - | Text -> update_text (raw.shid, raw.shtype) positions raw.shlinecolor raw.shtext geomap; - with _ -> () - - -let del_shape = fun raw -> - try - del_text raw; - match raw.shtype with - | Circle -> - let shape = Hashtbl.find circleshapes raw.shid in - Hashtbl.remove circleshapes raw.shid; - shape#destroy () - | Polygon -> - let shape = Hashtbl.find polygonshapes raw.shid in - Hashtbl.remove polygonshapes raw.shid; - shape#destroy () - | Segment -> - let shape = Hashtbl.find lineshapes raw.shid in - Hashtbl.remove lineshapes raw.shid; - shape#destroy () - | Text -> () - with _ -> () - -let new_shmsg = fun raw (geomap:MapCanvas.widget) -> - match raw.shstatus with - | Update -> update_shape raw (convert_to_positions raw) geomap - | Delete -> del_shape raw diff --git a/sw/ground_segment/cockpit/speech.ml b/sw/ground_segment/cockpit/speech.ml deleted file mode 100644 index 61c2567094..0000000000 --- a/sw/ground_segment/cockpit/speech.ml +++ /dev/null @@ -1,37 +0,0 @@ -(* - * Speech support for GCS alerts - * - * Copyright (C) 2011 - * - * 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. - * - *) - -let active = ref false - -let say = fun s -> - if !active then ( - let os = (Os_calls.os_name) in - match os with - (* If the os is Darwin, then use "say" *) - "Linux" -> ignore (Sys.command (Printf.sprintf "spd-say '%s'&" s)) - (* If the os is Linux, use "spd-say" *) - | "Darwin" -> ignore (Sys.command (Printf.sprintf "say '%s'&" s)) - (* Add more cases here to enhance support *) - | _ -> ignore (Sys.command (Printf.sprintf "echo Current OS not supported by -speech option")) - ) diff --git a/sw/ground_segment/cockpit/speech.mli b/sw/ground_segment/cockpit/speech.mli deleted file mode 100644 index dff4aac28c..0000000000 --- a/sw/ground_segment/cockpit/speech.mli +++ /dev/null @@ -1,2 +0,0 @@ -val active : bool ref -val say : string -> unit diff --git a/sw/ground_segment/cockpit/strip.ml b/sw/ground_segment/cockpit/strip.ml deleted file mode 100644 index 4e233369d9..0000000000 --- a/sw/ground_segment/cockpit/strip.ml +++ /dev/null @@ -1,426 +0,0 @@ -(* - * Strip handling - * - * Copyright (C) 2006 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 LL=Latlong - -let (//) = Filename.concat - -type t = - < add_widget : ?group:string -> GObj.widget -> unit; - connect_shift_alt : (float -> unit) -> unit; - connect_shift_lateral : (float -> unit) -> unit; - connect_launch : (float -> unit) -> unit; - connect_kill : bool -> (float -> unit) -> unit; - connect_mode : float -> (float -> unit) -> unit; - connect_mark : (unit -> unit) -> unit; - connect_flight_time : (float -> unit) -> unit; - connect_apt : (unit -> float) -> (float -> unit) -> unit; - set_agl : float -> unit; - set_bat : float -> unit; - set_throttle : ?kill:bool -> float -> unit; - set_speed : float -> unit; - set_airspeed : float -> unit; - set_climb : float -> unit; - set_color : string -> string -> unit; - set_label : string -> string -> unit; - set_rc : float -> string -> unit; - connect : (unit -> unit) -> unit; - hide_buttons : unit -> unit; - show_buttons : unit -> unit > - -type strip_param = { - color : string; - min_bat : float; - max_bat : float; - nb_cell_bat : float option; - alt_shift_plus_plus : float; - alt_shift_plus : float; - alt_shift_minus : float; - icons_theme : string } - - -let agl_max = 150. - -(** set a label *) -let set_label labels name value = - try - let _eb, l = List.assoc (name^"_value") labels in - let value = sprintf "%s" value in - if l#text <> value then - l#set_label value - with - Not_found -> - fprintf stderr "Strip.set_label: '%s' unknown\n%!" name - -(** set a color *) -let set_color labels name color = - let eb, _l = List.assoc (name^"_value") labels in - eb#coerce#misc#modify_bg [`NORMAL, `NAME color] - -class gauge = fun (gauge_da:GMisc.drawing_area) -> -object (self) - inherit Gtk_tools.pixmap_in_drawin_area ~drawing_area:gauge_da () - method layout = fun string -> - let context = gauge_da#misc#create_pango_context in - let layout = context#create_layout in - let fd = Pango.Context.get_font_description (Pango.Layout.get_context layout) in - Pango.Font.modify fd ~weight:`BOLD (); - context#set_font_description fd; - Pango.Layout.set_text layout string; - layout - method request_width = fun string -> - let layout = self#layout string in - let (width,_h) = Pango.Layout.get_pixel_size layout in - (gauge_da#misc#set_size_request ~width () : unit) -end - -(* 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 *) -class vgauge = fun ?(color="#00ff00") ?(history_len=50) gauge_da v_min v_max -> -object (self) - inherit gauge gauge_da - val history = Array.make history_len 0 - val mutable history_index = -1 - method set = fun ?arrow ?(background="orange") value strings -> - let {Gtk.width=width; height=height} = gauge_da#misc#allocation in - if height > 1 then (* Else the drawing area is not allocated already *) - let dr = self#get_pixmap () in - dr#set_foreground (`NAME background); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - - let f = (value -. v_min) /. (v_max -. v_min) in - let f = max 0. (min 1. f) in - let h = truncate (float height *. f) in - - (* First call: fill the array with the given value *) - if history_index < 0 then begin - for i = 0 to history_len - 1 do - history.(i) <- h - done; - history_index <- 0; - end; - - (* Store the value in the history array and update index *) - history.(history_index) <- h; - history_index <- (history_index+1) mod history_len; - - dr#set_foreground (`NAME color); - - (* From left to right, older to new values *) - let polygon = ref [0,height; width,height] in - for i = 0 to history_len - 1 do - let idx = (history_index+i) mod history_len in - polygon := ((i*width)/history_len, (height-history.(idx))):: !polygon; - done; - polygon := (width,height-h):: !polygon; - dr#polygon ~filled:true !polygon; - - (* Arrow for the variation *) - begin - match arrow with - None -> () - | Some angle_rad -> - let w = width and h = height in - let fh = 0.8 *. float w in - let x = truncate (cos angle_rad *. fh) - and y = - truncate (sin angle_rad *. fh) in - let a = -.angle_rad +. 5. *. LL.pi /. 6. - and a' = -.angle_rad -. 5. *. LL.pi /. 6. - and al = 0.2 *. fh in - let ax = truncate (cos a *. al) - and ay = truncate (sin a *. al) in - let ax' = truncate (cos a' *. al) - and ay' = truncate (sin a' *. al) in - let l = [w/10, h/2; w/10+x,h/2+y; w/10+x+ax,h/2+y+ay; w/10+x,h/2+y; w/10+x+ax',h/2+y+ay'] in - dr#set_foreground `BLACK; - dr#lines l - end; - - List.iter (fun (vpos, string) -> - let layout = self#layout string in - let (w,h) = Pango.Layout.get_pixel_size layout in - let y = truncate (vpos *. float height) - h / 2 in - dr#put_layout ~x:((width-w)/2) ~y ~fore:`BLACK layout) - strings; - - (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap -end - -class hgauge = fun ?(color="#00ff00") gauge_da v_min v_max -> -object (self) - inherit gauge gauge_da - method set = fun ?(background="orange") value string -> - let {Gtk.width=width; height=height} = gauge_da#misc#allocation in - if height > 1 then (* Else the drawing area is not allocated already *) - let dr = self#get_pixmap () in - dr#set_foreground (`NAME background); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - - let f = (value -. v_min) /. (v_max -. v_min) in - let f = max 0. (min 1. f) in - let w = truncate (float width *. f) in - - dr#set_foreground (`NAME color); - dr#rectangle ~x:0 ~y:0 ~width:w ~height ~filled:true (); - - let layout = self#layout string in - let (w,h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:((width-w)/2) ~y:((height-h)/2) ~fore:`BLACK layout; - - (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap -end - -(** add a strip to the panel *) -(*let add = fun config color min_bat max_bat ->*) -let add = fun config strip_param (strips:GPack.box) -> - let color = strip_param.color - and min_bat = strip_param.min_bat - and max_bat = strip_param.max_bat - and nb_cell_bat = strip_param.nb_cell_bat - and alt_shift_plus_plus = strip_param.alt_shift_plus_plus - and alt_shift_plus = strip_param.alt_shift_plus - and alt_shift_minus = strip_param.alt_shift_minus in - - let strip_labels = ref [] in - let add_label = fun name value -> - strip_labels := (name, value) :: !strip_labels in - - let ac_name = PprzLink.string_assoc "ac_name" config in - - let file = Env.paparazzi_src // "sw" // "ground_segment" // "cockpit" // "gcs.glade" in - let strip = new Gtk_strip.eventbox_strip ~file () in - - let eventbox_dummy = GBin.event_box () in - - strips#pack strip#toplevel#coerce; - - (* Name in top left *) - strip#label_ac_name#set_label (sprintf "%s" ac_name); - - (* Color *) - let plane_color = strip#eventbox_strip in - plane_color#coerce#misc#modify_bg [`NORMAL, `NAME color]; - - add_label "flight_time_value" (eventbox_dummy, strip#label_flight_time); - add_label "block_time_value" (eventbox_dummy, strip#label_block_time); - add_label "stage_time_value" (eventbox_dummy, strip#label_stage_time); - add_label "block_name_value" (eventbox_dummy, strip#label_block_name); - add_label "apt_value" (eventbox_dummy, strip#label_apt_value); - - (* battery gauge *) - let bat_da = strip#drawingarea_battery in - bat_da#misc#realize (); - let bat = new vgauge bat_da min_bat max_bat in - bat#request_width "22.5"; - bat#set 0. [0.5, "UNK"]; - - (* AGL gauge *) - let agl_da = strip#drawingarea_agl in - agl_da#misc#realize (); - let agl = new vgauge agl_da 0. agl_max in - - (* Speed gauge *) - strip#drawingarea_speed#misc#realize (); - let speed = new hgauge strip#drawingarea_speed 0. 10. in (* FIXME *) - speed#request_width "33.3m/s"; - - (* Throttle gauge *) - strip#drawingarea_throttle#misc#realize (); - let throttle = new hgauge strip#drawingarea_throttle 0. 100. in - - (* Diff to target altitude *) - let diff_target_alt = strip#label_diff_target_alt in - add_label "diff_target_alt_value" (eventbox_dummy, diff_target_alt); - - (* Telemetry *) - let eb = strip#eventbox_telemetry in - let ts = strip#label_telemetry in - add_label "telemetry_status_value" (eb, ts); - ts#set_width_chars 3; - - (* RC *) - strip#drawingarea_rc#misc#realize (); - let rc = new hgauge strip#drawingarea_rc 0. 10. in - rc#request_width "NONE"; - - (* Labels *) - add_label "AP_value" (strip#eventbox_mode, strip#label_mode); - add_label "GPS_value" (strip#eventbox_gps, strip#label_gps); - - add_label "altitude_value" (eventbox_dummy, strip#label_altitude); - add_label "target_altitude_value" (eventbox_dummy, strip#label_target_altitude); - - add_label "eta_time_value" (eventbox_dummy, strip#label_eta_time); - - let connect_buttons = fun callback -> - List.iter (fun ((button:GButton.button), value) -> - ignore (button#connect#clicked ~callback:(fun () -> callback value)); - button#misc#set_sensitive true) in - - (* Buttons : setting the icons (the path of the icon is not saved by glade) *) - List.iter (fun (b, icon) -> - b#remove b#child; - try - let pixbuf = GdkPixbuf.from_file (Env.get_gcs_icon_path strip_param.icons_theme icon) in - ignore (GMisc.image ~pixbuf ~packing:b#add ()) - with - exc -> - fprintf stderr "Error: %s\n" (Printexc.to_string exc); - ignore (GMisc.label ~text:"?" ~packing:b#add ())) - [ strip#button_launch, "launch.png"; - strip#button_kill, "kill.png"; - strip#button_resurrect, "resurrect.png"; - strip#button_down, "down.png"; - strip#button_up, "up.png"; - strip#button_up_up, "upup.png"; - strip#button_left, "left.png"; - strip#button_center, "recenter.png"; - strip#button_right, "right.png"; - ]; - -object - val mutable climb = 0. - val mutable button_tbl = Hashtbl.create 10 - method set_climb = fun v -> climb <- v - method set_agl value = - let arrow = max (min 0.5 (climb /. 5.)) (-0.5) in - agl#set ~arrow value [0.2, (sprintf "%3.0f" value); 0.8, sprintf "%+.1f" climb] - method set_bat value = - let v = if value < 0.1 then "UNK" else (string_of_float value) in - match nb_cell_bat with - | None -> bat#set value [0.5, v] - | Some nb -> bat#set value [0.3, v; 0.7, sprintf "%.2f /c" (value /. nb)] - method set_throttle ?(kill=false) value = - let background = if kill then "red" else "orange" in - throttle#set ~background value (sprintf "%.0f%%" value) - method set_speed value = speed#set value (sprintf "%.1fm/s" value) - - method set_airspeed value = - let text = sprintf "Ground speed (est. airspeed: %.1fm/s)" value in - let tooltips = GData.tooltips () in - tooltips#set_tip strip#eventbox_speed#coerce ~text - - method connect_mark callback = - ignore (strip#button_mark#connect#clicked ~callback) - - method set_label name value = set_label !strip_labels name value - method set_color name value = set_color !strip_labels name value - - method set_rc rate status = rc#set rate status - - (* add a button widget in a vertical box if it belongs to a group (create new group if needed) *) - method add_widget ?(group="") w = - let (vbox, pack) = match String.length group with - 0 -> (GPack.vbox ~show:true (), true) - | _ -> try (Hashtbl.find button_tbl group, false) with - Not_found -> - let vb = GPack.vbox ~show:true () in - ignore(Hashtbl.add button_tbl group vb); - (vb, true) - in - (*let vbox = GPack.vbox ~show:true () in*) - vbox#pack ~fill:false w; - if pack then strip#hbox_user#pack ~fill:false vbox#coerce else () - - method connect_shift_alt callback = - let tooltips = GData.tooltips () in - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_minus in - ignore (tooltips#set_tip strip#button_down#coerce ~text); - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus in - ignore (tooltips#set_tip strip#button_up#coerce ~text); - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus_plus in - ignore (tooltips#set_tip strip#button_up_up#coerce ~text); - connect_buttons callback - [ strip#button_down, alt_shift_minus; - strip#button_up, alt_shift_plus; - strip#button_up_up, alt_shift_plus_plus] - - method connect_shift_lateral = fun callback -> - connect_buttons callback - [ strip#button_left, -5.; - strip#button_right, 5.; - strip#button_center, 0.] - - method connect_kill = fun confirm_kill callback -> - let callback = fun x -> - if x = 1. && confirm_kill then - match GToolbox.question_box ~title:"Kill throttle" ~buttons:["Kill"; "Cancel"] (sprintf "Kill throttle of A/C %s ?" ac_name) with - 1 -> callback 1. - | _ -> () - else (* No confirmation for resurrect or confirm_kill = false *) - callback x - in - connect_buttons callback - [ strip#button_kill, 1.; - strip#button_resurrect, 0.] - - method connect_launch = fun callback -> - connect_buttons callback - [ strip#button_launch, 1. ] - - method connect_mode = fun mode callback -> - let callback = fun _ -> (* Back in AUTO2 *) - match GToolbox.question_box ~title:"Back to auto" ~buttons:["AUTO"; "Cancel"] (sprintf "Restore AUTO mode for A/C %s ?" ac_name) with - 1 -> callback mode; true - | _ -> true in - ignore(strip#eventbox_mode#event#connect#button_press ~callback) - - (* Reset the flight time *) - method connect_flight_time = fun callback -> - let callback = fun _ -> (* Reset flight time *) - match GToolbox.question_box ~title:"Reset flight time" ~buttons:["Reset"; "Cancel"] (sprintf "Reset flight time for A/C %s ?" ac_name) with - 1 -> callback 0.; true - | _ -> true in - ignore(strip#eventbox_flight_time#event#connect#button_press ~callback) - - (** Appointment date *) - method connect_apt = fun get_ac_unix_time send_value -> - strip#label_apt#misc#show (); - strip#label_apt_value#misc#show (); - let callback = fun _ -> - let w = new Gtk_setting_time.setting_time ~file () in - let utc = Unix.gmtime (get_ac_unix_time () +. 60.) in - w#spinbutton_hour#set_value (float utc.Unix.tm_hour); - w#spinbutton_min#set_value (float utc.Unix.tm_min); - ignore (w#button_cancel#connect#clicked ~callback:(fun () -> w#setting_time#destroy ())); - let callback = fun () -> - let hour = truncate w#spinbutton_hour#value - and min = truncate w#spinbutton_min#value - and sec = truncate w#spinbutton_sec#value in - w#setting_time#destroy (); - let tow = Latlong.gps_tow_of_utc hour min sec in - send_value (float tow) in - ignore (w#button_ok#connect#clicked ~callback); - true - in - ignore(strip#eventbox_RDV#event#connect#button_press ~callback) - - - method hide_buttons () = strip#hbox_user#misc#hide (); strip#frame_nav#misc#set_sensitive false - method show_buttons () = strip#hbox_user#misc#show (); strip#frame_nav#misc#set_sensitive true - method connect = fun (select: unit -> unit) -> - let callback = fun _ -> select (); true in - ignore (strip#eventbox_strip#event#connect#button_press ~callback) -end diff --git a/sw/ground_segment/cockpit/strip.mli b/sw/ground_segment/cockpit/strip.mli deleted file mode 100644 index 7b4dabc524..0000000000 --- a/sw/ground_segment/cockpit/strip.mli +++ /dev/null @@ -1,66 +0,0 @@ -(* - * Strip handling - * - * Copyright (C) 2006-2009 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. - * - *) - -type t = < - add_widget : ?group:string -> GObj.widget -> unit; - (** Add a user widget in the low row of the strip *) - - connect_shift_alt : (float -> unit) -> unit; - connect_shift_lateral : (float -> unit) -> unit; - connect_launch : (float -> unit) -> unit; - connect_kill : bool -> (float -> unit) -> unit; - connect_mode : float -> (float -> unit) -> unit; - connect_flight_time : (float -> unit) -> unit; - - connect_apt : (unit -> float) -> (float -> unit) -> unit; - (** [connect_apt get_ac_unix_time send_value] *) - - connect_mark : (unit -> unit) -> unit; - set_agl : float -> unit; - set_bat : float -> unit; - set_throttle : ?kill:bool -> float -> unit; - set_speed : float -> unit; - set_airspeed : float -> unit; - set_climb : float -> unit; - set_color : string -> string -> unit; - set_label : string -> string -> unit; - set_rc : float -> string -> unit; - hide_buttons : unit -> unit; - show_buttons : unit -> unit; - connect : (unit -> unit) -> unit -> - -type strip_param = { - color : string; - min_bat : float; - max_bat : float; - nb_cell_bat : float option; - alt_shift_plus_plus : float; - alt_shift_plus : float; - alt_shift_minus : float; - icons_theme : string; } - - -val add : PprzLink.values -> strip_param -> GPack.box -> t -(** [add config params] *) diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile deleted file mode 100644 index 0592892c35..0000000000 --- a/sw/supervision/Makefile +++ /dev/null @@ -1,107 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- -# -# Copyright (C) 2004-2012 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. - -# The default is to produce a quiet echo of compilation commands -# Launch with "make Q=''" to get full echo -Q=@ - -include ../Makefile.ocaml - -UNAME = $(shell uname -s) -ifeq ("$(UNAME)","Darwin") - MKTEMP = gmktemp -else - MKTEMP = mktemp -endif - -ifeq ($(USE_LABELGTK),lablgtk2) -LABLGTK2GNOMEUI = $(shell ocamlfind query -p-format lablgtk2-gnome.gnomeui 2>/dev/null) -ifeq ($(LABLGTK2GNOMEUI),) -LABLGTK2GNOMEUI = $(shell ocamlfind query -p-format lablgtk2.gnomeui 2>/dev/null) -endif - -LABLGTK2GLADE = $(shell ocamlfind query -p-format lablgtk2.glade 2>/dev/null) - -INCLUDES = -XPKG = -package lablgtk2,pprz.xlib,lablgtk2.glade,$(LABLGTK2GNOMEUI) -XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg lablgtk2,pprz.xlib,pprzlink - -PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_control_panel.cmo pc_aircraft.cmo paparazzicenter.cmo - -# only compile it lablgtk2.glade is installed -ifneq ($(LABLGTK2GLADE),) -all: paparazzicenter -else # no lablgtk2 glade -all : - @echo Skipping legacy Paparazzi Center build, no lablgtk2-glade -endif - -else # no lablgtk2 -all : - @echo Skipping legacy Paparazzi Center build, no lablgtk2 -endif - -paparazzicenter : $(PAPARAZZICENTERCMO) $(LIBPPRZCMA) $(LIBPPRZLINKCMA) $(XLIBPPRZCMA) - @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ - -gtk_pc.ml : paparazzicenter.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)lablgladecc2 -hide-default -root window $($@_TMP) > $@ - $(Q)rm -f $($@_TMP) - -gtk_process.ml : paparazzicenter.glade - @echo GLADE $@ - $(eval $@_TMP := $(shell $(MKTEMP))) - $(Q)grep -v invisible_char $< > $($@_TMP) - $(Q)lablgladecc2 -hide-default -root hbox_program $($@_TMP) | grep -B 1000000 " end" > $@ - $(Q)rm -f $($@_TMP) - -%.cmo : %.ml - @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $(XPKG) $< - -%.cmi : %.mli - @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $(XPKG) $< - -pc_common.cmo: gtk_process.cmo - -paparazzicenter.cmo : gtk_pc.cmo - -clean: - $(Q)rm -f *.cm* gtk_pc.ml gtk_process.ml .depend paparazzicenter - -.PHONY: all clean - -# -# Dependencies -# - -.depend: Makefile - @echo DEPEND $@ - $(Q)$(OCAMLDEP) -I $(LIBPPRZDIR) *.ml* > .depend - -ifneq ($(MAKECMDGOALS),clean) --include .depend -endif diff --git a/sw/supervision/paparazzicenter.glade b/sw/supervision/paparazzicenter.glade deleted file mode 100644 index f1ad6d265e..0000000000 --- a/sw/supervision/paparazzicenter.glade +++ /dev/null @@ -1,1684 +0,0 @@ - - - - - - True - False - window1 - - - 32 - True - False - - - True - False - process name - 20 - - - False - False - 0 - - - - - True - True - ● - False - False - True - True - - - True - True - 1 - - - - - True - True - False - Automatic respawn - False - True - - - - - - False - False - 2 - - - - - gtk-stop - 32 - True - True - False - False - True - - - False - False - 3 - - - - - gtk-remove - 32 - True - False - True - False - False - True - - - False - False - 4 - - - - - - - True - False - Paparazzi Center - - - True - False - - - True - False - - - True - False - False - _A/C - True - - - False - - - New - True - False - False - True - False - - - - - - Copy - True - False - False - True - False - - - - - - Delete - True - False - False - True - False - - - - - - gtk-save - True - False - False - True - True - - - - - - Autosave on quit - True - False - False - - - - - - New build target - True - False - Add manually a new build target. It is recommended to add targets into airframe file (firmware section). - False - True - False - - - - - - True - False - - - - - gtk-quit - True - False - False - True - True - - - - - - - - - - True - False - False - Session - True - - - False - - - gtk-new - True - False - False - True - True - - - - - - gtk-save - True - False - False - True - True - - - - - - gtk-delete - True - False - False - True - True - - - - - - - - - - True - False - False - _Tools - True - - - - - - True - False - False - _View - True - - - - False - - - gtk-fullscreen - True - False - False - True - True - - - - - - - - - - - True - False - False - _Help - True - - - False - - - True - False - False - _About - True - - - - - - True - False - False - _Get Help - True - - - - - - True - False - False - _Version - True - - - - - - - - - False - False - 0 - - - - - True - True - - - 250 - 400 - True - False - - - True - False - - - True - False - 0 - - - True - False - 8 - - - True - False - - - True - False - - - - - - True - True - 0 - - - - - True - True - True - True - Reload aircraft xml files. - False - - - True - False - 0 - 0 - - - True - False - 2 - - - True - False - gtk-refresh - - - False - False - 0 - - - - - - - - - False - False - 1 - - - - - - - - - True - False - <b>A/C</b> - True - - - label_item - - - - - True - True - 0 - - - - - True - False - 0 - - - True - False - 8 - - - True - True - ID of the aircraft (number from 1 to 255) - 3 - ● - 3 - False - False - True - True - - - - - - - True - False - <b>id</b> - True - - - label_item - - - - - True - True - 1 - - - - - True - False - 0 - - - True - False - 8 - - - True - False - - - True - False - - - - - - True - True - 0 - - - - - ... - True - True - False - Color selector - False - True - - - False - False - 1 - - - - - - - - - True - False - <b>GUI color</b> - True - - - label_item - - - - - True - True - 2 - - - - - False - True - 0 - - - - - True - True - 1 - automatic - automatic - - - True - False - - - True - False - - - True - False - 0 - - - True - False - 12 - - - True - False - 2 - - - True - False - ________________ - start - - - True - True - 0 - - - - - ... - True - True - False - Browse - False - True - - - False - False - 1 - - - - - gtk-edit - True - True - False - Launch the GCS editor or a text editor (gedit or EDITOR env variable if set) - False - True - - - False - False - 2 - - - - - - - - - True - False - <b>Airframe</b> - True - - - label_item - - - - - False - True - 0 - - - - - True - False - 0 - - - True - False - 12 - - - True - False - - - True - False - _________________ - start - - - True - True - 0 - - - - - ... - True - True - False - False - True - - - False - False - 1 - - - - - gtk-edit - True - True - False - Launch a text editor (gedit or EDITOR env variable if set) - False - True - - - False - False - 2 - - - - - - - - - True - False - <b>Flight plan</b> - True - - - label_item - - - - - False - True - 1 - - - - - True - False - 0 - - - True - False - - - True - False - 12 - - - True - False - - - True - True - False - - - True - True - 0 - - - - - True - False - - - gtk-add - True - True - True - True - Add a settings file - False - True - True - - - False - False - 0 - - - - - gtk-edit - True - True - True - True - Launch an editor on all the settings file - False - True - - - False - False - 1 - - - - - gtk-remove - True - True - True - True - Remove the selected settings file - False - True - - - False - False - 2 - - - - - False - False - 2 - - - - - - - True - True - 0 - - - - - True - False - 4 - 12 - 12 - - - True - True - False - - - - - True - True - 1 - - - - - - - True - False - <b>Settings</b> - True - - - label_item - - - - - False - True - 2 - - - - - True - False - 0 - - - True - False - 12 - - - True - False - - - True - False - _________________ - start - - - True - True - 0 - - - - - ... - True - True - False - False - True - - - False - False - 1 - - - - - gtk-edit - True - True - False - False - True - - - False - False - 2 - - - - - - - - - True - False - <b>Radio</b> - True - - - label_item - - - - - False - True - 3 - - - - - True - False - 0 - - - True - False - 12 - - - True - False - - - True - False - _________________ - start - - - True - True - 0 - - - - - ... - True - True - False - False - True - - - False - False - 1 - - - - - gtk-edit - True - True - False - False - True - - - False - False - 2 - - - - - - - - - True - False - <b>Telemetry</b> - True - - - label_item - - - - - False - True - 4 - - - - - - - True - False - 0 - - - True - False - 12 - - - True - False - - - True - False - _________________ - start - - - True - True - 0 - - - - - Compare - True - True - False - False - True - - - False - False - 1 - - - - - Gitk - True - True - False - False - True - - - False - False - 2 - - - - - Tag - True - True - False - False - True - - - False - False - 3 - - - - - - - - - True - False - <b>Release</b> - True - - - label_item - - - - - False - True - 5 - - - - - - - - - - - True - True - 1 - - - - - False - True - - - - - True - False - - - True - False - 3 - - - True - False - 1 - - - True - False - - - True - False - 0 - - - True - False - 12 - - - True - False - - - - - - - - - - True - False - <b>Target</b> - True - - - label_item - - - - - True - True - 0 - - - - - True - False - 0 - none - - - True - False - Select the flash mode for the current target -'Default' will use the board or airframe settings - 12 - - - True - False - - - - - - - - - - True - False - <b>Flash mode</b> - True - - - label_item - - - - - True - True - 1 - - - - - False - False - 0 - - - - - True - False - True - - - True - True - False - [Alt+C] Cleans the selected target of the selected A/C. - False - - - - True - False - 0 - 0 - - - True - False - 2 - - - True - False - gtk-clear - - - False - False - 0 - - - - - True - False - Clean - True - - - False - False - 1 - - - - - - - - - False - False - 0 - - - - - True - True - True - False - [Alt+B] Build the selected target of the selected A/C. Warning: Save is required before this action - False - - - - True - False - 0 - 0 - - - True - False - 2 - - - True - False - gtk-convert - - - False - False - 0 - - - - - True - False - Build - True - - - False - False - 1 - - - - - - - - - False - False - 1 - - - - - True - False - True - False - [Alt+U] Upload into the airborne device (which must be plugged !). - False - - - - True - False - 0 - 0 - - - True - False - 2 - - - True - False - gtk-go-up - - - False - False - 0 - - - - - True - False - Upload - True - - - False - False - 1 - - - - - - - - - False - False - 2 - - - - - False - False - 1 - - - - - print config at build time - True - True - False - Enable configuration messages at build time (PRINT_CONFIG). - False - True - - - True - True - 2 - - - - - True - True - 0 - - - - - True - False - - - False - True - 1 - - - - - True - False - 1 - True - - - True - False - - - True - False - 0 - - - True - False - 12 - - - True - False - - - - - - - - - - True - False - <b>Session</b> - True - - - label_item - - - - - True - True - 0 - - - - - gtk-execute - True - True - False - False - True - - - False - False - 1 - - - - - False - False - 0 - - - - - True - True - False - False - [Alt+S] Stop/Remove All Processes. - - - - True - False - 0 - 0 - - - True - False - 2 - - - True - False - gtk-clear - - - False - False - 0 - - - - - True - False - Stop/Remove All Processes - True - - - False - False - 1 - - - - - - - - - False - False - 1 - - - - - True - True - 2 - - - - - True - False - - - False - True - 3 - - - - - False - True - 0 - - - - - True - False - - - - - - False - True - 1 - - - - - True - True - - - True - True - False - - - - - True - True - 2 - - - - - True - True - - - - - True - True - 1 - - - - - True - False - - - False - False - 2 - - - - - - diff --git a/sw/supervision/paparazzicenter.ml b/sw/supervision/paparazzicenter.ml deleted file mode 100644 index 82b663e0ba..0000000000 --- a/sw/supervision/paparazzicenter.ml +++ /dev/null @@ -1,370 +0,0 @@ -(* - * 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 always_keep_changes = ref false - -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 ~width:(ios width) ~height:(ios height))); - - (*********** Left pane size *) - read_one "left_pane_width" - (fun width -> gui#vbox_left_pane#misc#set_size_request ~width:(ios width) ()); - - (*********** Left pane size *) - read_one "always keep changes" - (fun keep_changes -> - match keep_changes with - | "true" -> always_keep_changes := true - | _ -> always_keep_changes := false) - - -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 - - (* save always_keep_changes choice *) - let xml = - add_entry xml "always keep changes" (string_of_bool !always_keep_changes) 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 backup_file_differs = fun () -> - if Sys.file_exists Utils.backup_xml_file then - ExtXml.parse_file Utils.backup_xml_file <> ExtXml.parse_file Utils.conf_xml_file - else - false - -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 ?(confirm_quit = true) () -> - if (not !always_keep_changes) && backup_file_differs () then begin - let dialog = GWindow.dialog ~title:"Quit" ~modal:true () in - dialog#add_button "Keep changes" `APPLY; - dialog#add_button "Revert" `REJECT; - dialog#add_button "View changes" `HELP; - dialog#add_button "Cancel" `CANCEL; - let _ = GMisc.label ~text:"Configuration has been changed since startup.\nIf you want to undo the changes choose [Revert]" ~packing:dialog#vbox#pack () in - let checkbox = GButton.check_button ~label:"Always keep changes" ~active:!always_keep_changes ~packing:dialog#vbox#pack () in - ignore (checkbox#connect#toggled ~callback:(fun () -> - always_keep_changes := checkbox#active; - gui#menu_item_always_keep_changes#set_active checkbox#active;)); - - match dialog#run () with - `APPLY -> - Sys.remove Utils.backup_xml_file; - quit_callback gui ac_combo session_combo target_combo () - | `REJECT -> - ignore (Sys.command (sprintf "cp %s %s" Utils.backup_xml_file Utils.conf_xml_file)); - Sys.remove Utils.backup_xml_file; - quit_callback gui ac_combo session_combo target_combo () - | `HELP -> - ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)) - | `CANCEL -> - dialog#destroy () - | _ -> () - end else begin - if Sys.file_exists Utils.backup_xml_file then - Sys.remove Utils.backup_xml_file; - if confirm_quit then - match GToolbox.question_box ~title:"Quit" ~buttons:["Cancel"; "Quit"] ~default:2 "Quit ?" with - 2 -> quit_callback gui ac_combo session_combo target_combo () - | _ -> () - else - quit_callback gui ac_combo session_combo target_combo () - end - -let quit_window_callback = fun gui ac_combo session_combo target_combo _ -> - quit_button_callback gui ac_combo session_combo target_combo ~confirm_quit:false (); - true - -let keep_changes_callback = fun gui _ -> - always_keep_changes := gui#menu_item_always_keep_changes#active; - () - -(************************** Main *********************************************) -let () = - let session = ref "" - and fullscreen = ref false in - Arg.parse - ["-fullscreen", Arg.Set fullscreen, "Fullscreen window"; - "-session", Arg.Set_string session, " 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 ~name:"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 = "Seems that Paparazzi Center wasn't quit cleanly.\nFound an older copy of conf.xml, do you want to restore it?" in - match GToolbox.question_box ~title:"Backup" ~buttons:["Keep current"; "Restore"; "View changes"] ~default:1 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 - - (* Autosave on quit check box *) - ignore (gui#menu_item_always_keep_changes#connect#toggled ~callback:(keep_changes_callback gui)); - - (* 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_window_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:\nhttps://wiki.paparazziuav.org\n\nCommunity-based support, mailing list: Contact\n\nThe Paparazzi auto-generated developer documentation:\nhttp://docs.paparazziuav.org\n\nPaparazzi sourcecode and issue tracker:\nhttps://github.com/paparazzi/paparazzi" 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; - - gui#menu_item_always_keep_changes#set_active !always_keep_changes; - - (* Run the command line session *) - if !session <> "" then begin - Gtk_tools.select_in_combo session_combo !session; - execute_session !session - end; - - GMain.Main.main ();; diff --git a/sw/supervision/pc_aircraft.ml b/sw/supervision/pc_aircraft.ml deleted file mode 100644 index 1d8f1ae77d..0000000000 --- a/sw/supervision/pc_aircraft.ml +++ /dev/null @@ -1,626 +0,0 @@ -(* - * 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. - * - *) - -module Utils = Pc_common -module CP = Pc_control_panel -open Printf - -let (//) = Filename.concat - -let gcs = Env.paparazzi_src // "sw/ground_segment/cockpit/gcs" - -let regexp_space = Str.regexp "[ ]+" - -let string_of_gdkcolor = fun c -> - sprintf "#%04x%04x%04x" (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/examples/microjet_lisa_m.xml"; - "radio", "radios/cockpitSX.xml"; - "telemetry", "telemetry/default_fixedwing.xml"; - "flight_plan", "flight_plans/basic.xml"; - "settings", "settings/fixedwing_basic.xml"; - "settings_modules", ""; - "gui_color", "blue"; - "release", "" ], - []) - - -let write_conf_xml = fun ?(user_save = false) () -> - let l = Hashtbl.fold (fun _ a r -> a::r) Utils.aircrafts [] in - let l = List.sort (fun ac1 ac2 -> compare (Xml.attrib ac1 "name") (Xml.attrib ac2 "name")) l in - let c = Xml.Element ("conf", [], l) in - if c <> ExtXml.parse_file Utils.conf_xml_file then begin - if not (Sys.file_exists Utils.backup_xml_file) then - ignore (Sys.command (sprintf "cp %s %s" Utils.conf_xml_file Utils.backup_xml_file)); - let f = open_out Utils.conf_xml_file in - fprintf f "%s\n" (ExtXml.to_string_fmt ~tab_attribs:true c); - close_out f - end; - if user_save && Sys.file_exists Utils.backup_xml_file then begin - let today = Unix.localtime (Unix.gettimeofday ()) in - Sys.rename Utils.backup_xml_file (sprintf "%s.%04d-%02d-%02d_%02d:%02d" Utils.conf_xml_file (1900+today.Unix.tm_year) (today.Unix.tm_mon+1) today.Unix.tm_mday today.Unix.tm_hour today.Unix.tm_min) - end - -let new_ac_id = fun () -> - let used = Array.make 256 false in - Hashtbl.iter - (fun _ x -> - used.(int_of_string (ExtXml.attrib x "ac_id")) <- true) - Utils.aircrafts ; - let rec first_unused = fun i -> - if i < 256 then - if not used.(i) then i else first_unused (i+1) - else - failwith "Already 256 A/C in your conf.xml file !" in - first_unused 1 - -let parse_conf_xml = fun vbox -> - let strings = ref [] in - Hashtbl.iter (fun name _ac -> strings := name :: !strings) Utils.aircrafts; - let compare_ignore_case = fun s1 s2 -> - String.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2) in - let ordered = List.sort compare_ignore_case ("" :: !strings) in - Gtk_tools.combo ordered vbox - -let editor = - try Sys.getenv "EDITOR" with _ -> ( - if Os_calls.contains (Os_calls.os_name) "Darwin" then - "open" - else - "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 gitk_version = fun sha -> - ignore (Sys.command (sprintf "gitk '%s'&" sha)) - - -let execute_cmd_and_return_text = fun cmd -> - let tmp_file = Filename.temp_file "" ".txt" in - let _ = Sys.command @@ cmd ^ " > " ^ tmp_file in - let chan = open_in tmp_file in - let s = input_line chan in - close_in chan; - s - -let tag_this_version = fun _ -> - (execute_cmd_and_return_text "git rev-parse HEAD") - -let get_commits_after_version = fun sha -> - (execute_cmd_and_return_text (sprintf "git rev-list %s..HEAD --count" sha)) - -let get_commits_outside_version = fun sha -> - (execute_cmd_and_return_text (sprintf "git rev-list HEAD..%s --count" sha)) - -let show_gitk_of_version = fun sha -> - GToolbox.message_box ~title:"Compare" ("There have been " ^ (get_commits_after_version sha ) ^ " commits since the last reported test.\n The last reported test used " ^ (get_commits_outside_version sha ) ^ " commits that are not in this branch."); - (execute_cmd_and_return_text (sprintf "gitk %s..HEAD & gitk HEAD..%s &" sha sha)) - -type ac_data = - Label of GMisc.label - | Tree of Gtk_tools.tree - -let string_of_ac_data = fun d -> - match d with - Label l -> l#text - | Tree t -> Gtk_tools.tree_values t - - -(* Awful but easier *) -let current_color = ref "white" - -let correct_ac_id = fun s -> - try - let n = int_of_string s in - 0 < n && n < 256 - with - _ -> false - -let correct_ac_name = fun s -> - let allowed_char = function - 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> () - | _ -> raise Exit in - try - String.iter allowed_char s; - s <> "" - with - Exit -> false - -(*TODO function text of date_type*) -let save_callback = fun ?user_save gui ac_combo tree tree_modules () -> - let ac_name = Gtk_tools.combo_value ac_combo - and ac_id = gui#entry_ac_id#text in - - if ac_name <> "" && ac_id <> "" then begin - if not (correct_ac_id ac_id) then - GToolbox.message_box ~title:"Error on A/C id" "A/C id must be a non null number less than 255" - else - let color = !current_color in - let attribs = ["name", ac_name; - "ac_id", ac_id; - "airframe", gui#label_airframe#text; - "radio", gui#label_radio#text; - "telemetry", gui#label_telemetry#text; - "flight_plan", gui#label_flight_plan#text; - "settings", Gtk_tools.tree_values ~only_checked:false tree; - "settings_modules", Gtk_tools.tree_values ~only_checked:false tree_modules; - "gui_color", color ] in - let attribs = if gui#label_release#text = "" then attribs else attribs @ ["release", gui#label_release#text ] in - let aircraft = Xml.Element ("aircraft", attribs, []) in - begin try Hashtbl.remove Utils.aircrafts ac_name with _ -> () end; - Hashtbl.add Utils.aircrafts ac_name aircraft - end; - write_conf_xml ?user_save () - -(* selected state type *) -type selected_t = Selected | Unselected | Unknown - -(* Get the settings (string list) with current modules *) -let get_settings_modules = fun ac_id aircraft_xml settings_modules -> - (* get modules *) - let ac = Aircraft.parse_aircraft ~parse_af:true ~parse_ap:true ~parse_fp:true "" aircraft_xml in - let modules = List.map (fun m -> (m.Module.xml, m.Module.xml_filename)) ac.Aircraft.all_modules in - (* get list of settings files *) - let settings = List.fold_left (fun l (m, f) -> - (* get list of settings_file xml node if any *) - let settings_file_list = List.filter (fun t -> Xml.tag t = "settings_file") (Xml.children m) in - let file_list = List.map (fun s -> "settings/"^(Xml.attrib s "name")) settings_file_list in - (* include module file in the list only if it has a 'settings' node *) - let settings_list = List.filter (fun t -> Xml.tag t = "settings") (Xml.children m) in - (*let module_file = if List.length settings_list > 0 then [Env.filter_absolute_path f] else [] in*) - (* include module file with specific name if they exist *) - let settings_list = List.fold_left (fun l s -> - try - let name = Xml.attrib s "name" in - (* test if there is no white space in settings name *) - if Str.string_match (Str.regexp ".* .*") name 0 - then failwith "Paparazzicenter: no white space allowed in modules settings name"; - l @ [(Env.filter_absolute_path f)^"~"^name^"~"] - with - | Failure x -> prerr_endline x; l @ [Env.filter_absolute_path f] - | _ -> l @ [Env.filter_absolute_path f] - ) [] settings_list in - l @ file_list (*@ module_file*) @ settings_list - ) [] modules in - (* store current state in a hashtable *) - let current = Hashtbl.create 7 in - let set = Str.split regexp_space settings_modules in - List.iter (fun s -> - let l = String.length s in - if s.[0] == '[' && s.[l - 1] = ']' - then Hashtbl.add current (String.sub s 1 (l - 2)) Unselected - else Hashtbl.add current s Selected - ) set; - (* build list with previous state if necessary *) - List.map (fun s -> - (* get previous state, unknonw otherwise (new module, will be selected by default) *) - let checked = try Hashtbl.find current s with _ -> Unknown in - (* add to tree with correct state *) - match checked with - | Selected | Unknown -> s - | Unselected -> ("["^s^"]") - ) settings - -let first_word = fun s -> - try - let n = String.index s ' ' in - String.sub s 0 n - with - Not_found -> s - -(** Test if an element is available for the current target *) - -(** Get list of targets of an airframe *) -let get_targets_list = fun ac_xml -> - let firmwares = List.filter (fun x -> ExtXml.tag_is x "firmware") (Xml.children ac_xml) in - let targets = List.map (fun f -> List.filter (fun x -> ExtXml.tag_is x "target") (Xml.children f)) firmwares in - List.flatten targets - -(** Parse Airframe File for Targets **) -let parse_ac_targets = fun target_combo ac_file (log:string->unit) -> - (* remember last target *) - let last_target = try Gtk_tools.combo_value target_combo with _ -> "" in - (* Clear ComboBox *) - let (store, column) = Gtk_tools.combo_model target_combo in - store#clear (); - (* add targets *) - try - let af_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // ac_file) in - let targets = get_targets_list af_xml in - if List.length targets > 0 then - List.iter (fun t -> Gtk_tools.add_to_combo target_combo (Xml.attrib t "name")) targets - else begin - Gtk_tools.add_to_combo target_combo "ap"; - Gtk_tools.add_to_combo target_combo "sim" - end; - Gtk_tools.select_in_combo target_combo last_target - with _ -> - log (sprintf "Error while parsing targets from file %s\n" ac_file); - raise Not_found - -(* Parse AC file for flash mode *) -let parse_ac_flash = fun target flash_combo ac_file -> - (* remember last flash mode *) - let last_flash_mode = Gtk_tools.combo_value flash_combo in - (* Clear ComboBox *) - let (store, column) = Gtk_tools.combo_model flash_combo in - store#clear (); - Gtk_tools.add_to_combo flash_combo "Default"; - try - let af_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // ac_file) in - let targets = get_targets_list af_xml in - let board = Xml.attrib (List.find (fun t -> Xml.attrib t "name" = target) targets) "board" in - (* board names as regexp *) - let flash_modes = ref [] in - Hashtbl.iter (fun b m -> - if Str.string_match (Str.regexp b) board 0 then - flash_modes := !flash_modes @ m; - ) (snd CP.flash_modes); - List.iter (fun m -> Gtk_tools.add_to_combo flash_combo m) !flash_modes; - (Gtk_tools.combo_widget flash_combo)#misc#set_sensitive (List.length !flash_modes > 0); - Gtk_tools.select_in_combo flash_combo last_flash_mode - with _ -> - (* not a valid airframe file *) - (Gtk_tools.combo_widget flash_combo)#misc#set_sensitive false; - raise Not_found - -(* Link A/C to airframe & flight_plan labels *) -let ac_combo_handler = fun gui (ac_combo:Gtk_tools.combo) target_combo flash_combo (log:string->unit) -> - (* build tree for settings *) - let tree_set = Gtk_tools.tree ~check_box:true gui#tree_settings in - (* build tree for modules settings *) - let tree_set_mod = Gtk_tools.tree ~check_box:true gui#tree_settings_modules in - - (* connect save_callback to the two toggle signals - * it can't be done before because we need the two tree models - *) - let (_, _, _, tree_signal) = Gtk_tools.tree_model tree_set in - ignore (tree_signal#toggled ~callback:(fun _ -> save_callback gui ac_combo tree_set tree_set_mod ())); - let (_, _, _, tree_signal) = Gtk_tools.tree_model tree_set_mod in - ignore (tree_signal#toggled ~callback:(fun _ -> save_callback gui ac_combo tree_set tree_set_mod ())); - - (* Link AC conf with labels and buttons *) - let ac_files = - [ "airframe", "airframes", Label gui#label_airframe, Some gui#button_browse_airframe, Some gui#button_edit_airframe, edit, None; - "flight_plan", "flight_plans", Label gui#label_flight_plan, Some gui#button_browse_flight_plan, Some gui#button_edit_flight_plan, gcs_or_edit, None; - "settings", "settings", Tree tree_set, Some gui#button_browse_settings, Some gui#button_edit_settings, edit, Some gui#button_remove_settings; - "settings_modules", "settings", Tree tree_set_mod, None, None, (fun _ -> ()), None; - "radio", "radios", Label gui#label_radio, Some gui#button_browse_radio, Some gui#button_edit_radio, edit, None; - "telemetry", "telemetry", Label gui#label_telemetry, Some gui#button_browse_telemetry, Some gui#button_edit_telemetry, edit, None; - "release", "release", Label gui#label_release, None, None, edit, None] - in - - (* Update_params callback *) - let update_params = fun ac_name -> - try - let aircraft = Hashtbl.find Utils.aircrafts ac_name in - let sample = aircraft_sample ac_name "42" in - (* update list of modules settings *) - let ac_id = ExtXml.attrib aircraft "ac_id" in - let settings_modules = try - get_settings_modules ac_id aircraft (ExtXml.attrib_or_default aircraft "settings_modules" "") - with - | Failure x -> prerr_endline x; [] - | _ -> [] - in - (* update aicraft hashtable *) - let aircraft = ExtXml.subst_attrib "settings_modules" (String.concat " " settings_modules) aircraft in - begin try Hashtbl.remove Utils.aircrafts ac_name with _ -> () end; - Hashtbl.add Utils.aircrafts ac_name aircraft; - let value = fun a -> try (ExtXml.attrib aircraft a) with _ -> Xml.attrib sample a in - (* update elements *) - List.iter (fun (a, _subdir, label, _, _, _, _) -> - match label with - | Label l -> l#set_text (value a) - | Tree t -> - ignore (Gtk_tools.clear_tree t); - let names = Str.split regexp_space (value a) in - List.iter (Gtk_tools.add_to_tree t) names; - ) ac_files; - let 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#button_upload#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; - (Gtk_tools.combo_widget target_combo)#misc#set_sensitive true; - (Gtk_tools.combo_widget flash_combo)#misc#set_sensitive true; - let last_flash_mode = try Gtk_tools.combo_value flash_combo with _ -> "Default" in - begin - (* try parsing target from airframe file, may fail if not valid *) - try parse_ac_targets target_combo (ExtXml.attrib aircraft "airframe") log with _ -> - (Gtk_tools.combo_widget target_combo)#misc#set_sensitive false; - gui#button_build#misc#set_sensitive false - end; - begin - try parse_ac_flash (Gtk_tools.combo_value target_combo) flash_combo (ExtXml.attrib aircraft "airframe") with _ -> - (Gtk_tools.combo_widget flash_combo)#misc#set_sensitive false; - gui#button_upload#misc#set_sensitive false - end; - Gtk_tools.select_in_combo flash_combo last_flash_mode; - with - Not_found -> - (* Not found in aircrafts hashtbl *) - gui#button_build#misc#set_sensitive false; - gui#button_clean#misc#set_sensitive false; - (Gtk_tools.combo_widget target_combo)#misc#set_sensitive false; - (Gtk_tools.combo_widget flash_combo)#misc#set_sensitive false; - log (sprintf "Aircraft %s not in conf\n" ac_name) - in - Gtk_tools.combo_connect ac_combo update_params; - - (* 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 -> - if not (correct_ac_name s) then - GToolbox.message_box ~title:"Error on A/C name" "A/C name must contain only letters, digits or underscores" - else if (Hashtbl.mem Utils.aircrafts s) then - GToolbox.message_box ~title:"Error on A/C name" "A/C name already exists in this conf" - else begin - let a = aircraft_sample s (string_of_int (new_ac_id ())) in - (* add to hashtbl before combo to avoid update errors *) - Hashtbl.add Utils.aircrafts s a; - Gtk_tools.add_to_combo ac_combo s; - update_params s - end - in - ignore (gui#menu_item_new_ac#connect#activate ~callback); - - (* Copy A/C button *) - let callback = fun _ -> - let selected_ac_name = Gtk_tools.combo_value ac_combo in - if selected_ac_name <> "" then - match GToolbox.input_string ~title:"Copy A/C" ~text:"MYAC" "New A/C name ?" with - | None -> () - | Some s -> - if not (correct_ac_name s) then - GToolbox.message_box ~title:"Error on A/C name" "A/C name must contain only letters, digits or underscores" - else if (Hashtbl.mem Utils.aircrafts s) then - GToolbox.message_box ~title:"Error on A/C name" "A/C name already exists in this conf" - else begin - let a = Hashtbl.find Utils.aircrafts selected_ac_name in - let af_old = Env.paparazzi_home // "conf" // (ExtXml.attrib a "airframe") in - let af_new = - match GToolbox.select_file ~title:"Copy to new airframe file" ~filename:af_old () with - | None -> af_old - | Some x -> x - in - let af_new = - if af_old = af_new then af_new - else - if Sys.command (sprintf "cp -f %s %s" af_old af_new) = 0 then af_new - else begin - GToolbox.message_box ~title:"Error on airframe copy" ("Using original airframe " // af_old); - af_old - end - in - let a = ExtXml.subst_attrib "name" s a in - let a = ExtXml.subst_attrib "airframe" (Env.filter_absolute_path af_new) a in - let a = ExtXml.subst_attrib "ac_id" (string_of_int (new_ac_id ())) a in - (* add to hashtbl before combo to avoid update errors *) - Hashtbl.add Utils.aircrafts s a; - Gtk_tools.add_to_combo ac_combo s; - update_params s - end - in - ignore (gui#menu_item_copy_ac#connect#activate ~callback); - - (* Delete A/C *) - let callback = fun _ -> - let ac_name = Gtk_tools.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 after Save)" ac_name) with - | 2 -> begin - begin try Hashtbl.remove Utils.aircrafts ac_name with _ -> () end; - let combo_box = Gtk_tools.combo_widget ac_combo in - match combo_box#active_iter with - | None -> () - | Some row -> - let (store, _column) = Gtk_tools.combo_model ac_combo in - ignore (store#remove row); - combo_box#set_active 1 - end - | _ -> () - in - ignore (gui#delete_ac_menu_item#connect#activate ~callback); - - (* 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) = Gtk_tools.combo_model target_combo in - let row = store#append () in - store#set ~row ~column s; - (Gtk_tools.combo_widget target_combo)#set_active_iter (Some row) - in - ignore (gui#menu_item_new_target#connect#activate ~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; - save_callback gui ac_combo tree_set tree_set_mod (); - 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); - - (* A/C id *) - ignore(gui#entry_ac_id#connect#changed ~callback:(fun () -> save_callback gui ac_combo tree_set tree_set_mod ())); - - let callback = fun _ -> - update_params (Gtk_tools.combo_value ac_combo); - save_callback gui ac_combo tree_set tree_set_mod () in - (* refresh button *) - ignore(gui#button_refresh#connect#clicked ~callback); - (* update with build and upload button *) - ignore(gui#button_build#connect#clicked ~callback); - ignore(gui#button_upload#connect#clicked ~callback); - - (* Conf *) - List.iter (fun (name, subdir, label, button_browse, button_edit, editor, button_remove) -> - (* editor button callback *) - let callback = fun _ -> - let rel_files = match label with - Label l -> Str.split regexp_space l#text - | Tree t -> Str.split regexp_space (Gtk_tools.tree_values ~only_checked:true t) - in - let abs_files = List.map (Filename.concat Utils.conf_dir) rel_files in - let quoted_files = List.map (fun s -> "'"^s^"'") abs_files in - let arg = String.concat " " quoted_files in - editor arg in - (* connect editor button *) - ignore (match button_edit with Some e -> ignore(e#connect#clicked ~callback) | _ -> ()); - - (* browse button callback *) - let callback = fun _ -> - let cb = fun names -> - ignore (match label with - Label l -> - let names = String.concat " " names in - l#set_text names - | Tree t -> - List.iter (Gtk_tools.add_to_tree t) names - ); - save_callback gui ac_combo tree_set tree_set_mod (); - let ac_name = Gtk_tools.combo_value ac_combo in - update_params ac_name - in - Utils.choose_xml_file name subdir cb in - (* connect browse button *) - ignore (match button_browse with Some b -> ignore(b#connect#clicked ~callback) | _ -> ()); - - (* remove button callback *) - let callback = fun _ -> - match label with - Tree t -> - Gtk_tools.remove_selected_from_tree t; - save_callback gui ac_combo tree_set tree_set_mod () - | _ -> () - in - (* connect remove button *) - ignore (match button_remove with Some r -> ignore(r#connect#clicked ~callback) | _ -> ()) - ) - ac_files; - - (* Tag Current Commit-Aircraft *) - let callback = fun _ -> - match GToolbox.question_box ~title:"Mark Test-flight Successfull" ~default:2 ~buttons:["Yes"; "Cancel"] "Are you sure you tested this airframe in all its modes (e.g. GPS) and confirm all works well." with - | 1 -> - begin - gui#label_release#set_text (tag_this_version () ); - save_callback gui ac_combo tree_set tree_set_mod (); - let ac_name = Gtk_tools.combo_value ac_combo in - update_params ac_name - - end - | _ -> () - in - ignore (gui#button_store_release#connect#clicked ~callback); - - (* Compare *) - let callback = fun _ -> - ignore (show_gitk_of_version gui#label_release#text) - in - ignore (gui#button_compare_release#connect#clicked ~callback); - - (* Browse Version *) - let callback = fun _ -> - gitk_version gui#label_release#text - in - ignore (gui#button_gitk#connect#clicked ~callback); - - - - (* Save button *) - ignore(gui#menu_item_save_ac#connect#activate ~callback:(save_callback ~user_save:true gui ac_combo tree_set tree_set_mod)) - - -let build_handler = fun ~file gui ac_combo (target_combo:Gtk_tools.combo) (flash_combo:Gtk_tools.combo) (log:string->unit) -> - (* Link target to upload button *) - Gtk_tools.combo_connect target_combo - (fun target -> - let ac_name = Gtk_tools.combo_value ac_combo in - let aircraft = Hashtbl.find Utils.aircrafts ac_name in - parse_ac_flash (Gtk_tools.combo_value target_combo) flash_combo (ExtXml.attrib aircraft "airframe"); - (* if target is sim or nps, deactivate the upload button *) - gui#button_upload#misc#set_sensitive (target <> "sim" && target <> "nps")); - - (* Clean button *) - let callback = fun () -> - Utils.command ~file gui log (Gtk_tools.combo_value ac_combo) "clean_ac" in - ignore (gui#button_clean#connect#clicked ~callback); - - (* Build button *) - let callback = fun () -> - try ( - let ac_name = Gtk_tools.combo_value ac_combo - and target = Gtk_tools.combo_value target_combo - and config = if gui#checkbutton_printconfig#active then "PRINT_CONFIG=1 " else "" in - let target_cmd = sprintf "%s%s.compile" config target in - gui#button_build#misc#set_sensitive false; - gui#button_upload#misc#set_sensitive false; - let finished_callback = fun () -> - gui#button_build#misc#set_sensitive true; - gui#button_upload#misc#set_sensitive true in - Utils.command ~file ~finished_callback gui log ac_name target_cmd - ) with _ -> log "ERROR: Nothing to build!!!\n" in - ignore (gui#button_build#connect#clicked ~callback); - - (* Upload button *) - let callback = fun () -> - let ac_name = Gtk_tools.combo_value ac_combo - and target = Gtk_tools.combo_value target_combo - and flash = Gtk_tools.combo_value flash_combo - and config = if gui#checkbutton_printconfig#active then "PRINT_CONFIG=1 " else "" in - let options = try Hashtbl.find (fst CP.flash_modes) flash with _ -> "" in - let target_cmd = sprintf "%s%s %s.upload" config options target in - gui#button_build#misc#set_sensitive false; - gui#button_upload#misc#set_sensitive false; - let finished_callback = fun () -> - gui#button_build#misc#set_sensitive true; - gui#button_upload#misc#set_sensitive true in - Utils.command ~file ~finished_callback gui log ac_name target_cmd in - ignore (gui#button_upload#connect#clicked ~callback) - diff --git a/sw/supervision/pc_common.ml b/sw/supervision/pc_common.ml deleted file mode 100644 index f69001a00a..0000000000 --- a/sw/supervision/pc_common.ml +++ /dev/null @@ -1,207 +0,0 @@ -(* - * 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_env "/bin/sh" [|"/bin/sh"; "-c"; cmd|] (Array.append (Unix.environment ()) [|"GTK_SETLOCALE=0";"LANG=C"|]) in_read in_write Unix.stderr in - Unix.close in_write; - pid, inchan - -let buf_size = 512 - -let run_and_log = fun log exit_cb com -> - let com = com ^ " 2>&1" in - let pid, com_stdout = my_open_process_in com in - let channel_out_fd = Unix.descr_of_in_channel com_stdout in - let channel_out = GMain.Io.channel_of_descr channel_out_fd in - let cb = fun _ -> - let buf = Bytes.create buf_size in - (* loop until input returns zero *) - let rec log_input = fun out -> - let n = input out buf 0 buf_size in - (* split on beginning of new line *) - let s = Str.split (Str.regexp "^") (Bytes.to_string (Bytes.sub buf 0 n)) in - List.iter (fun l -> log l) s; - if n = buf_size then (log_input out) + n else n - in - let count = log_input com_stdout in - if count = 0 then exit_cb true; - true - in - let io_watch_out = Glib.Io.add_watch ~cond:[`IN] ~callback:cb channel_out in - pid, channel_out, com_stdout, io_watch_out - -let strip_prefix = fun dir file subdir -> - let n = String.length dir in - if not (String.length file > n && String.sub file 0 n = dir) then begin - let home = Env.paparazzi_home in - let nn = String.length home in - if (String.length file > nn && String.sub file 0 nn = home) then begin - ".." // String.sub file (nn+1) (String.length file - nn -1) - end else - let msg = sprintf "Selected file '%s' should be in '%s'" file dir in - GToolbox.message_box ~title:"Error" msg; - raise Exit - end else - subdir // String.sub file (n+1) (String.length file - n - 1) - - -let choose_xml_file = fun ?(multiple = false) 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:"xml" ~patterns:["*.xml"] ()); - dialog#add_button_stock `CANCEL `CANCEL ; - dialog#add_select_button_stock `OPEN `OPEN ; - dialog#set_select_multiple multiple; - begin match dialog#run (), dialog#filename with - | `OPEN, _ when multiple -> - let names = dialog#get_filenames in - dialog#destroy (); - cb (List.map (fun f -> strip_prefix dir f subdir) names) - | `OPEN, Some name -> - dialog#destroy (); - cb [strip_prefix dir name subdir] - | _ -> dialog#destroy () - end - - - -let run_and_monitor = fun ?(once = false) ?file ?(finished_callback = fun () -> ()) gui log com_name com args -> - 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) - and outchan = ref stdin - and watches = ref [] in - let run = fun callback -> - let c = p#entry_program#text in - log (sprintf "RUN '%s'\n" c); - - let (pi, out, unixfd, io_watch) = run_and_log log callback ("exec "^c) in - pid := pi; - outchan := unixfd; - (* watch for hangup/end on the out io, after small delay call callback to stop/remove prog *) - let io_watch' = Glib.Io.add_watch ~cond:[`HUP] ~callback: - (fun _ -> - (* call with a delay of 200ms, not strictly needed anymore, but seems more pleasing to the eye *) - ignore (Glib.Timeout.add ~ms:200 ~callback:(fun () -> callback true; false)); - (* return true to not automatically remove event source, - otherwise will try to remove non existent source in callback, resulting in: - GLib-CRITICAL **: Source ID xxx was not found when attempting to remove it *) - true) out in - watches := [ io_watch; io_watch' ] in - - let remove_callback = fun () -> - gui#vbox_programs#remove p#toplevel#coerce in - - let rec callback = fun stop -> - match p#button_stop#label, stop with - "gtk-stop", _ -> - List.iter Glib.Io.remove !watches; - close_in !outchan; - ignore (Unix.kill !pid Sys.sigkill); - begin match Unix.waitpid [] !pid with - | (x, Unix.WEXITED 0) -> - log (sprintf "\nDONE '%s'\n\n" com); - | (x, Unix.WEXITED i) -> - log (sprintf "\nFAILED '%s' with code %i\n\n" com i); - | (x, _) -> - log (sprintf "\nSTOPPED '%s'\n\n" com); - end; - finished_callback (); - p#button_stop#set_label "gtk-redo"; - p#button_remove#misc#set_sensitive true; - if once then - remove_callback () - else 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)); - ignore (p#entry_program#connect#activate ~callback:(fun () -> callback false)); - run callback; - - (* Stop the program if the box is closed *) - let callback = fun () -> - callback true in - ignore(p#toplevel#connect#destroy ~callback); - - (* Remove button *) - ignore (p#button_remove#connect#clicked ~callback:remove_callback) - - -let basic_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 (fun _ -> ()) com) - - -let command = fun ?file ?finished_callback gui (log:string->unit) ac_name target -> - let com = sprintf "make -C %s -f Makefile.ac AIRCRAFT=%s %s" Env.paparazzi_src ac_name target in - run_and_monitor ~once:true ?file ?finished_callback gui log "make" com "" - - -let conf_is_set = fun home -> - Sys.file_exists home && - Sys.file_exists (home // "conf") && - Sys.file_exists (home // "data") - -(* This was the place where GnoDruid used to create a wizard configuring your - * paparazzi installation. This could be replaced with an implementation using - * GtkAssistant instead. The issue tracking this can be found at: - * https://github.com/paparazzi/paparazzi/issues/923 - *) - -let _ = - let home = Env.paparazzi_home in - if not (conf_is_set home) then - printf "ERROR: Configuration files need to be installed in your \ - Paparazzi home (%s). Run `make init` in the toplevel paparazzi \ - directory to do that in your Paparazzi home (%s) directory. To \ - use another directory, set the PAPARAZZI_HOME variable to the \ - desired folder.\n" home home - -let conf_xml_file = conf_dir // "conf.xml" -let backup_xml_file = conf_xml_file ^ "~" -let aircrafts = Hashtbl.create 7 -let build_aircrafts = fun () -> - let conf_xml = ExtXml.parse_file conf_xml_file in - List.iter (fun aircraft -> - Hashtbl.add aircrafts (ExtXml.attrib aircraft "name") aircraft) - (Xml.children conf_xml) diff --git a/sw/supervision/pc_control_panel.ml b/sw/supervision/pc_control_panel.ml deleted file mode 100644 index 613dee5f22..0000000000 --- a/sw/supervision/pc_control_panel.ml +++ /dev/null @@ -1,386 +0,0 @@ -(* - * 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 - -(*Search recursively files in a directory*) -let walk_directory_tree dir pattern = - let re = Str.regexp pattern in (* pre-compile the regexp *) - let select str = Str.string_match re str 0 in - let rec walk acc = function - | [] -> (acc) - | dir::tail -> - let contents = Array.to_list (Sys.readdir dir) in - let contents = List.rev_map (Filename.concat dir) contents in - let dirs, files = - List.fold_left (fun (dirs,files) f -> - match (Unix.stat f).Unix.st_kind with - | Unix.S_REG -> (dirs, f::files) (* Regular file *) - | Unix.S_DIR -> (f::dirs, files) (* Directory *) - | _ -> (dirs, files) - ) ([],[]) contents - in - let matched = List.filter (select) files in - walk (matched @ acc) (dirs @ tail) - in - walk [] [dir] - -let control_panel_xml_file = Utils.conf_dir // "control_panel.xml" -let control_panel_xml = ExtXml.parse_file control_panel_xml_file -let tools_directory = (Utils.conf_dir // "tools") -let tool_files = if (Sys.file_exists tools_directory) then (walk_directory_tree tools_directory ".*\\.xml") else [] -let tools_xml = List.map (fun f -> ExtXml.parse_file f) tool_files -let blacklist_file = tools_directory // "blacklisted" - -let rec build_list l channel = - try - build_list ((input_line channel) :: l) channel - with End_of_file -> close_in channel; List.rev l - -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 blacklisted programs*) - let b = if Sys.file_exists blacklist_file - then (List.filter (fun s -> ((String.length s) > 0 && (String.get s 0) != '#')) (build_list [] (open_in blacklist_file))) - else [] in - (*Adds tools to h*) - List.iter - (fun p -> Hashtbl.add h (ExtXml.attrib p "name") p) - tools_xml; - (*Overwrite tools in h by the custom configuration from control_panel.xml*) - List.iter - (fun p -> Hashtbl.replace h (ExtXml.attrib p "name") p) - (Xml.children s); - (*Remove blacklisted programs*) - List.iter - (fun p -> Hashtbl.remove h p) - b; - h - -let program_command = fun x -> - try - let xml = Hashtbl.find programs x in - let cmd = ExtXml.attrib xml "command" in - if cmd.[0] = '/' then - cmd - else if cmd.[0] = '$' then - String.sub cmd 1 ((String.length cmd) - 1) - else - Env.paparazzi_src // cmd - 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 flash_modes_xml_file = Utils.conf_dir // "flash_modes.xml" -let flash_mode_xml = ExtXml.parse_file flash_modes_xml_file -let flash_modes = - let modes = Hashtbl.create 7 in (* table mode -> options *) - let boards = Hashtbl.create 7 in (* table board -> modes *) - let fm_common = Xml.children flash_mode_xml in (* common modes in dedicated file *) - let fm_custom = try - Xml.children (ExtXml.child ~select:(fun x -> Xml.attrib x "name" = "flash_modes") control_panel_xml "section") with - _ -> [] in (* custom mode can be added to personal control_panel.xml file *) - List.iter (fun m -> - let mode = Xml.attrib m "name" in - (* list of boards *) - let board_list = try Xml.children (ExtXml.child m "boards") with _ -> [] in - let board_list = List.map (fun x -> Xml.attrib x "name") board_list in - (* build options for this mode *) - let options = List.map (fun o -> - sprintf "%s=%s" (Xml.attrib o "name") (Xml.attrib o "value") - ) (List.filter (fun t -> Xml.tag t = "variable") (Xml.children m)) in - let options = String.concat " " options in - (* add to hash tables *) - Hashtbl.add modes mode options; - List.iter (fun b -> - (* look if board is already in the table *) - let _modes = try Hashtbl.find boards b with _ -> [] in - (* add the new mode with together with the old ones *) - Hashtbl.replace boards b ([mode] @ _modes) - ) board_list; - ) (fm_common @ fm_custom); - (* convert string to regexp *) - modes, boards - - -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 args = Bytes.of_string args in - let marked_space = Char.chr 0 in - let in_quotes = ref false in - for i = 0 to Bytes.length args - 1 do - match Bytes.get args i with - ' ' when !in_quotes -> Bytes.set args i marked_space - | '"' -> in_quotes := not !in_quotes - | _ -> () - done; - (* Split *) - let args = Str.split (Str.regexp "[ ]+") (Bytes.to_string args) in - let args = List.map Bytes.of_string args in - (* Restore spaces and remove quotes *) - let restore_spaces = fun s -> - let n = Bytes.length s in - for i = 0 to n - 1 do - if Bytes.get s i = marked_space then Bytes.set s i ' ' - done; - if n >= 2 && Bytes.get s 0 = '"' then - Bytes.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 -> Bytes.length s > 0 && Bytes.get s 0 = '-' in - let rec xml_args = function - [] -> [] - | option::value::l when not (is_option value) -> - Xml.Element("arg", ["flag", Bytes.to_string option; "constant", Bytes.to_string value],[])::xml_args l - | option::l -> - Xml.Element("arg", ["flag", Bytes.to_string 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 get_simtype = fun (target_combo : Gtk_tools.combo) -> - (* get the list of possible targets *) - let targets = Gtk_tools.combo_values_list target_combo in - (* filter non simulator targets *) - let sim_targets = ["sim"; "nps"] in - let targets = List.filter (fun t -> List.mem t sim_targets) targets in - (* open question box and return corresponding simulator type *) - match targets with - [] -> "none" - | [t] -> t - | l -> - match GToolbox.question_box ~title:"Simulator type" ~buttons:l "Choose the simulator type:" with - | 0 -> "none" - | choice -> List.nth targets (choice-1) - -let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo : Gtk_tools.combo) -> - let get_program_args = fun program -> - let args = ref "" in - List.iter - (fun arg -> - let constant = - match try double_quote (Xml.attrib arg "constant") with _ -> "" with - "@AIRCRAFT" -> (Gtk_tools.combo_value ac_combo) - | "@AC_ID" -> gui#entry_ac_id#text - | const -> const in - args := sprintf "%s %s %s" !args (ExtXml.attrib arg "flag") constant) - (Xml.children program); - !args - in - - let run_gcs = fun () -> - let args = get_program_args (Hashtbl.find programs "PprzGCS") in - run_and_monitor ?file gui log "PprzGCS" args in - let run_server = fun args -> run_and_monitor ?file gui log "Server" args in - let choose_and_run_sitl = fun ac_name -> - let get_args = fun simtype ac_name -> - match simtype with - "sim" -> sprintf "-a %s -t %s --boot --norc" ac_name simtype - | "nps" -> sprintf "-a %s -t %s" ac_name simtype - | _ -> "none" - in - let sim_type = get_simtype target_combo in - let args = get_args sim_type ac_name in - if args <> "none" then begin - run_and_monitor ?file gui log "Simulator" args; - run_gcs (); - run_server "-n"; - if sim_type = "nps" then - run_and_monitor ?file gui log "Data Link" "-udp -udp_broadcast" - end - in - - (* Sessions *) - let session_combo = Gtk_tools.combo ~width:50 [] 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; - let strings = ref [] in - Hashtbl.iter (fun name _session -> strings := name :: !strings) sessions; - let ordered = List.sort String.compare !strings in - List.iter (fun name -> Gtk_tools.add_to_combo session_combo name) ordered - 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 args = get_program_args program in - run_and_monitor ?file gui log name args) - (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 () -> - choose_and_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 () -> - let args = get_program_args prog in - run_and_monitor ?file gui log name args 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 ~entries: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 diff --git a/sw/tools/gcs_launch.py b/sw/tools/gcs_launch.py old mode 100755 new mode 100644 index 7266b43c80..bc0c1513bd --- a/sw/tools/gcs_launch.py +++ b/sw/tools/gcs_launch.py @@ -1,73 +1,8 @@ #! /usr/bin/env python3 -from optparse import OptionParser, OptionGroup, OptionValueError -import subprocess -from os import getenv, path, execvp - -HOME = getenv("PAPARAZZI_HOME", path.normpath(path.join(path.dirname(path.abspath(__file__)), '../../'))) -LEGACY_GCS_PATH = path.join(HOME, "sw", "ground_segment", "cockpit", "gcs") - - -def pprzgcs_help(option, opt, value, parser): - try: - cp = subprocess.run(["pprzgcs", "-h"], capture_output=True) - # trim to relevant output - lines = cp.stdout.decode().split("\n")[4:] - options = "\n".join(lines) - print("PprzGCS options:\n\n" + options) - exit(0) - except FileNotFoundError: - print("PprzGCS not found!") - exit(1) - - -def legacy_help(option, opt, value, parser): - try: - cp = subprocess.run([LEGACY_GCS_PATH, "--help"], capture_output=True) - # trim to relevant output - lines = cp.stdout.decode().split("\n")[1:] - options = "\n".join(lines) - print("Legacy GCS options:\n\n" + options) - exit(0) - except FileNotFoundError: - print("Legacy GCS not found!") - exit(1) - - -def main(): - - usage = "usage: %prog -g -- [GCS arguments]\n" + \ - "Run %prog --help to list the options." - parser = OptionParser(usage) - - parser.add_option("-g", "--gcs", dest="gcstype", - type='choice', choices=['pprzgcs', 'legacy'], - action="store", help="GCS type to start: pprgcs or legacy") - parser.add_option("--pprzgcs_help", dest="pprzgcs_help", action="callback", callback=pprzgcs_help, - help="Print help for pprzgcs") - parser.add_option("--legacy_help", dest="legacy_help", action="callback", callback=legacy_help, - help="Print help for legacy GCS") - - (options, args) = parser.parse_args() - - def run_gcs(cmd, args, error_msg): - try: - args = [cmd] + args - print("Running \"" + " ".join(args) + "\"") - execvp(cmd, args) - except FileNotFoundError: - print(error_msg) - - if options.gcstype == "pprzgcs": - run_gcs("pprzgcs", args, "PprzGCS not found!") - elif options.gcstype == "legacy": - run_gcs(LEGACY_GCS_PATH, args, "Legacy GCS not found!") - elif options.gcstype is None: - run_gcs("pprzgcs", args, "PprzGCS not found!") - run_gcs(LEGACY_GCS_PATH, args, "Legacy GCS not found!") - if __name__ == "__main__": - main() + print('Error: This wrapper has been removed. Please use directly the "PprzGCS" tool.') + print('You are probably using a custom control_panel.xml. Remove the "PprzGCS" tool from the "programs" section of your control panel.')