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 # # 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.59 (2005.02.09)"; #---------------------------------------------------------- # *) 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 XBFM (SP?) 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 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 #---------------------------------------------------------------------- ####################################################################### # Import obj file ####################################################################### # Example objects data: # $objects= # {#global options # 'mtllib' => "" # 'vertices' => {1=>[x,y,z]}, 'vert_counter' => 0, # 'uvdata' => {1=>[u,v]}, 'uv_counter' => 0, # 'vndata' => {1=>[s,t]}, 'norm_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' }; 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 ####################################################################### # 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 }; ### 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 return "BADFACE"; } } #----------------------------------------------------------------------- # END FILE-EXPORT #----------------------------------------------------------------------- #---------------------------------------------------------------------- # BEGIN MAIN PROGRAM #---------------------------------------------------------------------- # set default values my $obj_in = ''; 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) {$obj_in = $opt_i;} if ($obj_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 = $obj_in) =~ s/\.obj$/_cockpit\.obj/; ($xmesh_out = $obj_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): ".$obj_in ."\n"; print "Outfile (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 ---- print "#############################################################\n"; print "Reading .obj file: ".$obj_in."\n"; #( $mtlname_found, $objectname_found, # $groupname_found, $usemtlname_found, # $vert_counter, $uv_counter, $norm_counter) # = read_from_obj ($obj_in,$faces, # $vertices, $uvdata, $vndata, # $vert_counter,$uv_counter, $norm_counter, # $mtlname_found, $objectname_found, # $groupname_found, $usemtlname_found); my $objects = read_from_obj($obj_in); print "Facecount : ".(objects_facecount($objects))."\n"; #print "Facecount : ".$#{$faces} ."\n"; print "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_obj($obj_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 #######################################################################=