#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: tk-canvas-point.t,v 1.9 2009/11/10 19:46:24 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2002,2007,2009 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://www.rezic.de/eserte/
#

use strict;

BEGIN {
    if (!eval q{
	use Test::More;
	use File::Temp qw(tempfile);
	1;
    }) {
	print "1..0 # skip: no Test::More and/or File::Temp module\n";
	exit;
    }
}

plan 'no_plan';

use Tk;

$ENV{BATCH} = 1 unless defined $ENV{BATCH};
$ENV{BATCH} = 0 if @ARGV && $ARGV[0] eq '-demo';

use_ok('Tk::Canvas::Point');

my $mw = eval { new MainWindow };
if (!$mw) {
    exit 0;
}

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 $status = "";
$c->bind("all", "<Enter>" => sub {
	     my($c) = @_;
	     $status = ($c->gettags("current"))[0];
	 });
$c->bind("all", "<Leave>" => sub {
	     my($c) = @_;
	     $status = "";
	 });
my @p;
if ($ENV{BATCH}) {
    $mw->update;
    create_points();
    $mw->update;
    for (1..10) {
	delete_last_point();
	$mw->update;
    }
    postscript(0);
    $mw->update;
} else {
    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(-textvariable => \$status)->pack;

MainLoop if !$ENV{BATCH};

pass("Exited 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(undef, $f) = tempfile(SUFFIX => "_tkcp.ps", UNLINK => !$display);
    $c->postscript(-file => $f);
    ok(-f $f, "Seen postscript file $f");
    open(F, $f) or die $!;
    my($firstline) = <F>;
    close F;
    like($firstline, qr/%!PS-Adobe-\d/, "Looks like a postscript file");
    system("gv $f &") if $display;
}

__END__