#!/usr/bin/perl -w
use Tk;
use Tk::Canvas::Point;
use strict;

#adapted from Tk::CanvasPoint by Slaven Rezic 

my $mw = MainWindow->new;
my $c = $mw->Canvas->pack(-fill => "both", -expand => 1);

$c->bind("all", "<1>" => sub {
	     my($c) = @_;
	     my(@tags) = $c->gettags("current");
	     warn "Tags of current item: @tags\n";
	     my(@coords) = $c->coords("current");
	     warn "Coords of current item: @coords\n";
	 });

my $tag = "";

$c->bind("all", "<Enter>" => sub {
	     my($c) = @_;
	     $tag = ($c->gettags("current"))[0];
	 });

$c->bind("all", "<Leave>" => sub {
	     my($c) = @_;
	     $tag = "";
	 });

my @p;

$mw->update;

create_points();

$mw->update;
    for (1..10) {
	delete_last_point();
	$mw->update;
    }

    postscript(0);

    $mw->update;

    my $f = $mw->Frame->pack;
    $mw->Button(-text => "Create points",
		-command => sub { create_points() }
	       )->pack(-side => "left");
    $mw->Button(-text => "Delete last point",
		-command => sub { delete_last_point() },
	       )->pack(-side => "left");
    $mw->Button(-text => "PS",
		-command => sub { postscript(1) })->pack(-side => "left");

$mw->Label(-width => 10, -textvariable => \$tag)->pack;

MainLoop;

sub create_points {
    for(1..100) {
	my $width = rand(20);
	push @p, $c->create('point',
			    rand($c->width),rand($c->height),
			    -width => $width,
			    -activefill => "white",
			    -activewidth => $width+2,
			    -fill => [qw(blue red green yellow black white)]->[rand(5)],
			    -tags => "tag".int(rand(100)),
			   );
    }
}

sub delete_last_point {
    $c->delete(pop @p) if @p;
}


sub postscript {
    my $display = shift;
    my $f = "test.$$.ps";
    $c->postscript(-file => $f);
    open(F, $f) or die $!;
    my($firstline) = <F>;
    close F;
    system("gv $f &") if $display;
}

__END__