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

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.

[download]
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;}
##############################################################

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

Replies are listed 'Best First'.
Re^2: Unable to get rid of Perl::Tk Chart::Lines zoom rectangles
by pashanoid (Scribe) on Aug 22, 2011 at 04:17 UTC

    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!

[reply]
      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 );

      [download]
      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);

                 }
);

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
[select]
        thank you!
[reply]

In Section Seekers of Perl Wisdom