#!/usr/bin/perl

use Image::Magick;
use Getopt::Std;

$opt{f}="Times";
$opt{F}=200;
$opt{s}=100;
$opt{d}=8;
$opt{D}=10;
$opt{q}=4;

getopts("q:cpP:s:d:D:t:i:f:F:n:h",\%opt);

if ($opt{h})
{
    print <<EOF;
$0 options:
    -p		Show 2D preview, don't produce mesh
    -P N	Show edgefinding up to boundary N (for debugging)
    -s N	Scale, pixels per unit (default 100)
    -d N	Distance in pixels to engrave in, default 8
    -D N	Depth of object in pixels (scaled by -s)
    -n NAME	Declare named object
    -c		Include faces
    -q N	Number of pixels per segment (quality) - (default 4)

    Data source:

    -t 'a b c'	Use given text
     -f font	Use specified font (default Times)
     -F size	Use specified pixel size (default 200)

     *or*

    -i file	Load image from file

EOF
    exit;
}

$opt{D}/=$opt{s};

die if not $opt{t} and not $opt{i};

if ($opt{t})
{
    # We must create a dummy image to query the font with
    $im=Image::Magick->new(size => '1x1');
    $im->Read("XC:white");
    (undef, undef, undef, undef, $X, $Y)= 
	$im->QueryFontMetrics(font => $opt{f}, pointsize => $opt{F},
	text => $opt{t});

    undef $im;
    $X+=40;
    $Y+=40;
    $im=Image::Magick->new(size => "${X}x$Y");
    $im->Read("XC:white");
    print $im->Annotate(text => $opt{t}, pointsize => $opt{F}, x=> 20,
	y=> $Y-40, fill => "#000", font => $opt{f});
}

if ($opt{i})
{
    $im=Image::Magick->new;
    die "Can't open $opt{i}" if $im->Read($opt{i});
    $X=$im->Get("width");
    $Y=$im->Get("height");
}

$PI=atan2(0,-1);

$bl=$im->ImageToBlob(magick => 'GRAY', depth => '8');

for ($x=0; $x<$X; $x++)
{
    for ($y=0; $y<$Y; $y++)
    {
	substr($bl, $y*$X+$x, 1) = "\xE0" if
	    substr($bl, $y*$X+$x, 1) eq "\x00";
    }
}

# First find the edge

$BORD="\xA0";
    
for ($x=0; $x<$X; $x++)
{
    for ($y=0; $y<$Y; $y++)
    {
	next if substr($bl, $y*$X+$x,1) eq "\xff";

	next if substr($bl, ($y-1)*$X+$x, 1) ne "\xff" and
	     substr($bl, ($y+1)*$X+$x, 1) ne "\xff" and
	     substr($bl, $y*$X+$x+1, 1) ne "\xff" and
	     substr($bl, $y*$X+$x-1, 1) ne "\xff";

	substr($bl, $y*$X+$x,1)=$BORD;
	push @border, [$x, $y];
    }
}

$BOUND="\x00";

my @done;
# Now, organize these points into distinct boundaries
foreach $b (@border)
{
    next if defined $done[$$b[0]][$$b[1]];

    # Ok, we haven't done this point, so we haven't done whatever
    # boundary it's on.  Do it now.
    my @bound;
    my ($x,$y)=@$b;
    POINT: while (1)
    {
	push @bound, [$x, $y];
	substr($bl, $y*$X+$x, 1)=$BOUND;

	# Store which boundary set it's in
	$done[$x][$y]=scalar @bounds;

	RETRY:

	my ($dx, $dy);
	for ($dx=-1; $dx<=1; $dx++) {
	    for ($dy=-1; $dy<=1; $dy++) {
		next if (not $dx and not $dy);
		if (substr($bl, ($y+$dy)*$X+($x+$dx), 1) eq $BORD)
		{
		    $x+=$dx;
		    $y+=$dy;
		    next POINT;
		}
	    }
	}

	# Ok, as a kluge, we're willing to backtrack one point.
	if ($#bound and $x==$bound[$#bound][0] and $y==$bound[$#bound][1])
	{
	    $x=$bound[$#bound-1][0];
	    $y=$bound[$#bound-1][1];
	    goto RETRY;
	}

	# If we get here, we didn't find a successor point
	last POINT;
    }

    # ANything with a small number of points is noise
    next if (@bound < 10);

    push @bounds, \@bound;

    if (defined $opt{P} and @bounds >= $opt{P})
    {
	undef $im;
	$im=Image::Magick->new(size => "${X}x$Y", magick => "GRAY", depth => 8);
	$im->BlobToImage($bl);
	$im->Display;
	exit;
    }

    # Now, we want to know if the "inside" is left or right
    my $dir=atan2($bound[1][1]-$bound[0][1], $bound[1][0]-$bound[0][0]);
    $dir-=$PI/2;
    my $x=int (($bound[0][0]+$bound[1][0])/2+4*cos($dir));
    my $y=int (($bound[0][1]+$bound[1][1])/2+4*sin($dir));
    if (substr($bl, $y*$X+$x, 1) ne "\xff") {
#	print "Left is inside\n";
	push @bdir, -1;
	
    } else {
#	print "Left is outside\n";
	push @bdir, +1;
    }
    substr($bl, $y*$X+$x, 1) = "\x00";

if (0)
{
    $dir+=$PI;
    $x=int (($bound[0][0]+$bound[1][0])/2+4*cos($dir));
    $y=int (($bound[0][1]+$bound[1][1])/2+4*sin($dir));
    if (substr($bl, $y*$X+$x, 1) ne "\xff") {
#	print "Right is inside\n\n";
    } else {
#	print "Right is outside\n\n";
    }
}
}

if ($opt{p})
{
    $preview=Image::Magick->new(size => "${X}x$Y");
    $preview->Read("XC:white");
}

# Split the boundaries into segments, and create "inner" segments
# which are offset

for ($bcnt=0; $bcnt<@bounds; $bcnt++)
{
    my $bound=$bounds[$bcnt];
    my $bdir=$bdir[$bcnt];

    my @segment;
    my @segment2;
    my ($x,$y)=($$bound[0][0], $$bound[0][1]);
    for ($i=$opt{q}; $i<@$bound; $i+=$opt{q})
    {
	push @segment, [$x, $y, $$bound[$i][0], $$bound[$i][1]];
	($x,$y)=($$bound[$i][0], $$bound[$i][1]);
    }
    push @segment, [$x, $y, $$bound[0][0], $$bound[0][1]];

    my @pt;
    foreach $seg (@segment)
    {
	push @pt, $$seg[0], $$seg[1];

	# Now, extend to the inside
	my $dir=atan2($$seg[3]-$$seg[1], $$seg[2]-$$seg[0]);
	$dir+=$PI/2*$bdir;

	# See how far we can go
	my $cenx=($$seg[0]+$$seg[2])/2;
	my $ceny=($$seg[1]+$$seg[3])/2;
	my $delx=cos($dir);
	my $dely=sin($dir);
	my $scale=abs($delx)>abs($dely)?abs($delx):abs($dely);
	$delx/=$scale;
	$dely/=$scale;
	my $othx=$cenx;
	my $othy=$ceny;
	while (1)
	{
	    $othx+=$delx;
	    $othy+=$dely;

	    die if $othx > $X or $othx < 0 or $othy > $Y or $othy < 0;

#	    last if defined $done[$othx][$othy];
	    last if substr($bl, int($othy)*$X+$othx, 1) eq "\xff";
	}
	my $dist=sqrt(($othx-$cenx)**2 + ($othy-$ceny)**2);

	$dist=$dist/2-1;

	$dist=$opt{d} if $dist>$opt{d};

	my $x1=int($$seg[0]+$dist*cos($dir));
	my $y1=int($$seg[1]+$dist*sin($dir));
	my $x2=int($$seg[2]+$dist*cos($dir));
	my $y2=int($$seg[3]+$dist*sin($dir));

	push @segment2, [$x1, $y1, $x2, $y2];
    }
    print $preview->Draw(primitive=>"polygon", points => join(",",@pt),
	stroke => "#000") if $opt{p};

    # Now for the inner segments, average the points
    for (my $i=0; $i<@segment2-1; $i++)
    {
	my $x=($segment2[$i][2]+$segment2[$i+1][0])/2;
	my $y=($segment2[$i][3]+$segment2[$i+1][1])/2;
	$segment2[$i][2]=$x;
	$segment2[$i+1][0]=$x;
	$segment2[$i][3]=$y;
	$segment2[$i+1][1]=$y;
    }
    # and special-case the wraparound
    $x=($segment2[$#segment2][2]+$segment2[0][0])/2;
    $y=($segment2[$#segment2][3]+$segment2[0][1])/2;
    $segment2[$#segment2][2]=$x;
    $segment2[0][0]=$x;
    $segment2[$#segment2][3]=$y;
    $segment2[0][1]=$y;

    undef @pt;
    foreach $seg (@segment2)
    {
	push @pt, $$seg[0], $$seg[1];
    }
    print $preview->Draw(primitive=>"polygon", points => join(",",@pt),
	stroke => "#00F") if $opt{p};

    # and show the correlation...
    for (my $i=0; $i<@segment; $i++)
    {
	print $preview->Draw(primitive=>"line", points =>
	    "$segment[$i][0],$segment[$i][1], $segment2[$i][0],$segment2[$i][1]",
	    stroke => "#88F") if $opt{p};
    }

    # Store the inner and outer segments for later
    push @boundoseg, \@segment;
    push @boundiseg, \@segment2;
}

if ($opt{p})
{
    $preview->Display;
    exit;
}

# Now for the fun part!

print "#version unofficial MegaPov 0.7;\n";
print "#declare $opt{n} = \n" if $opt{n};
print "mesh {\n";
$XOFF=-$X/2;
$YOFF=0;
sub transformx { return ($_[0] + $XOFF)/$opt{s} };
sub transformy { return ($Y - $_[0] + $YOFF)/$opt{s} };

for ($b=0; $b<@bounds; $b++)
{
    my @oseg = @{$boundoseg[$b]};
    my @iseg = @{$boundiseg[$b]};

    for ($i=0; $i<@oseg; $i++)
    {
	my @pt;

	$pt[0][0]=transformx($oseg[$i][0]);
	$pt[0][1]=transformy($oseg[$i][1]);
	$pt[0][2]=0;
	$pt[1][0]=transformx($oseg[$i][2]);
	$pt[1][1]=transformy($oseg[$i][3]);
	$pt[1][2]=0;
	$pt[2][0]=transformx($iseg[$i][0]);
	$pt[2][1]=transformy($iseg[$i][1]);
	$pt[2][2]=$opt{D};
    

	$pt[3][0]=transformx($oseg[$i][2]);
	$pt[3][1]=transformy($oseg[$i][3]);
	$pt[3][2]=0;
	$pt[4][0]=transformx($iseg[$i][0]);
	$pt[4][1]=transformy($iseg[$i][1]);
	$pt[4][2]=$opt{D};
	$pt[5][0]=transformx($iseg[$i][2]);
	$pt[5][1]=transformy($iseg[$i][3]);
	$pt[5][2]=$opt{D};
    
	print "  triangle {\n";
	for ($j=0; $j<3; $j++) {
	    print "    <$pt[$j][0], $pt[$j][1], $pt[$j][2]>\n";
	}
	print "  }\n";

	print "  triangle {\n";
	for ($j=3; $j<6; $j++) {
	    print "    <$pt[$j][0], $pt[$j][1], $pt[$j][2]>\n";
	}
	print "  }\n";

	if ($opt{c})
	{
	    print "  triangle {\n";
		print "    <$pt[0][0], $pt[0][1], $pt[0][2]>\n";
		print "    <$pt[1][0], $pt[1][1], $pt[1][2]>\n";
		print "    <0, 1, $pt[1][2]>\n";
	    print "  }\n";
	    print "  triangle {\n";
		print "    <$pt[4][0], $pt[4][1], $pt[4][2]>\n";
		print "    <$pt[5][0], $pt[5][1], $pt[5][2]>\n";
		print "    <0, 1, $pt[4][2]>\n";
	    print "  }\n";
	}
    }
    
}
print "  inside_vector <1,0,0>\n";
print "}\n";
