#!/usr/bin/perl -w

# 3ds to Vegastrike XML converter

%chunk_handler = (0x4d4d=>main_chunk,
		0x3d3d=>edit_chunk,
		0xafff=>matlist_chunk,
		0xa000=>matname_chunk,
		0xa200=>texture_chunk,
		0xa300=>texturefilename_chunk,
		0x4000=>objdesc_chunk,
		0x4100=>trimesh_chunk,
		0x4110=>vertexlist_chunk,
		0x4120=>facelist_chunk,
		0x4130=>facematerial_chunk,
		0x4140=>texcoord_chunk,
		  0x4150=>smoothgroup_chunk
		);

sub dispatch_chunk($) {
	my $data = $_[0];

	while(length $data > 6) {
	my ($id, $size) = unpack("SL", substr($data, 0, 6));
	$data = substr($data, 6);
	#print "chunk length: " . $size . "\n";

	if(exists $chunk_handler{$id}) {
		$chunk_handler{$id}($size, substr($data,0,$size-6));
	} else {
		print STDERR "Unhandled chunk type: " . sprintf("%x", $id) . "\n";
	}
	$data = substr($data, $size - 6);
	last unless defined $data;
	}
}

die "Usage: 3ds2xml <3dsfile>" if @ARGV < 1;
$infile = $ARGV[0];
open(INFILE, "<$infile") or die "could not load $infile";
binmode(INFILE);

if($infile =~ /^(.+)\.[^.]+$/) {
	$basename = $1;
} else {
	$basename = $infile;
}

open (UNITOUT, ">$basename.xunit");
print UNITOUT "<Unit>\n";
while(!eof(INFILE)) {
read(INFILE, $buf, 4096);
$data .= $buf;
}
dispatch_chunk($data);

print UNITOUT "</Unit>\n";

exit;

sub main_chunk($$) {
	print STDERR "Main chunk\n";
	print STDERR "length: " . length($_[1]) . "\n";
	dispatch_chunk($_[1]);
}

sub edit_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Edit chunk\n";
	dispatch_chunk($_[1]);
}

sub matlist_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Material list chunk\n";
	local $name = "";
	local $filename = "";
	dispatch_chunk($data);
	print STDERR "Material name: $name == texture $filename\n";
	$materials{$name} = $filename;
}

sub matname_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Material name chunk\n";
	$name = unpack("Z*", $data);
}

sub texture_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Texture chunk\n";
	dispatch_chunk($data);
}

sub texturefilename_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Texture filename chunk\n";
	$filename = unpack("Z*", $data);
}

sub objdesc_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Object description chunk\n";
	local $name = unpack("Z*", $data); 
	print STDERR "Name: $name\n";
	$data = substr($data, length($name)+1);

	local @vertices = (), @texcoords = (), @triangles = (), %obj_materials = ();
	dispatch_chunk($data);
	my $subunitfilename = "$basename-$name.xunit";
	open(SUBUNITOUT, ">$subunitfilename");
	print UNITOUT "<SubUnit file=\"$subunitfilename\"/>\n";
	print SUBUNITOUT "<Unit>\n";
	for my $matname (keys %obj_materials) {
	    my $meshfilename = "$basename-$name-$matname.xmesh";
	    open(MESHOUT, ">$meshfilename");
	    print SUBUNITOUT "<Meshfile file=\"$meshfilename\"/>\n";
	    print MESHOUT "<Mesh texture=\"$materials{$matname}\">\n<Points>\n";
	    my @points_to_print = (), %points_index = ();
	    my $polytext = "<Polygons>\n";
	    for (my $a=0; $a<@{$obj_materials{$matname}}; $a++) {
		$tri_index = $obj_materials{$matname}->[$a];
		$polytext .= "<Tri>\n";
		for(my $a=0; $a<@{$triangles[$tri_index]}; $a++) {
		    my $vertex = @{$triangles[$tri_index]}->[$a];
		    unless(exists $points_index{$vertex}) {
			$points_index{$vertex} = scalar @points_to_print;
			push @points_to_print, $vertex;
		    }
		    $polytext .= "    <Vertex point=\"$points_index{$vertex}\" s=\"$texcoords[$vertex]->[0]\" t=\"$texcoords[$vertex]->[1]\"/>\n";
		}
		$polytext .= "</Tri>\n";
	    }
	    $polytext .= "</Polygons>\n";
	    for (my $index=0, $vert=$points_to_print[0]; $index<@points_to_print; $vert=$points_to_print[++$index]) {
		print MESHOUT << "EOP"
<Point>
    <Location x="$vertices[$vert]->[0]" y="$vertices[$vert]->[1]" z="$vertices[$vert]->[2]"/>
<!--  <Normal i="0" j="1" k="0"/> -->
</Point>
EOP
    ;
	    }
	    print MESHOUT "</Points>\n$polytext</Mesh>";
	}
	print SUBUNITOUT "</Unit>\n";
}

sub trimesh_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Triangle list chunk\n";
	dispatch_chunk($data);
#	print MESHOUT ("<Points>\n<!-- Num vertices " . @vertices . "-->\n" . join("\n", @vertices) . "\n</Points>\n" . "<Polygons>\n" . join("\n", @triangles) . "\n</Polygons>\n");
}

sub vertexlist_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Vertex list chunk\n";
	#$|=1;
	#print STDOUT $data if $name eq "NoName1";
	my $num_vertices = unpack("S", substr($data, 0, 2));
	print STDERR "numvertices $num_vertices\n";
	$data = substr($data, 2);
	for (1..$num_vertices) {
		my @curr_vertex = unpack("fff", substr($data, 0, 12));
		push @vertices, [@curr_vertex];
		$data = substr($data, 12);
	}
}

sub texcoord_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Texture coordinate chunk\n";
	my $num_coords = unpack("S", substr($data,0,2));
	$data = substr($data, 2);
	print STDERR "$num_coords\n";
	for (1..$num_coords) {
		my @coords = unpack("ff", substr($data, 0, 8));
		push @texcoords, [@coords];
		$data = substr($data, 8);
	}
}

sub facelist_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Face list chunk\n";
	my ($numpoly) = unpack("S", substr($data,0,2));
	$data = substr($data, 2);
	for (1..$numpoly) {
		my $text = "<Tri>\n";
		my @points = unpack("SSS", substr($data, 0, 6));
		my ($info) = unpack("S", substr($data, 6, 8));
		push @triangles, [@points];
		$data = substr($data, 8);
	}
	dispatch_chunk($data);
}

sub facematerial_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Face material chunk\n";
	my $name = unpack("Z*", $data);
	$data = substr($data, length($name)+1);
#	if(exists $materials{$name}) {
#		print STDERR "Using $materials{$name} as texture\n";
#	} else {
#		print STDERR "could not find texture $name\n";
#	}
	my ($numfaces) = unpack("S", substr($data,0,2));
	$data = substr($data,2);
	for my $num (1..$numfaces) {
	    my $face = unpack("S", substr($data,0,2));
	    unless(exists $obj_matrials{$name}) {
		$obj_matrials{$name} = [];
	    }
	    push @{$obj_materials{$name}}, $face;
	    $data = substr($data,2);
	}
}

sub smoothgroup_chunk($$) {
	my ($size, $data) = @_;
	print STDERR "Smoothgroup chunk\n";
}
