##       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__
[download]