Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Syntactic Confectionery Delight
 
PerlMonks  

Tk Realtime data aquisition

by zentara (Archbishop)
on Oct 09, 2006 at 14:19 UTC ( #577181=snippet: print w/ replies, xml ) Need Help??

Description: Real time data graphs. prompted me to try it. This is a realtime Tk data graph, getting the data through a socket connection. I made it as simple as I could for demo purposes. It will monitor for 86400 seconds ( broke the minutes into 10'ths). I also just let the sending script send a count (0..86400), mostly so I could speed it up for testing. In reality, you would want the sender to send the time of it's read, instead of the count.

I noticed that as the data array(for the curve) got bigger, the cpu rate would rise to handle reconfiguring the curve with the huge array. So I broke the day into 500 second segments, which limits the point data array to 1000 elements. On my machine the cpu usage varied between 5 and 10% at high speed. Very low cpu with 1 second updates.

There are 2 scripts, the socket-sender-test and the main Tk program.

The socket-sender-test
#!/usr/bin/perl
use IO::Socket;

my $machine_addr = 'localhost';
$sock = new IO::Socket::INET(PeerAddr=>$machine_addr,
      PeerPort=>7070,
      Proto=>'tcp',
      );

die "Could not connect: $!" unless $sock;


foreach my $count(1..86400){
  my $temp = 800 + int(rand 100);
  my $send = "$count $temp";
  print $sock "$send\n";
  print "$send\n";
  select(undef,undef,undef,.1) ;
}

close ($sock);
__END__
And the Tk monitor
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use Tk;
$|++;

my $listen = IO::Socket::INET->new(
    Proto       => 'tcp',
    LocalPort   => 7070,
    Listen      => 1,
    Reuse       => 1,
) or die "Can't create listen socket : $!\n";


my $margin = 50;
my $offset = 20;   #axis offset
my $x_max = 86400;
my $y_max = 1000;

my $connected = 'Not Connected';
my %data;            #why continuosly update the entire
                     #data set? cpu rate will climb, so 
my $current_seg = 0; #break graph into 500 second segments
                     #to avoid cpu rate climbing, will create
             # 86400/500 =~ 175 lines (data) segemnts

my $mw = tkinit;

$mw->fileevent($listen, 'readable', sub { new_connection($listen) });

my $scanvas = $mw->Scrolled('Canvas',
                 -width => 620, 
         -height => 420,
                 -scrollregion => [-$margin,-$margin, 
                          $x_max + $margin, 
                          $y_max + $margin + $offset ],
         -bg => 'black')->pack();

&build_axis();

my $canvas = $scanvas->Subwidget('scrolled');
$canvas->Tk::bind("<Button-1>", [ \&print_xy, Ev('x'), Ev('y') ]);

sub print_xy {
  my ($canv, $x, $y) = @_;
  print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n"
+;
}


#for simplicity create the lines first
foreach my $line(0..172){
  push @{$data{$line}{'data'}},0,0,0,0; #initilize, will remove later
  $data{$line}{'line_obj'} = $canvas->createLine( 
                           @{$data{$current_seg}{'data'}},
                          -width => 1,
                          -smooth => 1,
              -fill => 'lightgreen');
}



my $subframe = $mw->Frame(-background =>'gray50')->pack(-fill => 'x');

$subframe->Button(-text =>'Exit',
            -background => 'hotpink',
            -activebackground => 'red',
        -command => sub{ exit }
            )->pack(-side=>'left',-padx=>40);

$subframe->Label(-textvariable => \$connected,
            -background => 'black',
        -foreground => 'green',
            )->pack(-side=>'left');
MainLoop;

######################################################################
+#

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($clien
+t) });
    $connected = 'Connected';
}

sub handle_connection {
    my ($client) = @_;
    my $message = <$client>;
#    print "$message\n";
#    if( $message = eof){print "crashed\n"}

    if ( defined $message ) {
     $message =~ s/[\r\n]+$//;
     my ($x, $y) = split( " ", $message);
     
   
    if( $#{$data{$current_seg}{'data'}} >  1000 ){  #2 entries per poi
+nt
       #initialize next segmnet, pop off last 2 of previous segment
       my($xo,$yo) =  @{$data{ $current_seg}{'data'}}[-2, -1 ];
       $current_seg++;
       print "current seg $current_seg\n";    
       #inititialize by overwriting the initial 0,0,0,0
       ${$data{$current_seg}{'data'}}[0] = $xo;
       ${$data{$current_seg}{'data'}}[1] = $yo;
       ${$data{$current_seg}{'data'}}[2] = $xo;
       ${$data{$current_seg}{'data'}}[3] = $yo;
      }
    
    push @{$data{$current_seg}{'data'}}, $x, $y;
        $scanvas->coords( $data{$current_seg}{'line_obj'}, @{$data{$cu
+rrent_seg}{'data'}} );
     #$scanvas->xviewScroll(1,'units'); 
     $scanvas->xview('moveto', $x/86400 );

#     $text->insert('end', "Got message [$message]\t");
#     $text->see('end');
    }
    else {
       #$text->insert('end', "Connection Closed\n");
       #$text->see('end');
      $client->close();
      $connected = 'NOT Connected';
      print "not connected\n"; 
    }
}
##############################################################
sub build_axis{
# axis
my $xaxis = $scanvas->createLine( 0, $y_max + $offset, $x_max, $y_max 
++ $offset,
                          -width => 1,
              -fill => 'lightblue');

my $yaxis = $scanvas->createLine( 0, $y_max + $offset ,0,0,
                          -width => 1,
              -fill => 'lightgreen');

# x axis ticks
my $tflag;
my $labflag;
my $min = 0;
my $minflag = 0;
my $hour = 0;
my $hourflag = 0;
my $tlength;
my $color;
for(1..$x_max){
    $tflag = 0;
    $tlength = 5;
    $color = 'white';
    $hourflag = 0;
    $minflag = 0;
    $labflag = 0;
    if( ($_ % 10) == 0 ){ $tflag = 1 }  #minutes are broken into 10 se
+c intervals
    if( ($_ % 60) == 0 ){ $tlength = 15 ; 
                          $color = 'yellow'; 
              $min++; 
              $minflag = 1;
              $labflag = 1;
              }
              
    if( ($_ % 3600) == 0 ){ $tlength = 25; 
                            $color = 'hotpink'; 
                            $hour++; 
                $hourflag = 1;
                $labflag = 1;
                $min = 0;
                $minflag = 0;
               }

    if( $tflag ){
      $scanvas->createLine( $_, $y_max + $offset, $_, $y_max + $offset
+ + $tlength,
                          -width => 1,
              -fill => $color);
     
       
       if($labflag){
            my $label;
        if($minflag){ $label = $min; }
            if($hourflag){ $label = $hour; }
        
      $scanvas->createText( $_,  $y_max + $offset + 1.2*$tlength,
                           -text => $label,
                       -fill => $color,
               -anchor => 'n',
               );
           }
     }
}

# y axis ticks
my $uflag;
my $midflag;

my @array = reverse(0..$y_max );

for(@array){
    my $num = $y_max - $_;  #reverse normal axis
    $tflag = 0;
    $tlength = 5;
    $color = 'white';
    $uflag = 0;
    $midflag = 0;
    $labflag = 0;
    if( ($num % 10) == 0 ){ $tflag = 1 }
    if( ($num % 50) == 0 ){ $tlength = 10 ; 
                          $color = 'yellow'; 
              $midflag = 1;
              $labflag = 1;
              }
              
    if( ($num % 100) == 0 ){ $tlength = 20; 
                            $color = 'hotpink'; 
                            $uflag = 1;
                $labflag = 1;
                $midflag = 0;
               }

    if( $tflag ){
      $scanvas->createLine( 0 - $tlength, $num + $offset, 0, $num + $o
+ffset,
                          -width => 1,
              -fill => $color);
     
       
       if($labflag){
            my $label;
        if($midflag){ $label =  $num; }
            if($uflag){ $label =  $num; }
        
      $scanvas->createText( -20 ,  $y_max + $offset - $num ,
                           -text => $label,
                       -fill => $color,
               -anchor => 'e',
               );
           }
     }
}

$scanvas->xview('moveto',0);
$scanvas->yview('moveto',1);
}

Comment on Tk Realtime data aquisition
Select or Download Code
Re: Tk Realtime data aquisition
by jaschwartz (Novice) on May 05, 2009 at 21:05 UTC
    I am having some difficulty using your two scripts: If I start your sender script first I get an unspecified connect error "Could not connect: Unknown error at ....". If I start the monitor script first the sender script scrolls through some numbers, but nothing shows in the monitor graph as it also shows it not connected. Please help as I think I can greatly apply this script, but can't seem to get past these script/socket issues. Thanks :)
      You start the big Tk script first, and it will just sit there waiting for a connection. Start the smaller sender script second, and it should connect automatically.....works here I just tried it.

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku
        I started the big Tk script first, the monitor, and then started the smaller, the sender. The command line window I started it from shows incrementing numbers and its sent random number. But, nothing shows up in the monitor graph. I think some of the issue is that the monitor always shows "Not connected." I am not sure how to force it to connect? I am using a windows xp win32, is this the same as what you are using? After using a netstat -a, I see both the Listening on 7070 and the the established, but yet nothing shows up in the graph, I suspect this may be an issue in the the handle_connection subrutine. I uncommented your "print message line." But, nothing is printed. I suspect that handle_connection is not getting far enough to execute handle_connection. Your thoughts or advice?

Back to Snippets Section

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (7)
As of 2014-04-21 08:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (492 votes), past polls