anim8or can export models as OBJs, which is a relatively straightforward model format with a few serious cases of brain-damage. (You can get the OBJ spec here.) It's easily parsed with a bit of Perl, so I wrote something to do that for me.
This script is broken in a number of ways. First off, it doesn't understand very much at all about the OBJ format, although it seems to know what to do with the OBJs anim8or emits. Second, it only knows how to triangulate quads, and triangulates those in what's probably a non-optimal way. Finally, it could use refactoring -- write_obj in particular is pretty ugly. Nevertheless, it does what I want, and it took about an hour to hack together.
#! /usr/bin/perl -w
use strict;
use Data::Dumper;
my %handlers = (
'v' => \&vert,
'vn' => \&norm,
'vt' => \&texc,
'f' => \&face,
);
=head2 read_obj(filename)
Reads an OBJ file and returns it as an array of hashrefs. Yeah, one d
+ay
this might be a class constructor.
my @groups = &read_obj("foo.obj");
my $group = shift @groups
$group->{'name'}; -- Group name, from "g foobar\n"
$group->{'verts'}; -- Array of vertices
$group->{'norms'}; -- Array of vertex normals
$group->{'texcs'}; -- Array of vertex texture coordinates
$group->{'faces'}; -- Array of polygons
my $vert = shift @{$group->{'verts'}};
$vert->{'x'}; -- x coordinate of $vert.
$vert->{'y'}; -- y coordinate of $vert.
$vert->{'z'}; -- z coordinate of $vert.
=cut
sub vert
{
my ($group, @args) = @_;
my $vert = {
'x' => $args[0],
'y' => $args[1],
'z' => $args[2],
};
push @{$group->{'verts'}}, $vert;
}
=pod
my $norm = shift @{$group->{'norms'}};
$norm->{'nx'}; -- x component of $norm.
$norm->{'ny'}; -- y component of $norm.
$norm->{'nz'}; -- z component of $norm.
=cut
sub norm
{
my ($group, @args) = @_;
my $norm = {
'nx' => $args[0],
'ny' => $args[1],
'nz' => $args[2],
};
push @{$group->{'norms'}}, $norm;
}
=pod
my $texc = shift @{$group->{'texcs'}};
$texc->{'s'}; -- s coordinate of $texc.
$texc->{'t'}; -- t coordinate of $texc.
=cut
sub texc
{
my ($group, @args) = @_;
my $texc = {
's' => $args[0],
't' => $args[1],
};
push @{$group->{'texcs'}}, $texc;
}
=pod
# Eww!
my $face = shift @{$group->{'faces'}};
$face == [
[v, t, n], -- vert, texc, norm indices for vertex 1
[v, t, n], -- vert, texc, norm indices for vertex 2
...
[v, t, n], -- vert, texc, norm indices for vertex k
];
=cut
sub face
{
my ($group, @args) = @_;
my $verts = [];
for (@args) {
my @vert = split '/';
push @$verts, \@vert;
}
push @{$group->{'faces'}}, $verts;
}
sub read_obj
{
my ($file) = @_;
open OBJ, '<', $file
or die "Can't open $file: $!\n";
my @groups = ();
my $group = undef;
while(<OBJ>) {
next unless /\S/;
my ($cmd, @args) = split;
# handle groups separately; this is a Red Flag(tm)
if($cmd eq 'g') {
push @groups, $group if $group;
$group = { 'name' => shift @args };
next;
}
# otherwise, use the appropriate function
my $handler = $handlers{$cmd};
if(defined $handler) {
$handler->($group, @args);
} else {
warn "Got odd command $cmd with args ",
join(' ', @args),
" in $file\n";
}
}
push @groups, $group;
close OBJ
or die "Can't close $file: $!\n";
return @groups;
}
sub triangulate_obj
{
my ($groups) = @_;
for my $group (@$groups) {
my $old_faces = $group->{'faces'};
$group->{'faces'} = [];
for my $face (@$old_faces) {
if (scalar @$face == 3) {
push @{$group->{'faces'}}, $face;
} elsif (scalar @$face == 4) {
my $tri_1 = [$face->[0], $face->[1], $face->[2]];
my $tri_2 = [$face->[0], $face->[2], $face->[3]];
push @{$group->{'faces'}}, $tri_1, $tri_2;
} else {
warn "Don't know how to triangulate a general poly\n";
push @{$group->{'faces'}}, $face;
}
}
}
}
sub write_obj
{
my ($file, @groups) = @_;
open OBJ, '>', $file
or die "Can't open $file: $!\n";
print OBJ "# Generated by tri_obj\n\n";
for my $group (@groups) {
print OBJ "g ", $group->{'name'}, "\n";
for my $v (@{$group->{'verts'}}) {
printf OBJ "v %f %f %f\n",
$v->{'x'}, $v->{'y'}, $v->{'z'};
}
for my $vn (@{$group->{'norms'}}) {
printf OBJ "vn %f %f %f\n",
$vn->{'nx'}, $vn->{'ny'}, $vn->{'nz'};
}
for my $vt (@{$group->{'texcs'}}) {
printf OBJ "vt %f %f\n", $vt->{'s'}, $vt->{'t'};
}
for my $f (@{$group->{'faces'}}) {
print OBJ "f ";
for my $vs (@$f) {
print Dumper $vs;
print OBJ join('/', @$vs), ' ';
}
print OBJ "\n";
}
}
close OBJ
or die "Can't close $file: $!\n";
}
my @groups = &read_obj($ARGV[0]);
&triangulate_obj(\@groups);
&write_obj('new_'.$ARGV[0], @groups);
--
F
o
x
t
r
o
t
U
n
i
f
o
r
m
Found a typo in this node? /msg me
% man 3 strfry