#!/usr/bin/perl
use warnings;
use strict;
use Tk; 
use Tk::Zinc;

my $mw = MainWindow->new;
$mw->geometry("700x600");
$mw->resizable(0,0);

#lets add some backgrounds :-)
#if you want jpgs, you must install the Tk::JPEG
my $bak1 = $mw -> Photo (-format => 'gif', -file => '../images/bubbles.gif');
my $bak2 = $mw -> Photo (-format => 'gif', -file => '../images/distorted.gif');
my $bak3 = $mw -> Photo (-format => 'gif', -file => '../images/circuits.gif');



my $zinc = $mw->Zinc(-width => 700, -height => 565,
                -backcolor => 'black',
		-borderwidth => 3, 
		-relief => 'sunken',
		-tile => $bak1)->pack;

# Then we create a gray filled rectangle, in which we will display explain text.
$zinc->add('rectangle', 1 , [200, 400, 490, 490],
	   -linewidth => 2,
	   -filled => 1,
	   -fillcolor => 'SkyBlue',
	   );
my $text = $zinc->add('text', 1,
		      -position => [350, 445],
		      -anchor => 'center',
		      );

$zinc->add('rectangle', 1 , [250,275,450,325], #corners (xpos1,ypos1,xpos2,ypos2)
	   -linewidth => 2,
	   -filled => 1,
	   -fillcolor => 'Orange',
	   );

my $wintext = $zinc->add('text', 1,
		      -position => [350, 300],
		      -anchor => 'center',
		      );

#the old triangle from the triangle tutorial, properly made as a curve
my $tr1 = $zinc->add('curve', 1,
                     [10,10,30,10,20,40], #(x1,y1,x2,y2,x3,y3) 
                     -closed => 1,
                     -filled => 1, #will be transparent without this line
		     -fillcolor => 'Orange',
                     -visible => 1,
                     );

#simplist line
my $line1 = $zinc-> add('curve', 1, [20, 100, 320, 100]); # default options

my $line2 = $zinc-> add('curve', 1, [20, 120, 320, 120],
	                 -linewidth => 20,
	                  );

my $line3 = $zinc-> add('curve', 1, [20, 160, 320, 160],
	                -linewidth => 20,
	                -capstyle => "butt",
	              );

my $line4 = $zinc-> add('curve', 1, [20, 200, 320, 200],
	               -linewidth => 20,
	               -linepattern => "AlphaStipple7",
	               -linecolor => "red",
	               );
my ($xo, $yo, $xc, $yc) = $zinc->bbox($line4);
print "$xo,$yo,$xc,$yc\n";


my $line5 = $zinc-> add('curve', 1, [20, 240, 320, 240],
	               -linewidth => 20,
	               -linecolor => "red",
	            );

#complex polygon
$zinc->add('curve', 1, [20, 350, 140, 410, 320, 350, 180, 310],
	   -closed => 1,
	   -filled => 1,
	   -fillpattern => "Tk",
	   -fillcolor => "white",
	   -linecolor => "red",
	   -marker => "AtcSymbol7",
	   -markercolor => "blue",

	   );

#complex polygon
#start at 1 (x,y) point and go clockwise around the curve
$zinc->add('curve', 1, [400,50,500,25,600,50,550,100,425,75],

	   -closed => 1,
	   -linewidth => 10,
	   -joinstyle => "round", # "bevel" | "miter"
	   -tile => $bak3,
	   -fillcolor => "grey60",
	   -filled => 1,
	   -linecolor => "red",
	   );

# Display comment
comment("Each Down moves line4 down 10 pixels.
Up will move it up. Mouse button(1) will rotate 
it around the zinc canvas center
Mouse button(3) will translate line4 to the center.
Key r will return it to last translated position.
Key q will return to original position.");
wincomment("READY");

start();

my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exit(0)})
               ->pack; 
MainLoop;

sub start {
   # set binding 
    $mw->Tk::bind('<Up>', \&upaction);
    $mw->Tk::bind('<Down>', \&downaction);
    $mw->Tk::bind('<1>', \&dorotate);
    $mw->Tk::bind('<3>', \&docenter);
    $mw->Tk::bind('<r>', \&resetpos);
    $mw->Tk::bind('<q>', \&resetpos_orig);
}


sub upaction{
    wincomment("READY");
   $zinc->translate($line4,0,-10);  #moves up 10 pixels
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}

sub downaction {
# move $line4
$zinc->translate($line4,0,10);  #moves down 10 pixels
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}

sub dorotate {
# rotate $line4
$zinc->rotate($line4,.3,350,281);  #rotate around center of zinc canvas
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}

sub docenter {
#move $line4 to center
$zinc->coords($line4,[50,281,350,281]); #center is at (350,281), line length = 300
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}

sub resetpos {
#move $line4 to last translated to position
$zinc->treset($line4);
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}

sub resetpos_orig {
#move $line4 to original position
$zinc->treset($line4);
my($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
$zinc->translate($line4,-$x1+$xo,-$y1+$yo); #translate to (0,0)then back into position
($x1,$y1,$xc1,$yc1) =  $zinc->bbox($line4);
print "$x1 $y1 $xc1 $yc1\n";
}


# Just display comment 
sub comment {
    my $string = shift;
    $zinc->itemconfigure($text, -text => $string);
}

# display winning comment 
sub wincomment {
    my $string = shift;
    $zinc->itemconfigure($wintext, -text => $string);
}