## 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 a0a0^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 speed } }); 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($client) }); #$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('' => 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__