Difference between revisions of "Development:Script:obj2obj converter"

From VsWiki
Jump to: navigation, search
(→‎Test case)
(→‎Code: Version 0.8.68 (2005.05.13) = obj_conv.pl_2005_05_13_02.txt)
 
(18 intermediate revisions by one other user not shown)
Line 4: Line 4:
 
==Features and TODOs==
 
==Features and TODOs==
  
−
* OBJ reading ['''finished''']
+
===Features===
−
* OBJ writing ['''finished''']
+
* OBJ reading
−
* z-depth sorting (only works sane when everything is splitted correctly) ['''finished''']
+
* OBJ writing
−
* Splitting algorithms (needed for 3D cockpits) ['''Partly done'''] <BR/> '''This is the most needed feature right now.''' <BR/>''Please see [http://vegastrike.sourceforge.net/forums/viewtopic.php?p=29584#29584 this thread] in the formum or [[#Test case]] below for a test case i produced which isn't working correctly.''
+
* Xmesh reading (not yet tested for bugs)
 +
* Xmesh writing (no read-in materials yet)
 +
* Perl-dump writing
 +
* z-depth sorting (only works sane when everything is splitted correctly)
 +
* Splitting algorithms (needed for 3D cockpits)
 
** BSP (Binary Space Partition) splitting  
 
** BSP (Binary Space Partition) splitting  
 
** Split by view (edges)
 
** Split by view (edges)
−
* Parsing of tag data ['''finished''']
+
* Parsing of tag data (not writing them yet)
−
* Writing of tag data ['''OPEN''']
+
* Triangulation (before calculations and before saving)
  
−
==Test case==
+
===TODO===
−
The problem with the script as mentioned above is that i still don't get the correct display in vegastrike.
+
* You can find a complete list of open tasks in the code below under "TODO" -> "-OPEN-"
−
 
 
−
I assembled this [http://vegastrike.sourceforge.net/users/pontiac/scripts/3cubes.tar.bz2 Test Case] [2] and i think i found the problem.
 
−
In this archive are two screenshots, one from within Wings3D and the same file in vegastrike as cockpit. [1]
 
−
 
 
−
<code>3cubes_cockpit_wings.jpg</code> == processed obj file (<code>3cubes_cockpit.obj</code>) displayed in Wings3D
 
−
<code>3cubes_cockpit_vs.jpg</code> == <code>3cubes_cockpit.xmesh</code>
 
−
 
 
−
As you can see the small cube isn't shown/drawn in vegastrike.
 
−
Is this a bug or am I seeing ghosts again?
 
−
 
 
−
[1] The xmesh in the archive was generated by my script, but the <code>obj2xml</code> converter gives me an xmesh with the same problem, so i use mine to test.
 
−
There is no reason to say 'my' xmesh is correct though.
 
−
<pre>
 
−
obj2xml 3cubes_cockpit.obj
 
−
<pre>
 
−
 
 
−
[2] The most recent version of my script is in the archive as well.
 
  
 
==Code==
 
==Code==
Line 56: Line 43:
 
# Usage example (short):
 
# Usage example (short):
 
#
 
#
−
#  perl obj_conv.pl_xxxx_xx_xx_xx.txt -i inputfile.obj -o outputfile.obj -b -s -T
+
#  perl obj_conv.pl_xxxx_xx_xx_xx.txt -i inputfile.obj -o outputfile.obj -b -s -T
 
#
 
#
 
#  parameter description:
 
#  parameter description:
Line 76: Line 63:
 
#  OBJ Format(Ver3) http://astronomy.swin.edu.au/~pbourke/geomformats/obj/
 
#  OBJ Format(Ver3) http://astronomy.swin.edu.au/~pbourke/geomformats/obj/
 
#  OBJ Format      http://www.fileformat.info/format/wavefrontobj/egff.htm
 
#  OBJ Format      http://www.fileformat.info/format/wavefrontobj/egff.htm
 +
#  XMESH->BFXM http://vegastrike.sourceforge.net/forums/viewtopic.php?t=2406
 
#
 
#
 
# Known bugs / missing features:
 
# Known bugs / missing features:
Line 93: Line 81:
 
# VERSIONS / REVISIONS
 
# VERSIONS / REVISIONS
 
#----------------------------------------------------------
 
#----------------------------------------------------------
−
my $VERSION        = "0.8.59 (2005.02.09)";
+
my $VERSION        = "0.8.68 (2005.05.13)";
 
#----------------------------------------------------------
 
#----------------------------------------------------------
 +
# *) 2005.05.13 - Martin 'Pontiac' Buerbaum
 +
#  - Added some benchmark code.
 +
#  - Fixed some things in clean_data()
 +
#  - Removed some outdated functions (no '_new')
 +
#  - Commenteed out ht 'edges' entries in the tree.
 +
# *) 2005.05.11 - Martin 'Pontiac' Buerbaum
 +
#  - Added zero-check to make_vector_normal().
 +
# *) 2005.05.10 - Martin 'Pontiac' Buerbaum
 +
#  - Some Xmesh import fixes (seems to work now)
 +
#  - Started to clean up the code again (tabs) .. search for "CLEANED UP TO THIS POINT (TABS)"
 +
#    ... and finished.
 +
#  - Fixed material-hash problems.
 +
#  - Added write_to_any() function.
 +
#  - Added write_to_dump() function.
 +
# *) 2005.05.09 - Martin 'Pontiac' Buerbaum
 +
#  - Added some functions needed for file reading ... get_file_type() and read_from_any()
 +
#  - Added initial read_from_xmesh() function
 
# *) 2005.02.09 - Martin 'Pontiac' Buerbaum  
 
# *) 2005.02.09 - Martin 'Pontiac' Buerbaum  
 
#  - Added storage of numbers (instead of strings) to the read_from* subs (i hope this works at all)
 
#  - Added storage of numbers (instead of strings) to the read_from* subs (i hope this works at all)
Line 274: Line 279:
 
#    - [OPEN] If this is correct, reenabling of UseNormals='1' in xmesh export should be possible.
 
#    - [OPEN] If this is correct, reenabling of UseNormals='1' in xmesh export should be possible.
 
# *) [OPEN low] add XMESH/XUNIT import
 
# *) [OPEN low] add XMESH/XUNIT import
−
# *) [OPEN] add XBFM (SP?) import/export
+
# *) [OPEN] add BFXM import/export
 
# *) [OPEN low] Add function to add a point in a face (on an edge).
 
# *) [OPEN low] Add function to add a point in a face (on an edge).
 
#    This is to make a geometry that is winged-edge ok.
 
#    This is to make a geometry that is winged-edge ok.
Line 290: Line 295:
 
use warnings;
 
use warnings;
  
 +
use File::Basename; #$base = basename($filename);
 
use Data::Dumper;
 
use Data::Dumper;
 +
 +
# BEGIN Benchmark module
 +
my $use_benchmark = 0;
 +
my $timer;
 +
if ($use_benchmark) {
 +
require Time::HiRes; # needed for Benchmark::Timer
 +
require Benchmark::Timer;
 +
$timer = Benchmark::Timer->new(skip => 1);
 +
}
 +
# END Benchmark
  
 
#######################################################################
 
#######################################################################
Line 296: Line 312:
 
#######################################################################
 
#######################################################################
 
my $verbose;
 
my $verbose;
−
my $undef_vars = 1;   # $DEBUG:testing "if ($undef_vars)"  # Does this cause problems???
+
my $undef_vars = 1; # $DEBUG:testing "if ($undef_vars)"  # Does this cause problems???
−
my $epsilon = 0.001;   # defines a +/- tolerance for the plane-splitting
+
my $epsilon = 0.001; # defines a +/- tolerance for the plane-splitting
−
                      # and similar calculations  (e.g: +/-0.01)
+
# and similar calculations  (e.g: +/-0.01)
 
#######################################################################
 
#######################################################################
  
 
#######################################################################
 
#######################################################################
 
# SUBROUTINE DECLARATIONS (needed to prevent strict complaining
 
# SUBROUTINE DECLARATIONS (needed to prevent strict complaining
−
#                         about their use before the definition):
+
# about their use before the definition):
 
#######################################################################
 
#######################################################################
 
sub gen_bsptree_new (@%);
 
sub gen_bsptree_new (@%);
Line 316: Line 332:
 
# BEGIN FILE-IMPORT
 
# BEGIN FILE-IMPORT
 
#----------------------------------------------------------------------
 
#----------------------------------------------------------------------
 +
#######################################################################
 +
# Get the filetype (by extension of the filename)
 +
#######################################################################
 +
sub get_file_type ($) {
 +
# $DEBUG:TODO check file content at compare with filename as well.
 +
my ($filename) = @_;
 +
my $extension = $filename;
 +
(undef,undef,$extension) = fileparse($filename, qr{\..*}); #$extension =~ s/.*(\..*$)/$1/;
 +
$extension = lc($extension);
 +
print "Extension of input file: '",$extension,"'\n";
 +
SWITCH: { # filetype
 +
if ($extension eq ".obj") { # OBJ
 +
print "OBJ file detected.\n";
 +
return "obj";
 +
last SWITCH;
 +
}
 +
if ($extension eq ".xmesh") { # XMESH
 +
print "XMESH file detected.\n";
 +
return "xmesh";
 +
last SWITCH;
 +
}
 +
if ($extension eq ".bfxm") { # BFXM
 +
print "BFXM is unsupported right now!\n";
 +
return "bfxm";
 +
last SWITCH;
 +
}
 +
#else
 +
print "Bad/Unknown filetype found!\n";
 +
return "BADFILETYPE";
 +
} #SWITCH filetype
 +
} # sub get_file_type
 +
 +
#######################################################################
 +
# Import/export any file file
 +
#######################################################################
 +
sub read_from_any ($) {
 +
my ($filename) = @_;
 +
my $filetype = get_file_type($filename);
 +
  SWITCH: { # filetype
 +
if ($filetype eq "obj") { # OBJ
 +
return read_from_obj($filename);
 +
last SWITCH;
 +
}
 +
if ($filetype eq "xmesh") { # XMESH
 +
return read_from_xmesh($filename);
 +
last SWITCH;
 +
}
 +
if ($filetype eq "bfxm") { # BFXM
 +
print "DEBUG: read_from_bfxm() function not written yet!\n";
 +
last SWITCH;
 +
}
 +
#else
 +
print "Bad/Unknown filetype found! ",$filetype,"\n";
 +
return -1;
 +
} #SWITCH filetype
 +
} # sub read_from_any
 +
 +
sub write_to_any ($%) {
 +
my ($filename, $objects) = @_;
 +
die "write_to_any:objects" unless ( ref($objects) eq 'HASH' );
 +
my $filetype = get_file_type($filename);
 +
  SWITCH: { # filetype
 +
if ($filetype eq "obj") { # OBJ
 +
write_to_obj($filename, $objects);
 +
last SWITCH;
 +
}
 +
if ($filetype eq "xmesh") { # XMESH
 +
write_first_to_obj($filename, $objects);
 +
last SWITCH;
 +
}
 +
if ($filetype eq "bfxm") { # BFXM
 +
print "DEBUG: write_to_bfxm() function not written yet!\n";
 +
last SWITCH;
 +
}
 +
#else
 +
print "Bad/Unknown filetype found! ",$filetype,"\n";
 +
return -1;
 +
} #SWITCH filetype
 +
} # sub write_to_any
  
 
#######################################################################
 
#######################################################################
Line 325: Line 420:
 
#    'mtllib'  => ""
 
#    'mtllib'  => ""
 
#    'vertices' => {1=>[x,y,z]}, 'vert_counter' => 0,
 
#    'vertices' => {1=>[x,y,z]}, 'vert_counter' => 0,
 +
#    'vndata'  => {1=>[i,j,k]},  'norm_counter' => 0
 
#    'uvdata'  => {1=>[u,v]},  'uv_counter'  => 0,
 
#    'uvdata'  => {1=>[u,v]},  'uv_counter'  => 0,
−
#    'vndata'  => {1=>[s,t]},  'norm_counter' => 0
 
 
#
 
#
 
#    'objects'  =>
 
#    'objects'  =>
Line 340: Line 435:
 
#        },
 
#        },
 
#        {}
 
#        {}
−
#      ]
+
#      ],
 +
# 'materials' => $material_hash
 
#  };
 
#  };
−
sub read_from_obj ($)
+
sub read_from_obj ($) {
−
{
+
my ($filename) = @_;
−
  my ($filename) = @_;
 
  
−
  my $objects       = {
+
my $objects = {
−
                        'vertices' => {}, 'vert_counter' => 0,
+
'vertices' => {}, 'vert_counter' => 0,
−
                        'uvdata'  => {}, 'uv_counter'  => 0,
+
'uvdata'  => {}, 'uv_counter'  => 0,
−
                        'vndata'  => {}, 'norm_counter' => 0 ,
+
'vndata'  => {}, 'norm_counter' => 0 ,
−
                        'objects'  => []
+
'objects'  => []
−
                      };
+
};
 
   
 
   
−
  my $current_object = {
+
my $current_object = {
−
                        'initial_dummy' => 1,
+
'initial_dummy'=>1,
−
                        'objectname'   => 'default',
+
'objectname'=>'default',
−
      'groupname'     => 'default'
+
'groupname'=>'default',
 +
'type'=>'from_obj'
 +
};
 +
 +
my $current_mtlname = "";
 +
 
 +
open(OBJ_IN, "< ".$filename) ||
 +
die "Failed to open '".$filename."' .\n";
 +
 
 +
while(<OBJ_IN>) {
 +
next if /^\s*#/; # skip comments
 +
next if /^$/; # skip blank lines
 +
chomp;
 +
 
 +
/^\s*mtllib\s/ && do { # test.mtl
 +
(undef, $objects->{'mtllib'}) = split;
 +
#$objects->{'mtllib'} = $mtlname_found;
 +
print "Material library: '".$objects->{'mtllib'}."'\n";
 +
};
 +
/^\s*g\s/ && do {
 +
if (!exists $current_object->{'initial_dummy'}) {
 +
push(@{$objects->{'objects'}}, {%{$current_object}});
 +
}
 +
$current_object = {
 +
'objectname'=>$current_object->{'objectname'},  # save previous object name
 +
'faces'=>[]
 +
};
 +
(undef, $current_object->{'groupname'})  = split;
 +
print "Group:    '".$current_object->{'groupname'}."'\n";
 +
};
 +
 
 +
/^\s*o\s/ && do {
 +
(undef, $current_object->{'objectname'}) = split;
 +
print "Object:    '".$current_object->{'objectname'}."'\n";
 +
};
  
−
                      };
 
−
  my $current_mtlname = "";
 
 
    
 
    
−
   open(OBJ_IN, "< $filename") ||
+
/^\s*usemtl\s/ && do { # body_auv
−
    die "failed to open $filename\n";
+
if ($current_mtlname eq "") {
 +
print "1st\n";
 +
(undef, $current_object->{'mtlname'}) = split;
 +
$current_mtlname = $current_object->{'mtlname'};
 +
print "Usemtl:   '".$current_object->{'mtlname'}."'\n";
 +
} else {
 +
(undef, $current_mtlname) = split;
 +
print "Usemtl*X :'".$current_mtlname."'\n";
 +
}
 +
};
 +
/^\s*v\s/ && do {
 +
++$objects->{'vert_counter'};
 +
(undef, my $x, my $y, my $z) = split; # x,y,z = floating point values
 +
$x *= 1; $y *= 1; $z *= 1; # make the values numbers (hope this works at all)
 +
print "Vertex: x'$x',y'$y',z'$z'\n" if ($verbose==1);
 +
my $vertex = [$x, $y, $z];
 +
$objects->{'vertices'}->{$objects->{'vert_counter'}} = $vertex ;
 +
};
  
−
  while(<OBJ_IN>) {
+
/^\s*vt\s/ && do {
−
    next if /^\s*#/; # skip comments
+
++$objects->{'uv_counter'};
−
    next if /^$/; # skip blank lines
+
(undef, my $u, my $v) = split; # u,v = floating point values
−
    chomp;
+
$u *= 1; $v *= 1; # make the values numbers (hope this works at all)
 +
print "UV: u'$u',v'$v'\n" if ($verbose==1);
 +
my $uv_numbers = [$u,$v];
 +
$objects->{'uvdata'}->{$objects->{'uv_counter'}} = $uv_numbers;
 +
};
 +
 
 +
/^\s*vn/ && do { # vn is not yet supported
 +
++$objects->{'norm_counter'};
 +
(undef, my $i, my $j, my $k) = split; # i,j,k = floating point values
 +
$i *= 1; $j *= 1; $k *= 1; # make the values numbers (hope this works at all)
 +
print "Normal: i'$i',j'$j',k'$k'\n" if ($verbose==1);
 +
my $vn_numbers = [$i, $j, $k];
 +
$objects->{'vndata'}->{$objects->{'norm_counter'}} = $vn_numbers;
 +
};
  
−
    /^\s*mtllib\s/ && do { # test.mtl
+
/^\s*f\s/ && do {
−
      (undef, $objects->{'mtllib'}) = split;
+
(undef, my @indices) = split;
−
      #$objects->{'mtllib'} = $mtlname_found;  
+
print "Face: " if ($verbose==1);
−
      print "Material library: '".$objects->{'mtllib'}."'\n";
+
my $dummy_face = [];
−
    };
+
foreach my $vertexnumbers_text ( @indices ) {
 +
my ($vert, $vt, $vn) = split(/\//,$vertexnumbers_text);
 +
if (!$vert) {die "no vertex-number\n"};
 +
if (!$vt) {die "no uv-number found\n"};    # $DEBUG:testing
 +
if (!$vn) {die "no normal-number found\n"}; # $DEBUG:testing
 +
$vert = int($vert); $vt = int($vt); $vn = int($vn); # make the values (integer) numbers (hope this works at all)
 +
my $vertexnumbers = {
 +
'v'  => $vert,
 +
'vt'  => $vt,
 +
'vn' => $vn
 +
};
 +
push(@{$dummy_face}, $vertexnumbers );
 +
print "$vert,$vt,$vn " if ($verbose==1);
 +
}
 +
my $face = {
 +
'face'=> $dummy_face,
 +
'mtl' => $current_mtlname
 +
};
 +
push(@{$current_object->{'faces'}}, $face);
 +
print "\n" if ($verbose==1);
 +
};
 +
} # while <>
  
−
#    /^\s*o\s/ && do { # body
+
if (!exists $current_object->{'initial_dummy'}) { # if 'current_object' isn't the first object...
−
#      if (!exists $current_object->{'initial_dummy'}) {         # if 'current_object' isn't the first object...
+
push(@{$objects->{'objects'}}, {%{$current_object}}); # ...add previous object to the objectlist
−
#        push(@{$objects->{'objects'}}, {%{$current_object}});       # ......add previous object to the objectlist
+
}
−
#      }
 
−
#      $current_object = {
 
−
#                          'faces'    => [],
 
−
#                        };                                      # make new object
 
−
#      (undef, $current_object->{'objectname'}) = split;
 
−
#      print "Object:  '".$current_object->{'objectname'}."'\n";
 
−
#    };
 
  
−
#    /^\s*g\s/ && do { # body_body_auv
+
close(OBJ_IN);
−
#      (undef, $current_object->{'groupname'}) = split;
 
−
#      print "Group:    '".$current_object->{'groupname'}."'\n";
 
−
#    };
 
  
−
    /^\s*g\s/ && do {
+
#$DEBUG:TODO read materials with read_mtl($); and add them to $objects->{'materials'}
−
      if (!exists $current_object->{'initial_dummy'}) {
 
−
        push(@{$objects->{'objects'}}, {%{$current_object}});
 
−
      }
 
−
      $current_object = { 'objectname' => $current_object->{'objectname'},  # save previous object name
 
−
                          'faces'      => []
 
−
                        };
 
−
      (undef, $current_object->{'groupname'})  = split;
 
−
      print "Group:    '".$current_object->{'groupname'}."'\n";
 
−
    };
 
  
−
    /^\s*o\s/ && do {
+
return $objects;
−
      (undef, $current_object->{'objectname'}) = split;
+
} # sub read_from_obj
−
      print "Object:    '".$current_object->{'objectname'}."'\n";
 
−
    };
 
  
−
 
+
#######################################################################
−
    /^\s*usemtl\s/ && do { # body_auv
+
# Import xmesh file
−
      if ($current_mtlname eq "") {
+
#######################################################################
−
        print "1st\n";
+
sub read_from_xmesh ($) {
−
        (undef, $current_object->{'mtlname'}) = split;
+
my ($filename) = @_;
−
        $current_mtlname = $current_object->{'mtlname'};
+
−
        print "Usemtl:  '".$current_object->{'mtlname'}."'\n";
+
###########################
−
      }
+
print "Reading XML tree from xmesh file...\n";
−
      else {
+
use XML::Simple qw(:strict);
−
        (undef, $current_mtlname) = split;
+
my $data_tree = XMLin(
−
        print "Usemtl*X :'".$current_mtlname."'\n";
+
$filename,
−
      }
+
forcearray=>[], # forcearray=>['var', 'color' ],
−
    };
+
KeepRoot=>1,
−
   
+
KeyAttr =>[],
−
    /^\s*v\s/ && do {
+
GroupTags => {
−
      ++$objects->{'vert_counter'};
+
'Points'=>'Point',
−
      (undef, my $x, my $y, my $z) = split; # x,y,z = floating point values
+
'Polygons'=>'Tri',
−
      $x *= 1; $y *= 1; $z *= 1; # make the values numbers (hope this works at all)
+
#'Polygons'=>'Quad',
−
      print "Vertex: x'$x',y'$y',z'$z'\n" if ($verbose==1);
+
#'Polygons'=>'Trifan'
−
      my $vertex = [$x, $y, $z];
+
−
      $objects->{'vertices'}->{$objects->{'vert_counter'}} = $vertex ;
+
}
−
    };
+
);
 +
print "...done.\n";
 +
#write_to_debug('D:\dummy.txt',Dumper($data_tree));
 +
if (1) {
 +
###########################
 +
print "Converting XML tree to 'objects' structure...\n";
 +
# convert XMl-tree to 'objects' structure
 +
#foreach $data_tree;
 +
my $objects = {
 +
'vertices' => {}, 'vert_counter' => 0,
 +
'uvdata'  => {}, 'uv_counter'  => 0,
 +
'vndata'  => {}, 'norm_counter' => 0 ,
 +
'objects' => []
 +
};
 +
my ($objectname,undef,undef) = fileparse($filename, qr{\..*});
 +
my $object = {
 +
'objectname' =>$objectname,
 +
'groupname' => $objectname,
 +
# 'objectname' => 'default', # $DEBUG:TODO get objectname from filename and reduce it to 12 (or 14) characters
 +
# 'groupname' => 'default' # $DEBUG:TODO get objectname from filename and reduce it to 12 (or 14) characters
 +
'mtlname' => $objectname,
 +
#'texture' => '',
 +
'type'=>'from_xmesh',
 +
'faces'=>[]
 +
};
  
−
    /^\s*vt\s/ && do {
+
############
−
      ++$objects->{'uv_counter'};
+
print " Adding points and normal data...\n";
−
      (undef, my $u, my $v) = split; # u,v = floating point values
+
my $point = {};
−
      $u *= 1; $v *= 1; # make the values numbers (hope this works at all)
+
foreach $point (@{$data_tree->{'Mesh'}->{'Points'}}) {
−
      print "UV: u'$u',v'$v'\n" if ($verbose==1);
+
#add point data
−
      my $uv_numbers = [$u,$v];
+
if (exists $point->{'Location'}) {
−
      $objects->{'uvdata'}->{$objects->{'uv_counter'}} = $uv_numbers;
+
$objects->{'vertices'}->{$objects->{'vert_counter'}} = [
−
    };
+
$point->{'Location'}->{'x'},
−
 
+
$point->{'Location'}->{'y'},
−
    /^\s*vn/ && do { # vn is not yet supported
+
$point->{'Location'}->{'z'}
−
      ++$objects->{'norm_counter'};
+
];
−
      (undef, my $i, my $j, my $k) = split; # i,j,k = floating point values
+
$objects->{'vert_counter'}++;
−
      $i *= 1; $j *= 1; $k *= 1; # make the values numbers (hope this works at all)
+
}
−
      print "Normal: i'$i',j'$j',k'$k'\n" if ($verbose==1);
+
#add normal data
−
      my $vn_numbers = [$i, $j, $k];
+
if (exists $point->{'Normal'}) {
−
      $objects->{'vndata'}->{$objects->{'norm_counter'}} = $vn_numbers;
+
$objects->{'vndata'}->{$objects->{'norm_counter'}} = [
−
    };
+
$point->{'Normal'}->{'i'},
 +
$point->{'Normal'}->{'j'},
 +
$point->{'Normal'}->{'k'}
 +
];
 +
$objects->{'norm_counter'}++;
 +
}
 +
undef $point if ($undef_vars); # $DEBUG:TODO is this working to reduce memory wasting?
 +
}
 +
undef $data_tree->{'Mesh'}->{'Points'} if ($undef_vars); # $DEBUG:CHECK working?
 +
print " ... points done.\n";
 +
print " Adding faces and uv data...\n";
 +
my $polygon = {};
 +
foreach $polygon (@{$data_tree->{'Mesh'}->{'Polygons'}}) {
 +
my $dummy_face=[];
 +
#print Dumper($polygon);
 +
foreach my $vertex (@{$polygon->{'Vertex'}}) {
 +
my $vertexnumbers=[];
 +
#print Dumper($vertex);
 +
if ( (exists $vertex->{'s'}) &&
 +
(exists $vertex->{'t'}))  {
 +
$objects->{'uvdata'}->{$objects->{'uv_counter'}} = [
 +
$vertex->{'s'},
 +
$vertex->{'t'}
 +
];
 +
 +
$vertexnumbers = {
 +
'v'=>$vertex->{'point'},
 +
'vt'=>$vertex->{'point'},
 +
'vn'=>$objects->{'uv_counter'}
 +
};
 +
 +
$objects->{'uv_counter'}++;
 +
 +
} else {
 +
$vertexnumbers = {
 +
'v'=>$vertex->{'point'},
 +
'vt'=>$vertex->{'point'},
 +
'vn'=>-1 # $DEBUG:TODO better solution + checking?
 +
};
 +
}
 +
push(@{$dummy_face}, $vertexnumbers );
 +
}
 +
my $face = {'face'=> $dummy_face,
 +
'texture'=>$object->{'texture'}
 +
};
 +
push(@{$object->{'faces'}}, $face);
 +
undef $polygon if ($undef_vars); # $DEBUG:TODO is this working to reduce memory wasting?
 +
}
 +
undef $data_tree->{'Mesh'}->{'Polygons'} if ($undef_vars); # $DEBUG:CHECK working?
 +
print " ... faces done.\n";
 +
# faces& uvdata done
 +
############
 +
 +
############
 +
# add material (textures, etc...) and mesh data (texture, scale, etc...)
 +
print " Adding material and general mesh data....\n";
 +
my $ambient = $data_tree->{'Mesh'}->{'Material'}->{'Ambient'};
 +
my $diffuse = $data_tree->{'Mesh'}->{'Material'}->{'Diffuse'};
 +
my $specular = $data_tree->{'Mesh'}->{'Material'}->{'Specular'};
 +
 +
my $material_hash = {$objectname => {
 +
'diffuse' => [$diffuse->{'red'}, $diffuse->{'blue'}, $diffuse->{'green'}],
 +
'ambient' => [$ambient->{'red'}, $ambient->{'blue'}, $ambient->{'green'}],
 +
'specular' => [$specular->{'red'}, $specular->{'blue'}, $specular->{'green'}],
 +
'illumination' => 2, # $DEBUG:TODO
 +
'xmesh_diffuse_alpha' =>$diffuse->{'alpha'},
 +
'xmesh_ambient_alpha' =>$ambient->{'alpha'},
 +
'xmesh_specular_alpha' =>$specular->{'alpha'}
 +
}};
  
−
    /^\s*f\s/ && do {
+
$material_hash->{$objectname}->{'diffuse_map'} = $data_tree->{'Mesh'}->{'texture'} if (exists $data_tree->{'Mesh'}->{'texture'});
−
      (undef, my @indices) = split;
+
$material_hash->{$objectname}->{'ambient_map'} = 1 if (0) ; #$data_tree->{'Mesh'}->{'texture'}; # $DEBUG:TODO
−
      print "Face: " if ($verbose==1);
+
$material_hash->{$objectname}->{'specular_map'} = 1 if (0) ; #$data_tree->{'Mesh'}->{'texture'}; # $DEBUG:TODO
−
      my $dummy_face = [];
+
$material_hash->{$objectname}->{'xmesh_reflect'} = $data_tree->{'Mesh'}->{'Material'}->{'reflect'} if (exists $data_tree->{'Mesh'}->{'Material'}->{'reflect'});
−
      foreach my $vertexnumbers_text ( @indices )
+
$material_hash->{$objectname}->{'xmesh_UseNormals'} = $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'UseNormals'});
−
      {
+
$material_hash->{$objectname}->{'xmesh_LightningOn'} = $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'LightningOn'});
−
        my ($vert, $vt, $vn) = split(/\//,$vertexnumbers_text);
+
$material_hash->{$objectname}->{'xmesh_scale'} = $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'scale'});
−
        if (!$vert)  {die "no vertex-number\n"};
+
$material_hash->{$objectname}->{'xmesh_sharevertex'} = $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'sharevertex'});
−
        if (!$vt)    {die "no uv-number found\n"};     # $DEBUG:testing
+
−
        if (!$vn)    {die "no normal-number found\n"}; # $DEBUG:testing
+
$objects->{'materials'} = $material_hash;
−
$vert = int($vert); $vt = int($vt); $vn = int($vn); # make the values (integer) numbers (hope this works at all)
+
print " ...materials done.\n";
−
        my $vertexnumbers = { 'v'   => $vert,
+
# material done
−
                              'vt' => $vt,
+
###############
−
                              'vn' => $vn };
 
−
        push(@{$dummy_face}, $vertexnumbers );
 
−
        print "$vert,$vt,$vn " if ($verbose==1);
 
−
      }
 
−
      my $face = {'face'=> $dummy_face,
 
−
                  'mtl' => $current_mtlname
 
−
                };
 
−
      push(@{$current_object->{'faces'}}, $face);
 
−
      print "\n" if ($verbose==1);
 
−
    };
 
−
  } # while <>
 
  
−
  if (!exists $current_object->{'initial_dummy'}) {        # if 'current_object' isn't the first object...
+
undef $data_tree if ($undef_vars);
−
    push(@{$objects->{'objects'}}, {%{$current_object}});  # ...add previous object to the objectlist
+
−
  }
+
push(@{$objects->{'objects'}}, {%{$object}});  # ...add previous object to the objectlist
  
−
  close(OBJ_IN);
+
undef $object if ($undef_vars); # $DEBUG_CHECK working?
−
 
+
−
  return $objects;
+
#write_to_debug('D:\dummy.txt',Dumper($objects));
−
} # sub read_from_obj
+
print "...converting done.\n";
 +
return $objects;
 +
}
 +
} # sub read_from_xmesh
  
 
#######################################################################
 
#######################################################################
 
# TODO:  Convert tag-objects to VegaStrike Tag-Info and remove them from the objectlist
 
# TODO:  Convert tag-objects to VegaStrike Tag-Info and remove them from the objectlist
 
#######################################################################
 
#######################################################################
−
sub objects2vstags (%)
+
sub objects2vstags (%) {
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
−
  die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
+
my $normal_objects=[];
−
  my $normal_objects = [];
+
my $vs_tags={};
−
  my $vs_tags     = {};
+
my $object={};
−
  foreach my $object (@{$objects->{'objects'}})  {
+
foreach $object (@{$objects->{'objects'}})  {
−
    if ($object->{'objectname'} =~ m/^tag_(.)_.*/) { # matching tag objectnames (.+ ... one or more characters)
+
if ($object->{'objectname'} =~ m/^tag_(.)_.*/) { # matching tag objectnames (.+ ... one or more characters)
−
      my $tag_type = \1;                             # get regex-group defined by (.)
+
my $tag_type = \1; # get regex-group defined by (.)
−
      #if (correct_tag) {
+
#if (correct_tag) { # $DEBUG:TODO
−
      if (1) {
+
if (1) {
−
        my ($x,$y,$z,$r,$s,$t) = (0,0,0,0,0,0);                             #$DEBUG:TODO  tagobj2data($object);
+
my ($x,$y,$z,$r,$s,$t) = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0); #$DEBUG:TODO  tagobj2data($object);
−
        # ($x,$y,$z,$r,$s,$t) = ($x*1.0,$y*1.0,$z*1.0,$r*1.0,$s*1.0,$t*1.0) #$DEBUG:TODO
+
# ($x,$y,$z,$r,$s,$t) = ($x*1.0,$y*1.0,$z*1.0,$r*1.0,$s*1.0,$t*1.0) #$DEBUG:TODO
−
        SWITCH: {
+
SWITCH: {
−
          if ( ($tag_type eq "w") ||  # MOUNT/WEAPON
+
if ( ($tag_type eq "w") ||  # MOUNT/WEAPON
−
              ($tag_type eq "d")  ) { # DOCK
+
($tag_type eq "d")  ) { # DOCK
−
            $vs_tags->{$object->{'objectname'}} = "x='".$x."' ".
+
$vs_tags->{$object->{'objectname'}} =
−
                                                  "y='".$y."' ".
+
"x='".$x."' ".
−
                                                  "z='".$z."' ";
+
"y='".$y."' ".
−
            last SWITCH;
+
"z='".$z."' ";
−
          }
+
last SWITCH;
−
          if ( ($tag_type eq "l") ||  # LIGHT/ENGINE
+
}
−
              ($tag_type eq "s")  ) { # SUBUNIT
+
if ( ($tag_type eq "l") ||  # LIGHT/ENGINE
−
 
+
($tag_type eq "s")  ) { # SUBUNIT
−
            $vs_tags->{$object->{'objectname'}} = "x='".$x."' ".
+
$vs_tags->{$object->{'objectname'}} =
−
                                                  "y='".$y."' ".
+
"x='".$x."' y='".$y."' z='".$z."' ".
−
                                                  "z='".$z."' ".
+
"r='".$r."' s='".$s."' t='".$t."' ";
−
                                                  "r='".$r."' ".
+
last SWITCH;
−
                                                  "s='".$s."' ".
+
}
−
                                                  "t='".$t."' ";
+
#else
−
            last SWITCH;
+
print "Unknown tag-type! Ignored.\n";
−
          }
+
} # SWITCH tag_type
−
          #else
+
} else {  
−
          print "Unknown tag-type! Ignored.\n";
+
print "Bad tag-object! Ignored.\n";
−
        } # SWITCH tag_type
+
} # if correct_tag
−
      }  
+
} # if tag-object
−
      else {  
+
else {
−
        print "Bad tag-object! Ignored.\n";
+
push(@{$normal_objects},$object); # leave object in the list
−
      } # if correct_tag
+
}# if tag-object
−
    } # if tag-object
+
}
−
    else {
+
$objects->{'objects'} = $normal_objects; # delete tag objects
−
      push(@{$normal_objects},$object); # leave object in the list
+
return $vs_tags;
−
    }# if tag-object
 
−
  }
 
−
  $objects->{'objects'} = $normal_objects; # delete tag objects
 
−
  return $vs_tags;
 
 
}
 
}
  
Line 536: Line 773:
 
# TODO: replace the tags in the given file
 
# TODO: replace the tags in the given file
 
#######################################################################
 
#######################################################################
−
sub write_vstags_template($%$)
+
sub write_vstags_template($%$) {
−
{
+
my ($filename, $vs_tags, $write_new_file) = @_;
−
  my ($filename, $vs_tags, $write_new_file) = @_;
 
  
−
  if ($write_new_file) {
+
if ($write_new_file) {
−
    open(TEMPLATE_IN, "< $filename") ||
+
open(TEMPLATE_IN, "< ".$filename) ||
−
      die "failed to open $filename\n";
+
die "failed to open $filename\n";
−
    open(TEMPLATE_OUT, "> $write_new_file") ||
+
open(TEMPLATE_OUT, "> ".$write_new_file) ||
−
      die "failed to open $write_new_file\n";
+
die "failed to open $write_new_file\n";
−
    #sysopen(TEMPLATE_IN, $filename, O_RDONLY)         || die "failed to open $filename\n";
+
#sysopen(TEMPLATE_IN, $filename, O_RDONLY) || die "failed to open $filename\n";
−
    while(<TEMPLATE_IN>) {
+
while(<TEMPLATE_IN>) {
−
      my $vstag_key = '';
+
my $vstag_key = '';
−
      my $line = '';
+
my $line = '';
−
      foreach $vstag_key (keys %{$vs_tags}) {
+
foreach $vstag_key (keys %{$vs_tags}) {
−
        $line = $_;
+
$line = $_;
−
        $line =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
+
$line =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
−
        printf TEMPLATE_OUT "$line";
+
printf TEMPLATE_OUT "$line";
−
      } # foreach vstag_key
+
} # foreach vstag_key
  
−
    } # while <>
+
} # while <>
−
    close(TEMPLATE_IN);
+
close(TEMPLATE_IN);
−
    close(TEMPLATE_OUT);
+
close(TEMPLATE_OUT);
−
  }
+
} else {
−
  else {
+
open(TEMPLATE, "+< $filename") ||
−
    open(TEMPLATE, "+< $filename") ||
+
die "failed to open $filename\n";
−
      die "failed to open $filename\n";
+
while(<TEMPLATE>) {
−
    while(<TEMPLATE>) {
+
my $vstag_key = '';
−
      my $vstag_key = '';
+
foreach $vstag_key (keys %{$vs_tags}) {
−
      foreach $vstag_key (keys %{$vs_tags}) {
+
# $_ =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
−
        # $_ =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
+
s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
−
        s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
+
} # foreach vstag_key
−
      } # foreach vstag_key
+
} # while <>
−
 
+
close(TEMPLATE);
−
    } # while <>
+
} # if write_new_file
−
    close(TEMPLATE);
 
−
  } # if write_new_file
 
 
}
 
}
  
Line 577: Line 811:
 
# TODO: Merge several objects into one
 
# TODO: Merge several objects into one
 
#######################################################################
 
#######################################################################
−
sub merge_objects(%) # only works for xmesh if the material is the same right now
+
sub merge_objects(%) { # only works for xmesh if the material is the same right now
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
die "merge_objects:objects" unless ( ref($objects) eq 'HASH' );
−
  die "merge_objects:objects" unless ( ref($objects) eq 'HASH' );
+
my $final_object = {
−
  my $final_object = {'objectname' => 'merged_all',
+
'objectname' => 'merged_all',
−
                      'groupname' => 'merged_all',
+
'groupname' => 'merged_all',
−
                      'mtlname'   => $objects->{'objects'}->[0]->{'mtlname'},
+
'mtlname' => $objects->{'objects'}->[0]->{'mtlname'},
−
                      'faces'     => []
+
'faces' => []
−
                    };
+
};
−
  foreach my $object (@{$objects->{'objects'}})  {
+
my $object = {};
−
    push(@{$final_object->{'faces'}},$object->{'faces'});
+
foreach $object (@{$objects->{'objects'}})  {
−
  }
+
push(@{$final_object->{'faces'}},$object->{'faces'});
−
  $objects->{'objects'} = [ $final_object ];
+
}
 +
$objects->{'objects'} = [ $final_object ];
 
}
 
}
  
Line 596: Line 831:
 
# Get the total facecount of the objects
 
# Get the total facecount of the objects
 
#######################################################################
 
#######################################################################
−
sub objects_facecount (%)
+
sub objects_facecount (%) {
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
#write_to_debug('D:\dummy.txt',Dumper($objects));
−
  die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
+
die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
−
  my $facecount=0;
+
my $facecount=0;
−
 
+
my $object = {};
−
  foreach my $object (@{$objects->{'objects'}}) {
+
foreach $object (@{$objects->{'objects'}}) {
−
    $facecount += $#{ $object->{'faces'}} + 1;
+
$facecount += $#{ $object->{'faces'}} + 1;
−
  }
+
}
−
  return $facecount;
+
return $facecount;
 
}
 
}
  
Line 613: Line 848:
 
#######################################################################
 
#######################################################################
 
# Example material data:
 
# Example material data:
−
#my $material_hash->{mtl_name}
+
#my $material_hash={'mtl_name'=>{  
−
#   = {'diffuse'     => [1, 1, 1],
+
# 'diffuse'=>[1, 1, 1],
−
#     'ambient'     => [1, 1, 1],
+
# 'ambient'=>[1, 1, 1],
−
#     'specular'     => [1, 1, 1],
+
# 'specular'=>[1, 1, 1],
−
#     'diffuse_map' => "",
+
# 'diffuse_map'=>"",
−
#     'ambient_map' => "",
+
# 'ambient_map'=>"",
−
#     'specular_map' => "",
+
# 'specular_map'=>"",
−
#     'illumination' => 2         };
+
# 'illumination'=>2,
 +
# 'xmesh_Diffuse_alpha'=>0,
 +
# 'xmesh_Ambient_alpha'=>0,
 +
# 'xmesh_Specular_alpha'=>0,
 +
# 'xmesh_reflect'=>1,
 +
# 'xmesh_UseNormals'=>1,
 +
# 'xmesh_LightningOn'=>1,
 +
# 'xmesh_scale'=>1,
 +
# 'xmesh_sharevertex'=>0
 +
# };
 
###
 
###
−
sub read_mtl (%)
+
sub read_mtl ($) {
−
{
+
my ($filename) = @_;
−
  my ($objects) = @_;
 
−
die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );  my ($filename) = @_;
 
  
−
  my $material_hash = {};
+
open(MTL_IN, "< ".$filename) ||
 +
die "failed to open $filename\n";
  
−
  open(MTL_IN, "< $filename") ||
+
my $material_hash = {};
−
    die "failed to open $filename\n";
+
my $current_mtlname = "";
 +
my $current_mtl = {};
  
−
  my $current_mtlname = "";
+
while(<MTL_IN>)  {
−
  my $current_mtl     = {};
+
next if /^\s*#/; # skip comments
 +
next if /^$/; # skip blank lines
 +
chomp;
 +
/^newmtl\s/ && do {
 +
$material_hash->{$current_mtlname} = $current_mtl;
 +
$current_mtl = {};
 +
(undef, $current_mtlname) = split;
 +
};
  
−
  while(<MTL_IN>)  {
+
/^illum\s/ && do {
−
    next if /^\s*#/; # skip comments
+
(undef,  $current_mtl->{'illumination'}) = split;
−
    next if /^$/; # skip blank lines
+
};
−
    chomp;
 
−
    /^newmtl\s/ && do {
 
−
      $material_hash->{$current_mtlname} = $current_mtl;
 
−
      $current_mtl = {};
 
−
      (undef, $current_mtlname) = split;
 
−
     
 
−
    };
 
  
−
    /^illum\s/ && do {
+
/^Kd\s/ && do {
−
      (undef, $current_mtl->{'illumination'}) = split;
+
$current_mtl->{'diffuse'} = [];
−
    };
+
(undef,
 +
$current_mtl->{'diffuse'}->[0],
 +
$current_mtl->{'diffuse'}->[1],
 +
$current_mtl->{'diffuse'}->[2] ) = split;
 +
};
  
−
    /^Kd\s/ && do {
+
/^Ka\s/ && do {
−
      $current_mtl->{'diffuse'} = [];
+
$current_mtl->{'ambient'} = [];
−
      (undef, $current_mtl->{'diffuse'}->[0],
+
(undef,
−
              $current_mtl->{'diffuse'}->[1],
+
$current_mtl->{'ambient'}->[0],
−
              $current_mtl->{'diffuse'}->[2]) = split;
+
$current_mtl->{'ambient'}->[1],
−
    };
+
$current_mtl->{'ambient'}->[2] ) = split;
 +
};
  
−
    /^Ka\s/ && do {
+
/^Ks\s/ && do {
−
      $current_mtl->{'ambient'} = [];
+
$current_mtl->{'specular'} = [];
−
      (undef, $current_mtl->{'ambient'}->[0],
+
(undef,
−
              $current_mtl->{'ambient'}->[1],
+
$current_mtl->{'specular'}->[0],
−
              $current_mtl->{'ambient'}->[2]) = split;
+
$current_mtl->{'specular'}->[1],
−
    };
+
$current_mtl->{'specular'}->[2] ) = split;
 +
};
  
−
    /^Ks\s/ && do {
+
/^map_Kd\s/ && do {
−
      $current_mtl->{'specular'} = [];
+
(undef,  $current_mtl->{'diffuse_map'}) = split;
−
      (undef,  $current_mtl->{'specular'}->[0],
+
};
−
              $current_mtl->{'specular'}->[1],
 
−
              $current_mtl->{'specular'}->[2]) = split;
 
−
    };
 
  
−
    /^map_Kd\s/ && do {
+
/^map_Ka\s/ && do {
−
      (undef,  $current_mtl->{'diffuse_map'}) = split;
+
(undef,  $current_mtl->{'ambient_map'}) = split;
−
    };
+
};
  
−
    /^map_Ka\s/ && do {
+
/^map_Ks\s/ && do {
−
      (undef,  $current_mtl->{'ambient_map'}) = split;
+
(undef,  $current_mtl->{'specular_map'}) = split;
−
    };
+
};
  
−
    /^map_Ks\s/ && do {
+
/^d\s/ && do {
−
      (undef,  $current_mtl->{'specular_map'}) = split;
+
# $DEBUG:TODO
−
    };
+
};
  
−
    /^d\s/ && do {
+
/^Ns\s/ && do {
−
      # $DEBUG:TODO
+
# $DEBUG:TODO
−
    };
+
};
  
−
    /^Ns\s/ && do {
+
} # while <>
−
      # $DEBUG:TODO
+
close(MTL_IN);
−
    };
 
−
 
 
−
  } # while <>
 
−
  close(MTL_IN);
 
−
 
 
−
  $material_hash->{$current_mtlname} = $current_mtl;
 
−
  return $material_hash;
 
  
 +
$material_hash->{$current_mtlname} = $current_mtl;
 +
return $material_hash;
 
} # sub read_mtl
 
} # sub read_mtl
  
Line 711: Line 953:
 
# returns (A,B,C,D)
 
# returns (A,B,C,D)
 
#######################################################################
 
#######################################################################
−
sub vert3_to_plane (@@@)
+
sub vert3_to_plane (@@@) {
−
{
+
use Math::VectorReal;
−
  use Math::VectorReal;
+
my ($vertex1, $vertex2, $vertex3 ) = @_;
−
  my ($vertex1, $vertex2, $vertex3 ) = @_;
+
die "vert3_to_plane:vertex1 ".$vertex1 unless ( ref($vertex1) eq 'ARRAY' );
−
  die "vert3_to_plane:vertex1 ".$vertex1 unless ( ref($vertex1) eq 'ARRAY' );
+
die "vert3_to_plane:vertex2 ".$vertex2 unless ( ref($vertex2) eq 'ARRAY' );
−
  die "vert3_to_plane:vertex2 ".$vertex2 unless ( ref($vertex2) eq 'ARRAY' );
+
die "vert3_to_plane:vertex3 ".$vertex3 unless ( ref($vertex3) eq 'ARRAY' );
−
  die "vert3_to_plane:vertex3 ".$vertex3 unless ( ref($vertex3) eq 'ARRAY' );
+
die "vert3_to_plane:The given vertices are not useable." unless vert3_ok($vertex1, $vertex2, $vertex3 );
−
 
 
−
  die "vert3_to_plane:The given vertices are not useable." unless vert3_ok($vertex1, $vertex2, $vertex3 );
 
 
#  print vert3_ok($vertex1, $vertex2, $vertex3 );
 
#  print vert3_ok($vertex1, $vertex2, $vertex3 );
 
   
 
   
−
  my ($x1, $y1, $z1) = @{$vertex1};
+
my ($x1, $y1, $z1) = @{$vertex1};
−
  my ($x2, $y2, $z2) = @{$vertex2};
+
my ($x2, $y2, $z2) = @{$vertex2};
−
  my ($x3, $y3, $z3) = @{$vertex3};
+
my ($x3, $y3, $z3) = @{$vertex3};
  
 
#print "1 ".$x1." ".$y1." ".$z1."\n"; #$DEBUG:testing
 
#print "1 ".$x1." ".$y1." ".$z1."\n"; #$DEBUG:testing
Line 730: Line 970:
 
#print "3 ".$x3." ".$y3." ".$z3."\n"; #$DEBUG:testing
 
#print "3 ".$x3." ".$y3." ".$z3."\n"; #$DEBUG:testing
  
−
  my $vec1 = vector($x1, $y1, $z1 );
+
my $vec1 = vector($x1, $y1, $z1 );
−
  my $vec2 = vector($x2, $y2, $z2 );
+
my $vec2 = vector($x2, $y2, $z2 );
−
  my $vec3 = vector($x3, $y3, $z3 );
+
my $vec3 = vector($x3, $y3, $z3 );
  
 
#  print "x\n"; #$DEBUG:testing
 
#  print "x\n"; #$DEBUG:testing
−
  my ($normal, $distance_from_plane) = plane($vec1, $vec2, $vec3);
+
my ($normal, $distance_from_plane) = plane($vec1, $vec2, $vec3);
 
#  print "y\n"; #$DEBUG:testing
 
#  print "y\n"; #$DEBUG:testing
  
−
  return [$normal->x,
+
return [
−
          $normal->y,
+
$normal->x,
−
          $normal->z,
+
$normal->y,
−
          $distance_from_plane];
+
$normal->z,
 +
$distance_from_plane
 +
];
 
} # sub vert3_to_plane
 
} # sub vert3_to_plane
  
Line 749: Line 991:
 
# returns true=1 / false=0
 
# returns true=1 / false=0
 
#######################################################################
 
#######################################################################
−
sub vert3_ok (@@@)
+
sub vert3_ok (@@@) {
−
{
+
if ($use_benchmark) {$timer->start('vert3_ok')};
−
  my ($vertex1, $vertex2, $vertex3 ) = @_;
+
my ($vertex1, $vertex2, $vertex3 ) = @_;
−
  die "vert3_ok:vertex1"  unless ( ref($vertex1) eq 'ARRAY' );
+
die "vert3_ok:vertex1"  unless ( ref($vertex1) eq 'ARRAY' );
−
  die "vert3_ok:vertex2"  unless ( ref($vertex2) eq 'ARRAY' );
+
die "vert3_ok:vertex2"  unless ( ref($vertex2) eq 'ARRAY' );
−
  die "vert3_ok:vertex3"  unless ( ref($vertex3) eq 'ARRAY' );
+
die "vert3_ok:vertex3"  unless ( ref($vertex3) eq 'ARRAY' );
−
  die "vert3_ok:vertex1_2" unless ( $#{$vertex1} == 2 );
+
die "vert3_ok:vertex1_2" unless ( $#{$vertex1} == 2 );
−
  die "vert3_ok:vertex2_2" unless ( $#{$vertex2} == 2 );
+
die "vert3_ok:vertex2_2" unless ( $#{$vertex2} == 2 );
−
  die "vert3_ok:vertex3_2" unless ( $#{$vertex3} == 2 );
+
die "vert3_ok:vertex3_2" unless ( $#{$vertex3} == 2 );
 +
 
 +
my $equal_x = ( ($vertex1->[0] == $vertex2->[0]) && ($vertex2->[0] == $vertex3->[0]) );
 +
my $equal_y = ( ($vertex1->[1] == $vertex2->[1]) && ($vertex2->[1] == $vertex3->[1]) );
 +
my $equal_z = ( ($vertex1->[2] == $vertex2->[2]) && ($vertex2->[2] == $vertex3->[2]) );
  
−
  my $equal_x = ( ($vertex1->[0] == $vertex2->[0])&&
+
# die "All vertices in a row, would cause problems when creating plane.\n"
−
                  ($vertex2->[0] == $vertex3->[0]) );
+
# .$vertex1->[0]." ".$vertex1->[1]." ".$vertex1->[2]."\n"
−
  my $equal_y = ( ($vertex1->[1] == $vertex2->[1])&&
+
# .$vertex2->[0]." ".$vertex2->[1]." ".$vertex2->[2]."\n"
−
                  ($vertex2->[1] == $vertex3->[1]) );
+
# .$vertex3->[0]." ".$vertex3->[1]." ".$vertex3->[2]."\n"
−
  my $equal_z = ( ($vertex1->[2] == $vertex2->[2])&&
+
if ($use_benchmark) {$timer->stop('vert3_ok')};
−
                  ($vertex2->[2] == $vertex3->[2]) );
+
if ( ($equal_x && $equal_y) ||
−
# die "All vertices in a row, would cause problems when creating plane.\n"
+
($equal_y && $equal_z) ||
−
#     .$vertex1->[0]." ".$vertex1->[1]." ".$vertex1->[2]."\n"
+
($equal_x && $equal_z)  ) {
−
#     .$vertex2->[0]." ".$vertex2->[1]." ".$vertex2->[2]."\n"
+
return 0;
−
#     .$vertex3->[0]." ".$vertex3->[1]." ".$vertex3->[2]."\n"
+
}
−
  if ( ($equal_x && $equal_y) ||
+
return 1; # else
−
      ($equal_y && $equal_z) ||
 
−
      ($equal_x && $equal_z)  ) {
 
−
    return 0;
 
−
  }
 
−
  return 1; # else
 
 
} # sub vert3_ok
 
} # sub vert3_ok
  
Line 782: Line 1,023:
 
# returns (A,B,C,D)
 
# returns (A,B,C,D)
 
#######################################################################
 
#######################################################################
−
sub face2plane (@%)
+
sub face2plane (@%) {
−
{
+
my ($face, $vertices ) = @_;
−
  my ($face, $vertices ) = @_;
+
die "face2plane:face" unless ( ref($face)    eq 'ARRAY' );
−
  die "face2plane:face"     unless ( ref($face)    eq 'ARRAY' );
+
die "face2plane:vertices" unless ( ref($vertices) eq 'HASH' );
−
  die "face2plane:vertices" unless ( ref($vertices) eq 'HASH' );
 
 
    
 
    
−
  #my ($v1,$v2,$v3) = ([],[],[]);
+
#my ($v1,$v2,$v3) = ([],[],[]);
−
  my ($v1,$v2,$v3) = ('error_couldnt_create_plane',
+
my ($v1,$v2,$v3) = ('error_couldnt_create_plane',
−
                      'error_couldnt_create_plane',
+
'error_couldnt_create_plane',
−
                      'error_couldnt_create_plane' );  
+
'error_couldnt_create_plane' );  
  
−
  my $last_point_number = $#{$face} - 2 ;
+
my $last_point_number = $#{$face} - 2 ;
−
  for (my $i = 0; $i <= $last_point_number; $i++)                   # loop through the vertices of the face
+
for (my $i = 0; $i <= $last_point_number; $i++) { # loop through the vertices of the face
−
  {
+
if (vert3_ok($vertices->{$face->[$i  ]->{'v'}},
−
    if (vert3_ok($vertices->{$face->[$i  ]->{'v'}},
+
$vertices->{$face->[$i+1]->{'v'}},
−
                $vertices->{$face->[$i+1]->{'v'}},
+
$vertices->{$face->[$i+2]->{'v'}} ) ) {
−
                $vertices->{$face->[$i+2]->{'v'}} ) )
+
($v1,$v2,$v3) = ($vertices->{$face->[$i  ]->{'v'}},
−
    {
+
$vertices->{$face->[$i+1]->{'v'}},
−
      ($v1,$v2,$v3) = ($vertices->{$face->[$i  ]->{'v'}},
+
$vertices->{$face->[$i+2]->{'v'}} );
−
                      $vertices->{$face->[$i+1]->{'v'}},
+
last;
−
                      $vertices->{$face->[$i+2]->{'v'}} );
+
}
−
      last;
+
}
−
    }
+
my $plane  = vert3_to_plane ( $v1, $v2, $v3 );
−
  }
+
return $plane;
−
 
 
−
  my $plane  = vert3_to_plane ( $v1, $v2, $v3 );
 
−
  return $plane;
 
 
} # sub face2plane
 
} # sub face2plane
  
Line 817: Line 1,054:
 
# returns distance_to_plane
 
# returns distance_to_plane
 
#######################################################################
 
#######################################################################
−
sub classify_point_by_plane (@@)
+
sub classify_point_by_plane (@@) {
−
{
+
if ($use_benchmark) {$timer->start('classify_point_by_plane')};
−
  my ($plane, $vertex) = @_;
+
my ($plane, $vertex) = @_;
−
  die "classify_point_by_plane:plane"  unless ( ref($plane)  eq 'ARRAY' );
+
die "classify_point_by_plane:plane"  unless ( ref($plane)  eq 'ARRAY' );
−
  die "classify_point_by_plane:vertex" unless ( ref($vertex) eq 'ARRAY' );
+
die "classify_point_by_plane:vertex" unless ( ref($vertex) eq 'ARRAY' );
  
−
  my ($a, $b, $c, $d) = @{$plane};
+
my ($a, $b, $c, $d) = @{$plane};
−
  my ($x, $y, $z)     = @{$vertex};
+
my ($x, $y, $z) = @{$vertex};
−
  return (($a * $x) + ($b * $y) + ($c * $z)) - $d; #-$d
+
if ($use_benchmark) {$timer->stop('classify_point_by_plane')};
 +
return (($a * $x) + ($b * $y) + ($c * $z)) - $d; #-$d
 
} # sub classify_point_by_plane
 
} # sub classify_point_by_plane
  
Line 834: Line 1,072:
 
# returns left=-1 / crossing=0 / right=1 ?????
 
# returns left=-1 / crossing=0 / right=1 ?????
 
#######################################################################
 
#######################################################################
−
sub classify_face_by_plane (@@%)
+
sub classify_face_by_plane (@@%) {
−
{
+
if ($use_benchmark) {$timer->start('classify_face_by_plane')};
−
  my ($plane, $face, $vertices) = @_;
+
my ($plane, $face, $vertices) = @_;
−
  die "classify_face_by_plan:plane"   unless ( ref($plane)    eq 'ARRAY' );
+
die "classify_face_by_plan:plane" unless ( ref($plane)    eq 'ARRAY' );
−
  die "classify_face_by_plan:face"     unless ( ref($face)    eq 'ARRAY' );
+
die "classify_face_by_plan:face" unless ( ref($face)    eq 'ARRAY' );
−
  die "classify_face_by_plan:vertices" unless ( ref($vertices) eq 'HASH'  );
+
die "classify_face_by_plan:vertices" unless ( ref($vertices) eq 'HASH'  );
  
−
  my $status = 0;
+
my $status = 0;
  
−
  my $last_point_number = $#{$face};
+
my $last_point_number = $#{$face};
−
  for (my $i = 0; $i <= $last_point_number; $i++)                   # loop through the vertices of the face
+
for (my $i = 0; $i <= $last_point_number; $i++) { # loop through the vertices of the face
−
  {
+
my $vertex = $vertices->{$face->[$i]->{'v'}};
−
    my $vertex = $vertices->{$face->[$i]->{'v'}};
+
my $side = classify_point_by_plane($plane,  $vertex );
−
    my $side = classify_point_by_plane($plane,  $vertex );
+
if ( $side <= -$epsilon) {
−
    if ( $side <= -$epsilon)
+
if ($status ==  1 )  { if ($use_benchmark) {$timer->stop('classify_face_by_plane')}; return 0; };
−
    {
+
#else
−
      if ($status ==  1 )  { return 0; };
+
$status = -1;
−
      #else
+
};
−
      $status = -1;
+
if ( $side >= $epsilon ) {
−
    };
+
if ( $status == -1 ) { if ($use_benchmark) {$timer->stop('classify_face_by_plane')}; return 0; };
−
    if ( $side >= $epsilon )
+
#else
−
    {
+
$status = 1;
−
      if ( $status == -1 ) { return 0; };
+
};
−
      #else
+
#if ( $side == 0 )    { return 0; }; # $DEBUG:testing only deactivated for testing purpose
−
      $status = 1;
+
} #for
−
    };
+
if ($use_benchmark) {$timer->stop('classify_face_by_plane')};
−
    #if ( $side == 0 )    { return 0; }; # $DEBUG:testing only deactivated for testing purpose
+
return $status; # 0=crossing, 1/-1=left/right (or reverse)
−
   
 
−
  } #for
 
−
  return $status; # 0=crossing, 1/-1=left/right (or reverse)
 
 
} # sub classify_face_by_plane
 
} # sub classify_face_by_plane
  
Line 871: Line 1,106:
 
# returns (intersectionpoint,intersectionpoint-UV,intersectionpoint-NORMAL,new-vertexcount,new-UV-count,new-NORMAL-count)
 
# returns (intersectionpoint,intersectionpoint-UV,intersectionpoint-NORMAL,new-vertexcount,new-UV-count,new-NORMAL-count)
 
#######################################################################
 
#######################################################################
−
sub intersect_edge_with_plane (@@@@@@@$$)
+
sub intersect_edge_with_plane (@@@@@@@$$) {
−
{
+
if ($use_benchmark) {$timer->start('intersect_edge_with_plane')};
−
  use Math::VectorReal;                         # qw(:all);
+
use Math::VectorReal; # qw(:all);
−
  my ($vertex1, $vertex1_uv, $vertex1_vn,
+
my ( $vertex1, $vertex1_uv, $vertex1_vn,
−
      $vertex2, $vertex2_uv, $vertex2_vn,
+
$vertex2, $vertex2_uv, $vertex2_vn,
−
      $plane,
+
$plane,
−
      $vertexcount,  $uvcount, $vncount  ) = @_;
+
$vertexcount,  $uvcount, $vncount  ) = @_;
  
−
  die "intersect_edge_with_plane:vertex1"   unless ( ref($vertex1)    eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex1" unless ( ref($vertex1)    eq 'ARRAY' );
−
  die "intersect_edge_with_plane:vertex2"   unless ( ref($vertex2)    eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex2" unless ( ref($vertex2)    eq 'ARRAY' );
−
  die "intersect_edge_with_plane:vertex1_uv" unless ( ref($vertex1_uv) eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex1_uv" unless ( ref($vertex1_uv) eq 'ARRAY' );
−
  die "intersect_edge_with_plane:vertex2_uv" unless ( ref($vertex2_uv) eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex2_uv" unless ( ref($vertex2_uv) eq 'ARRAY' );
−
  die "intersect_edge_with_plane:vertex1_vn" unless ( ref($vertex1_vn) eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex1_vn" unless ( ref($vertex1_vn) eq 'ARRAY' );
−
  die "intersect_edge_with_plane:vertex2_vn" unless ( ref($vertex2_vn) eq 'ARRAY' );
+
die "intersect_edge_with_plane:vertex2_vn" unless ( ref($vertex2_vn) eq 'ARRAY' );
−
  die "intersect_edge_with_plane:plane"     unless ( ref($plane)      eq 'ARRAY' );
+
die "intersect_edge_with_plane:plane" unless ( ref($plane)      eq 'ARRAY' );
  
−
  my ($x1, $y1, $z1) = @{$vertex1};
+
my ($x1, $y1, $z1) = @{$vertex1};
−
  my ($x2, $y2, $z2) = @{$vertex2};
+
my ($x2, $y2, $z2) = @{$vertex2};
−
  my ($u1, $v1)       = @{$vertex1_uv};
+
my ($u1, $v1) = @{$vertex1_uv};
−
  my ($u2, $v2)       = @{$vertex2_uv};
+
my ($u2, $v2) = @{$vertex2_uv};
−
  my ($a, $b, $c, $d) = @{$plane};
+
my ($a, $b, $c, $d) = @{$plane};
  
−
  my $side1           = classify_point_by_plane($plane, $vertex1);
+
my $side1 = classify_point_by_plane($plane, $vertex1);
−
  my $vertex1_vec     = vector($x1, $y1, $z1 );
+
my $vertex1_vec = vector($x1, $y1, $z1 );
−
  my $vertex2_vec     = vector($x2, $y2, $z2 );
+
my $vertex2_vec = vector($x2, $y2, $z2 );
−
  my $normal         = vector($a, $b, $c);
+
my $normal = vector($a, $b, $c);
−
  my $vector12       = vector($x2-$x1, $y2-$y1, $z2-$z1);        #  my $vector12        = $vertex1_vec - $vertex2_vec; #???
+
my $vector12 = vector($x2-$x1, $y2-$y1, $z2-$z1);        #  my $vector12        = $vertex1_vec - $vertex2_vec; #???
  
−
die "points in the same place"      if ($vector12->length == 0); # $DEBUG:better code needed
+
die "points in the same place"      if ($vector12->length == 0); # $DEBUG:better code needed
−
die "normal vector with zero length" if ($normal->length  == 0); # $DEBUG:better code needed
+
die "normal vector with zero length" if ($normal->length  == 0); # $DEBUG:better code needed
  
−
  my $sect           = ( -$side1 / ( $normal . $vector12 ) );    #  my $sect          =  -$side1/($a*($x2-$x1) + $b * ($y2-$y1) + $c * ($z2-$z1));
+
my $sect = ( -$side1 / ( $normal . $vector12 ) );    #  my $sect          =  -$side1/($a*($x2-$x1) + $b * ($y2-$y1) + $c * ($z2-$z1));
  
−
  my $vertex_int_vec = $vertex1_vec + ($vector12 * $sect);      #  my $vertex_int_vec = vector( $x1+(($x2-$x1)*$sect),$y1+(($y2-$y1)*$sect),$z1+(($z2-$z1)*$sect) );
+
my $vertex_int_vec = $vertex1_vec + ($vector12 * $sect);      #  my $vertex_int_vec = vector( $x1+(($x2-$x1)*$sect),$y1+(($y2-$y1)*$sect),$z1+(($z2-$z1)*$sect) );
−
  my $vertex_int_length = $vertex_int_vec->length;
+
my $vertex_int_length = $vertex_int_vec->length;
  
 
   ##########
 
   ##########
 
   # BEGIN calculating the new uv data
 
   # BEGIN calculating the new uv data
−
  my ($ui, $vi)       = ($u1, $v1);
+
my ($ui, $vi) = ($u1, $v1);
−
  my $vector1i_length = vector($vertex_int_vec->x - $x1,         #  my $vector1i_length = ($vertex1_vec - $vertex_int_vec)->length; #???
+
my $vector1i_length = vector(
−
                              $vertex_int_vec->y - $y1,
+
$vertex_int_vec->x - $x1, #  my $vector1i_length = ($vertex1_vec - $vertex_int_vec)->length; #???
−
                              $vertex_int_vec->z - $z1)->length; #OK (mit I-1)
+
$vertex_int_vec->y - $y1,
 +
$vertex_int_vec->z - $z1 )->length; #OK (mit I-1)
  
−
  if ($vector1i_length  != 0)
+
if ($vector1i_length  != 0) {
−
  {
+
my ($u12, $v12) = ($u2 - $u1, $v2 - $v1);
−
    my ($u12, $v12) = ($u2 - $u1,
+
my $mult = ($vector1i_length / $vector12->length);
−
                      $v2 - $v1);
+
($ui, $vi) = (
−
    my $mult       = ($vector1i_length / $vector12->length);
+
$u1 + ($u12 * $mult),
−
    ($ui, $vi)     = ($u1 + ($u12 * $mult),
+
$v1 + ($v12 * $mult)
−
                      $v1 + ($v12 * $mult));
+
);
−
  };
+
};
 
   # END new uv data
 
   # END new uv data
 
   ##########
 
   ##########
 
   # BEGIN calculating the new normal data
 
   # BEGIN calculating the new normal data
−
  my $vni = get_avg_normal_vector ($vertex1_vn, $vertex2_vn);
+
my $vni = get_avg_normal_vector ($vertex1_vn, $vertex2_vn);
 
   # END new normal data
 
   # END new normal data
 
   ##########
 
   ##########
  
−
  ++$vertexcount;
+
++$vertexcount;
−
  ++$uvcount;
+
++$uvcount;
−
  ++$vncount;
+
++$vncount;
−
 
+
if ($use_benchmark) {$timer->stop('intersect_edge_with_plane')};
−
  return ([ $vertex_int_vec->x,
+
return (
−
            $vertex_int_vec->y,
+
[ $vertex_int_vec->x,
−
            $vertex_int_vec->z ],
+
$vertex_int_vec->y,
−
          [$ui, $vi],
+
$vertex_int_vec->z ],
−
          $vni,
+
[$ui, $vi],
−
          $vertexcount, $uvcount, $vncount );
+
$vni,
 +
$vertexcount, $uvcount, $vncount );
 
} # sub intersect_edge_with_plane
 
} # sub intersect_edge_with_plane
  
Line 955: Line 1,192:
 
# TODO  
 
# TODO  
 
#  *) right now the function is written for polygons that are 'round' (so -1 means it is  OUTSIDE for sure )
 
#  *) right now the function is written for polygons that are 'round' (so -1 means it is  OUTSIDE for sure )
−
sub face_in_frustum_of_other_face (@@%)
+
sub face_in_frustum_of_other_face (@@%) {
−
{
+
my ($face1, $face2, $vertices) = @_;
−
  my ($face1, $face2, $vertices) = @_;
+
# face1 ... the face that provides the fustrum
−
  # face1 ... the face that provides the fustrum
+
# face2 ... the face that has to be checked if it is inside/etc...
−
  # face2 ... the face that has to be checked if it is inside/etc...
+
die "face_in_frustum_of_other_face:face1" unless ( ref($face1)    eq 'ARRAY' );
−
  die "face_in_frustum_of_other_face:face1"   unless ( ref($face1)    eq 'ARRAY' );
+
die "face_in_frustum_of_other_face:face2" unless ( ref($face2)    eq 'ARRAY' );
−
  die "face_in_frustum_of_other_face:face2"   unless ( ref($face2)    eq 'ARRAY' );
+
die "face_in_frustum_of_other_face:vertices" unless ( ref($vertices) eq 'HASH'  );
−
  die "face_in_frustum_of_other_face:vertices" unless ( ref($vertices) eq 'HASH'  );
+
my $status = 666;  
−
  my $status = 666;  
+
my $zero_point  = [0, 0, 0];
−
  my $zero_point  = [0, 0, 0];
 
  
 +
my $last_point_number = $#{$face1};
 +
for (my $i=0; $i<=$last_point_number; $i++) { # loop through the vertices of the face
 +
my ($vertexnumbers1, $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
 +
my $vertex1 = $vertices->{$vertexnumbers1->{'v'}};
 +
my $vertex2 = $vertices->{$vertexnumbers2->{'v'}};
 +
my $zeroplane = vert3_to_plane($zero_point, $vertex1, $vertex2 );
 +
my $status_2 = classify_face_by_plane ($zeroplane, $face2, $vertices);
  
−
  my $last_point_number = $#{$face1};
+
if ( 0 == $status_2) { return  0; } # the face is crossing, no further checks necessary
−
  for (my $i = 0; $i <= $last_point_number; $i++)                    # loop through the vertices of the face
+
if (-1 == $status_2) { return -1; }  
−
  {
+
if ( 1 == $status_2) { $status = 1; } # the face is on the side of the polygon (but not yet inside for sure... loop is going on)
−
    my ($vertexnumbers1,
+
}
−
        $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
+
return $status; # 0=crossing; 1=in; - 1=out; #maybe -1 and 1 swapped
−
    my $vertex1    = $vertices->{$vertexnumbers1->{'v'}};
 
−
    my $vertex2    = $vertices->{$vertexnumbers2->{'v'}};
 
−
    my $zeroplane  = vert3_to_plane($zero_point, $vertex1, $vertex2 );
 
−
    my $status_2  = classify_face_by_plane ($zeroplane, $face2, $vertices);
 
−
 
 
−
 
 
−
    if ($status_2 ==  0) { return  0; } # the face is crossing, no further checks necessary
 
−
    if ($status_2 ==  -1) { return -1; }  
 
−
    if ($status_2 ==  1) {              # the face is on the side of the polygon (but not yet inside for sure... loop is going on)
 
−
      $status =  1;
 
−
    }
 
−
  }
 
−
  return $status;                       # 0=crossing; 1=in; - 1=out;   #maybe -1 and 1 swapped
 
−
 
 
 
}
 
}
  
Line 992: Line 1,221:
 
# TODO? ...VERY similar to face_in_frustum_of_other_face
 
# TODO? ...VERY similar to face_in_frustum_of_other_face
 
#######################################################################
 
#######################################################################
−
sub face_inside_of_other_face (@@%)
+
sub face_inside_of_other_face (@@%) {
−
{
+
my ($face1, $face2, $vertices) = @_;
−
  my ($face1, $face2, $vertices) = @_;
+
# face1 ... the face that provides the xxx
−
  # face1 ... the face that provides the xxx
+
# face2 ... the face that has to be checked if it is inside/etc...
−
  # face2 ... the face that has to be checked if it is inside/etc...
+
die "face_inside_of_other_fac:face1" unless ( ref($face1) eq 'ARRAY' );
−
  die "face_inside_of_other_fac:face1"   unless ( ref($face1)   eq 'ARRAY' );
+
die "face_inside_of_other_fac:face2" unless ( ref($face2) eq 'ARRAY' );
−
  die "face_inside_of_other_fac:face2"   unless ( ref($face2)   eq 'ARRAY' );
+
die "face_inside_of_other_fac:vertices" unless ( ref($vertices) eq 'HASH'  );
−
  die "face_inside_of_other_fac:vertices" unless ( ref($vertices) eq 'HASH'  );
 
  
−
  my $status = 666;  
+
my $status = 666;  
−
  my ($a, $b, $c, $d) = face2plane($face1, $vertices );
+
my ($a, $b, $c, $d) = face2plane($face1, $vertices );
  
−
  my $last_point_number = $#{$face1};
+
my $last_point_number = $#{$face1};
−
  for (my $i = 0; $i <= $last_point_number; $i++)                   # loop through the vertices of the face
+
for (my $i=0; $i<=$last_point_number; $i++) { # loop through the vertices of the face
−
  {
+
my ($vertexnumbers1, $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
−
    my ($vertexnumbers1,
+
my $vertex1 = $vertices->{$vertexnumbers1->{'v'}};
−
        $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
+
my $vertex2 = $vertices->{$vertexnumbers2->{'v'}};
−
    my $vertex1   = $vertices->{$vertexnumbers1->{'v'}};
+
my $normalpoint = [
−
    my $vertex2   = $vertices->{$vertexnumbers2->{'v'}};
+
$vertex1->[0] + $a,
−
    my $normalpoint = [$vertex1->[0] + $a,
+
$vertex1->[1] + $b,
−
                        $vertex1->[1] + $b,
+
$vertex1->[2] + $c
−
                        $vertex1->[2] + $c ];
+
];
−
    my $zeroplane  = vert3_to_plane($vertex1, $vertex2, $normalpoint );
+
my $zeroplane  = vert3_to_plane($vertex1, $vertex2, $normalpoint );
−
    my $status_2  = classify_face_by_plane ($zeroplane, $face2, $vertices);
+
my $status_2  = classify_face_by_plane ($zeroplane, $face2, $vertices);
  
−
 
+
if ( 0 == $status_2) { return  0; }; #the face is crossing, no further checks necessary
−
    if ($status_2 ==  0) { return  0;}; #the face is crossing, no further checks necessary
+
if (-1 == $status_2) { return -1; };  
−
    if ($status_2 == -1) { return -1;};  
+
if ( 1 == $status_2) { $status =  1; } # the face is on the side of the polygon (but not yet inside for sure... loop is going on)
−
    if ($status_2 ==  1) { # the face is on the side of the polygon (but not yet inside for sure... loop is going on)
+
}
−
      $status =  1;
+
return $status; # 0=crossing; 1=in; - 1=out; #maybe -1 and 1 swapped
−
    }
 
−
  }
 
−
  return $status; # 0=crossing; 1=in; - 1=out;   #maybe -1 and 1 swapped
 
 
}
 
}
  
Line 1,030: Line 1,255:
 
# Calculates the min/max distance of a face to the center point
 
# Calculates the min/max distance of a face to the center point
 
#######################################################################
 
#######################################################################
−
sub distance_face_from_center (@$%)
+
sub distance_face_from_center (@$%) {
−
{
+
if ($use_benchmark) {$timer->start('distance_face_from_center')};
−
  my ($face, $max, $vertices) = @_;
+
my ($face, $max, $vertices) = @_;
−
  die "distance_face_from_center:face"     unless ( ref($face)    eq 'ARRAY' );
+
die "distance_face_from_center:face" unless ( ref($face)    eq 'ARRAY' );
−
  die "distance_face_from_center:vertices" unless ( ref($vertices) eq 'HASH'  );
+
die "distance_face_from_center:vertices" unless ( ref($vertices) eq 'HASH'  );
 
    
 
    
−
  my $dist;
+
my $dist;
−
  if ($max) # a bit redundant, but may be faster then the other alternative
+
if ($max) { # a bit redundant, but may be faster then the other alternative
−
  {
+
for (my $i=0; $i<=$#{$face}; $i++) { # loop through the vertices of the face
−
    for (my $i = 0; $i <= $#{$face}; $i++)                   # loop through the vertices of the face
+
my $vertex = $vertices->{$face->[$i]->{'v'}};
−
    {
+
my $dummy_dist = sqrt(
−
      my $vertex     = $vertices->{$face->[$i]->{'v'}};
+
($vertex->[0])**2 +
−
      my $dummy_dist = sqrt( ($vertex->[0])**2 +
+
($vertex->[1])**2 +
−
                            ($vertex->[1])**2 +
+
($vertex->[2])**2  );
−
                            ($vertex->[2])**2  );
+
if ($i == 0) {
−
 
+
$dist = $dummy_dist; }
−
      if ($i == 0)             { $dist = $dummy_dist; };
+
if ($dummy_dist > $dist) {
−
      if ($dummy_dist > $dist) { $dist = $dummy_dist; };
+
$dist = $dummy_dist; }
−
    }
+
}
−
  }
+
} else {
−
  else
+
for (my $i=0; $i<=$#{$face}; $i++) { # loop through the vertices of the face
−
  {
+
my $vertex = $vertices->{$face->[$i]->{'v'}};
−
    for (my $i = 0; $i <= $#{$face}; $i++)                   # loop through the vertices of the face
+
my $dummy_dist = sqrt(
−
    {
+
($vertex->[0])**2 +
−
      my $vertex     = $vertices->{$face->[$i]->{'v'}};
+
($vertex->[1])**2 +
−
      my $dummy_dist = sqrt( ($vertex->[0])**2 +
+
($vertex->[2])**2  );
−
                            ($vertex->[1])**2 +
+
if ($i == 0) {
−
                            ($vertex->[2])**2  );
+
$dist = $dummy_dist; }
−
     
+
if ($dummy_dist < $dist) {
−
      if ($i == 0)             { $dist = $dummy_dist; };
+
$dist = $dummy_dist; }
−
      if ($dummy_dist < $dist) { $dist = $dummy_dist; };
+
}
−
    }
+
}
−
  }
+
if ($use_benchmark) {$timer->stop('distance_face_from_center')};
−
  return $dist;
+
return $dist;
 
} # sub distance_face_from_center
 
} # sub distance_face_from_center
  
Line 1,076: Line 1,301:
 
# Makes the length of a vector exactly 1 unit (== normal vector)
 
# Makes the length of a vector exactly 1 unit (== normal vector)
 
#######################################################################
 
#######################################################################
−
sub make_vector_normal (@)
+
sub make_vector_normal (@) {
−
{
+
if ($use_benchmark) {$timer->start('make_vector_normal')};
−
  my ($vector) = @_;
+
my ($vector) = @_;
−
  die "make_vector_normal:vector"    unless ( ref($vector) eq 'ARRAY' );
+
die "make_vector_normal:vector"    unless ( ref($vector) eq 'ARRAY' );
−
  die "make_vector_normal:vec_number" unless ( $#{$vector}  == 2      );
+
die "make_vector_normal:vec_number" unless ( $#{$vector}  == 2      );
−
  my ($x, $y, $z) = @{$vector};
+
my ($x, $y, $z) = @{$vector};
 
#  print $x.",".$y.",".$z."\n";  # $DEBUG:testing
 
#  print $x.",".$y.",".$z."\n";  # $DEBUG:testing
  
−
  my $length = sqrt( ($vector->[0]) ** 2 +
+
my $length = sqrt(
−
                    ($vector->[1]) ** 2 +
+
($vector->[0]) ** 2 +
−
                    ($vector->[2]) ** 2  );
+
($vector->[1]) ** 2 +
−
  return [ $x / $length,  
+
($vector->[2]) ** 2  );
−
          $y / $length,
+
if ($use_benchmark) {$timer->stop('make_vector_normal')};
−
          $z / $length ];
+
if ($length > 0) {
 +
return [
 +
$x / $length,  
 +
$y / $length,
 +
$z / $length
 +
];
 +
} else {
 +
return [0, 0, 0];
 +
}
 
} # sub make_vector_normal  
 
} # sub make_vector_normal  
  
Line 1,095: Line 1,328:
 
# Calculates the average normal vector of two given vecs
 
# Calculates the average normal vector of two given vecs
 
#######################################################################
 
#######################################################################
−
sub get_avg_normal_vector (@@)
+
sub get_avg_normal_vector (@@) {
−
{
+
if ($use_benchmark) {$timer->start('get_avg_normal_vector')};
−
  my ($vector1, $vector2) = @_;
+
my ($vector1, $vector2) = @_;
−
  die "get_avg_normal_vector:vector1"    unless ( ref($vector1) eq 'ARRAY' );
+
die "get_avg_normal_vector:vector1"    unless ( ref($vector1) eq 'ARRAY' );
−
  die "get_avg_normal_vector:vector2"    unless ( ref($vector2) eq 'ARRAY' );
+
die "get_avg_normal_vector:vector2"    unless ( ref($vector2) eq 'ARRAY' );
−
  die "get_avg_normal_vector:vec1_number" unless ( $#{$vector1}  == 2      );
+
die "get_avg_normal_vector:vec1_number" unless ( $#{$vector1}  == 2      );
−
  die "get_avg_normal_vector:vec2_number" unless ( $#{$vector2}  == 2      );
+
die "get_avg_normal_vector:vec2_number" unless ( $#{$vector2}  == 2      );
−
  my ($x1, $y1, $z1) = @{$vector1};
+
my ($x1, $y1, $z1) = @{$vector1};
−
  my ($x2, $y2, $z2) = @{$vector2};
+
my ($x2, $y2, $z2) = @{$vector2};
−
 
+
if ($use_benchmark) {$timer->stop('get_avg_normal_vector')};
−
  return make_vector_normal( [ $x1 + $x2,
+
return make_vector_normal( [
−
                              $y1 + $y2,
+
$x1 + $x2,
−
                              $z1 + $z2 ] );
+
$y1 + $y2,
 +
$z1 + $z2 ] );
 
} # sub get_avg_normal_vector
 
} # sub get_avg_normal_vector
 
#-----------------------------------------------------------------------
 
#-----------------------------------------------------------------------
Line 1,117: Line 1,351:
 
# get the verticenumbers of an edge by the index of the first vertex
 
# get the verticenumbers of an edge by the index of the first vertex
 
#######################################################################
 
#######################################################################
−
sub get_edgenumbers_from_face ($@)
+
sub get_edgenumbers_from_face ($@) {
−
{
+
my ($i, $face ) = @_;
−
  my ($i, $face ) = @_;
+
die "get_edgenumbers_from_face" unless (ref($face) eq 'ARRAY');
−
  die "get_edgenumbers_from_face" unless (ref($face) eq 'ARRAY');
 
  
−
  if ($i < $#{$face})
+
if ($i < $#{$face}) {
−
    { return ( $face->[$i], $face->[$i+1] ); }  
+
return ( $face->[$i], $face->[$i+1] );
−
  else
+
} else {
−
    { return ( $face->[$i], $face->[0  ] ); }
+
return ( $face->[$i], $face->[0  ] );
 +
}
 
} # sub get_edgenumbers_from_face
 
} # sub get_edgenumbers_from_face
  
Line 1,134: Line 1,368:
 
# split a face with a plane
 
# split a face with a plane
 
#######################################################################
 
#######################################################################
−
sub split_face_by_plane (@@%%%$$$)
+
sub split_face_by_plane (@@%%%$$$) {
−
{
+
if ($use_benchmark) {$timer->start('split_face_by_plane')};
−
  my ($face, $plane, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount ) = @_;
+
my ($face, $plane, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount ) = @_;
−
  die "split_face_by_plane:face"    if ( ref($face)    ne 'ARRAY' );
+
die "split_face_by_plane:face"    if ( ref($face)    ne 'ARRAY' );
−
  die "split_face_by_plane:plane"    if ( ref($plane)    ne 'ARRAY' );
+
die "split_face_by_plane:plane"    if ( ref($plane)    ne 'ARRAY' );
−
  die "split_face_by_plane:vertices" if ( ref($vertices) ne 'HASH'  );
+
die "split_face_by_plane:vertices" if ( ref($vertices) ne 'HASH'  );
−
  die "split_face_by_plane:uvdata"  if ( ref($uvdata)  ne 'HASH'  );
+
die "split_face_by_plane:uvdata"  if ( ref($uvdata)  ne 'HASH'  );
−
  die "split_face_by_plane:vndata"  if ( ref($vndata)  ne 'HASH'  );
+
die "split_face_by_plane:vndata"  if ( ref($vndata)  ne 'HASH'  );
  
−
  my $newvertices    = {};
+
my $newvertices    = {};
−
  my $newuvdata      = {};
+
my $newuvdata      = {};
−
  my $newvndata      = {};
+
my $newvndata      = {};
  
−
  my $pointsnear    = [];
+
my $pointsnear    = [];
−
  my $pointsfar      = [];
+
my $pointsfar      = [];
  
−
my $all_points_on_plane = 1;
+
my $all_points_on_plane = 1;
  
−
  my $last_point_number = $#{$face};
+
my $last_point_number = $#{$face};
−
  for (my $i = 0; $i <= $last_point_number; $i++)                   # loop through the vertices of the face
+
for (my $i = 0; $i <= $last_point_number; $i++) {                  # loop through the vertices of the face
−
  {
+
my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i,$face);
−
    my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i,$face);
+
my $vertex1    = $vertices->{$vertexnumbers1->{'v'}};
−
    my $vertex1    = $vertices->{$vertexnumbers1->{'v'}};
+
my $vertex2    = $vertices->{$vertexnumbers2->{'v'}};
−
    my $vertex2    = $vertices->{$vertexnumbers2->{'v'}};
+
my $vertex1_uv = $uvdata->{$vertexnumbers1->{'vt'}};
−
    my $vertex1_uv = $uvdata->{$vertexnumbers1->{'vt'}};
+
my $vertex2_uv = $uvdata->{$vertexnumbers2->{'vt'}};
−
    my $vertex2_uv = $uvdata->{$vertexnumbers2->{'vt'}};
+
my $vertex1_vn = $vndata->{$vertexnumbers1->{'vn'}};
−
    my $vertex1_vn = $vndata->{$vertexnumbers1->{'vn'}};
+
my $vertex2_vn = $vndata->{$vertexnumbers2->{'vn'}};
−
    my $vertex2_vn = $vndata->{$vertexnumbers2->{'vn'}};
+
my $side1      = classify_point_by_plane($plane, $vertex1);
−
    my $side1      = classify_point_by_plane($plane, $vertex1);
+
my $side2      = classify_point_by_plane($plane, $vertex2);
−
    my $side2      = classify_point_by_plane($plane, $vertex2);
 
  
 
#    if ($vertexnumbers1 == $vertexnumbers2) {die " points are the same";} # $DEBUG:testing remove or replace later
 
#    if ($vertexnumbers1 == $vertexnumbers2) {die " points are the same";} # $DEBUG:testing remove or replace later
Line 1,170: Line 1,403:
 
#        ($vertex1->[2] == $vertex2->[2]) ) {die " points are the same";}  # $DEBUG:testing remove or replace later
 
#        ($vertex1->[2] == $vertex2->[2]) ) {die " points are the same";}  # $DEBUG:testing remove or replace later
  
−
    my $intpoint        = [];
+
my $intpoint        = [];
−
    my $intpoint_uv      = [];
+
my $intpoint_uv      = [];
−
    my $intpoint_vn      = [];
+
my $intpoint_vn      = [];
−
    my $intpoint_numbers = {};
+
my $intpoint_numbers = {};
  
−
    SWITCH:
+
SWITCH: {
−
    {
+
if ( ($side2 < -$epsilon) &&
−
     
+
($side1 <  $epsilon)    ) { # point2 on one side and point1 als least inside the +/- epsilon
−
      if ( ($side2 < -$epsilon) &&
+
push(@{$pointsnear}, $vertexnumbers2 );              # pointsnear  + point2
−
          ($side1 <  $epsilon)    )                         # point2 on one side and point1 als least inside the +/- epsilon
+
$all_points_on_plane = 0;
−
      {
+
last SWITCH;       
−
        push(@{$pointsnear}, $vertexnumbers2 );              # pointsnear  + point2
+
}
−
        $all_points_on_plane = 0;
+
if ( ($side2 >  $epsilon) &&
−
        last SWITCH;       
+
($side1 > -$epsilon)  ) { # point1 on one side and point2 als least inside the +/- epsilon
−
      }
+
push(@{$pointsfar}, $vertexnumbers2 );              # pointsfar  + point2
 +
$all_points_on_plane = 0;
 +
last SWITCH; 
 +
}
 +
if ( ($side2 >  $epsilon) &&
 +
($side1 < -$epsilon)    ) {
 +
($intpoint,    $intpoint_uv, $intpoint_vn,
 +
$vertexcount, $uvcount    , $vncount    )
 +
= intersect_edge_with_plane (
 +
$vertex1, $vertex1_uv, $vertex1_vn,
 +
$vertex2, $vertex2_uv, $vertex2_vn,
 +
$plane,
 +
$vertexcount, $uvcount, $vncount  );
  
−
      if ( ($side2 > $epsilon) &&
+
$intpoint_numbers = {
−
          ($side1 > -$epsilon)   )                          # point1 on one side and point2 als least inside the +/- epsilon
+
'v'  => $vertexcount,
−
      {   
+
'vt' => $uvcount,
−
        push(@{$pointsfar}, $vertexnumbers2 );               # pointsfar  + point2
+
'vn' => $vncount    };
−
        $all_points_on_plane = 0;
+
push(@{$pointsnear}, $intpoint_numbers  ); # pointsnear + intp
−
        last SWITCH;
+
push(@{$pointsfar}, $intpoint_numbers, $vertexnumbers2 ); # pointsfar  + intp + point2
−
      }
+
$newvertices->{$vertexcount} = $intpoint; # newverticeslist + intp
 +
$newuvdata->{$uvcount} = $intpoint_uv; # -- " --
 +
$newvndata->{$vncount} = $intpoint_vn; # -- " --
 +
$all_points_on_plane = 0;
 +
last SWITCH;  
 +
}
  
−
      if ( ($side2 >  $epsilon) &&  
+
if ( ($side2 < -$epsilon) &&
−
          ($side1 < -$epsilon)    )
+
($side1 >  $epsilon)    ) {
−
      {
+
($intpoint,    $intpoint_uv, $intpoint_vn,
−
        ($intpoint,    $intpoint_uv, $intpoint_vn,
+
$vertexcount, $uvcount,     $vncount    )
−
        $vertexcount, $uvcount   , $vncount    )
+
= intersect_edge_with_plane (
−
            = intersect_edge_with_plane ($vertex1, $vertex1_uv, $vertex1_vn,
+
$vertex1, $vertex1_uv, $vertex1_vn,
−
                                        $vertex2, $vertex2_uv, $vertex2_vn,
+
$vertex2, $vertex2_uv, $vertex2_vn,
−
                                        $plane,
+
$plane,
−
                                        $vertexcount, $uvcount, $vncount  );
+
$vertexcount, $uvcount, $vncount  );
 +
$intpoint_numbers = {
 +
'v'  => $vertexcount,
 +
'vt' => $uvcount,   
 +
'vn' => $vncount    };
 +
push(@{$pointsnear}, $intpoint_numbers, $vertexnumbers2 ); # pointsnear + intp + point2
 +
push(@{$pointsfar}, $intpoint_numbers ); # pointsfar  + intp
 +
$newvertices->{$vertexcount} = $intpoint; # newverticeslist + intp
 +
$newuvdata->{$uvcount} = $intpoint_uv; # -- " --
 +
$newvndata->{$vncount} = $intpoint_vn; # -- " --
 +
$all_points_on_plane = 0;
 +
last SWITCH;
 +
}
 +
# else: on plane (inside +/- epsilon)     
 +
push(@{$pointsnear}, $vertexnumbers2 );                        # pointsnear + point2
 +
push(@{$pointsfar},  $vertexnumbers2 );                        # pointsfar  + point2
 +
} # SWITCH
  
−
        $intpoint_numbers = {'v'  => $vertexcount,
+
} #for
−
                            'vt' => $uvcount,
+
my $facesnear = [];
−
                            'vn' => $vncount    };
+
my $facesfar  = [];
−
        push(@{$pointsnear}, $intpoint_numbers  );                  # pointsnear + intp
 
−
        push(@{$pointsfar},  $intpoint_numbers, $vertexnumbers2 );  # pointsfar  + intp + point2
 
−
        $newvertices->{$vertexcount} = $intpoint;                    # newverticeslist + intp
 
−
        $newuvdata->{$uvcount}       = $intpoint_uv;                # -- " --
 
−
        $newvndata->{$vncount}      = $intpoint_vn;                 # -- " --
 
−
        $all_points_on_plane = 0;
 
−
        last SWITCH;  
 
−
      }
 
  
−
      if ( ($side2 < -$epsilon) &&
+
if ($all_points_on_plane) { # make sure there are no duplicate faces generated
−
          ($side1 >  $epsilon)    )
+
$facesnear = [$face];
−
      {
+
$facesfar  = [];     
−
        ($intpoint,    $intpoint_uv, $intpoint_vn,
+
} else {
−
        $vertexcount, $uvcount,    $vncount    )
+
$facesnear = ($#{$pointsnear} >= 2)
−
            = intersect_edge_with_plane ($vertex1, $vertex1_uv, $vertex1_vn,
+
?[[@{$pointsnear}]]
−
                                        $vertex2, $vertex2_uv, $vertex2_vn,
+
:[];
−
                                        $plane,
+
$facesfar  = ($#{$pointsfar}  >= 2)
−
                                        $vertexcount, $uvcount, $vncount  );
+
?[[@{$pointsfar}]]
−
        $intpoint_numbers = {'v'  => $vertexcount,
+
:[];
−
                            'vt' => $uvcount,   
+
}
−
                            'vn' => $vncount    };
+
undef $pointsnear if ($undef_vars); #$DEBUG:testing
−
        push(@{$pointsnear}, $intpoint_numbers, $vertexnumbers2 );  # pointsnear + intp + point2
+
undef $pointsfar if ($undef_vars);  #$DEBUG:testing
−
        push(@{$pointsfar},  $intpoint_numbers );                  # pointsfar  + intp
+
if ($use_benchmark) {$timer->stop('split_face_by_plane')};
−
        $newvertices->{$vertexcount} = $intpoint;                  # newverticeslist + intp
+
return ($facesnear, $facesfar,
−
        $newuvdata->{$uvcount}      = $intpoint_uv;                # -- " --
+
$newvertices, $newuvdata, $newvndata,
−
        $newvndata->{$vncount}      = $intpoint_vn;                # -- " --
+
$vertexcount, $uvcount, $vncount  );
−
        $all_points_on_plane = 0;
 
−
        last SWITCH;
 
−
      }
 
−
      # else: on plane (inside +/- epsilon)     
 
−
      push(@{$pointsnear}, $vertexnumbers2 );                        # pointsnear + point2
 
−
      push(@{$pointsfar},  $vertexnumbers2 );                        # pointsfar  + point2
 
−
    } # SWITCH
 
−
 
 
−
  } #for
 
−
  my $facesnear = [];
 
−
  my $facesfar  = [];
 
−
 
 
−
  if ($all_points_on_plane) # make sure there are no duplicate faces generated
 
−
  {
 
−
    $facesnear = [$face];
 
−
    $facesfar  = [];     
 
−
  }
 
−
  else
 
−
  {
 
−
    $facesnear = ($#{$pointsnear} >= 2)
 
−
                  ?[[@{$pointsnear}]]
 
−
                  :[];
 
−
    $facesfar  = ($#{$pointsfar}  >= 2)
 
−
                  ?[[@{$pointsfar}]]
 
−
                  :[];
 
−
  }
 
−
  undef $pointsnear if ($undef_vars); #$DEBUG:testing
 
−
  undef $pointsfar if ($undef_vars);  #$DEBUG:testing
 
−
 
 
−
  return ($facesnear, $facesfar, $newvertices, $newuvdata, $newvndata,
 
−
                                $vertexcount, $uvcount,   $vncount  );
 
 
} # sub split_face_by_plane
 
} # sub split_face_by_plane
  
Line 1,269: Line 1,496:
 
# Split all faces with a plane
 
# Split all faces with a plane
 
#######################################################################
 
#######################################################################
−
sub split_faces_by_plane (@@%%%$$$)
+
sub split_faces_by_plane (@@%%%$$$) {
−
{
+
my ($faces, $vert3, $planeface, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;
−
  my ($faces, $vert3, $planeface, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;
+
die "split_faces_by_plane:faces"    unless ( ref($faces)    eq 'ARRAY' );
−
  die "split_faces_by_plane:faces"    unless ( ref($faces)    eq 'ARRAY' );
+
die "split_faces_by_plane:vert3"    unless ( ref($vert3)    eq 'ARRAY' );
−
  die "split_faces_by_plane:vert3"    unless ( ref($vert3)    eq 'ARRAY' );
+
die "split_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
−
  die "split_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
+
die "split_faces_by_plane:vertices"  unless ( ref($vertices)  eq 'HASH'  );
−
  die "split_faces_by_plane:vertices"  unless ( ref($vertices)  eq 'HASH'  );
+
die "split_faces_by_plane:uvdata"    unless ( ref($uvdata)    eq 'HASH'  );
−
  die "split_faces_by_plane:uvdata"    unless ( ref($uvdata)    eq 'HASH'  );
+
die "split_faces_by_plane:vndata"    unless ( ref($vndata)    eq 'HASH'  );
−
  die "split_faces_by_plane:vndata"    unless ( ref($vndata)    eq 'HASH'  );
 
  
 +
my $plane      = vert3_to_plane($vert3->[0],$vert3->[1],$vert3->[2]);
 +
my $newfaces    = [];
 +
my $newvertices = {};
 +
my $newuvdata  = {};
 +
my $newvndata  = {};
 +
my $planeface_max_distance = distance_face_from_center ($planeface, 1, $vertices);
 +
 
 +
foreach my $face (@{$faces}) {  # check if face needs to be splitted/skipped/added
 +
if ($face == $planeface) {
 +
#      print " adding planeface\n" if ($verbose == 3);
 +
push(@{$newfaces}, $face );
 +
next;
 +
}
 +
my $face_min_distance = distance_face_from_center($face, 0, $vertices);
 +
my $face_in_frustum  = face_in_frustum_of_other_face($planeface, $face, $vertices);
  
−
  my $plane      = vert3_to_plane($vert3->[0],$vert3->[1],$vert3->[2]);
 
−
  my $newfaces    = [];
 
−
  my $newvertices = {};
 
−
  my $newuvdata  = {};
 
−
  my $newvndata  = {};
 
−
  my $planeface_max_distance = distance_face_from_center ($planeface, 1, $vertices);
 
−
 
 
−
  foreach my $face (@{$faces})
 
−
  { # check if face needs to be splitted/skipped/added
 
−
    if ($face == $planeface)
 
−
    {
 
−
#      print " adding planeface\n" if ($verbose == 3);
 
−
      push(@{$newfaces}, $face );
 
−
      next;
 
−
    }
 
−
    my $face_min_distance = distance_face_from_center($face, 0, $vertices);
 
−
    my $face_in_frustum  = face_in_frustum_of_other_face($planeface, $face, $vertices);
 
 
#    print "'$face_in_frustum'";
 
#    print "'$face_in_frustum'";
−
 
 
#print $planeface_max_distance." ".$face_min_distance."\n";
 
#print $planeface_max_distance." ".$face_min_distance."\n";
 +
SWITCH: {
 +
if ( (1 == $face_in_frustum ) &&
 +
($planeface_max_distance <  $face_min_distance )  ) { # face is inside the (extended) frustum AND behind the planeface
 +
# print " skipping face\n" if ($verbose == 3);
 +
print 2;
 +
last SWITCH;     
 +
} #if
  
−
    SWITCH:
+
if ( (0 != $face_in_frustum) ||
−
    {
+
($planeface_max_distance <  $face_min_distance )  ) { # face is not crossing (0 or 1) the (extended) frustum OR it is behind the planeface (mind the OR !!!!)
−
      if ( ($face_in_frustum        == 1                  ) &&
+
# print " adding orig. face\n" if ($verbose == 3);
−
          ($planeface_max_distance <  $face_min_distance )  )
+
push(@{$newfaces}, $face );  
−
      { # face is inside the (extended) frustum AND behind the planeface
+
last SWITCH;       
−
#        print " skipping face\n" if ($verbose == 3);
+
} #if
−
        print 2;
 
−
        last SWITCH;     
 
−
      } #if
 
−
 
 
−
      if ( ($face_in_frustum       != 0                  ) ||
 
−
          ($planeface_max_distance <  $face_min_distance )  )
 
−
      { # face is not crossing (0 or 1) the (extended) frustum OR it is behind the planeface (mind the OR !!!!)
 
−
#       print " adding orig. face\n" if ($verbose == 3);
 
−
        push(@{$newfaces}, $face );  
 
−
        last SWITCH;       
 
−
      } #if
 
 
   
 
   
−
      #if (face completly on plane) $DEBUG:TODO $DEBUG:MARK3
+
# if (face completly on plane) { $DEBUG:TODO $DEBUG:MARK3
−
      #{
+
# skip face
−
      # skip
+
# }
−
      #}
 
  
−
      # ELSE SWITCH    # ($face_in_frustum == 0) and others
+
# ELSE SWITCH    # ($face_in_frustum == 0) and others
−
#     print " splitting face\n" if ($verbose == 3);
+
# print " splitting face\n" if ($verbose == 3);
−
      (my $dummy_newfacesnear, my $dummy_newfacesfar,
+
(my $dummy_newfacesnear, my $dummy_newfacesfar,
−
      my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
+
my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
−
      $vertexcount,          $uvcount,            $vncount )
+
$vertexcount,          $uvcount,            $vncount )
−
          = split_face_by_plane($face, $plane, $vertices,   $uvdata, $vndata,
+
= split_face_by_plane($face, $plane,
−
                                              $vertexcount, $uvcount, $vncount );
+
$vertices, $uvdata, $vndata,
−
      push(@{$newfaces}, @{$dummy_newfacesnear}, @{$dummy_newfacesfar} );
+
$vertexcount, $uvcount, $vncount );
−
      %{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
+
push(@{$newfaces}, @{$dummy_newfacesnear}, @{$dummy_newfacesfar} );
−
      %{$newuvdata}  = ( %{$newuvdata},  %{$dummy_newuvdata}  );
+
%{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
−
      %{$newvndata}  = ( %{$newvndata},  %{$dummy_newvndata}  );
+
%{$newuvdata}  = ( %{$newuvdata},  %{$dummy_newuvdata}  );
−
      undef $dummy_newvertices  if ($undef_vars); #$DEBUG:testing
+
%{$newvndata}  = ( %{$newvndata},  %{$dummy_newvndata}  );
−
      undef $dummy_newuvdata if ($undef_vars);  #$DEBUG:testing
+
undef $dummy_newvertices  if ($undef_vars); #$DEBUG:testing
−
      undef $dummy_newvndata if ($undef_vars);  #$DEBUG:testing
+
undef $dummy_newuvdata if ($undef_vars);  #$DEBUG:testing
−
    } # SWITCH
+
undef $dummy_newvndata if ($undef_vars);  #$DEBUG:testing
−
  } # foreach
+
} # SWITCH
−
  return ($newfaces, $newvertices, $newuvdata, $newvndata, $vertexcount, $uvcount, $vncount);
+
} # foreach
 +
return ($newfaces,
 +
$newvertices, $newuvdata, $newvndata,
 +
$vertexcount, $uvcount, $vncount);
 
} # sub split_faces_by_plane
 
} # sub split_faces_by_plane
  
Line 1,353: Line 1,574:
 
# Split faces by a plane that for use in the bsp sorting algorithm
 
# Split faces by a plane that for use in the bsp sorting algorithm
 
#######################################################################
 
#######################################################################
−
sub bspsplit_faces_by_plane (@@@%%%$$$)
+
sub bspsplit_faces_by_plane_new (@@@%) {
−
{
+
my ($bspfaces, $plane, $planeface, $objects) = @_;  
−
  my ($bspfaces, $plane, $planeface, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;
+
die "bspsplit_faces_by_plane:faces"    unless ( ref($bspfaces)    eq 'ARRAY' );
−
  die "bspsplit_faces_by_plane:faces"    unless ( ref($bspfaces)    eq 'ARRAY' );
+
die "bspsplit_faces_by_plane:plane"    unless ( ref($plane)    eq 'ARRAY' );
−
  die "bspsplit_faces_by_plane:plane"    unless ( ref($plane)    eq 'ARRAY' );
+
die "bspsplit_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
−
  die "bspsplit_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
+
die "bspsplit_faces_by_plane:objects"  unless ( ref($objects)  eq 'HASH'  );
−
  die "bspsplit_faces_by_plane:vertices"  unless ( ref($vertices)  eq 'HASH'  );
 
−
  die "bspsplit_faces_by_plane:uvdata"    unless ( ref($uvdata)    eq 'HASH'  );
 
−
  die "bspsplit_faces_by_plane:vndata"    unless ( ref($vndata)    eq 'HASH'  );
 
−
 
 
−
  my $newfacesnear = [];
 
−
  my $newfacesfar  = [];
 
−
  my $newfacespar  = [];
 
−
  my $newvertices  = {};
 
−
  my $newuvdata    = {};
 
−
  my $newvndata    = {};
 
−
 
 
−
  foreach my $bspface (@{$bspfaces})
 
−
  { # check if face needs to be splitted/skipped/added
 
−
    my $face = $bspface->{'face'};
 
−
    if ($face == $planeface) {
 
−
      push(@{$newfacesnear}, $bspface);
 
−
      next;                            # skipping this foreach-face
 
−
    }
 
−
 
 
−
    print " splitting face\n" if ($verbose == 3);
 
−
    (my $dummy_newfacesnear, my $dummy_newfacesfar,
 
−
    my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
 
−
    $vertexcount,          $uvcount,            $vncount )
 
−
        = split_face_by_plane($face, $plane, $vertices,    $uvdata,  $vndata,
 
−
                                            $vertexcount, $uvcount, $vncount );
 
−
 
 
−
    $dummy_newfacesnear = faces2bspfaces($dummy_newfacesnear,$bspface->{'used_as_plane'});
 
−
    $dummy_newfacesfar  = faces2bspfaces($dummy_newfacesfar, $bspface->{'used_as_plane'});
 
−
 
 
−
    push(@{$newfacesnear}, @{$dummy_newfacesnear});
 
−
    push(@{$newfacesfar},  @{$dummy_newfacesfar} );
 
−
 
 
−
    undef $dummy_newfacesnear if ($undef_vars);  #$DEBUG:testing
 
−
    undef $dummy_newfacesfar if ($undef_vars);  #$DEBUG:testing
 
−
 
 
−
    %{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
 
−
    %{$newuvdata}  = ( %{$newuvdata},  %{$dummy_newuvdata}  );
 
−
    %{$newvndata}  = ( %{$newvndata},  %{$dummy_newvndata}  );
 
−
 
 
−
    undef $dummy_newvertices if ($undef_vars); #$DEBUG:testing
 
−
    undef $dummy_newuvdata if ($undef_vars);  #$DEBUG:testing
 
−
    undef $dummy_newvndata if ($undef_vars);  #$DEBUG:testing
 
−
  } # foreach
 
−
  return ($newfacesnear, $newfacesfar, $newvertices, $newuvdata, $newvndata,
 
−
                                      $vertexcount, $uvcount,  $vncount );
 
−
} # sub bspsplit_faces_by_plane
 
−
 
 
−
#######################################################################
 
−
# Split faces by a plane that for use in the bsp sorting algorithm
 
−
#######################################################################
 
−
sub bspsplit_faces_by_plane_new (@@@%)  
 
−
{
 
−
  my ($bspfaces, $plane, $planeface, $objects) = @_;  
 
−
  die "bspsplit_faces_by_plane:faces"    unless ( ref($bspfaces)    eq 'ARRAY' );
 
−
  die "bspsplit_faces_by_plane:plane"    unless ( ref($plane)    eq 'ARRAY' );
 
−
  die "bspsplit_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
 
−
  die "bspsplit_faces_by_plane:objects"  unless ( ref($objects)  eq 'HASH'  );
 
  
−
  my $newfacesnear = [];
+
my $newfacesnear = [];
−
  my $newfacesfar  = [];
+
my $newfacesfar  = [];
−
  my $newfacespar  = [];
+
my $newfacespar  = [];
  
−
  foreach my $face (@{$bspfaces}) { # check if face needs to be splitted/skipped/added
+
foreach my $face (@{$bspfaces}) { # check if face needs to be splitted/skipped/added
−
    #my $face = $bspface->{'face'};
+
#my $face = $bspface->{'face'};
−
    if ($face->{'face'} == $planeface) {  
+
if ($face->{'face'} == $planeface) {  
−
      push(@{$newfacesnear}, $face);
+
push(@{$newfacesnear}, $face);
−
      next;                            # skipping this foreach-face
+
next;                            # skipping this foreach-face
−
    }
+
}
  
−
    print " splitting face\n" if ($verbose == 3);
+
print " splitting face\n" if ($verbose == 3);
  
−
    (my $dummy_newfacesnear, my $dummy_newfacesfar,
+
(my $dummy_newfacesnear, my $dummy_newfacesfar,
−
    my $dummy_newvertices,  my $dummy_newuvdata, my $dummy_newvndata,
+
my $dummy_newvertices,  my $dummy_newuvdata, my $dummy_newvndata,
−
    $objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
+
$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
−
        = split_face_by_plane($face->{'face'}, $plane,  
+
= split_face_by_plane($face->{'face'}, $plane,  
−
                                $objects->{'vertices'},     $objects->{'uvdata'},     $objects->{'vndata'},
+
$objects->{'vertices'}, $objects->{'uvdata'}, $objects->{'vndata'},
−
                              $objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'}  
+
$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'}  
 
                                  );
 
                                  );
−
    my $dummy_newfacesnear2 = [];
+
my $dummy_newfacesnear2 = [];
−
    foreach my $facex (@{$dummy_newfacesnear}) {
+
foreach my $facex (@{$dummy_newfacesnear}) {
−
      push(@{$dummy_newfacesnear2},{'face'=>$facex,
+
push(
−
                                    'mtl' =>""});#$face->{'mtl'}} );
+
@{$dummy_newfacesnear2},
−
    }
+
{ 'face'=>$facex,
−
    my $dummy_newfacesfar2 = [];
+
'mtl' =>""  
−
    foreach my $facex (@{$dummy_newfacesfar}) {
+
}
−
      push(@{$dummy_newfacesfar2},{'face'=>$facex,
+
);#$face->{'mtl'}} );
−
                                    'mtl' =>""});#$face->{'mtl'}} );
+
}
−
    }
+
my $dummy_newfacesfar2 = [];
 +
foreach my $facex (@{$dummy_newfacesfar}) {
 +
push(
 +
@{$dummy_newfacesfar2},
 +
{ 'face'=>$facex,
 +
'mtl' =>""
 +
}
 +
);#$face->{'mtl'}} );
 +
}
  
−
    faces2bspfaces($dummy_newfacesnear2, $face->{'used_as_plane'});
+
faces2bspfaces($dummy_newfacesnear2, $face->{'used_as_plane'});
−
    faces2bspfaces($dummy_newfacesfar2, $face->{'used_as_plane'});
+
faces2bspfaces($dummy_newfacesfar2, $face->{'used_as_plane'});
  
−
    push(@{$newfacesnear}, @{$dummy_newfacesnear2});
+
push(@{$newfacesnear}, @{$dummy_newfacesnear2});
−
    push(@{$newfacesfar},  @{$dummy_newfacesfar2} );
+
push(@{$newfacesfar},  @{$dummy_newfacesfar2} );
  
−
    undef $dummy_newfacesnear2 if ($undef_vars);  #$DEBUG:testing
+
undef $dummy_newfacesnear2 if ($undef_vars);  #$DEBUG:testing
−
    undef $dummy_newfacesfar2 if ($undef_vars);  #$DEBUG:testing
+
undef $dummy_newfacesfar2 if ($undef_vars);  #$DEBUG:testing
 
      
 
      
−
    %{$objects->{'vertices'}} = ( %{$objects->{'vertices'}}, %{$dummy_newvertices} );
+
%{$objects->{'vertices'}} = (%{$objects->{'vertices'}}, %{$dummy_newvertices});
−
    %{$objects->{'uvdata'}}   = ( %{$objects->{'uvdata'}},   %{$dummy_newuvdata}   );
+
%{$objects->{'uvdata'}} = (%{$objects->{'uvdata'}}, %{$dummy_newuvdata});
−
    %{$objects->{'vndata'}}   = ( %{$objects->{'vndata'}},   %{$dummy_newvndata}   );
+
%{$objects->{'vndata'}} = (%{$objects->{'vndata'}}, %{$dummy_newvndata});
−
 
 
−
    undef $dummy_newvertices if ($undef_vars); #$DEBUG:testing
 
−
    undef $dummy_newuvdata if ($undef_vars);  #$DEBUG:testing
 
−
    undef $dummy_newvndata if ($undef_vars);  #$DEBUG:testing
 
  
−
   } # foreach face
+
undef $dummy_newvertices if ($undef_vars); #$DEBUG:testing
−
  return ($newfacesnear, $newfacesfar);
+
undef $dummy_newuvdata if ($undef_vars);  #$DEBUG:testing
 +
undef $dummy_newvndata if ($undef_vars);   #$DEBUG:testing
 +
} # foreach face
 +
return ($newfacesnear, $newfacesfar);
 
} # sub bspsplit_faces_by_plane
 
} # sub bspsplit_faces_by_plane
  
Line 1,473: Line 1,644:
 
# the info says if the face has been used as plane
 
# the info says if the face has been used as plane
 
#######################################################################
 
#######################################################################
−
sub faces2bspfaces(@$)
+
sub faces2bspfaces(@$) {
−
{
+
my ($faces, $used_as_plane) = @_;
−
  my ($faces, $used_as_plane) = @_;
+
if ($#{$faces} >= 0) {
−
  if ($#{$faces} >= 0){
+
foreach my $face (@{$faces}) {  
−
    foreach my $face (@{$faces}) {  
+
$face->{'used_as_plane'} = $used_as_plane;
−
      $face->{'used_as_plane'} = $used_as_plane;
+
}
−
    }
+
}
−
  }
 
 
}
 
}
  
−
sub bspfaces2faces(@)
+
sub bspfaces2faces(@) {
−
{
+
my ($faces) = @_;
−
  my ($faces) = @_;
+
if ($#{$faces} >= 0) {
−
  if ($#{$faces} >= 0){
+
foreach my $face (@{$faces}) {  
−
    foreach my $face (@{$faces}) {  
+
if (exists $face->{'used_as_plane'}) {
−
      if (exists $face->{'used_as_plane'}) {
+
delete($face->{'used_as_plane'})
−
        delete($face->{'used_as_plane'})
+
}
−
      }
+
} # foreach face
−
    } # foreach face
+
}
−
  }
 
 
}
 
}
  
Line 1,498: Line 1,667:
 
# Generate a bsp sorted/splitted tree out of a list of faces
 
# Generate a bsp sorted/splitted tree out of a list of faces
 
#######################################################################
 
#######################################################################
−
sub gen_bsptree_new (@%)
+
sub gen_bsptree_new (@%) {
−
{
+
my ($bspfaces, $objects ) = @_;
−
  my ($bspfaces, $objects ) = @_;
+
die "gen_bsptree:faces"  unless ( ref($bspfaces) eq 'ARRAY' );
−
  die "gen_bsptree:faces"  unless ( ref($bspfaces) eq 'ARRAY' );
+
die "gen_bsptree:objects" unless ( ref($objects)  eq 'HASH'  );
−
  die "gen_bsptree:objects" unless ( ref($objects)  eq 'HASH'  );
 
  
−
  my $bsptree           = {};
+
my $bsptree = {};
−
  my $bsptree_near     = {};
+
my $bsptree_near = {};
−
  my $bsptree_far       = {};
+
my $bsptree_far = {};
−
  my $dummy_newvertices = {};
+
my $dummy_newvertices = {};
−
  my $dummy_newuvdata   = {};
+
my $dummy_newuvdata = {};
−
  my $dummy_newvndata   = {};
+
my $dummy_newvndata = {};
  
−
  if ($#{$bspfaces} >= 0) {
+
if ($#{$bspfaces} >= 0) {
−
    my $planeface = [];
+
my $planeface = [];
−
    for (my $i = 0; $i <= $#{$bspfaces}; $i++) {
+
for (my $i = 0; $i <= $#{$bspfaces}; $i++) {
−
      if ($bspfaces->[$i]->{'used_as_plane'} == 0) {
+
if ($bspfaces->[$i]->{'used_as_plane'} == 0) {
−
        $planeface = $bspfaces->[$i]->{'face'};
+
$planeface = $bspfaces->[$i]->{'face'};
−
        $bspfaces->[$i]->{'used_as_plane'} = 1;
+
$bspfaces->[$i]->{'used_as_plane'} = 1;
−
        last; # for
+
last; # for
−
      }
+
}
−
    }
+
}
−
    if ($#{$planeface} >= 0) {
+
if ($#{$planeface} >= 0) {
−
      print "<".$bspfaces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$bspfaces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
−
      print "<".$#{$bspfaces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$#{$bspfaces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
−
      print "<".$bspfaces->[0]->{'face'}.">\n" if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$bspfaces->[0]->{'face'}.">\n" if ($verbose == 4 ); # $DEBUG:testing
  
−
      my $plane     = face2plane($planeface, $objects->{'vertices'} );
+
my $plane = face2plane($planeface, $objects->{'vertices'} );
−
      (my $newfacesnear, my $newfacesfar)
+
(my $newfacesnear, my $newfacesfar)
−
          = bspsplit_faces_by_plane_new($bspfaces, $plane, $planeface, $objects );
+
= bspsplit_faces_by_plane_new($bspfaces, $plane, $planeface, $objects );
  
−
      if ( $#{$newfacesnear} >= 0 ) { # one face or more
+
if ( $#{$newfacesnear} >= 0 ) { # one face or more
−
        $bsptree_near = gen_bsptree_new ($newfacesnear, $objects );
+
$bsptree_near = gen_bsptree_new ($newfacesnear, $objects );
−
      }
+
}
 
    
 
    
−
      if ( $#{$newfacesfar} >= 0 ) { # one face or more
+
if ( $#{$newfacesfar} >= 0 ) { # one face or more
−
        $bsptree_far  = gen_bsptree_new ($newfacesfar, $objects );
+
$bsptree_far  = gen_bsptree_new ($newfacesfar, $objects );
−
      }
+
}
−
      $bsptree = { 'near' => $bsptree_near,  # bsptree near
+
$bsptree = {
−
                  'far'  => $bsptree_far,  # bsptree far
+
'near' => $bsptree_near,  # bsptree near
−
                  'f'    => []              # faces
+
'far'  => $bsptree_far,  # bsptree far
−
                };
+
'f'    => []              # faces
−
    }#if $planeface=ok
+
};
−
    else
+
} else { #if $planeface=ok
−
    {
+
$bsptree = {
−
      $bsptree = { 'near' => 0,        # bsptree near
+
'near' => 0,        # bsptree near
−
                  'far'  => 0,        # bsptree far
+
'far'  => 0,        # bsptree far
−
                  'f'    => $bspfaces # faces
+
'f'    => $bspfaces # faces
−
                };
+
};
−
    }
+
}
−
  }
+
} else { # ( ${$faces} <= -1 )
−
  else # ( ${$faces} <= -1 )
+
$bsptree = {
−
  {
+
'near' => 0,            # empty
−
  $bsptree = { 'near' => 0,            # empty
+
'far'  => 0,            # empty
−
                'far'  => 0,            # empty
+
'f'    => []            # faces
−
                'f'    => []            # faces
+
};
−
              };
+
}
−
  }
+
return $bsptree;
−
 
+
} # sub gen_bsptree_new
−
  return $bsptree;
 
−
} # sub gen_bsptree
 
  
 
#######################################################################
 
#######################################################################
 
# Generate a list of faces out of a BSP-tree
 
# Generate a list of faces out of a BSP-tree
 
#######################################################################
 
#######################################################################
−
sub bsptree2faceslist_new (%)
+
sub bsptree2faceslist_new (%) {
−
{
+
my ($bsptree, $objects) = @_;
−
  my ($bsptree, $objects) = @_;
+
die "bsptree2faceslist:bsptree" unless ( ref($bsptree) eq 'HASH' );
−
  die "bsptree2faceslist:bsptree" unless ( ref($bsptree) eq 'HASH' );
 
  
−
  my $faces      = [];
+
my $faces      = [];
−
  my $faces_near = [];
+
my $faces_near = [];
−
  my $faces_far  = [];
+
my $faces_far  = [];
  
−
  if (ref($bsptree->{'near'}) eq "HASH"){
+
if (ref($bsptree->{'near'}) eq "HASH") {
−
    $faces_near = bsptree2faceslist_new($bsptree->{'near'});
+
$faces_near = bsptree2faceslist_new($bsptree->{'near'});
−
    #$faces_near = bspfaces2faces($faces_near);
+
#$faces_near = bspfaces2faces($faces_near);
−
    if ($#{$faces_near} >= 0) {
+
if ($#{$faces_near} >= 0) {
−
      push( @{$faces}, @{$faces_near});
+
push( @{$faces}, @{$faces_near});
−
    }
+
}
−
  }
+
}
  
−
  if ($#{$bsptree->{'f'}}>= 0) {
+
if ($#{$bsptree->{'f'}}>= 0) {
−
    bspfaces2faces($bsptree->{'f'});
+
bspfaces2faces($bsptree->{'f'});
−
    push( @{$faces}, @{$bsptree->{'f'}});
+
push( @{$faces}, @{$bsptree->{'f'}});
−
    #push( @{$faces}, @{$bsptree->{'f'}});
+
#push( @{$faces}, @{$bsptree->{'f'}});
−
  }
+
}
  
−
  if (ref($bsptree->{'far'}) eq "HASH"){
+
if (ref($bsptree->{'far'}) eq "HASH") {
−
    $faces_far = bsptree2faceslist_new($bsptree->{'far'});
+
$faces_far = bsptree2faceslist_new($bsptree->{'far'});
−
    #$faces_far = bspfaces2faces($faces_far);
+
#$faces_far = bspfaces2faces($faces_far);
 
      
 
      
−
    if ($#{$faces_far} >= 0) {
+
if ($#{$faces_far} >= 0) {
−
      push( @{$faces}, @{$faces_far});
+
push( @{$faces}, @{$faces_far});
−
    }
+
}
−
  }
+
}
−
  return $faces;
+
return $faces;
 
} # sub bsptree2faceslist
 
} # sub bsptree2faceslist
 
#----------------------------------------------------------------------
 
#----------------------------------------------------------------------
Line 1,607: Line 1,772:
 
# this one is used by the center-bsp method
 
# this one is used by the center-bsp method
 
#######################################################################
 
#######################################################################
−
sub centerbspsplit_faces_by_plane (@@%%%$$$)  
+
sub centerbspsplit_faces_by_plane_new (@@%) {
−
{
+
if ($use_benchmark) {$timer->start('centerbspsplit_faces_by_plane_new')};
−
  my ($faces, $plane, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;  
+
my ($faces, $plane, $objects) = @_;  
−
  die "centerbspsplit_faces_by_plane:faces"     unless ( ref($faces)    eq 'ARRAY' );
+
die "centerbspsplit_faces_by_plane:faces" unless ( ref($faces)    eq 'ARRAY' );
−
  die "centerbspsplit_faces_by_plane:plane"     unless ( ref($plane)    eq 'ARRAY' );
+
die "centerbspsplit_faces_by_plane:plane" unless ( ref($plane)    eq 'ARRAY' );
−
  die "centerbspsplit_faces_by_plane:vertices" unless ( ref($vertices)  eq 'HASH'  );
+
die "centerbspsplit_faces_by_plane:objects" unless ( ref($objects)  eq 'HASH'  );
−
  die "centerbspsplit_faces_by_plane:uvdata"    unless ( ref($uvdata)    eq 'HASH'  );
 
−
  die "centerbspsplit_faces_by_plane:vndata"    unless ( ref($vndata)    eq 'HASH'  );
 
  
−
  my $newfacesnear = [];
+
my $newfacesnear = [];
−
  my $newfacesfar = [];
+
my $newfacesfar = [];
−
  my $newfacespar = [];
+
my $newfacespar = [];
−
  my $newvertices  = {};
 
−
  my $newuvdata    = {};
 
−
  my $newvndata    = {};
 
  
−
  foreach my $face (@{$faces})
+
foreach my $face (@{$faces}) {  
−
  {  
+
print " splitting face\n" if ($verbose == 3);
−
    print " splitting face\n" if ($verbose == 3);
+
(my $dummy_newfacesnear, my $dummy_newfacesfar,
−
    (my $dummy_newfacesnear, my $dummy_newfacesfar,
+
my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
−
    my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
+
$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
−
    $vertexcount,         $uvcount,           $vncount )
+
= split_face_by_plane($face->{'face'}, $plane,  
−
        = split_face_by_plane($face, $plane, $vertices,   $uvdata, $vndata,
+
$objects->{'vertices'}, $objects->{'uvdata'}, $objects->{'vndata'},
−
                                            $vertexcount, $uvcount, $vncount );
+
$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'}
 +
);
 +
#print "a".Dumper($dummy_newfacesnear);
 +
my $dummy_newfacesnear2 = [];
 +
foreach my $face (@{$dummy_newfacesnear}) {
 +
push(
 +
@{$dummy_newfacesnear2},
 +
{ 'face'=>$face,
 +
'mtl' =>""
 +
}
 +
);#$face->{'mtl'}} );
 +
}
 +
undef $dummy_newfacesnear if ($undef_vars);
 +
my $dummy_newfacesfar2 = [];
 +
foreach my $face (@{$dummy_newfacesfar}) {
 +
push(
 +
@{$dummy_newfacesfar2},
 +
{ 'face'=>$face,
 +
'mtl' =>""
 +
}
 +
);#$face->{'mtl'}} );
 +
}
 +
undef $dummy_newfacesfar if ($undef_vars);
 +
push(@{$newfacesnear}, @{$dummy_newfacesnear2});
 +
push(@{$newfacesfar},  @{$dummy_newfacesfar2} );
  
−
    push(@{$newfacesnear}, @{$dummy_newfacesnear});
+
undef $dummy_newfacesnear2 if ($undef_vars);
−
    push(@{$newfacesfar},  @{$dummy_newfacesfar} );
+
undef $dummy_newfacesfar2 if ($undef_vars);
  
−
    undef $dummy_newfacesnear if ($undef_vars);
+
%{$objects->{'vertices'}} =  ( %{$objects->{'vertices'}}, %{$dummy_newvertices} );
−
    undef $dummy_newfacesfar if ($undef_vars);
+
%{$objects->{'uvdata'}}  =  ( %{$objects->{'uvdata'}},  %{$dummy_newuvdata} );
 +
%{$objects->{'vndata'}}  =  ( %{$objects->{'vndata'}},  %{$dummy_newvndata} );
  
−
    %{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
+
undef $dummy_newvertices if ($undef_vars);
−
    %{$newuvdata}  = ( %{$newuvdata},  %{$dummy_newuvdata}  );
+
undef $dummy_newuvdata if ($undef_vars);
−
    %{$newvndata}  = ( %{$newvndata},  %{$dummy_newvndata}  );
+
undef $dummy_newvndata if ($undef_vars);
−
 
+
} # foreach face
−
    undef $dummy_newvertices if ($undef_vars);
+
if ($use_benchmark) {$timer->stop('centerbspsplit_faces_by_plane_new')};
−
    undef $dummy_newuvdata if ($undef_vars);
+
return ($newfacesnear, $newfacesfar);
−
    undef $dummy_newvndata if ($undef_vars);
 
−
 
 
−
  } # foreach
 
−
  return ($newfacesnear, $newfacesfar, $newvertices, $newuvdata, $newvndata,
 
−
                                      $vertexcount, $uvcount,  $vncount );
 
−
} # sub centerbspsplit_faces_by_plane
 
−
 
 
−
#######################################################################
 
−
# Split faces by a plane that for use in the bsp sorting algorithm
 
−
# this one is used by the center-bsp method
 
−
#######################################################################
 
−
sub centerbspsplit_faces_by_plane_new (@@%)
 
−
{
 
−
  my ($faces, $plane, $objects) = @_;
 
−
  die "centerbspsplit_faces_by_plane:faces"  unless ( ref($faces)    eq 'ARRAY' );
 
−
  die "centerbspsplit_faces_by_plane:plane"  unless ( ref($plane)    eq 'ARRAY' );
 
−
  die "centerbspsplit_faces_by_plane:objects" unless ( ref($objects)  eq 'HASH'  );
 
−
 
 
−
  my $newfacesnear = [];
 
−
  my $newfacesfar  = [];
 
−
  my $newfacespar  = [];
 
−
 
 
−
  foreach my $face (@{$faces}) {
 
−
    print " splitting face\n" if ($verbose == 3);
 
−
    (my $dummy_newfacesnear, my $dummy_newfacesfar,
 
−
    my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
 
−
    $objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
 
−
        = split_face_by_plane($face->{'face'}, $plane,
 
−
                              $objects->{'vertices'},    $objects->{'uvdata'},    $objects->{'vndata'},
 
−
                              $objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'}
 
−
                            );
 
−
#print "a".Dumper($dummy_newfacesnear);
 
−
    my $dummy_newfacesnear2 = [];
 
−
    foreach my $face (@{$dummy_newfacesnear}) {
 
−
      push(@{$dummy_newfacesnear2},{'face'=>$face,
 
−
                                    'mtl' =>""});#$face->{'mtl'}} );
 
−
    }
 
−
    undef $dummy_newfacesnear if ($undef_vars);
 
−
    my $dummy_newfacesfar2 = [];
 
−
    foreach my $face (@{$dummy_newfacesfar}) {
 
−
      push(@{$dummy_newfacesfar2},{'face'=>$face,
 
−
                                    'mtl' =>""});#$face->{'mtl'}} );
 
−
    }
 
−
    undef $dummy_newfacesfar if ($undef_vars);
 
−
    push(@{$newfacesnear}, @{$dummy_newfacesnear2});
 
−
    push(@{$newfacesfar},  @{$dummy_newfacesfar2} );
 
−
 
 
−
    undef $dummy_newfacesnear2 if ($undef_vars);
 
−
    undef $dummy_newfacesfar2 if ($undef_vars);
 
−
 
 
−
    %{$objects->{'vertices'}} =  ( %{$objects->{'vertices'}}, %{$dummy_newvertices} );
 
−
    %{$objects->{'uvdata'}}  =  ( %{$objects->{'uvdata'}},  %{$dummy_newuvdata} );
 
−
    %{$objects->{'vndata'}}  =  ( %{$objects->{'vndata'}},  %{$dummy_newvndata} );
 
−
 
 
−
    undef $dummy_newvertices if ($undef_vars);
 
−
    undef $dummy_newuvdata if ($undef_vars);
 
−
    undef $dummy_newvndata if ($undef_vars);
 
−
 
 
−
  } # foreach face
 
−
  return ($newfacesnear, $newfacesfar);
 
 
} # sub centerbspsplit_faces_by_plane
 
} # sub centerbspsplit_faces_by_plane
  
Line 1,709: Line 1,834:
 
# generate center-BSP tree
 
# generate center-BSP tree
 
#######################################################################
 
#######################################################################
−
sub gen_centerbsptree_new (@%%)
+
sub gen_centerbsptree_new (@%%) {
−
{
+
my ($faces, $objects, $edges, $used_edges ) = @_;
−
  my ($faces, $objects, $edges, $used_edges ) = @_;
 
−
  #my  ($faces, $vertices, $uvdata, $vndata,  $vertexcount, $uvcount, $vncount, $edges, $used_edges ) = @_;
 
 
    
 
    
−
  die "gen_centerbsptree:faces"        unless ( ref($faces)      eq 'ARRAY' );
+
die "gen_centerbsptree:faces"        unless ( ref($faces)      eq 'ARRAY' );
−
  die "gen_centerbsptree:objects"      unless ( ref($objects)    eq 'HASH'  );
+
die "gen_centerbsptree:objects"      unless ( ref($objects)    eq 'HASH'  );
−
  die "gen_centerbsptree:edges"        unless ( ref($edges)      eq 'HASH'  );  
+
die "gen_centerbsptree:edges"        unless ( ref($edges)      eq 'HASH'  );  
−
  die "gen_centerbsptree:unused_edges" unless ( ref($used_edges) eq 'HASH'  );  
+
die "gen_centerbsptree:unused_edges" unless ( ref($used_edges) eq 'HASH'  );  
  
−
  my $zero_point  = [0, 0, 0];
+
my $zero_point  = [0, 0, 0];
  
−
  my $centerbsptree     = {};
+
my $centerbsptree = {};
−
  my $centerbsptree_near = {};
+
my $centerbsptree_near = {};
−
  my $centerbsptree_far = {};
+
my $centerbsptree_far = {};
−
  my $dummy_newvertices = {};
+
my $dummy_newvertices = {};
−
  my $dummy_newuvdata   = {};
+
my $dummy_newuvdata = {};
−
  my $dummy_newvndata   = {};
+
my $dummy_newvndata = {};
  
−
  print "Processed edges: " . (keys %{$used_edges}) ." of <=  ~". (keys %{$edges}) ."\n";
+
print "Processed edges: " . (keys %{$used_edges}) ." of <=  ~". (keys %{$edges}) ."\n";
  
−
  if ($#{$faces} >= 0) {
+
if ($#{$faces} >= 0) {
−
    print "<".$faces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$faces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
−
    print "<".$#{$faces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$#{$faces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
−
    print "<".$faces->[0].">\n" if ($verbose == 4 ); # $DEBUG:testing
+
print "<".$faces->[0].">\n" if ($verbose == 4 ); # $DEBUG:testing
  
−
    my $first_unused_edge = first_unused_edges_in_faces($faces, $edges, $used_edges);
+
my $first_unused_edge = first_unused_edges_in_faces($faces, $edges, $used_edges);
  
−
    if ((exists $first_unused_edge->{'v1'}) &&
+
if ( (exists $first_unused_edge->{'v1'}) &&
−
        (exists $first_unused_edge->{'v2'})   )
+
(exists $first_unused_edge->{'v2'}) ) {
−
    {
+
my $vertexnumbers1 = $first_unused_edge->{'v1'};
−
      my $vertexnumbers1 = $first_unused_edge->{'v1'};
+
my $vertexnumbers2 = $first_unused_edge->{'v2'};
−
      my $vertexnumbers2 = $first_unused_edge->{'v2'};
+
−
       
+
$used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;              # save used edge
−
      $used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;              # save used edge
+
−
 
+
my $vertex1 = $objects->{'vertices'}->{$vertexnumbers1->{'v'}};
−
      my $vertex1 = $objects->{'vertices'}->{$vertexnumbers1->{'v'}};
+
my $vertex2 = $objects->{'vertices'}->{$vertexnumbers2->{'v'}};       
−
      my $vertex2 = $objects->{'vertices'}->{$vertexnumbers2->{'v'}};       
+
my $zeroplane  = vert3_to_plane($zero_point, $vertex1, $vertex2 );
−
      my $zeroplane  = vert3_to_plane($zero_point, $vertex1, $vertex2 );
+
     
−
     
+
#undef $vertex1; #$DEBUG:TODO possible? (link needed?)
−
      #undef $vertex1; #$DEBUG:TODO possible? (link needed?)
+
#undef $vertex2; #$DEBUG:TODO possible? (link needed?)
−
      #undef $vertex2; #$DEBUG:TODO possible? (link needed?)
+
−
 
+
(my $newfacesnear, my $newfacesfar)
−
      (my $newfacesnear, my $newfacesfar)
+
= centerbspsplit_faces_by_plane_new($faces, $zeroplane, $objects );
−
                          = centerbspsplit_faces_by_plane_new($faces, $zeroplane, $objects );
+
#$first_unused_edge  = first_unused_edges_in_faces($newfacesnear, $edges, $used_edges);
−
      #$first_unused_edge  = first_unused_edges_in_faces($newfacesnear, $edges, $used_edges);
+
$centerbsptree_near = gen_centerbsptree_new ($newfacesnear, $objects, $edges, $used_edges);
−
      $centerbsptree_near = gen_centerbsptree_new ($newfacesnear, $objects, $edges, $used_edges);
+
$centerbsptree_far  = gen_centerbsptree_new ($newfacesfar,  $objects, $edges, $used_edges);
−
      $centerbsptree_far  = gen_centerbsptree_new ($newfacesfar,  $objects, $edges, $used_edges);
+
−
 
+
$centerbsptree = {
−
                                                       
+
'near'  => $centerbsptree_near,  # bsptree near
−
                                                                         
+
'far'  => $centerbsptree_far,  # bsptree far
−
      $centerbsptree = { 'near'  => $centerbsptree_near,  # bsptree near
+
'f'    => []                  # faces  
−
                        'far'  => $centerbsptree_far,  # bsptree far
+
#,'edges' => [ $vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'} ] # edges on the plane
−
                        'f'    => [],                   # faces  
+
# $DEBUG:TODO ADD rest of the coplanar edges to this list
−
                        'edges' => [ $vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'} ] # edges on the plane
+
};
−
 
+
# $DEBUG:TODO ADD th3 rest of the 'f' edges to the used edges
−
                        # $DEBUG:TODO ADD rest of the coplanar edges to this list
+
} else {
−
                      };
+
# no unused edges found
−
      # $DEBUG:TODO ADD th3 rest of the 'f' edges to the used edges
+
$centerbsptree = {
−
    }
+
'near'  => 0,            # empty
−
    else {
+
'far'  => 0,            # empty
−
      # no unused edges found
+
'f'    => $faces      # faces  
−
      $centerbsptree = { 'near'  => 0,            # empty
+
#,'edges' => []            # edges on the plane
−
                        'far'  => 0,            # empty
+
# $DEBUG:TODO ADD rest of the coplanar edges to this list
−
                        'f'    => $faces,     # faces  
+
};
−
                        'edges' => []            # edges on the plane
+
}   
−
 
+
} else { # ( ${$faces} <= -1 ) ## == no faces
−
                        # $DEBUG:TODO ADD rest of the coplanar edges to this list
+
$centerbsptree = {
−
                      };
+
'near'  => 0,            # empty
−
    }   
+
'far'  => 0,            # empty
−
  }
+
'f'    => []            # faces
−
  else {# ( ${$faces} <= -1 ) ## == no faces
+
#,'edges' => []            # edges
−
    $centerbsptree = { 'near'  => 0,            # empty
+
};
−
                      'far'  => 0,            # empty
+
}
−
                      'f'    => [],           # faces
+
return $centerbsptree;
−
                      'edges' => []            # edges
 
−
                    };
 
−
  }
 
−
 
 
−
#  return ($centerbsptree, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount);
 
−
  return $centerbsptree;
 
 
} # sub gen_centerbsptree
 
} # sub gen_centerbsptree
  
Line 1,795: Line 1,912:
 
# makes a facelist out of a centerBSP tree
 
# makes a facelist out of a centerBSP tree
 
#######################################################################
 
#######################################################################
−
sub centerbsptree2faceslist_new  (%)
+
sub centerbsptree2faceslist_new  (%) {
−
{
+
my ($centerbsptree) = @_;
−
  my ($centerbsptree) = @_;
+
die "centerbsptree2faceslist:bsptree" unless ( ref($centerbsptree) eq 'HASH' );
−
  die "centerbsptree2faceslist:bsptree" unless ( ref($centerbsptree) eq 'HASH' );
 
  
−
  my $faces     = [];
+
my $faces = [];
−
  my $faces_near = [];
+
my $faces_near = [];
−
  my $faces_far = [];
+
my $faces_far = [];
 
    
 
    
−
  if (ref($centerbsptree->{'near'}) eq "HASH"){
+
if (ref($centerbsptree->{'near'}) eq "HASH") {
−
    $faces_near = centerbsptree2faceslist_new($centerbsptree->{'near'});
+
$faces_near = centerbsptree2faceslist_new($centerbsptree->{'near'});
−
    if ($#{$faces_near} >= 0) {
+
if ($#{$faces_near} >= 0) {
−
      push( @{$faces}, @{$faces_near});
+
push( @{$faces}, @{$faces_near});
−
    }
+
}
−
  }
+
}
  
−
  if ($#{$centerbsptree->{'f'}} >= 0) {
+
if ($#{$centerbsptree->{'f'}} >= 0) {
−
    push( @{$faces}, @{$centerbsptree->{'f'}});
+
push( @{$faces}, @{$centerbsptree->{'f'}});
−
  }
+
}
  
−
  if (ref($centerbsptree->{'far'}) eq "HASH"){
+
if (ref($centerbsptree->{'far'}) eq "HASH") {
−
    $faces_far = centerbsptree2faceslist_new($centerbsptree->{'far'});
+
$faces_far = centerbsptree2faceslist_new($centerbsptree->{'far'});
−
   
+
if ($#{$faces_far} >= 0) {
−
    if ($#{$faces_far} >= 0) {
+
push( @{$faces}, @{$faces_far});
−
      push( @{$faces}, @{$faces_far});
+
}
−
    }
+
}
−
  }
+
−
 
+
return $faces;
−
  return $faces;
 
 
} # sub centerbsptree2faceslist
 
} # sub centerbsptree2faceslist
  
Line 1,830: Line 1,945:
 
# in $edges and not listed in $used_edges
 
# in $edges and not listed in $used_edges
 
#######################################################################
 
#######################################################################
−
sub first_unused_edges_in_faces(@%%)
+
sub first_unused_edges_in_faces (@%%) {
−
{
+
my ($faces, $edges, $used_edges) = @_;
−
  my ($faces, $edges, $used_edges) = @_;
+
die "first_unused_edges_in_faces:faces"      unless ( ref($faces)      eq 'ARRAY' );
−
  die "first_unused_edges_in_faces:faces"      unless ( ref($faces)      eq 'ARRAY' );
+
die "first_unused_edges_in_faces:edges"      unless ( ref($edges)      eq 'HASH'  );
−
  die "first_unused_edges_in_faces:edges"      unless ( ref($edges)      eq 'HASH'  );
+
die "first_unused_edges_in_faces:used_edges" unless ( ref($used_edges) eq 'HASH'  );
−
  die "first_unused_edges_in_faces:used_edges" unless ( ref($used_edges) eq 'HASH'  );
 
  
−
  my $first_unused_edges = {'all_edges_used' => 1};
+
my $first_unused_edges = {'all_edges_used' => 1};
 
   
 
   
 +
foreach my $face (@{$faces}) { # loop trough faces
 +
my $last_point_number = $#{$face->{'face'}};
 +
for (my $i = 0; $i <= $last_point_number; $i++) { # loop through the vertices of the face and check if there is an unused edge
 +
my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'});
 +
if ( (exists( $used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) || 
 +
(exists( $used_edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} )) ) {
 +
# print "Already used edge ... trying the next one.\n";
 +
next;
 +
} else {
 +
if  ( (exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) ||
 +
(exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} )) ) {
 +
$first_unused_edges = {
 +
'v1'  => $vertexnumbers1,
 +
'v2'  => $vertexnumbers2
 +
};
 +
last;
 +
} else {
 +
# print "Newly created edge ... trying the next one.\n";
 +
next;
 +
}
 +
}
 +
} # for
  
−
  foreach my $face (@{$faces}) # loop trough faces
+
} # foreach
−
  {
 
−
    my $last_point_number = $#{$face->{'face'}};
 
−
    for (my $i = 0; $i <= $last_point_number; $i++)                    # loop through the vertices of the face and check if there is an unused edge
 
−
    {
 
−
    my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'});
 
−
    if ( (exists( $used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) || 
 
−
          (exists( $used_edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} ))  )
 
−
      {
 
−
        # print "Already used edge ... trying the next one.\n";
 
−
        next;
 
−
      }
 
−
      else
 
−
      {
 
−
        if  ( (exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) ||
 
−
              (exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} ))  )
 
−
        {
 
−
          $first_unused_edges = { 'v1'  => $vertexnumbers1,
 
−
                                  'v2'  => $vertexnumbers2 };
 
−
          last;
 
−
        }
 
−
        else
 
−
        {
 
−
          # print "Newly created edge ... trying the next one.\n";
 
−
          next;
 
−
        }
 
−
      }
 
−
    } # for
 
−
 
 
−
  } # foreach
 
−
 
 
−
  return $first_unused_edges;
 
  
 +
return $first_unused_edges;
 
} # sub first_unused_edges_in_faces
 
} # sub first_unused_edges_in_faces
  
Line 1,879: Line 1,985:
 
# format: "pointnumber1-pointnumber2"
 
# format: "pointnumber1-pointnumber2"
 
#######################################################################
 
#######################################################################
−
sub get_edges(%)
+
sub get_edges(%) {
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
die "get_edges:objects"      unless ( ref($objects)      eq 'HASH' );
−
  die "get_edges:objects"      unless ( ref($objects)      eq 'HASH' );
+
my $edges = {};
−
  my $edges = {};
+
my $faces = [];
−
  my $faces = [];
+
foreach my $object (@{$objects->{'objects'}})  {
−
  foreach my $object (@{$objects->{'objects'}})  {
+
push(@{$faces}, @{$object->{'faces'}});
−
    push(@{$faces}, @{$object->{'faces'}});
+
}
−
  }
+
foreach my $face (@{$faces}) { # loop trough faces
−
  foreach my $face (@{$faces}) {# loop trough faces
+
my $last_point_number = $#{$face->{'face'}};
−
    my $last_point_number = $#{$face->{'face'}};
+
for (my $i = 0; $i <= $last_point_number; $i++)  {                # loop through the vertices of the face and check if there is an unused edge
−
    for (my $i = 0; $i <= $last_point_number; $i++)  {                # loop through the vertices of the face and check if there is an unused edge
+
my ($vertexnumbers1, $vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'});  
−
    my ($vertexnumbers1, $vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'});  
+
if ( exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} ) ||   
−
    if ( exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} ) ||   
+
exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} ) ) { # check for already used edges.
−
          exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} )   ) # check for already used edges.
+
# print "Already existing edge.. trying the next one.\n";
−
      {
+
next;
−
        # print "Already existing edge.. trying the next one.\n";
+
} else {
−
        next;
+
$edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;
−
      }
+
}
−
      else {
+
} # for
−
        $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;
+
} # foreach face
−
      }
+
return $edges;
−
    } # for
 
−
 
 
−
  } # foreach face
 
−
  return $edges;
 
 
} # sub get_edges
 
} # sub get_edges
  
Line 1,917: Line 2,019:
 
# Returns the midpoint of a face
 
# Returns the midpoint of a face
 
#######################################################################
 
#######################################################################
−
sub get_face_midpoint (@%) # fixed for objects
+
sub get_face_midpoint (@%) {  
−
{
+
my ($face, $vertices) = @_;
−
  my ($face, $vertices) = @_;
+
die "get_face_midpoint:face" unless (ref($face) eq 'ARRAY' );
−
  die "get_face_midpoint:face"     unless (ref($face)     eq 'ARRAY' );
+
die "get_face_midpoint:vertices" unless (ref($vertices) eq 'HASH'  );
−
  die "get_face_midpoint:vertices" unless (ref($vertices) eq 'HASH'  );
 
  
−
  my ($xd, $yd, $zd) = (0, 0, 0);
+
my ($xd, $yd, $zd) = (0, 0, 0);
−
  my $vertex_count  = 0;
+
my $vertex_count  = 0;
 
    
 
    
−
  foreach my $vertexnumbers (@{$face})
+
foreach my $vertexnumbers (@{$face}) {
−
  {
 
 
#  print "number=".$vertexnumbers->{'v'}."\n";                  # $DEBUG_testing
 
#  print "number=".$vertexnumbers->{'v'}."\n";                  # $DEBUG_testing
 
#  print "value=".$vertices->{$vertexnumbers->{'v'}}->[0]."\n"; # $DEBUG_testing
 
#  print "value=".$vertices->{$vertexnumbers->{'v'}}->[0]."\n"; # $DEBUG_testing
−
    $xd += $vertices->{$vertexnumbers->{'v'}}->[0];
+
$xd += $vertices->{$vertexnumbers->{'v'}}->[0];
−
    $yd += $vertices->{$vertexnumbers->{'v'}}->[1];
+
$yd += $vertices->{$vertexnumbers->{'v'}}->[1];
−
    $zd += $vertices->{$vertexnumbers->{'v'}}->[2];
+
$zd += $vertices->{$vertexnumbers->{'v'}}->[2];
−
    ++$vertex_count;
+
++$vertex_count;
−
  }
+
}
−
  #my $vertex_count = ($#{$face} + 1);
+
#my $vertex_count = ($#{$face} + 1);
  
−
  return [ $xd / $vertex_count,
+
return [
−
          $yd / $vertex_count,
+
$xd / $vertex_count,
−
          $zd / $vertex_count ];
+
$yd / $vertex_count,
 +
$zd / $vertex_count
 +
];
 
} # sub get_face_midpoint
 
} # sub get_face_midpoint
  
Line 1,945: Line 2,047:
 
# Returns the distance from the center to the midpoint of a face
 
# Returns the distance from the center to the midpoint of a face
 
#######################################################################
 
#######################################################################
−
sub get_distance_to_midpoint (@%) # fixed for objects
+
sub get_distance_to_midpoint (@%) {
−
{
+
my ($face, $vertices) = @_;
−
  my ($face, $vertices) = @_;
+
die "get_distance_to_midpoint:face"    unless (ref($face)    eq 'ARRAY' );
−
  die "get_distance_to_midpoint:face"    unless (ref($face)    eq 'ARRAY' );
+
die "get_distance_to_midpoint:vertices" unless (ref($vertices) eq 'HASH'  );
−
  die "get_distance_to_midpoint:vertices" unless (ref($vertices) eq 'HASH'  );
 
  
−
  my $midpoint = get_face_midpoint($face, $vertices);
+
my $midpoint = get_face_midpoint($face, $vertices);
−
  my $distance = sqrt(($midpoint->[0])**2 +
+
my $distance = sqrt(
−
                      ($midpoint->[1])**2 +
+
($midpoint->[0])**2 +
−
                      ($midpoint->[2])**2 );     # distance center->midpoint
+
($midpoint->[1])**2 +
−
  return $distance;
+
($midpoint->[2])**2
 +
); # distance center->midpoint
 +
return $distance;
 
} # sub get_distance_to_midpoint
 
} # sub get_distance_to_midpoint
  
Line 1,961: Line 2,064:
 
# Sort faceslist by face-midpoint (z sorting)
 
# Sort faceslist by face-midpoint (z sorting)
 
#######################################################################
 
#######################################################################
−
sub sort_by_facemidpoint (%$) # fixed for objects
+
sub sort_by_facemidpoint (%$) {  
−
{
+
my ($objects, $far_to_near) = @_;
−
  my ($objects, $far_to_near) = @_;
+
die "sort_by_facemidpoint:objects" unless (ref($objects) eq 'HASH'  );
−
  die "sort_by_facemidpoint:objects" unless (ref($objects) eq 'HASH'  );
+
my $vertices = $objects->{'vertices'};
−
  my $vertices = $objects->{'vertices'};
+
foreach my $object (@{$objects->{'objects'}})  {
−
  foreach my $object (@{$objects->{'objects'}})  {
+
if ($far_to_near) {
−
    if ($far_to_near) {
+
@{ $object->{'faces'} }
−
      @{ $object->{'faces'} }
+
= sort {
−
        = sort { get_distance_to_midpoint($b->{'face'},$vertices)
+
get_distance_to_midpoint($b->{'face'},$vertices)
−
                <=>
+
<=>
−
                get_distance_to_midpoint($a->{'face'},$vertices) }  @{ $object->{'faces'} };
+
get_distance_to_midpoint($a->{'face'},$vertices)
−
    }
+
}  @{$object->{'faces'}};
−
    else {  # near_to_far
+
} else {  # near_to_far
−
      @{ $object->{'faces'} }
+
@{ $object->{'faces'} }
−
        = sort { get_distance_to_midpoint($a->{'face'},$vertices)
+
= sort {
−
                <=>
+
get_distance_to_midpoint($a->{'face'},$vertices)
−
                get_distance_to_midpoint($b->{'face'},$vertices) } @{ $object->{'faces'} };
+
<=>
−
    } # if
+
get_distance_to_midpoint($b->{'face'},$vertices)
−
  } # foreach object
+
} @{$object->{'faces'}};
 +
} # if
 +
} # foreach object
 
} # sub sort_by_facemidpoint
 
} # sub sort_by_facemidpoint
 
#----------------------------------------------------------------------
 
#----------------------------------------------------------------------
Line 1,992: Line 2,097:
 
# this function requires to have a maximum of 1 (one) existing entries in the hash
 
# this function requires to have a maximum of 1 (one) existing entries in the hash
 
#######################################################################
 
#######################################################################
−
sub data_exists (@%)
+
sub data_exists (@%) {
−
{
+
my ($data, $datahash) = @_;
−
  my ($data, $datahash) = @_;
+
die "data_exists:data"    unless (ref($data)    eq 'ARRAY' );
−
  die "data_exists:data"    unless (ref($data)    eq 'ARRAY' );
+
die "data_exists:datahash" unless (ref($datahash) eq 'HASH'  );
−
  die "data_exists:datahash" unless (ref($datahash) eq 'HASH'  );
 
  
−
  my $existing = 0;
+
my $existing = 0;
−
  #foreach my $dummy_data_key (keys %{$datahash}) {    # slower than "while ..each" ?
+
#foreach my $dummy_data_key (keys %{$datahash}) {    # slower than "while ..each" ?
−
  #  my $dummy_data = $datahash->{$dummy_data_key};    # slower than "while ..each" ?
+
#  my $dummy_data = $datahash->{$dummy_data_key};    # slower than "while ..each" ?
  
−
  my $dummy_data_key;
+
my $dummy_data_key;
−
  my $dummy_data;
+
my $dummy_data;
−
  while (($dummy_data_key, $dummy_data) = each %{$datahash}) {
+
while (($dummy_data_key, $dummy_data) = each %{$datahash}) {
−
    for (my $i = 0; $i <= $#{$dummy_data}; ++$i) {
+
for (my $i = 0; $i <= $#{$dummy_data}; ++$i) {
−
      if ($dummy_data->[$i] != $data->[$i])
+
if ($dummy_data->[$i] != $data->[$i]) {
−
        { $existing = 0; last; }                # this entry isn't equal, skipping the rest of this entry
+
$existing = 0; last; # this entry isn't equal, skipping the rest of this entry
−
      else
+
} else {
−
        { $existing = 1; }
+
$existing = 1;
−
    } #for
+
}
 +
} #for
  
−
    if ($existing) {
+
if ($existing) {
−
      return [$dummy_data_key, $dummy_data];    # found a match -> returning the key+entry
+
return [$dummy_data_key, $dummy_data];    # found a match -> returning the key+entry
−
    }
+
}
−
  #} #foreach dummy_data_key
+
#} #foreach dummy_data_key
−
  } #while
+
} #while
−
  return $existing;
+
return $existing;
 
} # sub data_exists
 
} # sub data_exists
  
Line 2,023: Line 2,128:
 
# Remove all unneeded vertices/uvdata/normals and remake the index
 
# Remove all unneeded vertices/uvdata/normals and remake the index
 
#######################################################################
 
#######################################################################
−
sub clean_data (%)
+
sub clean_data (%) {
 +
my ($objects) = @_;
 +
die "clean_data:objects" unless (ref($objects) eq 'HASH'  );
  
−
{
+
my $new_vertices = {};
−
  my ($objects) = @_;
+
my $new_uvdata = {};
−
  die "clean_data:objects" unless (ref($objects) eq 'HASH'  );
+
my $new_vndata = {};
  
−
  foreach my $object (@{$objects->{'objects'}}) {
+
my $new_vert_indices = {}; #relationship old/new idex of vert data (old=key)
 +
my $new_uv_indices = {}; #relationship old/new idex of uv data (old=key)
 +
my $new_vn_indices = {}; #relationship old/new idex of vn data (old=key)
  
−
    my $new_vertices    = {};
+
#make new list of used vertices/uvdata (+ add new index)
−
    my $new_uvdata      = {};
+
my $new_vert_count = 0;
−
    my $new_vndata      = {};
+
my $new_uv_count = 0;
 +
my $new_vn_count = 0;
 +
 +
foreach my $object (@{$objects->{'objects'}})  {
  
−
    my $new_vert_indices = {}; #relationship old/new idex of vert data (old=key)
+
print "  Creating new list of vertices/uvdata/normals ... \n";
−
    my $new_uv_indices  = {}; #relationship old/new idex of uv data (old=key)
+
my $face = {};
−
    my $new_vn_indices  = {}; #relationship old/new idex of vn data (old=key)
 
  
 +
my $vertexnumbers = {};
 +
my ($v, $vt, $vn);
 +
my ($vertex_v, $vertex_vt, $vertex_vn);
 +
my $exists = [];
  
−
    #make new list of used vertices/uvdata (+ add new index)
+
foreach $face (@{ $object->{'faces'} }) {
−
    my $new_vert_count = 0;
+
# ->moved var defs to the top
−
    my $new_uv_count  = 0;
+
foreach $vertexnumbers (@{ $face->{'face'} }) {
−
    my $new_vn_count  = 0;
+
$v  = $vertexnumbers->{'v'};
 +
$vt = $vertexnumbers->{'vt'};
 +
$vn = $vertexnumbers->{'vn'};
  
−
    print " Creating new list of vertices/uvdata/normals ... \n";
+
$vertex_v = $objects->{'vertices'}->{$v};
−
    my $face = {};
+
$vertex_vt = $objects->{'uvdata'}->{$vt};
 +
$vertex_vn = $objects->{'vndata'}->{$vn};
  
−
      my $vertexnumbers = {};
+
### vertex data ###
−
      my $v;
+
$exists = data_exists($vertex_v, $new_vertices);
−
      my $vt;
+
if (! $exists) {
−
      my $vn;
+
++$new_vert_count;
−
      my $vertex_v;
+
$new_vertices->{$new_vert_count} = $vertex_v;       # add a new index
−
      my $vertex_vt;
+
$new_vert_indices->{$v}          = $new_vert_count; # add a new index
−
      my $vertex_vn;
+
} else {
−
      my $exists = [];
+
$new_vert_indices->{$v} = $exists->[0];             # relate the old index with the new existing one
 +
}     
  
−
    foreach $face (@{ $object->{'faces'} }) {
+
### UV data ###
−
      # ->moved var defs to the top
+
$exists = data_exists($vertex_vt, $new_uvdata);
−
      foreach $vertexnumbers (@{ $face->{'face'} }) {
+
if (! $exists) {
−
        $v  = $vertexnumbers->{'v'};
+
++$new_uv_count;   
−
        $vt = $vertexnumbers->{'vt'};
+
$new_uvdata->{$new_uv_count} = $vertex_vt;         # add a new index
−
        $vn = $vertexnumbers->{'vn'};
+
$new_uv_indices->{$vt}      = $new_uv_count;      # add a new index
 +
} else {
 +
$new_uv_indices->{$vt} = $exists->[0];              # relate the old index with the new existing one
 +
}
  
−
        $vertex_v  = $objects->{'vertices'}->{$v};
+
### normal data ###
−
        $vertex_vt = $objects->{'uvdata'}->{$vt};
+
$exists = data_exists($vertex_vn, $new_vndata);
−
        $vertex_vn = $objects->{'vndata'}->{$vn};
+
if (! $exists) {
 +
++$new_vn_count;
 +
$new_vndata->{$new_vn_count} = $vertex_vn;         # add a new index
 +
$new_vn_indices->{$vn}      = $new_vn_count;      # add a new index
 +
} else {
 +
$new_vn_indices->{$vn} = $exists->[0];              # relate the old index with the new existing one
 +
}
 +
} #foreach vertexnumers
 +
} #foreach face
 +
print "  ...done.\n";
  
−
        ### vertex data ###
+
print "  Replace faces ...\n";
−
        $exists = data_exists($vertex_v, $new_vertices);
+
#loop through faces and replace the indices of vertices/uvdata/normals with the new ones
−
        if (! $exists) {
+
$face = {};
−
          ++$new_vert_count;
+
foreach $face (@{ $object->{'faces'} }) {
−
          $new_vertices->{$new_vert_count} = $vertex_v;      # add a new index
+
for (my $i=0; $i<$#{$face->{'face'}}; $i++) {
−
          $new_vert_indices->{$v}          = $new_vert_count; # add a new index
+
$face->{'face'}->[$i]->{'v' } = $new_vert_indices->{$face->{'face'}->[$i]->{'v'}};
−
        }
+
$face->{'face'}->[$i]->{'vt'} = $new_uv_indices->{$face->{'face'}->[$i]->{'vt'}};
−
        else {
+
$face->{'face'}->[$i]->{'vn'} = $new_vn_indices->{$face->{'face'}->[$i]->{'vn'}};
−
          $new_vert_indices->{$v} = $exists->[0];            # relate the old index with the new existing one
+
} # for $i
−
        }     
+
} # foreach face
−
        ### UV data ###
+
print "  ...object done.\n";
−
        $exists = data_exists($vertex_vt, $new_uvdata);
+
} # foreach object
−
        if (! $exists) {
+
print "  ...done.\n";
−
          ++$new_uv_count;   
+
$objects->{'vertices'} = $new_vertices;
−
          $new_uvdata->{$new_uv_count} = $vertex_vt;          # add a new index
+
$objects->{'uvdata'} = $new_uvdata;
−
          $new_uv_indices->{$vt}      = $new_uv_count;      # add a new index
+
$objects->{'vndata'} = $new_vndata;
−
        }
+
$objects->{'vert_counter'} = $new_vert_count;
−
        else {
+
$objects->{'uv_counter'} = $new_uv_count;
−
          $new_uv_indices->{$vt} = $exists->[0];              # relate the old index with the new existing one
+
$objects->{'norm_counter'} = $new_vn_count;
−
        }
+
−
        ### normal data ###
 
−
        $exists = data_exists($vertex_vn, $new_vndata);
 
−
        if (! $exists) {
 
−
          ++$new_vn_count;
 
−
          $new_vndata->{$new_vn_count} = $vertex_vn;          # add a new index
 
−
          $new_vn_indices->{$vn}      = $new_vn_count;      # add a new index
 
−
        }
 
−
        else {
 
−
          $new_vn_indices->{$vn} = $exists->[0];              # relate the old index with the new existing one
 
−
        }
 
−
        ######
 
−
      } #foreach vertexnumers
 
−
    } #foreach face
 
−
    print "  ...done.\n";
 
−
 
 
−
    print "  Replace faces ...\n";
 
−
    #loop through faces and replace the indices of vertices/uvdata/normals with the new ones
 
−
### BEGIN OLD
 
−
#    my $new_faces = [];
 
−
#    foreach my $face (@{ $object->{'faces'} }) {
 
−
#      my $new_face = [];
 
−
#      foreach my $vertexnumbers (@{$face->{'face'}}) {
 
−
#        push(@{$new_face}, {'v'  => $new_vert_indices->{$vertexnumbers->{'v'}},
 
−
#                            'vt' => $new_uv_indices->{$vertexnumbers->{'vt'}},
 
−
#                            'vn' => $new_vn_indices->{$vertexnumbers->{'vn'}}
 
−
#                          }
 
−
#            )
 
−
#      } # foreach vertexnumbers
 
−
#      push(@{$new_faces},[@{$new_face}]);
 
−
#    } # foreach face
 
−
#    $object->{'faces'} = $new_faces;
 
−
### END OLD
 
−
    $face = {};
 
−
    foreach $face (@{ $object->{'faces'} }) {
 
−
      for (my $i=0; $i<=$#{$face->{'face'}}; $i++) {
 
−
        $face->{'face'}->[$i]->{'v' }=$new_vert_indices->{$face->{'face'}->[$i]->{'v'}};
 
−
        $face->{'face'}->[$i]->{'vt'}=$new_vert_indices->{$face->{'face'}->[$i]->{'vt'}};
 
−
        $face->{'face'}->[$i]->{'vn'}=$new_vert_indices->{$face->{'face'}->[$i]->{'vn'}};
 
−
      } # for $i
 
−
    } # foreach face
 
−
    print "  ...object done.\n";
 
−
  } # foreach object
 
−
  print "  ...done.\n";
 
 
} # sub clean_data
 
} # sub clean_data
  
Line 2,137: Line 2,225:
 
# Remove every face that is clearly pointing the other way ;-)
 
# Remove every face that is clearly pointing the other way ;-)
 
#######################################################################
 
#######################################################################
−
sub delete_backfaces (%) # fixed for objects
+
sub delete_backfaces (%) { # fixed for objects
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
die "delete_backfaces:objects" unless (ref($objects) eq 'HASH'  );
−
  die "delete_backfaces:objects" unless (ref($objects) eq 'HASH'  );
+
my $object = {};
−
  my $object = {};
+
foreach $object (@{ $objects->{'objects'} }) {
−
  foreach $object (@{ $objects->{'objects'} }) {
+
my $new_faces  = [];
−
    my $new_faces  = [];
+
my $zero_point = [0, 0, 0];
−
    my $zero_point = [0, 0, 0];
+
foreach my $face (@{ $object->{'faces'} }) {
−
    foreach my $face (@{ $object->{'faces'} }) {
+
#print Dumper($face->{'face'}); #$DEBUG:testing
−
      #print Dumper($face->{'face'}); #$DEBUG:testing
+
my $plane = face2plane($face->{'face'}, $objects->{'vertices'} );  
−
      my $plane = face2plane($face->{'face'}, $objects->{'vertices'} );  
+
my $side  = classify_point_by_plane($plane, $zero_point);
−
      my $side  = classify_point_by_plane($plane, $zero_point);
+
if ($side > 0) {
−
      if ($side > 0) {
+
push(@{$new_faces},$face);
−
        push(@{$new_faces},$face);
+
}
−
      }
+
# else {
−
#     else {
+
# print "Removed face".$face."\n";
−
#       print "Removed face".$face."\n";
+
# }
−
#     }
+
} # foreach face
−
    } # foreach face
+
$object->{'faces'} = $new_faces;
−
    $object->{'faces'} = $new_faces;
+
} # foreach object
−
  } # foreach object
 
 
} # sub delete_backfaces
 
} # sub delete_backfaces
  
Line 2,170: Line 2,257:
 
# Make all faces in _all objects_  triangles
 
# Make all faces in _all objects_  triangles
 
#######################################################################
 
#######################################################################
−
sub triangulate_objects (%) # fixed for objects
+
sub triangulate_objects (%) {
−
{
+
my ($objects) = @_;
−
  my ($objects) = @_;
+
die "triangulate_objects:objects" unless (ref($objects) eq 'HASH'  );
−
  die "triangulate_objects:objects" unless (ref($objects) eq 'HASH'  );
 
  
−
  foreach my $object (@{ $objects->{'objects'} }) {
+
foreach my $object (@{ $objects->{'objects'} }) {
−
    triangulate_object($object);
+
triangulate_object($object);
−
  } # foreach object
+
} # foreach object
 
} # sub triangulate_objects
 
} # sub triangulate_objects
  
Line 2,183: Line 2,269:
 
# Make all faces in _one object_  triangles
 
# Make all faces in _one object_  triangles
 
#######################################################################
 
#######################################################################
−
sub triangulate_object (%) # fixed for objects
+
sub triangulate_object (%) {
−
{
+
my ($object) = @_;
−
  my ($object) = @_;
+
die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
−
  die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
+
my $new_faces = [];
−
  my $new_faces = [];
+
foreach my $face (@{$object->{'faces'}}) {
−
  foreach my $face (@{$object->{'faces'}}) {
+
push(@{$new_faces},@{triangulate_face($face)});
−
    push(@{$new_faces},@{triangulate_face($face)});
+
} # foreach face
−
  } # foreach face
+
$object->{'faces'} = $new_faces;
−
  $object->{'faces'} = $new_faces;
 
 
} # sub triangulate_objects
 
} # sub triangulate_objects
  
Line 2,197: Line 2,282:
 
# Make face into triangles  
 
# Make face into triangles  
 
#######################################################################
 
#######################################################################
−
sub triangulate_face (%)
+
sub triangulate_face (%) {
−
{
+
my ($face) = @_;
−
  my ($face) = @_;
+
my $new_faces = [];
 +
my $vertexcount  = @{$face->{'face'}};          # get number of vertices
 +
my $first = 0;                        # store first
 +
my $last = $first + $vertexcount - 1; # store last
  
−
  my $new_faces = [];
+
for (my $v_index = 0; $v_index < $vertexcount; $v_index++) { # loop through face
−
 
+
SWITCH: {
−
  my $vertexcount  = @{$face->{'face'}};          # get number of vertices
+
if ($v_index == $last) {              ## if last vertex
−
  my $first = 0;                        # store first
+
push(@{$new_faces},{
−
  my $last  = $first + $vertexcount -1; # store last
+
'face'=> [
−
 
+
$face->{'face'}->[$v_index], #1
−
  for (my $v_index = 0; $v_index < $vertexcount; $v_index++) { # loop through face
+
$face->{'face'}->[$last], #next
−
    SWITCH:
+
$face->{'face'}->[$first+1] #prev
−
    {
+
],
−
      if ($v_index == $last) {              ## if last vertex
+
'mtl' => $face->{'mtl'}
−
        push(@{$new_faces},{'face'=> [$face->{'face'}->[$v_index],     #1
+
}
−
                                      $face->{'face'}->[$last],         #next
+
);  
−
                                      $face->{'face'}->[$first+1] ],   #prev
+
last SWITCH;
−
                            'mtl' => $face->{'mtl'}
+
}
−
                          }
+
if ($v_index == $first) {        ## if first vertex
−
        );  
+
push(@{$new_faces},{
−
    last SWITCH;
+
'face'=> [
−
      }
+
$face->{'face'}->[$v_index], #1
−
      if ($v_index == $first) {        ## if first vertex
+
$face->{'face'}->[$v_index+1], #next
−
      push(@{$new_faces},{'face'=> [$face->{'face'}->[$v_index] ,   #1
+
$face->{'face'}->[$last] #prev
−
                                      $face->{'face'}->[$v_index+1],   #next
+
],
−
                                      $face->{'face'}->[$last]     ], #prev
+
'mtl' => $face->{'mtl'}
−
                            'mtl' => $face->{'mtl'}
+
}
−
                            }
+
);
−
        );
+
last SWITCH;
−
      last SWITCH;
+
}
−
      }
+
# else                      ## if anything else
−
      # else                      ## if anything else
+
push(@{$new_faces},{
−
      push(@{$new_faces},{'face' => [$face->{'face'}->[$v_index],     #1
+
'face' => [
−
                                    $face->{'face'}->[$v_index+1],   #next
+
$face->{'face'}->[$v_index], #1
−
                                    $face->{'face'}->[$last]     ], #prev
+
$face->{'face'}->[$v_index+1], #next
−
                          'mtl' => $face->{'mtl'}
+
$face->{'face'}->[$last] #prev
−
                        }   
+
],
−
      );
+
'mtl' => $face->{'mtl'}
−
    } #SWITCH
+
}   
−
  } #for
+
);
−
  return $new_faces ;
+
} #SWITCH
 +
} #for
 +
return $new_faces ;
 
} # triangulate_face
 
} # triangulate_face
 
#-----------------------------------------------------------------------
 
#-----------------------------------------------------------------------
Line 2,246: Line 2,336:
 
# BEGIN TRANSFORM
 
# BEGIN TRANSFORM
 
#-----------------------------------------------------------------------
 
#-----------------------------------------------------------------------
−
 
 
#######################################################################
 
#######################################################################
 
# Transform objects
 
# Transform objects
Line 2,261: Line 2,350:
 
#  s0.5 s2
 
#  s0.5 s2
 
#######################################################################
 
#######################################################################
−
sub transform_objects(%$)
+
sub transform_objects(%$) {
−
{
+
my ($objects, $transform_commands) = @_;
−
  my ($objects, $transform_commands) = @_;
+
die "transform_objects:objects" unless ( ref($objects) eq 'HASH' );
−
  die "transform_objects:objects" unless ( ref($objects) eq 'HASH' );
+
my $commands = [];
−
  my $commands = [];
+
print "Transform input: '".$transform_commands."'\n";
−
  print "Transform input: '".$transform_commands."'\n";
+
@{$commands} = ($transform_commands =~ /\s*([rs][xyz]*[\d\.]+)\s*/g);
−
  @{$commands} = ($transform_commands =~ /\s*([rs][xyz]*[\d\.]+)\s*/g);
+
foreach my $transform_command (@{$commands}) {
−
  foreach my $transform_command (@{$commands}) {
+
my ($type ,$axis, $value) = ($transform_command =~ m/([rs])([xyz]*)([\d\.]+)/);
−
    my ($type ,$axis, $value) = ($transform_command =~ m/([rs])([xyz]*)([\d\.]+)/);
+
print "Type='".$type."' Axis='".$axis."' Value='".$value."'\n";
−
    print "Type='".$type."' Axis='".$axis."' Value='".$value."'\n";
+
SWITCH: { # TYPE
−
    SWITCH: { # TYPE
+
if ($type eq "r") { # ROTATE
−
      if ($type eq "r") { # ROTATE
+
# $DEBUG:TODO rotate around axis $value degrees
−
        #rotate around axis $value degrees
+
last SWITCH;
−
        last SWITCH;
+
}
−
      }
+
if ($type eq "s") { # SCALE
−
      if ($type eq "s") { # SCALE
+
# $DEBUG:TODO scale along axis (or global if empty) factor
−
        #scale along axis (or global if empty) factor
+
last SWITCH;
−
        last SWITCH;
+
}
−
      }
+
#else
−
      #else
+
print "Unknown command: '".$transform_command."'! Ignored.\n";
−
      print "Unknown command: '".$transform_command."'! Ignored.\n";
+
} # SWITCH TYPE
−
    } # SWITCH TYPE
+
} # foreach command
−
  } # foreach command
 
 
}
 
}
  
Line 2,289: Line 2,377:
 
# Scale objects
 
# Scale objects
 
#######################################################################
 
#######################################################################
−
sub transform_scale_objects(%$$)
+
sub transform_scale_objects(%$$) { #$DEBUG:TODO not done
−
{
+
my ($objects, $axis, $value) = @_;
−
  my ($objects, $axis, $value) = @_;
+
die "transform_scale_objects:objects" unless ( ref($objects) eq 'HASH' );
−
  die "transform_scale_objects:objects" unless ( ref($objects) eq 'HASH' );
+
my $scaling = [0,0,0];
−
  my $scaling = [0,0,0];
+
my $axislist = [];
−
  my $axislist = [];
+
@{$axislist} = split(//, $axis);
−
  @{$axislist} = split(//, $axis);
+
#for (my $single_axis)character
−
  #for (my $single_axis)character
+
foreach my $single_axis (@{$axislist}) {
−
  foreach my $single_axis (@{$axislist}) {
+
SWITCH: { # AXIS
−
    SWITCH: { # AXIS
+
if ($single_axis eq '') { $scaling = [1,1,1]; last SWITCH; }
−
      if ($single_axis eq '') { $scaling     = [1,1,1]; last SWITCH; }
+
if ($single_axis eq 'x') { $scaling->[0] = 1; last SWITCH; }
−
      if ($single_axis eq 'x') { $scaling->[0] = 1;       last SWITCH; }
+
if ($single_axis eq 'y') { $scaling->[1] = 1; last SWITCH; }
−
      if ($single_axis eq 'y') { $scaling->[1] = 1;       last SWITCH; }
+
if ($single_axis eq 'z') { $scaling->[2] = 1; last SWITCH; }
−
      if ($single_axis eq 'z') { $scaling->[2] = 1;       last SWITCH; }
+
#else
−
      #else
+
print "Bad axis: '".$axis."'! Ignored.\n";
−
      print "Bad axis: '".$axis."'! Ignored.\n";
+
} # SWITCH AXIS
−
    } # SWITCH AXIS
+
}
−
  }
+
# foreach vertice (verticelist) {
−
  # foreach vertice (verticelist) {
+
# scale vertices
−
  # scale vertices
+
# } # foreach vertice
−
  # } # foreach vertice
+
# if  ((!$scaling->[0]) || (!$scaling->[1]) || (!$scaling->[2])) {
−
  # if  ((!$scaling->[0]) || (!$scaling->[1]) || (!$scaling->[2])) {
+
## scale normals too
−
  ## scale normals too
+
#}
−
  #}
 
 
}
 
}
  
Line 2,324: Line 2,411:
 
# Write/Export to new obj file
 
# Write/Export to new obj file
 
#######################################################################
 
#######################################################################
−
sub write_to_obj ($%)
+
sub write_to_obj ($%) {
−
{
+
my ($filename, $objects) = @_;
−
  my ($filename, $objects) = @_;
+
die "write_to_obj:objects" unless ( ref($objects) eq 'HASH' );
−
  die "write_to_obj:objects" unless ( ref($objects) eq 'HASH' );
 
−
 
 
−
  my $write_vt = 1; #write uv data if it exists
 
−
  my $write_vn = 1; #write normals if they exists # $DEBUG:TODO calulate normals
 
−
 
 
−
  print "Opening file '$filename' for writing ...\n";
 
−
  open(OBJ_OUT, "> $filename") || die "failed to open $filename\n";
 
−
  print "...Done.\n";
 
  
−
  print "Writing Header ...\n";
+
my $write_vt = 1; #write uv data if it exists
−
  printf OBJ_OUT "# Generated with obj_conv.pl version %s \n", $VERSION;  
+
my $write_vn = 1; #write normals if they exists # $DEBUG:TODO calulate normals
−
  #printf OBJ_OUT "#  - Split by BSP-tree\n" if ($split_bsp);  
 
−
  #printf OBJ_OUT "# - Split by edges\n"    if ($split_by_view);
 
−
  #printf OBJ_OUT "#  - Triangulated\n"      if ($triangulate_objects);
 
  
 +
print "Opening file '$filename' for writing ...\n";
 +
open(OBJ_OUT, "> ".$filename) || die "failed to open $filename\n";
 +
print "...Done.\n";
  
−
  printf OBJ_OUT "mtllib %s\n", $objects->{'mtllib'};
+
print "Writing Header ...\n";
−
  print "...Done.\n";
+
printf OBJ_OUT "# Generated with obj_conv.pl version %s \n", $VERSION;
 +
#printf OBJ_OUT "#  - Split by BSP-tree\n" if ($split_bsp);
 +
#printf OBJ_OUT "#  - Split by edges\n"    if ($split_by_view);  
 +
#printf OBJ_OUT "#  - Triangulated\n"     if ($triangulate_objects);  
  
−
  print "Writing vertices ...\n";
+
printf OBJ_OUT "mtllib %s\n", $objects->{'mtllib'};
−
  my $dummy_index = '';
+
print "...Done.\n";
−
  foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vertices'}}))
 
−
  {
 
−
    printf OBJ_OUT "v %f %f %f\n", $objects->{'vertices'}->{$dummy_index}->[0],
 
−
                                  $objects->{'vertices'}->{$dummy_index}->[1],
 
−
                                  $objects->{'vertices'}->{$dummy_index}->[2];
 
−
  }
 
−
  print "...Done.\n";
 
  
−
  #if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}   # $DEBUG:TODO check if the data is empty
+
print "Writing vertices ...\n";
−
  #if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}   # $DEBUG:TODO check if the data is empty
+
my $dummy_index = '';
 +
foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vertices'}})) {
 +
printf OBJ_OUT "v %f %f %f\n",
 +
$objects->{'vertices'}->{$dummy_index}->[0],
 +
$objects->{'vertices'}->{$dummy_index}->[1],
 +
$objects->{'vertices'}->{$dummy_index}->[2];
 +
}
 +
print "...Done.\n";
  
−
  print "Writing uv data ...\n";
+
#if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}  # $DEBUG:TODO check if the data is empty
−
  foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'uvdata'}})) {
+
#if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}  # $DEBUG:TODO check if the data is empty
−
    printf OBJ_OUT "vt %f %f\n", $objects->{'uvdata'}->{$dummy_index}->[0],
 
−
                                $objects->{'uvdata'}->{$dummy_index}->[1];
 
−
  }
 
−
   print "...Done.\n";
 
  
−
  print "Writing normal data ...\n";
+
print "Writing uv data ...\n";
−
  foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vndata'}})) {
+
foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'uvdata'}})) {
−
    printf OBJ_OUT "vn %f %f %f\n", $objects->{'vndata'}->{$dummy_index}->[0],
+
printf OBJ_OUT "vt %f %f\n",
−
                                    $objects->{'vndata'}->{$dummy_index}->[1],
+
$objects->{'uvdata'}->{$dummy_index}->[0],
−
                                    $objects->{'vndata'}->{$dummy_index}->[2];
+
$objects->{'uvdata'}->{$dummy_index}->[1];
−
  }
+
}
−
  print "...Done.\n";
+
print "...Done.\n";
  
−
  my $object = {};
+
print "Writing normal data ...\n";
−
  foreach $object (@{$objects->{'objects'}})  {
+
foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vndata'}})) {
 +
printf OBJ_OUT "vn %f %f %f\n",
 +
$objects->{'vndata'}->{$dummy_index}->[0],
 +
$objects->{'vndata'}->{$dummy_index}->[1],
 +
$objects->{'vndata'}->{$dummy_index}->[2];
 +
}
 +
print "...Done.\n";
  
−
    print "Writing group+usemtl ...\n";
+
my $object = {};
−
    if ((! exists( $object->{'objectname'})) || ($object->{'objectname'} eq "")){
+
foreach $object (@{$objects->{'objects'}})  {
−
      printf OBJ_OUT "#o\n"  
+
print "Writing group+usemtl ...\n";
−
    }
+
if ((! exists( $object->{'objectname'})) || ($object->{'objectname'} eq "")) {
−
    else {
+
printf OBJ_OUT "#o\n"  
−
      printf OBJ_OUT "o %s\n", $object->{'objectname'};
+
} else {
−
    }
+
printf OBJ_OUT "o %s\n", $object->{'objectname'};
−
    if ((! exists( $object->{'groupname'})) || ($object->{'groupname'} eq "")){
+
}
−
      printf OBJ_OUT "#g\n"  
+
if ((! exists( $object->{'groupname'})) || ($object->{'groupname'} eq "")) {
−
    }
+
printf OBJ_OUT "#g\n"  
−
    else{
+
} else {
−
      printf OBJ_OUT "g %s\n", $object->{'groupname'};
+
printf OBJ_OUT "g %s\n", $object->{'groupname'};
−
    }
+
}
−
    if ((! exists( $object->{'mtlname'})) ||  ($object->{'mtlname'} eq "")){
+
if ((! exists( $object->{'mtlname'})) ||  ($object->{'mtlname'} eq "")) {
−
      printf OBJ_OUT "#usemtl\n"  
+
printf OBJ_OUT "#usemtl\n"  
−
    }
+
} else {
−
    else{
+
printf OBJ_OUT "usemtl %s\n", $object->{'mtlname'};
−
      printf OBJ_OUT "usemtl %s\n", $object->{'mtlname'};
+
}
−
    }
+
print "...Done.\n";
  
−
    print "...Done.\n";
+
print "Writing faces ...\n";
 +
my $face = {};
 +
my $vertexnumbers = {};
 +
foreach $face (@{$object->{'faces'}}) {
 +
print "face=". ($face->{'face'}) ."\n" if ($verbose ==1);
 +
printf OBJ_OUT "f";
 +
foreach $vertexnumbers (@{$face->{'face'}}) {
 +
print "vertnr=".$vertexnumbers."\n" if ($verbose == 1);
 +
printf OBJ_OUT " %i", $vertexnumbers->{'v'};
 +
printf OBJ_OUT "\/";
 +
printf OBJ_OUT "%i",  $vertexnumbers->{'vt'} if (($write_vt) && (exists $vertexnumbers->{'vt'}));
 +
printf OBJ_OUT "\/";
 +
printf OBJ_OUT "%i",  $vertexnumbers->{'vn'} if (($write_vn) && (exists $vertexnumbers->{'vn'}));
 +
} # foreach vertexnumbers
 +
#printf OBJ_OUT "\n# dist %f",  get_distance_to_midpoint($face->{'face'}, $objects->{'vertices'}); # $DEBUG:testing
 +
printf OBJ_OUT "\n";
 +
} # foreach face
 +
} # foreach object
  
−
    print "Writing faces ...\n";
+
printf OBJ_OUT "# EOF\n";  
−
    my $face = {};
+
close(OBJ_OUT);
−
    my $vertexnumbers = {};
+
print "...Done.\n";
−
    foreach $face (@{$object->{'faces'}}) {
 
−
      print "face=". ($face->{'face'}) ."\n" if ($verbose ==1);
 
−
      printf OBJ_OUT "f";
 
−
      foreach $vertexnumbers (@{$face->{'face'}}) {
 
−
        print "vertnr=".$vertexnumbers."\n" if ($verbose == 1);
 
−
        printf OBJ_OUT " %i", $vertexnumbers->{'v'};
 
−
        printf OBJ_OUT "\/";
 
−
        printf OBJ_OUT "%i",  $vertexnumbers->{'vt'} if (($write_vt) && (exists $vertexnumbers->{'vt'}));
 
−
        printf OBJ_OUT "\/";
 
−
        printf OBJ_OUT "%i",  $vertexnumbers->{'vn'} if (($write_vn) && (exists $vertexnumbers->{'vn'}));
 
−
      }
 
−
      #printf OBJ_OUT "\n# dist %f",  get_distance_to_midpoint($face->{'face'}, $objects->{'vertices'}); # $DEBUG:testing
 
−
      printf OBJ_OUT "\n";
 
−
    } # foreach face
 
−
  } # foreach object
 
−
 
 
−
  printf OBJ_OUT "# EOF\n";  
 
−
  close(OBJ_OUT);
 
−
  print "...Done.\n";
 
 
} # sub write_to_obj
 
} # sub write_to_obj
  
 
#######################################################################
 
#######################################################################
−
# Write/Export to vegastrike xmesh file
+
# Write/Export first object to vegastrike xmesh file
 
#######################################################################
 
#######################################################################
−
sub write_first_to_xmesh ($%)
+
sub write_first_to_xmesh ($%) {
−
{
+
my ($filename, $objects) = @_;
−
  my ($filename, $objects) = @_;
+
die "write_first_to_xmesh:objects" unless ( ref($objects) eq 'HASH' );
−
  die "write_first_to_xmesh:objects" unless ( ref($objects) eq 'HASH' );
 
  
−
  my $write_vt    = 1;  #write uv data if it exists
+
my $write_vt    = 1;  #write uv data if it exists
−
  my $write_vn    = 1;  #write normals if they exists # $DEBUG:TODO calulate normals
+
my $write_vn    = 1;  #write normals if they exists # $DEBUG:TODO calulate normals
−
  my $use_normals = "0"; # $DEBUG:TODO get this from type of export
+
my $use_normals = "0"; # $DEBUG:TODO get this from type of export
 
    
 
    
−
  #if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}  # $DEBUG:TODO check if the data is empty
+
#if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}  # $DEBUG:TODO check if the data is empty
−
  #if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}  # $DEBUG:TODO check if the data is empty
+
#if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}  # $DEBUG:TODO check if the data is empty
  
−
  #... get data from first object
+
#... get data from first object
−
  my $faces  = $objects->{'objects'}->[0]->{'faces'};
+
my $faces  = $objects->{'objects'}->[0]->{'faces'};
  
−
  ############################################
+
############################################
−
  # BEGIN make new data ('cause points include the normal data and the vertices of the faces include the uv-data)
+
# BEGIN make new data ('cause points include the normal data and the vertices of the faces include the uv-data)
−
  my $new_vertex_data    = {};
+
my $new_vertex_data    = {};
−
  my $new_faces          = [];
+
my $new_faces          = [];
−
  my $new_vertex_counter = 0;
+
my $new_vertex_counter = 0;
−
  my $vertexnumbers = {};
+
my $vertexnumbers = {};
−
  foreach my $face (@{$faces}) {
+
foreach my $face (@{$faces}) {
−
    my $new_face = [];
+
my $new_face = [];
−
    foreach $vertexnumbers (@{$face->{'face'}}) {
+
foreach $vertexnumbers (@{$face->{'face'}}) {
−
      $new_vertex_data->{$new_vertex_counter} =
+
$new_vertex_data->{$new_vertex_counter} = {
−
        { 'v_data' => $objects->{'vertices'}->{$vertexnumbers->{'v'}},
+
'v_data' => $objects->{'vertices'}->{$vertexnumbers->{'v'}},
−
          'vn_data'=> $objects->{'vndata'}->{$vertexnumbers->{'vn'}} };
+
'vn_data'=> $objects->{'vndata'}->{$vertexnumbers->{'vn'}}
−
      push(@{$new_face},{'v'     => $new_vertex_counter,
+
};
−
                        'vt_data'=> $objects->{'uvdata'}->{$vertexnumbers->{'vt'}}  
+
push(@{$new_face},{
−
                        } );
+
'v' => $new_vertex_counter,
−
      $new_vertex_counter++;
+
'vt_data'=> $objects->{'uvdata'}->{$vertexnumbers->{'vt'}}
−
    } # foreach vertexnumbers
+
}
−
    push(@{$new_faces}, $new_face);
+
);
−
  } # foreach face
+
$new_vertex_counter++;
−
  # END make new data
+
} # foreach vertexnumbers
−
  ############################################
+
push(@{$new_faces}, $new_face);
 +
} # foreach face
 +
# END make new data
 +
############################################
  
−
  #---
+
#---
−
  print "Opening file '$filename' for writing ...\n";
+
print "Opening file '",$filename,"' for writing ...\n";
−
  open(XMESH_OUT, "> $filename") || die "failed to open $filename\n";
+
open(XMESH_OUT, "> ".$filename) || die "failed to open $filename\n";
−
  print "...Done.\n";
+
print "...Done.\n";
−
  #---
+
#---
−
  print "Writing Header ...\n";
+
print "Writing Header ...\n";
−
  printf XMESH_OUT "<!-- Generated with obj_conv.pl version %s ", $VERSION;
+
printf XMESH_OUT "<!-- Generated with obj_conv.pl version %s ", $VERSION;
−
  #printf XMESH_OUT "\n - Split by BSP-tree" if ($split_bsp);  
+
#printf XMESH_OUT "\n - Split by BSP-tree" if ($split_bsp);  
−
  #printf XMESH_OUT "\n - Split by edges"    if ($split_by_view);  
+
#printf XMESH_OUT "\n - Split by edges"    if ($split_by_view);  
−
  #printf XMESH_OUT "\n - Triangulated"      if ($triangulate_objects);   
+
#printf XMESH_OUT "\n - Triangulated"      if ($triangulate_objects);   
−
  printf XMESH_OUT " -->\n";
+
printf XMESH_OUT " -->\n";
−
  printf XMESH_OUT "<Mesh texture='%s' scale='%f' %s >\n", "dummy.bmp", 1, "sharevertex='0'";
+
printf XMESH_OUT "<Mesh texture='%s' scale='%f' %s >\n", "dummy.bmp", 1, "sharevertex='0'";
−
  print "...Done.\n";
+
print "...Done.\n";
−
  #---
+
#---
−
  print "Writing material settings ...\n";
+
print "Writing material settings ...\n";
−
  printf XMESH_OUT "<!-- material %s -->\n", $objects->{'mtllib'};
+
printf XMESH_OUT "<!-- material %s -->\n", $objects->{'mtllib'};
−
  printf XMESH_OUT "<Material reflect='%s' LightningOn='%s' UseNormals='%s' %s >\n" ,"1","1",$use_normals,"";
+
printf XMESH_OUT "<Material reflect='%s' LightningOn='%s' UseNormals='%s' %s >\n" ,"1","1",$use_normals,"";
−
  printf XMESH_OUT "<Diffuse  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
+
printf XMESH_OUT "<Diffuse  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
−
  printf XMESH_OUT "<Ambient  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
+
printf XMESH_OUT "<Ambient  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
−
  printf XMESH_OUT "<Specular red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
+
printf XMESH_OUT "<Specular red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
−
  printf XMESH_OUT "<\/Material>\n";
+
printf XMESH_OUT "<\/Material>\n";
−
  print "...Done.\n";
+
print "...Done.\n";
−
  #---
+
#---
−
  printf XMESH_OUT "<!-- %i faces -->\n", $#{$new_faces};
+
printf XMESH_OUT "<!-- %i faces -->\n", $#{$new_faces};
−
  #---
+
#---
−
  print "Writing vertices ...\n";
+
print "Writing vertices ...\n";
−
  my $dummy_index = '';
+
my $dummy_index = '';
−
  printf XMESH_OUT "<Points>\n";
+
printf XMESH_OUT "<Points>\n";
−
  my $dummy_data_key;
+
my $dummy_data_key;
−
  my $dummy_data = {};
+
my $dummy_data = {};
−
  foreach $dummy_data_key (sort { $a <=> $b } (keys %{$new_vertex_data})) {
+
foreach $dummy_data_key (sort { $a <=> $b } (keys %{$new_vertex_data})) {
−
    $dummy_data = $new_vertex_data->{$dummy_data_key};
+
$dummy_data = $new_vertex_data->{$dummy_data_key};
−
    printf XMESH_OUT "<Point>\n";
+
printf XMESH_OUT "<Point>\n";
−
    printf XMESH_OUT "<Location x='%g' y='%g' z='%g'\/>\n", $dummy_data->{'v_data'}->[0],
+
printf XMESH_OUT "<Location x='%g' y='%g' z='%g'\/>\n",
−
                                                            $dummy_data->{'v_data'}->[1],
+
$dummy_data->{'v_data'}->[0],
−
                                                            $dummy_data->{'v_data'}->[2];
+
$dummy_data->{'v_data'}->[1],
−
    printf XMESH_OUT "<Normal i='%g' j='%g' k='%g'\/>\n", (-$dummy_data->{'vn_data'}->[0]),
+
$dummy_data->{'v_data'}->[2];
−
                                                          (-$dummy_data->{'vn_data'}->[1]),
+
printf XMESH_OUT "<Normal i='%g' j='%g' k='%g'\/>\n",
−
                                                          (-$dummy_data->{'vn_data'}->[2]);
+
(-$dummy_data->{'vn_data'}->[0]),
−
    printf XMESH_OUT "</Point>\n";
+
(-$dummy_data->{'vn_data'}->[1]),
−
  } # foreach dummydatakey
+
(-$dummy_data->{'vn_data'}->[2]);
 +
printf XMESH_OUT "</Point>\n";
 +
} # foreach dummydatakey
 +
 
 +
printf XMESH_OUT "</Points>\n";
 +
print "...Done.\n";
 +
#---
 +
print "Writing faces ...\n";
 +
printf XMESH_OUT "<Polygons>\n";
 +
my $face = [];
 +
$vertexnumbers = {};
 +
foreach $face (@{$new_faces}) {
 +
printf XMESH_OUT "<%s>\n",poly_text(($#{$face}+1));
 +
foreach $vertexnumbers (@{$face}) {
 +
printf XMESH_OUT "  <Vertex point='%s' s='%g' t='%g'\/>\n",
 +
$vertexnumbers->{'v'},
 +
$vertexnumbers->{'vt_data'}->[0],
 +
(1 - $vertexnumbers->{'vt_data'}->[1]);
 +
} # foreach vertexnumbers
 +
#printf XMESH_OUT "<!-- dist %f -->\n",  get_distance_to_midpoint($face, $objects->{'vertices'}); # $DEBUG:testing
 +
printf XMESH_OUT "<\/%s>\n",poly_text(($#{$face}+1));
 +
} # foreach face
 +
printf XMESH_OUT "<\/Polygons>\n";
 +
#---
 +
#printf XMESH_OUT "<!-- %s -->", Dumper($objects); # $DEBUG:DEBUG
 +
printf XMESH_OUT "%s". "";  #print LOD etc...
 +
#---
 +
printf XMESH_OUT "<\/Mesh>\n";
 +
close(XMESH_OUT);
 +
print "...Done.\n";
 +
} # sub write_first_to_xmesh
 +
 
 +
#######################################################################
 +
# Dump objects data structurte into a text file
 +
#######################################################################
 +
sub write_to_dump ($%) {
 +
my ($filename, $objects) = @_;
 +
die "write_to_dump:objects" unless ( ref($objects) eq 'HASH' );
 +
print "Opening file '$filename' for writing ...\n";
 +
open(DUMP_OUT, "> ".$filename) || die "failed to open $filename\n";
 +
print "...Done.\n";
  
−
  printf XMESH_OUT "</Points>\n";
+
print "Writing dump into file ...\n";
−
  print "...Done.\n";
+
printf DUMP_OUT "%s\n",Dumper($objects);
−
  #---
+
close(DUMP_OUT);
−
  print "Writing faces ...\n";
+
print "...Done.\n";
−
  printf XMESH_OUT "<Polygons>\n";
+
} # sub write_to_dump
−
  my $face = [];
 
−
  $vertexnumbers = {};
 
−
  foreach $face (@{$new_faces}) {
 
−
    printf XMESH_OUT "<%s>\n",poly_text(($#{$face}+1));
 
−
    foreach $vertexnumbers (@{$face}) {
 
−
      printf XMESH_OUT " <Vertex point='%s' s='%g' t='%g'\/>\n", $vertexnumbers->{'v'},
 
−
                                                                  $vertexnumbers->{'vt_data'}->[0],
 
−
                                                            (1 - $vertexnumbers->{'vt_data'}->[1]) ;     
 
  
−
    } # foreach vertexnumbers
+
#######################################################################
−
    #printf XMESH_OUT "<!-- dist %f -->\n",  get_distance_to_midpoint($face, $objects->{'vertices'}); # $DEBUG:testing
+
# Dump (any) text into a file
−
    printf XMESH_OUT "<\/%s>\n",poly_text(($#{$face}+1));
+
#######################################################################
−
  } # foreach face
+
sub write_to_debug ($$) {
−
  printf XMESH_OUT "<\/Polygons>\n";
+
my ($filename, $text) = @_;
−
  #---
+
  open(FILE, "> ".$filename) || die "failed to open $filename\n";
−
  #printf XMESH_OUT "<!-- %s -->", Dumper($objects); # $DEBUG:DEBUG
+
printf FILE $text;
−
  printf XMESH_OUT "%s". ""; #print LOD etc...
+
close(FILE);
−
  #---
+
print "...Done.\n";
−
  printf XMESH_OUT "<\/Mesh>\n";
+
} # sub write_to_debug
−
  close(XMESH_OUT);
 
−
  print "...Done.\n";
 
−
} # sub write_first_to_xmesh
 
  
 
#######################################################################
 
#######################################################################
 
# Return the currect XML-tag text for a poly with a given number of vertices
 
# Return the currect XML-tag text for a poly with a given number of vertices
 
#######################################################################
 
#######################################################################
−
sub poly_text ($)
+
sub poly_text ($) {
−
{
+
my ($number) = @_;
−
  my ($number) = @_;
+
SWITCH : {
−
  SWITCH :
+
if (3 == $number ) {return "Tri"; last SWITCH; }
−
  {  
+
if (4 == $number) {return "Quad"; last SWITCH; }
−
   
+
if (4 < $number) {return "Trifan"; last SWITCH; }
−
    if ($number == 3) {return "Tri";   last SWITCH;}
+
#else
−
    if ($number == 4) {return "Quad";   last SWITCH;}
+
print "Bad face found!\n";
−
    if ($number >  4) {return "Trifan"; last SWITCH;}
+
return "BADFACE";
−
    #else
+
}
−
    return "BADFACE";
 
−
  }
 
 
}
 
}
 
#-----------------------------------------------------------------------
 
#-----------------------------------------------------------------------
Line 2,557: Line 2,668:
 
#----------------------------------------------------------------------
 
#----------------------------------------------------------------------
 
# set default values
 
# set default values
−
  my $obj_in              = '';
+
my $file_in = ''; # $DEBUG:TODO Will be $file_in in the future (because the type will be autodetected)
−
  my $obj_out             = '';
+
my $obj_out = '';
−
  my $delete_backfaces   = 1;
+
my $xmesh_out = '';
−
  my $cleanup_data       = 0;
+
my $delete_backfaces = 1;
−
  my $cleanup_data2       = 0;
+
my $cleanup_data = 0;
−
  my $triangulate_objects = 0;
+
my $cleanup_data2 = 0;
−
  my $split_by_view       = 0;
+
my $triangulate_objects = 0;
−
  my $split_bsp           = 0;
+
my $split_by_view = 0;
−
  my $sort_by_midpoint   = 0;
+
my $split_bsp = 0;
−
  my $sort_by_midpoint2   = 1;
+
my $sort_by_midpoint = 0;
−
  my $write_as_obj       = 1; # needs to be deleted
+
my $sort_by_midpoint2 = 1;
−
  my $xmesh_out          = "";
+
my $write_as_obj = 1; # needs to be deleted
 +
 
  
 
my $helptext =
 
my $helptext =
Line 2,576: Line 2,688:
 
."usage: obj_conv.pl <TAGS>\n"
 
."usage: obj_conv.pl <TAGS>\n"
 
."\n"
 
."\n"
−
." -i<filename>      Input  file (obj)\n"
+
." -i<filename>      Input  file (obj/xmesh)\n"
 
." -o<filename>      Output file (obj)\n"
 
." -o<filename>      Output file (obj)\n"
 
."                      [Default: <input-filename>_cockpit.obj]\n"
 
."                      [Default: <input-filename>_cockpit.obj]\n"
Line 2,591: Line 2,703:
 
." -c                Cleanup vertices/uvdata/normals/faces before\n"
 
." -c                Cleanup vertices/uvdata/normals/faces before\n"
 
."                    doing anything else (removes duplicates, etc...)\n"
 
."                    doing anything else (removes duplicates, etc...)\n"
−
."                      [Default: $cleanup_data]\n"
+
."                      [Default: $cleanup_data] (needs -d sometimes)\n"
 
."-- MAIN-ACTIONS --------------------------------------------\n"
 
."-- MAIN-ACTIONS --------------------------------------------\n"
 
." -s                Split faces by planes tru the centerpoint\n"
 
." -s                Split faces by planes tru the centerpoint\n"
Line 2,600: Line 2,712:
 
."-- PAST-ACTIONS --------------------------------------------\n"
 
."-- PAST-ACTIONS --------------------------------------------\n"
 
." -C                Cleanup vertices/uvdata/normals/faces before\n"
 
." -C                Cleanup vertices/uvdata/normals/faces before\n"
−
."                    saving\n"
+
."                    saving (needs -d sometimes)\n"
 
."                      [Default: $cleanup_data2]\n"
 
."                      [Default: $cleanup_data2]\n"
 
." -T                Make all faces triangles before saving\n"
 
." -T                Make all faces triangles before saving\n"
Line 2,619: Line 2,731:
 
# Get all parameters and switches from the command line
 
# Get all parameters and switches from the command line
 
#######################################################################
 
#######################################################################
−
sub get_commandline_params ()
+
sub get_commandline_params () {
−
{
+
use vars qw($opt_i $opt_o $opt_r $opt_R $opt_h $opt_v $opt_s $opt_b $opt_c $opt_C $opt_T $opt_d);
−
  use vars qw($opt_i $opt_o $opt_r $opt_R $opt_h $opt_v $opt_s $opt_b $opt_c $opt_C $opt_T $opt_d);
+
use Getopt::Std;
−
  use Getopt::Std;
 
  
−
  print $#ARGV."\n";                              # $DEBUG_testing
+
print $#ARGV."\n";                              # $DEBUG_testing
−
  if ($#ARGV == -1) {
+
if ($#ARGV == -1) {
−
    print "Error: Not enough parameters. See usage below\n";die $helptext;
+
print "Error: Not enough parameters. See usage below\n";die $helptext;
−
  }
+
}
  
−
  if (!getopts('i:o:rRhv:sbcCTd')) {              # 'x:' takes argument 'x' doesn't
+
if (!getopts('i:o:rRhv:sbcCTd')) {              # 'x:' takes argument 'x' doesn't
−
    print "bad param\n";die $helptext;
+
print "Bad param.\n";
−
  }
+
die $helptext;
 +
}
  
−
  if ($opt_h) {
+
if ($opt_h) {
−
    print "help\n";die $helptext;
+
print "Display help.\n";
−
  }
+
die $helptext;
 +
}
  
−
  # params with additional data
+
# params with additional data
−
  if ($opt_v) {$verbose           = $opt_v;}
+
if ($opt_v) {$verbose = $opt_v; }
−
  else       {$verbose           = 0;}
+
else {$verbose = 0; }
−
  if ($opt_i) {$obj_in            = $opt_i;}
+
if ($opt_i) {$file_in = $opt_i;}
−
  if ($obj_in eq '') {
+
if ($file_in eq '') {
−
    print "Error: no input file (-i). See usage below.\n";die $helptext;
+
print "Error: no input file (-i). See usage below.\n";die $helptext;
−
  }
+
}
−
  if ($opt_o) {
+
if ($opt_o) {
−
              $obj_out               = $opt_o;
+
$obj_out = $opt_o;
−
              ($xmesh_out = $obj_out) =~ s/\.obj$/\.xmesh/;
+
($xmesh_out = $obj_out) =~ s/\.obj$/\.xmesh/;
−
              }
+
} else {
−
  else       {
+
($obj_out = $file_in) =~ s/\..*$/_cockpit\.obj/;
−
              ($obj_out   = $obj_in) =~ s/\.obj$/_cockpit\.obj/;
+
($xmesh_out = $file_in) =~ s/\..*$/_cockpit\.xmesh/;
−
              ($xmesh_out = $obj_in) =~ s/\.obj$/_cockpit\.xmesh/;
+
}
−
              }
 
  
−
  # single params
+
# single params
−
  if ($opt_c) {$cleanup_data       = !$cleanup_data;}
+
if ($opt_c) {$cleanup_data = !$cleanup_data;}
−
  if ($opt_d) {$delete_backfaces   = !$delete_backfaces;}
+
if ($opt_d) {$delete_backfaces = !$delete_backfaces;}
−
  if ($opt_r) {$sort_by_midpoint   = !$sort_by_midpoint;}
+
if ($opt_r) {$sort_by_midpoint = !$sort_by_midpoint;}
−
  if ($opt_R) {$sort_by_midpoint2   = !$sort_by_midpoint2;}
+
if ($opt_R) {$sort_by_midpoint2 = !$sort_by_midpoint2;}
−
  if ($opt_s) {$split_by_view       = !$split_by_view;}
+
if ($opt_s) {$split_by_view = !$split_by_view;}
−
  if ($opt_b) {$split_bsp           = !$split_bsp;}
+
if ($opt_b) {$split_bsp = !$split_bsp;}
−
  if ($opt_T) {$triangulate_objects = !$triangulate_objects;}
+
if ($opt_T) {$triangulate_objects = !$triangulate_objects;}
−
  if ($opt_C) {$cleanup_data2       = !$cleanup_data2;}
+
if ($opt_C) {$cleanup_data2 = !$cleanup_data2;}
 
} # sub get_commandline_params
 
} # sub get_commandline_params
 
      
 
      
Line 2,670: Line 2,782:
 
print "##################################################################\n";
 
print "##################################################################\n";
 
print "Current settings (chronological order).......\n";
 
print "Current settings (chronological order).......\n";
−
print "Infile          (i): ".$obj_in           ."\n";
+
print "Infile          (i): ".$file_in           ."\n";
−
print "Outfile         (o): ".$obj_out          ."\n";
+
print "Outfile (OBJ)  (o): ".$obj_out          ."\n";
 
print "Outfile Xmesh  ( ): ".$xmesh_out        ."\n";
 
print "Outfile Xmesh  ( ): ".$xmesh_out        ."\n";
 
print "Remove Backfaces(d): ".$delete_backfaces ."\n";
 
print "Remove Backfaces(d): ".$delete_backfaces ."\n";
Line 2,682: Line 2,794:
 
print "Cleanup data    (C): ".$cleanup_data2    ."\n";
 
print "Cleanup data    (C): ".$cleanup_data2    ."\n";
 
print "Verbosity      (v): ".$verbose          ."\n";
 
print "Verbosity      (v): ".$verbose          ."\n";
−
 
  
 
#---- main program variables ----
 
#---- main program variables ----
Line 2,702: Line 2,813:
  
 
#---- main program ----
 
#---- main program ----
 +
 +
#read_from_xmesh($file_in);
 +
#die "DEBUG xmesh\n";
  
 
print "#############################################################\n";
 
print "#############################################################\n";
−
print "Reading .obj file: ".$obj_in."\n";
+
print "Reading input file: ".$file_in."\n";
−
 
+
my $objects = read_from_any($file_in);
−
#( $mtlname_found,  $objectname_found,
+
#write_to_debug('D:\dummy.txt',Dumper($objects));
−
#  $groupname_found, $usemtlname_found,
+
print "-------------------------------------------------------------\n";
−
#  $vert_counter,    $uv_counter, $norm_counter)
 
−
# = read_from_obj ($obj_in,$faces,
 
−
#                  $vertices,    $uvdata,    $vndata,
 
−
#                  $vert_counter,$uv_counter, $norm_counter,
 
−
#                  $mtlname_found,  $objectname_found,
 
−
#                  $groupname_found, $usemtlname_found);
 
−
 
 
−
my $objects = read_from_obj($obj_in);
 
−
 
 
 
print "Facecount  : ".(objects_facecount($objects))."\n";  #print "Facecount  : ".$#{$faces}    ."\n";
 
print "Facecount  : ".(objects_facecount($objects))."\n";  #print "Facecount  : ".$#{$faces}    ."\n";
 
print "Vertexcount: ".($objects->{'vert_counter'} )."\n";
 
print "Vertexcount: ".($objects->{'vert_counter'} )."\n";
Line 2,723: Line 2,828:
 
print "... Reading done.\n";
 
print "... Reading done.\n";
  
−
if ($delete_backfaces)
+
if ($delete_backfaces) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Removing the faces that are pointing the other way (away from center)  ...\n";
−
  print "Removing the faces that are pointing the other way (away from center)  ...\n";
+
print "Old facecount: ".objects_facecount($objects)."\n";
−
  print "Old facecount: ".objects_facecount($objects)."\n";
+
delete_backfaces ($objects);
−
 
+
print "New facecount: ".objects_facecount($objects)."\n";
−
  delete_backfaces ($objects);
+
print "... Backfaces removed.\n";
−
 
 
−
  print "New facecount: ".objects_facecount($objects)."\n";
 
−
  print "... Backfaces removed.\n";
 
 
}
 
}
  
−
if ($sort_by_midpoint) # $DEBUG:testing
+
if ($sort_by_midpoint) { # $DEBUG:testing
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Sorting by midpoint the first time  ...\n";
−
  print "Sorting by midpoint the first time  ...\n";
+
sort_by_facemidpoint ($objects, 1 );
−
 
+
print "... Sorting done.\n";
−
  sort_by_facemidpoint ($objects, 1 );
 
−
 
 
−
  print "... Sorting done.\n";
 
 
}
 
}
  
−
if ($cleanup_data)
+
if ($cleanup_data) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Clean up data ...\n";
−
  print "Clean up data ...\n";
+
clean_data($objects);
−
 
+
print "... Cleaning done.\n";
−
  clean_data($objects);
 
−
 
 
−
  print "... Cleaning done.\n";
 
 
}
 
}
  
−
my $edges             = {};
+
my $edges = {};
  
−
if ($split_bsp)
+
if ($split_bsp) {
−
{
+
if ($split_by_view) {
−
 
+
$edges = get_edges($objects);
−
  if ($split_by_view) {
+
}
−
    $edges               = get_edges($objects);
+
print "#############################################################\n";
−
  }
+
print "Creating and sorting BSP tree ...\n";
−
 
+
print "Old facecount: ".objects_facecount($objects)."\n";
−
  print "#############################################################\n";
+
print "Creating BSP tree (this will take some time)...\n";
−
  print "Creating and sorting BSP tree ...\n";
+
faces2bspfaces($objects->{'objects'}->[0]->{'faces'}, 0);
−
  print "Old facecount: ".objects_facecount($objects)."\n";
 
−
  print "Creating BSP tree (this will take some time)...\n";
 
−
  faces2bspfaces($objects->{'objects'}->[0]->{'faces'}, 0);
 
 
#print "f".Dumper($objects->{'objects'}->[0]->{'faces'})."f\n";
 
#print "f".Dumper($objects->{'objects'}->[0]->{'faces'})."f\n";
−
 
+
my $bsptree = gen_bsptree_new( $objects->{'objects'}->[0]->{'faces'} , $objects );
−
#  my %bsptree;
+
print "...done.\n";
−
#  use DB_File;                      # optional; overrides default
+
print "converting BSP-tree to facelist ...\n";
−
#  use POSIX qw(tmpnam);
+
$objects->{'objects'}->[0]->{'faces'} = bsptree2faceslist_new($bsptree);
−
#  do { my $tmp_filename = tmpnam() }
 
−
#    until (dbmopen %bsptree, $tmp_filename, 0666); # try new temporary filenames until we get one that didn't already exist
 
−
 
 
−
 
 
−
  my $bsptree = gen_bsptree_new( $objects->{'objects'}->[0]->{'faces'} , $objects );
 
−
  print "...done.\n";
 
−
  print "converting BSP-tree to facelist ...\n";
 
−
 
 
−
  $objects->{'objects'}->[0]->{'faces'} = bsptree2faceslist_new($bsptree);
 
−
 
 
 
#dbmclose %bsptree;                  # close the database
 
#dbmclose %bsptree;                  # close the database
 
#undef %bsptree;
 
#undef %bsptree;
 
undef $bsptree if ($undef_vars);
 
undef $bsptree if ($undef_vars);
 +
print "...done.\n";
  
−
  print "...done.\n";
+
print "New facecount: ".objects_facecount($objects)."\n";
−
 
+
print "... BSP tree+sorting done.\n";
−
  print "New facecount: ".objects_facecount($objects)."\n";
 
−
  print "... BSP tree+sorting done.\n";
 
 
}
 
}
  
 
### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # $DEBUG:MARK4
 
### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # $DEBUG:MARK4
−
if ($split_by_view)
+
if ($split_by_view) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Splitting by view ...\n";
−
  print "Splitting by view ...\n";
+
print "Old facecount: ".objects_facecount($objects)."\n";
−
  print "Old facecount: ".objects_facecount($objects)."\n";
+
print "Creating centerBSP-tree ...\n";
−
  print "Creating centerBSP-tree ...\n";
 
 
    
 
    
−
  my $used_edges = {};
+
my $used_edges = {};
−
  if (! $split_bsp) {
+
if (! $split_bsp) {
−
    $edges  = get_edges($objects);
+
$edges  = get_edges($objects);
−
  }
+
}
  
−
  print "Edgecount: ". (keys %{$edges}) ."\n";
+
print "Edgecount: ". (keys %{$edges}) ."\n";
  
 
#print "y".Dumper($objects->{'objects'}->[0]->{'faces'})."yy";
 
#print "y".Dumper($objects->{'objects'}->[0]->{'faces'})."yy";
  
−
  my $centerbsptree  = gen_centerbsptree_new ($objects->{'objects'}->[0]->{'faces'},  $objects, $edges, $used_edges);
+
my $centerbsptree  = gen_centerbsptree_new ($objects->{'objects'}->[0]->{'faces'},  $objects, $edges, $used_edges);
 
    
 
    
 
#print "x".Dumper($centerbsptree)."xx";
 
#print "x".Dumper($centerbsptree)."xx";
−
  print "\n";
+
print "\n";
−
  print "...done.\n";
+
print "...done.\n";
−
  print "converting centerBSP-tree to facelist ...\n";
+
print "converting centerBSP-tree to facelist ...\n";
−
  $objects->{'objects'}->[0]->{'faces'} = centerbsptree2faceslist_new($centerbsptree);
+
$objects->{'objects'}->[0]->{'faces'} = centerbsptree2faceslist_new($centerbsptree);
 
undef $centerbsptree if ($undef_vars);
 
undef $centerbsptree if ($undef_vars);
−
  print "...done.\n";
+
print "...done.\n";
  
−
 
+
print "New facecount: ".objects_facecount($objects)."\n";
−
  print "New facecount: ".objects_facecount($objects)."\n";
+
print "... Splitting by view done.\n";
−
  print "... Splitting by view done.\n";
 
  
 
} # split_by_view
 
} # split_by_view
 
### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
−
if ($cleanup_data2)
+
if ($cleanup_data2) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Clean up data ...\n";
−
  print "Clean up data ...\n";
+
clean_data($objects);
−
 
+
print "... Cleaning done.\n";
−
  clean_data($objects);
 
−
 
 
−
  print "... Cleaning done.\n";
 
 
}
 
}
  
−
if ($triangulate_objects)
+
if ($triangulate_objects) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Making all faces triangles ...\n";
−
  print "Making all faces triangles ...\n";
+
print "Old facecount: ".objects_facecount($objects)."\n";
−
  print "Old facecount: ".objects_facecount($objects)."\n";
+
triangulate_objects($objects);
−
 
+
print "New facecount: ".objects_facecount($objects)." (tris)\n";
−
  triangulate_objects($objects);
+
print "... triangles done.\n";
−
 
 
−
  print "New facecount: ".objects_facecount($objects)." (tris)\n";
 
−
  print "... triangles done.\n";
 
 
}
 
}
  
−
if ($sort_by_midpoint2)
+
if ($sort_by_midpoint2) {
−
{
+
print "#############################################################\n";
−
  print "#############################################################\n";
+
print "Sorting by midpoint ...\n";
−
  print "Sorting by midpoint ...\n";
 
 
#print "x".Dumper($bsptree);
 
#print "x".Dumper($bsptree);
−
  sort_by_facemidpoint ($objects, 1 ); # high to low distance (should be correct for VS display)
+
sort_by_facemidpoint ($objects, 1 ); # high to low distance (should be correct for VS display)
 
#  sort_by_facemidpoint ($objects, 0 ); # low to high distance
 
#  sort_by_facemidpoint ($objects, 0 ); # low to high distance
 +
print "... Sorting done.\n";
 +
}
  
−
  print "... Sorting done.\n";
 
−
}
 
  
 +
if ($write_as_obj) {
 +
print "#############################################################\n";
 +
print "Writing to obj file ...\n";
  
−
if ($write_as_obj)
+
if ($use_benchmark) {
−
{
+
write_to_debug($obj_out.'.bench',$timer->reports());
−
  print "#############################################################\n";
+
}
−
  print "Writing to obj file ...\n";
+
write_to_obj ($obj_out, $objects);
−
  write_to_obj ($obj_out, $objects);
+
print "... Writing obj done.\n";
−
  print "... Writing obj done.\n";
+
print "\n";
−
  print "\n";
 
 
######
 
######
−
  print "Writing to xmesh file ...\n";
+
print "Writing to xmesh file ...\n";
−
  write_first_to_xmesh ($xmesh_out, $objects);
+
write_first_to_xmesh ($xmesh_out, $objects);
−
  print "... Writing xmesh done.\n";
+
print "... Writing xmesh done.\n";
 
}
 
}
  
Line 2,885: Line 2,960:
 
# safer chomp operator, which removes only a newline character
 
# safer chomp operator, which removes only a newline character
 
# (Or whatever the input record separator $/is set to.)
 
# (Or whatever the input record separator $/is set to.)
−
sub superchomp ($)
+
sub superchomp ($) { # $DEBUG:TODO unused right now .. needed?
−
{
+
my ($string) = @_;
−
  my ($string) = @_;
+
#die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
−
  #die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
+
my $default_EOL = $/;
−
  my $default_EOL = $/;
+
chomp($string);
−
  chomp($string);
+
$/ = "\n";
−
  $/ = "\n";
+
chomp($string);
−
  chomp($string);
+
$/ = "\n\r";
−
  $/ = "\n\r";
+
chomp($string);
−
  chomp($string);
+
$/ = $default_EOL;
−
  $/ = $default_EOL;
+
return $string;
−
  return $string;
 
 
} # sub superchomp
 
} # sub superchomp
 +
  
 
#######################################################################
 
#######################################################################
−
##obj example
+
# obj syntax example
 
#
 
#
 
#mtllib 2box.mtl
 
#mtllib 2box.mtl
Line 2,922: Line 2,997:
  
 
#######################################################################
 
#######################################################################
−
##mtl example
+
##mtl syntax example
 
#
 
#
 
#newmtl octotoad1_auv_0
 
#newmtl octotoad1_auv_0
Line 2,934: Line 3,009:
 
#######################################################################
 
#######################################################################
  
−
##################################
+
#######################################################################
−
# test functions
+
# DB_File example
−
#open(DUMMY, "> test.txt") ||
 
−
#   die "failed to open test.txt\n";
 
 
#
 
#
−
#my $objects_dummy =read_from_obj($obj_in);
 
−
#print DUMMY Dumper($objects_dummy)."\n";
 
−
#print DUMMY @{$objects_dummy->{'objects'}}."\n";
 
−
#################################
 
−
 
 
#use DB_File;                      # optional; overrides default
 
#use DB_File;                      # optional; overrides default
 
#use POSIX qw(tmpnam);
 
#use POSIX qw(tmpnam);
Line 2,957: Line 3,025:
 
#}
 
#}
 
#dbmclose %HASH;                  # close the database
 
#dbmclose %HASH;                  # close the database
 +
#######################################################################
 +
 +
#######################################################################
 +
# MLDBM example
 +
#
 +
# use Tie::MLDBM;
 +
#
 +
# tie my %test, 'Tie::MLDBM', {
 +
#    'Serialise' =>  'Storable',
 +
#    'Store'    =>  'DB_File'
 +
# }, 'testdb.dbm', O_CREAT|O_RDWR, 0640 or die $!;
 +
#
 +
##WARNINGS
 +
## The addition or alteration of elements to nested data structures is not entirely transparent in Perl. As such, in order to store a reference or modify an existing reference value within a tied hash, the value must first be retrieved and stored in a temporary variable before modification. For example, the following will not work:
 +
#$hash{'key'}{'subkey'} = 'value';  #  Will not work
 +
##Instead, this operation should be performed in a two-step process, like thus:
 +
# $temp = $hash{'key'};              #  Retrieve element
 +
# $temp->{'subkey'} = 'value';
 +
# $hash{'key'} = $temp;              #  Store element
 +
## This limitation exists because the perl TIEHASH interface currently has no support for multidimensional ties.
 +
#######################################################################
 +
#sub init_objects () { # $DEBUG:TODO is this even working (because vertices do have lists in them)
 +
# my $objects = {
 +
# 'vertices' => {}, 'vert_counter' => 0,
 +
# 'uvdata'  => {}, 'uv_counter'  => 0,
 +
# 'vndata'  => {}, 'norm_counter' => 0 ,
 +
# 'objects'  => []
 +
# };
 +
# # $DEBUG:TODO serialise/tie vertices, uvdata and vndata
 +
# use DB_File;                      # optional; overrides default
 +
# use POSIX qw(tmpnam);
 +
# my $tmp_filename = tmpnam();
 +
# do { $tmp_filename = tmpnam() }
 +
# until (dbmopen %{$objects->{'vertices'}}, $tmp_filename, 0666); # try new temporary filenames until we get one that didn't already exist
 +
# do { $tmp_filename = tmpnam() }
 +
# until (dbmopen %{$objects->{'uvdata'}}, $tmp_filename, 0666);
 +
# do { $tmp_filename = tmpnam() }
 +
# until (dbmopen %{$objects->{'vndata'}}, $tmp_filename, 0666);
 +
# return $objects;
 +
#}
 
#######################################################################
 
#######################################################################
 
# EOF
 
# EOF
−
#######################################################################=
+
#######################################################################
 
</pre>
 
</pre>
 +
 +
==Test case analysis==
 +
{{warning_text|text=Test case problem solved.. see point 3 below. <BR/>"'''''Move along, there is nothing to see here!'''''}}
 +
Here i try to reduce the test case to the problem.
 +
You can see in the code below that all but the last faces are commented out. The still active faces are the ones of the little cube which isn't visible in vegastrike, but imports into wings.
 +
 +
Possible reasons for the problem i've found so far:
 +
# Normals are screwed up ... front/back (mentioned by dandandaman [http://vegastrike.sourceforge.net/forums/viewtopic.php?p=35228#35228 here])
 +
# Rendering isn't working as expected (order of drawing)
 +
# '''EDIT''': OK, it was case 3 (the one nobody though of).... just set up the '''scale to <code>"2.0"</code>''' and everything is displayed ;) ..'''I'm feewing wucky'''
 +
 +
Now i'm of to test it with bigger and '''cooler''' cockpits ;) wasted CPU time here i come :D
 +
 +
 +
Original test case data:<BR/>
 +
<small>The test case can be found [http://vegastrike.sourceforge.net/users/pontiac/scripts/3cubes.tar.bz2 here].
 +
In this archive are two screenshots, one from within Wings3D and the same file in vegastrike as cockpit. [1]
 +
<code>3cubes_cockpit_wings.jpg</code> == processed obj file (<code>3cubes_cockpit.obj</code>) displayed in Wings3D<BR/>
 +
<code>3cubes_cockpit_vs.jpg</code> == <code>3cubes_cockpit.xmesh</code>
 +
 +
As you can see the small cube isn't shown/drawn in vegastrike.<BR/>
 +
Is this a bug or am I seeing ghosts again?</small>
 +
 +
==Testing/Benchmarking the code==
 +
Here's the code to time various functions and generate a (non-statistical) report:
 +
<pre>
 +
# Non-statistical usage
 +
use Benchmark::Timer;
 +
$timer = Benchmark::Timer->new(skip => 1);
 +
 +
for (xxx) {
 +
$timer->start('split_face_by_plane');
 +
####
 +
$timer->stop('split_face_by_plane');
 +
}
 +
 +
for (yyy) {
 +
$timer->start('foreach my $face (@{$dummy_newfacesfar})');
 +
####
 +
$timer->stop('foreach my $face (@{$dummy_newfacesfar})');
 +
}
 +
 +
for (zzz) {
 +
$timer->start('%x=%y+%z');
 +
####
 +
$timer->stop('%x=%y+%z');
 +
}
 +
 +
print $timer->report;
 +
</pre>
 +
==See also==
 +
 +
[[Category:Development]]

Latest revision as of 15:46, 13 May 2005

Description

This script is under HEAVY development, but only when i find some spare time ;) (i love this sort of sentences)

Features and TODOs

Features

  • OBJ reading
  • OBJ writing
  • Xmesh reading (not yet tested for bugs)
  • Xmesh writing (no read-in materials yet)
  • Perl-dump writing
  • z-depth sorting (only works sane when everything is splitted correctly)
  • Splitting algorithms (needed for 3D cockpits)
    • BSP (Binary Space Partition) splitting
    • Split by view (edges)
  • Parsing of tag data (not writing them yet)
  • Triangulation (before calculations and before saving)

TODO

  • You can find a complete list of open tasks in the code below under "TODO" -> "-OPEN-"

Code

#!/bin/perl
#######################################################################
# obj_conv.pl
#                      2004.07.26 (c) Martin 'Pontiac' Buerbaum
#
# Licence:
#   The content of this file is under the GNU/GPL license.
#   http://www.gnu.org/licenses/gpl.txt
#
# Description:
#   Converts .obj to .obj/.xmesh files.
#   The following functions are available:
#     - BSP sorting
#     - Splitting all faces by a plane through every edge of the polys.
#       and then sorts them by the distance to the center-point
#       (called center-BSP inside this file)
#   This and other functionality listed (with a short description)
#   in the -h parameter or the $helptext variable below.
#
# Usage example (short):
#
#   perl obj_conv.pl_xxxx_xx_xx_xx.txt -i inputfile.obj -o outputfile.obj -b -s -T
#
#   parameter description:
#     b ... BSP-sorting (fixed alot of heavy bugs)
#     s ... split by view (complete rewrite)
#     T ... triangulation (finally working correctly, partly rewritten)
#   The default output files (right now) are:
#     outputfile.obj
#     outputfile.xmesh
#
# Links:
#   VegaStrike       http://vegastrike.sourceforge.net
#   VegaStrike XMESH http://vegastrike.sourceforge.net/phpwiki/index.php/VsHowtoEditMeshFiles
#   CPAN             http://cpan.org/
#   Data::Dumper     http://search.cpan.org/~ilyam/Data-Dumper/
#   Math::VectorReal http://search.cpan.org/~anthony/Math-VectorReal/
#   Binary Space Partitioning Trees FAQ http://www.faqs.org/faqs/graphics/bsptree-faq/
#   BSP trees        http://www.cs.wpi.edu/~matt/courses/cs563/talks/bsp/document.html
#   OBJ Format(Ver3) http://astronomy.swin.edu.au/~pbourke/geomformats/obj/
#   OBJ Format       http://www.fileformat.info/format/wavefrontobj/egff.htm
#   XMESH->BFXM	http://vegastrike.sourceforge.net/forums/viewtopic.php?t=2406
#
# Known bugs / missing features:
#   *) see TODO below
#
# Comments:
#   *) "# $DEBUG:testing" ... Comments like this are only for testing
#                             purpose and may/should be removed later.
#   *) "# $DEBUG:TODO"    ... Pretty much self explaining (there is usually
#                             a short description after that entry)
#   *) "# $DEBUG:MARK1"    ... marks a special place in the code to be reviewed later
#                              (for easy reference in the TODO/REVISION part)
#                              Numbers are incremented as needed
#######################################################################

#######################################################################
# VERSIONS / REVISIONS
#----------------------------------------------------------
my $VERSION        = "0.8.68 (2005.05.13)";
#----------------------------------------------------------
# *) 2005.05.13 - Martin 'Pontiac' Buerbaum
#   - Added some benchmark code.
#   - Fixed some things in clean_data()
#   - Removed some outdated functions (no '_new')
#   - Commenteed out ht 'edges' entries in the tree.
# *) 2005.05.11 - Martin 'Pontiac' Buerbaum
#   - Added zero-check to make_vector_normal().
# *) 2005.05.10 - Martin 'Pontiac' Buerbaum 
#   - Some Xmesh import fixes (seems to work now)
#   - Started to clean up the code again (tabs) .. search for "CLEANED UP TO THIS POINT (TABS)"
#     ... and finished.
#   - Fixed material-hash problems.
#   - Added write_to_any() function.
#   - Added write_to_dump() function.
# *) 2005.05.09 - Martin 'Pontiac' Buerbaum 
#   - Added some functions needed for file reading ... get_file_type() and read_from_any()
#   - Added initial read_from_xmesh() function
# *) 2005.02.09 - Martin 'Pontiac' Buerbaum 
#   - Added storage of numbers (instead of strings) to the read_from* subs (i hope this works at all)
#     I used the $value_or_string *= 1; command for floats and
#     $value_or_string = int($value_or_string); for integer -> better way?
# *) 2005.02.08 - Martin 'Pontiac' Buerbaum 
#    - Added skipping of comments and blanklines in read_from* subs
#    - Improved this skipping behaviour
# *) 2005.02.04 - Martin 'Pontiac' Buerbaum 
#   - Small change in the write_to_obj for debugging (distance)
#   - Set UseNormals to 0 for now (bad display)
# *) 2005.01.28 - Martin 'Pontiac' Buerbaum 
#   - Fixed some MORE multi-object problems in sub clean_data (see "for $i")
#   - Added some "my" speedups (hopefully) in sub data_exists
#   - Added some "my" speedups (hopefully) in sub clean_data
#   - Made the xmesh export from %f into %g (='compact floating point output')
#     for file-space reasons (though pure integers will be written without a point)
#   - Removed various blank characters in the xmesh export
#   - Added "UseNormals" to xmesh export
#   - Added basic transform sceleton (regex + switch)
#     Transform functions still needed though.
# *) 2005.01.27 - Martin 'Pontiac' Buerbaum 
#   - Fixed some multi-object problems in the data-cleanup code
#   - Save previous objectname when a new group is created in sub read_obj.
# *) 2005.01.26 - Martin 'Pontiac' Buerbaum 
#   - Fixed (i hope) the group/objectname (o & g) issue of the read_obj sub.
#   - Added basic template function
# *) 2005.01.25 - Martin 'Pontiac' Buerbaum 
#   - Added if() to undef functions
#   - Found that memory consumtion only occurs in writing subs:
#     changes some of the loop variable definitions/places
# *) 2005.01.24 - Martin 'Pontiac' Buerbaum 
#   - Added/changed (verbose) TODO entries
#   - Searching for the problem in the display
#   - Added check to vert3_ok: die if a vertex(list) doesn't have exactly 3 entries
#   - Replaced chop with chomp in read_xxx functions
#   - Added sub superchomp (for OS independent chomp). It's not yet in use.
#   - Modified the tag function (sub objects2vstags) a bit (regex)
#   - Finally removed old subs
#     * sub gen_bsptree
#     * sub bsptree2faceslist
#     (saved in obj_conv.pl_2005_01_24_01_old_bsptree_subs.txt):
#   - Added alot of undef commands to (hopefully) reduce memory usage.
#   - Thinking about how to include the DBMs
# *) 2004.11.24 - Martin 'Pontiac' Buerbaum 
#   - Lots of bugfixes 'cause of the support for multiple objects
# *) 2004.11.23 - Martin 'Pontiac' Buerbaum 
#   - Added per-face materials to the sub 'read_from_obj'
#   - Corrected storage of vertices/uv/vn data (=global ... not per object)
#   - LOTS and LOTS of functions converted to multi-object support
# *) 2004.11.22 - Martin 'Pontiac' Buerbaum 
#   - removed planeface from sub 'centerbspsplit_faces_by_plane'
# *) 2004.11.20 - Martin 'Pontiac' Buerbaum 
#   - test of new triangulation-algorithm -> seems to work as expected
#  - the problem with the non-splitted faces seems to be the planeface
#    in sub 'bspsplit_faces_by_plane'
# *) 2004.11.19 - Martin 'Pontiac' Buerbaum 
#   - code cleanup (including comments,output) +
#   - testing triangulation functions (seems to be basically working now)
#   - testing midpoint-sorting functions (seems to work fine, but it isn't
#     correctly displayed in VS)
#   - center-BSP functions are working fine and REALLY FAST .. finally 8)
# *) 2004.11.18 - Martin 'Pontiac' Buerbaum 
#   - improved center-BSP related code
#     .. should work correctly and fast now :))))
#     Testing needed though [DONE^^^^^]
#   - code cleanup
# *) 2004.11.17 - Martin 'Pontiac' Buerbaum 
#   - added center-BSP related code (see $DEBUG:MARK4 and bottom of the file)
# *) 2004.11.16 - Martin 'Pontiac' Buerbaum 
#   - remove skipping of faces when the...
#     see $DEBUG:MARK1 and $DEBUG:MARK2
#   - added TODO about the frustrum-bsp-algorithm (see TODO below)
#   - added pseudocode on the bottom of this file (see EOF)
# *) 2004.10.01 - Martin 'Pontiac' Buerbaum 
#   - trying to find error in code (to much removed faces
#   - fix of inverted normals
#   - fix of flipped uv-map
# *) 2004.09.26 - Martin 'Pontiac' Buerbaum 
#   - fixed nasty tag-closing bug <Polygons> instead of </Polygons>
# *) 2004.09.26 - Martin 'Pontiac' Buerbaum 
#   - testing
# *) 2004.08.27 - Martin 'Pontiac' Buerbaum 
#   - another improvement to make "-s -b" more accurate and faster
# *) 2004.08.26 - Martin 'Pontiac' Buerbaum 
#   - some usage improvements (programming-vise)
#     e.g: default in helptext
# *) 2004.08.18 - Martin 'Pontiac' Buerbaum 
#   - added basic xmesh export (just as a proof of concept)
#   - added basic mtl import (not yet used or even finished)
# *) 2004.08.17 - Martin 'Pontiac' Buerbaum 
#   - search for bug in normal-data  + some corrections
#   - added delete_backfaces
#   - cleaned up 'clean_data' ;-)
#   - general code cleanup
#   - added vert3_ok to checck faces before making planes out of them
# *) 2004.08.16 - Martin 'Pontiac' Buerbaum 
#   - some code cleanup
# *) 2004.08.12 - Martin 'Pontiac' Buerbaum 
#   - added basic (and untested) cleanup sub
#   - added basic (and untested) triangulate sub
# *) 2004.08.06 - Martin 'Pontiac' Buerbaum 
#   - started implementing bsp sorting ( corrupted right now)
#   - added various (commented out) lines for future normal support
#   - splitting by viewcone still SLOW as hell: converting a sample
#     cockpit with around 1000 faces generated around 100000! faces when
#     splitted by viewcone and lasts at least three full day on my PC.
# *) 2004.07.31 - Martin 'Pontiac' Buerbaum   (2004_07_31_03)
#   - ignoring faces that are not crossing the frustum
#     (centerpoint->polygon) OR are before the face they are split by
# *) 2004.07.29 - Martin 'Pontiac' Buerbaum   (2004_07_29_10)
#   - z-sorting seems to works now (checking needed)
#   - splitting by viewplane fully implemented
#   - skipping faces that are not in the way while splitting
#   - some reformatting + cleanup
#   - still SLOOOOOOW as hell
# *) 2004.07.28 - Martin 'Pontiac' Buerbaum
#   - mostly working (not yet checked ingame) but slooooow
# *) 2004.07.27 - Martin 'Pontiac' Buerbaum
#   - basic split by view/edge
# *) 2004.07.26 - Martin 'Pontiac' Buerbaum
#   - first concept
#   - import of obj
#######################################################################

#######################################################################
# TODO       (sorted where possible from high to low priority)
#
#--DONE----------------------------------------------------------------
# *) [DONE] Remove all faces that are NOT visible  (BEFORE sorting/splitting anything)
#    Though, how do i recognize all of this faces? (imagine one face
#    that isn't visible because of 2!! ore more other faces in front of it,
#    not just one)
#    - [DONE] remove backfaces (faces poining away from the centerpoint)
#    - [$ME_WONTFIX] faces behind others (hard to do in a good way
# *) [DONE] Make vert2_to_plane recognize faulty vertices (e.g all in a row)
# *) [DONE] Support for vertex-normals (vn) 
# *) [DONE] Speedup the whole frustum split !!!!!!!!!!!! -> new algorithm
#    - [DONE] Similar algorithm as the bsp one, but this time with the
#      plane (centerpoint,edgepoint1,edgepoint2) as branching criteria.
# *) [DONE] fix triangulation
# *) [DONE] improve obj-read and mtl-read
#    - [DONE should be at least] also read tags like "o" or "mtllib" with
#      whitespaces in the beginning
#      Should be /^\s*o\s/  or /^\s*mtllib\s/ ?????
#--OPEN----------------------------------------------------------------
# *) [OPEN veryhigh] Find the problem with the wrong display in VS:
#    - [WORKING CORRECTLY!!] maybe sort_by_midpoint -> better sorting???
#    - [DONE i hope] the normal bsp algorithm doesn't split all faces!!!!!!!!
#    - [PENDING] The most likley reason is the order of drawing faces by VS (tri,quad,etc...)
#      see triangulation.
#    - [OPEN] ??? still problems in display in VS (but not in Wings3D)
# *) [OPEN low] Add DBM support for the bsptree and centerbsptree hash.
#           See bottom of file for code.
# *) [OPEN] skip faces that are on the viewplane (see $DEBUG:MARK3 )
# *) [OPEN] support for multiple objects (very low priortity right now).
#    - [DONE] read_from_obj -> read_from_obj_new
#    - [DONE] delete_backfaces
#    - [DONE] triangulate
#    - [OPEN]check if objects can share vertexnumbers
# *) [OPEN high] Support for TAG-geometry (requires multiple object support)
#    - [PENDING] read template file and replace the name tags (Vegastrike Mounts/Docks/Lights)
#      with the 3D-data from the model.
#      Example (syntax useable?):
#        Template file: '<Unit #unittagdata#>  <!-- needs better name -->
#                        #meshfilelist#        <!-- needs better name -->
#                        <Mount weapon='Photon Torpedo VI' size='heavy-photon' #tag_m_0001# />
#                        ...'
#        3D/Tag data:   MountPosition(0,1,20)
#        Result:        '<Unit scale='1.0'> 
#                          <Meshfile file='Galaxy_bussardglow1.xmesh'/>
#                          <Meshfile file='Galaxy_nacelleglow1.xmesh'/>
#                          <Mount weapon='Photon Torpedo VI' size='heavy-photon'  x='0.0' y='1.0' z='20.0' />
#                        ...'
#    - [OPEN] Remove the 3D-Tags from the file and export it to xxx (optional as a whole )
# *) [OPEN high] add cvs line output
# *) [OPEN low] add XUNIT export
# *) [OPEN] Check if normal data of the intersection point is correct .
#    - [OPEN] If this is correct, reenabling of UseNormals='1' in xmesh export should be possible.
# *) [OPEN low] add XMESH/XUNIT import
# *) [OPEN] add BFXM import/export
# *) [OPEN low] Add function to add a point in a face (on an edge).
#    This is to make a geometry that is winged-edge ok.
#    input: ($face, $vertexnumber1,$vertexnumber2, $vertexnumber_new)
#    output: $changed_face
#    - [OPEN] Also add a function that searches through all the faces and
#      find faces with a particular edge to add the new vertex.
# *) [OPEN verylow] use sysopen for opening files (strict??)
#      no strict 'subs';
#      sysopen(FILEHANDLE, $filename, O_RDONLY)         || die "failed to open $filename\n";
# END TODO
#######################################################################

use strict;
use warnings;

use File::Basename;	#$base = basename($filename);
use Data::Dumper;

# BEGIN Benchmark module
my $use_benchmark = 0;
my $timer;
if ($use_benchmark) {
	require Time::HiRes; # needed for Benchmark::Timer
	require Benchmark::Timer;
	$timer = Benchmark::Timer->new(skip => 1);
}
# END Benchmark

#######################################################################
# DEFINITION OF GLOBAL VARIABLES (and default behaviour)
#######################################################################
my $verbose;
my $undef_vars = 1;	# $DEBUG:testing "if ($undef_vars)"  # Does this cause problems???
my $epsilon = 0.001;	# defines a +/- tolerance for the plane-splitting
					# and similar calculations  (e.g: +/-0.01)
#######################################################################

#######################################################################
# SUBROUTINE DECLARATIONS (needed to prevent strict complaining
# about their use before the definition):
#######################################################################
sub gen_bsptree_new (@%);
sub bsptree2faceslist_new (%);
sub gen_centerbsptree_new (@%%);
sub centerbsptree2faceslist_new (%);
sub get_edges (%);
#######################################################################


#----------------------------------------------------------------------
# BEGIN FILE-IMPORT
#----------------------------------------------------------------------
#######################################################################
# Get the filetype (by extension of the filename)
#######################################################################
sub get_file_type ($) {
	# $DEBUG:TODO check file content at compare with filename as well.
	my ($filename) = @_;
	my $extension = $filename;
	(undef,undef,$extension) = fileparse($filename, qr{\..*});	#$extension =~ s/.*(\..*$)/$1/;
	$extension = lc($extension);
	print "Extension of input file: '",$extension,"'\n";
	SWITCH: { # filetype
	if ($extension eq ".obj") { # OBJ
		print "OBJ file detected.\n";
		return "obj";
		last SWITCH;
		}
	if ($extension eq ".xmesh") { # XMESH
		print "XMESH file detected.\n";
		return "xmesh";
		last SWITCH;
		}
	if ($extension eq ".bfxm") { # BFXM
		print "BFXM is unsupported right now!\n";
		return "bfxm";
		last SWITCH;
		}
	#else
	print "Bad/Unknown filetype found!\n";
	return "BADFILETYPE";
	} #SWITCH filetype
} # sub get_file_type

#######################################################################
# Import/export any file file
#######################################################################
sub read_from_any ($) {
	my ($filename) = @_;
	my $filetype = get_file_type($filename);
  	SWITCH: { # filetype
	if ($filetype eq "obj") { # OBJ
		return read_from_obj($filename);
		last SWITCH;
		}
	if ($filetype eq "xmesh") { # XMESH
		return read_from_xmesh($filename);
		last SWITCH;
		}
	if ($filetype eq "bfxm") { # BFXM
		print "DEBUG: read_from_bfxm() function not written yet!\n";
		last SWITCH;
		}
	#else
	print "Bad/Unknown filetype found! ",$filetype,"\n";
	return -1;
	} #SWITCH filetype
} # sub read_from_any

sub write_to_any ($%) {
	my ($filename, $objects) = @_;
	die "write_to_any:objects"	unless ( ref($objects) eq 'HASH' );
	my $filetype = get_file_type($filename);
  	SWITCH: { # filetype
	if ($filetype eq "obj") { # OBJ
		write_to_obj($filename, $objects);
		last SWITCH;
		}
	if ($filetype eq "xmesh") { # XMESH
		write_first_to_obj($filename, $objects);
		last SWITCH;
		}
	if ($filetype eq "bfxm") { # BFXM
		print "DEBUG: write_to_bfxm() function not written yet!\n";
		last SWITCH;
		}
	#else
	print "Bad/Unknown filetype found! ",$filetype,"\n";
	return -1;
	} #SWITCH filetype
} # sub write_to_any

#######################################################################
# Import obj file
#######################################################################
# Example objects data:
# $objects=
#    {#global options
#     'mtllib'   => ""
#     'vertices' => {1=>[x,y,z]}, 'vert_counter' => 0,
#     'vndata'   => {1=>[i,j,k]},   'norm_counter' => 0
#     'uvdata'   => {1=>[u,v]},   'uv_counter'   => 0,
#
#     'objects'  =>
#       [{'objectname'=> '',
#         'groupname' => '',
#         'mtlname'   => '',
#         'faces'     => [ {'face'=>[{'v'=>1, 'vt'=>1, 'vn'=>1},
#                                    {}],
#                            'mtl'=>''
#                          }
#                          {}
#                        ]
#        },
#        {}
#       ],
#	'materials' => $material_hash
#   };
sub read_from_obj ($) {
	my ($filename) = @_;

	my $objects = {
		'vertices' => {}, 'vert_counter' => 0,
		'uvdata'   => {}, 'uv_counter'   => 0,
		'vndata'   => {}, 'norm_counter' => 0 ,
		'objects'  => []
		};
 
	my $current_object = {
		'initial_dummy'=>1,
		'objectname'=>'default',
		'groupname'=>'default',
		'type'=>'from_obj'
		};
		
	my $current_mtlname = "";
  
	open(OBJ_IN, "< ".$filename) ||
		die "Failed to open '".$filename."' .\n";

	while(<OBJ_IN>) {
		next if /^\s*#/;	# skip comments
		next if /^$/;	# skip blank lines
		chomp;

		/^\s*mtllib\s/ && do { # test.mtl
			(undef, $objects->{'mtllib'}) = split;
			#$objects->{'mtllib'} = $mtlname_found; 
			print "Material library: '".$objects->{'mtllib'}."'\n";
		};
		/^\s*g\s/ && do {
			if (!exists $current_object->{'initial_dummy'}) { 
				push(@{$objects->{'objects'}}, {%{$current_object}});
			}
			$current_object = {
				'objectname'=>$current_object->{'objectname'},  # save previous object name
				'faces'=>[]
				};
			(undef, $current_object->{'groupname'})  = split;
			print "Group:    '".$current_object->{'groupname'}."'\n";
			};

		/^\s*o\s/ && do {
			(undef, $current_object->{'objectname'}) = split;
			print "Object:    '".$current_object->{'objectname'}."'\n";
			};

  
		/^\s*usemtl\s/ && do { # body_auv
			if ($current_mtlname eq "") {
				print "1st\n";
				(undef, $current_object->{'mtlname'}) = split;
				$current_mtlname = $current_object->{'mtlname'};
				print "Usemtl:   '".$current_object->{'mtlname'}."'\n";
			} else {
				(undef, $current_mtlname) = split;
				print "Usemtl*X :'".$current_mtlname."'\n";
			}
			};
		/^\s*v\s/ && do {
			++$objects->{'vert_counter'};
			(undef, my $x, my $y, my $z) = split; # x,y,z = floating point values
			$x *= 1; $y *= 1; $z *= 1; # make the values numbers (hope this works at all)
			print "Vertex: x'$x',y'$y',z'$z'\n" if ($verbose==1);
			my $vertex = [$x, $y, $z];
			$objects->{'vertices'}->{$objects->{'vert_counter'}} = $vertex ;
			};

		/^\s*vt\s/ && do {
			++$objects->{'uv_counter'};
			(undef, my $u, my $v) = split; # u,v = floating point values
			$u *= 1; $v *= 1; # make the values numbers (hope this works at all)
			print "UV: u'$u',v'$v'\n" if ($verbose==1);
			my $uv_numbers = [$u,$v];
			$objects->{'uvdata'}->{$objects->{'uv_counter'}} = $uv_numbers;
			};
   
		/^\s*vn/ && do { # vn is not yet supported
			++$objects->{'norm_counter'};
			(undef, my $i, my $j, my $k) = split; # i,j,k = floating point values
			$i *= 1; $j *= 1; $k *= 1; # make the values numbers (hope this works at all)
			print "Normal: i'$i',j'$j',k'$k'\n" if ($verbose==1);
			my $vn_numbers = [$i, $j, $k];
			$objects->{'vndata'}->{$objects->{'norm_counter'}} = $vn_numbers;
			};

		/^\s*f\s/ && do {
			(undef, my @indices) = split;
			print "Face: " if ($verbose==1);
			my $dummy_face = [];
			foreach my $vertexnumbers_text ( @indices ) {
				my ($vert, $vt, $vn) = split(/\//,$vertexnumbers_text);
				if (!$vert)	{die "no vertex-number\n"};
				if (!$vt)	{die "no uv-number found\n"};     # $DEBUG:testing
				if (!$vn)	{die "no normal-number found\n"}; # $DEBUG:testing
				$vert = int($vert); $vt = int($vt); $vn = int($vn); # make the values (integer) numbers (hope this works at all)
				my $vertexnumbers = {
					'v'   => $vert,
					'vt'  => $vt,
					'vn'  => $vn 
					};
				push(@{$dummy_face}, $vertexnumbers );
				print "$vert,$vt,$vn " if ($verbose==1);
			}
			my $face = {
				'face'=> $dummy_face,
				'mtl' => $current_mtlname
				};
			push(@{$current_object->{'faces'}}, $face);
			print "\n" if ($verbose==1);
			};
	} # while <>

	if (!exists $current_object->{'initial_dummy'}) {	# if 'current_object' isn't the first object...
		push(@{$objects->{'objects'}}, {%{$current_object}});  # ...add previous object to the objectlist
	}

	close(OBJ_IN);

#$DEBUG:TODO read materials with read_mtl($); and add them to $objects->{'materials'}

	return $objects;
} # sub read_from_obj

#######################################################################
# Import xmesh file
#######################################################################
sub read_from_xmesh ($) {
	my ($filename) = @_;
	
	###########################
	print "Reading XML tree from xmesh file...\n";
	use XML::Simple qw(:strict);
	my $data_tree = XMLin(
		$filename,
		forcearray=>[],	#		forcearray=>['var', 'color' ],
		KeepRoot=>1,
		KeyAttr =>[],
		GroupTags => {
			'Points'=>'Point',
			'Polygons'=>'Tri',
			#'Polygons'=>'Quad',
			#'Polygons'=>'Trifan'
			
		}
	);
	print "...done.\n";
	#write_to_debug('D:\dummy.txt',Dumper($data_tree));
if (1) {
	###########################
	print "Converting XML tree to 'objects' structure...\n";
	# convert XMl-tree to 'objects' structure
	#foreach $data_tree;
	my $objects = {
		'vertices' => {}, 'vert_counter' => 0,
		'uvdata'   => {}, 'uv_counter'   => 0,
		'vndata'   => {}, 'norm_counter' => 0 ,
		'objects'  => []
		};
 	my ($objectname,undef,undef) = fileparse($filename, qr{\..*});
	my $object = {
		'objectname'	=>$objectname,
		'groupname'	=> $objectname,
#		'objectname'	=> 'default',	# $DEBUG:TODO get objectname from filename and reduce it to 12 (or 14) characters
#		'groupname' 	=> 'default'	# $DEBUG:TODO get objectname from filename and reduce it to 12 (or 14) characters
		'mtlname'	=> $objectname,
		#'texture'	=> '',
		'type'=>'from_xmesh',
		'faces'=>[]
		};

	############
	print " Adding points and normal data...\n";
	my $point = {};
	foreach $point (@{$data_tree->{'Mesh'}->{'Points'}}) {
		#add point data
		if (exists $point->{'Location'}) {
			$objects->{'vertices'}->{$objects->{'vert_counter'}} = [
				$point->{'Location'}->{'x'},
				$point->{'Location'}->{'y'},
				$point->{'Location'}->{'z'}
				];	
			$objects->{'vert_counter'}++;
		}
		#add normal data
		if (exists $point->{'Normal'}) {
			$objects->{'vndata'}->{$objects->{'norm_counter'}} = [
				$point->{'Normal'}->{'i'},
				$point->{'Normal'}->{'j'},
				$point->{'Normal'}->{'k'}
				];	
			$objects->{'norm_counter'}++;
		}
		undef $point if ($undef_vars); # $DEBUG:TODO is this working to reduce memory wasting?
	}
	undef $data_tree->{'Mesh'}->{'Points'} if ($undef_vars); # $DEBUG:CHECK working?
	print " ... points done.\n";
	print " Adding faces and uv data...\n";
	my $polygon = {};
	foreach $polygon (@{$data_tree->{'Mesh'}->{'Polygons'}}) {
		my $dummy_face=[];
		#print Dumper($polygon);
		foreach my $vertex (@{$polygon->{'Vertex'}}) {
			my $vertexnumbers=[];
			#print Dumper($vertex);
			if (	(exists $vertex->{'s'}) &&
				(exists $vertex->{'t'}))  {
				$objects->{'uvdata'}->{$objects->{'uv_counter'}} = [
					$vertex->{'s'},
					$vertex->{'t'}
					];	
				
				$vertexnumbers = {
					'v'=>$vertex->{'point'},
					'vt'=>$vertex->{'point'},
					'vn'=>$objects->{'uv_counter'}
					};
				
				$objects->{'uv_counter'}++;
				
			} else {
				$vertexnumbers = {
					'v'=>$vertex->{'point'},
					'vt'=>$vertex->{'point'},
					'vn'=>-1					 # $DEBUG:TODO better solution + checking?
					};
			}
			push(@{$dummy_face}, $vertexnumbers );
		}
		my $face = {'face'=> $dummy_face,
			'texture'=>$object->{'texture'}
			};
		push(@{$object->{'faces'}}, $face);
		undef $polygon if ($undef_vars); # $DEBUG:TODO is this working to reduce memory wasting?
	}
	undef $data_tree->{'Mesh'}->{'Polygons'} if ($undef_vars); # $DEBUG:CHECK working?
	print " ... faces done.\n";
	# faces& uvdata done
	############
	
	############
	# add material (textures, etc...) and mesh data (texture, scale, etc...)
	print " Adding material and general mesh data....\n";
	my $ambient	= $data_tree->{'Mesh'}->{'Material'}->{'Ambient'};
	my $diffuse	= $data_tree->{'Mesh'}->{'Material'}->{'Diffuse'};
	my $specular	= $data_tree->{'Mesh'}->{'Material'}->{'Specular'};
	
	my $material_hash = {$objectname => {
		'diffuse'		=> [$diffuse->{'red'}, $diffuse->{'blue'}, $diffuse->{'green'}],
		'ambient'		=> [$ambient->{'red'}, $ambient->{'blue'}, $ambient->{'green'}],
		'specular'	=> [$specular->{'red'}, $specular->{'blue'}, $specular->{'green'}],
		'illumination'	=> 2,	# $DEBUG:TODO
		'xmesh_diffuse_alpha'	=>$diffuse->{'alpha'},
		'xmesh_ambient_alpha'	=>$ambient->{'alpha'},
		'xmesh_specular_alpha'	=>$specular->{'alpha'}
		}};

	$material_hash->{$objectname}->{'diffuse_map'}	= $data_tree->{'Mesh'}->{'texture'} if (exists $data_tree->{'Mesh'}->{'texture'});
	$material_hash->{$objectname}->{'ambient_map'}	= 1 if (0) ; #$data_tree->{'Mesh'}->{'texture'}; # $DEBUG:TODO
	$material_hash->{$objectname}->{'specular_map'}	= 1 if (0) ; #$data_tree->{'Mesh'}->{'texture'}; # $DEBUG:TODO
	$material_hash->{$objectname}->{'xmesh_reflect'}	= $data_tree->{'Mesh'}->{'Material'}->{'reflect'} if (exists $data_tree->{'Mesh'}->{'Material'}->{'reflect'});
	$material_hash->{$objectname}->{'xmesh_UseNormals'}	= $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'UseNormals'});
	$material_hash->{$objectname}->{'xmesh_LightningOn'}	= $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'LightningOn'});
	$material_hash->{$objectname}->{'xmesh_scale'}		= $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'scale'});
	$material_hash->{$objectname}->{'xmesh_sharevertex'}	= $data_tree->{'Mesh'}->{'UseNormals'} if (exists $data_tree->{'Mesh'}->{'sharevertex'});
	
	$objects->{'materials'} = $material_hash;
	print " ...materials done.\n";	
	# material done
	###############

	undef $data_tree if ($undef_vars);
	
	push(@{$objects->{'objects'}}, {%{$object}});  # ...add previous object to the objectlist

	undef $object if ($undef_vars); # $DEBUG_CHECK working?
	
	#write_to_debug('D:\dummy.txt',Dumper($objects));
	print "...converting done.\n";	
	return $objects;
}
} # sub read_from_xmesh

#######################################################################
# TODO:  Convert tag-objects to VegaStrike Tag-Info and remove them from the objectlist
#######################################################################
sub objects2vstags (%) {
	my ($objects) = @_;
		die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
	my $normal_objects=[];
	my $vs_tags={};
	my $object={};
	foreach $object (@{$objects->{'objects'}})  {
		if ($object->{'objectname'} =~ m/^tag_(.)_.*/) {	# matching tag objectnames (.+ ... one or more characters)
			my $tag_type = \1;						# get regex-group defined by (.)
#if (correct_tag) { # $DEBUG:TODO
if (1) {
			my ($x,$y,$z,$r,$s,$t) = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0);		#$DEBUG:TODO  tagobj2data($object);
			# ($x,$y,$z,$r,$s,$t) = ($x*1.0,$y*1.0,$z*1.0,$r*1.0,$s*1.0,$t*1.0) #$DEBUG:TODO
			SWITCH: {
			if (	($tag_type eq "w") ||   # MOUNT/WEAPON
				($tag_type eq "d")  ) { # DOCK
				$vs_tags->{$object->{'objectname'}} =
					"x='".$x."' ".
					"y='".$y."' ".
					"z='".$z."' ";
				last SWITCH;
				}
			if (	($tag_type eq "l") ||   # LIGHT/ENGINE
				($tag_type eq "s")  ) { # SUBUNIT
				$vs_tags->{$object->{'objectname'}} =
				"x='".$x."' y='".$y."' z='".$z."' ".
				"r='".$r."' s='".$s."' t='".$t."' ";
				last SWITCH;
				}
			#else
			print "Unknown tag-type! Ignored.\n";
			} # SWITCH tag_type
} else { 
	print "Bad tag-object! Ignored.\n";
} # if correct_tag
		} # if tag-object
		else {
			push(@{$normal_objects},$object); # leave object in the list
		}# if tag-object
	}
	$objects->{'objects'} = $normal_objects; # delete tag objects
	return $vs_tags;
}

#######################################################################
# TODO: replace the tags in the given file
#######################################################################
sub write_vstags_template($%$) {
	my ($filename, $vs_tags, $write_new_file) = @_;

	if ($write_new_file) {
		open(TEMPLATE_IN, "< ".$filename) ||
			die "failed to open $filename\n";
		open(TEMPLATE_OUT, "> ".$write_new_file) ||
			die "failed to open $write_new_file\n";
		#sysopen(TEMPLATE_IN, $filename, O_RDONLY) || die "failed to open $filename\n";
		while(<TEMPLATE_IN>) {
			my $vstag_key = '';
			my $line = '';
			foreach $vstag_key (keys %{$vs_tags}) {
				$line = $_;
				$line =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
				printf TEMPLATE_OUT "$line";
			} # foreach vstag_key

		} # while <>
		close(TEMPLATE_IN);
		close(TEMPLATE_OUT);
	} else {
		open(TEMPLATE, "+< $filename") ||
			die "failed to open $filename\n";
		while(<TEMPLATE>) {
			my $vstag_key = '';
			foreach $vstag_key (keys %{$vs_tags}) {
				# $_ =~ s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
				s/^(.*)$vstag_key(.*)/$1$vs_tags->{vstag_key}$2/g;
			} # foreach vstag_key
		} # while <>
		close(TEMPLATE);
	} # if write_new_file
}

#######################################################################
# TODO: Merge several objects into one
#######################################################################
sub merge_objects(%) { # only works for xmesh if the material is the same right now
	my ($objects) = @_;
	die "merge_objects:objects" unless ( ref($objects) eq 'HASH' );
	my $final_object = {
		'objectname' => 'merged_all',
		'groupname' => 'merged_all',
		'mtlname' => $objects->{'objects'}->[0]->{'mtlname'},
		'faces' => []
		};
	my $object = {};
	foreach $object (@{$objects->{'objects'}})  {
		push(@{$final_object->{'faces'}},$object->{'faces'});
	}
	$objects->{'objects'} = [ $final_object ];
}


#######################################################################
# Get the total facecount of the objects
#######################################################################
sub objects_facecount (%) {
	my ($objects) = @_;
	#write_to_debug('D:\dummy.txt',Dumper($objects));
	die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
	my $facecount=0;
	my $object = {};
	foreach $object (@{$objects->{'objects'}}) {
		$facecount += $#{ $object->{'faces'}} + 1;
	}
	return $facecount;
}


#######################################################################
# Read obj-material file (.mtl)
#######################################################################
# Example material data:
#my $material_hash={'mtl_name'=>{ 
#	'diffuse'=>[1, 1, 1],
#	'ambient'=>[1, 1, 1],
#	'specular'=>[1, 1, 1],
#	'diffuse_map'=>"",
#	'ambient_map'=>"",
#	'specular_map'=>"",
#	'illumination'=>2,
#	'xmesh_Diffuse_alpha'=>0,
#	'xmesh_Ambient_alpha'=>0,
#	'xmesh_Specular_alpha'=>0,
#	'xmesh_reflect'=>1,
#	'xmesh_UseNormals'=>1,
#	'xmesh_LightningOn'=>1,
#	'xmesh_scale'=>1,
#	'xmesh_sharevertex'=>0
#	};
###
sub read_mtl ($) {
	my ($filename) = @_;

	open(MTL_IN, "< ".$filename) ||
		die "failed to open $filename\n";

	my $material_hash = {};
	my $current_mtlname = "";
	my $current_mtl = {};

	while(<MTL_IN>)  {
		next if /^\s*#/;	# skip comments
		next if /^$/;	# skip blank lines
		chomp;
		/^newmtl\s/ && do {
			$material_hash->{$current_mtlname} = $current_mtl;
			$current_mtl = {};
			(undef, $current_mtlname) = split;
		};

		/^illum\s/ && do {
			(undef,  $current_mtl->{'illumination'}) = split;
		};

		/^Kd\s/ && do {
			$current_mtl->{'diffuse'} = [];
			(undef,
			$current_mtl->{'diffuse'}->[0],
			$current_mtl->{'diffuse'}->[1],
			$current_mtl->{'diffuse'}->[2] ) = split;
		};

		/^Ka\s/ && do {
			$current_mtl->{'ambient'} = [];
			(undef,
			$current_mtl->{'ambient'}->[0],
			$current_mtl->{'ambient'}->[1],
			$current_mtl->{'ambient'}->[2] ) = split;
		};

		/^Ks\s/ && do {
			$current_mtl->{'specular'} = [];
			(undef,
			$current_mtl->{'specular'}->[0],
			$current_mtl->{'specular'}->[1],
			$current_mtl->{'specular'}->[2] ) = split;
		};

		/^map_Kd\s/ && do {
			(undef,  $current_mtl->{'diffuse_map'}) = split;
		};

		/^map_Ka\s/ && do {
			(undef,  $current_mtl->{'ambient_map'}) = split;
		};

		/^map_Ks\s/ && do {
			(undef,  $current_mtl->{'specular_map'}) = split;
		};

		/^d\s/ && do {
			# $DEBUG:TODO
		};

		/^Ns\s/ && do {
			# $DEBUG:TODO
		};

	} # while <>
	close(MTL_IN);

	$material_hash->{$current_mtlname} = $current_mtl;
	return $material_hash;
} # sub read_mtl

#-----------------------------------------------------------------------
# END FILE-IMPORT
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# BEGIN PLANE FUNCTIONS
#-----------------------------------------------------------------------
#######################################################################
# Calculate plane from 3 vertices/points
# input   (point1,point2,point3)
# returns (A,B,C,D)
#######################################################################
sub vert3_to_plane (@@@) {
	use Math::VectorReal;
	my ($vertex1, $vertex2, $vertex3 ) = @_;
	die "vert3_to_plane:vertex1 ".$vertex1 unless ( ref($vertex1) eq 'ARRAY' );
	die "vert3_to_plane:vertex2 ".$vertex2 unless ( ref($vertex2) eq 'ARRAY' );
	die "vert3_to_plane:vertex3 ".$vertex3 unless ( ref($vertex3) eq 'ARRAY' );
	die "vert3_to_plane:The given vertices are not useable." unless vert3_ok($vertex1, $vertex2, $vertex3 );
#  print vert3_ok($vertex1, $vertex2, $vertex3 );
 
	my ($x1, $y1, $z1) = @{$vertex1};
	my ($x2, $y2, $z2) = @{$vertex2};
	my ($x3, $y3, $z3) = @{$vertex3};

#print "1 ".$x1." ".$y1." ".$z1."\n"; #$DEBUG:testing
#print "2 ".$x2." ".$y2." ".$z2."\n"; #$DEBUG:testing
#print "3 ".$x3." ".$y3." ".$z3."\n"; #$DEBUG:testing

	my $vec1 = vector($x1, $y1, $z1 );
	my $vec2 = vector($x2, $y2, $z2 );
	my $vec3 = vector($x3, $y3, $z3 );

#  print "x\n"; #$DEBUG:testing
	my ($normal, $distance_from_plane) = plane($vec1, $vec2, $vec3);
#  print "y\n"; #$DEBUG:testing

	return [
		$normal->x,
		$normal->y,
		$normal->z,
		$distance_from_plane
		];
} # sub vert3_to_plane

#######################################################################
# Check if the 3 vertices would be a valid face/plane
# input   (point1,point2,point3)
# returns true=1 / false=0
#######################################################################
sub vert3_ok (@@@) {
	if ($use_benchmark) {$timer->start('vert3_ok')};
	my ($vertex1, $vertex2, $vertex3 ) = @_;
	die "vert3_ok:vertex1"   unless ( ref($vertex1) eq 'ARRAY' );
	die "vert3_ok:vertex2"   unless ( ref($vertex2) eq 'ARRAY' );
	die "vert3_ok:vertex3"   unless ( ref($vertex3) eq 'ARRAY' );
	die "vert3_ok:vertex1_2" unless ( $#{$vertex1} == 2 );
	die "vert3_ok:vertex2_2" unless ( $#{$vertex2} == 2 );
	die "vert3_ok:vertex3_2" unless ( $#{$vertex3} == 2 );

	my $equal_x = ( ($vertex1->[0] == $vertex2->[0]) && ($vertex2->[0] == $vertex3->[0]) );
	my $equal_y = ( ($vertex1->[1] == $vertex2->[1]) && ($vertex2->[1] == $vertex3->[1]) );
	my $equal_z = ( ($vertex1->[2] == $vertex2->[2]) && ($vertex2->[2] == $vertex3->[2]) );

#	die "All vertices in a row, would cause problems when creating plane.\n"
#		.$vertex1->[0]." ".$vertex1->[1]." ".$vertex1->[2]."\n"
#		.$vertex2->[0]." ".$vertex2->[1]." ".$vertex2->[2]."\n"
#		.$vertex3->[0]." ".$vertex3->[1]." ".$vertex3->[2]."\n"
	if ($use_benchmark) {$timer->stop('vert3_ok')};
	if (	($equal_x && $equal_y) ||
		($equal_y && $equal_z) ||
		($equal_x && $equal_z)   ) {
		return 0;
	}
	return 1; # else
} # sub vert3_ok

#######################################################################
# Calculate plane from the first 3 vertices of a face
# usage   (face,verticelist)
# returns (A,B,C,D)
#######################################################################
sub face2plane (@%) {
	my ($face, $vertices ) = @_;
	die "face2plane:face"		unless ( ref($face)     eq 'ARRAY' );
	die "face2plane:vertices"	unless ( ref($vertices) eq 'HASH' );
  
	#my ($v1,$v2,$v3) = ([],[],[]);
	my ($v1,$v2,$v3) = ('error_couldnt_create_plane',
			'error_couldnt_create_plane',
			'error_couldnt_create_plane' ); 

	my $last_point_number = $#{$face} - 2 ;
	for (my $i = 0; $i <= $last_point_number; $i++) {		# loop through the vertices of the face
		if (vert3_ok($vertices->{$face->[$i  ]->{'v'}},
				$vertices->{$face->[$i+1]->{'v'}},
				$vertices->{$face->[$i+2]->{'v'}} ) ) {
		($v1,$v2,$v3) = ($vertices->{$face->[$i  ]->{'v'}},
			$vertices->{$face->[$i+1]->{'v'}},
			$vertices->{$face->[$i+2]->{'v'}} );
		last;
		}
	}
	my $plane  = vert3_to_plane ( $v1, $v2, $v3 );
	return $plane;
} # sub face2plane


#######################################################################
# Classify a vertex/point relative to a plane
# usage   (plane,point)
# returns distance_to_plane
#######################################################################
sub classify_point_by_plane (@@) {
	if ($use_benchmark) {$timer->start('classify_point_by_plane')};
	my ($plane, $vertex) = @_;
	die "classify_point_by_plane:plane"  unless ( ref($plane)  eq 'ARRAY' );
	die "classify_point_by_plane:vertex" unless ( ref($vertex) eq 'ARRAY' );

	my ($a, $b, $c, $d) = @{$plane};
	my ($x, $y, $z) = @{$vertex};
	if ($use_benchmark) {$timer->stop('classify_point_by_plane')};
	return (($a * $x) + ($b * $y) + ($c * $z)) - $d; #-$d
} # sub classify_point_by_plane

#######################################################################
# Classify a face relative to a plane
# usage   (plane,face,verticelist)
# returns left=1 / crossing=0 / right=-1 ?????
# returns left=-1 / crossing=0 / right=1 ?????
#######################################################################
sub classify_face_by_plane (@@%) {
	if ($use_benchmark) {$timer->start('classify_face_by_plane')};
	my ($plane, $face, $vertices) = @_;
	die "classify_face_by_plan:plane"	unless ( ref($plane)    eq 'ARRAY' );
	die "classify_face_by_plan:face"	unless ( ref($face)     eq 'ARRAY' );
	die "classify_face_by_plan:vertices"	unless ( ref($vertices) eq 'HASH'  );

	my $status = 0;

	my $last_point_number = $#{$face};
	for (my $i = 0; $i <= $last_point_number; $i++) {		# loop through the vertices of the face
		my $vertex = $vertices->{$face->[$i]->{'v'}};
		my $side = classify_point_by_plane($plane,  $vertex );
		if ( $side <= -$epsilon) {
			if ($status ==  1 )  { if ($use_benchmark) {$timer->stop('classify_face_by_plane')}; return 0; };
			#else
			$status = -1;
		};
		if ( $side >= $epsilon ) {
			if ( $status == -1 ) { if ($use_benchmark) {$timer->stop('classify_face_by_plane')}; return 0; };
			#else
			$status = 1;
		};
		#if ( $side == 0 )     { return 0; }; # $DEBUG:testing only deactivated for testing purpose
	} #for
	if ($use_benchmark) {$timer->stop('classify_face_by_plane')};
	return $status; # 0=crossing, 1/-1=left/right (or reverse)
} # sub classify_face_by_plane

#######################################################################
# split an edge by a plane (and calculate the intersection point)
# usage   (point1,point1-UV,point1-NORMAL,point2,point2-UV,point2-NORMAL,plane,vertexcount,UV-count,NORMAL-count)
# returns (intersectionpoint,intersectionpoint-UV,intersectionpoint-NORMAL,new-vertexcount,new-UV-count,new-NORMAL-count)
#######################################################################
sub intersect_edge_with_plane (@@@@@@@$$) {
	if ($use_benchmark) {$timer->start('intersect_edge_with_plane')};
	use Math::VectorReal;	# qw(:all);
	my (	$vertex1, $vertex1_uv, $vertex1_vn,
		$vertex2, $vertex2_uv, $vertex2_vn,
		$plane,
		$vertexcount,  $uvcount, $vncount  ) = @_;

	die "intersect_edge_with_plane:vertex1"	unless ( ref($vertex1)    eq 'ARRAY' );
	die "intersect_edge_with_plane:vertex2"	unless ( ref($vertex2)    eq 'ARRAY' );
	die "intersect_edge_with_plane:vertex1_uv"	unless ( ref($vertex1_uv) eq 'ARRAY' );
	die "intersect_edge_with_plane:vertex2_uv"	unless ( ref($vertex2_uv) eq 'ARRAY' );
	die "intersect_edge_with_plane:vertex1_vn"	unless ( ref($vertex1_vn) eq 'ARRAY' );
	die "intersect_edge_with_plane:vertex2_vn"	unless ( ref($vertex2_vn) eq 'ARRAY' );
	die "intersect_edge_with_plane:plane"	unless ( ref($plane)      eq 'ARRAY' );

	my ($x1, $y1, $z1) = @{$vertex1};
	my ($x2, $y2, $z2) = @{$vertex2};
	my ($u1, $v1) = @{$vertex1_uv};
	my ($u2, $v2) = @{$vertex2_uv};
	my ($a, $b, $c, $d) = @{$plane};

	my $side1		= classify_point_by_plane($plane, $vertex1);
	my $vertex1_vec	= vector($x1, $y1, $z1 );
	my $vertex2_vec	= vector($x2, $y2, $z2 );
	my $normal		= vector($a, $b, $c);
	my $vector12		= vector($x2-$x1, $y2-$y1, $z2-$z1);        #  my $vector12        = $vertex1_vec - $vertex2_vec; #???

	die "points in the same place"       if ($vector12->length == 0); # $DEBUG:better code needed
	die "normal vector with zero length" if ($normal->length   == 0); # $DEBUG:better code needed

	my $sect = ( -$side1 / ( $normal . $vector12 ) );    #  my $sect           =  -$side1/($a*($x2-$x1) + $b * ($y2-$y1) + $c * ($z2-$z1));

	my $vertex_int_vec = $vertex1_vec + ($vector12 * $sect);       #  my $vertex_int_vec = vector( $x1+(($x2-$x1)*$sect),$y1+(($y2-$y1)*$sect),$z1+(($z2-$z1)*$sect) );
	my $vertex_int_length = $vertex_int_vec->length;

  ##########
  # BEGIN calculating the new uv data
	my ($ui, $vi) = ($u1, $v1);
	my $vector1i_length = vector(
		$vertex_int_vec->x - $x1,			#  my $vector1i_length = ($vertex1_vec - $vertex_int_vec)->length; #???
		$vertex_int_vec->y - $y1,
		$vertex_int_vec->z - $z1 )->length;	#OK (mit I-1)

	if ($vector1i_length  != 0) {
		my ($u12, $v12) = ($u2 - $u1, $v2 - $v1);
		my $mult = ($vector1i_length / $vector12->length);
		($ui, $vi) = (
			$u1 + ($u12 * $mult),
			$v1 + ($v12 * $mult)
			);
		};
  # END new uv data
  ##########
  # BEGIN calculating the new normal data
	my $vni = get_avg_normal_vector ($vertex1_vn, $vertex2_vn);
  # END new normal data
  ##########

	++$vertexcount;
	++$uvcount;
	++$vncount;
	if ($use_benchmark) {$timer->stop('intersect_edge_with_plane')};
	return (
		[	$vertex_int_vec->x,
			$vertex_int_vec->y,
			$vertex_int_vec->z ],
		[$ui, $vi],
		$vni,
		$vertexcount, $uvcount, $vncount );
} # sub intersect_edge_with_plane

#----------------------------------------------------------------------
# END PLANE FUNCTIONS
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN FACE FUNCTIONS
#----------------------------------------------------------------------
#######################################################################
# Check if face is inside/outside/crossing of the(extended)  frustum of another face
#######################################################################
#  *) loop trough edges of first face and use the centerpoint to make planes
#  *) at every plane check if the second face (all points) are on one side of the plane (hopefully completely outside or inside)
# TODO 
#  *) right now the function is written for polygons that are 'round' (so -1 means it is  OUTSIDE for sure )
sub face_in_frustum_of_other_face (@@%) {
	my ($face1, $face2, $vertices) = @_;
	# face1 ... the face that provides the fustrum
	# face2 ... the face that has to be checked if it is inside/etc...
	die "face_in_frustum_of_other_face:face1"	unless ( ref($face1)    eq 'ARRAY' );
	die "face_in_frustum_of_other_face:face2"	unless ( ref($face2)    eq 'ARRAY' );
	die "face_in_frustum_of_other_face:vertices"	unless ( ref($vertices) eq 'HASH'  );
	my $status = 666; 
	my $zero_point   = [0, 0, 0];

	my $last_point_number = $#{$face1};
	for (my $i=0; $i<=$last_point_number; $i++) {	# loop through the vertices of the face
		my ($vertexnumbers1, $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
		my $vertex1	= $vertices->{$vertexnumbers1->{'v'}};
		my $vertex2	= $vertices->{$vertexnumbers2->{'v'}};
		my $zeroplane	= vert3_to_plane($zero_point, $vertex1, $vertex2 );
		my $status_2	= classify_face_by_plane ($zeroplane, $face2, $vertices);

		if ( 0 == $status_2) { return  0; }	# the face is crossing, no further checks necessary
		if (-1 == $status_2) { return -1; } 
		if ( 1 == $status_2) { $status =  1; }	# the face is on the side of the polygon (but not yet inside for sure... loop is going on)
	}
	return $status;	# 0=crossing; 1=in; - 1=out;	#maybe -1 and 1 swapped
}

#######################################################################
# Check if a face is inside/outside/crossing of another face
# TODO? ...VERY similar to face_in_frustum_of_other_face
#######################################################################
sub face_inside_of_other_face (@@%) {
	my ($face1, $face2, $vertices) = @_;
	# face1 ... the face that provides the xxx
	# face2 ... the face that has to be checked if it is inside/etc...
	die "face_inside_of_other_fac:face1"	unless ( ref($face1) eq 'ARRAY' );
	die "face_inside_of_other_fac:face2"	unless ( ref($face2) eq 'ARRAY' );
	die "face_inside_of_other_fac:vertices"	unless ( ref($vertices) eq 'HASH'  );

	my $status = 666; 
	my ($a, $b, $c, $d) = face2plane($face1, $vertices );

	my $last_point_number = $#{$face1};
	for (my $i=0; $i<=$last_point_number; $i++) {	# loop through the vertices of the face
		my ($vertexnumbers1, $vertexnumbers2 ) = get_edgenumbers_from_face ($i,$face1);
		my $vertex1 = $vertices->{$vertexnumbers1->{'v'}};
		my $vertex2 = $vertices->{$vertexnumbers2->{'v'}};
		my $normalpoint = [
			$vertex1->[0] + $a,
			$vertex1->[1] + $b,
			$vertex1->[2] + $c
			];
		my $zeroplane  = vert3_to_plane($vertex1, $vertex2, $normalpoint );
		my $status_2   = classify_face_by_plane ($zeroplane, $face2, $vertices);

		if ( 0 == $status_2) { return  0; };	#the face is crossing, no further checks necessary
		if (-1 == $status_2) { return -1; }; 
		if ( 1 == $status_2) { $status =  1; }	# the face is on the side of the polygon (but not yet inside for sure... loop is going on)
	}
	return $status; # 0=crossing; 1=in; - 1=out;	#maybe -1 and 1 swapped
}

#######################################################################
# Calculates the min/max distance of a face to the center point
#######################################################################
sub distance_face_from_center (@$%) {
	if ($use_benchmark) {$timer->start('distance_face_from_center')};
	my ($face, $max, $vertices) = @_;
	die "distance_face_from_center:face"	 unless ( ref($face)     eq 'ARRAY' );
	die "distance_face_from_center:vertices"	unless ( ref($vertices) eq 'HASH'  );
  
	my $dist;
	if ($max) { # a bit redundant, but may be faster then the other alternative
		for (my $i=0; $i<=$#{$face}; $i++) {	# loop through the vertices of the face
			my $vertex = $vertices->{$face->[$i]->{'v'}};
			my $dummy_dist = sqrt(
				($vertex->[0])**2 +
				($vertex->[1])**2 +
				($vertex->[2])**2  );
			if ($i == 0) {
				$dist = $dummy_dist; }
			if ($dummy_dist > $dist) {
				$dist = $dummy_dist; }
		}
	} else {
		for (my $i=0; $i<=$#{$face}; $i++) {	# loop through the vertices of the face
			my $vertex = $vertices->{$face->[$i]->{'v'}};
			my $dummy_dist = sqrt(
				($vertex->[0])**2 +
				($vertex->[1])**2 +
				($vertex->[2])**2  );
			if ($i == 0) {
				$dist = $dummy_dist; }
			if ($dummy_dist < $dist) {
				$dist = $dummy_dist; }
		}
	}
	if ($use_benchmark) {$timer->stop('distance_face_from_center')};
	return $dist;
} # sub distance_face_from_center

#----------------------------------------------------------------------
# END FACE FUNCTIONS
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN VECTOR FUNCTIONS
#----------------------------------------------------------------------
#######################################################################
# Makes the length of a vector exactly 1 unit (== normal vector)
#######################################################################
sub make_vector_normal (@) {
	if ($use_benchmark) {$timer->start('make_vector_normal')};
	my ($vector) = @_;
	die "make_vector_normal:vector"     unless ( ref($vector) eq 'ARRAY' );
	die "make_vector_normal:vec_number" unless ( $#{$vector}  == 2       );
	my ($x, $y, $z) = @{$vector};
#  print $x.",".$y.",".$z."\n";  # $DEBUG:testing

	my $length = sqrt(
		($vector->[0]) ** 2 +
		($vector->[1]) ** 2 +
		($vector->[2]) ** 2  );
	if ($use_benchmark) {$timer->stop('make_vector_normal')};
	if ($length > 0) {
		return [
			$x / $length, 
			$y / $length,
			$z / $length
			];
	} else {
		return [0, 0, 0];
	}
} # sub make_vector_normal 

#######################################################################
# Calculates the average normal vector of two given vecs
#######################################################################
sub get_avg_normal_vector (@@) {
	if ($use_benchmark) {$timer->start('get_avg_normal_vector')};
	my ($vector1, $vector2) = @_;
	die "get_avg_normal_vector:vector1"     unless ( ref($vector1) eq 'ARRAY' );
	die "get_avg_normal_vector:vector2"     unless ( ref($vector2) eq 'ARRAY' );
	die "get_avg_normal_vector:vec1_number" unless ( $#{$vector1}  == 2       );
	die "get_avg_normal_vector:vec2_number" unless ( $#{$vector2}  == 2       );
	my ($x1, $y1, $z1) = @{$vector1};
	my ($x2, $y2, $z2) = @{$vector2};
	if ($use_benchmark) {$timer->stop('get_avg_normal_vector')};
	return make_vector_normal( [
		$x1 + $x2,
		$y1 + $y2,
		$z1 + $z2 ] );
} # sub get_avg_normal_vector
#-----------------------------------------------------------------------
# END VECTOR FUNCTIONS
#-----------------------------------------------------------------------


#######################################################################
# get the verticenumbers of an edge by the index of the first vertex
#######################################################################
sub get_edgenumbers_from_face ($@) {
	my ($i, $face ) = @_;
	die "get_edgenumbers_from_face" unless (ref($face) eq 'ARRAY');

	if ($i < $#{$face}) {
		return ( $face->[$i], $face->[$i+1] );
	} else {
		return ( $face->[$i], $face->[0   ] );
	}
} # sub get_edgenumbers_from_face

#-----------------------------------------------------------------------
# BEGIN ADVANCED PLANE FUNCTIONS
#-----------------------------------------------------------------------
#######################################################################
# split a face with a plane
#######################################################################
sub split_face_by_plane (@@%%%$$$) {
	if ($use_benchmark) {$timer->start('split_face_by_plane')};
	my ($face, $plane, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount ) = @_;
	die "split_face_by_plane:face"     if ( ref($face)     ne 'ARRAY' );
	die "split_face_by_plane:plane"    if ( ref($plane)    ne 'ARRAY' );
	die "split_face_by_plane:vertices" if ( ref($vertices) ne 'HASH'  );
	die "split_face_by_plane:uvdata"   if ( ref($uvdata)   ne 'HASH'  );
	die "split_face_by_plane:vndata"   if ( ref($vndata)   ne 'HASH'  );

	my $newvertices    = {};
	my $newuvdata      = {};
	my $newvndata      = {};

	my $pointsnear     = [];
	my $pointsfar      = [];

	my $all_points_on_plane = 1;

	my $last_point_number = $#{$face};
	for (my $i = 0; $i <= $last_point_number; $i++) {                   # loop through the vertices of the face
		my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i,$face);
		my $vertex1    = $vertices->{$vertexnumbers1->{'v'}};
		my $vertex2    = $vertices->{$vertexnumbers2->{'v'}};
		my $vertex1_uv = $uvdata->{$vertexnumbers1->{'vt'}};
		my $vertex2_uv = $uvdata->{$vertexnumbers2->{'vt'}};
		my $vertex1_vn = $vndata->{$vertexnumbers1->{'vn'}};
		my $vertex2_vn = $vndata->{$vertexnumbers2->{'vn'}};
		my $side1      = classify_point_by_plane($plane, $vertex1);
		my $side2      = classify_point_by_plane($plane, $vertex2);

#    if ($vertexnumbers1 == $vertexnumbers2) {die " points are the same";} # $DEBUG:testing remove or replace later
#    if ( ($vertex1->[0] == $vertex2->[0]) &&
#         ($vertex1->[1] == $vertex2->[1]) &&
#         ($vertex1->[2] == $vertex2->[2]) ) {die " points are the same";}   # $DEBUG:testing remove or replace later

		my $intpoint         = [];
		my $intpoint_uv      = [];
		my $intpoint_vn      = [];
		my $intpoint_numbers = {};

		SWITCH: {
		if (	($side2 < -$epsilon) &&
			($side1 <  $epsilon)    ) {			# point2 on one side and point1 als least inside the +/- epsilon
			push(@{$pointsnear}, $vertexnumbers2 );              # pointsnear  + point2
			$all_points_on_plane = 0;
			last SWITCH;      
			}
		if (	($side2 >  $epsilon) &&
			($side1 > -$epsilon)   ) {			# point1 on one side and point2 als least inside the +/- epsilon
			push(@{$pointsfar}, $vertexnumbers2 );               # pointsfar  + point2
			$all_points_on_plane = 0;
			last SWITCH;  
			}
		if (	($side2 >  $epsilon) && 
			($side1 < -$epsilon)    ) {
			($intpoint,    $intpoint_uv, $intpoint_vn,
			$vertexcount, $uvcount    , $vncount     )
			= intersect_edge_with_plane (
				$vertex1, $vertex1_uv, $vertex1_vn,
				$vertex2, $vertex2_uv, $vertex2_vn,
				$plane,
				$vertexcount, $uvcount, $vncount   );

			$intpoint_numbers = {
				'v'  => $vertexcount,
				'vt' => $uvcount,
				'vn' => $vncount     };
			push(@{$pointsnear},	$intpoint_numbers  );				# pointsnear + intp
			push(@{$pointsfar},	$intpoint_numbers, $vertexnumbers2 );	# pointsfar  + intp + point2
			$newvertices->{$vertexcount}	= $intpoint;		# newverticeslist + intp
			$newuvdata->{$uvcount}		= $intpoint_uv;	# -- " --
			$newvndata->{$vncount}		= $intpoint_vn;	# -- " --
			$all_points_on_plane = 0;
			last SWITCH; 
			}

		if (	($side2 < -$epsilon) &&
			($side1 >  $epsilon)    ) {
			($intpoint,    $intpoint_uv, $intpoint_vn,
			$vertexcount, $uvcount,     $vncount     )
			= intersect_edge_with_plane (
				$vertex1, $vertex1_uv, $vertex1_vn,
				$vertex2, $vertex2_uv, $vertex2_vn,
				$plane,
				$vertexcount, $uvcount, $vncount   );
			$intpoint_numbers = {
				'v'  => $vertexcount,
				'vt' => $uvcount,     
				'vn' => $vncount     };
			push(@{$pointsnear},	$intpoint_numbers, $vertexnumbers2 );	# pointsnear + intp + point2
			push(@{$pointsfar},	$intpoint_numbers );				# pointsfar  + intp
			$newvertices->{$vertexcount}	= $intpoint;		# newverticeslist + intp
			$newuvdata->{$uvcount}		= $intpoint_uv;	# -- " --
			$newvndata->{$vncount}		= $intpoint_vn;	# -- " --
			$all_points_on_plane = 0;
			last SWITCH;
			}
		# else: on plane (inside +/- epsilon)      
		push(@{$pointsnear}, $vertexnumbers2 );                         # pointsnear + point2
		push(@{$pointsfar},  $vertexnumbers2 );                         # pointsfar  + point2
		} # SWITCH

	} #for 
	my $facesnear = [];
	my $facesfar  = [];

	if ($all_points_on_plane) { # make sure there are no duplicate faces generated
		$facesnear = [$face];
		$facesfar  = [];    
	} else {
		$facesnear = ($#{$pointsnear} >= 2)
			?[[@{$pointsnear}]]
			:[];
		$facesfar  = ($#{$pointsfar}  >= 2)
			?[[@{$pointsfar}]]
			:[];
	}
	undef $pointsnear if ($undef_vars); #$DEBUG:testing
	undef $pointsfar if ($undef_vars);  #$DEBUG:testing
	if ($use_benchmark) {$timer->stop('split_face_by_plane')};
	return ($facesnear, $facesfar,
		$newvertices, $newuvdata, $newvndata,
		$vertexcount, $uvcount, $vncount   );
} # sub split_face_by_plane

#######################################################################
# Split all faces with a plane
#######################################################################
sub split_faces_by_plane (@@%%%$$$) {
	my ($faces, $vert3, $planeface, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;
	die "split_faces_by_plane:faces"     unless ( ref($faces)     eq 'ARRAY' );
	die "split_faces_by_plane:vert3"     unless ( ref($vert3)     eq 'ARRAY' );
	die "split_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
	die "split_faces_by_plane:vertices"  unless ( ref($vertices)  eq 'HASH'  );
	die "split_faces_by_plane:uvdata"    unless ( ref($uvdata)    eq 'HASH'  );
	die "split_faces_by_plane:vndata"    unless ( ref($vndata)    eq 'HASH'  );

	my $plane       = vert3_to_plane($vert3->[0],$vert3->[1],$vert3->[2]);
	my $newfaces    = [];
	my $newvertices = {};
	my $newuvdata   = {};
	my $newvndata   = {};
	my $planeface_max_distance = distance_face_from_center ($planeface, 1, $vertices);
  
	foreach my $face (@{$faces}) {  # check if face needs to be splitted/skipped/added
		if ($face == $planeface) { 
			#      print " adding planeface\n" if ($verbose == 3);
			push(@{$newfaces}, $face ); 
			next;
			}
		my $face_min_distance = distance_face_from_center($face, 0, $vertices);
		my $face_in_frustum   = face_in_frustum_of_other_face($planeface, $face, $vertices);

#    print "'$face_in_frustum'";
#print $planeface_max_distance." ".$face_min_distance."\n";
		SWITCH: {
		if (	(1 == $face_in_frustum ) &&
			($planeface_max_distance <  $face_min_distance )   ) { # face is inside the (extended) frustum AND behind the planeface
			# print " skipping face\n" if ($verbose == 3);
			print 2;
			last SWITCH;      
			} #if

		if (	(0 != $face_in_frustum) ||
			($planeface_max_distance <  $face_min_distance )   ) { # face is not crossing (0 or 1) the (extended) frustum OR it is behind the planeface (mind the OR !!!!)
			# print " adding orig. face\n" if ($verbose == 3);
			push(@{$newfaces}, $face ); 
			last SWITCH;      
			} #if
 
#		if (face completly on plane) { $DEBUG:TODO $DEBUG:MARK3
#			skip face
#			}

		# ELSE SWITCH    # ($face_in_frustum == 0) and others
		# print " splitting face\n" if ($verbose == 3);
		(my $dummy_newfacesnear, my $dummy_newfacesfar,
		my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
		$vertexcount,          $uvcount,            $vncount )
		= split_face_by_plane($face, $plane,
			$vertices, $uvdata, $vndata,
			$vertexcount, $uvcount, $vncount );
		push(@{$newfaces}, @{$dummy_newfacesnear}, @{$dummy_newfacesfar} );
		%{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
		%{$newuvdata}   = ( %{$newuvdata},   %{$dummy_newuvdata}   );
		%{$newvndata}   = ( %{$newvndata},   %{$dummy_newvndata}   );
		undef $dummy_newvertices  if ($undef_vars); #$DEBUG:testing
		undef $dummy_newuvdata if ($undef_vars);   #$DEBUG:testing
		undef $dummy_newvndata if ($undef_vars);   #$DEBUG:testing
		} # SWITCH
	} # foreach
	return ($newfaces,
		$newvertices, $newuvdata, $newvndata,
		$vertexcount, $uvcount, $vncount);
} # sub split_faces_by_plane

#----------------------------------------------------------------------
# END ADVANCED PLANE FUNCTIONS
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN BSP SORTING
#----------------------------------------------------------------------
#######################################################################
# Split faces by a plane that for use in the bsp sorting algorithm
#######################################################################
sub bspsplit_faces_by_plane_new (@@@%) {
	my ($bspfaces, $plane, $planeface, $objects) = @_; 
	die "bspsplit_faces_by_plane:faces"     unless ( ref($bspfaces)     eq 'ARRAY' );
	die "bspsplit_faces_by_plane:plane"     unless ( ref($plane)     eq 'ARRAY' );
	die "bspsplit_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
	die "bspsplit_faces_by_plane:objects"   unless ( ref($objects)  eq 'HASH'  );

	my $newfacesnear = [];
	my $newfacesfar  = [];
	my $newfacespar  = [];

	foreach my $face (@{$bspfaces}) { # check if face needs to be splitted/skipped/added
		#my $face = $bspface->{'face'};
		if ($face->{'face'} == $planeface) { 
			push(@{$newfacesnear}, $face);
			next;                            # skipping this foreach-face
			}

		print " splitting face\n" if ($verbose == 3);

		(my $dummy_newfacesnear, my $dummy_newfacesfar,
		my $dummy_newvertices,  my $dummy_newuvdata, my $dummy_newvndata,
		$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
		= split_face_by_plane($face->{'face'}, $plane, 
			$objects->{'vertices'}, $objects->{'uvdata'}, $objects->{'vndata'},
			$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'} 
		 		  		 		   		 		  		 		    		 		  		 		   		 		  		 		    		 		  		 		   		 		  		 		         );
		my $dummy_newfacesnear2 = [];
		foreach my $facex (@{$dummy_newfacesnear}) {
			push(
				@{$dummy_newfacesnear2},
				{	'face'=>$facex,
					'mtl' =>"" 
				}
			);#$face->{'mtl'}} );
		}
		my $dummy_newfacesfar2 = [];
		foreach my $facex (@{$dummy_newfacesfar}) {
			push(
				@{$dummy_newfacesfar2},
				{	'face'=>$facex,
					'mtl' =>""
				}
			);#$face->{'mtl'}} );
		}

		faces2bspfaces($dummy_newfacesnear2, $face->{'used_as_plane'});
		faces2bspfaces($dummy_newfacesfar2, $face->{'used_as_plane'});

		push(@{$newfacesnear}, @{$dummy_newfacesnear2});
		push(@{$newfacesfar},  @{$dummy_newfacesfar2} );

		undef $dummy_newfacesnear2 if ($undef_vars);  #$DEBUG:testing
		undef $dummy_newfacesfar2 if ($undef_vars);   #$DEBUG:testing
    
		%{$objects->{'vertices'}}	= (%{$objects->{'vertices'}},	%{$dummy_newvertices});
		%{$objects->{'uvdata'}}	= (%{$objects->{'uvdata'}},	%{$dummy_newuvdata});
		%{$objects->{'vndata'}}	= (%{$objects->{'vndata'}},	%{$dummy_newvndata});

		undef $dummy_newvertices if ($undef_vars); #$DEBUG:testing
		undef $dummy_newuvdata if ($undef_vars);   #$DEBUG:testing
		undef $dummy_newvndata if ($undef_vars);   #$DEBUG:testing
	} # foreach face
	return ($newfacesnear, $newfacesfar);
} # sub bspsplit_faces_by_plane

#######################################################################
# Converts a facelist to a list of hashes with the face and additional info.
# the info says if the face has been used as plane
#######################################################################
sub faces2bspfaces(@$) {
	my ($faces, $used_as_plane) = @_;
	if ($#{$faces} >= 0) {
		foreach my $face (@{$faces}) { 
			$face->{'used_as_plane'} = $used_as_plane;
		}
	}
}

sub bspfaces2faces(@) {
	my ($faces) = @_;
	if ($#{$faces} >= 0) {
		foreach my $face (@{$faces}) { 
			if (exists $face->{'used_as_plane'}) {
				delete($face->{'used_as_plane'})
			}
		} # foreach face
	}
}

#######################################################################
# Generate a bsp sorted/splitted tree out of a list of faces
#######################################################################
sub gen_bsptree_new (@%) {
	my ($bspfaces, $objects ) = @_;
	die "gen_bsptree:faces"   unless ( ref($bspfaces) eq 'ARRAY' );
	die "gen_bsptree:objects" unless ( ref($objects)  eq 'HASH'  );

	my $bsptree		= {};
	my $bsptree_near	= {};
	my $bsptree_far		= {};
	my $dummy_newvertices	= {};
	my $dummy_newuvdata	= {};
	my $dummy_newvndata	= {};

	if ($#{$bspfaces} >= 0) {
		my $planeface = [];
		for (my $i = 0; $i <= $#{$bspfaces}; $i++) {
			if ($bspfaces->[$i]->{'used_as_plane'} == 0) {
				$planeface = $bspfaces->[$i]->{'face'};
				$bspfaces->[$i]->{'used_as_plane'} = 1;
				last; # for
			}
		}
		if ($#{$planeface} >= 0) {
			print "<".$bspfaces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
			print "<".$#{$bspfaces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
			print "<".$bspfaces->[0]->{'face'}.">\n" if ($verbose == 4 ); # $DEBUG:testing

			my $plane = face2plane($planeface, $objects->{'vertices'} );
			(my $newfacesnear, my $newfacesfar)
			= bspsplit_faces_by_plane_new($bspfaces, $plane, $planeface, $objects );

			if ( $#{$newfacesnear} >= 0 ) { # one face or more
				$bsptree_near = gen_bsptree_new ($newfacesnear, $objects );
			}
  
			if ( $#{$newfacesfar} >= 0 ) { # one face or more
				$bsptree_far  = gen_bsptree_new ($newfacesfar, $objects );
			}
			$bsptree = {
				'near' => $bsptree_near,  # bsptree near
				'far'  => $bsptree_far,   # bsptree far
				'f'    => []              # faces
				};
		} else { #if $planeface=ok
			$bsptree = {
				'near' => 0,        # bsptree near
				'far'  => 0,        # bsptree far
				'f'    => $bspfaces # faces
				};
		}
	} else { # ( ${$faces} <= -1 )
		$bsptree = {
			'near' => 0,            # empty
			'far'  => 0,            # empty
			'f'    => []            # faces
			};
	}
	return $bsptree;
} # sub gen_bsptree_new

#######################################################################
# Generate a list of faces out of a BSP-tree
#######################################################################
sub bsptree2faceslist_new (%) {
	my ($bsptree, $objects) = @_;
	die "bsptree2faceslist:bsptree" unless ( ref($bsptree) eq 'HASH' );

	my $faces      = [];
	my $faces_near = [];
	my $faces_far  = [];

	if (ref($bsptree->{'near'}) eq "HASH") {
		$faces_near = bsptree2faceslist_new($bsptree->{'near'});
		#$faces_near = bspfaces2faces($faces_near);
		if ($#{$faces_near} >= 0) {
			push( @{$faces}, @{$faces_near});
		}
	}

	if ($#{$bsptree->{'f'}}>= 0) {
		bspfaces2faces($bsptree->{'f'});
		push( @{$faces}, @{$bsptree->{'f'}});
		#push( @{$faces}, @{$bsptree->{'f'}});
	}

	if (ref($bsptree->{'far'}) eq "HASH") {
		$faces_far = bsptree2faceslist_new($bsptree->{'far'});
		#$faces_far = bspfaces2faces($faces_far);
    
		if ($#{$faces_far} >= 0) {
			push( @{$faces}, @{$faces_far});
		}
	}
	return $faces;
} # sub bsptree2faceslist
#----------------------------------------------------------------------
# END BSP SORTING
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN center-BSP SORTING
#----------------------------------------------------------------------
#######################################################################
# Split faces by a plane that for use in the bsp sorting algorithm
# this one is used by the center-bsp method
#######################################################################
sub centerbspsplit_faces_by_plane_new (@@%) {
	if ($use_benchmark) {$timer->start('centerbspsplit_faces_by_plane_new')};
	my ($faces, $plane, $objects) = @_; 
	die "centerbspsplit_faces_by_plane:faces"	unless ( ref($faces)     eq 'ARRAY' );
	die "centerbspsplit_faces_by_plane:plane"	unless ( ref($plane)     eq 'ARRAY' );
	die "centerbspsplit_faces_by_plane:objects"	unless ( ref($objects)  eq 'HASH'  );

	my $newfacesnear = [];
	my $newfacesfar = [];
	my $newfacespar = [];

	foreach my $face (@{$faces}) { 
		print " splitting face\n" if ($verbose == 3);
		(my $dummy_newfacesnear, my $dummy_newfacesfar,
		my $dummy_newvertices, my $dummy_newuvdata, my $dummy_newvndata,
		$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'})
		= split_face_by_plane($face->{'face'}, $plane, 
			$objects->{'vertices'}, $objects->{'uvdata'}, $objects->{'vndata'},
			$objects->{'vert_counter'}, $objects->{'uv_counter'}, $objects->{'norm_counter'} 
			);
		#print "a".Dumper($dummy_newfacesnear);
		my $dummy_newfacesnear2 = [];
		foreach my $face (@{$dummy_newfacesnear}) {
			push(
				@{$dummy_newfacesnear2},
				{	'face'=>$face,
					'mtl' =>""
				}
			);#$face->{'mtl'}} );
		}
		undef $dummy_newfacesnear if ($undef_vars);
		my $dummy_newfacesfar2 = [];
		foreach my $face (@{$dummy_newfacesfar}) {
			push(
				@{$dummy_newfacesfar2},
				{	'face'=>$face,
					'mtl' =>""
				}
			);#$face->{'mtl'}} );
		}
		undef $dummy_newfacesfar if ($undef_vars);
		push(@{$newfacesnear}, @{$dummy_newfacesnear2});
		push(@{$newfacesfar},  @{$dummy_newfacesfar2} );

		undef $dummy_newfacesnear2 if ($undef_vars);
		undef $dummy_newfacesfar2 if ($undef_vars);

		%{$objects->{'vertices'}} =  ( %{$objects->{'vertices'}}, %{$dummy_newvertices} );
		%{$objects->{'uvdata'}}   =  ( %{$objects->{'uvdata'}},   %{$dummy_newuvdata} );
		%{$objects->{'vndata'}}   =  ( %{$objects->{'vndata'}},   %{$dummy_newvndata} );

		undef $dummy_newvertices if ($undef_vars);
		undef $dummy_newuvdata if ($undef_vars);
		undef $dummy_newvndata if ($undef_vars);
	} # foreach face
	if ($use_benchmark) {$timer->stop('centerbspsplit_faces_by_plane_new')};
	return ($newfacesnear, $newfacesfar);
} # sub centerbspsplit_faces_by_plane

#######################################################################
# generate center-BSP tree
#######################################################################
sub gen_centerbsptree_new (@%%) {
	my ($faces, $objects, $edges, $used_edges ) = @_;
  
	die "gen_centerbsptree:faces"        unless ( ref($faces)      eq 'ARRAY' );
	die "gen_centerbsptree:objects"      unless ( ref($objects)    eq 'HASH'  );
	die "gen_centerbsptree:edges"        unless ( ref($edges)      eq 'HASH'  ); 
	die "gen_centerbsptree:unused_edges" unless ( ref($used_edges) eq 'HASH'  ); 

	my $zero_point   = [0, 0, 0];

	my $centerbsptree = {};
	my $centerbsptree_near = {};
	my $centerbsptree_far = {};
	my $dummy_newvertices = {};
	my $dummy_newuvdata = {};
	my $dummy_newvndata = {};

	print "Processed edges: " . (keys %{$used_edges}) ." of <=  ~". (keys %{$edges}) ."\n";

	if ($#{$faces} >= 0) {
		print "<".$faces.">\n"      if ($verbose == 4 ); # $DEBUG:testing
		print "<".$#{$faces}.">\n"  if ($verbose == 4 ); # $DEBUG:testing
		print "<".$faces->[0].">\n" if ($verbose == 4 ); # $DEBUG:testing

		my $first_unused_edge = first_unused_edges_in_faces($faces, $edges, $used_edges);

		if (	(exists $first_unused_edge->{'v1'}) &&
			(exists $first_unused_edge->{'v2'}) ) {
			my $vertexnumbers1 = $first_unused_edge->{'v1'};
			my $vertexnumbers2 = $first_unused_edge->{'v2'};
		 
			$used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;              # save used edge
	
			my $vertex1 = $objects->{'vertices'}->{$vertexnumbers1->{'v'}};
			my $vertex2 = $objects->{'vertices'}->{$vertexnumbers2->{'v'}};      
			my $zeroplane  = vert3_to_plane($zero_point, $vertex1, $vertex2 );
	      
			#undef $vertex1; #$DEBUG:TODO possible? (link needed?)
			#undef $vertex2; #$DEBUG:TODO possible? (link needed?)
	
			(my $newfacesnear, my $newfacesfar)
			= centerbspsplit_faces_by_plane_new($faces, $zeroplane, $objects );
			#$first_unused_edge  = first_unused_edges_in_faces($newfacesnear, $edges, $used_edges);
			$centerbsptree_near = gen_centerbsptree_new ($newfacesnear, $objects, $edges, $used_edges);
			$centerbsptree_far  = gen_centerbsptree_new ($newfacesfar,  $objects, $edges, $used_edges);
	
			$centerbsptree = {
				'near'  => $centerbsptree_near,  # bsptree near
				'far'   => $centerbsptree_far,   # bsptree far
				'f'     => []                   # faces 
				#,'edges' => [ $vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'} ] # edges on the plane
				 # $DEBUG:TODO ADD rest of the coplanar edges to this list
				};
			# $DEBUG:TODO ADD th3 rest of the 'f' edges to the used edges
		} else {
			# no unused edges found
			$centerbsptree = {
				'near'  => 0,            # empty
				'far'   => 0,            # empty
				'f'     => $faces      # faces 
				#,'edges' => []             # edges on the plane
				# $DEBUG:TODO ADD rest of the coplanar edges to this list
				};
		}   
	} else { # ( ${$faces} <= -1 ) ## == no faces
		$centerbsptree = {
			'near'  => 0,            # empty
			'far'   => 0,            # empty
			'f'     => []            # faces
			#,'edges' => []             # edges
			};
	}
	return $centerbsptree;
} # sub gen_centerbsptree

#######################################################################
# makes a facelist out of a centerBSP tree
#######################################################################
sub centerbsptree2faceslist_new  (%) {
	my ($centerbsptree) = @_;
	die "centerbsptree2faceslist:bsptree" unless ( ref($centerbsptree) eq 'HASH' );

	my $faces = [];
	my $faces_near = [];
	my $faces_far = [];
   
	if (ref($centerbsptree->{'near'}) eq "HASH") {
		$faces_near = centerbsptree2faceslist_new($centerbsptree->{'near'});
		if ($#{$faces_near} >= 0) {
			push( @{$faces}, @{$faces_near});
		}
	}

	if ($#{$centerbsptree->{'f'}} >= 0) {
		push( @{$faces}, @{$centerbsptree->{'f'}});
	}

	if (ref($centerbsptree->{'far'}) eq "HASH") {
		$faces_far = centerbsptree2faceslist_new($centerbsptree->{'far'});
		if ($#{$faces_far} >= 0) {
			push( @{$faces}, @{$faces_far});
		}
	}
	
	return $faces;
} # sub centerbsptree2faceslist

#######################################################################
# Returns the first edge in $faces that is also listed
# in $edges and not listed in $used_edges
#######################################################################
sub first_unused_edges_in_faces (@%%) {
	my ($faces, $edges, $used_edges) = @_;
	die "first_unused_edges_in_faces:faces"      unless ( ref($faces)      eq 'ARRAY' );
	die "first_unused_edges_in_faces:edges"      unless ( ref($edges)      eq 'HASH'  );
	die "first_unused_edges_in_faces:used_edges" unless ( ref($used_edges) eq 'HASH'  );

	my $first_unused_edges = {'all_edges_used' => 1};
 
	foreach my $face (@{$faces}) { # loop trough faces
		my $last_point_number = $#{$face->{'face'}};
		for (my $i = 0; $i <= $last_point_number; $i++) {		# loop through the vertices of the face and check if there is an unused edge
			my ($vertexnumbers1,$vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'}); 
			if (	(exists( $used_edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) ||   
				(exists( $used_edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} )) ) { 
				# print "Already used edge ... trying the next one.\n";
				next;
			} else {
				if  (	(exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} )) ||
					(exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} )) ) {
					$first_unused_edges = {
						'v1'   => $vertexnumbers1,
						'v2'   => $vertexnumbers2
						};
					last;
				} else {
					# print "Newly created edge ... trying the next one.\n";
					next;
				}
			}
		} # for

	} # foreach

	return $first_unused_edges;
} # sub first_unused_edges_in_faces

#######################################################################
# returns a list of all edges (no duplicates) in a facelist
# format: "pointnumber1-pointnumber2"
#######################################################################
sub get_edges(%) {
	my ($objects) = @_;
	die "get_edges:objects"      unless ( ref($objects)      eq 'HASH' );
	my $edges = {};
	my $faces = [];
	foreach my $object (@{$objects->{'objects'}})  {
		push(@{$faces}, @{$object->{'faces'}});
	}
	foreach my $face (@{$faces}) { # loop trough faces
		my $last_point_number = $#{$face->{'face'}};
		for (my $i = 0; $i <= $last_point_number; $i++)  {                 # loop through the vertices of the face and check if there is an unused edge
			my ($vertexnumbers1, $vertexnumbers2) = get_edgenumbers_from_face ($i, $face->{'face'}); 
			if (	exists( $edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} ) ||   
				exists( $edges->{$vertexnumbers2->{'v'}.'-'.$vertexnumbers1->{'v'}} ) ) { # check for already used edges.
				# print "Already existing edge.. trying the next one.\n";
				next;
			} else {
				$edges->{$vertexnumbers1->{'v'}.'-'.$vertexnumbers2->{'v'}} = 1;
			}
		} # for
	} # foreach face
	return $edges;
} # sub get_edges

#-----------------------------------------------------------------------
# END center-BSP SORTING
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# BEGIN SORTING
#-----------------------------------------------------------------------
#######################################################################
# Returns the midpoint of a face
#######################################################################
sub get_face_midpoint (@%) { 
	my ($face, $vertices) = @_;
	die "get_face_midpoint:face"		unless (ref($face) eq 'ARRAY' );
	die "get_face_midpoint:vertices"	unless (ref($vertices) eq 'HASH'  );

	my ($xd, $yd, $zd) = (0, 0, 0);
	my $vertex_count   = 0;
  
	foreach my $vertexnumbers (@{$face}) {
#   print "number=".$vertexnumbers->{'v'}."\n";                  # $DEBUG_testing
#   print "value=".$vertices->{$vertexnumbers->{'v'}}->[0]."\n"; # $DEBUG_testing
		$xd += $vertices->{$vertexnumbers->{'v'}}->[0];
		$yd += $vertices->{$vertexnumbers->{'v'}}->[1];
		$zd += $vertices->{$vertexnumbers->{'v'}}->[2];
		++$vertex_count;
	}
#my $vertex_count = ($#{$face} + 1);

	return [
		$xd / $vertex_count,
		$yd / $vertex_count,
		$zd / $vertex_count
		];
} # sub get_face_midpoint

#######################################################################
# Returns the distance from the center to the midpoint of a face
#######################################################################
sub get_distance_to_midpoint (@%) {
	my ($face, $vertices) = @_;
	die "get_distance_to_midpoint:face"     unless (ref($face)     eq 'ARRAY' );
	die "get_distance_to_midpoint:vertices" unless (ref($vertices) eq 'HASH'  );

	my $midpoint = get_face_midpoint($face, $vertices);
	my $distance = sqrt(
		($midpoint->[0])**2 +
		($midpoint->[1])**2 +
		($midpoint->[2])**2
		); # distance center->midpoint
	return $distance;
} # sub get_distance_to_midpoint

#######################################################################
# Sort faceslist by face-midpoint (z sorting)
#######################################################################
sub sort_by_facemidpoint (%$) { 
	my ($objects, $far_to_near) = @_;
	die "sort_by_facemidpoint:objects" unless (ref($objects) eq 'HASH'  );
	my $vertices = $objects->{'vertices'};
	foreach my $object (@{$objects->{'objects'}})  {
		if ($far_to_near) {
			@{ $object->{'faces'} }
			= sort {
				get_distance_to_midpoint($b->{'face'},$vertices)
				<=>
				get_distance_to_midpoint($a->{'face'},$vertices)
				}  @{$object->{'faces'}};
		} else {  # near_to_far
			@{ $object->{'faces'} }
			= sort {
				get_distance_to_midpoint($a->{'face'},$vertices)
				<=>
				get_distance_to_midpoint($b->{'face'},$vertices)
				} @{$object->{'faces'}};
		} # if
	} # foreach object
} # sub sort_by_facemidpoint
#----------------------------------------------------------------------
# END SORTING
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN CLEANING
#----------------------------------------------------------------------
#######################################################################
# Checks if an entry of vertices/uvdata/normals alread exists in a hash
# this function requires to have a maximum of 1 (one) existing entries in the hash
#######################################################################
sub data_exists (@%) {
	my ($data, $datahash) = @_;
	die "data_exists:data"     unless (ref($data)     eq 'ARRAY' );
	die "data_exists:datahash" unless (ref($datahash) eq 'HASH'  );

	my $existing = 0;
#foreach my $dummy_data_key (keys %{$datahash}) {     # slower than "while ..each" ?
#  my $dummy_data = $datahash->{$dummy_data_key};     # slower than "while ..each" ?

	my $dummy_data_key;
	my $dummy_data;
	while (($dummy_data_key, $dummy_data) = each %{$datahash}) {
		for (my $i = 0; $i <= $#{$dummy_data}; ++$i) {
			if ($dummy_data->[$i] != $data->[$i]) {
				$existing = 0; last;				# this entry isn't equal, skipping the rest of this entry
			} else { 
				$existing = 1;
			}
		} #for

		if ($existing) {
			return [$dummy_data_key, $dummy_data];    # found a match -> returning the key+entry
		}
#} #foreach dummy_data_key
	} #while
	return $existing;
} # sub data_exists

#######################################################################
# Remove all unneeded vertices/uvdata/normals and remake the index
#######################################################################
sub clean_data (%) {
	my ($objects) = @_;
	die "clean_data:objects" unless (ref($objects) eq 'HASH'  );

	my $new_vertices = {};
	my $new_uvdata = {};
	my $new_vndata = {};

	my $new_vert_indices = {}; #relationship old/new idex of vert data (old=key)
	my $new_uv_indices = {}; #relationship old/new idex of uv data (old=key)
	my $new_vn_indices = {}; #relationship old/new idex of vn data (old=key)

	#make new list of used vertices/uvdata (+ add new index)
	my $new_vert_count = 0;
	my $new_uv_count = 0;
	my $new_vn_count = 0;
		
	foreach my $object (@{$objects->{'objects'}})  {

		print "  Creating new list of vertices/uvdata/normals ... \n";
		my $face = {};

		my $vertexnumbers = {};
		my ($v, $vt, $vn);
		my ($vertex_v, $vertex_vt, $vertex_vn);
		my $exists = [];

		foreach $face (@{ $object->{'faces'} }) {
			# ->moved var defs to the top
			foreach $vertexnumbers (@{ $face->{'face'} }) {
				$v  = $vertexnumbers->{'v'};
				$vt = $vertexnumbers->{'vt'};
				$vn = $vertexnumbers->{'vn'};

				$vertex_v  = $objects->{'vertices'}->{$v};
				$vertex_vt = $objects->{'uvdata'}->{$vt};
				$vertex_vn = $objects->{'vndata'}->{$vn};

				### vertex data ###
				$exists = data_exists($vertex_v, $new_vertices);
				if (! $exists) {
					++$new_vert_count;
					$new_vertices->{$new_vert_count} = $vertex_v;       # add a new index
					$new_vert_indices->{$v}          = $new_vert_count; # add a new index
				} else {
					$new_vert_indices->{$v} = $exists->[0];             # relate the old index with the new existing one
				}       

				### UV data ###
				$exists = data_exists($vertex_vt, $new_uvdata);
				if (! $exists) {
					++$new_uv_count;    
					$new_uvdata->{$new_uv_count} = $vertex_vt;          # add a new index
					$new_uv_indices->{$vt}       = $new_uv_count;       # add a new index
				} else {
					$new_uv_indices->{$vt} = $exists->[0];              # relate the old index with the new existing one
				}

				### normal data ###
				$exists = data_exists($vertex_vn, $new_vndata);
				if (! $exists) {
					++$new_vn_count;
					$new_vndata->{$new_vn_count} = $vertex_vn;          # add a new index
					$new_vn_indices->{$vn}       = $new_vn_count;       # add a new index
				} else {
					$new_vn_indices->{$vn} = $exists->[0];              # relate the old index with the new existing one
				}
			} #foreach vertexnumers
		} #foreach face
		print "  ...done.\n";

		print "  Replace faces ...\n";
		#loop through faces and replace the indices of vertices/uvdata/normals with the new ones
		$face = {};
		foreach $face (@{ $object->{'faces'} }) {
			for (my $i=0; $i<$#{$face->{'face'}}; $i++) {
				$face->{'face'}->[$i]->{'v' }	= $new_vert_indices->{$face->{'face'}->[$i]->{'v'}};
				$face->{'face'}->[$i]->{'vt'}	= $new_uv_indices->{$face->{'face'}->[$i]->{'vt'}};
				$face->{'face'}->[$i]->{'vn'}	= $new_vn_indices->{$face->{'face'}->[$i]->{'vn'}};
			} # for $i
		} # foreach face
		print "  ...object done.\n";
	} # foreach object
	print "  ...done.\n";
	$objects->{'vertices'}	= $new_vertices;
	$objects->{'uvdata'}	= $new_uvdata;
	$objects->{'vndata'}	= $new_vndata;
	$objects->{'vert_counter'}	= $new_vert_count;
	$objects->{'uv_counter'}	= $new_uv_count;
	$objects->{'norm_counter'}	= $new_vn_count;
	
} # sub clean_data


#######################################################################
# Remove every face that is clearly pointing the other way ;-)
#######################################################################
sub delete_backfaces (%) { # fixed for objects
	my ($objects) = @_;
	die "delete_backfaces:objects" unless (ref($objects) eq 'HASH'  );
	my $object = {};
	foreach $object (@{ $objects->{'objects'} }) {
		my $new_faces  = [];
		my $zero_point = [0, 0, 0];
		foreach my $face (@{ $object->{'faces'} }) {
#print Dumper($face->{'face'}); #$DEBUG:testing
			my $plane = face2plane($face->{'face'}, $objects->{'vertices'} ); 
			my $side  = classify_point_by_plane($plane, $zero_point);
			if ($side > 0) {
				push(@{$new_faces},$face);
			}
#			else {
#				print "Removed face".$face."\n";
#			}
		} # foreach face
		$object->{'faces'} = $new_faces;
	} # foreach object
} # sub delete_backfaces

#-----------------------------------------------------------------------
# END CLEANING
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# BEGIN TRIANGULATE
#-----------------------------------------------------------------------
#######################################################################
# Make all faces in _all objects_  triangles
#######################################################################
sub triangulate_objects (%) {
	my ($objects) = @_;
	die "triangulate_objects:objects" unless (ref($objects) eq 'HASH'  );

	foreach my $object (@{ $objects->{'objects'} }) {
		triangulate_object($object);
	} # foreach object
} # sub triangulate_objects

#######################################################################
# Make all faces in _one object_  triangles
#######################################################################
sub triangulate_object (%) {
	my ($object) = @_;
	die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
	my $new_faces = [];
	foreach my $face (@{$object->{'faces'}}) {
		push(@{$new_faces},@{triangulate_face($face)});
	} # foreach face
	$object->{'faces'} = $new_faces;
} # sub triangulate_objects

#######################################################################
# Make face into triangles 
#######################################################################
sub triangulate_face (%) {
	my ($face) = @_;
	my $new_faces = [];
	my $vertexcount  = @{$face->{'face'}};          # get number of vertices
	my $first = 0;                        # store first 
	my $last = $first + $vertexcount - 1; # store last

	for (my $v_index = 0; $v_index < $vertexcount; $v_index++) { # loop through face
		SWITCH: {
		if ($v_index == $last) {               ## if last vertex
			push(@{$new_faces},{
				'face'=> [
					$face->{'face'}->[$v_index],	#1
					$face->{'face'}->[$last],		#next
					$face->{'face'}->[$first+1] 	#prev
					],
				'mtl' => $face->{'mtl'}
				}
			); 
			last SWITCH;
			}
		if ($v_index == $first) {         ## if first vertex
			push(@{$new_faces},{
				'face'=> [
					$face->{'face'}->[$v_index],	#1
					$face->{'face'}->[$v_index+1],	#next
					$face->{'face'}->[$last]		#prev
					],
				'mtl' => $face->{'mtl'}
				}
			);
			last SWITCH;
			}
		# else                      ## if anything else
		push(@{$new_faces},{
			'face' => [
				$face->{'face'}->[$v_index],	#1
				$face->{'face'}->[$v_index+1],	#next
				$face->{'face'}->[$last]		#prev
				],
			'mtl' => $face->{'mtl'}
			}   
		);
		} #SWITCH
	} #for
	return $new_faces ;
} # triangulate_face
#-----------------------------------------------------------------------
# END TRIANGULATE
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# BEGIN TRANSFORM
#-----------------------------------------------------------------------
#######################################################################
# Transform objects
#######################################################################
# Possible commands
# Rotation
#   rx90 rx-90
#   ry90 ry-90
#   rz90 rz-90
# Scaling
#   sx0.5 sx2
#   sy0.5 sy2
#   sz0.5 sz2
#   s0.5 s2
#######################################################################
sub transform_objects(%$) {
	my ($objects, $transform_commands) = @_;
	die "transform_objects:objects" unless ( ref($objects) eq 'HASH' );
	my $commands = [];
	print "Transform input: '".$transform_commands."'\n";
	@{$commands} = ($transform_commands =~ /\s*([rs][xyz]*[\d\.]+)\s*/g);
	foreach my $transform_command (@{$commands}) {
		my ($type ,$axis, $value) = ($transform_command =~ m/([rs])([xyz]*)([\d\.]+)/);
		print "Type='".$type."' Axis='".$axis."' Value='".$value."'\n";
		SWITCH: { # TYPE
		if ($type eq "r") { # ROTATE
			# $DEBUG:TODO rotate around axis $value degrees
			last SWITCH;
			}
		if ($type eq "s") { # SCALE
			# $DEBUG:TODO scale along axis (or global if empty) factor
			last SWITCH;
			}
		#else
		print "Unknown command: '".$transform_command."'! Ignored.\n";
		} # SWITCH TYPE
	} # foreach command
}

#######################################################################
# Scale objects
#######################################################################
sub transform_scale_objects(%$$) { #$DEBUG:TODO not done
	my ($objects, $axis, $value) = @_;
	die "transform_scale_objects:objects" unless ( ref($objects) eq 'HASH' );
	my $scaling = [0,0,0];
	my $axislist = [];
	@{$axislist} = split(//, $axis);
	#for (my $single_axis)character
	foreach my $single_axis (@{$axislist}) {
		SWITCH: { # AXIS
			if ($single_axis eq '')	{ $scaling = [1,1,1]; last SWITCH; }
			if ($single_axis eq 'x')	{ $scaling->[0] = 1; last SWITCH; }
			if ($single_axis eq 'y')	{ $scaling->[1] = 1; last SWITCH; }
			if ($single_axis eq 'z')	{ $scaling->[2] = 1; last SWITCH; }
		#else
		print "Bad axis: '".$axis."'! Ignored.\n";
		} # SWITCH AXIS
	}
# foreach vertice (verticelist) {
# scale vertices
# } # foreach vertice
# if  ((!$scaling->[0]) || (!$scaling->[1]) || (!$scaling->[2])) {
## scale normals too
#}
}

#-----------------------------------------------------------------------
# END TRANSFORM
#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
# BEGIN FILE-EXPORT
#-----------------------------------------------------------------------
#######################################################################
# Write/Export to new obj file
#######################################################################
sub write_to_obj ($%) {
	my ($filename, $objects) = @_;
	die "write_to_obj:objects" unless ( ref($objects) eq 'HASH' );

	my $write_vt = 1; #write uv data if it exists
	my $write_vn = 1; #write normals if they exists # $DEBUG:TODO calulate normals

	print "Opening file '$filename' for writing ...\n";
	open(OBJ_OUT, "> ".$filename) || die "failed to open $filename\n";
	print "...Done.\n";

	print "Writing Header ...\n";
	printf OBJ_OUT "# Generated with obj_conv.pl version %s \n", $VERSION; 
	#printf OBJ_OUT "#  - Split by BSP-tree\n" if ($split_bsp); 
	#printf OBJ_OUT "#  - Split by edges\n"    if ($split_by_view); 
	#printf OBJ_OUT "#  - Triangulated\n"      if ($triangulate_objects); 

	printf OBJ_OUT "mtllib %s\n", $objects->{'mtllib'};
	print "...Done.\n";

	print "Writing vertices ...\n";
	my $dummy_index = '';
	foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vertices'}})) {
		printf OBJ_OUT "v %f %f %f\n",
			$objects->{'vertices'}->{$dummy_index}->[0],
			$objects->{'vertices'}->{$dummy_index}->[1],
			$objects->{'vertices'}->{$dummy_index}->[2];
	}
	print "...Done.\n";

	#if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}   # $DEBUG:TODO check if the data is empty
	#if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}   # $DEBUG:TODO check if the data is empty

	print "Writing uv data ...\n";
	foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'uvdata'}})) {
		printf OBJ_OUT "vt %f %f\n",
			$objects->{'uvdata'}->{$dummy_index}->[0],
			$objects->{'uvdata'}->{$dummy_index}->[1];
	}
	print "...Done.\n";

	print "Writing normal data ...\n";
	foreach $dummy_index (sort { $a <=> $b } (keys %{$objects->{'vndata'}})) {
		printf OBJ_OUT "vn %f %f %f\n",
			$objects->{'vndata'}->{$dummy_index}->[0],
			$objects->{'vndata'}->{$dummy_index}->[1],
			$objects->{'vndata'}->{$dummy_index}->[2];
	}
	print "...Done.\n";

	my $object = {};
	foreach $object (@{$objects->{'objects'}})  {
		print "Writing group+usemtl ...\n";
		if ((! exists( $object->{'objectname'})) || ($object->{'objectname'} eq "")) {
			printf OBJ_OUT "#o\n" 
		} else {
			printf OBJ_OUT "o %s\n", $object->{'objectname'};
		}
		if ((! exists( $object->{'groupname'})) || ($object->{'groupname'} eq "")) {
			printf OBJ_OUT "#g\n" 
		} else {
			printf OBJ_OUT "g %s\n", $object->{'groupname'};
		}
		if ((! exists( $object->{'mtlname'})) ||  ($object->{'mtlname'} eq "")) {
			printf OBJ_OUT "#usemtl\n" 
		} else {
			printf OBJ_OUT "usemtl %s\n", $object->{'mtlname'};
		}
		print "...Done.\n";

		print "Writing faces ...\n";
		my $face = {};
		my $vertexnumbers = {};
		foreach $face (@{$object->{'faces'}}) {
			print "face=". ($face->{'face'}) ."\n" if ($verbose ==1);
			printf OBJ_OUT "f";
			foreach $vertexnumbers (@{$face->{'face'}}) {
				print "vertnr=".$vertexnumbers."\n" if ($verbose == 1);
				printf OBJ_OUT " %i", $vertexnumbers->{'v'};
				printf OBJ_OUT "\/";
				printf OBJ_OUT "%i",  $vertexnumbers->{'vt'} if (($write_vt) && (exists $vertexnumbers->{'vt'}));
				printf OBJ_OUT "\/";
				printf OBJ_OUT "%i",  $vertexnumbers->{'vn'} if (($write_vn) && (exists $vertexnumbers->{'vn'}));
			} # foreach vertexnumbers
			#printf OBJ_OUT "\n# dist %f",  get_distance_to_midpoint($face->{'face'}, $objects->{'vertices'}); # $DEBUG:testing
			printf OBJ_OUT "\n";
		} # foreach face
	} # foreach object

	printf OBJ_OUT "# EOF\n"; 
	close(OBJ_OUT);
	print "...Done.\n";
} # sub write_to_obj

#######################################################################
# Write/Export first object to vegastrike xmesh file
#######################################################################
sub write_first_to_xmesh ($%) {
	my ($filename, $objects) = @_;
	die "write_first_to_xmesh:objects" unless ( ref($objects) eq 'HASH' );

	my $write_vt    = 1;   #write uv data if it exists
	my $write_vn    = 1;   #write normals if they exists # $DEBUG:TODO calulate normals
	my $use_normals = "0"; # $DEBUG:TODO get this from type of export
  
	#if ($#{@{keys %{$objects->{'uvdata'}}}} < 0 ) {$write_vt=0;}   # $DEBUG:TODO check if the data is empty
	#if ($#{@{keys %{$objects->{'vndata'}}}} < 0 ) {$write_vn=0;}   # $DEBUG:TODO check if the data is empty

	#... get data from first object
	my $faces   = $objects->{'objects'}->[0]->{'faces'};

	############################################
	# BEGIN make new data ('cause points include the normal data and the vertices of the faces include the uv-data)
	my $new_vertex_data    = {};
	my $new_faces          = [];
	my $new_vertex_counter = 0;
	my $vertexnumbers = {};
	foreach my $face (@{$faces}) {
		my $new_face = [];
		foreach $vertexnumbers (@{$face->{'face'}}) {
			$new_vertex_data->{$new_vertex_counter} = {
				'v_data' => $objects->{'vertices'}->{$vertexnumbers->{'v'}},
				'vn_data'=> $objects->{'vndata'}->{$vertexnumbers->{'vn'}}
				};
			push(@{$new_face},{
				'v' => $new_vertex_counter,
				'vt_data'=> $objects->{'uvdata'}->{$vertexnumbers->{'vt'}}
				}
			);
			$new_vertex_counter++;
		} # foreach vertexnumbers
		push(@{$new_faces}, $new_face);
	} # foreach face
	# END make new data
	############################################

	#---
	print "Opening file '",$filename,"' for writing ...\n";
	open(XMESH_OUT, "> ".$filename) || die "failed to open $filename\n";
	print "...Done.\n";
	#---
	print "Writing Header ...\n";
	printf XMESH_OUT "<!-- Generated with obj_conv.pl version %s ", $VERSION;
	#printf XMESH_OUT "\n - Split by BSP-tree" if ($split_bsp); 
	#printf XMESH_OUT "\n - Split by edges"    if ($split_by_view); 
	#printf XMESH_OUT "\n - Triangulated"      if ($triangulate_objects);  
	printf XMESH_OUT " -->\n";
	printf XMESH_OUT "<Mesh texture='%s' scale='%f' %s >\n", "dummy.bmp", 1, "sharevertex='0'";
	print "...Done.\n";
	#---
	print "Writing material settings ...\n";
	printf XMESH_OUT "<!-- material %s -->\n", $objects->{'mtllib'};
	printf XMESH_OUT "<Material reflect='%s' LightningOn='%s' UseNormals='%s' %s >\n" ,"1","1",$use_normals,"";
	printf XMESH_OUT "<Diffuse  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
	printf XMESH_OUT "<Ambient  red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
	printf XMESH_OUT "<Specular red='%f' green='%f' blue='%f' alpha='%f'/>\n",1,1,1,1;
	printf XMESH_OUT "<\/Material>\n";
	print "...Done.\n";
	#---
	printf XMESH_OUT "<!-- %i faces -->\n", $#{$new_faces};
	#---
	print "Writing vertices ...\n";
	my $dummy_index = '';
	printf XMESH_OUT "<Points>\n";
	my $dummy_data_key;
	my $dummy_data = {};
	foreach $dummy_data_key (sort { $a <=> $b } (keys %{$new_vertex_data})) {
		$dummy_data = $new_vertex_data->{$dummy_data_key};
		printf XMESH_OUT "<Point>\n";
		printf XMESH_OUT "<Location x='%g' y='%g' z='%g'\/>\n",
			$dummy_data->{'v_data'}->[0],
			$dummy_data->{'v_data'}->[1],
			$dummy_data->{'v_data'}->[2];
		printf XMESH_OUT "<Normal i='%g' j='%g' k='%g'\/>\n",
			(-$dummy_data->{'vn_data'}->[0]),
			(-$dummy_data->{'vn_data'}->[1]),
			(-$dummy_data->{'vn_data'}->[2]);
		printf XMESH_OUT "</Point>\n";
	} # foreach dummydatakey

	printf XMESH_OUT "</Points>\n";
	print "...Done.\n";
	#---
	print "Writing faces ...\n";
	printf XMESH_OUT "<Polygons>\n";
	my $face = [];
	$vertexnumbers = {};
	foreach $face (@{$new_faces}) {
		printf XMESH_OUT "<%s>\n",poly_text(($#{$face}+1));
		foreach $vertexnumbers (@{$face}) {
		printf XMESH_OUT "  <Vertex point='%s' s='%g' t='%g'\/>\n",
			$vertexnumbers->{'v'},
			$vertexnumbers->{'vt_data'}->[0],
			(1 - $vertexnumbers->{'vt_data'}->[1]);
		} # foreach vertexnumbers
		#printf XMESH_OUT "<!-- dist %f -->\n",  get_distance_to_midpoint($face, $objects->{'vertices'}); # $DEBUG:testing
		printf XMESH_OUT "<\/%s>\n",poly_text(($#{$face}+1));
	} # foreach face
	printf XMESH_OUT "<\/Polygons>\n";
	#---
	#printf XMESH_OUT "<!-- %s -->", Dumper($objects); # $DEBUG:DEBUG
	printf XMESH_OUT "%s". "";  #print LOD etc...
	#---
	printf XMESH_OUT "<\/Mesh>\n";
	close(XMESH_OUT);
	print "...Done.\n";
} # sub write_first_to_xmesh

#######################################################################
# Dump objects data structurte into a text file
#######################################################################
sub write_to_dump ($%) {
	my ($filename, $objects) = @_;
	die "write_to_dump:objects"	unless ( ref($objects) eq 'HASH' );
	print "Opening file '$filename' for writing ...\n";
	open(DUMP_OUT, "> ".$filename) || die "failed to open $filename\n";
	print "...Done.\n";

	print "Writing dump into file ...\n";
	printf DUMP_OUT "%s\n",Dumper($objects);
	close(DUMP_OUT);
	print "...Done.\n";
} # sub write_to_dump

#######################################################################
# Dump (any) text into a file
#######################################################################
sub write_to_debug ($$) {
	my ($filename, $text) = @_;
  	open(FILE, "> ".$filename) || die "failed to open $filename\n";
	printf FILE $text;
	close(FILE);
	print "...Done.\n";
} # sub write_to_debug

#######################################################################
# Return the currect XML-tag text for a poly with a given number of vertices
#######################################################################
sub poly_text ($) {
	my ($number) = @_;
	SWITCH : {
		if (3 == $number )	{return "Tri"; last SWITCH; }
		if (4 == $number)	{return "Quad"; last SWITCH; }
		if (4 < $number)	{return "Trifan"; last SWITCH; }
	#else
	print "Bad face found!\n";
	return "BADFACE";
	}
}
#-----------------------------------------------------------------------
# END FILE-EXPORT
#-----------------------------------------------------------------------

#----------------------------------------------------------------------
# BEGIN MAIN PROGRAM
#----------------------------------------------------------------------
# set default values
my $file_in			= ''; # $DEBUG:TODO Will be $file_in in the future (because the type will be autodetected)
my $obj_out			= '';
my $xmesh_out		= '';
my $delete_backfaces	= 1;
my $cleanup_data		= 0;
my $cleanup_data2		= 0;
my $triangulate_objects	= 0;
my $split_by_view		= 0;
my $split_bsp			= 0;
my $sort_by_midpoint	= 0;
my $sort_by_midpoint2	= 1;
my $write_as_obj		= 1; # needs to be deleted


my $helptext =
 "=====================================\n"
."== obj converter  $VERSION\n"
."=====================================\n"
."usage: obj_conv.pl <TAGS>\n"
."\n"
." -i<filename>       Input  file (obj/xmesh)\n"
." -o<filename>       Output file (obj)\n"
."                      [Default: <input-filename>_cockpit.obj]\n"
." -h                 Displays this help text.\n"
." -v<level>          Verbosity level. Only for debugging.\n"
."                      [Default: 0]\n"
."-- PRE-ACTIONS --------------------------------------------\n"
." -d                 Delete all backfaces (= faces that are pointing\n"
."                    away from the center/viewpoint)\n"
."                      [Default: $delete_backfaces]\n"
." -r                 Re-sort faces (depth sorting) before doing\n"
."                    anything.\n"
."                      [Default: $sort_by_midpoint]\n"
." -c                 Cleanup vertices/uvdata/normals/faces before\n"
."                    doing anything else (removes duplicates, etc...)\n"
."                      [Default: $cleanup_data] (needs -d sometimes)\n"
."-- MAIN-ACTIONS --------------------------------------------\n"
." -s                 Split faces by planes tru the centerpoint\n"
."                    and every edge of the faces (center-BSP)\n"
."                      [Default: $split_by_view]\n"
." -b                 Sort/split faces to a BSP-tree\n"
."                      [Default: $split_bsp]\n"
."-- PAST-ACTIONS --------------------------------------------\n"
." -C                 Cleanup vertices/uvdata/normals/faces before\n"
."                    saving  (needs -d sometimes)\n"
."                      [Default: $cleanup_data2]\n"
." -T                 Make all faces triangles before saving\n"
."                      [Default: $triangulate_objects]\n"
." -R                 Re-sort faces (depth sorting) before saving\n"
."                      [Default: $sort_by_midpoint2] (normally needed)\n"
."\n"
."NOTE: Every tag that doesn't need additional data\n"
."      INVERTS THE DEFAULT SETTING.\n"
."      (e.g: if -b is used and default is 0 then the\n"
."      program will use the -b functionality and vice versa)\n" 
."\n";

  


#######################################################################
# Get all parameters and switches from the command line
#######################################################################
sub get_commandline_params () {
	use vars qw($opt_i $opt_o $opt_r $opt_R $opt_h $opt_v $opt_s $opt_b $opt_c $opt_C $opt_T $opt_d);
	use Getopt::Std;

	print $#ARGV."\n";                               # $DEBUG_testing
	if ($#ARGV == -1) {
		print "Error: Not enough parameters. See usage below\n";die $helptext;
	}

	if (!getopts('i:o:rRhv:sbcCTd')) {               # 'x:' takes argument 'x' doesn't
		print "Bad param.\n";
		die $helptext;
	}

	if ($opt_h) {
		print "Display help.\n";
		die $helptext;
	}

	# params with additional data
	if ($opt_v)	{$verbose	= $opt_v; }
	else		{$verbose	= 0; }
	if ($opt_i) {$file_in = $opt_i;}
	if ($file_in eq '') {
		print "Error: no input file (-i). See usage below.\n";die $helptext;
	}
	if ($opt_o) {
		$obj_out = $opt_o;
		($xmesh_out	= $obj_out)	=~ s/\.obj$/\.xmesh/;
	} else {
		($obj_out		= $file_in)	=~ s/\..*$/_cockpit\.obj/;
		($xmesh_out	= $file_in)	=~ s/\..*$/_cockpit\.xmesh/;
	}

	# single params
	if ($opt_c) {$cleanup_data		= !$cleanup_data;}
	if ($opt_d) {$delete_backfaces	= !$delete_backfaces;}
	if ($opt_r) {$sort_by_midpoint	= !$sort_by_midpoint;}
	if ($opt_R) {$sort_by_midpoint2	= !$sort_by_midpoint2;}
	if ($opt_s) {$split_by_view		= !$split_by_view;}
	if ($opt_b) {$split_bsp			= !$split_bsp;}
	if ($opt_T) {$triangulate_objects	= !$triangulate_objects;}
	if ($opt_C) {$cleanup_data2		= !$cleanup_data2;}
} # sub get_commandline_params
    
get_commandline_params();

print "##################################################################\n";
print "#---< OBJ Converter:  .obj -> .obj (e.g. VegaStrike Cockpit) >---#\n";
print "##################################################################\n";
print "Current settings (chronological order).......\n";
print "Infile          (i): ".$file_in           ."\n";
print "Outfile (OBJ)   (o): ".$obj_out          ."\n";
print "Outfile Xmesh   ( ): ".$xmesh_out        ."\n";
print "Remove Backfaces(d): ".$delete_backfaces ."\n";
print "Re-sort Faces   (r): ".$sort_by_midpoint ."\n";
print "Cleanup data    (c): ".$cleanup_data     ."\n";
print "Split faces     (s): ".$split_by_view    ."\n";
print "Create BSP tree (b): ".$split_bsp        ."\n";
print "Trianulate      (t): ".$triangulate_objects."\n";
print "Re-sort Faces   (R): ".$sort_by_midpoint2."\n";
print "Cleanup data    (C): ".$cleanup_data2    ."\n";
print "Verbosity       (v): ".$verbose          ."\n";

#---- main program variables ----

#my $vertices         = {};
#my $uvdata           = {};
#my $vndata           = {};
#my $faces            = [];

#my $vert_counter     = 0;
#my $uv_counter       = 0;
#my $norm_counter     = 0;

#my $mtlname_found    = 0;
#my $objectname_found = 0;

#my $groupname_found  = 0;
#my $usemtlname_found = 0;

#---- main program ----

#read_from_xmesh($file_in);
#die "DEBUG xmesh\n";

print "#############################################################\n";
print "Reading input file: ".$file_in."\n";
my $objects = read_from_any($file_in);
#write_to_debug('D:\dummy.txt',Dumper($objects));
print "-------------------------------------------------------------\n";
print "Facecount  : ".(objects_facecount($objects))."\n";   #print "Facecount  : ".$#{$faces}    ."\n";
print "Vertexcount: ".($objects->{'vert_counter'} )."\n";
print "UV-count   : ".($objects->{'uv_counter'}   )."\n";
print "Normalcount: ".($objects->{'norm_counter'} )."\n";
print "... Reading done.\n";

if ($delete_backfaces) {
	print "#############################################################\n";
	print "Removing the faces that are pointing the other way (away from center)  ...\n";
	print "Old facecount: ".objects_facecount($objects)."\n";
	delete_backfaces ($objects);
	print "New facecount: ".objects_facecount($objects)."\n";
	print "... Backfaces removed.\n";
}

if ($sort_by_midpoint) { # $DEBUG:testing
	print "#############################################################\n";
	print "Sorting by midpoint the first time  ...\n";
	sort_by_facemidpoint ($objects, 1 );
	print "... Sorting done.\n";
}

if ($cleanup_data) {
	print "#############################################################\n";
	print "Clean up data ...\n";
	clean_data($objects);
	print "... Cleaning done.\n";
}

my $edges = {};

if ($split_bsp) {
	if ($split_by_view) {
		$edges = get_edges($objects);
	}
	print "#############################################################\n";
	print "Creating and sorting BSP tree ...\n";
	print "Old facecount: ".objects_facecount($objects)."\n";
	print "Creating BSP tree (this will take some time)...\n";
	faces2bspfaces($objects->{'objects'}->[0]->{'faces'}, 0);
#print "f".Dumper($objects->{'objects'}->[0]->{'faces'})."f\n";
	my $bsptree = gen_bsptree_new( $objects->{'objects'}->[0]->{'faces'} , $objects );
	print "...done.\n";
	print "converting BSP-tree to facelist ...\n";
	$objects->{'objects'}->[0]->{'faces'} = bsptree2faceslist_new($bsptree);
#dbmclose %bsptree;                   # close the database
#undef %bsptree;
undef $bsptree if ($undef_vars);
	print "...done.\n";

	print "New facecount: ".objects_facecount($objects)."\n";
	print "... BSP tree+sorting done.\n";
}

### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # $DEBUG:MARK4
if ($split_by_view) {
	print "#############################################################\n";
	print "Splitting by view ...\n";
	print "Old facecount: ".objects_facecount($objects)."\n";
	print "Creating centerBSP-tree ...\n";
  
	my $used_edges = {};
	if (! $split_bsp) {
		$edges  = get_edges($objects);
	}

	print "Edgecount: ". (keys %{$edges}) ."\n";

#print "y".Dumper($objects->{'objects'}->[0]->{'faces'})."yy";

	my $centerbsptree  = gen_centerbsptree_new ($objects->{'objects'}->[0]->{'faces'},  $objects, $edges, $used_edges);
  
#print "x".Dumper($centerbsptree)."xx";
	print "\n";
	print "...done.\n";
	print "converting centerBSP-tree to facelist ...\n";
	$objects->{'objects'}->[0]->{'faces'} = centerbsptree2faceslist_new($centerbsptree);
undef $centerbsptree if ($undef_vars);
	print "...done.\n";

	print "New facecount: ".objects_facecount($objects)."\n";
	print "... Splitting by view done.\n";

} # split_by_view
### NEW!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

if ($cleanup_data2) {
	print "#############################################################\n";
	print "Clean up data ...\n";
	clean_data($objects);
	print "... Cleaning done.\n";
}

if ($triangulate_objects) {
	print "#############################################################\n";
	print "Making all faces triangles ...\n";
	print "Old facecount: ".objects_facecount($objects)."\n";
	triangulate_objects($objects);
	print "New facecount: ".objects_facecount($objects)." (tris)\n";
	print "... triangles done.\n";
}

if ($sort_by_midpoint2) {
	print "#############################################################\n";
	print "Sorting by midpoint ...\n";
#print "x".Dumper($bsptree);
	sort_by_facemidpoint ($objects, 1 ); # high to low distance (should be correct for VS display)
#  sort_by_facemidpoint ($objects, 0 ); # low to high distance
	print "... Sorting done.\n";
}


if ($write_as_obj) {
	print "#############################################################\n";
	print "Writing to obj file ...\n";

	if ($use_benchmark) {
		write_to_debug($obj_out.'.bench',$timer->reports());
	}
	write_to_obj ($obj_out, $objects);
	print "... Writing obj done.\n";
	print "\n";
######
	print "Writing to xmesh file ...\n";
	write_first_to_xmesh ($xmesh_out, $objects);
	print "... Writing xmesh done.\n";
}

print "#############################################################\n";

#----------------------------------------------------------------------
# END MAIN PROGRAM
#----------------------------------------------------------------------

#######################################################################
# If you're not sure whether the variable has a newline on the end, you can use the slightly
# safer chomp operator, which removes only a newline character
# (Or whatever the input record separator $/is set to.)
sub superchomp ($) { # $DEBUG:TODO unused right now .. needed?
	my ($string) = @_;
	#die "triangulate_object:object" unless (ref($object) eq 'HASH'  );
	my $default_EOL = $/;
	chomp($string);
	$/ = "\n";
	chomp($string);
	$/ = "\n\r";
	chomp($string);
	$/ = $default_EOL;
	return $string;
} # sub superchomp


#######################################################################
# obj syntax example
#
#mtllib 2box.mtl
#
#o cube2
#v -1.00000 -1.00000 5.63644
#vt 0.00000e+0 0.333333
#vn -0.577350 -0.577350 0.577350
#g cube2_cube2_auv
#usemtl cube2_auv
#f 3/20/3 2/15/2 1/13/1 4/19/4
#
#o cube1
#v 2.10756 -1.00000 5.63644
#vt 0.00000e+0 0.666667
#vn -0.577350 -0.577350 0.577350
#g cube1_cube1_auv
#usemtl cube1_auv
#f 11/41/11 10/37/10 9/36/9 12/40/12
#######################################################################

#######################################################################
##mtl syntax example
#
#newmtl octotoad1_auv_0
#Ns 100.000
#d 1.00000
#illum 2
#Kd 1.00000 1.00000 1.00000
#Ka 1.00000 1.00000 1.00000
#Ks 1.00000 1.00000 1.00000
#map_Kd fighter_hammer_octotoad1_auv_0_map_Kd.tga
#######################################################################

#######################################################################
# DB_File example
#
#use DB_File;                      # optional; overrides default
#use POSIX qw(tmpnam);
# try new temporary filenames until we get one that didn't already exist
# my %HASH ;
#do { $tmp_filename = tmpnam() }
#    until (dbmopen %HASH, $tmp_filename, 0666);

#$V = $HASH{$KEY};                 # retrieve from database
#$HASH{$KEY} = $VALUE;             # put value into database
#if (exists $HASH{$KEY}) {         # check whether in database
#    # ...
#}
#dbmclose %HASH;                   # close the database
#######################################################################

#######################################################################
# MLDBM example
#
# use Tie::MLDBM;
#
# tie my %test, 'Tie::MLDBM', {
#     'Serialise' =>  'Storable',
#     'Store'     =>  'DB_File'
# }, 'testdb.dbm', O_CREAT|O_RDWR, 0640 or die $!;
#
##WARNINGS
## The addition or alteration of elements to nested data structures is not entirely transparent in Perl. As such, in order to store a reference or modify an existing reference value within a tied hash, the value must first be retrieved and stored in a temporary variable before modification. For example, the following will not work:
#$hash{'key'}{'subkey'} = 'value';   #   Will not work
##Instead, this operation should be performed in a two-step process, like thus:
# $temp = $hash{'key'};               #   Retrieve element
# $temp->{'subkey'} = 'value';
# $hash{'key'} = $temp;               #   Store element
## This limitation exists because the perl TIEHASH interface currently has no support for multidimensional ties.
#######################################################################
#sub init_objects () { # $DEBUG:TODO is this even working (because vertices do have lists in them)
#	my $objects = {
#		'vertices' => {}, 'vert_counter' => 0,
#		'uvdata'   => {}, 'uv_counter'   => 0,
#		'vndata'   => {}, 'norm_counter' => 0 ,
#		'objects'  => []
#		};
#	# $DEBUG:TODO serialise/tie vertices, uvdata and vndata
#	use DB_File;                      # optional; overrides default
#	use POSIX qw(tmpnam);
#	my $tmp_filename = tmpnam();
#	do { $tmp_filename = tmpnam() }
#		until (dbmopen %{$objects->{'vertices'}}, $tmp_filename, 0666); # try new temporary filenames until we get one that didn't already exist
#	do { $tmp_filename = tmpnam() }
#		until (dbmopen %{$objects->{'uvdata'}}, $tmp_filename, 0666);
#	do { $tmp_filename = tmpnam() }
#		until (dbmopen %{$objects->{'vndata'}}, $tmp_filename, 0666);
#	return $objects;
#}
#######################################################################
# EOF
#######################################################################

Test case analysis

Test case problem solved.. see point 3 below.
"Move along, there is nothing to see here!

Here i try to reduce the test case to the problem. You can see in the code below that all but the last faces are commented out. The still active faces are the ones of the little cube which isn't visible in vegastrike, but imports into wings.

Possible reasons for the problem i've found so far:

  1. Normals are screwed up ... front/back (mentioned by dandandaman here)
  2. Rendering isn't working as expected (order of drawing)
  3. EDIT: OK, it was case 3 (the one nobody though of).... just set up the scale to "2.0" and everything is displayed ;) ..I'm feewing wucky

Now i'm of to test it with bigger and cooler cockpits ;) wasted CPU time here i come :D


Original test case data:
The test case can be found here. In this archive are two screenshots, one from within Wings3D and the same file in vegastrike as cockpit. [1] 3cubes_cockpit_wings.jpg == processed obj file (3cubes_cockpit.obj) displayed in Wings3D
3cubes_cockpit_vs.jpg == 3cubes_cockpit.xmesh

As you can see the small cube isn't shown/drawn in vegastrike.
Is this a bug or am I seeing ghosts again?

Testing/Benchmarking the code

Here's the code to time various functions and generate a (non-statistical) report: 

# Non-statistical usage
use Benchmark::Timer;
$timer = Benchmark::Timer->new(skip => 1);

for (xxx) {
	$timer->start('split_face_by_plane');
	####
	$timer->stop('split_face_by_plane');
}

for (yyy) {
	$timer->start('foreach my $face (@{$dummy_newfacesfar})');
	####
	$timer->stop('foreach my $face (@{$dummy_newfacesfar})');
}

for (zzz) {
	$timer->start('%x=%y+%z');
	####
	$timer->stop('%x=%y+%z');
}

print $timer->report;

See also

Retrieved from "https://wiki.vega-strike.org/mediawiki/index.php?title=Development:Script:obj2obj_converter&oldid=7964"