#!/bin/perl

# Copyright (C) 1997-1998 Janne Lf <jlof@student.oulu.fi>
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the Free
# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.



use strict;

my $wrong_order = (unpack("N", "ABCD") != unpack("l", "ABCD"));

sub read_id {
	my $x;
	read STDIN, $x, 4;
	return $x;
}

sub read_uchar {
	my $x;
	read STDIN, $x, 1;
	return unpack("C", $x);	
}

sub read_short {
	my $x;
	read STDIN, $x, 2;
	$x = scalar reverse $x if $wrong_order;
	return unpack("s", $x);
}
sub read_long {
	my $x;
	read STDIN, $x, 4;
	$x = scalar reverse $x if $wrong_order;
	return unpack("l", $x);
}
sub read_float {
	my $x;
	read STDIN, $x, 4;
	$x = scalar reverse $x if $wrong_order;
	return unpack("f", $x);
}

sub read_string {
	$/ = "\000";
	my $x = <STDIN>;
	seek STDIN,1,1 if (length($x) & 1);
	chop $x;
	return $x;
}

#object info is stored to these variables
my %surface = ();
my @surf = ();
my @polygon = ();
my @px = ();
my @py = ();
my @pz = ();


# process arguments
my $draw_func = "draw";
$draw_func = $ARGV[0] if defined $ARGV[0];

my $scale = 1;
$scale = $ARGV[1] if defined $ARGV[1];

#read lightwave object file
die "Not a LightWave object file\n" if &read_id ne "FORM";
my $rlen = &read_long;
die "Not a LightWave object file\n" if &read_id ne "LWOB";
$rlen -= 4;


while ($rlen > 0) {
	my $cid  = &read_id;
	my $clen = &read_long;
	$rlen -= 8 + $clen + ($clen&1);
	
	if ($cid eq "PNTS") {

		while ($clen > 0) {
			push @px, &read_float * $scale;
			push @py, &read_float * $scale;
			push @pz, &read_float * $scale;
			$clen -= 12;
		}

	} elsif ($cid eq "POLS") {

		while ($clen > 0) {
			my @pol = ();
			my $points = &read_short;
			$clen -= 2;
			while ($points-- > 0) {
				push @pol, &read_short;
				$clen -= 2;
			}
			my $srf = &read_short; 
			$clen -= 2;
			die "Can't handle detail polygons\n" if ($srf < 0);
			unshift @pol, $srf-1;
			push @polygon, [ @pol ];
		}

	} elsif ($cid eq "SRFS") {

		while ($clen > 0) {
			my $name = &read_string;
			push @surf, $name;
			$clen -= (length($name)+1)+((length($name)+1)&1);
		}
	} elsif ($cid eq "SURF") {

		my $name = &read_string;
		$clen -= (length($name)+1)+((length($name)+1)&1);
		
		while ($clen > 0) {
			my $id  = &read_id;
			my $len = &read_short;
			$clen -= 6 + $len + ($len&1);
			if ($id eq "COLR") {
				$surface{$name}{r} = &read_uchar / 255.0;
				$surface{$name}{g} = &read_uchar / 255.0;
				$surface{$name}{b} = &read_uchar / 255.0;
				&read_uchar; # dummy
			} elsif ($id eq "LUMI") {
				$surface{$name}{lumi} = &read_short;
			} elsif ($id eq "DIFF") {
				$surface{$name}{diff} = &read_short;
			} elsif ($id eq "SPEC") {
				$surface{$name}{spec} = &read_short;
			} elsif ($id eq "REFL") {
				$surface{$name}{refl} = &read_short;
			} elsif ($id eq "TRAN") {
				$surface{$name}{tran} = &read_short;
			} else {
				seek STDIN, $len+($len&1), 1;
			}
		}

	} else {

		print STDERR "Unknown chunk $cid\n";
		seek STDIN, $clen+($clen&1), 1;

	}
}



#write opengl rendering function

print "/* automatically generated by lwtogl */\n";
print "#include <GL/gl.h>\n";
print "void $draw_func(void)\n";
print "{\n";

my $pol;
my $prev_pol_size = 0;
my $prev_srf;
for $pol (@polygon) {

	my $srf = $surf[shift @$pol];

	# calculate normal
	my $ax = $px[$pol->[2]] - $px[$pol->[1]];
	my $ay = $py[$pol->[2]] - $py[$pol->[1]];
	my $az = $pz[$pol->[2]] - $pz[$pol->[1]];

	my $bx = $px[$pol->[0]] - $px[$pol->[1]];
	my $by = $py[$pol->[0]] - $py[$pol->[1]];
	my $bz = $pz[$pol->[0]] - $pz[$pol->[1]];

	my $nx = $ay * $bz - $az * $by;
	my $ny = $az * $bx - $ax * $bz;
	my $nz = $ax * $by - $ay * $bx;

	my $r = sqrt($nx*$nx + $ny*$ny + $nz*$nz);
	$nx = $nx / $r;
	$ny = $ny / $r;
	$nz = $nz / $r;

	# TODO: optimizations, better handling of surfaces

	if ($prev_pol_size != scalar(@$pol) || $prev_pol_size > 4) {
		print "\tglEnd();\n" if ($prev_pol_size);
		if (scalar(@$pol) == 3) {
			print "\tglBegin(GL_TRIANGLES);\n";
		} elsif (scalar(@$pol) == 4) {
			print "\tglBegin(GL_QUADS);\n";
		} else {
			print "\tglBegin(GL_POLYGON);\n";
		}
		$prev_pol_size = scalar(@$pol);
	}
	if ($prev_srf ne $srf) {
		print "\tglColor3f($surface{$srf}{r}, $surface{$srf}{g}, $surface{$srf}{b} );\n";
		$prev_srf = $srf;
	}
	print "\tglNormal3f($nx,$ny,$nz);\n";
	my $p;
	foreach $p (@$pol) {
		print "\tglVertex3f($px[$p],$py[$p],$pz[$p]);\n";
	}
}
print "\tglEnd();\n" if ($prev_pol_size);


print "}\n";



