#!/usr/bin/perl -w

use strict;
use Opt;
use Tty;
use POSIX;
use Vec;
use Ascii;

use Data::Dumper;

$Opt::synopsis = "Make points/holes in the x/y plane according to the pattern given by the function and arguments given.
\tThe argument output=<xx> decides the output, where xx can be gcode, xy (list of points) or ps (postscript).";

$Opt::OPT{output} = "xy";
$Opt::OPT{gcsta} = "s10 m3 g90 f1000"; # f in mm/min
$Opt::OPT{gcend} = "g0z0 m5 g0x0y0";
$Opt::OPT{gcdrill} = "g0z-10 g1z-15 g0z0";

sub drill() {
    my $str = $Opt::OPT{gcdrill};
    $str =~ tr/ \t\n\r/ /s;
    my @fld = split(/ /, $str);
    @fld;
}
sub pos2gcode(@) {
    my @pos = @_;
    my @str = ();
    push @str, $Opt::OPT{gcsta};
    my $xpos = 0; # how to get bakc to current position
    my $ypos = 0;
    for my $p (@pos) {
	if (defined($p)) {
	    if (ref($p) eq "ARRAY") {
		my ($x, $y) = @$p;
		$xpos -= $x;
		$ypos -= $y;
		push @str, "g0x${x}y${y}";
		push @str, drill();
	    } else {
		#push @str, "";
	    }
	} else {
		push @str, "";
	}
    }
    push @str, "";
    push @str, split(/ /, $Opt::OPT{gcend});

    join("\n", @str) . "\n";
}
sub pos2ps(@) {
    my @pos = @_;
    my $xtr = "";
    my $str = "
/a 72 25.4 div def
a a scale

1 setlinecap
1 setlinejoin
";

    {
	my $p = $pos[0];
	if (defined($p) && ref($p) eq "HASH" && $$p{ps}) {
	    $p = shift @pos;
	    $str .= $$p{ps};
	}
    }

    $str .= 
"1 setlinewidth
newpath
%0 0 moveto

";

    for my $p (@pos) {
	if (defined($p)) {
	    if (ref($p) eq "ARRAY") {
		my ($x, $y) = @$p;
		$str .= "$x $y moveto ";
		$str .= "$x $y lineto\n";
	    } elsif (ref($p) eq "HASH") {
		$xtr .= $$p{ps} if ($$p{ps});
	    } else {
	    }
	} else {
	    $str .= "\n";
	}
    }

    $str .= "
stroke
$xtr
showpage
";
}

sub extrPos($) {
    my $str = shift;

    my $opt = $Opt::OPT{$str} // "";
    my @d = split(/,/,$opt);
    if (@d < 3) { Opt::UsageDisp("Error: <$str=$opt> should contain at least 3 values"); }

    my @pos = ();

    my $min = shift @d;
    my $max = shift @d;
    my $ix = 0;
    my $pos = $min;
    while ($pos <= $max) {
	#print "$ix $xpos\n";
	push @pos, $pos;
	$pos += $d[$ix];
	$ix++;
	if ($ix >= @d) {
	    $ix = 0;
	}
    }
    @pos;
}
sub show_argv(@) {
    my @argv = @_;
    my $sepa = "";
    for my $arg (@argv) {
	print $sepa;
	$sepa = " ";
	my $sepp = "";
	for my $pos (@$arg) {
	    #print Dumper($pos);
	    print $sepp;
	    $sepp = "/";
	    print "$$pos[0],$$pos[1]";
	}
    }
    print "\n";
}

sub INSIDE() { return 0; }
sub AGAIN()  { return 1; }
sub STOP()   { return 2; }

my $lvl = 0;
sub bb_cmp($$$) {
    my $bb = shift;
    my $pos = shift;
    my $dir = shift // 0;
    my ($b,$B) = @$bb;

    my $res;
    if ($dir < 0) {
	if    ($pos < $b  ) { $res = STOP; }
	elsif ($B   < $pos) { $res = AGAIN; }
	else                { $res = INSIDE; }
    } elsif ($dir == 0) {
	if    ($pos < $b  ) { $res = STOP; }
	elsif ($B   < $pos) { $res = STOP; }
	else                { $res = INSIDE; }
    } else { # 0 < $dir
	if    ($pos < $b  ) { $res = AGAIN; }
	elsif ($B   < $pos) { $res = STOP; }
	else                { $res = INSIDE; }
    }
#    printf STDERR "%2d %3d %3d %2d %4d %d\n", $lvl, $b, $B, $dir, $pos, $res;

    $res;
}
sub bb_Cmp($$$){
    my $bb = shift;
    my $nxt = shift;
    my $direction = shift;

    my $bbx = 0; # bb_cmp($$bb[0], $$nxt[0], $$direction[0]);
    my $bby = bb_cmp($$bb[1], $$nxt[1], $$direction[1]);
    my $chk = $bbx | $bby;

#    printf STDERR "%4d %4d %d %d %d\n", $$nxt[0], $$nxt[1], $bbx, $bby, $chk;

    $chk;
}
sub calc_point($$@);
sub calc_point($$@) {
    my $bb = shift;
    my $sta = shift;
    my @delta = @_;

    $lvl++;
    my @point = ();
    if (@delta < 1) { $lvl--; return (); }
    my @current_delta = @{shift @delta};

    my $nxt = $sta;
    push @point, calc_point($bb, $nxt, @delta);
    if (@current_delta == 1) {
	my $delta = shift @current_delta;
#	printf STDERR "delta: %4d %4d\n", @$delta;
	my $direction = [ $$delta[0] <=> 0, $$delta[1] <=> 0 ];
	while (1) {
	    #$nxt = [ $$nxt[0] + $$delta[0], $$nxt[1] + $$delta[1] ];
	    $nxt = Vec::Add($nxt, $delta);
#	    printf STDERR "%4d %4d: ", $$nxt[0], $$nxt[1];
	    my $chk = bb_Cmp($bb, $nxt, $direction);
	    if ($chk & STOP) {
#		print STDERR "last\n\n";
		last;
	    } elsif ($chk & AGAIN) {
#		print STDERR "next\n";
		next;
	    } elsif ($chk == INSIDE ) {
#		print STDERR "inside\n";
		push @point, $nxt;
		push @point, calc_point($bb, $nxt, @delta);
	    }
	    #print STDERR "\n";
	}
    } else {
	for my $dd (@current_delta) {
	    $nxt = Vec::Add($sta, $dd);
	    next if (bb_Cmp($bb, $nxt,[0,0]));
	    push @point, $nxt;
	    push @point, calc_point($bb, $nxt, @delta);
	}
    }
    $lvl--;
#    show_point(@current_delta);
#    show_point(@point);
    @point;
}

sub do_output(@) {
    my @point = @_;

    if ($Opt::OPT{output} eq "gcode") {
	print pos2gcode(@point);
    } elsif ($Opt::OPT{output} eq "xy") {
	print Vec::PrintXY(@point);
    } elsif ($Opt::OPT{output} eq "ps") {
	my $str = pos2ps(@point);
	print $str;
    }
}
########

sub MatVec($$) {
    my $A = shift;
    my $v = shift;
    my @b = (); # result values

    #print STDERR Dumper($A);
    for my $row (@$A) {
	#print STDERR Vec::vec2str($row);
	push @b, Vec::InnerProduct($row, $v);
    }
    \@b;
}

sub doMatrix() {
    my @point = ();

    my @x = extrPos("x");
    my @y = extrPos("y");

    #print "x: ", join(" ", @x), "\n";
    #print "y: ", join(" ", @y), "\n";

    for my $x (@x) {
	for my $y (@y) {
	    push @point, [$x, $y];
	}
	push @point, undef;
    }
    do_output(@point);
}
$Opt::DISP{matrix} = [ \&doMatrix,
 "matrix pattern specified by x=min,max,dx,dx,... y=min,max,dy,dy,..."
 ];

sub doRecursive() {
    my @argv = ();
    for (@ARGV) {
	push @argv, [ Vec::str2veclist($_) ];
    }
    #show_argv(@argv);
    if (@argv < 3) {
	Opt::UsageDisp("bounding box, start point and at least one dx/dy needed");
    }
    my @bba  = @{$argv[0]};
    my @sta = @{$argv[1]};
    shift @argv;
    shift @argv;
    if (@bba != 2) { Opt::UsageDisp("bounding box in the form of minx,miny/maxx,maxy is needed"); }
    if (@sta != 1) { Opt::UsageDisp("start point in the form of x,y is needed"); }
    @sta = @{$sta[0]};

    my @bb = ( [ $bba[0][0], $bba[1][0] ], [ $bba[0][1], $bba[1][1], ] ); # [ xmin xmax ] [ ymin ymax ]

    my @delta = @argv;
    my @point = ();
    my $chk = bb_Cmp(\@bb, \@sta, [0, 0]);
    if ($chk == INSIDE) { push @point, \@sta; }
    push @point, calc_point(\@bb, \@sta, @delta);

    do_output(@point);
}
$Opt::DISP{recursive} = [ \&doRecursive,
 "TODO, arg is <bounding box> <start point> <delta>..., each in the form x,y/x,y/x,y"
 ];

sub rombFill($$$;$) {
    # get all points = sta + n*e1 + m*e2 who are not outside the bounding box
    my @bb  = @{shift @_}; # boinding box/working area
    my @sta = @{shift @_}; # pattern fix point
    my @e   = @{shift @_}; # the two vectors ( [x1 x2], [y1 y2] ) forming the pattern
    my @exclude = @{shift @_}; # where not to put points/drill

    # boinding box corners
    my @lb = @{$bb[0]};
    my @rt = @{$bb[1]};
    my @rb = ($rt[0], $lb[1]);
    my @lt = ($lb[0], $rt[1]);
    my @cp = (\@lb, \@lt, \@rt, \@rb); # corner points

    my @A = ( [ $e[0][0], $e[1][0] ], [ $e[0][1], $e[1][1] ] );

    if ($Opt::OPT{verb}) {
	print STDERR "\n";
	printf STDERR "A = (%s\n", Vec::vec2str($A[0], undef, " %8.3f,");
	printf STDERR "     %s)\n", Vec::vec2str($A[1], undef, " %8.3f,");
    }

    my @point = (); # return value

    my @Ebb = (); # boinding boxes to exclude
    if (@exclude) {
	my %p;
	$p{ps} = "0.1";
	for my $rr (@exclude) {
	    my ($x, $y, $r) = @$rr;
	    my $ex = [ [ $x - $r, $y - $r ], [ $x + $r, $y + $r ] ];
	    push @Ebb, $ex;
	}
    }

    if ($Opt::OPT{verbps}) { # for postscript output, show the bounding box as a frame
	my %p = ( ps => "
0.1 setlinewidth
newpath
$lb[0] $lb[1] moveto
");
	for my $cp (@cp) { $p{ps} .= "$$cp[0] $$cp[1] lineto\n"; }
	$p{ps} .= "closepath\nstroke\n\n";
	$p{ps} .= "0.01 setlinewidth\nnewpath\n";
	if ($Opt::OPT{verbps} > 1) {
	    for my $xyr (@exclude) {
		my ($x, $y, $r) = @$xyr;
		my $s = $x + $r;
		$p{ps} .= "$s $y moveto\n $x $y $r 0 360 arc\n"
	    }
	}
	$p{ps} .= "stroke\n\n";
	push @point, \%p;
   }

    ##########
    # now we want to find the vector [ k l ] for each corner point
    # satisfying cornerpoint = matrix A * [ k l ]
    # so we will know the range of k's and l's.

    my @kl;
    {
	my $cmd = "./solve $A[0][0] $A[0][1] $A[1][0] $A[1][1]   $cp[0][0] $cp[0][1]  $cp[1][0] $cp[1][1]  $cp[2][0] $cp[2][1]  $cp[3][0] $cp[3][1]";
	my $str = `$cmd`;
	$str =~ tr/: \t/ /s;
	my @solve = split(/\n/, $str);

	if ($Opt::OPT{verb}) {
	    print STDERR "\ncmd: $cmd\n";
	    printf STDERR " nr:   corner point  /  [k l] solution / result check A * [k l]\n";
	}

	for (my $ix = 0; $ix < @solve; $ix++) {
	    my $line = $solve[$ix];
	    $line =~ s/^ //;
	    my @fld = split(/ /, $line);

	    if ($Opt::OPT{verb}) {
		printf STDERR "%3d: %7.3f %7.3f / %7.3f %7.3f / %7.3f %7.3f", $ix, @fld;
		my $chk = MatVec(\@A, [ $fld[2], $fld[3] ]);
		printf STDERR " / chk = %s\n", Vec::vec2str($chk, undef, " %8.3f");
		#print STDERR Dumper($chk);
	    }

	    $kl[$ix] = [ $fld[2], $fld[3] ];
	}
    }
    my ($Min, $Max) = Vec::MinMax(@kl);
    $Min = Vec::FloorR($Min);
    $Max = Vec::CeilR($Max);
    if ($Opt::OPT{verb}) {
	printf STDERR "min = %s\n", Vec::vec2str($Min, undef, " %8.3f");
	printf STDERR "max = %s\n", Vec::vec2str($Max, undef, " %8.3f");
	print STDERR "kl =\n";
	print STDERR Vec::PrintXY(@kl);
    }

    ##########
    # now that we have the ranges of [ k, l ], save the point if it is inside the bounding box

    for (my $kx = $$Min[0]; $kx <= $$Max[0]; $kx++) {
	$kx = $Opt::OPT{kx} if (defined($Opt::OPT{kx}));
	printf STDERR " %4d /", $kx if ($Opt::OPT{verb});
	for (my $lx = $$Min[1]; $lx < $$Max[1]; $lx++) {
	    printf STDERR " %4d", $lx if ($Opt::OPT{verb});
	    my $c = MatVec(\@A, [ $kx, $lx ]);
	    $c = Vec::Add($c, \@sta);
	    my $inside = Vec::bbInside(\@bb, $c, \@Ebb);
	    if ($inside) {
		push @point, $c;
	    } else {
	    }
	}
	push @point, undef;
	printf STDERR "\n" if ($Opt::OPT{verb});
	last if (defined($Opt::OPT{kx}));
    }

    @point;
}
sub doRomb() {
    my @argv = ();
    for (@ARGV) {
	push @argv, [ Vec::str2veclist($_) ];
    }
    #show_argv(@argv);
    if (3 <= @argv && @argv <= 4) {
    } else {
	Opt::UsageDisp("bounding box, start point, e1/e2 are required + opt. exclude x,y,r/x,y,r/...");
    }
    my @bb  = @{$argv[0]};
    my @sta = @{$argv[1]};
    my @e   = @{$argv[2]};
    my @exclude = @{$argv[3] // []};

    if (@bb  != 2) { Opt::UsageDisp("bounding box in the form of minx,miny/maxx,maxy is needed"); }
    if (@sta != 1) { Opt::UsageDisp("start point in the form of x,y is needed"); }
    if (@e   != 2) { Opt::UsageDisp("r/s in the form of x,y/x,y is needed"); }

    @sta = @{$sta[0]};

    my @point = rombFill(\@bb,\@sta, \@e, \@exclude);

    do_output(@point);
}
$Opt::DISP{romb} = [ \&doRomb,
 "arg is <bounding box> <start point> <e> where e[0]/e[1] combined forms a rombic pattern"
 ];

sub doAbs() {
    my @argv = ();
    if (@ARGV != 2) {
	Opt::UsageDisp("need two arguments");
    }
    my @x = Vec::str2vec($ARGV[0]);
    my @y = Vec::str2vec($ARGV[1]);

    my @point;
    for my $x (@x) {
	for my $y (@y) {
	    push @point, [ $x, $y ];
	}
    }

    do_output(@point);
}
$Opt::DISP{abs} = [ \&doAbs,
 "arg is x1,x2,... y1,y2,... holes in matrix with thoose x and y's"
 ];


########

sub main() {
    @ARGV = Opt::opt();
    Opt::opt(\&Opt::UsageDisp);
    print STDERR Opt::Show(\%Opt::OPT);

    my $func = Opt::disp(shift @ARGV);
    &$func();
}

main();

__END__

1. comment (includes message).
2. set feed rate mode (G93, G94 — inverse time or per minute).
3. set feed rate (F).
4. set spindle speed (S).
5. select tool (T).
6. change tool (M6).
7. spindle on or off (M3, M4, M5).
8. coolant on or off (M7, M8, M9).
9. enable or disable overrides (M48, M49).
10. dwell (G4).
11. set active plane (G17, G18, G19).
12. set length units (G20, G21).
13. cutter radius compensation on or off (G40, G41, G42)
14. cutter length compensation on or off (G43, G49)
15. coordinate system selection (G54, G55, G56, G57, G58, G59, G59.1, G59.2, G59.3).
16. set path control mode (G61, G61.1, G64)
17. set distance mode (G90, G91).
18. set retract mode (G98, G99).
19. home (G28, G30) or

          change coordinate system data (G10) or
          set axis offsets (G92, G92.1, G92.2, G94).
20. perform motion (G0 to G3, G80 to G89), as modifed (possibly) by G53.
21. stop (M0, M1, M2, M30, M60).