xracer-tools 0.96.9.1-9 / usr / share / perl5 / XRacer / BVRML.pm

# XRACER (C) 1999-2000 Richard W.M. Jones <rich@annexia.org> and other AUTHORS
#
# 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
# of the License, 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.
#
# $Id: BVRML.pm,v 1.2 2000/01/07 08:44:41 rich Exp $

package XRacer::BVRML;

use Exporter;

@ISA = qw( Exporter );
@EXPORT = qw(  );

use strict;

sub parse
  {
    my $class = shift;
    my $filename = shift;
    my $world = shift;

    $world = { objects => [] } if !$world;

    if (!open FILE, $filename)
      {
	warn "open: $filename: $!";
	return undef;
      }

    my $state = "expecting header";
    my $current_object_name;
    my @current_vertices;
    my @current_faces;

    while (<FILE>)
      {
	s/[\n\r]+$//;

	if ($state eq "expecting header")
	  {
	    if (not /^\#VRML V1.0 ascii/)
	      {
		warn "$filename: not a B-VRML file";
		close FILE;
		return undef;
	      }
	    $state = "expecting object";
	  }

	elsif ($state eq "expecting object")
	  {
	    if (/DEF ([^ \t]+)/)
	      {
		$current_object_name = $1;
		$state = "expecting vertices";
	      }
	  }

	elsif ($state eq "expecting vertices")
	  {
	    if (/point \[/)
	      {
		@current_vertices = ();
		$state = "reading vertices";
	      }
	  }

	elsif ($state eq "reading vertices")
	  {
	    if (/([-0-9.]+)[ \t]+([-0-9.]+)[ \t]+([-0-9.]+)[ \t]*,/)
	      {
		push @current_vertices, [ $1, $2, $3 ];
	      }
	    elsif (/\]/)
	      {
		$state = "expecting faces";
	      }
	    else
	      {
		warn "$filename: parse error reading vertices";
		close FILE;
		return undef;
	      }
	  }

	elsif ($state eq "expecting faces")
	  {
	    if (/coordIndex \[/)
	      {
		@current_faces = ();
		$state = "reading faces";
	      }
	  }

	elsif ($state eq "reading faces")
	  {
	    if (/([0-9][0-9, \t]+),[ \t]+-1,/)
	      {
		my @vs = split /[ \t]*,[ \t]*/, $1;
		push @current_faces, \@vs;
	      }
	    elsif (/\]/)
	      {
		$state = "expecting object";

		my $object = { name => $current_object_name,
			       vertices => \@current_vertices,
			       faces => \@current_faces };

		#warn "created object: $current_object_name";

		push @{$world->{objects}}, $object;
	      }
	    else
	      {
		warn "$filename: parse error reading faces";
		close FILE;
		return undef;
	      }
	  }
      }

    close FILE;

    return bless $world, $class;
  }

sub vertices
  {
    my $self = shift;
    my @vertices = ();

    foreach (@{$self->{objects}}) { push @vertices, @{$_->{vertices}} }

    return @vertices;
  }

sub nr_vertices
  {
    my $self = shift;
    return 0+$self->vertices;
  }

sub faces
  {
    my $self = shift;
    my @faces = ();

    foreach (@{$self->{objects}}) { push @faces, @{$_->{faces}} }

    return @faces;
  }

sub nr_faces
  {
    my $self = shift;
    my $n = 0;

    foreach (@{$self->{objects}}) { $n += @{$_->{faces}} }

    return 0+$self->faces;
  }

sub bbox
  {
    my $self = shift;
    my @vertices = $self->vertices;
    my ($smallest_x, $largest_x, $smallest_y, $largest_y,
	$smallest_z, $largest_z) = (1e9, -1e9, 1e9, -1e9, 1e9, -1e9);

    foreach (@vertices)
      {
	$smallest_x = $_->[0] if $_->[0] < $smallest_x;
	$largest_x = $_->[0] if $_->[0] > $largest_x;
	$smallest_y = $_->[1] if $_->[1] < $smallest_y;
	$largest_y = $_->[1] if $_->[1] > $largest_y;
	$smallest_z = $_->[2] if $_->[2] < $smallest_z;
	$largest_z = $_->[2] if $_->[2] > $largest_z;
      }

    return ($smallest_x, $largest_x, $smallest_y, $largest_y,
	    $smallest_z, $largest_z);
  }

sub write_display_function
  {
    my $self = shift;
    my %args = @_;

    my $fh = $args{filehandle} || \*STDOUT;
    my $name = $args{name} || "display";
    my $decl = $args{decl} || "void";

    print $fh "$decl\n$name ()\n{\n";

    foreach (@{$self->{objects}})
      {
	$self->_write_object ($fh, $_);
      }

    print $fh "}\n\n";
  }

sub _write_object
  {
    my $self = shift;
    my $fh = shift;
    my $object = shift;

    print $fh "  /* object: ", $object->{name}, " */\n";

    print $fh "  {\n";
    print $fh "    static GLfloat va[][3] = ",
    _cinitializer (@{$object->{vertices}}), ";\n";

    print $fh "    static GLfloat saved_colour[4];\n\n";

    print $fh "    glGetFloatv (GL_CURRENT_COLOR, saved_colour);\n";
    print $fh "    glColor3f (1, 1, 1);\n";
    print $fh "    glEnableClientState (GL_VERTEX_ARRAY);\n";
    print $fh "    glVertexPointer (3, GL_FLOAT, 0, va);\n";

    # Note: It would make sense for us to somehow order the
    # faces to be drawn into multiple triangle strips, triangle
    # fans and quad strips. However, I can't be bothered to do
    # that, so instead lets order them into triangles and quads
    # and draw those. For Mesa 3.0 at least, drawing quads (or
    # even separate polygons) was much faster than drawing
    # quad strips. For Mesa 3.1, the release notes claim that
    # drawing quad strips should be a dramatic performance
    # improvement, so perhaps I should go back and revisit my
    # benchmarks.
    #   - RWMJ 2000/01/03.
    my @triangles = ();
    my @quads = ();
    my @polygons = ();

    foreach (@{$object->{faces}})
      {
	my @vs = @$_;

	push @triangles, \@vs if @vs == 3;
	push @quads, \@vs if @vs == 4;
	push @polygons, \@vs if @vs > 4;
      }

    if (@triangles)
      {
	print $fh "    glBegin (GL_TRIANGLES);\n";
	my $ref;
	foreach $ref (@triangles) {
	  foreach (@$ref) {
	    print $fh "      glArrayElement ($_);\n";
	  }
	}
	print $fh "    glEnd ();\n";
      }

    if (@quads)
      {
	print $fh "    glBegin (GL_QUADS);\n";
	my $ref;
	foreach $ref (@quads) {
	  foreach (@$ref) {
	    print $fh "      glArrayElement ($_);\n";
	  }
	}
	print $fh "    glEnd ();\n";
      }

    if (@polygons)
      {
	print $fh "    glBegin (GL_POLYGONS);\n";
	my $ref;
	foreach $ref (@polygons) {
	  foreach (@$ref) {
	    print $fh "      glArrayElement ($_);\n";
	  }
	}
	print $fh "    glEnd ();\n";
      }

    print $fh "    glColor3fv (saved_colour);\n";
    print $fh "    glDisableClientState (GL_VERTEX_ARRAY);\n";
    print $fh "  }\n";
  }

# This small helper function takes a list of either numbers of
# array refs, and returns an equivalent C string for initializing
# a C multi-dimensional array or structure.
sub _cinitializer
  {
    return "{ " . join (", ",
			map ({ ref ($_) eq 'ARRAY' ? _cinitializer (@$_) : $_ }
			     @_)) . " }";
  }

1;
__END__

=head1 NAME

XRacer::BVRML - Parser for a tiny subset of VRML generated by Blender

=head1 SYNOPSIS

  use XRacer::BVRML;


=head1 DESCRIPTION

This is a parser for a tiny subset of VRML generated by Blender,
so called Blender-VRML or BVRML. In fact, this parser is by no
means guaranteed to be able to parse everything that Blender
could generate. I will add parsing capability to it as I see
the need.

C<XRacer::BVRML> parses a Blender VRML file, and stores it in
an internal I<world> representation, which can be inspected and
manipulated. C<XRacer::BVRML> can also write out a C function
containing GL commands which render this I<world> object, and
this function can then be used inside an XRacer track or craft
file.

=head1 CLASS METHODS

=over 4

=item $world = XRacer::BVRML->parse ($filename [, $world]);

This function parses a BVRML file called C<$filename>, and
generates a C<$world> object. If the second optional
C<$world> parameter is given, then the BVRML file is
parsed and the results are merged with the existing
C<$world> object.

If the parsing fails, then this function will print an
error message and return C<undef>.

=back

=head1 WORLD OBJECT METHODS

=over 4

=item $nr_vertices = $world->nr_vertices;

Return the total number of vertices in the world.

=item $nr_faces = $world->nr_faces;

Return the total number of faces in the world.

=item @vertices = $world->vertices;

Aggregate all vertices in the world, and return it as
a list.

=item @faces = $world->faces;

Aggregate all faces in the world, and return it as
a list.

=item ($smallest_x, $largest_x, $smallest_y, $largest_y, $smallest_z, $largest_z) = $world->bbox;

Return the bounding box (or bounding cuboid, to be more precise)
of this world.

=item $world->write_display_function ([name => $function_name,] [filehandle => $filehandle,] [decl => $decl]);

Write out a C function containing GL calls which, when invoked, will
display this world object. The C function is called C<$function_name>
and will be written to the file specified by the C<$filehandle>. The
function will be declared as C<void function_name (void)> unless the
C<$decl> parameter is given, which gives the return declaration. The C
function is suitable for directly linking into XRacer craft and track
files. However, it requires some support. In particular, you will need
to include the header file GL/gl.h, and probably xracer.h before the
function.

=back

=head1 AUTHOR

  Richard W.M. Jones, <rich@annexia.org>

=head1 COPYRIGHT

XRacer is copyright (C) 1999-2000 Richard W.M. Jones (rich@annexia.org)
and other contributors listed in the AUTHORS file.

=head1 SEE ALSO

L<perl(1)>, L<xracer(6)>.

=cut