mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-05-27 17:06:31 +08:00
remove some long obsolete perl files
This commit is contained in:
Felix Ruess
@@ -1,25 +0,0 @@
|
|||||||
#
|
|
||||||
# $Id$
|
|
||||||
# Copyright (C) 2004 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.
|
|
||||||
#
|
|
||||||
|
|
||||||
This directory contains code that use the festival speech engine to
|
|
||||||
pronounce warnings and parameters.
|
|
||||||
It uses Ivy
|
|
||||||
@@ -1,216 +0,0 @@
|
|||||||
#!/usr/bin/perl -w
|
|
||||||
|
|
||||||
package PaparazziSpeak;
|
|
||||||
|
|
||||||
my @paparazzi_lib;
|
|
||||||
BEGIN {
|
|
||||||
@paparazzi_lib = (defined $ENV{PAPARAZZI_SRC}) ?
|
|
||||||
($ENV{PAPARAZZI_SRC}."/sw/lib/perl"):();
|
|
||||||
}
|
|
||||||
use lib (@paparazzi_lib);
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use Paparazzi::Environment;
|
|
||||||
|
|
||||||
use constant APP_ID => "Paparazzi Speaker";
|
|
||||||
use constant MESSAGE_WHEN_READY => APP_ID." : READY";
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
use IO::Socket;
|
|
||||||
use POSIX;
|
|
||||||
use Getopt::Long;
|
|
||||||
use Ivy;
|
|
||||||
|
|
||||||
use Paparazzi::IvyProtocol;
|
|
||||||
|
|
||||||
|
|
||||||
sub new() {
|
|
||||||
|
|
||||||
my ($proto, $festd_host, $festd_port) = @_;
|
|
||||||
my $self = {
|
|
||||||
'ivy' => undef,
|
|
||||||
'festival_handle' => undef,
|
|
||||||
'vbat' => 0,
|
|
||||||
'cur_wp' => -1,
|
|
||||||
'cnt_nav' => 0,
|
|
||||||
};
|
|
||||||
$self->{options} = {
|
|
||||||
# paparazzi_home => $paparazzi_home,
|
|
||||||
ivy_bus => "127.255.255.255:2010",
|
|
||||||
};
|
|
||||||
|
|
||||||
bless $self;
|
|
||||||
$self->parse_args();
|
|
||||||
$self->start_ivy();
|
|
||||||
$self->connect_to_festival($festd_host, $festd_port);
|
|
||||||
$self->say_hello();
|
|
||||||
|
|
||||||
# Trap signal in order to exit cleanly
|
|
||||||
$SIG{TERM} = \&catchSigTerm ;
|
|
||||||
|
|
||||||
return $self;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_args {
|
|
||||||
my ($self) = @_;
|
|
||||||
my $options = $self->{options};
|
|
||||||
GetOptions ("b=s" => \$options->{ivy_bus},
|
|
||||||
"t=s" => \$options->{paparazzi_home},
|
|
||||||
);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub start_ivy() {
|
|
||||||
my ($self) = @_;
|
|
||||||
Ivy->init (-ivyBus => $self->{options}->{ivy_bus},
|
|
||||||
-appName => APP_ID,
|
|
||||||
-loopMode => 'LOCAL',
|
|
||||||
-messWhenReady => MESSAGE_WHEN_READY,
|
|
||||||
) ;
|
|
||||||
my $paparazzi_home = Paparazzi::Environment::paparazzi_home();
|
|
||||||
Paparazzi::IvyProtocol::read_protocol($paparazzi_home."/conf/messages.xml", "ground");
|
|
||||||
Paparazzi::IvyProtocol::read_protocol($paparazzi_home."/conf/messages.xml", "aircraft_info");
|
|
||||||
|
|
||||||
$self->{ivy} = Ivy->new (-statusFunc => \&ivyStatusCbk) ;
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::CALIB_START_Regexp(), [$self, \&ivyOnCalibStart]);
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::CALIB_CONTRAST_Regexp(), [$self, \&ivyOnCalibContrast]);
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::NAVIGATION_Regexp(), [$self, \&ivyOnNavigation]);
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::BAT_Regexp(), [$self, \&ivyOnBat]);
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::PPRZ_MODE_Regexp(), [$self, \&ivyOnPprzMode]);
|
|
||||||
# $self->{ivy}->bindRegexp (IvyMsgs::TAKEOFF_Regexp(), [$self, \&ivyOnTakeOff]);
|
|
||||||
$self->{ivy}->start() ;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub catchSigTerm() {
|
|
||||||
print ("in catchSigTerm\n");
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyStatusCbk {
|
|
||||||
print ("in ivyStatusCbk\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
sub say_hello() {
|
|
||||||
my ($self) = @_;
|
|
||||||
$self->speak('<EMP>Hello.</EMP> Welcome to <PRON SUB=\"Paparraddzee\">Paparazzi.</PRON>');
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnNavigation() {
|
|
||||||
my ($self, $sender, $cur_wp, $pos_x, $pos_y, $desired_course, $dist2_wp, $course_pgain) = @_;
|
|
||||||
# printf("NAVIGATION wp $cur_wp, x $pos_x, y $pos_y, dc $desired_course, d2wp $dist2_wp, cpg $course_pgain\n");
|
|
||||||
|
|
||||||
if ($self->{cur_wp} != $cur_wp) {
|
|
||||||
$self->speak(sprintf("current waypoint : <EMP>%s.</EMP>", $cur_wp));
|
|
||||||
$self->{cur_wp} = $cur_wp;
|
|
||||||
$self->{cnt_nav} = 0;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my $rdist = floor(sqrt($dist2_wp)/10)*10;
|
|
||||||
printf "dist2wp $rdist\n";
|
|
||||||
if (($rdist ge 100 and $self->{cnt_nav} == 16) or
|
|
||||||
($rdist ge 20 and $rdist le 100 and ($self->{cnt_nav})%5 == 0)) {
|
|
||||||
$self->speak(sprintf("distance to waypoint : <EMP>%s.</EMP> meters", $rdist));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
$self->{cnt_nav}++;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnBat() {
|
|
||||||
my ($self, $sender, $voltage, $flight_time, $low_battery) = @_;
|
|
||||||
my $vbat = $voltage/10;
|
|
||||||
|
|
||||||
if ($voltage le $low_battery) {
|
|
||||||
if ($self->{vbat} != $vbat) {
|
|
||||||
$self->speak(sprintf("battery : <EMP> Warning : battery low : %s volts.</EMP>", $vbat));
|
|
||||||
$self->{vbat} = $vbat;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if (abs($self->{vbat} - $vbat) ge 0.2) {
|
|
||||||
$self->speak(sprintf("battery : <EMP>%s</EMP> volts.", $vbat));
|
|
||||||
$self->{vbat} = $vbat;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnPprzMode() {
|
|
||||||
my @autopilot_mode_name=("manual", "auto one", "auto two", "home");
|
|
||||||
my ($self, $sender, $ap_mode, $ap_altitude, $if_calib_mode, $mcu1_status, $lls_calib) = @_;
|
|
||||||
if ($self->{ap_mode} != $ap_mode) {
|
|
||||||
my $ap_str = $autopilot_mode_name[$ap_mode];
|
|
||||||
$self->speak(sprintf("autopilot mode : <EMP>%s.</EMP>", $ap_str));
|
|
||||||
$self->{ap_mode} = $ap_mode;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnCalibStart() {
|
|
||||||
my ($self, $sender) = @_;
|
|
||||||
$self->speak("<EMP>contrast</EMP> calibration triggered");
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnCalibContrast() {
|
|
||||||
my ($self, $sender, $adc) = @_;
|
|
||||||
my $pc_contrast = ceil($adc / 1024 * 100);
|
|
||||||
my $txt = sprintf("contrast <EMP>%s</EMP>per cent", $pc_contrast);
|
|
||||||
print "txt $txt\n";
|
|
||||||
$self->speak($txt);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ivyOnTakeOff() {
|
|
||||||
my ($self, $sender) = @_;
|
|
||||||
$self->speak('<VOLUME LEVEL=\"loud\"><EMP>Take Off</EMP></VOLUME>');
|
|
||||||
}
|
|
||||||
|
|
||||||
sub speak() {
|
|
||||||
my ($self, $what) = @_;
|
|
||||||
my $handle = $self->{festival_handle};
|
|
||||||
my $sable_fmt =
|
|
||||||
'<!DOCTYPE SABLE PUBLIC \"-//SABLE//DTD SABLE speech mark up//EN\" \"Sable.v0_2.dtd\" []>
|
|
||||||
<SABLE>
|
|
||||||
<SPEAKER NAME=\"male1\">
|
|
||||||
|
|
||||||
%s
|
|
||||||
|
|
||||||
</SPEAKER>
|
|
||||||
</SABLE>';
|
|
||||||
|
|
||||||
my $cmd_fmt = sprintf("(tts_text \"%s\" \'sable)\n", $sable_fmt);
|
|
||||||
my $fest_cmd = sprintf $cmd_fmt, $what;
|
|
||||||
print $handle $fest_cmd;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub connect_to_festival() {
|
|
||||||
my ($self, $host, $port) = @_;
|
|
||||||
$self->{festival_handle} = IO::Socket::INET->new(Proto => "tcp",
|
|
||||||
PeerAddr => $host,
|
|
||||||
PeerPort => $port);
|
|
||||||
$self->{festival_handle}->autoflush(1);
|
|
||||||
Ivy->fileEvent($self->{festival_handle}, [\&FestivalOnReceive, $self]);
|
|
||||||
print STDERR "[Connected to $host:$port]\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub FestivalOnReceive {
|
|
||||||
my ($self) = @_;
|
|
||||||
my $file_stuff_key = "ft_StUfF_key"; # defined in speech tools
|
|
||||||
print "FestivalOnReceive\n";
|
|
||||||
my $handle = $self->{festival_handle};
|
|
||||||
my $line = <$handle>;
|
|
||||||
|
|
||||||
# print "line: [$line]\n";
|
|
||||||
# if ($line eq "WV\n") { # we have a waveform coming
|
|
||||||
# print "Waveform\n";
|
|
||||||
# }
|
|
||||||
|
|
||||||
# if ($line eq "LP\n") { # we have a waveform coming
|
|
||||||
# print "Lisp\n";
|
|
||||||
# }
|
|
||||||
# if ($line =~ s/$file_stuff_key(.*)$//s) {
|
|
||||||
# print STDOUT $line;
|
|
||||||
# }
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
PaparazziSpeak->new("localhost", 1314);
|
|
||||||
Ivy->mainLoop();
|
|
||||||
|
|
||||||
@@ -1,482 +0,0 @@
|
|||||||
#!/usr/bin/perl -w
|
|
||||||
use Getopt::Long;
|
|
||||||
use Tk;
|
|
||||||
|
|
||||||
package Ploter;
|
|
||||||
|
|
||||||
use Tk::LabEntry;
|
|
||||||
use Tk::FileSelect;
|
|
||||||
use Tk::DialogBox;
|
|
||||||
use XML::Parser;
|
|
||||||
use XML::DOM;
|
|
||||||
use Expect;
|
|
||||||
use Data::Dumper;
|
|
||||||
use Getopt::Long;
|
|
||||||
|
|
||||||
my $paparazzi_lib;
|
|
||||||
BEGIN {
|
|
||||||
$paparazzi_lib = (defined $ENV{PAPARAZZI_SRC}) ?
|
|
||||||
$ENV{PAPARAZZI_SRC}."/sw/lib/perl" : "/usr/lib/paparazzi/";
|
|
||||||
}
|
|
||||||
use lib ($paparazzi_lib);
|
|
||||||
|
|
||||||
#use ChildrenSpawner;
|
|
||||||
@ISA = qw(Subject);
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
use diagnostics;
|
|
||||||
use Paparazzi::Environment;
|
|
||||||
|
|
||||||
use Subject;
|
|
||||||
|
|
||||||
|
|
||||||
my $log_date;
|
|
||||||
my $log_duration;
|
|
||||||
my $log_filename;
|
|
||||||
|
|
||||||
my $time_range="[]";
|
|
||||||
my $tr_entry;
|
|
||||||
|
|
||||||
my $pi = 3.14159;
|
|
||||||
|
|
||||||
sub populate {
|
|
||||||
my ($self, $args) = @_;
|
|
||||||
my $paparazzi_src = Paparazzi::Environment::paparazzi_src();
|
|
||||||
my $paparazzi_home = Paparazzi::Environment::paparazzi_home();
|
|
||||||
Paparazzi::Environment::check_paparazzi_home();
|
|
||||||
# $args->{-variables} = {paparazzi_home => $paparazzi_home}; #A quoi ça sert ?
|
|
||||||
# $args->{-bin_base_dir} = $paparazzi_src; #A quoi ça sert ?
|
|
||||||
# $self->SUPER::populate($args); #A quoi ça sert ?
|
|
||||||
$self->configspec(-log => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef]);
|
|
||||||
$self->configspec(-log_start_date => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef]);
|
|
||||||
$self->configspec(-protocol => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef]);
|
|
||||||
$self->configspec(-listbox => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef]);
|
|
||||||
$self->configspec(-gnuplots => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef]);
|
|
||||||
$self->configspec(-variables => [S_SUPER, S_SUPER, S_SUPER, S_SUPER, S_SUPER, {}]);
|
|
||||||
# print("in Ploter::populate\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
sub completeinit {
|
|
||||||
my $self = shift;
|
|
||||||
$self->SUPER::completeinit;
|
|
||||||
$self->configure('-protocol' => undef); #A retirer je suppose
|
|
||||||
$self->build_gui();
|
|
||||||
# print("in Ploter::completeinit\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
#
|
|
||||||
# XML
|
|
||||||
#
|
|
||||||
sub parse_messages_xml() {
|
|
||||||
my $self = shift;
|
|
||||||
my $filename = Paparazzi::Environment::paparazzi_src()."/conf/messages.xml";
|
|
||||||
my $parser = XML::DOM::Parser->new();
|
|
||||||
my $doc = $parser->parsefile($filename);
|
|
||||||
$self->{messages} = $doc;
|
|
||||||
print STDOUT "successfully parsed $filename\n";
|
|
||||||
return $doc;
|
|
||||||
}
|
|
||||||
|
|
||||||
#
|
|
||||||
# Menus
|
|
||||||
#
|
|
||||||
sub build_menu_msg() {
|
|
||||||
my ($self, $doc, $menubar) = @_;
|
|
||||||
my $data_menu = $menubar->cascade(-label => "~Data");
|
|
||||||
$self->{data_menu} = $data_menu;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub update_menu_msg() {
|
|
||||||
my ($self, $ac_name, $ac_id) = @_;
|
|
||||||
my $data_menu = $self->{data_menu};
|
|
||||||
my $doc = $self->{messages};
|
|
||||||
my $menubar = $self->{menubar};
|
|
||||||
my $ac_menu = $data_menu->cascade(-label => "$ac_name ($ac_id)");
|
|
||||||
$self->parse_protocol($doc, $ac_menu, $ac_id);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_protocol() {
|
|
||||||
my ($self, $doc, $ac_menu, $ac_id) = @_;
|
|
||||||
my $protocol = $doc->getElementsByTagName('protocol')->[0];
|
|
||||||
print "found protocol \n";
|
|
||||||
$self->parse_class($protocol, $ac_menu, $ac_id);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_class() {
|
|
||||||
my ($self, $protocol, $ac_menu, $ac_id) = @_;
|
|
||||||
my $class_name;
|
|
||||||
foreach my $class ($protocol->getElementsByTagName('class')) {
|
|
||||||
$class_name = $class->getAttribute('name');
|
|
||||||
if ($class_name eq "telemetry") {
|
|
||||||
print "found telemetry class \n";
|
|
||||||
$self->parse_msg($class, $ac_menu, $ac_id);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_msg() {
|
|
||||||
my ($self, $class, $ac_menu, $ac_id) = @_;
|
|
||||||
my $msg_name;
|
|
||||||
foreach my $message ($class->getElementsByTagName('message')) {
|
|
||||||
$msg_name = $message->getAttribute('name');
|
|
||||||
# print "found message $msg_name \n";
|
|
||||||
my $msg_menu = $ac_menu->cascade(-label => $msg_name);
|
|
||||||
$self->build_field_commands($message, $msg_name, $msg_menu, $ac_id);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub build_field_commands() {
|
|
||||||
my ($self, $message, $msg_name, $msg_menu, $ac_id) = @_;
|
|
||||||
my $no_field = 0;
|
|
||||||
foreach my $field ($message->getElementsByTagName('field')) {
|
|
||||||
my $field_name = $field->getAttribute('name');
|
|
||||||
my $field_unit = $field->getAttribute('unit');
|
|
||||||
# print "found field $field_name \n";
|
|
||||||
my $no_field1 = $no_field;
|
|
||||||
my $file_menu = $msg_menu->command(-label => $field_name,
|
|
||||||
-command => sub {on_plot($self, $msg_name, $field_name, $no_field1, $ac_id, $field_unit)});
|
|
||||||
$no_field++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub build_log_menu() {
|
|
||||||
my ($self, $mainwindow, $menubar) = @_;
|
|
||||||
my $log_menu = $menubar->cascade(-label => "~Log",);
|
|
||||||
my $new_log_menu = $log_menu->command(-label => "~Open new log",
|
|
||||||
-command => sub { on_new_log($self, $mainwindow)});
|
|
||||||
# my $add_log_menu = $log_menu->command(-label => "~Add new log",
|
|
||||||
# -command => sub { on_add_log($self, $mainwindow)});
|
|
||||||
}
|
|
||||||
|
|
||||||
sub build_gui() {
|
|
||||||
my ($self) = @_;
|
|
||||||
my $width = 700;
|
|
||||||
my $height = 300;
|
|
||||||
my $mw = MainWindow->new;
|
|
||||||
$mw->geometry(sprintf("%dx%d", $width, $height));
|
|
||||||
$mw->title("Paparazzi (gnu)plotter");
|
|
||||||
|
|
||||||
my $mb = $mw->Menu();
|
|
||||||
$self->{menubar} = $mb;
|
|
||||||
$self->build_log_menu($mw, $mb);
|
|
||||||
# my $log_menu = $mb->command(-label => "~Log",
|
|
||||||
# -command => sub { on_load($self, $mw)});
|
|
||||||
$self->build_menu_msg($self->parse_messages_xml(), $mb);
|
|
||||||
# $self->build_compiled_msg_menu($mb);
|
|
||||||
$mw->configure(-menu => $mb);
|
|
||||||
|
|
||||||
my $padx = 10;
|
|
||||||
|
|
||||||
my $filename_label = $self->add_label("filename :", \$log_filename, 0, $padx, $mw);
|
|
||||||
my $date_label = $self->add_label("date :", \$log_date, 1, $padx, $mw);
|
|
||||||
my $duration_label = $self->add_label("duration :", \$log_duration, 2, $padx, $mw);
|
|
||||||
|
|
||||||
my $time_range_label = $mw->Label( -text => "time range")->pack(-side=>'left');
|
|
||||||
$time_range_label->grid (-column=>0, -row=>3, -ipadx=>$padx);
|
|
||||||
$tr_entry = $mw->Entry(-width => 25);
|
|
||||||
$tr_entry->grid (-column=>1, -row=>3, -ipadx=>$padx);
|
|
||||||
$tr_entry->insert(0, $time_range);
|
|
||||||
|
|
||||||
my $button = $mw->Button (-text => "update",
|
|
||||||
-command=> sub { update_time_range($self)},
|
|
||||||
);
|
|
||||||
$button->grid (-column=>2, -row=>3, -ipadx=>$padx);
|
|
||||||
|
|
||||||
my $listbox = $mw->Listbox();
|
|
||||||
$listbox->grid (-column=>0, -columnspan => 3, -row=>4, -ipadx=>$padx);
|
|
||||||
$listbox->bind('<Double-1>', sub {$self->on_list_clicked($listbox, $mw)});
|
|
||||||
$self->configure('-listbox' => $listbox);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub add_label() {
|
|
||||||
my ($self, $text, $text_variable, $row, $padx, $mw) = @_;
|
|
||||||
my $label1 = $mw->Label( -text => $text);
|
|
||||||
$label1->grid (-column=>0, -row=>$row, -ipadx=>$padx, -sticky => 'e' );
|
|
||||||
my $label2 = $mw->Label( -textvariable => $text_variable);
|
|
||||||
$label2->grid (-column=>1, -row=>$row, -ipadx=>$padx, -sticky => 'w');
|
|
||||||
return $label2;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub on_list_clicked() {
|
|
||||||
my ($self, $listbox, $mw) = @_;
|
|
||||||
my $key = $listbox->get('active');
|
|
||||||
my $gnuplots = $self->get('-gnuplots');
|
|
||||||
my $gnuplot = $gnuplots->{$key};
|
|
||||||
my $plot_cmd = $gnuplot->{'plot_cmd'};
|
|
||||||
my $dialog;
|
|
||||||
if ($gnuplot->{'normal'}) {
|
|
||||||
$dialog = $mw->DialogBox( -title => "Plot command",
|
|
||||||
-buttons => [ "Replot", "Print", "Remove", "Add points", "Cancel" ],
|
|
||||||
); }
|
|
||||||
else {
|
|
||||||
$dialog = $mw->DialogBox( -title => "Plot command",
|
|
||||||
-buttons => [ "Replot", "Remove", "Cancel" ],
|
|
||||||
); }
|
|
||||||
|
|
||||||
$dialog->add("Label", -text => "Plot command")->pack();
|
|
||||||
# print "plot_cmd $plot_cmd\n";
|
|
||||||
my $entry = $dialog->add("Entry", -width => 150)->pack();
|
|
||||||
$entry->insert(0,$plot_cmd);
|
|
||||||
print "selected key $key\n";
|
|
||||||
my $answer = $dialog->Show();
|
|
||||||
print "selected $answer\n";
|
|
||||||
my ($new_plot_cmd, $exp);
|
|
||||||
my $timeout = 1;
|
|
||||||
if ($answer eq "Add points") {
|
|
||||||
$key =~ /([^\.]+).([^\.]+).([^\.]+).([^\.]+)/ or return;
|
|
||||||
my ($msg_name, $ac_id, $field_name, $field_pos) = ($1, $2, $3, $4);
|
|
||||||
my $rpos = $field_pos + 3;
|
|
||||||
|
|
||||||
my $last_plot_cmd = $entry->get();
|
|
||||||
my $plot_points_cmd = "\"/tmp/plot_data.$msg_name.$ac_id\" using 1:$rpos w p not";
|
|
||||||
$new_plot_cmd = $last_plot_cmd.", ".$plot_points_cmd;
|
|
||||||
$entry->configure(-text => $new_plot_cmd);
|
|
||||||
|
|
||||||
print("add points to $key \n");
|
|
||||||
$gnuplot->{'plot_cmd'} = $new_plot_cmd;
|
|
||||||
$exp = $gnuplot->{'exp'};
|
|
||||||
$exp->send($new_plot_cmd."\n");
|
|
||||||
$exp->expect($timeout);
|
|
||||||
}
|
|
||||||
if ($answer eq "Replot") {
|
|
||||||
$new_plot_cmd = $entry->get();
|
|
||||||
print("new_plot_cmd $new_plot_cmd \n");
|
|
||||||
$gnuplot->{'plot_cmd'} = $new_plot_cmd;
|
|
||||||
$exp = $gnuplot->{'exp'};
|
|
||||||
# print "exp $exp\n";
|
|
||||||
$exp->send($new_plot_cmd."\n");
|
|
||||||
$exp->expect($timeout);
|
|
||||||
}
|
|
||||||
if ($answer eq "Print") {
|
|
||||||
$self->print_plot($key, $entry);
|
|
||||||
}
|
|
||||||
if ($answer eq "Remove") {
|
|
||||||
$self->remove_plot($key);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub update_time_range() {
|
|
||||||
my ($self) = @_;
|
|
||||||
my $gnuplots = $self->get('-gnuplots');
|
|
||||||
$time_range = $tr_entry->get();
|
|
||||||
foreach my $key (keys %{$gnuplots}) {
|
|
||||||
my $gnuplot = $gnuplots->{$key};
|
|
||||||
my $exp = $gnuplot->{'exp'};
|
|
||||||
if (defined $exp) {
|
|
||||||
print "update_range_for_key $key ($gnuplots->{$key})\n";
|
|
||||||
my $plot_cmd = $gnuplot->{'plot_cmd'};
|
|
||||||
print "plot_cmd $time_range [$plot_cmd]\n";
|
|
||||||
$plot_cmd =~ s/\[.*\]/$time_range/;
|
|
||||||
print "new_plot_cmd $plot_cmd\n\n";
|
|
||||||
$gnuplot->{'plot_cmd'} = $plot_cmd;
|
|
||||||
$exp->send($plot_cmd."\n");
|
|
||||||
my $timeout = 1;
|
|
||||||
$exp->expect($timeout);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub open_log() {
|
|
||||||
my ($self, $mw) = @_;
|
|
||||||
my $fs = $mw->FileSelect(-directory => Paparazzi::Environment::paparazzi_home()."/var/logs");
|
|
||||||
$fs->geometry("600x350");
|
|
||||||
my $file_name = $fs->Show();
|
|
||||||
if (defined $file_name) {
|
|
||||||
print "file_name: $file_name\n";
|
|
||||||
$self->load_log($file_name);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub on_plot() {
|
|
||||||
my ($self, $msg_name, $field_name, $field_pos, $ac_id, $field_unit) = @_;
|
|
||||||
print "in on_plot msg_name $msg_name, field_name $field_name, field_pos $field_pos, ac_id $ac_id, field_unit $field_unit \n";
|
|
||||||
|
|
||||||
my $key = $msg_name.".".$ac_id.".".$field_name.".".$field_pos;
|
|
||||||
$self->gen_data_file($msg_name, $ac_id);
|
|
||||||
$self->add_plot($key, $field_unit);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub on_new_log() {
|
|
||||||
my ($self, $mainwindow) = @_;
|
|
||||||
my $log;
|
|
||||||
push (@{$log}, {date=>"", ac_id=>"", type=>"", args=>""});
|
|
||||||
$self->configure('-log' => $log);
|
|
||||||
$self->open_log($mainwindow);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub load_log() {
|
|
||||||
my ($self, $filename) = @_;
|
|
||||||
$log_filename = $filename;
|
|
||||||
my $nb_lines = 0;
|
|
||||||
open(INFILE, $filename) or die print STDERR "Cant open $filename: $!";
|
|
||||||
my $log = $self->get('-log');
|
|
||||||
$log_date = undef;
|
|
||||||
my $ac_list;
|
|
||||||
my $line;
|
|
||||||
while ($line = <INFILE>) { # assigns each line in turn to $_
|
|
||||||
if ($line =~ /(^\d+\.\d+) (\d+) (\w+) (.+)/) {
|
|
||||||
$log_date = $1 unless defined $log_date;
|
|
||||||
my $rel_date = $1 - $log_date;
|
|
||||||
push (@{$log}, {date=>$rel_date, ac_id=>$2, type=>$3, args=>$4});
|
|
||||||
$self->{ac_list}->{name}->{$2} = 1;
|
|
||||||
# push (@{$self->{ac_list}->{$2}}, {date=>$rel_date, type=>$3, args=>$4});
|
|
||||||
$nb_lines++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
close INFILE;
|
|
||||||
$self->configure('-log' => $log);
|
|
||||||
$self->configure( '-log_start_date' => $log_date);
|
|
||||||
$log_duration = "aaa";
|
|
||||||
|
|
||||||
|
|
||||||
print STDERR "read $nb_lines lines\n";
|
|
||||||
$self->parse_conf();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_conf() {
|
|
||||||
my ($self) = @_;
|
|
||||||
my $filename = Paparazzi::Environment::paparazzi_src()."/conf/conf.xml";
|
|
||||||
my $parser = XML::DOM::Parser->new();
|
|
||||||
my $doc = $parser->parsefile($filename);
|
|
||||||
my ($aircraft_name, $aircraft_id);
|
|
||||||
my $aircraft_no = 0;
|
|
||||||
foreach my $aircraft ($doc->getElementsByTagName('aircraft')) {
|
|
||||||
$aircraft_name = $aircraft->getAttribute('name');
|
|
||||||
$aircraft_id = $aircraft->getAttribute('ac_id');
|
|
||||||
# print "search aircraft $aircraft_name with id $aircraft_ac_id... \n";
|
|
||||||
if (defined $self->{ac_list}->{name}->{$aircraft_id}) {
|
|
||||||
print "found aircraft $aircraft_name \n";
|
|
||||||
$self->{ac_list}->{name}->{$aircraft_id} = $aircraft_name;
|
|
||||||
$aircraft_no++;
|
|
||||||
$self->update_menu_msg($aircraft_name, $aircraft_id);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
print "=> found $aircraft_no aircrafts \n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub add_plot() {
|
|
||||||
my ($self, $data_key, $field_unit) = @_;
|
|
||||||
|
|
||||||
$data_key =~ /([^\.]+).([^\.]+).([^\.]+).([^\.]+)/ or return;
|
|
||||||
my ($msg_name, $ac_id, $field_name, $field_pos) = ($1, $2, $3, $4);
|
|
||||||
my $ac_name = $self->{ac_list}->{name}->{$ac_id};
|
|
||||||
|
|
||||||
my $gnuplots = $self->get('-gnuplots');
|
|
||||||
|
|
||||||
my $exp = new Expect();
|
|
||||||
$exp->raw_pty(1);
|
|
||||||
|
|
||||||
my $rpos = $field_pos + 3;
|
|
||||||
my $nb_plots = scalar(keys(%{$gnuplots}));
|
|
||||||
my $h = $nb_plots * 260;
|
|
||||||
my $timeout = 1;
|
|
||||||
|
|
||||||
#Do not open again already open keys. Just show it.
|
|
||||||
if (defined $gnuplots->{$data_key}) {
|
|
||||||
print ("$data_key is already open \n");
|
|
||||||
$exp = $gnuplots->{$data_key}->{'exp'};
|
|
||||||
$exp->send($gnuplots->{$data_key}->{'plot_cmd'}."\n");
|
|
||||||
$exp->expect($timeout);
|
|
||||||
}
|
|
||||||
#Key is not in current list. Show it.
|
|
||||||
else {
|
|
||||||
my $plot_cmd = "plot $time_range \"/tmp/plot_data.$msg_name.$ac_id\" using 1:$rpos t \"$ac_name : $field_name ($field_unit)\" w l";
|
|
||||||
my $pid = $exp->spawn("/usr/bin/gnuplot", ("-geometry", "1350x200+0+$h", "-title", "$msg_name.$field_name"));
|
|
||||||
$pid->log_stdout(0);
|
|
||||||
my $gnuplot = { 'plot_cmd' => $plot_cmd,
|
|
||||||
'exp' => $exp,
|
|
||||||
'normal' => 1
|
|
||||||
};
|
|
||||||
$gnuplots->{$data_key} = $gnuplot;
|
|
||||||
$self->configure('-gnuplots' => $gnuplots);
|
|
||||||
|
|
||||||
$exp->send($plot_cmd."\n");
|
|
||||||
$exp->expect($timeout);
|
|
||||||
|
|
||||||
my $listbox = $self->get('-listbox');
|
|
||||||
$listbox->insert('end', "$data_key");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub print_plot() {
|
|
||||||
my ($self, $data_key, $entry) = @_;
|
|
||||||
|
|
||||||
$data_key =~ /([^\.]+).([^\.]+).([^\.]+).([^\.]+)/ or return;
|
|
||||||
my ($msg_name, $ac_id, $field_name, $field_pos) = ($1, $2, $3, $4);
|
|
||||||
my $ac_name = $self->{ac_list}->{name}->{$ac_id};
|
|
||||||
|
|
||||||
my $set_terminal_cmd = "set terminal jpeg giant size 1350,400";
|
|
||||||
my $set_output_cmd = "set output \"$log_filename\_print/$ac_name.$msg_name.$field_name.jpg\"";
|
|
||||||
my $plot_cmd = $entry->get();
|
|
||||||
my $print_cmd = "$set_terminal_cmd; $set_output_cmd; $plot_cmd";
|
|
||||||
|
|
||||||
mkdir $log_filename."_print/";
|
|
||||||
|
|
||||||
my $gnuplots = $self->get('-gnuplots');
|
|
||||||
my $exp = new Expect();
|
|
||||||
$exp->raw_pty(1);
|
|
||||||
|
|
||||||
my $pid = $exp->spawn("/usr/bin/gnuplot", ("-geometry", "1x1+0+0")) or die "Don't find gnuplot";
|
|
||||||
$pid->log_stdout(0);
|
|
||||||
print("Printing $plot_cmd \n");
|
|
||||||
$exp->send($print_cmd."\n");
|
|
||||||
my $timeout = 1;
|
|
||||||
$exp->expect($timeout);
|
|
||||||
$exp->hard_close();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub remove_plot() {
|
|
||||||
my ($self, $data_key) = @_;
|
|
||||||
my $gnuplots = $self->get('-gnuplots');
|
|
||||||
my $gnuplot = $gnuplots->{$data_key};
|
|
||||||
my $exp = $gnuplot->{'exp'};
|
|
||||||
# $exp->soft_close();
|
|
||||||
$exp->hard_close();
|
|
||||||
$gnuplots->{$data_key} = undef;
|
|
||||||
$self->configure('-gnuplots' => $gnuplots);
|
|
||||||
my $listbox = $self->get('-listbox');
|
|
||||||
print "remove $data_key\n";
|
|
||||||
my $idx = $listbox->index('active');
|
|
||||||
$listbox->delete($idx);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub gen_data_file() {
|
|
||||||
my ($self, $msg_name, $ac_id) = @_;
|
|
||||||
my $nb_msgs = 0;
|
|
||||||
my $tmp_file = "/tmp/plot_data.$msg_name.$ac_id";
|
|
||||||
open(OUTFILE, ">".$tmp_file) or die "Can t open $tmp_file: $!";
|
|
||||||
foreach (@{$self->get('-log')}) {
|
|
||||||
# print "$_->{type} eq $msg_name \n";
|
|
||||||
if (($_->{type} eq $msg_name && $_->{ac_id} == $ac_id) || $_->{type} eq " ") {
|
|
||||||
print OUTFILE "$_->{date} $_->{type} $_->{args}\n";
|
|
||||||
$nb_msgs++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
close OUTFILE;
|
|
||||||
print STDERR "Number of messages $nb_msgs for $msg_name \n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub catchSigTerm() {
|
|
||||||
my ($self) = @_;
|
|
||||||
printf("in catchSigTerm\n");
|
|
||||||
my %gnuplots = $self->get('-gnuplots');
|
|
||||||
foreach my $key (keys %gnuplots) {
|
|
||||||
print ("killing $key (%gnuplots{$key}->{'pid'})\n");
|
|
||||||
$self->kill_gnuplot($key);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub tan { sin($_[0]) / cos($_[0]) }
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
$SIG{TERM} = \&catchSigTerm ;
|
|
||||||
#$SIG{KILL} = \&catchSigTerm ;
|
|
||||||
my $ploter = Ploter->new();
|
|
||||||
#$ploter->load_log("../../var/log_05_08_04__12_50_09");
|
|
||||||
Tk::MainLoop();
|
|
||||||
$ploter->catchSigTerm();
|
|
||||||
printf STDOUT "ploter over\n";
|
|
||||||
|
|
||||||
1;
|
|
||||||
@@ -1,31 +0,0 @@
|
|||||||
#!/usr/bin/perl -w
|
|
||||||
|
|
||||||
use Getopt::Long;
|
|
||||||
my @paparazzi_lib;
|
|
||||||
BEGIN {
|
|
||||||
@paparazzi_lib = (defined $ENV{PAPARAZZI_SRC}) ?
|
|
||||||
($ENV{PAPARAZZI_SRC}."/sw/lib/perl", $ENV{PAPARAZZI_SRC}."/sw/ground_segment/cockpit"):();
|
|
||||||
}
|
|
||||||
use lib (@paparazzi_lib);
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use Paparazzi::Environment;
|
|
||||||
|
|
||||||
my $options = {};
|
|
||||||
GetOptions (
|
|
||||||
"b=s" => \$options->{ivy_bus},
|
|
||||||
"a=s" => \$options->{aircraft},
|
|
||||||
"fg=s" => \$options->{fg},
|
|
||||||
"boot" => \$options->{boot},
|
|
||||||
"norc" => \$options->{norc},
|
|
||||||
"launch" => \$options->{launch},
|
|
||||||
);
|
|
||||||
my @args = ();
|
|
||||||
push @args, "-b", $options->{ivy_bus} if defined $options->{ivy_bus};
|
|
||||||
push @args, "-fg", $options->{fg} if defined $options->{fg};
|
|
||||||
push @args, "-norc" if defined $options->{norc};
|
|
||||||
push @args, "-boot" if defined $options->{boot};
|
|
||||||
push @args, "-launch" if defined $options->{launch};
|
|
||||||
my $sim_binary = Paparazzi::Environment::paparazzi_home()."/var/".$options->{aircraft}."/sim/simsitl";
|
|
||||||
die "Error: $sim_binary not found. Build target 'sim' for $options->{aircraft} (make AIRCRAFT=$options->{aircraft} sim)\n" unless -e $sim_binary;
|
|
||||||
exec ($sim_binary, @args)
|
|
||||||
Reference in New Issue
Block a user