Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 having an uproarious good time at the Monastery: (7)
As of 2014-07-31 04:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (244 votes), past polls