#!/usr/bin/perl -w
# rubberband.pl
# a little rubberbanding Tk demo (demonstrates rubberbanding with perl Tk)
# copyright crazyinsomniac.perlmonk.org 2002, all rights reserved
# released under the same terms as perl itself
use strict;

use Tk 8;

my $MW = new MainWindow(
        -background => 'darkblue',
        -borderwidth => 1,
        -relief => 'groove',
        -width => 500,
        -height => 500,
    ,);

my $F = $MW->Frame(
    -relief  => "groove",
    -height => 300,
    -width => 500,
,)->pack(
    -anchor => 'n',
    -side => 'top',
    -expand => 'yes',
,);

use vars '$OBJECT'; BEGIN{$OBJECT="oval"};

Button($F, "oval", groove => sub { $OBJECT = "oval" } );
Button($F, "line", groove => sub { $OBJECT = "line" } );
Button($F, "arc", groove => sub { $OBJECT = "arc" } );
Button($F, "rectangle", groove => sub { $OBJECT = "rectangle" } );


$F->Label(
    -text => " OBJECT:",
    -relief => 'flat',
    -font => "Arial",
,)->pack(
    -side => 'left',
    -expand => 1,
,);

$F->Label(
    -textvariable => \$OBJECT,
    -relief => 'flat',
    -font => "Arial",
,)->pack(
    -side => 'left',
    -expand => 1,
,);

my $C = $MW->Canvas(
        -width      => 500,
        -height     => 500,
        -background => "#AFFAAF",
    ,)->pack;

## S&M (left button down only)
$MW->bind(
    'Tk::Canvas',
    '<ButtonPress-1>' => [\&BandOn, map{Ev($_)} qw{ x y s } ]
);

$MW->bind(
    'Tk::Canvas',
    '<ButtonRelease-1>' => [\&BandOff, map{Ev($_)} qw{ x y s } ]
);


&MainLoop();

sub BandOn {
    BEEP("BandOn",@_);
    
    my( $C, $X, $Y, $S ) = @_;
    $C->{"\0__Xo"} = $X; # the origin, to remain constant
    $C->{"\0__Yo"} = $Y;
    $C->{"\0__RUBBER"} = "RUBBER".time;
    $C->create($OBJECT, $X, $Y, $X+10, $Y+10, -tags => $C->{"\0__RUBBER"});

    $MW->bind(
        'Tk::Canvas',
        '<Motion>' => [\&BandIt, map { Ev($_) } qw{ x y s } ]
    );
}


sub BandOff {
    BEEP("BandOff",@_);
    my( $C, $X, $Y, $S ) = @_;
    
    $MW->bind(
        'Tk::Canvas',
        '<Motion>' => undef, # essentially unbind
    );   
}

sub BandIt {
    BEEP("BandIt",@_);
    my( $C, $X, $Y, $S ) = @_;

    $C->delete($C->{"\0__RUBBER"}); # I wish I could transform the existing one
    $C->create(
        $OBJECT,
        $C->{"\0__Xo"},
        $C->{"\0__Yo"},
        $X, $Y, -tags => $C->{"\0__RUBBER"},
    );

}


sub BEEP {
   print shift(@_),"\n";
   print shift(@_)->{"\0__RUBBER"},"\n";
   print "$_)$_[$_]\n" for 0..$#_;
}




sub Button {
    my ( $W , $text , $relief , $sub )=@_;

    $W = $W->Button(
        -text => $text,
        -relief => $relief,
    ,)->pack(
        -anchor => 'n',
        -expand => 'no',
        -side => 'left',
    ,);

    $W->configure(-command => [ $sub, $W ] );

    return undef;
}