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 (Cardinal) on Aug 20, 2011 at 21:10 UTC | |
by pashanoid (Scribe) on Aug 22, 2011 at 04:17 UTC | |
by zentara (Cardinal) on Aug 22, 2011 at 12:26 UTC | |
by pashanoid (Scribe) on Aug 23, 2011 at 06:22 UTC |