diff --git a/sw/ground_segment/cockpit/Paparazzi/InfraredPage.pm b/sw/ground_segment/cockpit/Paparazzi/InfraredPage.pm index cd20a043d4..35890af1f3 100644 --- a/sw/ground_segment/cockpit/Paparazzi/InfraredPage.pm +++ b/sw/ground_segment/cockpit/Paparazzi/InfraredPage.pm @@ -24,7 +24,6 @@ sub populate { sub completeinit { my $self = shift; $self->SUPER::completeinit(); -# $self->build_gui(); $self->{timer_id} = $self->get('-zinc')->repeat(UPDATE_REPEAT, [\&onTimer, $self]); } diff --git a/sw/ground_segment/cockpit/Paparazzi/SettingsPage.pm b/sw/ground_segment/cockpit/Paparazzi/SettingsPage.pm index b5a99eeb55..f01a876774 100644 --- a/sw/ground_segment/cockpit/Paparazzi/SettingsPage.pm +++ b/sw/ground_segment/cockpit/Paparazzi/SettingsPage.pm @@ -62,7 +62,6 @@ sub update_field { $label = $self->{'value_'.$ap_mode."_".$if_mode."_".$slider}; $zinc->itemconfigure($label, -color => 'green') if defined $label; $self->configure( 'ap_mode' => $ap_mode, 'if_mode' => $if_mode); - # print "$ap_mode $if_mode $slider $label\n"; } } else { diff --git a/sw/ground_segment/cockpit/Paparazzi/Strip.pm b/sw/ground_segment/cockpit/Paparazzi/Strip.pm index dd83ddeec3..d2c804b95d 100644 --- a/sw/ground_segment/cockpit/Paparazzi/Strip.pm +++ b/sw/ground_segment/cockpit/Paparazzi/Strip.pm @@ -390,7 +390,8 @@ sub aircraft_config_changed { # $self->border_block() if (defined $new_value) ; # display blocks of flight plan } elsif ($event eq 'airframe') { - $self->get('-zinc')->itemconfigure($self->{ident}, -text => scalar $new_value->get('-name')) if defined $new_value; + my $ac_name = $new_value->get('-ac_name'); + $self->get('-zinc')->itemconfigure($self->{ident}, -text => $ac_name ) if defined $ac_name; } elsif ($event eq 'rc_status' or $event eq 'rc_mode' or $event eq 'contrast_status' or $event eq 'ap_mode' or $event eq 'gps_mode') { $self->set_item($event, $new_value, $self->get_color($event, $new_value)); diff --git a/sw/ground_segment/cockpit/cockpit.pl b/sw/ground_segment/cockpit/cockpit.pl index e67ba5a869..84c1478391 100755 --- a/sw/ground_segment/cockpit/cockpit.pl +++ b/sw/ground_segment/cockpit/cockpit.pl @@ -26,7 +26,6 @@ use Paparazzi::PFD; use Paparazzi::ND; use Paparazzi::MissionD; use Paparazzi::StripPanel; -use Paparazzi::Geometry; use Tk; #use Tk::PNG; @@ -59,7 +58,10 @@ sub completeinit { -app_name => APP_NAME, -loop_mode => 'TK', ); - $self->{aircrafts_manager} = Paparazzi::AircraftsManager->new(-listen_to_all => 1); + $self->{aircrafts_manager} = + Paparazzi::AircraftsManager->new(-listen_to_all => + ['FLIGHT_PARAM', 'AP_STATUS', 'NAV_STATUS', 'CAM_STATUS', 'ENGINE_STATUS', + 'FLY_BY_WIRE', 'INFRARED', 'INFLIGH_CALIB', 'SVSINFO']); $self->{aircrafts_manager}->attach($self, 'NEW_AIRCRAFT', [\&on_new_aircraft]); $self->{mw}->after(500, [\&on_foo, $self]); } @@ -75,7 +77,6 @@ sub on_new_aircraft { sub build_gui { my ($self) = @_; $self->{mw} = MainWindow->new(); -# $self->{mw}->geometry("1280x1024"); my $top_frame = $self->{mw}->Frame()->pack(-side => 'top', -fill => 'both'); my $bot_frame = $self->{mw}->Frame()->pack(-side => 'bottom', -fill => 'both', -expand => 1); my ($stp_p, $stp_w, $stp_h) = ([0, 0], 315, 300); @@ -106,7 +107,6 @@ sub build_gui { -width => $nd_w, -height => $nd_h, ); -# $self->{nd}->attach($self, 'WIND_COMMAND', ['onWindCommand']); my $md = $bot_frame->MissionD(-bg => '#c1daff'); $md->pack(-side => 'bottom', -anchor => "n", -fill => 'both', -expand => 1); $self->{md} = $md; @@ -135,7 +135,7 @@ sub on_aircraft_selection { sub select_ac { my ($self, $ac_id) = @_; $self->{selected_ac} = $ac_id; - $self->{aircrafts_manager}->listen_to_ac($ac_id); + $self->{aircrafts_manager}->configure('-selected_aircrafts' => [$ac_id]); my $aircraft = $self->{aircrafts_manager}->get_aircraft_by_id($ac_id); $self->{pfd}->configure('-selected_ac', $aircraft); $self->{nd}->configure('-selected_ac', $aircraft); diff --git a/sw/lib/perl/Paparazzi/AircraftsManager.pm b/sw/lib/perl/Paparazzi/AircraftsManager.pm index 3c680ee22e..2fd1ad76ee 100644 --- a/sw/lib/perl/Paparazzi/AircraftsManager.pm +++ b/sw/lib/perl/Paparazzi/AircraftsManager.pm @@ -32,13 +32,13 @@ use Paparazzi::Aircraft; use Paparazzi::Flightplan; use Paparazzi::Airframe; - - sub populate { my ($self, $args) = @_; $self->SUPER::populate($args); - $self->configspec( - -listen_to_all => [S_NOINIT, S_METHOD, S_RDWR, S_OVRWRT, S_NOPRPG, 0], + $self->configspec( + -listen_to_all => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, []], + -listen_to_selected => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, []], + -selected_aircrafts => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, []], -aircrafts => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, {}], -pubevts => [S_NEEDINIT, S_PASSIVE, S_RDWR, S_APPEND, S_NOPRPG,[]], ); @@ -54,7 +54,7 @@ sub completeinit { sub start { my ($self) = @_; Paparazzi::IvyProtocol::send_request("ground", "ground", "AIRCRAFTS", {}, [\&on_aircrafts, $self]); - Paparazzi::IvyProtocol::bind_msg("ground", "ground", "NEW_AIRCRAFT", + Paparazzi::IvyProtocol::bind_msg("ground", "ground", "NEW_AIRCRAFT", {}, [\&on_aircraft_new_die, $self]); } @@ -64,46 +64,35 @@ sub on_aircraft_new_die { } sub on_aircrafts { -# print "AircraftsManager::on_aircrafts\n"; my ($sender_name, $msg_class, $msg_name, $fields, $self) = @_; -# use Data::Dumper; -# print "in AircraftsManager::on_aircrafts : dumping fields\n ".Dumper($fields); my $ac_list = $fields->{ac_list}; foreach my $ac_id (@{$ac_list}) { $self->add_aircraft($ac_id) unless $ac_id eq ""; } } - sub add_aircraft { my ($self, $ac_id) = @_; Paparazzi::IvyProtocol::send_request("ground", "ground", "CONFIG", {ac_id => $ac_id}, [\&on_config, $self]) unless $ac_id eq ""; my $aircraft = Paparazzi::Aircraft->new(-ac_id => $ac_id); $self->get('-aircrafts')->{$ac_id} = $aircraft; - $self->listen_to_ac($ac_id) if ($self->get('-listen_to_all')); - -# print "int AircraftsManager : notifying new ac $ac_id\n"; + my $all_ac_msg = $self->get('-listen_to_all'); + foreach my $msg_name (@{$all_ac_msg}) { + Paparazzi::IvyProtocol::bind_msg("ground", "ground", $msg_name, {aircraft_id => $ac_id}, + [\&on_ac_msg, $self]); + } $self->notify('NEW_AIRCRAFT', $ac_id); } - sub on_config { my ($sender_name, $msg_class, $msg_name, $fields, $self) = @_; -# print "AircraftsManager::on_config\n"; -# use Data::Dumper; -# print "fields ".Dumper($fields)."\n"; my $ac_id = $fields->{ac_id}; my $ac = $self->get('-aircrafts')->{$ac_id}; delete $fields->{ac_id}; - my $fp_url = $fields->{flight_plan}; if (defined $fp_url) { - # print "in AircraftsManager : on_config creating new flight plan\n"; my $fp = Paparazzi::Flightplan->new(-url => $fp_url); -# use Data::Dumper; -# print "##### waypoints\n".Dumper($fp->get('-waypoints')); -# print "##### mission\n".Dumper($fp->get('-mission')); $fields->{flight_plan} = $fp; } my $airframe_url = $fields->{airframe}; @@ -111,7 +100,6 @@ sub on_config { my $af = Paparazzi::Airframe->new(-url => $airframe_url); $fields->{airframe} = $af; } - $ac->configure(%{$fields}); } @@ -119,7 +107,6 @@ sub on_ac_msg { my ($sender_name, $msg_class, $msg_name, $fields, $self) = @_; my $ac_id = $fields->{ac_id}; my $aircraft = $self->get('-aircrafts')->{$ac_id}; -# print "AircraftsManager::on_ac_msg : $msg_name\n".Dumper($fields); if (defined ($aircraft)) { delete $fields->{ac_id}; if ($msg_name eq "SVSINFO" or $msg_name eq "ENGINE_STATUS") { @@ -134,20 +121,6 @@ sub on_ac_msg { } } -sub listen_to_ac { - my ($self, $ac_id) = @_; - my @ac_msgs = ( 'FLIGHT_PARAM', 'AP_STATUS', 'NAV_STATUS', 'CAM_STATUS', 'ENGINE_STATUS', - 'FLY_BY_WIRE', 'INFRARED', 'INFLIGH_CALIB', 'SVSINFO'); - foreach my $msg_name (@ac_msgs) { - Paparazzi::IvyProtocol::bind_msg("ground", "ground", $msg_name, {aircraft_id => $ac_id}, - [\&on_ac_msg, $self]); - } -} - -sub listen_to_all { - -} - sub get_aircraft_by_id { my ($self, $id) = @_; return $self->get('-aircrafts')->{$id}; diff --git a/sw/lib/perl/Paparazzi/Airframe.pm b/sw/lib/perl/Paparazzi/Airframe.pm index 805e772911..6726dcc27c 100644 --- a/sw/lib/perl/Paparazzi/Airframe.pm +++ b/sw/lib/perl/Paparazzi/Airframe.pm @@ -4,7 +4,7 @@ use Subject; @ISA = ("Subject"); use strict; -use XML::DOM; +require XML::DOM; require LWP::Simple; sub populate { @@ -12,7 +12,7 @@ sub populate { $self->SUPER::populate($args); $self->configspec( -url => [S_NEEDINIT, S_PASSIVE, S_RDONLY, S_OVRWRT, S_NOPRPG, undef], - -name => [S_NOINIT, S_PASSIVE, S_RDONLY, S_OVRWRT, S_NOPRPG, undef], + -ac_name => [S_NOINIT, S_PASSIVE, S_RDWR, S_OVRWRT, S_NOPRPG, undef], ); } @@ -20,19 +20,17 @@ sub completeinit { my $self = shift; $self->SUPER::completeinit(); my $airframe_url = $self->get('-url'); - print "in Airframe::compleetinit url $airframe_url\n"; +# print "in Airframe::completeinit url $airframe_url\n"; my $airframe_xml = LWP::Simple::get($airframe_url); - $self->parse_airframe($airframe_xml) if defined $airframe_xml; } sub parse_airframe { my ($self, $airframe_xml) = @_; - my $parser = XML::DOM::Parser->new(); my $doc = $parser->parse($airframe_xml); my $airframe = $doc->getElementsByTagName('airframe')->[0]; - $self->configure( -name => $airframe->getAttribute('name')); + $self->configure( -ac_name => $airframe->getAttribute('name')); } 1; diff --git a/sw/lib/perl/Paparazzi/Flightplan.pm b/sw/lib/perl/Paparazzi/Flightplan.pm index 727e027f7f..51a6d60687 100644 --- a/sw/lib/perl/Paparazzi/Flightplan.pm +++ b/sw/lib/perl/Paparazzi/Flightplan.pm @@ -87,22 +87,17 @@ sub completeinit { print "###### flight_plan_url $flight_plan_url\n"; -# my $flight_plan_xml =""; my $flight_plan_xml = LWP::Simple::get($flight_plan_url); if (defined $flight_plan_xml) { $self->configure( -compiled_xml => $flight_plan_xml); + my $doc = $parser->parse($flight_plan_xml); + $self->{doc} = $doc; + $self->parse_flight_plan(); } else { print "############WARNING : could not get $flight_plan_url\n"; return; } - -# print "#######flight_plan_xml\n".$flight_plan_xml; - - my $doc = $parser->parse($flight_plan_xml); -# print "in Flightplan : parsing $file $doc \n"; - $self->{doc} = $doc; - $self->parse_flight_plan(); } sub parse_flight_plan { @@ -125,12 +120,13 @@ sub parse_flight_plan { sub configure_spec { my ($self) = @_; - $self->configure( -nav_utm_east0 => $self->{nav_utm_east0}, - -nav_utm_north0 => $self->{nav_utm_north0}, - -max_dist_from_home => $self->{max_dist_from_home}, - -waypoints => $self->{waypoints}, - -nb_waypoints => $self->{nb_waypoints}, - -mission => $self->{mission}); + $self->configure( -nav_utm_east0 => $self->{nav_utm_east0}, + -nav_utm_north0 => $self->{nav_utm_north0}, + -max_dist_from_home => $self->{max_dist_from_home}, + -waypoints => $self->{waypoints}, + -nb_waypoints => $self->{nb_waypoints}, + -mission => $self->{mission}, + ); } sub parse_rc_control {