#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Std;
use Panotools::Script;

my %opt;

sub mk_coords {
    my ($p) = @_;
    my $num = "[-+]?\\d+(?:\\.\\d+)?";
    my @coords;
    while($p =~ m/($num)\s+($num)/g) {
	push @coords, { x => $1, y => $2 };
    }
    return \@coords;
}

sub nn { # syntactic sugar
    my $string = join " ", @_;
    return qq@"$string"@;
}

my $big = 1000000;

sub get_x {
    my ($slope, $c, $y) = @_;
    if($slope == $big) {
	return $c;
    } else {
	return ($y - $c) / $slope;
    }
}

sub get_y {
    my ($slope, $c, $x) = @_;
    return $slope * $x + $c;
}

# turn each side of the box into a exclude region stretching to the corresponding edge
sub mk_excl {
    my ($w, $h, $aa, $bb) = @_;
    my ($slope, $c);
    if($aa->{x} == $bb->{x}) {
	$slope = $big; # deal with infinity
	$c = $aa->{x};
    } else {
	$slope = ($bb->{y} - $aa->{y})/($bb->{x} - $aa->{x});
	$c = $aa->{y} - $slope * $aa->{x};
    }
    # line y = mx + c; m = slope
    # c = (m * x1)+y1
    my $a_slope = $slope > 0 ? $slope : -$slope;
    if($a_slope < .5) {
	# shallow line
	my $l = -5;
	my $r = $w + 5;
	if($aa->{y} < $h/2) {
	    # top box
	    return nn($l, -5, $r, -5, $r, get_y($slope, $c, $r), -5, get_y($slope, $c, $l));
	} else {
	    # bottom box
	    return nn($l, get_y($slope, $c, $l), $r, get_y($slope, $c, $r), $r, $h + 5, $l, $h + 5);
	}
    } else {
	# steep line
	my $t = -5;
	my $b = $h + 5;
	my $r = $w + 5;
	if($aa->{x} < $w/2) {
	    # left box
	    return nn(-5, $t, get_x($slope, $c, $t), $t, get_x($slope, $c, $b), $b, -5, $b);
	} else {
	    # right box
	    return nn(get_x($slope, $c, $t), $t, $r, $t, $r, $b, get_x($slope, $c, $b), $b);
	}
    }
}

sub map_mask {
    my ($inum, $ii) = @_;
    my $m = $ii->{masks}->[0];
    my $image = $ii->{image};
    my @four;
    for(my $i = 0; $i < 4; $i++) {
	my $p = mk_excl($image->{w}, $image->{h}, $m->{coords}->[$i], $m->{coords}->[($i+1) % 4]);
	my $m = Panotools::Script::Line::Mask->new();
	$m->Set(p => $p, i => $inum, t => 0);
	push @four, $m;
    }
    $ii->{masks} = \@four;
}

sub proc_all {
    my ($p) = @_;
    # package up the images and masks
    my @image;
    foreach my $ii (@{$p->{image}}) {
	push @image, { image => $ii };
    }
    foreach my $m (@{$p->{mask}}) {
	$m->{coords} = mk_coords($m->{p});
	push @{$image[$m->{i}]->{masks}}, $m;
    }
    my @ret_mask;
    # now find packages that have exactly 1 include mask with 4 coords
    for(my $inum = 0; $inum < scalar(@image); $inum++) {
	my $ii = $image[$inum];
	my $fname = $ii->{image}->{n};
	if(exists($ii->{masks})) {
	    my $m_cnt = scalar(@{$ii->{masks}});
	    if($m_cnt == 1) {
		my $m = $ii->{masks}->[0];
		print("image $fname has mask\n");
		my $c_cnt = scalar(@{$m->{coords}});
		if($m->{t} == 1 && $c_cnt == 4) {
		    printf("new mask for $fname\n");
		    map_mask($inum, $ii);
		}
	    } else {
		printf("image $ii has %d masks\n", $m_cnt);
	    }
	    push @ret_mask, @{$ii->{masks}};
	}
    }
    return \@ret_mask;
}

sub proc {
    my $p = new Panotools::Script;
    $p->Read($opt{i});
    if(scalar(@{$p->{image}}) == 0) {
	die "Error; $opt{i} contains no images\n";
    }
    my $out = $p->Clone();
    $out->{mask} = proc_all($p);
    $out->Write($opt{o});
}

getopts("i:o:", \%opt);
print STDERR "Usage: $0 -i <infile> -i <outfile>\n" unless(exists($opt{i}) && exists($opt{o}));
proc();
