xracer-tools 0.96.9.1-7 / usr / games / xracer-blender2track

#!/usr/bin/perl -w
# 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: xracer-blender2track.pl,v 1.8 2000/03/20 21:08:57 rich Exp $

# This script generates XRacer track files from Blender scene
# descriptions.
#
# To use it, first note that you currently need to have a Blender
# C-Key (this restriction will be lifted when free Blender is released
# in the summer this year). You will then need to design a track
# and export it using the Python script found in tools/blenderexport.
#
# In brief the program works as follows: It takes the Python exported
# track description and loads it into memory using the XRacer::BlenderImport
# module. It locates the track description which it expects to find
# on layer 1. It then converts the track description into a series of
# ``zones''. Each zone corresponds to the (nearly-) cuboid shape
# directly above each track face. If the craft enters one of these
# zones then it feels pressure from that face. Since the track lies
# mainly in the X-Y plane, we compute the X-Y bounding boxes of each
# of these zones and from that build up a simple BSP which maps a craft
# (x,y) position to a small number of zones. The job at run time is
# then simply to check the craft's actual position against each of these
# zones (there should be no more than about 4 or 5 zones to check - in
# other words, just about 30 point-to-plane comparisons). The track
# BSP etc. is written to a track description file called track.c. After
# building information about the track, the program looks at layer 2 to
# find scenery information. Each piece of scenery is turned into a distinct
# object and written to a file called obj_NAME.c.

use strict;

use Getopt::Long;
#use Data::Dumper;

use lib '../../XRacer/blib/lib'; # So you can run this without installing it.
use XRacer::Math;
use XRacer::BlenderImport;

# Read command line arguments.
my $silent = 0;
my $verbose = 0;
my $help = 0;
my $only_scenery = 0;
my $track_height = 0.2;
my $track_depth = 0.2;
my $track_expansion = 1.1;

GetOptions ("only-scenery" => \$only_scenery,
	    "track-height=f" => \$track_height,
	    "track-depth=f" => \$track_depth,
	    "track-expansion=f" => \$track_expansion,
	    "verbose" => \$verbose,
	    "silent" => \$silent,
	    "help|?" => \$help);

if ($help)
  {
    print STDERR "$0 [--verbose] [--silent] [--only-scenery] [--track-height=TRACK_HEIGHT] [--track-depth=TRACK_DEPTH] [--track-expansion=FACTOR] [blender.export] [OBJ,TEXTURE,TEXSCALE,ROTATION ...]\n";
    exit 1;
  }

print "track_height=$track_height, track_depth=$track_depth, track_expansion=$track_expansion\n" if $verbose;

print "Importing track ...\n" if $verbose;
my $world = parse XRacer::BlenderImport shift;

# Read texture descriptions, if any.
my %texture_description = ();

while ($_ = shift)
  {
    my ($object_name, $texture_name, $texture_scale, $texture_rotation)
      = split /,/, $_;

    $texture_description{$object_name}
      = {
	 name => $texture_name,
	 scale => $texture_scale,
	 rotation => $texture_rotation
	};
  }

my $verticesref = $world->get_vertices;
my %layersinfo = $world->get_layer_info;

# Print out some information about the scene.
if ($verbose)
  {
    print "Number of common vertices: ", 0+@$verticesref, "\n";
    print "Objects found in each layer:\n";
    foreach (sort numerically keys %layersinfo)
      {
	my @objects = $world->get_meshes_in_layer ($_);
	my @names = map { $_->{name} } @objects;

	print "  Layer $_: ", $layersinfo{$_},
	  " object(s): ", join (", ", @names), "\n";
      }
  }

# We are expecting to find:
#  layer 0:   Objects in this layer are ignored.
#  layer 1:   Track
#  layer 2:   EnterPlane00 EnterPlane01 .. EnterPlaneNN
#  layer 3:   Scenery objects ...
my @objects;

if (! $only_scenery)
  {
    @objects = $world->get_meshes_in_layer (1);

    die "Expected to find a single object called ``Track'' in layer 1."
      if @objects != 1 || $objects[0]->{name} ne "Track";

    my $track_mesh = $objects[0];

    # Do the track stuff.
    do_track ($track_mesh);

    @objects = $world->get_meshes_in_layer (2);

    die "Expected to find EnterPlane* objects in layer 2."
      unless @objects;

    # Sort enter plane objects into numerical order.
    @objects = sort { $a->{name} cmp $b->{name} } @objects;

    for (my $i = 0; $i < @objects; ++$i)
      {
	my $name = $objects[$i]{name};

	die "$name: Expected to find EnterPlane00, EnterPlane01, ... in layer 2."
	  unless $name =~ m/^EnterPlane([0-9][0-9])$/ && int ($1) == $i;
      }

    # Write out the enter planes.
    do_enterplanes (\@objects);
  }

# Do the scenery stuff.
@objects = $world->get_meshes_in_layer (3);

my @object_names = ();

foreach (@objects)
  {
    push @object_names, do_scenery_object ($_);
  }

open OBJECTS_H, ">objects.h" or die "objects.h: $!";

print OBJECTS_H "/* This file describes all scenery objects.\n * It is automatically generated.\n */\n\n#ifndef __objects_h__\n#define __objects_h__\n\n";

foreach (@object_names)
  {
    print OBJECTS_H "extern void obj_${_}_display (void);\n";
    print OBJECTS_H "extern int obj_${_}_load (void);\n";
    print OBJECTS_H "extern void obj_${_}_unload (void);\n";
  }

print OBJECTS_H "\n#endif __objects_h__\n";
close OBJECTS_H;

open OBJECTS_C, ">objects.c" or die "objects.c: $!";

print OBJECTS_C "/* This file describes all scenery objects.\n * It is automatically generated.\n */\n\n#include \"common.h\"\n\n";

print OBJECTS_C "int\nobj_load ()\n{\n";

foreach (@object_names)
  {
    print OBJECTS_C "  if (obj_${_}_load ()) return -1;\n";
  }

print OBJECTS_C "  return 0;\n}\n\n";

print OBJECTS_C "void\nobj_unload ()\n{\n";

foreach (@object_names)
  {
    print OBJECTS_C "  obj_${_}_unload ();\n";
  }

print OBJECTS_C "}\n\n";

close OBJECTS_C;

exit 0;

#----------------------------------------------------------------------
# TRACK PROCESSING.

sub do_track
  {
    my $track_mesh = shift;

    print "Processing track ...\n" if $verbose;

    my @track_faces = @{$track_mesh->{faces}};

    my ($track_min_x, $track_max_x, $track_min_y, $track_max_y)
      = (1000000, -1000000, 1000000, -1000000);

    my @faces = ();

    my $face;
    my $face_num = 0;

    foreach $face (@track_faces)
      {
        my @face_vertex_indices = @{$face->{vertices}};
        
        # All faces in the track mesh must be four-sided. Get the four
        # vertices.
        die "faces in track mesh must be four-sided"
          if @face_vertex_indices != 4;
        
        my $v0 = $verticesref->[$face_vertex_indices[0]]->{coords};
        my $v1 = $verticesref->[$face_vertex_indices[1]]->{coords};
        my $v2 = $verticesref->[$face_vertex_indices[2]]->{coords};
        my $v3 = $verticesref->[$face_vertex_indices[3]]->{coords};

        # Compute the midpoint and plane coefficients.
        my $mp = midpoint ($v0, $v1, $v2, $v3);
        
        my $plane = plane_coefficients ($v2, $v1, $v0);
        
        # Construct a unit normal vector to the face.
        my $n = unit_normal ($plane);

        # Construct midpoint of plane HEIGHT * unit normal from face.
	my $hn = multiply_scalar_vector ($track_height, $n);
        my $mq = sum_vectors ($mp, $hn);
        
        # Construct top points of the zone.
        my $v4 = sum_vectors ($v0, $hn);
        my $v5 = sum_vectors ($v1, $hn);
        my $v6 = sum_vectors ($v2, $hn);
        my $v7 = sum_vectors ($v3, $hn);

        # Expand the top face out slightly.
        my $v8 = sum_vectors ($mq,
                              multiply_scalar_vector ($track_expansion,
                                              subtract_vectors ($v4, $mq)));
        my $v9 = sum_vectors ($mq,
                              multiply_scalar_vector ($track_expansion,
                                              subtract_vectors ($v5, $mq)));
        my $v10 = sum_vectors ($mq,
                               multiply_scalar_vector ($track_expansion,
                                               subtract_vectors ($v6, $mq)));
        my $v11 = sum_vectors ($mq,
                               multiply_scalar_vector ($track_expansion,
                                               subtract_vectors ($v7, $mq)));

	# Construct the part of the zone below the track.
	my $dn = multiply_scalar_vector (-$track_depth, $n);

        my $v12 = sum_vectors ($v0, $dn);
        my $v13 = sum_vectors ($v1, $dn);
        my $v14 = sum_vectors ($v2, $dn);
        my $v15 = sum_vectors ($v3, $dn);
        
        # Construct the zone midpoint - so we can arrange all the
        # faces to point inwards.
        my $zone_midpoint = midpoint ($v0, $v1, $v2, $v3,
				      $v8, $v9, $v10, $v11);
        
        # Construct the six faces around the zone.
        my @face0 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v12, $v13, $v14, $v15);
        my @face1 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v12, $v13, $v9, $v8);
        my @face2 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v13, $v14, $v10, $v9);
        my @face3 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v14, $v15, $v11, $v10);
        my @face4 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v15, $v12, $v8, $v11);
        my @face5 = reorder_face_so_point_inside ($zone_midpoint,
                                                  $v8, $v9, $v10, $v11);

	# Construct the actual face plane.
        my @faceplane = reorder_face_so_point_inside ($zone_midpoint,
						      $v0, $v1, $v2, $v3);

	# Construct planes from faces.
	my $plane0 = plane_coefficients (@face0);
	my $plane1 = plane_coefficients (@face1);
	my $plane2 = plane_coefficients (@face2);
	my $plane3 = plane_coefficients (@face3);
	my $plane4 = plane_coefficients (@face4);
	my $plane5 = plane_coefficients (@face5);
	my $faceplane = plane_coefficients (@faceplane);

	# Construct the XY bounding box.
	my ($min_x, $max_x, $min_y, $max_y)
	  = bbox ($v12, $v13, $v14, $v15, $v8, $v9, $v10, $v11);

	# Update the track bounding box.
	if ($min_x < $track_min_x) {
	  $track_min_x = $min_x;
	} elsif ($max_x > $track_max_x) {
	  $track_max_x = $max_x;
	}
	if ($min_y < $track_min_y) {
	  $track_min_y = $min_y;
	} elsif ($max_y > $track_max_y) {
	  $track_max_y = $max_y;
	}

	# Save everything about this face.
	push @faces, { bbox_min_x => $min_x,
		       bbox_max_x => $max_x,
		       bbox_min_y => $min_y,
		       bbox_max_y => $max_y,
		       faceplane => $faceplane,
		       plane0 => $plane0,
		       plane1 => $plane1,
		       plane2 => $plane2,
		       plane3 => $plane3,
		       plane4 => $plane4,
		       plane5 => $plane5,
		       n => $face_num };

      } continue {
	$face_num ++;
      }

    my $nr_faces = 0+@faces;

    if ($verbose)
      {
	print "Number of faces in track: ", $nr_faces, "\n";
	print "Track XY bounding box: X: [$track_min_x, $track_max_x] Y: [$track_min_y, $track_max_y]\n";
      }

    # Write out the faces to a file.
    print "Writing trackfaces.c ...\n" if $verbose;

    open FACES, ">trackfaces.c" or die "trackfaces.c: $!";
    print FACES "/* This file describes the shape of the track itself.\n * It is automatically generated.\n */\n\n#include \"common.h\"\n\n";

    print FACES "int nr_track_faces = $nr_faces;\n\n";

    print FACES "struct xrTrackFace track_faces[$nr_faces] = {\n";

    foreach (@faces)
      {
	print FACES "  { ",
	cinitializer (@{$_->{faceplane}}), ", ",
	cinitializer ($_->{plane0}, $_->{plane1},
		      $_->{plane2}, $_->{plane3},
		      $_->{plane4}, $_->{plane5}), " },\n";
      }

    print FACES "};\n\n";

    print FACES "/* EOF */\n";
    close FACES;

    # Construct the BSP.
    print "Building BSP ...\n" if $verbose;

    my $bsp = build_track_bsp (\@faces,
			       $track_min_x, $track_max_x,
			       $track_min_y, $track_max_y,
			       0);

    if ($verbose)
      {
	my ($nr_nodes, $nr_interior_nodes, $nr_terminal_nodes,
	    $nr_faces_spread, $max_depth)
	  = count_bsp ($bsp);

	print "BSP: depth = $max_depth, nr nodes = $nr_nodes (interior = $nr_interior_nodes, terminal = $nr_terminal_nodes)\n";

	#foreach (sort numerically keys %$nr_faces_spread)
	#  {
	#    print "  nodes containing $_ face(s): ",
	#      $nr_faces_spread->{$_}, "\n";
	#  }
      }

    # Write out the BSP to a file.
    print "Writing trackbsp.c ...\n" if $verbose;

    open BSP, ">trackbsp.c" or die "trackbsp.c: $!";
    print BSP "/* This file describes the shape of the track itself.\n * It is automatically generated.\n */\n\n#include \"common.h\"\n\n";

    my $root_nodename = write_track_bsp ($bsp, \*BSP);

    print BSP "struct xrTrackBSPNode *track_root = &$root_nodename;\n";
    print BSP "/* EOF */\n";
    close BSP;
  }

sub build_track_bsp
  {
    my $facesref = shift;
    my $min_x = shift;
    my $max_x = shift;
    my $min_y = shift;
    my $max_y = shift;
    my $level = shift;

    my ($subtree0, $subtree1);
    my ($split_axis, $split);

    my $nr_faces = 0+@$facesref;

    # Base case: only a small number of faces left or very deep inside.
    if ($nr_faces <= 4 || $level > 12) # XXX Remove these constants.
      {
	my $node = { type => 'terminal',
		     faces => $facesref,
		     nr_faces => $nr_faces };

	return $node;
      }

    # On even numbered levels, split parallel to the Y axis.
    if (($level & 1) == 0)
      {
	$split_axis = 'y';
	$split = ($min_x + $max_x) / 2;

	# Separate faces into those left and those right of the line.
	my @left_faces = ();
	my @right_faces = ();
	my $face;

	foreach $face (@$facesref)
	  {
	    if ($face->{bbox_max_x} <= $split)
	      {
		push @left_faces, $face;
	      }
	    elsif ($face->{bbox_min_x} >= $split)
	      {
		push @right_faces, $face;
	      }
	    else
	      {
		# Straddles the line. Split it.
		# Make two copies of the face so we don't alter the original.
		my %left_face = %$face;
		my %right_face = %$face;

		$left_face{bbox_max_x} = $split;
		$right_face{bbox_min_x} = $split;

		push @left_faces, \%left_face;
		push @right_faces, \%right_face;
	      }
	  }

	# Construct the left and right subtrees.
	$subtree0
	  = build_track_bsp (\@left_faces,
			     $min_x, $split, $min_y, $max_y,
			     $level+1);

	$subtree1
	  = build_track_bsp (\@right_faces,
			     $split, $max_x, $min_y, $max_y,
			     $level+1);
      }
    # On odd numbered levels, split parallel to the X axis.
    else
      {
	$split_axis = 'x';
	$split = ($min_y + $max_y) / 2;

	# Separate faces into those above and those below the line.
	my @below_faces = ();
	my @above_faces = ();
	my $face;

	foreach $face (@$facesref)
	  {
	    if ($face->{bbox_max_y} <= $split)
	      {
		push @below_faces, $face;
	      }
	    elsif ($face->{bbox_min_y} >= $split)
	      {
		push @above_faces, $face;
	      }
	    else
	      {
		# Straddles the line. Split it.
		# Make two copies of the face so we don't alter the original.
		my %below_face = %$face;
		my %above_face = %$face;

		$below_face{bbox_max_y} = $split;
		$above_face{bbox_min_y} = $split;

		push @below_faces, \%below_face;
		push @above_faces, \%above_face;
	      }
	  }

	# Construct the below and above subtrees.
	$subtree0
	  = build_track_bsp (\@below_faces,
			     $min_x, $max_x, $min_y, $split,
			     $level+1);

	$subtree1
	  = build_track_bsp (\@above_faces,
			     $min_x, $max_x, $split, $max_y,
			     $level+1);
      }

    # We can prune the tree quite considerably here. If both
    # subtrees contain only empty terminal nodes, then we
    # just return an empty terminal node ourselves. If both
    # subtrees contain only terminal nodes with the same
    # set of zones in each one, then we can immediately
    # replace this with a terminal node with just that set
    # of zones.
    #
    # Note an optimization here: if we ever build an interior
    # node, then we *know* that the terminal nodes within
    # have to be non-identical. Hence we only need to check
    # the $subtree0 and $subtree1 if these trees consist
    # of just terminal nodes!
    if ($subtree0->{type} eq 'terminal' &&
	$subtree1->{type} eq 'terminal' &&
	$subtree0->{nr_faces} == $subtree1->{nr_faces})
      {
	my @facenums0 = sort numerically map { $_->{n} } @{$subtree0->{faces}};
	my @facenums1 = sort numerically map { $_->{n} } @{$subtree1->{faces}};

	#warn "\@facenums0 = ", join (", ", @facenums0);
	#warn "\@facenums1 = ", join (", ", @facenums1);

	if (sorted_list_equality (\@facenums0, \@facenums1))
	  {
	    my $node = { type => 'terminal',
			 faces => $subtree0->{faces},
			 nr_faces => $subtree0->{nr_faces} };

	    return $node;
	  }
      }

    # Construct an ordinary interior node.
    my $node = { type => 'interior',
		 split_axis => $split_axis,
		 split => $split,
		 subtree0 => $subtree0,
		 subtree1 => $subtree1 };

    return $node;
  }

# Check two sorted lists for equality.
sub sorted_list_equality
  {
    my $list1 = shift;
    my $list2 = shift;

    return 0 if @$list1 != @$list2;

    my $i;

    for ($i = 0; $i < @$list1; ++$i)
      {
        return 0 if $list1->[$i] != $list2->[$i];
      }

    return 1;
  }

# Reorder a face so that the point lies on the inside.
sub reorder_face_so_point_inside
  {
    my $point = shift;
    my @vertices = @_;
    my $plane = plane_coefficients ($vertices[0], $vertices[1], $vertices[2]);

    if (distance_point_to_plane ($plane, $point) < 0) # outside
      {
        return reverse @vertices;
      }
    else # inside
      {
        return @vertices;
      }
  }

# Collect some stats on the BSP.
sub count_bsp
  {
    my $node = shift;

    my ($nr_nodes, $nr_interior_nodes, $nr_terminal_nodes);
    my %nr_faces_spread;
    my $max_depth;

    if ($node->{type} eq 'interior')
      {
	my ($nr_nodes0, $nr_interior_nodes0, $nr_terminal_nodes0,
	    $nr_faces_spread0, $max_depth0) = count_bsp ($node->{subtree0});
	my ($nr_nodes1, $nr_interior_nodes1, $nr_terminal_nodes1,
	    $nr_faces_spread1, $max_depth1) = count_bsp ($node->{subtree1});

	$nr_nodes = $nr_nodes0 + $nr_nodes1 + 1;
	$nr_interior_nodes = $nr_interior_nodes0 + $nr_interior_nodes1 + 1;
	$nr_terminal_nodes = $nr_terminal_nodes0 + $nr_terminal_nodes1;

	foreach (keys %$nr_faces_spread0)
	  {
	    $nr_faces_spread{$_} = $nr_faces_spread0->{$_};
	  }

	foreach (keys %$nr_faces_spread1)
	  {
	    $nr_faces_spread{$_} = 0 if !exists $nr_faces_spread{$_};
	    $nr_faces_spread{$_} += $nr_faces_spread1->{$_};
	  }

	$max_depth = ($max_depth0 > $max_depth1) ? $max_depth0 : $max_depth1;
	$max_depth++;

	return ($nr_nodes, $nr_interior_nodes, $nr_terminal_nodes,
		\%nr_faces_spread, $max_depth);
      }
    elsif ($node->{type} eq 'terminal')
      {
	$nr_faces_spread{$node->{nr_faces}} = 1;
	return (1, 0, 1, \%nr_faces_spread, 1);
      }
    else
      {
	die "unknown node type: ", $node->{type};
      }
  }

# This variable is used by write_track_bsp to generate unique numbers.
my $_wtb_unique = 0;

# The following hash is used by write_track_bsp to share common face
# number lists.
my %_wtb_facenums2listname = ();

sub write_track_bsp
  {
    my $node = shift;
    my $fh = shift;

    my $nodename = "_node" . $_wtb_unique++;

    if ($node->{type} eq 'terminal')
      {
	my $listname;

	if ($node->{nr_faces} > 0)
	  {
	    $listname = "_list" . $_wtb_unique++;

	    my @facenums = sort numerically map { $_->{n} } @{$node->{faces}};

	    my $key = join (",", @facenums);
	    if (exists $_wtb_facenums2listname{$key})
	      {
		$listname = $_wtb_facenums2listname{$key};
	      }
	    else
	      {
		$_wtb_facenums2listname{$key} = $listname;

		print $fh "static int ", $listname, "[] = ",
		cinitializer (@facenums), ";\n";
	      }
	  }

	print $fh "static struct xrTrackBSPNode $nodename = {\n";
	print $fh "  type: nodetype_terminal,\n";
	print $fh "  u: { t: {\n";

	if ($node->{nr_faces} > 0)
	  {
	    print $fh "            faces: $listname,\n";
	  }
	else
	  {
	    print $fh "            faces: 0,\n";
	  }

	print $fh "            nr_faces: ", $node->{nr_faces}, "\n";
	print $fh "  }}\n";
	print $fh "};\n\n";
      }
    else # $node->{type} eq 'interior'
      {
	my $subtree0_nodename = write_track_bsp ($node->{subtree0}, $fh);
	my $subtree1_nodename = write_track_bsp ($node->{subtree1}, $fh);

	print $fh "static struct xrTrackBSPNode $nodename = {\n";
	print $fh "  type: nodetype_interior,\n";
	print $fh "  u: { i: {\n";
	print $fh "            subtree0: &$subtree0_nodename,\n";
	print $fh "            subtree1: &$subtree1_nodename,\n";
	print $fh "            split_axis: '", $node->{split_axis}, "',\n";
	print $fh "            split: ", $node->{split}, "\n";
	print $fh "  }}\n";
	print $fh "};\n\n";
      }

    return $nodename;
  }

sub numerically { $a <=> $b }

#----------------------------------------------------------------------
# ENTER PLANE PROCESSING.

sub do_enterplanes
  {
    my $meshsref = shift;
    my $mesh;

    my @planes = ();

    foreach $mesh (@$meshsref)
      {
	# The mesh should consist of just a single quad.
	my $name = $mesh->{name};
	my $facesref = $mesh->{faces};
	my $face0ref = $facesref->[0]->{vertices};

	die "$name: Each EnterPlane* object should just a single quad."
	  if @$facesref != 1 || @$face0ref != 4;

	# Compute the plane coefficients and save them.
	my $v0 = $verticesref->[$face0ref->[0]]->{coords};
	my $v1 = $verticesref->[$face0ref->[1]]->{coords};
	my $v2 = $verticesref->[$face0ref->[2]]->{coords};
	my $v3 = $verticesref->[$face0ref->[3]]->{coords};
	push @planes, plane_coefficients ($v0, $v1, $v2);

	if ($verbose && 0)
	  {
	    print "enterplane points:\n";
	    print "  ",
	    join (", ", ($v0->[0], $v0->[1], $v0->[2], $v0->[3])), "\n";
	    print "  ",
	    join (", ", ($v1->[0], $v1->[1], $v1->[2], $v1->[3])), "\n";
	    print "  ",
	    join (", ", ($v2->[0], $v2->[1], $v2->[2], $v2->[3])), "\n";
	    print "  ",
	    join (", ", ($v3->[0], $v3->[1], $v3->[2], $v3->[3])), "\n";
	  }
      }

    # Write the enterplanes.c file.
    open C, ">enterplanes.c" or die "enterplanes.c: $!";

    print C "/* This file describes the segments in the track.\n * It is automatically generated.\n */\n\n#include \"common.h\"\n\n";

    print C "int nr_enterplanes = ", 0+@planes, ";\n\n";

    print C "struct xrTrackEnterPlane enterplanes[", 0+@planes, "] = {\n";
    print C join (",",
		  map { cinitializer ($_) } @planes);
    print C "\n};\n\n";

    print C "/* EOF */\n";

    close C;
  }

#----------------------------------------------------------------------
# SCENERY OBJECT PROCESSING.

sub do_scenery_object
  {
    my $mesh = shift;
    my $name = $mesh->{name};
    my $facesref = $mesh->{faces};
    my $material = $mesh->{material};
    my $has_texcoords = $mesh->{has_texcoords};
    my $has_colours = $mesh->{has_colours};
    my $has_material = $mesh->{has_material};

    print "Processing mesh ", $name, " ...\n" if $verbose;

    # Get the texture description for this mesh (supplied on the
    # command line).
    my $force_texture = 0;
    my $texture_name;
    my $texture_scale;
    my $texture_rotation;

    if (exists $texture_description{$name})
      {
	$force_texture = 1;
	$texture_name = $texture_description{$name}{name};
	$texture_scale = $texture_description{$name}{scale} || 1;
	$texture_rotation = $texture_description{$name}{rotation} || 0;
      }

    # Canonicalize the name for the name of the output file and
    # the name of the symbols in the output file.
    my $canon_name = $name;
    $canon_name =~ tr/a-zA-Z0-9/_/cs;

    if ($canon_name =~ m/^[0-9]/)
      {
	die "$name: canonical name cannot begin with a number";
      }

    # Derive names for the output file and for the symbols.
    my $c_filename = "obj_" . $canon_name . ".c";
    my $symbol_prefix = "obj_" . $canon_name;

    # We need to build a list of vertices actually used by
    # this face, derived from the global list of vertices.
    # We also need to copy these vertices so that we can
    # make changes (such as adding texture coordinates if
    # $force_texture is set). To do this, we first build a
    # mapping from `new' vertex numbers to `old' (ie. global)
    # vertex numbers, and another mapping in the reverse
    # direction. Then we use this mapping to renumber the
    # faces. Thirdly we copy the old vertices into a new
    # vertex array.
    my @new2old = ();
    my %old2new = ();

    my $face;
    foreach $face (@$facesref)
      {
	my $vsref = $face->{vertices};
	my $vertexindex;

	foreach $vertexindex (@$vsref)
	  {
	    if (! exists $old2new{$vertexindex})
	      {
		$old2new{$vertexindex} = @new2old;
		push @new2old, $vertexindex;
	      }
	  }
      }

    foreach $face (@$facesref)
      {
	my $vsref = $face->{vertices};
	my $vertexindex;
	my @newvs = ();

	foreach $vertexindex (@$vsref)
	  {
	    push @newvs, $old2new{$vertexindex};
	  }

	$face->{vertices} = \@newvs;
      }

    my @vertices = ();		# New array of vertices.
    foreach (@new2old)
      {
	my %vertex = %{$verticesref->[$_]}; # Shallow copy of vertex hash.

	push @vertices, \%vertex;
      }

    # Force texture coordinates, if desired.
    if ($force_texture)
      {
	$has_texcoords = 1;	# Because we are going to forcibly add them.
	$has_colours = 0;
	$has_material = 0;

	my ($min_x, $min_y, $min_z,
	    $max_x, $max_y, $max_z) = ( 1000000,  1000000,  1000000,
				       -1000000, -1000000, -1000000);

	# We use a very simple formula here: (1) we find the min and max
	# x, y, z coordinates over the whole mesh (2) we work out which
	# pair (eg. (x, z)) of these coordinates vary the most (3) we set
	# the texture coordinates to range over [0,1] over these two
	# axes.
	my $face;

	foreach $face (@$facesref)
	  {
	    my $vsref = $face->{vertices};
	    my $vertexindex;

	    foreach $vertexindex (@$vsref)
	      {
		my $vsref = $vertices[$vertexindex]->{coords};
		my @vs = @$vsref;

		if ($vs[0] < $min_x) { $min_x = $vs[0] }
		elsif ($vs[0] > $max_x) { $max_x = $vs[0] }
		if ($vs[1] < $min_y) { $min_y = $vs[1] }
		elsif ($vs[1] > $max_y) { $max_y = $vs[1] }
		if ($vs[2] < $min_z) { $min_z = $vs[2] }
		elsif ($vs[2] > $max_z) { $max_z = $vs[2] }
	      }
	  }

	my $range_x = $max_x - $min_x;
	my $range_y = $max_y - $min_y;
	my $range_z = $max_z - $min_z;

	# Which two axes shall we use?
	my (@ords, $usub, $uscale, $vsub, $vscale);

	if ($range_x >= $range_z && $range_y >= $range_z)
	  {
	    @ords = (0, 1);	# Use (x, y).
	    $usub = $min_x;
	    $uscale = $range_x;
	    $vsub = $min_y;
	    $vscale = $range_y;
	  }
	elsif ($range_x >= $range_y && $range_z >= $range_y)
	  {
	    @ords = (0, 2);	# Use (x, z).
	    $usub = $min_x;
	    $uscale = $range_x;
	    $vsub = $min_z;
	    $vscale = $range_z;
	  }
	elsif ($range_y >= $range_x && $range_z >= $range_x)
	  {
	    @ords = (1, 2);	# Use (y, z).
	    $usub = $min_y;
	    $uscale = $range_y;
	    $vsub = $min_z;
	    $vscale = $range_z;
	  }
	else
	  {
	    die "oops: ranges = ($range_x, $range_y, $range_z)";
	  }

	if ($verbose)
	  {
	    print "ords: ($ords[0],$ords[1])\n";
	    print "usub = $usub, uscale = $uscale, vsub = $vsub, vscale = $vscale\n";
	    print "x: [$min_x, $max_x] (range: $range_x)\n";
	    print "y: [$min_y, $max_y] (range: $range_y)\n";
	    print "z: [$min_z, $max_z] (range: $range_z)\n";
	  }

	# Assign (u, v) texture coordinates to each vertex.
	my $vertex;
	foreach $vertex (@vertices)
	  {
	    my @vs = @{$vertex->{coords}};
	    my $u = $texture_scale * ($vs[$ords[0]] - $usub) / $uscale;
	    my $v = $texture_scale * ($vs[$ords[1]] - $vsub) / $vscale;

	    if ($texture_rotation == 90)
	      {
		my $c = $v;
		$v = $u;
		$u = $texture_scale-$c;
	      }
	    elsif ($texture_rotation == 180)
	      {
		$u = $texture_scale-$u;
		$v = $texture_scale-$v;
	      }
	    elsif ($texture_rotation == 270)
	      {
		my $c = $v;
		$v = $texture_scale-$u;
		$u = $c;
	      }

	    $vertex->{texcoords} = [ $u, $v ];
	  }
      }

    # XXX Debug.
    #dump_scenery_to_file (\@vertices, $facesref,
    #			  "/tmp/" . $canon_name . ".obj");

    # Write out what we have to the C output file.
    open C, ">$c_filename" or die "$c_filename: $!";

    print C "/* This file describes a scenery object.\n * It is automatically generated.\n */\n\n#include \"common.h\"\n\n";

    print C "static int tex;\n\n";

    print C "void\n${symbol_prefix}_display ()\n";
    print C "{\n";

    # Write out the vertex array.
    print C "  static GLfloat va[", 0+@vertices, "][3] = {",
    join (", ",
          map ({ "{" . $_->{coords}[0] . ", "
                 . $_->{coords}[1] . ", "
                 . $_->{coords}[2] . "}" } @vertices)), "};\n";

    # Write out the normals array.
    print C "  static GLfloat na[", 0+@vertices, "][3] = {",
    join (", ",
          map ({ "{" . $_->{normal}[0] . ", "
                 . $_->{normal}[1] . ", "
                 . $_->{normal}[2] . "}" } @vertices)), "};\n";

    # Write out the texture coordinate array.
    if ($has_texcoords)
      {
	print C "  static GLfloat tca[", 0+@vertices, "][2] = {",
	join (", ",
	      map ({ "{" . $_->{texcoords}[0] . ", "
		     . $_->{texcoords}[1] . "}" } @vertices)), "};\n";
      }

    # Write out the vertex colours array.
    if ($has_colours)
      {
	print C "  static GLfloat vca[", 0+@vertices, "][2] = {",
	join (", ",
	      map ({ "{" . $_->{colour}[0] . ", "
		     . $_->{colour}[1] . ", "
		     . $_->{colour}[2] . ", "
		     . $_->{colour}[3] . "}" } @vertices)), "};\n";
      }

    # Drawing prologue.
    print C "  glEnableClientState (GL_VERTEX_ARRAY);\n";
    print C "  glVertexPointer (3, GL_FLOAT, 0, va);\n";

    print C "  glEnableClientState (GL_NORMAL_ARRAY);\n";
    print C "  glNormalPointer (GL_FLOAT, 0, na);\n";

    if ($has_texcoords)
      {
	print C "  glEnableClientState (GL_TEXTURE_COORD_ARRAY);\n";
	print C "  glTexCoordPointer (2, GL_FLOAT, 0, tca);\n";
      }

    if ($has_colours)
      {
	print C "  glEnableClientState (GL_COLOR_ARRAY);\n";
	print C "  glColorPointer (4, GL_FLOAT, 0, vca);\n";
      }

    print C "  glBindTexture (GL_TEXTURE_2D, tex);\n";

    # Separate faces into triangles, quads and polygons.
    my @triangles = ();
    my @quads = ();
    my @polygons = ();

    foreach (@$facesref)
      {
        if (@{$_->{vertices}} == 3)
          {
            push @triangles, $_->{vertices};
          }
        elsif (@{$_->{vertices}} == 4)
          {
            push @quads, $_->{vertices};
          }
        elsif (@{$_->{vertices}} > 4)
          {
            push @polygons, $_->{vertices};
          }
      }

    # Draw triangles.
    if (@triangles)
      {
        print C "  glBegin (GL_TRIANGLES);\n";
        foreach (@triangles)
          {
            print C "  glArrayElement (", $_->[0], ");\n";
            print C "  glArrayElement (", $_->[1], ");\n";
            print C "  glArrayElement (", $_->[2], ");\n";
          }
        print C "  glEnd ();\n";
      }

    # Draw quads.
    if (@quads)
      {
        print C "  glBegin (GL_QUADS);\n";
        foreach (@quads)
          {
            print C "  glArrayElement (", $_->[0], ");\n";
            print C "  glArrayElement (", $_->[1], ");\n";
            print C "  glArrayElement (", $_->[2], ");\n";
            print C "  glArrayElement (", $_->[3], ");\n";
          }
        print C "  glEnd ();\n";
      }

    # Draw polygons.
    if (@polygons)
      {
        print C "  glBegin (GL_TRIANGLES);\n";
        my $polygon;
        foreach $polygon (@polygons)
          {
            foreach (@$polygon)
              {
                print C "  glArrayElement (", $_, ");\n";
              }
          }
        print C "  glEnd ();\n";
      }

    # Drawing epilogue.
    print C "  glDisableClientState (GL_VERTEX_ARRAY);\n";
    print C "  glDisableClientState (GL_NORMAL_ARRAY);\n";

    if ($has_texcoords)
      {
	print C "  glDisableClientState (GL_TEXTURE_COORD_ARRAY);\n";
      }

    if ($has_colours)
      {
	print C "  glDisableClientState (GL_COLOR_ARRAY);\n";
      }

    print C "}\n\n";

    # Generate onload and onunload functions.
    die if !defined $texture_name;

    print C join ("\n",
		  ("int",
		   "${symbol_prefix}_load ()",
		   "{",
		   "  tex = xrTextureLoad (\"$texture_name\", 0, 0, 0, XR_TEXTURE_MIPMAPS);",
		   "  if (tex == 0)",
		   "    {",
		   "      xrLog (LOG_ERROR, \"cannot load texture: $texture_name\");",
		   "      return -1;",
		   "    }",
		   "",
		   "  return 0;",
		   "}",
		   "",
		   "void",
		   "${symbol_prefix}_unload ()",
		   "{",
		   "  xrTextureUnload (tex);",
		   "}",
		   "",
		   ""));

    print C "/* EOF */\n";

    close C;

    return $canon_name;
  }

sub dump_scenery_to_file
  {
    my $verticesref = shift;
    my $facesref = shift;
    my $filename = shift;

    open OBJ, ">$filename" or die "$filename: $!";

    print OBJ "3DG1\n", 0+@$verticesref, "\n";

    foreach (@$verticesref)
      {
	my $vsref = $_->{coords};

	print OBJ $vsref->[0], " ", $vsref->[1], " ", $vsref->[2], "\n";
      }

    foreach (@$facesref)
      {
	my @vis = @{$_->{vertices}};

	print OBJ 0+@vis, " ", join (" ", @vis), " 0xc0c0c000\n";
      }

    close OBJ;
  }

#----------------------------------------------------------------------
# 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 (@$_) : $_ }
                             @_)) . " }";
  }

=pod

=head1 NAME

xracer-blender2track - generate a XRacer track from a Blender exported description file

=head1 SYNOPSIS

xracer-blender2track
[ B<--verbose> ] [ B<--silent> ] [ B<--only-scenery> ]
[ B<--track-height>=TRACK_HEIGHT ] [ B<--track-depth>=TRACK_DEPTH]
[ B<--track-expansion>=FACTOR ] [ blender.export ]
[ OBJ,TEXTURE,TEXSCALE,ROTATION [ ... ] ]

xracer-blender2track help | ? 

=head1 DESCRIPTION

I<xracer-blender2track> is a perl script that takes a track description file
exported from Blender with help of the xracer-blenderexport Python module.
It generates a C source file that contains
code suitable to be used as a track description in the game XRacer.

=head1 SEE ALSO

L<xracer(6)>, L<xracer-mkcraft(1p)>, L<XRacer::BVRML(3pm)>

=head1 AUTHOR

This documentation for B<xracer-blender2track> was written by Filip Van Raemdonck
(mechanix@digibel.org) for the Debian prepackaged version of XRacer. It is
uncertain which of the persons listed in the AUTHORS file distributed with the
XRacer sources has written the actual script.

=cut