#!/usr/local/bin/perl

use Tk;

#Interactive spline drawing - Monty Stein 12/25/97 (from an original from '95)
# translated to Perl by Bradley Kuhn, 1/1/98

#These need to be defined for their globalism more than being initialized
@point_list = ();
$cursor_max_x = 0;
$cursor_max_y = 0;

#creates the tagged cursor graphics object when the pointer enters the canvas
sub cursorcreate {
    my($w, $x, $y) = @_;

    my(@width) = $w->configure(-width);
    my(@height) = $w->configure(-height);
    $cursor_max_x = $width[4];
    $cursor_max_y = $height[4];

    $w->create('line', 0, $y, $cursor_max_x, $y, 
               -fill => 'red',  -tag => 'cursorx');
    $w->create('line', $x, 0, $x, $cursor_max_y,
               -fill => 'red', -tag => 'cursory');

}
#destroys the cursor when the pointer leaves the canvas
sub cursordestroy {
    my($w) = @_;
    $w->delete('cursorx', 'cursory');
}

#all mouse movement passes through here, just move the cursor to where the
#   pointer is
sub cursormove { 
    my($w, $x, $y) = @_;

    $w->coords('cursorx', 0,  $y,  $cursor_max_x , $y);
    $w->coords('cursory', $x, 0, $x, $cursor_max_y);
}

#handle resizing of the window - be careful to not have the cursor displayed
#  when the rescale takes place so it can be the right size
sub cursorresize {
    my($w, $width,  $height, $x, $y) = @_;

    $border = $w->cget('-bd');
    $width  = $width -4 - (2 * $border);
    $height = $height - 4 - (2*$border);

    $cursortags = $w->gettags('cursorx');

    if ( ($width != $cursor_max_x) ||  ($height != $cursor_max_y) ) {
        &cursordestroy($w) if ($cursortags ne "");
        $w->configure(-width => $width,  -height => $height);

        if ($cursortags ne "") {
            &cursorcreate($w, $x, $y);
            &cursormove($w, $x, $y);
        }
    }
}

#place a spline control point on the canvas, manage the list of points
sub droppoint {
    my($w, $x, $y) = @_;

    push(@point_list, $x, $y);
    $w->create('rectangle', $x - 2, $y - 2, $x + 2, $y + 2,
               -fill => 'black', -tag => 'temppoint');

    if ($#point_list > 0) {
        $lasttemppointY = $point_list[$#point_list - 2];
        $lasttemppointX = $point_list[$#point_list - 3];

        $w->create('line', $lasttemppointX, $lasttemppointY,
                   $x, $y, -tag => 'temppoint', -fill => 'black');
    }
}

#convert the list of points into a spline, calls the cancel routine to erase
#  the construction lines
sub finishpoint {
    my($w, $x, $y) = @_;

    my(@argList) = ('line');
    foreach my $i (@point_list) {
        push(@argList, $i);
    }
    push(@argList, -smooth => '1',  -fill => 'black');
    $w->create(@argList);
    &cancelpoint($w);
}

#abort the current spline, erases the drawn lines and resets the list of points
sub cancelpoint {
    my($w) = @_;
    @point_list = ();
    $w->delete('temppoint');
}

my($win) = MainWindow->new();

my($c) = $win->Canvas(-relief => 'groove',  -bd => 5);
my($quit) = $win->Button(-text =>  'Quit',  -command => eval 'sub { exit }');

#all the functions other than quit are handled through bindings
$c->Tk::bind("<Motion>" => sub { my($w) = @_;  my($e) = $w->XEvent();
                                 &cursormove($w, $e->x, $e->y); });
$c->Tk::bind("<Enter>" => sub { my($w) = @_;  my($e) = $w->XEvent();
                                &cursorcreate($w, $e->x, $e->y); });
$c->Tk::bind("<Leave>" =>  sub { my($w) = @_;  my($e) = $w->XEvent();
                                 &cursordestroy($w); });
$c->Tk::bind("<Configure>" =>  sub { my($w) = @_;  my($e) = $w->XEvent();
                                     &cursorresize($w, $e->w, $e->h, $e->x,
                                                   $e->y); });
$c->Tk::bind("<Button-1>" =>  sub { my($w) = @_;  my($e) = $w->XEvent();
                                    &droppoint($w, $e->x, $e->y); });
$c->Tk::bind("<Button-2>" =>  sub { my($w) = @_;  my($e) = $w->XEvent();
                                    &cancelpoint($c); });
$c->Tk::bind("<Button-3>" => sub { my($w) = @_;  my($e) = $w->XEvent();
                                   &finishpoint($w, $e->x, $e->y); });

$c->pack(-fill => 'both',  -expand => 1);
$quit->pack(-fill => 'x');
&Tk::MainLoop;