Development:Script:obj2obj converter
Description
This script is under HEAVY development, but only when i find some spare time ;) (i love this sort of sentences)
Features and TODOs
- [finished] OBJ reading
- [finished] OBJ writing
- [finished] z-depth sorting (only works sane when everything is splitted correctly)
- [partly done] Splitting algorithms (needed for 3D cockpits)
This is the most needed feature right now.
Please see this thread in the formum or test case below for a test case i produced which isn't working correctly.- BSP (Binary Space Partition) splitting
- Split by view (edges)
- [finished] Parsing of tag data
- [OPEN] Writing of tag data
Test case
The problem with the script as mentioned above is that i still don't get the correct display in vegastrike.
I assembled this 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]
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?
[1] The xmesh in the archive was generated by my script, but the obj2xml 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.
obj2xml 3cubes_cockpit.obj
[2] The most recent version of my script is in the archive as well.
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.60 (2005.05.09)";
#----------------------------------------------------------
# *) 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;
#######################################################################
# 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
#----------------------------------------------------------------------
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
}
#######################################################################
# Import 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
print "DEBUG: read_from_xmesh() function not written yet!\n";
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
#######################################################################
# 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'=>''
# }
# {}
# ]
# },
# {}
# ]
# };
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*o\s/ && do { # body
# 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
# }
# $current_object = {
# 'faces' => [],
# }; # make new object
# (undef, $current_object->{'objectname'}) = split;
# print "Object: '".$current_object->{'objectname'}."'\n";
# };
# /^\s*g\s/ && do { # body_body_auv
# (undef, $current_object->{'groupname'}) = split;
# print "Group: '".$current_object->{'groupname'}."'\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);
return $objects;
} # sub read_from_obj
#######################################################################
# Import xmesh file
#######################################################################
sub read_from_xmesh ($)
{
my ($filename) = @_;
###########################
# read XML-tree from file
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'
}
);
write_to_debug('D:\dummy.txt',Dumper($data_tree));
#print Dumper($data_tree);
if (1) {
###########################
# 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 (undef,$objectname,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'=>[]
};
############
# add faces and uv data
foreach my $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'}++;
}
}
foreach my $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);
}
# faces& uvdata done
############
############
# add material (textures, etc...) and mesh data (texture, scale, etc...)
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'});
# material done
###############
undef $data_tree if ($undef_vars);
#write_to_debug('D:\dummy.txt',Dumper($objects));
push(@{$objects->{'objects'}}, {%{$object}}); # ...add previous object to the objectlist
# 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 = {};
foreach my $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) {
if (1) {
my ($x,$y,$z,$r,$s,$t) = (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' => []
};
foreach my $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) = @_;
die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' );
my $facecount=0;
foreach my $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 ($objects) = @_;
die "objects2vstags:objects" unless ( ref($objects) eq 'HASH' ); my ($filename) = @_;
my $material_hash = {};
open(MTL_IN, "< $filename") ||
die "failed to open $filename\n";
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 (@@@)
{
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 ( ($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 (@@)
{
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};
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 (@@%)
{
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 ) { return 0; };
#else
$status = -1;
};
if ( $side >= $epsilon )
{
if ( $status == -1 ) { return 0; };
#else
$status = 1;
};
#if ( $side == 0 ) { return 0; }; # $DEBUG:testing only deactivated for testing purpose
} #for
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 (@@@@@@@$$)
{
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;
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 ($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
}
#######################################################################
# 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 ($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
}
#######################################################################
# Calculates the min/max distance of a face to the center point
#######################################################################
sub 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; };
}
}
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 (@)
{
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 );
return [ $x / $length,
$y / $length,
$z / $length ];
} # sub make_vector_normal
#######################################################################
# Calculates the average normal vector of two given vecs
#######################################################################
sub 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};
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 (@@%%%$$$)
{
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
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 ( ($face_in_frustum == 1 ) &&
($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 ( ($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
#{
# skip
#}
# 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 (@@@%%%$$$)
{
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:plane" unless ( ref($plane) eq 'ARRAY' );
die "bspsplit_faces_by_plane:planeface" unless ( ref($planeface) eq 'ARRAY' );
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 $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
};
}#if $planeface=ok
else
{
$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
#######################################################################
# 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 (@@%%%$$$)
{
my ($faces, $plane, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount) = @_;
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:vertices" unless ( ref($vertices) 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 $newfacesfar = [];
my $newfacespar = [];
my $newvertices = {};
my $newuvdata = {};
my $newvndata = {};
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,
$vertexcount, $uvcount, $vncount )
= split_face_by_plane($face, $plane, $vertices, $uvdata, $vndata,
$vertexcount, $uvcount, $vncount );
push(@{$newfacesnear}, @{$dummy_newfacesnear});
push(@{$newfacesfar}, @{$dummy_newfacesfar} );
undef $dummy_newfacesnear if ($undef_vars);
undef $dummy_newfacesfar if ($undef_vars);
%{$newvertices} = ( %{$newvertices}, %{$dummy_newvertices} );
%{$newuvdata} = ( %{$newuvdata}, %{$dummy_newuvdata} );
%{$newvndata} = ( %{$newvndata}, %{$dummy_newvndata} );
undef $dummy_newvertices if ($undef_vars);
undef $dummy_newuvdata if ($undef_vars);
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
#######################################################################
# generate center-BSP tree
#######################################################################
sub gen_centerbsptree_new (@%%)
{
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: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, $vertices, $uvdata, $vndata, $vertexcount, $uvcount, $vncount);
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 (@%) # fixed for objects
{
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 (@%) # fixed for objects
{
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 (%$) # fixed for objects
{
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' );
foreach my $object (@{$objects->{'objects'}}) {
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;
print " Creating new list of vertices/uvdata/normals ... \n";
my $face = {};
my $vertexnumbers = {};
my $v;
my $vt;
my $vn;
my $vertex_v;
my $vertex_vt;
my $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
### 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
#######################################################################
# 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 (%) # fixed for 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 (%) # fixed for objects
{
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
#rotate around axis $value degrees
last SWITCH;
}
if ($type eq "s") { # SCALE
#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(%$$)
{
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'}));
}
#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 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
#######################################################################
# Return the currect XML-tag text for a poly with a given number of vertices
#######################################################################
sub poly_text ($)
{
my ($number) = @_;
SWITCH :
{
if ($number == 3) {return "Tri"; last SWITCH;}
if ($number == 4) {return "Quad"; last SWITCH;}
if ($number > 4) {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 $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 $xmesh_out = "";
my $helptext =
"=====================================\n"
."== obj converter $VERSION\n"
."=====================================\n"
."usage: obj_conv.pl <TAGS>\n"
."\n"
." -i<filename> Input file (obj)\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]\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\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 "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/\.obj$/_cockpit\.obj/;
($xmesh_out = $file_in) =~ s/\.obj$/_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);
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;
# use DB_File; # optional; overrides default
# use POSIX qw(tmpnam);
# 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
#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";
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 ($)
{
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 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 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
#######################################################################
##################################
# test functions
#open(DUMMY, "> test.txt") ||
# die "failed to open test.txt\n";
#
#my $objects_dummy =read_from_any($file_in);
#print DUMMY Dumper($objects_dummy)."\n";
#print DUMMY @{$objects_dummy->{'objects'}}."\n";
#################################
#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
#######################################################################
# EOF
#######################################################################
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
