Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Unable to get rid of Perl::Tk Chart::Lines zoom rectangles

by pashanoid (Scribe)
on Aug 20, 2011 at 16:02 UTC ( [id://921422]=perlquestion: print w/replies, xml ) Need Help??

pashanoid has asked for the wisdom of the Perl Monks concerning the following question:

Dear Bretheren, I've created a zoom function that lets a user select a rectangle area on a chart (such as http://pashanoid.ru/charts.png) and the script selects that area of the database timeline (http://pashanoid.ru/sqlite.db) and re-draws the chart with that area being not only zoomed in, but also re-defined via the timeline. However, I'm unable to get rid of the rectangle boxes that I originally use to show the selection. Please help.

#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::Chart; use Tk::Chart::Lines; use Tk::Canvas::GradientColor; use DBI; use utf8; my (@timeline, @v_out, @v_in, @v_ac, @v_acc); my $mw = MainWindow->new(); $mw->title('U in, U out'); $mw->optionAdd("*font", "*utf-8"); $mw->fontCreate('giant_rus', -family => 'nimbus sans l', -weight => 'n +ormal', -size=>int(-13*13/10)); $mw->fontCreate('tiny_rus', -family => 'nimbus sans l', -weight => 'no +rmal', -size=>int(-12*12/10)); my $chart = $mw->Lines( -title => 'U in and U out (volts)', -titlefont => 'giant_rus', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -boxaxis => 1, -yticknumber => 10, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 700, -height => 350, -yminvalue => 0, -ymaxvalue => 260, -xlabelskip => 150, )->pack(qw / -fill both -expand 1/); $chart->enabled_gradientcolor(); $chart->set_gradientcolor( -start_color => '#bdbebe', -end_color => '#aed5e2', -type => 'linear_vertical', ); my $chart2 = $mw->Lines( -title => 'U batt', -titlefont => 'giant_rus', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -boxaxis => 1, -yticknumber => 10, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 700, -height => 350, -yminvalue => 9, -ymaxvalue =>17, -xlabelskip => 150, )->pack(qw / -fill both -expand 1 /); $chart2->enabled_gradientcolor(); $chart2->set_gradientcolor( -start_color => '#bdbebe', -end_color => '#aed5e2', -type => 'linear_vertical', ); my (@data, @data2); my ($d, $e) = (0.001, 1); &update_data($d, $e); $chart->plot( \@data ); $chart2->plot(\@data2 ); my ($chart_width, $x_begin, $y_begin, $x_now, $y_now, $rec, $rec2); $mw->bind('<ButtonPress>' => sub { $x_begin = $Tk::event->x; $y_begin = $Tk::event->y; print "x_begin = $x_begin y_begin=$y_begin\n"; $mw->bind('<Motion>' => sub { $x_now = $Tk::event->x; $y_now = $Tk::event->y; print "x_now = $x_now y_now=$y_now\n"; $rec = $chart->createRectangle($x_begin, $y_begin, $x_ +now, $y_now, -width => 2, -outline => 'yellow'); $rec2 = $chart2->createRectangle($x_begin, $y_begin, $ +x_now, $y_now, -width => 2, -outline => 'orange'); }); } ); $mw->bind('<ButtonRelease>' => sub { print "ButtonReleased\n"; #$chart->delete($rec); $mw->bind('<Motion>', ""); $chart_width = $chart->width; $chart->delete($rec); $chart2->delete($rec2); $d = $x_begin/$chart_width; $e = $x_now/$chart_width; print "draw next chart at $d percent of timeline, end at $ +e percent of timeline\n"; $chart->clearchart; $chart2->clearchart; &update_data($d, $e); $chart->plot(\@data); $chart2->plot(\@data2); } ); MainLoop(); sub update_data{ my ($d, $e) = @_; my ($mindate, $maxdate); @timeline = (); @v_in =(); @v_out =(); @v_acc =(); @data =(); @data2=(); my $dbfile = 'sqlite.db'; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); # my $sth = $dbh->prepare("SELECT min(strftime('%s',date)) FROM mapl +og"); $sth->execute(); while (my @result = $sth->fetchrow_array()) { $mindate = $result[0] } $sth = $dbh->prepare("SELECT max(strftime('%s',date)) FROM maplog" +); $sth->execute(); while (my @result = $sth->fetchrow_array()) { $maxdate = $result[0] } $sth->finish; my $interval = ($maxdate - $mindate); print "d=$d e=$e interval=$interval maxdate = $maxdate\n"; print "converted = ". &convert_dates($maxdate); $d = &convert_dates($mindate+$interval*$d); $e = &convert_dates($mindate+$interval*$e); print " d=$d e=$e\n"; my $phrase = "SELECT strftime(\'%H-%MN%m-%d\',date), v_in, v_out, +v_acc FROM maplog WHERE (date > \'$d\' and date < \'$e\')"; print "phrase = $phrase\n"; $sth = $dbh->prepare($phrase); $sth->execute(); while (my @result = $sth->fetchrow_array()) { $result[0] =~ s/N/\n/g; push (@timeline,$result[0]); push (@v_in,$result[1]); push (@v_out,$result[2]); push (@v_acc,$result[3]); } $sth->finish; $dbh->disconnect; @data = (\@timeline, \@v_in, \@v_out); @data2 = (\@timeline, \@v_acc); } sub convert_dates{ my $date = shift; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localti +me($date); $year += 1900; $sec = sprintf("%02d", $sec); $min = sprintf("%02d", $min); $hour = sprintf("%02d", $hour); $mon = sprintf("%02d", $mon+1); my $sqlite_date = "$year-$mon-$mday $hour:$min:$sec"; #SQLite +date old->#my $sqlite_date = "$mday/$mon/$year $hour:$min:$sec"; return($sqlite_date); }

Replies are listed 'Best First'.
Re: Unable to get rid of Perl::Tk Chart::Lines zoom rectangles
by zentara (Archbishop) on Aug 20, 2011 at 21:10 UTC
    Hey nice example, and it brought my attention to Tk::Chart and Tk::Canvas::GradientColor. Nice stuff.

    Getting back to your problem with the rectangle, it's hard to run your program without the maplog file

    DBD::SQLite::db prepare failed: no such table: maplog at ./921422.pl l +ine 138.
    Can you either provide a minimal maplog file, or make an example with some builtin data?

    It should be simple enough to make the rectangle disappear, since it is all Canvas based, and you can (or should) be able to put Canvas tags on the rectangle to make them disappear.

    In the meantime, here is a simple example of creating a draggable rectangle, which is also movable after creation.

    #!/usr/bin/perl use warnings; use strict; use Tk; my $rect_ready = 0; #flag for setting ready to drag my $dx; my $dy; my $mw = new MainWindow( -width => 500, -height => 500 ); my $canvas = $mw->Canvas( -width => 500, -height => 500, -background => 'white', )->pack; $mw->bind('Tk::Canvas', '<ButtonPress-1>' => \&start_rect); $mw->bind('Tk::Canvas', '<ButtonRelease-1>' => \&stop_rect); $canvas->bind('move', '<1>', sub {&mobileStart();}); $canvas->bind('move', '<B1-Motion>', sub {&mobileMove();}); $canvas->bind('move', '<ButtonRelease>', sub {&mobileStop();}); MainLoop; ################################################################### sub start_rect { return if $rect_ready; my $canvas = shift; my $event = $canvas->XEvent; my $x = $canvas->canvasx($event->x); my $y = $canvas->canvasy($event->y); $canvas->create('rectangle', $x, $y, $x+10, $y+10, -width => 5, -tags => ['rect','move']); $mw->bind( 'Tk::Canvas','<Motion>' => \&making_rect ); } ############################################################### sub stop_rect { my $canvas = shift; $mw->bind('Tk::Canvas', '<Motion>' => undef ); $rect_ready = 1; } ############################################################# sub making_rect { my $canvas = shift; my $event = $canvas ->XEvent; my $x = $canvas->canvasx($event->x); my $y = $canvas->canvasy($event->y); my ($x0,$y0,$x1,$y1) = $canvas->coords('rect'); # $canvas->coords('rect', $x0, $y0, $x, $y ); $canvas->delete('rect'); $canvas->create('rectangle', $x0, $y0, $x, $y, -width => 5, -activewidth => 10, -tags => ['rect','move']); } ############################################################## sub mobileStart { my $ev = $canvas->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); $canvas->raise('current'); print "START MOVE-> $dx $dy\n"; } ############################################################### sub mobileMove { my $ev = $canvas->XEvent; $canvas->move('current', $ev->x + $dx, $ev->y +$dy); ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); # print "MOVING-> $dx $dy\n"; } ############################################################ sub mobileStop{&mobileMove;} ##############################################################

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      This is somewhat close to what I'm trying to do. However, I want the rectangle to dissapear after I'm done selecting an area. Here is the maplog database, just put it near my script! http://pashanoid.ru/sqlite.db

      Thank you!

        Here is the basic idea, use canvas tags. It dosn't deal with your screen clutter of multiple rectangles as you drag, but the solution to that is in the previous example I showed, where you
        $mw->bind( 'Tk::Canvas','<Motion>' => \&making_rect );
        You should be able to implement that yourself. You need to work thru it once, to get it into your head how it works. So I throw you 1 fish, but not 2. :-)

        So to correct your code above to using tags, here are the modified subs

        $mw->bind('<ButtonPress>' => sub { $x_begin = $Tk::event->x; $y_begin = $Tk::event->y; print "x_begin = $x_begin y_begin=$y_begin\n"; $mw->bind('<Motion>' => sub { $x_now = $Tk::event->x; $y_now = $Tk::event->y; print "x_now = $x_now y_now=$y_now\n"; $rec = $chart->createRectangle( $x_begin, $y_begin, $x_now, $y_now, -width => 2, -outline => 'yellow', ################### -tags => ['rect'] ); ################### $rec2 = $chart2->createRectangle( $x_begin, $y_begin, $x_now, $y_now, -width => 2, -outline => 'orange', ################# -tags => ['rect'] ); ################## }); } ); $mw->bind('<ButtonRelease>' => sub { print "ButtonReleased\n"; #$chart->delete($rec); $mw->bind('<Motion>', ""); $chart_width = $chart->width; $chart->delete($rec); $chart2->delete($rec2); ###################################### $chart->delete('rect'); $chart2->delete('rect'); ###################################### $d = $x_begin/$chart_width; $e = $x_now/$chart_width; print "draw next chart at $d percent of timeline, end at $e percent of timeline\n"; $chart->clearchart; $chart2->clearchart; &update_data($d, $e); $chart->plot(\@data); $chart2->plot(\@data2); } );

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (4)
As of 2024-03-29 08:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found