#! /usr/freeware/bin/perl5

#
#  This will read the ElectricImage .fact format and write an Inventor/VRML file.
#
#  The Electric Image .fact format is an IFF type format.
#  In other words it follows similar conventions as the Lightwave object file format.
#
#  The IFF file metaformat is summarized as follows:
#  The file must start with the keyword FORM and an unsigned long indicating the
#  size of the file in bytes (excepting the 8 bytes already read).
#  Then there must be a four byte ASCII file type ID indicating the type of IFF file.
#  If you don't recognize the file type you can punt.
#  Then follow chunks of data.  Each chunk consists of a four byte ASCII chunk ID
#  followed by a four-byte unsigned long indicating the length of the data in bytes
#  to corresponding to the chunk (again excepting the 8-byte header).  If you don't
#  recognize the chunk type you can skip it.  In this way, IFF files are extensible.
#  All numerical fields in an IFF file are big-endian (the high-order bytes
#  occur earlier in the file).
#
#  Now for the particulars of the ElectricImage .fact format:
#
#  The file type ID for the Electric Image .fact file is 3DFL.
#
#  The large scale structure of the file is a file header chunk identified by FORM
#  followed by a tree-like structure of part chunks also identified by FORM.
#
#  The file header chunk ID (FORM) is followed by the size and the form header ID FHDR.
#  Then follows the FINF chunk and it's size.
#  The FINF chunk consists of three unsigned longs indicating the number
#  of vertices in the whole model, the number of facets in the whole model,
#  and the number of groups (parts) in the whole model.  This is followed by
#  six floats describing the boundingbox of the whole model.  Last is four longs
#  that seem to be zerod out.
#
#  The data is contained in a sequence of group header chunks with ID GRUP.
#  The file header chunk ID (FORM) is followed by the form size and the form ID GHDR.
#  Then follows the GINF and it's size.
#  The GINF chunk consists of three unsigned longs indicating the number
#  of vertices in the group, the number of facets in the group, and the number
#  of subgroups in the group.  Then there are six floats describing the boundingbox
#  of the object.  After four bytes of crud there is 1 char indicating the length of
#  the object name followed by the object name in ASCII with a bunch of null padding.
#  The last four bytes in this chunk seem to have something in them.
#
#  The the GATR chunk follows with its size and can be skipped
#  (or parsed by someone smarter than me).  Then follows the geometry data in CORD
#  and ELEM chunks.
#
#  The vertex coordinate chunk has the ID CORD. The size of the CORD chunk
#  should be such that size/12 = n_grp_points where n_grp_points is the number of
#  vertices specified in the corresponding group header.  The CORD chunk size is
#  immediately followed by triplets of vertex coordinates in IEEE floating
#  point format (4-bytes) for the X, Y, and Z coordinates.
#
#  The element (facet) chunk has the ID ELEM.  Each facet begins with a 6-byte
#  header whose meaning is not entirely clear to me except that there is an
#  ID (byte 2) indicating whether the element is a quad (id = 0) or a polygon (id = 1).
#  If the element is  a polygon then the size of the rest of the data in bytes appears
#  in byte 6 of the header and can be divided into polygon vertices.
#
#  For quads, the element header is followed by
#  four unsigned integers indicating the unit-offset vertex indices
#  into the list of vertices.  The vertex indices are NOT byte offsets but
#  indicate the vertex number.  Index 0 (zero) indicates an invalid index so that
#  if the last index of the four in a facet is zero then the facet is a triangle
#  indexed by the first three indices.  (I don't know if wires or points are allowed.)
#  The trick is that the byte size of the indices is determined by the
#  number of vertices in the group.  If the number of vertices in the group is less
#  than 256 then the vertex indices are unsigned char.  If the number of vertices
#  in the group is less than 65536 then the vertex indices are unsigned short.
#  If the number of vertices in the group is less than 4294967296 then the vertex
#  indices are unsigned long.
#
#  For polygons the first 8 bytes of data following the header is unknown (by me).
#  The rest of the stream consists of integer indices into the vertex array defining
#  the polygon.  The integer size follows the same conventions as for quads.
#
#  It seems that Z points into the screen
#  and that the polygons are specified with clockwise vertex order.
#  I will negate all Z coordinates and boundingbox components so that facets
#  have normals facing outwards and so that the Z boundingbox coordinates
#  have z_max > z_min.
#
#  Here is a hexdump for your viewing pleasure:
#
#  0000000 464f524d 0007d13a 3344464c 464f524d
#           F O R M  file_sz  3 D F L  F O R M
#  0000020 00000040 46484452 46494e46 00000034
#                    F H D R  F I N F      len
#  0000040 000043b4 00005452 00000006 c1b921f9
#             n_pts   n_fcts   n_prts    min_x
#  0000060 c1217666 426f9fb3 41b92321 405a532a
#             min_y    min_z    max_x    max_y
#  0000100 c2855c71 00000000 00000000 00000000
#             max_z      pad      pad      pad
#  0000120 00000000 464f524d 00001176 47525550
#               pad  F O R M      len  G R U P
#  0000140 464f524d 00000086 47484452 47494e46
#           F O R M      len  G H D R  G I N F
#  0000160 0000004e 000000b8 000000d2 00000000
#           n_g_pts n_g_fcts n_g_prts      pad
#  0000200 c08652e3 bf9b87f9 c23cdb28 40861355
#           min_g_x  min_g_y  min_g_z  max_g_x
#  0000220 3feeb94e c24a2ea8 71000000 04657965
#           max_g_y  max_g_z           4 e y e // char size of ascii object name and string.
#  0000240 73000000 00000000 00000000 00000000
#           s                                 
#  0000260 00000000 00000000 00000000 000037cf
#                                             
#  0000300 cdac4741 54520000 00242280 ff000000
#               G A  T R                      
#  0000320 ff000000 ff202020 4063ab85 1eb851ec
#                                             
#  0000340 ffff0000 003ff000 00000000 0000434f
#                                          C O
#  0000360 52440000 08a0c07a 8eeb3fa4 80d8c243
#           R D          x_1      y_1      z_1
#  0000400 eef8c086 52e33f2a ec39c244 0630c081
#               x_2      y_2      z_2      x_3
#
#  . . . . .
#
#  0004600 13553f2a ec39c244 06de4086 1355bc91
#                                          x_N
#  0004620 2fd3c244 06de454c 454d0000 08340000
#       yN       zN      E L  E M      len<---
#  0004640 ff7f7f7f 01020304 0000ff7f 7f7f0506
#          q_head-> <q_vrts> <-q_head --><
#


use Carp;
use English;

if ( $#ARGV < 1 ) {
    croak "\n  Usage: ", $PROGRAM_NAME, " <fact_file> <vrml_file>\n\n";
}

#  Open ElectricImage input file.
$fact_file = $ARGV[0];
open( FACT, "<$fact_file" ) || croak "\n  Can't open $fact_file for input.\n";

#  Open VRML output file.
$vrml_file = $ARGV[1];
open( VRML, ">$vrml_file" ) || croak "\n  Can't open $vrml_file for output.\n";


read( FACT, $data, 4 );

if ( $data =~ "FORM" ) {
    print "\n  Lookin\' good!!!\n\n";
} else {
    print "\n  File is not IFF!!!\n\n";
}

read( FACT, $data, 4 );
($file_length) = unpack( "I", $data );
print "  File Length: ", $file_length, "\n";

#  Read the file type ID.

read( FACT, $data, 4 );
print "  File Type: ", $data, "\n";

if ( ! $data =~ "3DFL" ) {
    croak "\n  File type not recognized!!!\n\n";
}

read( FACT, $data, 4 );
print "  Form: ", $data, "\n";

read( FACT, $data, 4 );
($form_length) = unpack( "I", $data );
print "  Form Length: ", $form_length, "\n";

read( FACT, $data, 4 );
print "  Form Header: ", $data, "\n";

read( FACT, $data, 4 );
print "  Form Info: ", $data, "\n";

read( FACT, $data, 4 );
($form_info_length) = unpack( "I", $data );
print "  Form Info Length: ", $form_info_length, "\n";

#  Read numbers of points, facets, and parts for the whole model.

read( FACT, $data, 4 );
($n_points) = unpack( "I", $data );
print "  Number of Points: ", $n_points, "\n";

read( FACT, $data, 4 );
($n_facets) = unpack( "I", $data );
print "  Number of Facets: ", $n_facets, "\n";

read( FACT, $data, 4 );
($n_parts) = unpack( "I", $data );
print "  Number of Parts: ", $n_parts, "\n";

#  Read the model boundingbox.

read( FACT, $data, 4 );
($bbox[0][0]) = unpack( "f", $data );
print "  X Min: ", $bbox[0][0], "\n";

read( FACT, $data, 4 );
($bbox[0][1]) = unpack( "f", $data );
print "  Y Min: ", $bbox[0][1], "\n";

read( FACT, $data, 4 );
($bbox[0][2]) = unpack( "f", $data );
$bbox[0][2] = -$bbox[0][2];
print "  Z Min: ", $bbox[0][2], "\n";

read( FACT, $data, 4 );
($bbox[1][0]) = unpack( "f", $data );
print "  X Max: ", $bbox[1][0], "\n";

read( FACT, $data, 4 );
($bbox[1][1]) = unpack( "f", $data );
print "  Y Max: ", $bbox[1][1], "\n";

read( FACT, $data, 4 );
($bbox[1][2]) = unpack( "f", $data );
$bbox[1][2] = -$bbox[1][2];
print "  Z Max: ", $bbox[1][2], "\n";

#  Read what seems to be padding.

read( FACT, $data, 4 );
($n) = unpack( "I", $data );
print "  Number: ", $n, "\n";

read( FACT, $data, 4 );
($n) = unpack( "I", $data );
print "  Number: ", $n, "\n";

read( FACT, $data, 4 );
($n) = unpack( "I", $data );
print "  Number: ", $n, "\n";

read( FACT, $data, 4 );
($n) = unpack( "I", $data );
print "  Number: ", $n, "\n";



#  Write the model boundingbox to the scene graph.

print VRML "#VRML V1.0 ascii\n\n";
print VRML "Separator {\n";
print VRML "  #\n";
print VRML "  #  Model boundingbox\n";
print VRML "  #\n";
print VRML "  Separator {\n";
print VRML "    BaseColor {\n";
print VRML "      rgb 1.0 0.0 0.0\n";
print VRML "    }\n";
print VRML "    Coordinate3 {\n";
print VRML "      point [\n";
print VRML "        ", $bbox[0][0], " ", $bbox[0][1], " ", $bbox[0][2], ",\n";
print VRML "        ", $bbox[1][0], " ", $bbox[0][1], " ", $bbox[0][2], ",\n";
print VRML "        ", $bbox[0][0], " ", $bbox[1][1], " ", $bbox[0][2], ",\n";
print VRML "        ", $bbox[0][0], " ", $bbox[0][1], " ", $bbox[1][2], ",\n";
print VRML "        ", $bbox[0][0], " ", $bbox[1][1], " ", $bbox[1][2], ",\n";
print VRML "        ", $bbox[1][0], " ", $bbox[0][1], " ", $bbox[1][2], ",\n";
print VRML "        ", $bbox[1][0], " ", $bbox[1][1], " ", $bbox[0][2], ",\n";
print VRML "        ", $bbox[1][0], " ", $bbox[1][1], " ", $bbox[1][2], ",\n";
print VRML "      ]\n";
print VRML "    }\n";
print VRML "    IndexedLineSet {\n";
print VRML "      coordIndex [\n";
print VRML "        0, 1, -1,\n";
print VRML "        0, 2, -1,\n";
print VRML "        0, 3, -1,\n";
print VRML "        4, 2, -1,\n";
print VRML "        4, 3, -1,\n";
print VRML "        5, 3, -1,\n";
print VRML "        5, 1, -1,\n";
print VRML "        6, 1, -1,\n";
print VRML "        6, 2, -1,\n";
print VRML "        7, 6, -1,\n";
print VRML "        7, 5, -1,\n";
print VRML "        7, 4, -1,\n";
print VRML "      ]\n";
print VRML "    }\n";
print VRML "  }\n";


#  Flag indicating whether the current group is the first.  Used for writing the scene graph.
$first = "Hell, Yes!!!";

#  This flag controls whether each and every vertex and facet is written to standard output.
$verbose = "";

$n_grp_points = 0;
$n_grp_facets = 0;

$n_temp_points = 0;
$n_temp_facets = 0;

$group = 0;

do {

    read( FACT, $data, 4 );
    if ( eof( FACT ) ) {
        break;
    }

    if ( $data =~ "FORM" ) {

        print "\n  Form: ", $data, "\n";

        read( FACT, $data, 4 );
        ($form_length) = unpack( "I", $data );
        print "  Form Length: ", $form_length, "\n";

    } elsif ( $data =~ "GRUP" ) {

        print "  Group: ", $data, "\n";

        read( FACT, $data, 4 );
        print "  Group Form: ", $data, "\n";

        read( FACT, $data, 4 );
        ($form_length) = unpack( "I", $data );
        print "  Group Form Length: ", $form_length, "\n";

        read( FACT, $data, 4 );
        print "  Group Header: ", $data, "\n";

        read( FACT, $data, 4 );
        print "  Group Info: ", $data, "\n";

        read( FACT, $data, 4 );
        ($form_length) = unpack( "I", $data );
        print "  Group Info Length: ", $form_length, "\n";

        #  Read group info stuff.
        read( FACT, $data, 4 );
        ($n_grp_points) = unpack( "i", $data );
        print "  Group Number of Points: ", $n_grp_points, "\n";
        $n_temp_points += $n_grp_points;

        read( FACT, $data, 4 );
        ($n_grp_facets) = unpack( "i", $data );
        print "  Group Number of Facets: ", $n_grp_facets, "\n";
        $n_temp_facets += $n_grp_facets;

        read( FACT, $data, 4 );
        ($n) = unpack( "I", $data );
        print "  Number of Subgroups: ", $n, "\n";

        read( FACT, $data, 4 );
        ($gbox[0][0]) = unpack( "f", $data );
        print "  Group X Min: ", $gbox[0][0], "\n";

        read( FACT, $data, 4 );
        ($gbox[0][1]) = unpack( "f", $data );
        print "  Group Y Min: ", $gbox[0][1], "\n";

        read( FACT, $data, 4 );
        ($gbox[0][2]) = unpack( "f", $data );
        $gbox[0][2] = -$gbox[0][2];
        print "  Group Z Min: ", $gbox[0][2], "\n";

        read( FACT, $data, 4 );
        ($gbox[1][0]) = unpack( "f", $data );
        print "  Group X Max: ", $gbox[1][0], "\n";

        read( FACT, $data, 4 );
        ($gbox[1][1]) = unpack( "f", $data );
        print "  Group Y Max: ", $gbox[1][1], "\n";

        read( FACT, $data, 4 );
        ($gbox[1][2]) = unpack( "f", $data );
        $gbox[1][2] = -$gbox[1][2];
        print "  Group Z Max: ", $gbox[1][2], "\n";

        read( FACT, $data, 4 );
        #($n) = unpack( "i", $data );
        #print "  Number: ", $n, "\n";

        #  Read the group description.
        read( FACT, $data, 1 );
        ($desc_length) = unpack( "C", $data );
        print "  Group Description Length: ", $desc_length, "\n";
        read( FACT, $data, $desc_length );
        ($desc) = unpack( "a".$desc_length, $data );
        print "  Group Description: ", $desc, "\n";

        #  Read the rest of the group info.
        read( FACT, $data, $form_length - 41 - $desc_length );

        read( FACT, $data, 4 );
        print "  Group Attribute: ", $data, "\n";

        read( FACT, $data, 4 );
        ($form_length) = unpack( "I", $data );
        print "  Group Attribute Length: ", $form_length, "\n";

        $location = tell( FACT );

        #  Read past group attribute data . . . Nope.
        #read( FACT, $data, $form_length );

        #  Parse group attribute data . . . Nope.
        #read( FACT, $data, 16 );
        #read( FACT, $data, 12 );
        #($r,$g,$b) = unpack( "fff", $data );
        #print "  R: ", $r, "\n";
        #print "  G: ", $g, "\n";
        #print "  B: ", $b, "\n";

        #  Skip to end of group attribute data.
        seek( FACT, $location + $form_length, 0 );

        #  Write Inventor separator stuff.

        if ( ! $first ) {
            print VRML "  }\n";
        } else {
            ++$group;
            $first = "";
        }

        print VRML "  #\n";
        print VRML "  #  Group ", $group, "\n";
        print VRML "  #\n";
        print VRML "  Separator {\n";

    } elsif ( $data =~ "CORD" ) {

        read( FACT, $data, 4 );
        ($cord_length) = unpack( "I", $data );
        print "  Coordinate Length: ", $cord_length, "\n";

        print VRML "    Coordinate3 {\n";
        print VRML "      point [\n";

        $n_cords = $cord_length/12;
        if ( $n_cords != $n_grp_points ) {
            carp "\n  **  Inconsistent number of vertex points!!!\n\n";
        }

        for ( $i = 0; $i < $n_cords; ++$i ) {

            read( FACT, $data, 12 );
            ($x, $y, $z) = unpack( "fff", $data );
            $z = -$z;

            if ( $verbose ) {
                print "  Vertex: ", $x, " " , $y, " ", $z, "\n";
            }

            print VRML "        ", $x, " " , $y, " ", $z, ",\n";
        }

        print VRML "      ]\n";
        print VRML "    }\n";

        #  We don't need no stinkin' point set now that we can read facets.
        #print VRML "    PointSet {\n";
        #print VRML "      startIndex 0\n";
        #print VRML "      numPoints ", $n_cords, "\n";
        #print VRML "    }\n";

    } elsif ( $data =~ "ELEM" ) {

        read( FACT, $data, 4 );
        ($elem_length) = unpack( "I", $data );
        print "  Element Length: ", $elem_length, "\n";

        #  Keep tabs on how many facets are read in this group for consistency checking.
        $n_temp_grp_facets = 0;

        $location = tell( FACT );

        #  Facets are unit-offset indices into the group point array.

        print VRML "    IndexedFaceSet {\n";
        print VRML "      coordIndex [\n";

        if ( $n_grp_points < 256 ) {

            #  Facet vertex indices are stored as unsigned char.
            $vertex_size = 1;
            $vertex_type = "C";

        } elsif ( $n_grp_points < 65536 ) {

            #  Facet vertex indices are stored as unsigned short.
            $vertex_size = 2;
            $vertex_type = "S";

        } else {

            #  Facet vertex indices are stored as unsigned long.
            $vertex_size = 4;
            $vertex_type = "I";

        }

        for ( $i = 0; $i < $n_grp_facets; ++$i ) {

            read( FACT, $data, 6 );
            @elem_header = unpack( "C6", $data );
            #print "  Element Header: ", $elem_header[2], "\n";
            if ( $elem_header[1] == 0 ) {

                #  This element is either a quadrangle or a triangle.

                ++$n_temp_grp_facets;

                read( FACT, $data, $vertex_size );
                ($facet[0]) = unpack( $vertex_type, $data );

                read( FACT, $data, $vertex_size );
                ($facet[1]) = unpack( $vertex_type, $data );

                read( FACT, $data, $vertex_size );
                ($facet[2]) = unpack( $vertex_type, $data );

                read( FACT, $data, $vertex_size );
                ($facet[3]) = unpack( $vertex_type, $data );

                print VRML "        ", $facet[0] - 1,
                                 ", ", $facet[1] - 1,
                                 ", ", $facet[2] - 1,
                                 ", ", $facet[3] - 1;
                if ( $facet[3] != 0 ) {
                    print VRML ", -1,\n";
                } else {
                    print VRML ",\n";
                }

                if ( $verbose ) {
                    print "  Facet: ", $facet[0], " ", $facet[1], " ", $facet[2], " ", $facet[3], "\n";
                }

            } elsif ( $elem_header[1] == 1 ) {

                #  This element is a polygon.

                ++$n_temp_grp_facets;

                $elem_size = $elem_header[5];

                #  Read past some polygon header stuff.
                read( FACT, $data, 8 );

                #  Read the polygon vertices.
                read( FACT, $data, $elem_size - 8 );

                $n_vertices = ($elem_size - 8)/$vertex_size;
                @vertex = unpack( $vertex_type.$n_vertices, $data );

                if ( $verbose ) {
                    print "  Facet:";
                    for ( $v = 0; $v < $n_vertices; ++$v ) {
                        print " ", $vertex[$v];
                    }
                    print "\n";
                }

                print VRML "        ";
                for ( $v = 0; $v < $n_vertices; ++$v ) {
                    print VRML $vertex[$v] - 1, ", ";
                }
                print VRML "-1,\n";

            } else {

                carp "\n  **  Element header not recognized.  Element type: ", $elem_header[1], "\n\n";

            }

        }


        if ( $n_temp_grp_facets != $n_grp_facets ) {
            carp "\n  **  Number of group facets read (", $n_temp_grp_facets,
                    ") != Number of group facets expected (", $n_grp_facets, ").\n\n";
        }

        print VRML "      ]\n";
        print VRML "    }\n";

        #  Skip to end of element list so that if something went wrong
        #  we could keep going with the next group.
        seek( FACT, $location + $elem_length, 0 );

    } else {

        carp "\n  **  Entity not recognized.\n\n";
        break;

    }

} while( ! eof( FACT ) );

print "\n";
print "  Sum of points for all parts: ", $n_temp_points, "\n";
print "  Sum of facets for all parts: ", $n_temp_facets, "\n";

print "\n  Done!!!\n\n";

print VRML "  }\n";
print VRML "}\n";

close( VRML );

close( FACT );

