Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Tk Realtime data aquisition

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

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); }

Replies are listed 'Best First'.
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?

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2024-04-19 09:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found