#!/usr/bin/perl
# ========================================================================
#< ac3d2threejs.pl - 12/05/2013
# AC3D parser and converter to three.js json format
# Based on ac3d2Horde3D format by Niek Albers, circa 13/11/2009
# 12/05/2013 geoff mclane http://geoffair.net/mperl
# TODO:
# 1: There are several TODO items noted, mainly where a more strict
# parsing would help.
# 2: At present a rought fix in output to ensure a "faces" : [ ] index is
# not out of range of the vertices or normals lists, but should address
# why this happens.
# 3: Should dig into the calculation of the normals. Original code expected
# only 3 refs, but have over-ridden this, but with what consequence?
# 4: Would be nice if some of the 'options' below were available on the command
# line, including for example the output file name.
# ==========================================================================
my $os = $^O;
# This need to be adjusted to suit your environment
my $perl_dir = '.';
my $PATH_SEP = '/';
my $temp_dir = '/tmp';
if ($os =~ /win/i) {
$perl_dir = '.';
$temp_dir = '.';
$PATH_SEP = "\\";
}
unshift(@INC, $perl_dir); # add location of lib_vec3.pm
my $VERSION = 0.7; # 12/05/2013 - lots of fixes - geoff
#my $VERSION = 0.6; # last by Niek Albers, circa 13/11/2009
use strict;
no strict 'refs';
#no warnings;
use Data::Dumper;
use Carp;
use File::Copy;
# note: in the original this 'package' was included, but I prefer it separated
require 'lib_vec3.pm' or die "Unable to load 'lib_vec3.pm' Check paths in \@INC...\n";
my $AC3D_FILE_VERSION = 11;
my $strict_triangluation = 0; # 0=allow any number of SURF refs
my $out_file = $temp_dir.$PATH_SEP."tempscene.xml"; # not really used
# options
my $do_welding = 0; # not sure what all this was about - it increases the vertices...
my $show_welding = 0; # now not done - see $do_welding = 0;
my $show_unwelding = 0; # now not done - see $do_welding = 0;
my $show_objects = 1; # turn off to reduce noise
my $show_calc_norms = 0; # additional noise
my $show_parse_kid = 0; # mainly for diagnostics
my $show_parse_numvert = 0; # likewise
my $show_out_of_range = 0; # show when an index is 'fixed'
my $add_other_items = 0; # just to see what they are
my $add_line_sep = 1; # add extra line to the json
my $normal = 0; # grep { $_ eq '-n' } @ARGV;
my $scene_basename;
my $source;
my $ac3dfile;
my $scenefile;
my $geofile;
my @VERTICES;
my @INDICES;
my @NORMALS;
my @TANGENTS;
my @BITANGENTS;
my @TCOORDS0;
my @TCOORDS1;
my @INDPERSURF = ();
my @warnings = ();
my $warn_count = 0; # also used as final exit level
my $index_offset = 0;
my $batch_offset = 0;
my $world = {};
my $material_files = {};
my $last_name = '';
# my $vertice_count = 0;
# 12/05/2013 - Added token 'subdiv' and 'texoff',
# and changed 'data' to what I understand it does
my $TOKENIZER = {
'MATERIAL' => \&parse_material,
'OBJECT' => \&parse_object,
'kids' => \&parse_kids,
'name' => \&parse_name,
'texture' => \&parse_value,
'crease' => \&parse_value,
'numvert' => \&parse_numvert,
'numsurf' => \&parse_numsurf,
'SURF' => \&parse_surf,
'mat' => \&parse_mat,
'refs' => \&parse_refs,
'texrep' => \&parse_texrep,
'rot' => \&parse_rot,
'loc' => \&parse_loc,
'url' => \&parse_value,
'data' => \&parse_data,
'subdiv' => \&parse_value,
'texoff' => \&parse_texoff,
};
# ### DEBUG ###
# Just some vey specific 'test' files, so I can run the script from my editor
# with a blank command line... should be OFF for release
my $debug_on = 0;
#my $def_file = 'C:\FG\18\blendac3d\cube.ac';
#my $def_file = 'C:\FG\18\blendac3d\f16.ac';
#my $def_file = 'C:\FG\fgdata\Aircraft\A380\Models\FlightDeck\Glareshield\efis_c.ac'; # has 'subdiv 1'
#my $def_file = 'C:\FG\fgdata\Aircraft\a4\Models\attitude-mod1.ac'; # has 'texoff -0.5 0.5'
#14398: ac_to_gl: Unrecognised token 'light', line 'OBJECT light'
#my $def_file = 'C:\FG\fgdata\Aircraft\dhc8\Models\dhc8.ac';
#ac_to_gl: Illegal ref record. actually has several blank lines!!! could overlook, but NO!
# Also fails with blender ac importer until blank lines are removed
#my $def_file = 'C:\FG\fgdata\Aircraft\Dromader\Models\DropSystem.ac';
my $def_file = 'C:\FG\ac3d\DropSystem.ac'; # fixed file - no warnings
############################################################################
eval { main(@ARGV) };
die($@) if ($@);
exit($warn_count);
sub prt($) { print shift; }
sub prtw($) {
my $t = shift;
push(@warnings,$t);
prt($t);
}
# simple vector3 class - now an external package
sub vec3 { vec3->new(@_) }
sub basename {
my $path = shift;
$path =~ s/.*[\/\\]//;
return [ split( /\./, $path ) ]->[0];
}
sub filename {
my $path = shift;
$path =~ s/.*[\/\\]//;
return $path;
}
# load a file line, and 'tokenise' it, removing
# any double quotes...
sub parse_line {
my $line = <$ac3dfile>;
return if ( !$line );
my @items = ( $line =~ /(".*?"|\S+)/g );
map { s/(^"|"$)//g } @items;
return \@items;
}
# individual opcode parsers
sub parse_header {
my $items = shift;
$items->[0] =~ m/^AC3D(\w)/;
die "not minimally an AC3D version $AC3D_FILE_VERSION file\n"
if ( hex($1) < $AC3D_FILE_VERSION );
}
sub parse_roc {
my $items = shift;
return [
[ $items->[1], $items->[2], $items->[3] ],
[ $items->[4], $items->[5], $items->[6] ],
[ $items->[7], $items->[8], $items->[9] ]
];
}
sub parse_value {
my $items = shift;
return $items->[1];
}
sub parse_name {
my $items = shift;
$last_name = $items->[1];
return $items->[1];
}
sub parse_texrep {
my $items = shift;
return { x => $items->[1], y => $items->[2] };
}
# 12/05/2013 - added
sub parse_texoff {
my $items = shift;
return { x => $items->[1], y => $items->[2] };
}
sub parse_surf {
my $items = shift;
my $param = hex( $items->[1] );
my $type = $param & 0xF;
my $types = { 0 => 'polygon', 1 => 'closedline', 2 => 'line' };
my $shading_sides = $param >> 4;
my $shading = $shading_sides & 0x1 ? 'smooth' : 'flat';
my $sides = $shading_sides & 0x2 ? 2 : 1;
my $result = {
type => $types->{$type},
shading => $shading,
sides => $sides,
};
return $result;
}
# 12/05/2013 - my 'understanding' is just take the next line, BUT if
# given a large 'len' could maybe be several lines, but what exactly is
# the spec on this?
sub parse_data {
my $items = shift;
my $len = $items->[1];
my $next = parse_line();
# TODO: if $strict_ac3d could check the length of the following line = len
my $result = {
data => $next
};
return $result;
}
sub parse_mat {
my $items = shift;
my $index = $items->[1];
# TODO: if $strict_ac3d could check the index is within range
return $world->{MATERIAL}->[$index];
}
sub parse_loc {
my $items = shift;
# TODO: if $strict_ac3d could check it is 3 floats
return vec3( $items->[1], $items->[2], $items->[3] );
}
sub parse_numvert {
my $items = shift;
my $numverts = $items->[1];
my @vertices = ();
# TODO: if $strict_ac3d could check it is 3 floats
for ( 1 .. $numverts ) {
my $itm = parse_line();
push @vertices, vec3( $itm->[0], $itm->[1], $itm->[2] );
}
my $cnt = scalar @vertices;
warn "parse_numvert: collected $cnt vertices ($numverts)\n" if ($show_parse_numvert);
return \@vertices;
}
sub parse_refs {
my $items = shift;
my $numrefs = $items->[1];
# TODO: since source expects just 3 refs, perhaps normals calculation
# also needs to be 'fixed' if this is off!
if ($strict_triangluation) {
die("model is not triangulated: $last_name numrefs=$numrefs\n") if ( $numrefs != 3 );
}
my @indices = ();
# TODO: if $strict_ac3d could check it is integer, in range, and 2 floats
for ( 1 .. $numrefs ) {
my $items = parse_line();
push @indices,
{ index => $items->[0], u => $items->[1], v => $items->[2] };
}
return \@indices;
}
# SURF 0x10
# mat 1
# refs 3
# 1 0.8 1
# 0 1 1
# 5 0.8 0
sub parse_surface {
my $items = shift;
my $surface = {};
# TODO: if $strict_ac3d could check opcode order, and
# index into vertices is valid!
while ( my $items = parse_line() ) {
my $opcode = $items->[0];
if ( exists( $TOKENIZER->{$opcode} ) ) {
$surface->{$opcode} = $TOKENIZER->{$opcode}($items);
} else {
my $line = join(" ",@{$items});
prtw("WARNING: $.: parse_surface: unrecognised opcode [$opcode] in '$line'\n");
}
last if ( $surface->{refs} );
}
return $surface;
}
sub parse_numsurf {
my $items = shift;
my $numsurfs = $items->[1];
my @surfaces = ();
for ( 1 .. $numsurfs ) {
push @surfaces, parse_surface($items);
}
return \@surfaces;
}
sub parse_kids {
my $items = shift;
my $amount = $items->[1];
my @objects = ();
warn "parse_kids: $amount...\n" if ($show_parse_kid && $amount);
for ( 1 .. $amount ) {
my $items = parse_line();
push @objects, parse_object($items);
}
warn "parse_kids: $amount done\n" if ($show_parse_kid && $amount);
return \@objects;
}
sub parse_object {
my $items = shift;
my $type = $items->[1];
my $object = {};
my $error;
$last_name = '';
$object->{type} = $type;
while ( my $items = parse_line() ) {
my $opcode = $items->[0];
if ( exists( $TOKENIZER->{$opcode} ) ) {
$object->{$opcode} = $TOKENIZER->{$opcode}($items);
$error = $@ if ($@);
} else {
$error = join(" ",@{$items});
prtw("WARNING: $.: parse_object: unrecognised opcode [$opcode] in '$error'\n");
}
last if ( $opcode eq 'kids' );
}
warn "parsed object: $object->{name}, type: $type, vertices: "
. int( @{ $object->{numvert} } ) . "\n" if ($show_objects);
return $object;
}
sub parse_material {
my $items = shift;
# TODO: if $strict_ac3d could check length, and verify tokens
return {
name => $items->[1],
rgb => [ $items->[3], $items->[4], $items->[5] ],
amb => [ $items->[7], $items->[8], $items->[9] ],
emis => [ $items->[11], $items->[12], $items->[13] ],
spec => [ $items->[15], $items->[16], $items->[17] ],
shi => $items->[19],
trans => $items->[21],
};
}
sub parse {
while ( my $items = parse_line() ) {
my $command = $items->[0];
if ( exists( $TOKENIZER->{$command} ) ) {
push @{ $world->{$command} }, $TOKENIZER->{$command}($items);
} else {
my $line = join(" ",@{$items});
prtw("WARNING: $.: parse: unrecognised command [$command] in '$line'\n");
}
}
return $world;
}
# Original write materials - NOT USED
sub write_material_NOT_USED {
my $object = shift;
my $texture = $object->{texture} || $scene_basename || 'standard';
my $texture_basename = basename($texture);
my $use_normal = $normal;
my $material_filename = "$scene_basename/$texture_basename.material.xml";
return if ( $material_files->{$material_filename} );
warn "writing to: $material_filename\n";
my $materialfile;
mkdir("$scene_basename");
open( $materialfile, ">$material_filename" )
|| die("Cannot write to $material_filename\n");
print $materialfile qq~\n~;
my $texture_filename = filename($texture);
warn
qq~copying "$texture_filename" to "$scene_basename/$texture_filename"\n~;
copy( $texture_filename, "$scene_basename/$texture_filename" ) || die("$!\n");
my $texture_normal_filename = $texture_filename;
$texture_normal_filename =~ s/\.(\w\w\w)$/_normal.$1/;
if ( !-e "$texture_normal_filename" ) {
$use_normal = 0;
}
else {
warn
qq~copying "$texture_normal_filename" to "$scene_basename/$texture_normal_filename"\n~;
copy( $texture_normal_filename, "$scene_basename/$texture_normal_filename" )
|| die("$!\n");
}
print $materialfile qq~\n~;
if ($texture) {
if ($use_normal) {
print $materialfile qq~\n~;
}
print $materialfile
qq~\n~;
if ($use_normal) { # add normal mapped texture
print $materialfile
qq~\n~;
}
}
print $materialfile qq~\n~;
close($materialfile);
$material_files->{$material_filename} = 1;
}
# add vertices for indices that point to the same vertex (full unweld)
sub unweld_object_NOT_USED {
my $object = shift;
print STDERR "unwelding: $object->{name} " if ($show_unwelding);
my @tcoords;
my %found;
foreach my $surface ( @{ $object->{numsurf} } ) {
foreach my $ref ( @{ $surface->{refs} } ) {
if ( $found{ $ref->{index} } ) {
# add new vertex
push @{ $object->{numvert} },
$object->{numvert}->[ $ref->{index} ];
$ref->{index} = int( @{ $object->{numvert} } ) - 1;
}
$found{ $ref->{index} } = 1;
$tcoords[ $ref->{index} ] = $ref;
}
}
print STDERR "vertices: " . int( @{ $object->{numvert} } ) . "\n" if ($show_unwelding);
$object->{tcoords} = \@tcoords;
}
# remove vertices that have the same coordinates, texture coordinates and normals
sub weld_object_NOT_USED {
my $object = shift;
print STDERR "welding: $object->{name} " if ($show_welding);
my @vertices;
my @normals;
my @tangents;
my @bitangents;
my @tcoords;
my %found;
my $index = 0;
foreach my $surface ( @{ $object->{numsurf} } ) {
foreach my $ref ( @{ $surface->{refs} } ) {
my $vertex = $object->{numvert}->[ $ref->{index} ];
my $normal = $object->{normals}->[ $ref->{index} ];
my $tcoord = $object->{tcoords}->[ $ref->{index} ];
my $tangent = $object->{tangents}->[ $ref->{index} ];
my $bitangent = $object->{bitangents}->[ $ref->{index} ];
if ((! defined $vertex)||(! defined $normal)||
(! defined $tcoord)||(! defined $tangent)||(! defined $bitangent)) {
warn "weld_object: got undefined suface reference!\n";
next;
}
if (
!exists(
$found{ $vertex->as_string }->{ $normal->as_string }
->{ $tcoord->{u} . ',' . $tcoord->{v} }
)
)
{
$found{ $vertex->as_string }->{ $normal->as_string }
->{ $tcoord->{u} . ',' . $tcoord->{v} } = $index;
$vertices[$index] = $vertex;
$normals[$index] = $normal;
$tcoords[$index] = $tcoord;
$tangents[$index] = $tangent;
$bitangents[$index] = $bitangent;
$index++;
}
$ref->{index} =
$found{ $vertex->as_string }->{ $normal->as_string }
->{ $tcoord->{u} . ',' . $tcoord->{v} };
}
}
$object->{numvert} = \@vertices;
$object->{normals} = \@normals;
$object->{tangents} = \@tangents;
$object->{bitangents} = \@bitangents;
$object->{tcoords} = \@tcoords;
print STDERR "vertices: " . int( @{ $object->{numvert} } ) . "\n" if ($show_welding);
}
# find lowest and highest vertex index
sub get_min_max_count_index {
my $object = shift;
my $min_index = 0xffffffff;
my $max_index = 0;
my $index_count = 0;
foreach my $surface ( @{ $object->{numsurf} } ) {
foreach my $ref ( @{ $surface->{refs} } ) {
if ( $max_index < $ref->{index} ) {
$max_index = $ref->{index};
}
if ( $min_index > $ref->{index} ) {
$min_index = $ref->{index};
}
$index_count++;
}
}
return ( $min_index, $max_index, $index_count );
}
# original write object - NOT USED
sub write_object_NOT_USED {
my $object = shift;
my $tag = '';
my $params = {};
if ( $object->{loc} ) {
$params->{tx} = $object->{loc}->x;
$params->{ty} = $object->{loc}->y;
$params->{tz} = $object->{loc}->z;
}
if ( $object->{type} eq 'world' ) {
$tag = 'Group';
$params->{name} = 'world';
}
elsif ( $object->{type} eq 'group' ) {
$tag = 'Model';
$params->{name} = $object->{name};
$params->{geometry} = "$scene_basename/$scene_basename.geo";
$object->{in_model} = 1;
}
elsif ( $object->{type} eq 'poly' ) {
if ( !$object->{in_model} )
{ # whoops not in a model yet, create one first
my %wrapper = %$object;
$wrapper{kids} = [$object];
$wrapper{type} = 'group';
delete $object->{loc}; # set location for model in this case
write_object( \%wrapper );
return;
}
else {
$tag = 'Mesh';
unweld_object($object);
calc_vertex_normals($object);
weld_object($object);
# warn Dumper($object);
my $material = basename( $object->{texture} ) || 'standard';
$params->{material} = "$scene_basename/$material.material.xml";
$params->{name} = $object->{name};
my ( $min_index, $max_index, $index_count ) =
get_min_max_count_index($object);
$params->{vertRStart} = $min_index + $index_offset;
$params->{vertREnd} = $max_index + $index_offset;
$params->{batchCount} = $index_count;
$params->{batchStart} = $batch_offset;
write_material($object);
push @VERTICES, @{ $object->{numvert} };
push @NORMALS, @{ $object->{normals} };
push @TANGENTS, @{ $object->{tangents} };
push @BITANGENTS, @{ $object->{bitangents} };
push @TCOORDS0, @{ $object->{tcoords} };
foreach my $surface ( @{ $object->{numsurf} } ) {
foreach my $ref ( @{ $surface->{refs} } ) {
push @INDICES, $ref->{index} + $index_offset;
}
}
$index_offset += int( @{ $object->{numvert} } );
$batch_offset += $index_count;
}
}
my $attributes = '';
foreach my $key ( sort keys(%$params) ) {
$attributes .= qq~ $key="$params->{$key}"~;
}
print $scenefile qq~<$tag$attributes>\n~;
foreach my $kid ( @{ $object->{kids} } ) {
$kid->{in_model} = $object->{in_model};
write_object($kid);
}
print $scenefile qq~$tag>\n~;
delete $object->{kids};
}
# original write geo - NOT USED
sub write_geo_NOT_USED {
my $filename = "$scene_basename/$scene_basename.geo";
open( $geofile, ">$filename" )
|| die("cannot write to $filename\n");
binmode($geofile);
warn "writing to: $filename\n";
print $geofile "H3DG" . pack( 'I', 5 ); # horde file version
print $geofile pack( 'I', 1 ); # numjoints (0+1)
print $geofile
pack( 'f16', 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1 )
; # identity matrix
print $geofile pack( 'I', 6 ); # num vertex streams
print $geofile pack( 'I', int(@VERTICES) ); # num vertices
# Vertices - positions magic = 0
print $geofile pack( 'I', 0 );
# streamElementSize 12
print $geofile pack( 'I', 12 );
foreach my $vertex (@VERTICES) {
print $geofile pack( 'f3', $vertex->x, $vertex->y, $vertex->z );
}
# Normals - positions magic = 1
print $geofile pack( 'I', 1 );
# streamElementSize 6
print $geofile pack( 'I', 6 );
foreach my $normal (@NORMALS) {
print $geofile pack( 's3',
round( $normal->x * 32767 ),
round( $normal->y * 32767 ),
round( $normal->z * 32767 ) );
}
# Tangents - positions magic = 2
print $geofile pack( 'I', 2 );
# streamElementSize 6
print $geofile pack( 'I', 6 );
foreach my $tangent (@TANGENTS) {
print $geofile pack( 's3',
round( $tangent->x * 32767 ),
round( $tangent->y * 32767 ),
round( $tangent->z * 32767 ) );
}
# BiTangents - positions magic = 3
print $geofile pack( 'I', 3 );
# streamElementSize 6
print $geofile pack( 'I', 6 );
foreach my $bitangent (@BITANGENTS) {
print $geofile pack( 's3',
round( $bitangent->x * 32767 ),
round( $bitangent->y * 32767 ),
round( $bitangent->z * 32767 ) );
}
# texture coordinates set 0 - positions magic = 6
print $geofile pack( 'I', 6 );
# streamElementSize 8
print $geofile pack( 'I', 8 );
foreach my $tcoord (@TCOORDS0) {
print $geofile pack( 'f2', $tcoord->{u}, $tcoord->{v} );
}
# for now
@TCOORDS1 = @TCOORDS0;
# texture coordinates set 1 - positions magic = 7
print $geofile pack( 'I', 7 );
# streamElementSize 8
print $geofile pack( 'I', 8 );
foreach my $tcoord (@TCOORDS1) {
print $geofile pack( 'f2', 0, 0 );
# print $geofile pack( 'f2', $tcoord->{u}, $tcoord->{v} );
}
print $geofile pack( 'I', int(@INDICES) );
foreach my $index (@INDICES) {
print $geofile pack( 'I', $index );
}
# Morph targets = 0
print $geofile pack( 'I', 0 );
close($geofile);
}
# original write scene - NOT USED
sub write_scene_NOT_USED {
my $tree = shift;
if (length($out_file)) {
warn "writing to: $out_file\n";
open( $scenefile, ">$out_file" )
|| die("Cannot write to $out_file\n");
} else {
mkdir($scene_basename);
my $scene_filename = "$scene_basename/$scene_basename.scene.xml";
warn "writing to: $scene_filename\n";
open( $scenefile, ">$scene_filename" )
|| die("Cannot write to $scene_filename\n");
}
write_object( $tree->{OBJECT}->[0] );
close($scenefile);
}
# =================================================================================
###################################################################################
# my three.js replacement fucntions
###################################################################################
sub write_js2 {
my ($cnt,$i,$msg,$itm,@arr);
my $filename = $temp_dir.$PATH_SEP."temp.$scene_basename.js";
open( $geofile, ">$filename" )
|| die("cannot write to $filename\n");
warn "writing to: $filename\n";
my $vcnt = scalar @VERTICES;
my $ncnt = scalar @NORMALS;
my $scnt = scalar @INDPERSURF;
$msg = "{\n";
$msg .= "\n" if ($add_line_sep);
$msg .= "\t\"metadata\" : {\n";
$msg .= "\t\t\"formatVersion\" : 3.1,\n";
$msg .= "\t\t\"generatedBy\" : \"ac3d2threejs.pl $VERSION\",\n";
$msg .= "\t\t\"vertices\" : $vcnt,\n";
$msg .= "\t\t\"faces\" : $scnt,\n";
$msg .= "\t\t\"normals\" : $ncnt,\n";
$msg .= "\t\t\"colors\" : 0,\n";
$msg .= "\t\t\"uvs\" : [],\n";
$msg .= "\t\t\"materials\" : 1,\n";
$msg .= "\t\t\"morphTargets\" : 0,\n";
$msg .= "\t\t\"bones\" : 0\n";
$msg .= "\t},\n";
$msg .= "\n" if ($add_line_sep);
$msg .= "\t\"scale\" : 1.000000,\n";
$msg .= "\n" if ($add_line_sep);
print $geofile $msg;
$msg = "\t\"vertices\" : [";
for ($i = 0; $i < $vcnt; $i++) {
my $vertex = $VERTICES[$i];
$msg .= $vertex->x;
$msg .= ',';
$msg .= $vertex->y;
$msg .= ',';
$msg .= $vertex->z;
$msg .= "," if (($i + 1) < $vcnt);
}
$msg .= "],\n";
$msg .= "\n" if ($add_line_sep);
print $geofile $msg;
print $geofile "\t\"morphTargets\" : [],\n";
print $geofile "\n" if ($add_line_sep);
# Normals - positions magic = 1
$msg = "\t\"normals\" : [";
for ($i = 0; $i < $ncnt; $i++) {
my $normal = $NORMALS[$i];
next if (!defined $normal);
$msg .= $normal->x;
$msg .= ',';
$msg .= $normal->y;
$msg .= ',';
$msg .= $normal->z;
$msg .= ',' if (($i + 1) < $ncnt);
}
$msg .= "],\n";
print $geofile $msg;
print $geofile "\n" if ($add_line_sep);
# foreach my $tcoord (@TCOORDS0) {
# print $geofile pack( 'f2', $tcoord->{u}, $tcoord->{v} );
# }
#
# # for now
# @TCOORDS1 = @TCOORDS0;
#
# # texture coordinates set 1 - positions magic = 7
# print $geofile pack( 'I', 7 );
#
# # streamElementSize 8
# print $geofile pack( 'I', 8 );
# foreach my $tcoord (@TCOORDS1) {
# print $geofile pack( 'f2', 0, 0 );
#
# # print $geofile pack( 'f2', $tcoord->{u}, $tcoord->{v} );
# }
#
print $geofile "\t\"colors\" : [],\n";
print $geofile "\n" if ($add_line_sep);
print $geofile "\t\"uvs\" : [],\n";
print $geofile "\n" if ($add_line_sep);
my ($tmp,$cnt2,$j,$k);
my ($ind,$emsg);
$msg = "\t\"faces\" : [";
$cnt = scalar @INDPERSURF;
for ($i = 0; $i < $cnt; $i++) {
$tmp = $INDPERSURF[$i];
$msg .= ',' if ($i);
$cnt2 = scalar @{$tmp};
$msg .= "35";
$k = 0;
for ($j = 0; $j < $cnt2; $j++) {
$ind = ${$tmp}[$j];
if (($ind < 0)||($ind >= $vcnt)) {
$emsg .= "$i:$j: VOOR $ind on $vcnt ";
$ind = $vcnt - 1;
}
$msg .= ",$ind";
$k++;
last if ($k == 4);
}
while ($k < 4) {
$msg .= ',0';
$k++;
}
$msg .= ',0';
$k = 0;
for ($j = 0; $j < $cnt2; $j++) {
$ind = ${$tmp}[$j];
if (($ind < 0)||($ind >= $ncnt)) {
$emsg .= "$i:$j: $ind/$ncnt ";
$ind = $ncnt - 1;
}
$msg .= ",$ind";
$k++;
last if ($k == 4);
}
while ($k < 4) {
$msg .= ',0';
$k++;
}
}
$msg .= "],\n";
prtw("WARNING: Out of range index: $emsg\n") if (length($emsg) && $show_out_of_range);
print $geofile $msg;
print $geofile "\n" if ($add_line_sep);
print $geofile "\t\"bones\" : [],\n";
print $geofile "\n" if ($add_line_sep);
print $geofile "\t\"skinIndices\" : [],\n";
print $geofile "\n" if ($add_line_sep);
print $geofile "\t\"skinWeights\" : [],\n";
print $geofile "\n" if ($add_line_sep);
print $geofile "\t\"animation\" : {}";
if ($add_other_items) {
# this was just to see what they contained
print $geofile ",\n";
print $geofile "\n" if ($add_line_sep);
@arr = @INDICES;
$cnt = scalar @arr;
$msg = "\t\"indices\" : [";
for ($i = 0; $i < $cnt; $i++) {
$itm = $arr[$i];
$msg = $itm;
$msg .= ',' if (($i + 1) < $cnt);
}
$msg .= "],\n";
print $geofile $msg;
print $geofile "\n" if ($add_line_sep);
@arr = @TANGENTS;
$cnt = scalar @arr;
print $geofile "\t\"tangents\" : [";
for ($i = 0; $i < $cnt; $i++) {
$itm = $arr[$i];
$msg = $itm->x;
$msg .= ',';
$msg .= $itm->y;
$msg .= ',';
$msg .= $itm->z;
$msg .= ',' if (($i + 1) < $cnt);
print $geofile $msg;
}
print $geofile "],\n";
print $geofile "\n" if ($add_line_sep);
@arr = @BITANGENTS;
$cnt = scalar @arr;
$msg = "\t\"bitangents\" : [";
for ($i = 0; $i < $cnt; $i++) {
$itm = $arr[$i];
$msg = $itm->x;
$msg .= ',';
$msg .= $itm->y;
$msg .= ',';
$msg .= $itm->z;
$msg .= ',' if (($i + 1) < $cnt);
}
$msg .= "]\n";
print $geofile $msg;
print $geofile "\n" if ($add_line_sep);
} else {
print $geofile "\n";
}
print $geofile "\n" if ($add_line_sep);
print $geofile "}\n";
close($geofile);
warn "written to: $filename\n";
}
sub write_material2 {
my $object = shift;
my $texture = $object->{texture} || $scene_basename || 'standard';
my $texture_basename = basename($texture);
my $use_normal = $normal;
my $material_filename = "$scene_basename/$texture_basename.material.xml";
return if ( $material_files->{$material_filename} );
### warn "writing to: $material_filename\n";
my $materialfile = $scenefile;
###mkdir("$scene_basename");
###open( $materialfile, ">$material_filename" )
### || die("Cannot write to $material_filename\n");
print $materialfile qq~\n~;
my $texture_filename = filename($texture);
# warn
# qq~copying "$texture_filename" to "$scene_basename/$texture_filename"\n~;
# copy( $texture_filename, "$scene_basename/$texture_filename" ) || die("$!\n");
#
my $texture_normal_filename = $texture_filename;
$texture_normal_filename =~ s/\.(\w\w\w)$/_normal.$1/;
#
# if ( !-e "$texture_normal_filename" ) {
# $use_normal = 0;
# }
# else {
# warn
#qq~copying "$texture_normal_filename" to "$scene_basename/$texture_normal_filename"\n~;
# copy( $texture_normal_filename, "$scene_basename/$texture_normal_filename" )
# || die("$!\n");
# }
#
print $materialfile qq~\n~;
if ($texture) {
if ($use_normal) {
print $materialfile qq~\n~;
}
print $materialfile
qq~\n~;
if ($use_normal) { # add normal mapped texture
print $materialfile
qq~\n~;
}
}
print $materialfile qq~\n~;
### close($materialfile);
$material_files->{$material_filename} = 1;
}
sub write_object2 {
my $object = shift;
my $tag = '';
my $params = {};
if ( $object->{loc} ) {
$params->{tx} = $object->{loc}->x;
$params->{ty} = $object->{loc}->y;
$params->{tz} = $object->{loc}->z;
}
if ( $object->{type} eq 'world' ) {
$tag = 'Group';
$params->{name} = 'world';
}
elsif ( $object->{type} eq 'group' ) {
$tag = 'Model';
$params->{name} = $object->{name};
$params->{geometry} = "$scene_basename/$scene_basename.geo";
$object->{in_model} = 1;
}
elsif ( $object->{type} eq 'poly' ) {
if ( !$object->{in_model} )
{ # whoops not in a model yet, create one first
my %wrapper = %$object;
$wrapper{kids} = [$object];
$wrapper{type} = 'group';
delete $object->{loc}; # set location for model in this case
write_object2( \%wrapper );
return;
}
else {
$tag = 'Mesh';
unweld_object($object) if ($do_welding);
calc_vertex_normals($object);
weld_object($object) if ($do_welding);
# warn Dumper($object);
my $material = basename( $object->{texture} ) || 'standard';
$params->{material} = "$scene_basename/$material.material.xml";
$params->{name} = $object->{name};
my ( $min_index, $max_index, $index_count ) =
get_min_max_count_index($object);
$params->{vertRStart} = $min_index + $index_offset;
$params->{vertREnd} = $max_index + $index_offset;
$params->{batchCount} = $index_count;
$params->{batchStart} = $batch_offset;
### my $vcnt = scalar @{ $object->{numvert} };
### my $ncnt = scalar @{ $object->{normals} };
### write_material($object);
write_material2($object);
### my $vcnt2 = scalar @{ $object->{numvert} };
### my $ncnt2 = scalar @{ $object->{normals} };
### warn "Before $vcnt,$ncnt, after $vcnt2,$ncnt2\n";
push @VERTICES, @{ $object->{numvert} };
push @NORMALS, @{ $object->{normals} };
push @TANGENTS, @{ $object->{tangents} };
push @BITANGENTS, @{ $object->{bitangents} };
push @TCOORDS0, @{ $object->{tcoords} };
# @INDPERSURF
my @inds = ();
foreach my $surface ( @{ $object->{numsurf} } ) {
@inds = ();
foreach my $ref ( @{ $surface->{refs} } ) {
push @INDICES, $ref->{index} + $index_offset;
push @inds, $ref->{index} + $index_offset;
}
push(@INDPERSURF, [@inds]); # keep on a per face basis
}
$index_offset += int( @{ $object->{numvert} } );
$batch_offset += $index_count;
}
}
my $attributes = '';
foreach my $key ( sort keys(%$params) ) {
$attributes .= qq~ $key="$params->{$key}"~;
}
print $scenefile qq~<$tag$attributes>\n~;
foreach my $kid ( @{ $object->{kids} } ) {
$kid->{in_model} = $object->{in_model};
write_object2($kid);
}
print $scenefile qq~$tag>\n~;
delete $object->{kids};
}
sub write_threejs {
my $tree = shift;
if (length($out_file)) {
warn "writing to: $out_file\n";
open( $scenefile, ">$out_file" )
|| die("Cannot write to $out_file\n");
} else {
warn "no out file\n";
return;
}
write_object2( $tree->{OBJECT}->[0] );
close($scenefile);
warn "written to: $out_file\n";
}
# =================================================================================
###################################################################################
sub uv_sub {
my $uv1 = shift;
my $uv2 = shift;
return {
u => $uv1->{u} - $uv2->{u},
v => $uv1->{v} - $uv2->{v}
};
}
# find vertices with same coordinates, this is for normal smoothing, return of list of matching indices
sub find_same_vertices {
my $object = shift;
my $indices_map = shift;
my $index = shift;
my $vertex = $object->{numvert}->[$index];
my @indices = @{ $indices_map->{ $vertex->as_string } };
push( @indices, $index ) if ( !grep { $_ == $index } @indices );
return @indices;
}
# create map of indices with same vertices
sub make_indices_map {
my $object = shift;
my %indices_map;
foreach my $surface ( @{ $object->{numsurf} } ) {
# only average out smooth vertex normals
next if ( $surface->{SURF}->{shading} ne 'smooth' );
foreach my $ref ( @{ $surface->{refs} } ) {
my $v = $object->{numvert}->[ $ref->{index} ];
push @{ $indices_map{ $v->as_string } }, $ref->{index};
}
}
# warn Dumper(\%indices_map);
return \%indices_map;
}
sub calc_vertex_normals {
my $object = shift;
my $vcnt = scalar @{ $object->{numvert} };
my $scnt = scalar @{ $object->{numsurf} };
warn "calculating normals: $object->{name} v=$vcnt, s=$scnt\n" if ($show_calc_norms);
my @normals;
my @tangents;
my @bitangents;
my $indices_map = make_indices_map($object);
foreach my $surface ( @{ $object->{numsurf} } ) {
my $index0 = $surface->{refs}->[0]->{index};
my $index1 = $surface->{refs}->[1]->{index};
my $index2 = $surface->{refs}->[2]->{index};
my $v0 = $object->{numvert}->[$index0];
my $v1 = $object->{numvert}->[$index1];
my $v2 = $object->{numvert}->[$index2];
my $d0 = $v1 - $v0;
my $d1 = $v2 - $v0;
my $v = ( $d0 x $d1 )->normalized;
#
# Calculate the normal for this face and add it
# to the running sum of normals for each of the
# three vertices involved
#
# and now tangents and bitangents
my $Edge0uv = uv_sub( $surface->{refs}->[1], $surface->{refs}->[0] );
my $Edge1uv = uv_sub( $surface->{refs}->[2], $surface->{refs}->[0] );
my $cp = $Edge0uv->{u} * $Edge1uv->{v} - $Edge1uv->{u} * $Edge0uv->{v};
my $r = 0;
if ( $cp != 0 ) {
$r = 1.0 / $cp;
}
my $tangent = ( $d0 * $Edge1uv->{v} - $d1 * $Edge0uv->{v} ) * $r;
my $bitangent = ( $d1 * $Edge0uv->{u} - $d0 * $Edge1uv->{u} ) * $r;
my @indices;
push @indices, find_same_vertices( $object, $indices_map, $index0 );
push @indices, find_same_vertices( $object, $indices_map, $index1 );
push @indices, find_same_vertices( $object, $indices_map, $index2 );
foreach my $index (@indices) {
$normals[$index] ||= vec3();
$tangents[$index] ||= vec3();
$bitangents[$index] ||= vec3();
$normals[$index] += $v;
$tangents[$index] += $tangent;
$bitangents[$index] += $bitangent;
}
}
# Normalize and fixup the vertex normal vectors, tangents en bitangents
my $numVerts = int( @{ $object->{numvert} } );
for ( my $j = 0 ; $j < $numVerts ; $j++ ) {
next if (! defined $normals[$j]);
my $n = $normals[$j]->normalized;
my $t = $tangents[$j];
# orthogonalize
$tangents[$j] = ( $t - $n * ( $n * $t ) )->normalized;
$normals[$j] = $n;
if ( ( $n x $t ) * $bitangents[$j] < 0 ) {
$bitangents[$j] = ( ( $n * -1 ) x $t )->normalized;
}
else {
$bitangents[$j] = ( $n x $t )->normalized;
}
}
$object->{normals} = \@normals;
$object->{tangents} = \@tangents;
$object->{bitangents} = \@bitangents;
}
sub round {
my $number = shift;
return int( $number + .5 * ( $number <=> 0 ) );
}
# TODO: Add more command line options
sub main {
if ($debug_on) {
$source = $def_file;
open( $ac3dfile, "<$source" ) || die "cannot open $source\n";
} else {
warn
"AC3D2Threejs.pl $VERSION - Convert AC3D .ac file to three.js json file.\n";
$source = pop
|| die
"usage: $0 \n";
open( $ac3dfile, "<$source" ) || die "cannot open $source\n";
}
$scene_basename = basename($source);
my $header = parse_line();
parse_header($header);
my $tree = parse();
#### write_scene($tree);
#### warn Dumper($tree);
#### write_geo();
write_threejs($tree);
write_js2();
$warn_count = scalar @warnings;
if ($warn_count) {
foreach my $w (@warnings) {
prt($w);
}
}
warn "Done file [$source], lines $., exit $warn_count\n";
close($ac3dfile);
}
# eof - ac3d2threejs.pl