Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Tk Zinc Drone plane control

by zentara (Archbishop)
on Dec 16, 2006 at 22:02 UTC ( #590233=snippet: print w/replies, xml ) Need Help??
Description: 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__
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://590233]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2021-06-21 08:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (98 votes). Check out past polls.

    Notices?