This is just a simple snippet that uses Tk::Zinc's radar display widgets, a socket connection, and a Tk compass to remote control a drone plane. It is only tested for rudimentary steering,
but someone may find some useful code in here. First start the radar screen, then start the controller. Dragging the clock hand on the controller will steer the plane.
## radar screen .... start first
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Tk;
use Tk::Zinc;
$|=1;
$SIG{PIPE} = 'IGNORE';
my $listen = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => 7070,
Listen => 1,
Reuse => 1,
) or die "Can't create listen socket : $!\n";
my $mw = MainWindow->new();
$mw->geometry('+30+30');
my $bits = pack("b32"x 16,
"...............1................",
"..............111...............",
"..............111...............",
"..............111...............",
".............11111..............",
"..1111111111111111111111111111..",
"..1111111111111111111111111111..",
"..............111...............",
"..............111...............",
"..............111...............",
"..............111...............",
"..............111...............",
"..............111...............",
"...........111111111............",
"...............1................",
"................................",
);
$mw->DefineBitmap('symbol' => 32,16, $bits);
my $zinc = $mw->Zinc(-width => 600,
-height => 600,
-backcolor => 'black'
)->pack;
#create a group with it's origin at center
my $og = $zinc->add('group',1,-visible=> 1);
$zinc->scale($og,1,-1); #reverse direction of y axis
$zinc->translate($og,300,300);
my $labelformat = "x80x60+0+0 x63a0^0^0 x33a0^0>1 a0a0>2>1 x33a0>3>1 a
+0a0^0>2";
my $current_heading = 0;
my $dx = 0;
my $dy = 1;
my $track = $zinc->add('track', $og, 6, # 6 is the number of field in
+the flightlabel
-symbolcolor=>"lightgreen",
-position => [0, 0],#position of the marker
-speedvector => [0, 20],#ccords of the speed vector
-speedvectorcolor => 'green',
-markersize => 10,
-labelformat => $labelformat,
-circlehistory => 1,
-labeldistance => 15,
-connectioncolor => 'grey50',
-leadercolor =>'white',
-markercolor => 'blue',
-markersize => 50,
-symbol => 'symbol',
-leaderwidth => 0,
-historycolor => 'white',
-filledhistory => 1,
-circlehistory => 1,
-historyvisible => 10,
);
#
# moving the track, to display past positions
#foreach my $i (0..5) { $zinc->coords($track,[$x+$i*10,$y-$i*5]); }
#fields of the label#
$zinc->itemconfigure($track, 0,#configuration of field 0 of the label
-filled => 1,
-bordercolor => 'DarkGreen',
-border => "contour",
);
$zinc->itemconfigure($track, 1,
-filled => 1,
-backcolor => 'hotpink',
-color => 'black',
-text => "Perl6");
$zinc->itemconfigure($track, 2,
-filled => 1,
-backcolor => 'lightgreen',
-color => 'black',
-text => "2010");
$zinc->itemconfigure($track, 3,
-filled => 1,
-backcolor => 'white',
-text => "/");
$zinc->itemconfigure($track, 4,
-filled => 1,
-backcolor => 'white',
-color => 'black',
-text => "555");
$zinc->itemconfigure($track, 5,
-filled => 1,
-backcolor => 'lightsteelblue',
-color => 'black',
-text => "USA");
my $subframe = $mw->Frame()->pack();
$subframe->Button(-text => 'Clear',
-command => sub {
$zinc->treset($track);
})->pack(-side=>'left');
$subframe->Button(-text => 'Save Log',
-command => sub { })->pack(-side=>'left');
$subframe->Button(-text => 'Exit',
-command => sub { exit })->pack(-side=>'right');
$mw->fileevent($listen, 'readable', sub { &new_connection($listen) });
$mw->repeat(10,sub{
for(1..10){
$zinc->translate($track,.02*$dx,.02*$dy); #adjust for spee
+d
}
});
MainLoop;
############################################################3
sub handle_connection {
my ($client) = @_;
my $new_heading;
my $n = sysread($client, $new_heading, 8);
if ( $n > 0 ) {
my @tget = $zinc->tget($track);
#now rotate around center
my $delta_heading = $current_heading - $new_heading;
$zinc->rotate($track, $delta_heading, 'degree', $tget[4], $tget[5
+] );
$current_heading = $new_heading;
$dx = cos(.01745 * (90 - $new_heading ));
$dy = sin(.01745 * (90 - $new_heading ));
}
else {
$client->close();
}
}
sub new_connection {
my ($listen) = @_;
my $client = $listen->accept() or warn "Can't accept connection";
$client->autoflush(1);
$mw->fileevent($client, 'readable', sub { &handle_connection($clie
+nt) });
#$client->print("Connected\n");
# $text->insert('end', "Connected\t");
# $text->see('end');
print "connected\n";
}
####################################################################
__END__
##### the controller ############################
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use IO::Socket;
$|=1;
$SIG{PIPE} = 'IGNORE';
my $sock = new IO::Socket::INET (
PeerAddr => 'localhost',
PeerPort => '7070',
Proto => 'tcp',
);
if($sock){ $sock->autoflush(1);}else{
warn "Could not create socket: $!\n" unless $sock }
my $mw = MainWindow->new;
my $gray50_width = 2;
my $gray50_height = 2;
my $gray50_bits = pack "CC", 0x02, 0x01;
$mw->DefineBitmap('mask' => 2,2, $gray50_bits);
$mw->fontCreate('medium',
-family=>'courier',
-weight=>'bold',
-size=>int(-14*14/10));
my $c = $mw->Canvas(
-width => 200,
-height => 200,
-bd => 2,
-relief => 'sunken',
-background => 'black',
)->pack;
$c->createLine(100,100,100,10,
-tags => ['needle'],
-arrow => 'last',
-width => 5,
-smooth => 1,
-splinesteps => 20,
-fill => 'hotpink',
);
my $gauge = $c->createOval(
10,10, 190,190,
-fill=> 'lightblue',
-outline => 'skyblue',
-width => 5,
-tags => ['gauge'],
-stipple => 'mask',
);
my $hub = $c->createOval(
90,90, 110,110,
-fill => 'lightgreen',
-outline => 'seagreen',
-width => 2,
-tags => ['hub'],
);
my $indicator = $c->createOval(
95,95, 105,105,
-fill => 'red',
-outline => 'black',
-width => 1,
-state => 'hidden',
-tags => ['ind'],
);
$mw->bind('<B1-Motion>' => sub{
my $ev = $c->XEvent;
&local_adjust($ev->x,$ev->y, 0);
});
my $text = $c->createText(
100,50,
-text => 0,
-font => 'medium',
-fill => 'yellow',
-anchor => 's',
-tags => ['text']
);
$c->raise('needle','text');
$c->raise('hub','needle');
$c->raise('ind','hub');
MainLoop;
######################################################################
+#####
sub local_adjust{
my($x,$y,$remote) = @_;
# transform coords center to 100,100
$x = $x - 100;
$y = 100 - $y;
#handle case where mouse crosses hub center
#and causes division by 0
if($x == $y){return}
my $cos = $x/(($x**2 + $y**2)**(.5));
my $sin = $y/(($x**2 + $y**2)**(.5));
my $x1 = 100.0 + 90.0 * $cos;
my $y1 = 100.0 - 90.0 * $sin;
$c->coords('needle', 100,100, $x1, $y1);
#see perldoc -f cos
#convert to radians 180/PI
my $angle = 90 - sprintf('%.2d', 57.2956 * atan2( sqrt(1 - $cos * $
+cos), $cos ));
if( $y < 0){ $angle = 180 - $angle }
if( $angle < 0){ $angle = 360 + $angle }
$c->itemconfigure($text,-text => $angle);
if( defined $sock){
syswrite( $sock, $angle, 8);
}
}
__END__