#!/usr/bin/perl

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.

# Written in 2004 (c) by Michael Jung <miju@phantasia.org>.

$DEPTH = 100; # delta between planes
$THICK = 10; # thickness

while (@ARGV) {
    $a = shift @ARGV;
    if ($a eq "-depth") { $DEPTH = shift @ARGV; }
    elsif ($a eq "-thick") { $THICK = shift @ARGV; }
    else {
        print STDERR "Usage: fig2pov.pl [-depth n] [-thick m]\n";
        print STDERR "   n defaults to 100, m defaults to 10\n";
        print STDERR "   the script then reads from stdin and writes to stdout\n";
        exit -1;
    }
}

@col = (0x000000, 0x0000ff, 0x00ff00, 0x00ffff, 0xff0000,
        0xff00ff, 0xffff00, 0xffffff, 0x00008e, 0x0000ae,
        0x0000cf, 0x86cfff, 0x009200, 0x00b200, 0x00d300,
        0x00928e, 0x00b2ae, 0x00d3cf, 0x8e0000, 0xae0000,
        0xcf0000, 0x8e008e, 0xae00ae, 0xcf00cf, 0x863000,
        0x9e4100, 0xbe6100, 0xff8286, 0xffa29e, 0xffc3be,
        0xffe3df, 0xffd700);

<>;
while (<>) {
    # Resolution
    $RES = $1 if (/^(\d+) [12]$/);

    $comment = $1 if (/^\# (.+)/);

    # Color object
    if (/^0 (\d+) \#(\p{IsAlnum}+)/) {
        print STDERR "Parsing Color pseudo-object\n";
        $col[$1] = hex($2);
    }

    # Compound
    if (/^6 -?\d+ -?\d+ -?\d+ -?\d+/) {
        print STDERR "Parsing Compound\n";
        push @objects, prep()."merge {\n";
    }
    if (/^-6/) {
        print STDERR "Parsing Compound (end)\n";
        push @objects, "}\n";
    }

    # Arc
    if (($st, $line_style, $line_thickness, $pen_color, $fc, $d, $pen_style, $af, $style_val, $cap_style, $dir, $forward_arrow, $backward_arrow, $cx, $cy, $x1, $y1, $x2, $y2, $x3, $y3) = /^5 ([12]) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+)/) {
        print STDERR "Parsing Arc\n";
        my $h0 = $d*$DEPTH - .001;
        my $h1 = $d*$DEPTH + $THICK + .001;
        $cy = -$cy; $y1 = -$y1; $y2 = -$y2; $y3 = -$y3;
        my $r = sqrt(($cx - $x1)*($cx - $x1) + ($cy - $y1)*($cy - $y1));
        my $obj = prep()."intersection {\n".
            "   cylinder { <$cx, $cy, $h0>, <$cx, $cy, $h1>, $r }\n";
        if ($st == 2) {
            if ((($y3 - $cy)*($x1 - $cx) - ($x3 - $cx)*($y1 - $cy))
                * (2*$dir - 1) > 0 ) {
                $obj .= "   intersection {\n";
            }
            else {
                $obj .= "   merge {\n";
            }
            $obj .= "      plane {\n".
                "         vcross(".($dir?"":"-")."z, ".
                "<$cx - $x1, $cy - $y1, 0>) 0\n".
                "         translate <$cx, $cy, 0>\n".
                "      }\n".
                "      plane {\n".
                "         -vcross(".($dir?"":"-")."z, ".
                "<$cx - $x3, $cy - $y3, 0>) 0\n".
                "         translate <$cx, $cy, 0>\n".
                "      }\n".
                "   }\n";
        }
        else {
            $obj .= "      plane {\n".
                "         vcross(".($dir?"":"-")."z, ".
                "<$x3 - $x1, $y3 - $y1, 0>) 0\n".
                "      translate <$x3, $y3, 0>\n".
                "      }\n";
        }
        $obj .= "   pigment { ".&col($fc, $af)." }\n".
            "}\n";
        push @objects, $obj;
    }

    # Ellipse
    if (($line_style, $thickness, $pen_color, $fc, $d, $pen_style, $af, $style_val, $direction, $a, $cx, $cy, $rx, $ry) = /^1 [1-4] (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+)/) {
        print STDERR "Parsing Ellipsis\n";
        my $h0 = $d*$DEPTH - .001;
        my $h1 = $d*$DEPTH + $THICK + .001;
        $cy = -$cy;
        my $obj = prep()."cylinder {\n".
            "   0, z, 1\n".
            "   scale <$rx, $ry, ".($h1 - $h0).">\n".
            "   rotate ".(45/atan2(1,1)*$a)."*z\n".
            "   translate <$cx, $cy, $h0>\n".
            "   pigment { ".&col($fc, $af)." }\n".
            "}\n";
        push @objects, $obj;
    }

    # Polyline
    if (($line_style, $st, $thickness, $pen_color, $fc, $d, $pen_style, $af, $style_val, $join_style, $cap_style, $r, $forward_arrow, $backward_arrow, $np) = /^2 ([1-4]) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+)/) {
        print STDERR "Parsing Polyline\n";
        my $h0 = $d*$DEPTH - .001;
        my $h1 = $d*$DEPTH + $THICK + .001;
        my $obj = prep();
        if ($st != 4) {
            $obj .= "prism {\n".
                "   $h0, $h1, $np\n";
            my @pts;
            push(@pts, grep(/\d/,split(/ |\n/,<>)))
                while (2*$np > $#pts + 1);
            my @prism;
            foreach my $i (0..($#pts - 1)/2) {
                push @prism, "   <".$pts[2*$i].", ".$pts[2*$i+1].">";
            }
            $obj .= join(",\n",@prism).
                "\n".
                "   rotate 90*x\n".
                "   pigment { ".&col($fc, $af)." }\n".
                "}\n";
        }
        else { # We assume an aligned box
            $r *= $RES/80;
            @pts = grep(/\d/,split(/ |\n/,<>));
            $obj .= "merge {\n";
            $obj .="   box { <".(min($pts[0],$pts[4]) + $r).", ".
                min(-$pts[1],-$pts[5]).", ".($h0 - .001).">, <".
                (max($pts[0],$pts[4]) - $r).", ".max(-$pts[1],-$pts[5]).", ".
                ($h1 - .001)."> }\n";
            $obj .= "   box { <".min($pts[0],$pts[4]).", ".
                (min(-$pts[1],-$pts[5]) + $r).", ".($h0 - .006).">, <".
                max($pts[0],$pts[4]).", ".(max(-$pts[1],-$pts[5]) - $r).", ".
                ($h1 - .006)."> }\n";
            $obj .= "   cylinder { <".(min($pts[0],$pts[4]) + $r).", ".
                (min(-$pts[1],-$pts[5]) + $r).", ".
                ($h0 - .002).">, <".(min($pts[0],$pts[4]) + $r).", ".
                (min(-$pts[1],-$pts[5]) + $r).", ".
                ($h1 - .002).">, $r }\n";
            $obj .= "   cylinder { <".(min($pts[0],$pts[4]) + $r).", ".
                (max(-$pts[1],-$pts[5]) - $r).", ".
                ($h0 - .003).">, <".(min($pts[0],$pts[4]) + $r).", ".
                (max(-$pts[1],-$pts[5]) - $r).", ".
                ($h1 - .003).">, $r }\n";
            $obj .= "   cylinder { <".(max($pts[0],$pts[4]) - $r).", ".
                (min(-$pts[1],-$pts[5]) + $r).", ".
                ($h0 - .004).">, <".(max($pts[0],$pts[4]) - $r).", ".
                (min(-$pts[1],-$pts[5]) + $r).", ".
                ($h1 - .004).">, $r }\n";
            $obj .= "   cylinder { <".(max($pts[0],$pts[4]) - $r).", ".
                (max(-$pts[1],-$pts[5]) - $r).", ".
                ($h0 - .005).">, <".(max($pts[0],$pts[4]) - $r).", ".
                (max(-$pts[1],-$pts[5]) - $r).", ".
                ($h1 - .005).">, $r }\n";
            $obj .= "   pigment { ".&col($fc, $af)." }\n".
                "}\n";
        }
        push @objects, $obj;
    }

    # Spline
    if (($sub_type, $line_style, $thickness, $pen_color, $fc, $d, $pen_style, $af, $style_val, $cap_style, $forward_arrow, $backward_arrow, $np) = /^3 ([1-5]) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+)/) {
        print STDERR "Parsing Spline\n";
        my $h0 = $d*$DEPTH - .001;
        my $h1 = $d*$DEPTH + $THICK + .001;
        my $obj = prep()."prism {\n   cubic_spline\n".
            "   $h0, $h1, ".($np+3)."\n";
        my @pts;

        push(@pts, grep(/\d/,split(/ |\n/,<>)))
            while (2*$np > $#pts + 1);
        my @prism;
        push @prism, "   <".$pts[$#pts-1].", ".$pts[$#pts].">";
        foreach my $i (0..($#pts - 1)/2) {
            push @prism, "   <".$pts[2*$i].", ".$pts[2*$i+1].">";
        }
        push @prism, "   <".$pts[0].", ".$pts[1].">";
        push @prism, "   <".$pts[2].", ".$pts[3].">";
        
        $obj .= join(",\n",@prism).
            "\n".
            "   rotate 90*x\n".
            "   pigment { ".&col($fc, $af)." }\n".
            "}\n";
        push @objects, $obj;
        # The control points factors are dumped by the outer loop
    }

    # Text
    if (($st, $c, $d, $pen_style, $font, $fs, $a, $font_flags, $height, $l, $x, $y, $string) = /^4 ([012]) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+.?\d+) (-?\d+.?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (-?\d+) (.+)/) {
        print STDERR "Parsing Text\n";
        $string .= <> while (!$string =~ /\\001/);
        chomp $string;
        $string = substr($string, 0, -4);
        $fs *= $RES/72;
        my $h0 = $d*$DEPTH - .001;
        my $h1 = $d*$DEPTH + $THICK + .001;
        $y = -$y;
        if ($st == 2) { $x -= $l/2; }
        if ($st == 3) { $x -= $l; }
        my $obj = prep()."text {\n".
            "   ttf \"timrom.ttf\" \"$string\" ".($h1 - $h0).", 0\n".
            "   rotate ".(45/atan2(1,1)*$a)."*z\n".
            "   scale <$fs,$fs,1>\n".
            "   translate <$x, $y, $h0>\n".
            "   pigment { ".&col($c, 20)." }\n".
            "}\n";
        push @objects, $obj;
    }
}

print $_ foreach (@objects);

sub prep {
    if ($comment ne "") {
        my $ret = "#declare $comment = ";
        $comment = "";
        return $ret;
    }
}

sub col {
    my ($c,$f) = @_;
    return &col(0) if ($c == -1);

    if ($f == -1) {
        return "color rgbf 1";
    }
    elsif ($c == 0 && $f < 21) {
        return "color ".(1 - $f/20);
    }
    elsif ($f < 21) {
        return "color ".($f/20)."*<".
            ((($col[$c] & 0xff0000) >> 16)/255).", ".
            ((($col[$c] & 0x00ff00) >> 8)/255).", ".
            ((($col[$c] & 0x0000ff) >> 0)/255).">";
    }
    elsif ($c != 0 && $c != 7 && $f < 41) {
        return "color ".($f/20-1)." + ".(2-$f/20)."*<".
            ((($col[$c] & 0xff0000) >> 16)/255).", ".
            ((($col[$c] & 0x00ff00) >> 8)/255).", ".
            ((($col[$c] & 0x0000ff) >> 0)/255).">";
    }
}

sub min { return $_[0] if ($_[0] < $_[1]); return $_[1]; }
sub max { return $_[1] if ($_[0] < $_[1]); return $_[0]; }