#!/usr/bin/perl

use strict;

use lib '/program';
use Tk;
use Math::Bezier::Convert ':all';

my ($draw_line, $draw_quad, $point_line, $point_quad)=(1,1,0,0);

my $mw=MainWindow->new;
$mw->geometry('640x480');
$mw->title('Cubic bezier test');
my $board=$mw->Scrolled('Canvas', -scrollbars=>'osoe', -background=>'white')->pack( -side => 'bottom', -expand=>1, -fill=> 'both');
my $fr = $mw->Frame(-relief=> 'flat')->pack(-fill=>'x');
$fr->Checkbutton(-text=> 'Draw with polyline', -variable => \$draw_line, -command=> \&cubic, -indicatoron=>0)
   ->grid(
	  $fr->Checkbutton(-text=> 'Plot control points', -variable => \$point_line, -command=> \&cubic),
	  $fr->Label(-text=>'Approx. tolerance'),
	  $fr->Scale(-orient=>'horizontal', -variable=>\$Math::Bezier::Convert::APPROX_LINE_TOLERANCE, -from=>1, -width=>3),
	  my $lLabel = $fr->Label(-text=>'Points = ', -justify=>'left'),
	  -sticky=>'ew');
$fr->Checkbutton(-text=> 'Draw with quadratic bezier', -variable => \$draw_quad, -command=> \&quad, -indicatoron=>0)
   ->grid(
	  $fr->Checkbutton(-text=> 'Plot control points', -variable => \$point_quad, -command=> \&quad),
	  $fr->Label(-text=>'Approx. tolerance'),
	  $fr->Scale(-orient=>'horizontal', -variable=>\$Math::Bezier::Convert::APPROX_QUADRATIC_TOLERANCE, -from=>1, -width=>3),
	  my $qLabel = $fr->Label(-text=>'Points = ', -justify=>'left'),
	  -sticky=>'ew', -ipadx=>10);
$fr->Label()
    ->grid( 'x',
	   $fr->Label(-text=>'Ctrl pt. tolerance'),
	   $fr->Scale(-orient=>'horizontal', -variable=>\$Math::Bezier::Convert::CTRL_PT_TOLERANCE, -from=>2, -width=>3), 'x',
	   -sticky=>'ew');
$board->createRectangle(0,0,600,400, -outline=>'white'); # border anchor

my @anchor = (100,200, 100,50, 400,50, 400,200, 400,300, 500,300, 500,200);
my $k = 0;
cubic();quad();
while ($k < @anchor) {
    my $kk = $k;
    $board->createRectangle($anchor[$k]-4,$anchor[$k+1]-4,$anchor[$k]+4,$anchor[$k+1]+4, -outline=>'black', -fill=>'green', -tags=>['anchor'.$k, 'anchor']); # border anchor
    $board->bind('anchor'.$k, "<Button1-Motion>", [sub {shift;move_anchor($kk, @_);$board->delete('cubic','quad');cubic();quad()}, Ev('x'), Ev('y')]);
    $board->bind('anchor'.$k, "<Shift-Button1-Motion>", [sub {shift;move_anchor_alone($kk, @_);$board->delete('cubic','quad');cubic();quad()}, Ev('x'), Ev('y')]);
    $k+=2;
}
$board->createLine(@anchor[0..3], -width=>1, -fill=>'green', -tags=>['rb0','rb2']);
$board->createLine(@anchor[-4..-1], -width=>1, -fill=>'green', -tags=>['rb'.($#anchor-1),'rb'.($#anchor-3)]);
for (my $k = 4; $k<$#anchor-6; $k+=6) {
    $board->createLine(@anchor[$k..$k+5], -width=>1, -fill=>'green', -tags=>['rb'.$k, 'rb'.($k+2), 'rb'.($k+4)]);
}
$board->bind('anchor', "<ButtonRelease>", \&redraw_anchors);
$board->configure(-scrollregion=>[$board->bbox('all')]);

MainLoop;

sub move_anchor_alone {
    my ($k, $x, $y) = @_;
    my ($k1, $k2) = ($k - (($k+2) % 6), $k + 5-(($k+2) % 6));

    $k1 = 0 if $k1 < 0;
    $k2 = $#anchor if $k2 > $#anchor;
    $x = $board->canvasx($x);
    $y = $board->canvasx($y);

    $anchor[$k]=$x;
    $anchor[$k+1]=$y;
    $board->coords('anchor'.$k, $anchor[$k]-4, $anchor[$k+1]-4, $anchor[$k]+4, $anchor[$k+1]+4);
    $board->coords('rb'.$k, @anchor[$k1..$k2]);
}

sub move_anchor {
    my ($k, $x, $y) = @_;
    my ($ox, $oy) = @anchor[$k, $k+1];

    $x = $board->canvasx($x);
    $y = $board->canvasx($y);

    $anchor[$k]=$x;
    $anchor[$k+1]=$y;
    $board->coords('anchor'.$k, $anchor[$k]-4, $anchor[$k+1]-4, $anchor[$k]+4, $anchor[$k+1]+4);

    my ($k1, $k2);

    if ($k % 6 == 0) {
	my ($dx, $dy) = ($x-$ox, $y-$oy);
	if ($k<$#anchor-1) {
	    $k2 = $k + 2;
	    $anchor[$k2]+=$dx;
	    $anchor[$k2+1]+=$dy;
	    $board->coords('anchor'.$k2, $anchor[$k2]-4, $anchor[$k2+1]-4, $anchor[$k2]+4, $anchor[$k2+1]+4);
	} else {
	    $k2 = $k;
	}
	if ($k>0) {
	    $k1 = $k - 2;
	    $anchor[$k1]+=$dx;
	    $anchor[$k1+1]+=$dy;
	    $board->coords('anchor'.$k1, $anchor[$k1]-4, $anchor[$k1+1]-4, $anchor[$k1]+4, $anchor[$k1+1]+4);
	}
    } else {
	my $kk = (($k % 6) == 2) ? -1 : 1;
	my $kc = $k + $kk*2;
	$k2 = $k + $kk*4;
	$k1 = $k;
	if ($k2>=0 and $k2<=$#anchor) {
	    my $ax = $anchor[$k]-$anchor[$kc];
	    my $ay = $anchor[$k+1]-$anchor[$kc+1];
	    my $bx = $ox-$anchor[$kc];
	    my $by = $oy-$anchor[$kc+1];
	    my $kkx = $anchor[$k2]-$anchor[$kc];
	    my $kky = $anchor[$k2+1]-$anchor[$kc+1];
	    my $abi = $ax*$bx+$ay*$by;
	    my $abe = $ax*$by-$ay*$bx;
	    my $ab = sqrt($ax*$ax+$ay*$ay)*sqrt($bx*$bx+$by*$by);
	    $anchor[$k2] = ($kkx*$abi+$kky*$abe)/$ab + $anchor[$kc];
	    $anchor[$k2+1] = (-$kkx*$abe+$kky*$abi)/$ab + $anchor[$kc+1];
	    $board->coords('anchor'.$k2, $anchor[$k2]-4, $anchor[$k2+1]-4, $anchor[$k2]+4, $anchor[$k2+1]+4);
	} else {
	    $k2 = $kc;
	}
	if ($k2<$k1) {
	    my $kk = $k2;
	    $k2 = $k1;
	    $k1 = $kk;
	}
    }
    $board->coords('rb'.$k, @anchor[$k1..$k2+1]);
}

sub redraw_anchors {
    $board->delete('anchor');
    for (my $k = 0; $k < @anchor; $k+=2) {
	$board->createRectangle($anchor[$k]-4,$anchor[$k+1]-4,$anchor[$k]+4,$anchor[$k+1]+4, -outline=>'black', -fill=>'green', -tags=>['anchor'.$k, 'anchor']);
    }
}

sub cubic {
    my @coords=cubic_to_lines(@anchor);
    @coords=map {int($_+0.5)} @coords;
    $lLabel->configure(-text=>'Points = '.sprintf('%.2d',@coords/2));
    $board->delete('cubic');
    if ($draw_line) {
	$board->createLine(@coords, -tags=>'cubic', -width=>3, -fill=>'gray');
    }
    if ($point_line) {
	while (@coords) {
	    my @p=splice(@coords, 0, 2);
	    $board->createRectangle($p[0]-3,$p[1]-3,$p[0]+3,$p[1]+3, -outline=>'black', -fill=>'gray', -tag=>'cubic');
	}
    }
}

sub quad {
    my @coords=cubic_to_quadratic(@anchor);
    @coords=map {int($_+0.5)} @coords;
    my ($x, $y) = splice(@coords,0,2);
    $qLabel->configure(-text=>'Points = '.sprintf('%.2d',@coords/2));
    $board->delete('quad');

    while (@coords) {
	my @p=splice(@coords, 0, 4);
	if ($draw_quad) {$board->createLine($x, $y, @p, -tags=>'quad', -width=>1, -fill=>'blue', -smooth=>1)}
	if ($point_quad) {
	    $board->createRectangle($p[0]-4,$p[1]-4,$p[0]+4,$p[1]+4, -outline=>'blue', -fill=>'blue', -tag=>'quad');
	    $board->createRectangle($p[2]-4,$p[3]-4,$p[2]+4,$p[3]+4, -outline=>'red', -fill=>'red', -tag=>'quad');
	}
	$x=$p[2];
	$y=$p[3];
    }
}