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

#by zentara on Sept 30, 2005 

# Usage: 
# Press and drag Mouse Button 1 to draw lines 
# Right click to add text at click point 
# Middle Click(or both mouse buttons ) to delete item under mouse 
# Save will write the canvas to postscript 

my @s;            #line drawing buffer  
my $count_l = 0;  #count for lines tags 
my $count_t = 0;  #count for text tags 

my $mw = tkinit;

$mw->fontCreate('big', -family=>'arial',
   -weight=>'bold', -size=> 18 );

my $topframe = $mw->Frame(-bg=>'black')->pack(-fill =>'x');

$topframe->Button(-text=>'Exit',-command=>sub{ exit })
                     ->pack(-side => 'right', -padx => 5);

my $canvas = $mw->Canvas( -width => 640,
                      -height => 480,
                      -bg => 'white',
                 )->pack(-fill=>'both', -expand => 1);

$canvas->Tk::bind('<1>', [ \&Start, Ev('x'), Ev('y') ] );
$canvas->Tk::bind("<B1-Motion>", [ \&Move, Ev('x'), Ev('y') ]);
$canvas->Tk::bind('<ButtonRelease>', sub { @s =() });

#text insert with right button click 
$canvas->Tk::bind('<3>', [ \&Text_insert, Ev('x'), Ev('y') ] );

#undo with a middle mouse click 
$canvas->Tk::bind('<2>', sub{
           $canvas->delete( ($canvas->gettags("current"))[0] );
          });

$topframe->Button(
     -text    => "Save",
    -command => [sub {
           $canvas->update;
           my @capture=();
           my ($x0,$y0,$x1,$y1)=$canvas->bbox('all');
           @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-
+$x0);
           $canvas -> postscript(-colormode=>'color',
                               -file=>$0.'.ps',
                               -rotate=>0,
                               -width=>800,
                               -height=>500,
                               @capture);
                              }
         ])->pack(-side=>'left', -padx =>5);

$topframe->Button(
     -text    => "Restart",
    -command => sub{
          $canvas->delete('line','text');
       })->pack(-side=>'left', -padx =>5);

MainLoop;
############################################################# 
sub Start {
     my ($canv, $x, $y) = @_;
     $count_l++;
     @s =();
     my @coords = ($canv->canvasx($x) , $canv->canvasx($y) );
     push @s, @coords;
}
############################################################# 
sub Move {
   my ($canv, $x, $y) = @_;
   my @coords = ($canv->canvasx($x) , $canv->canvasx($y) );
   push @s, @coords;

   $canvas->createLine( @s,
               -width => 5,
               -smooth => 1,
               -tags => [ 'l'.$count_l , 'line'],
               -fill => 'black');

  #shift off previous points to avoid overlapping 
  shift @s; shift @s;
}
############################################################## 
sub Text_insert {
     my ($canv, $x, $y) = @_;
     $count_t++;
     my @coords = ($canv->canvasx($x) , $canv->canvasx($y) );

     my $dialog = $mw->DialogBox(
       -buttons => ['Ok'],
       -title => 'Text Insert',
                   -bg    => 'lightsteelblue',
                  );

     my $dentry = $dialog->add('Entry',
                -bg=>'yellow',
                -font => 'big',
                )->pack();

     $dialog->configure(-focus => $dentry);
     my $button = $dialog->Show();

     if ( $button eq "Ok" ) {
        my $text = $dialog->Subwidget('entry')->get();

        $canvas->createText( @coords,
               -text => $text,
               -anchor => 'w',
               -justify => 'left',
               -font => 'big',
               -tags => [ 't'.$count_t, 'text' ],
               -fill => 'red');
     }
}
################################################################ 

__END__