#!/usr/bin/perl

$debug=0;
sub debug(@) {
    print @_ if ($debug);
}
sub formatnum ($) {
    return "0.0" if (abs($_[0])<0.0000001) ;
    my $var="$_[0]";
    if (length $var > 10) {
	$var=substr $var, 0, 10;
    }
    return $var;
}
sub formatvert ($) {
    my $v=shift;
    return ("<".formatnum ($v->[0])." ".formatnum ($v->[1])." ".formatnum ($v->[2]).">");
}
sub formattc ($) {
    my $v=shift;
    return ("<".formatnum ($v->[0])." ".formatnum ($v->[1]).">");
}

sub writebyte ($$) {
    my ($fh,$int)=@_;
    print $fh pack "C",$int;
}
sub writeleshort ($$) {
    my ($fh,$int)=@_;
    print $fh pack "v",$int;
}
sub writelelong ($$) {
    my ($fh,$int)=@_;
    print $fh pack "V",$int;
}
# sub writefixed($$) {
#     my ($fh,$i)=@_;
#     my $lng=int($i * 65536.0);
    
#     debug "  Fixed: $i -> $lng \n";
#     writelelong ($fh,$lng);
# }
sub writedbl($$) {
    my ($fh,$i)=@_;
    print $fh pack "d",$i;
}
sub writevect ($$) {
    my ($fh,$vec)=@_;
    for $i (@$vec) {
	writedbl ($fh,$i);
    }
}

sub writestring ($$) {
    my ($fh,$str)=@_;
    print $fh pack "v/A*",$str;
}

# open BLAH,">test";

# $fh=\*BLAH;

# writeleshort $fh,42;

# writelelong $fh,42424242;

# writestring $fh,"The answer";

# close BLAH;
# __END__

$pi=4 * atan2(1, 1);

sub dot ($$) {
    my ($a,$b)=@_;
    return $a->[0]*$b->[0]+$a->[1]*$b->[1]+$a->[2]*$b->[2];
}

sub cross ($$) {
    my ($a,$b)=@_;
    my $x=$a->[1]*$b->[2] - $b->[1]*$a->[2];
    my $y=$b->[0]*$a->[2] - $a->[0]*$b->[2];
    my $z=$a->[0]*$b->[1] - $b->[0]*$a->[1];
    return [$x, $y, $z];
}

sub vlength ($) {
    my $v=shift;
    return sqrt(dot($v,$v));
}

sub vadd ($$) {
    my $a=shift;
    my $b=shift;

    return [ $a->[0]+$b->[0], $a->[1]+$b->[1], $a->[2]+$b->[2] ];

}
sub vneg ($) {
    my $a=shift;

    return [ -$a->[0], -$a->[1], -$a->[2] ];

}
sub vsub ($$) {
    my $a=shift;
    my $b=shift;

    return [ $a->[0]-$b->[0], $a->[1]-$b->[1], $a->[2]-$b->[2] ];
}
sub vsmul ($$) {
    my $a=shift;
    my $s=shift;

    return [ $a->[0]*$s, $a->[1]*$s, $a->[2]*$s ];
}
sub vsdiv ($$) {
    my $a=shift;
    my $s=shift;

    return [ $a->[0]/$s, $a->[1]/$s, $a->[2]/$s ];
}

sub normal ($) {
    my $v=shift;
    my $len=vlength($v);
    return $v if ($len==0);
    return vsdiv($v,$len);
}

sub qrotatepoint ($$$$) {
    my $point=shift;
    my $ref=shift;
    my $cos=shift;
    my $sin=shift;

    my $dot=dot($point,$ref);
    my $diff=vsmul($ref,$dot);
    my $front=vsub($point,$diff);
    my $side=cross($ref,$front);
    return $point if (length($side)==0);
    
    #print "$dot @{[formatvert $diff]} @{[formatvert $front]} @{[formatvert $side]} \n";

    my $resv=vadd(vsmul($front,$cos),vsmul($side,$sin));
    
    return vadd($diff,$resv);
    # whew! that's a mess. hope it works ok
}
sub rotatepoint ($$$) {
    my $point=shift;
    my $ref=normal(shift);
    my $ang=shift;
    return qrotatepoint($point,$ref,cos($ang),sin($ang));
}


sub matmul ($$) {
    my $mata=shift;
    my $matb=shift;
    my ($i, $j, $k, $tmp);
    my ($x, $y, $z);
    my $res=[[0, 0, 0, 0],[0, 0, 0, 0],[0, 0, 0, 0],[0, 0, 0, 0]];
    
	  
    for ($i=0; $i<4; $i++) {
	for ($j=0; $j<4; $j++) {
	    $tmp=0;
	    for ($k=0; $k<4; $k++) {
		$tmp += $mata->[$j][$k]*$matb->[$k][$i];
	    }
	    $res->[$j][$i]=$tmp;
	}
    }
    return $res;
}
sub printmat ($) {
    my $mat=shift;
    for $i (@$mat) {
	print "[ ".join(' ',@$i)." ]\n";
    }
    print "\n";
}

sub rotmatrix ($$) {
    my $ref=normal(shift);
    my $ang=shift;

    my $cos=cos($ang);
    my $sin=sin($ang);

    my $xv= qrotatepoint([1.0, 0.0, 0.0],$ref,$cos,$sin);
    my $yv= qrotatepoint([0.0, 1.0, 0.0],$ref,$cos,$sin);
    my $zv= qrotatepoint([0.0, 0.0, 1.0],$ref,$cos,$sin);

    my $ret=[[(@$xv,0.0)], [(@$yv,0.0)], [(@$zv,0.0)], [0.0,0.0,0.0,1.0]];
    #printmat $ret;
    return $ret;
}

sub lookatmat($$) {
    my ($up,$vec)=@_;
    my $zv=normal($rel);
    my $xv=normal(cross($zv,$up));
    my $yv=normal(cross($xv,$zv));
    return [[(@$xv,0.0)], [(@$yv,0.0)], [(@$zv,0.0)], [0.0,0.0,0.0,1.0]];
    
}

sub transmatrix ($) {
    return [[1.0, 0.0, 0.0, 0.0],
	    [0.0, 1.0, 0.0, 0.0],
	    [0.0, 0.0, 1.0, 0.0],
	    [(@{$_[0]},1.0)]];

}

sub scalematrix ($) {
    my $dir=shift;
    return [[$dir->[0], 0.0, 0.0, 0.0],
	    [0.0, $dir->[1], 0.0, 0.0],
	    [0.0, 0.0, $dir->[2], 0.0],
	    [0.0, 0.0, 0.0, 1.0]];
}

sub calcnorm($$$) {
    my ($a,$b,$c)=@_;
    return normal(cross(vsub($c,$a),vsub($b,$a)));
    #print "Calcnorm: a=@{[formatvert($a)]} c=@{[formatvert($a)]} c=@{[formatvert($a)]} ret=c=@{[formatvert($ret)]}\n";
}

sub transformpoint ($$$) {
    my $mat=shift;
    my $point=shift;
    my $w=shift;
    my $npoint=[(@$point,$w)];
    my ($i, $j, $k, $tmp);
    my ($x, $y, $z);
    my $res=[0,0,0];
    
	  
    for ($i=0; $i<3; $i++) {
	$tmp=0;
	for ($k=0; $k<4; $k++) {
	    $tmp += $mat->[$k][$i]*$npoint->[$k];
	}
	$res->[$i]=$tmp;
    }
    return $res;
}

sub transformpoints ($$) {
    my $mat=shift;
    my $points=shift;
    my $ret=[];
    my $i;
    for ($i=0;$i<=$#$points;$i++) {
	push (@$ret,transformpoint($mat,$points->[$i],1));
    }
    return $ret;
}

sub transformshape ($$) {
    my $shape=shift;
    my $mat=shift;
    $shape->{'verts'}=transformpoints($mat,$shape->{'verts'});
    #$shape->{'normal'}=transformpoint($mat,$shape->{'normal'},0);
}

sub deferror($) {
    die "function $_[0] called outside of primitive or from wrong primitive";
}

# These will be overridden by locals, but they need primitives.
sub location(@) { deferror "location"; }
sub radius(@) { deferror "radius"; }
sub iradius(@) { deferror "iradius"; }
sub npoints(@) { deferror "npoints"; }
sub twoside(@) { deferror "twoside"; }
sub stencil(@) { deferror "stencil"; }
sub texture(@) { deferror "texcoord"; }
sub height(@) { deferror "height"; }
sub dbname(@) { deferror "dbname"; }

sub translate(@) { deferror "translate"; }
sub rotate(@) { deferror "rotate"; }
sub rotatex(@) { deferror "rotatex"; }
sub rotatey(@) { deferror "rotatey"; }
sub rotatez(@) { deferror "rotatez"; }
sub scale(@) { deferror "scale"; }
sub pivot(@) { deferror "pivot"; }

sub setfunc (@) {
    my @refs=@_; # reference
    return sub { my $tmp; for $i (@refs) { $tmp=shift; return if (!defined $tmp); $$i=$tmp; } };
}
# sub common (@) {
#     my $texref=$shift;
#     my @refs=@_; # reference
#     return sub { 
# 	my $tmp; 
# 	for $i (@refs) { 
# 	    $tmp=shift; 
# 	    return if (!defined $tmp); 
# 	    $$i=$tmp; 
# 	} 
#     };
# }

sub maketransfuncs($) {
    my $matref=shift;
    $$matref= [[1.0, 0.0, 0.0, 0.0],
	       [0.0, 1.0, 0.0, 0.0],
	       [0.0, 0.0, 1.0, 0.0],
	       [0.0, 0.0, 0.0, 1.0]];
    
    my $translate = sub {
	$$matref=matmul($$matref,transmatrix($_[0]));
    };
    
    my $rotate = sub {
	$$matref=matmul($$matref,rotmatrix($_[0],$_[1]*$pi/180));
    };
    my $rotatex = sub  {
	$$matref=matmul($$matref,rotmatrix ([1,0,0],$_[0]*$pi/180));
    };
    my $rotatey = sub  {
	$$matref=matmul($$matref,rotmatrix ([0,1,0],$_[0]*$pi/180) );
    };
    my $rotatez = sub  {
	$$matref=matmul($$matref,rotmatrix ([0,0,1],$_[0]*$pi/180));
    };
    
    my $scale = sub  {
	$$matref=matmul($$matref,scalematrix($_[0]));
    };
    return ($translate,$rotate,$rotatex,$rotatey,$rotatez,$scale);
}


sub runwithtrans (&) {
    my $subr=shift;
    my $retmat;
    local (*translate,*rotate,*rotatex,*rotatey,*rotatez,*scale)=maketransfuncs(\$retmat);
    &$subr();

    #printmat $retmat;
    return $retmat;
}

sub outputshape ($) {
    my $shape=shift;
  #  '. formatvert($shape->{'normal'})  . "
#     print OUTPUT '    ' . $shape->{'type'} . ' tex "' . $shape->{'tex'} . "\" <0 0 0> { \n";
#     my $i;
#     my $verts=$shape->{'verts'};
#     my $tcs=$shape->{'texcoords'};
#     for ($i=0; $i<=$#$verts; $i++) {
# 	print OUTPUT ('        ' . formatvert ($verts->[$i]) . ' ' . formattc ($tcs->[$i]) . "\n");
#     }
#     print OUTPUT "    }\n";
}


sub circle (&) {
    my $subr=shift;

    my $loc=[0,0,0];	local *location=setfunc (\$loc);
    my $npts=8;		local *npoints=setfunc  (\$npts);
    my $rad=1.0;	local *radius=setfunc   (\$rad);
    my $tside=0;	local *twoside=setfunc  (\$tside);
    my $stencil=0;	local *stencil=setfunc  (\$stencil);
    my $name=0;		local *dbname=setfunc   (\$name);

    my ($tex,$texx,$texy,$texw,$texh)=("",0,0,1,1);
    local *texture=setfunc(\$tex,\$texx,\$texy,\$texw,\$texh);
    my ($texxrad,$texyrad);
    my $mat;

    $mat=runwithtrans { &$subr(); };

    my $texxrad=($texw/2);
    my $texyrad=($texh/2);
    my $texcx=$texx+$texxrad;
    my $texcy=$texy+$texyrad;

    my $shape={};
    $shape->{'type'} = 'poly';
    $shape->{'tex'} = $tex;
    $shape->{'twoside'} = $tside;
    $shape->{'stencil'} = $stencil;
    $shape->{'name'} = $name;
    my $verts=[];
    my $tcs=[];


    my $i,$ang, $point, $tc, $sin, $cos;
    for ($i=0;$i<$npts;$i++) {
	$ang=($i/$npts)*2*$pi;
	$sin=sin($ang); $cos=cos($ang);
	$point=vadd($loc,[$cos*$rad,$sin*$rad,0.0]);
	$tc=[$cos*$texxrad+$texcx,$sin*$texyrad+$texcy];
	
	push (@$verts,$point);
	push (@$tcs,$tc);
    }
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;

    transformshape($shape,$mat);
    if (defined wantarray) {
	return [$shape];
    } else {
	push(@shapelist, $shape);
    }
}
sub cord () {
    my $subr=shift;

    my $vec1=[0,0,0];
    my $vec2=[0,0,1]; 
    local *location=setfunc (\$vec1,\$vec2);
    my $size=1.0;	local *radius=setfunc   (\$size);
    my $name=0;		local *dbname=setfunc   (\$name);

    my ($tex,$texx,$texy,$texw,$texh)=("",0,0,1,1);
    local *texture=setfunc(\$tex,\$texx,\$texy,\$texw,\$texh);
    my ($texxrad,$texyrad);
    my $mat;

    $mat=runwithtrans { &$subr(); };


    my $tex=shift;
    my $size=shift;
    my $vec1=shift;
    my $vec2=shift;

    my $texx=shift;
    my $texy=shift;
    my $texw=shift;
    my $texh=shift;

    my $shape={};
    $shape->{'type'} = 'quadstrip';
    $shape->{'tex'} = $tex;
    #$shape->{'normal'} = [0, 0, 0];
    my $verts=[];
    my $tcs=[];


    my $i,$ang, $point, $tc, $sin, $cos;
    for ($i=0;$i<4;$i++) {
	$ang=($i/3)*2*$pi;
	$sin=sin($ang); $cos=cos($ang);
	$tcx=(($i/3)*$texw)+$texx;

	$pointa=[$cos*$rad,$sin*$rad,0.0];
	$tca=[$tcx,$texy+$texh];
	$pointb=[$cos*$rad,$sin*$rad,$h];
	$tcb=[$tcx,$texy];

	push (@$verts,$pointa);
	push (@$tcs,$tca);

	
	push (@$verts,$pointb);
	push (@$tcs,$tcb);
    }
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;
    $mat=matmul(transmat $vec2,lookatmat([0, 0, 1], vsub($vec1,$vec2)));
    transformshape($shape,$mat);
    transformshape($shape,$mat);
    if (defined wantarray) {
	return [$shape];
    } else {
	push(@shapelist, $shape);
    }
}
sub disk (&) {
    my $subr=shift;

    my $loc=[0,0,0];	local *location=setfunc (\$loc);
    my $npts=8;		local *npoints=setfunc  (\$npts);
    my $irad=1.0; my $orad=1.0;	local *radius=setfunc   (\$irad,\$orad);
    my $tside=0;	local *twoside=setfunc  (\$tside);
    my $stencil=0;	local *stencil=setfunc  (\$stencil);
    my $name=0;		local *dbname=setfunc   (\$name);

    my ($tex,$texx,$texy,$texw,$texh)=("",0,0,1,1);
    local *texture=setfunc(\$tex,\$texx,\$texy,\$texw,\$texh);
    my ($texxrad,$texyrad);
    my $mat;

    $mat=runwithtrans { &$subr(); };

    my $texxrad=($texw/2);
    my $texyrad=($texh/2);
    my $texcx=$texx+$texxrad;
    my $texcy=$texy+$texyrad;
    
    my $texixrad=$texxrad*($irad/$orad);
    my $texiyrad=$texyrad*($irad/$orad);

    my $shape={};
    $shape->{'type'} = 'quadstrip';
    $shape->{'tex'} = $tex;
    $shape->{'twoside'} = $tside;
    $shape->{'stencil'} = $stencil;
    $shape->{'name'} = $name;
    my $verts=[];
    my $tcs=[];


    my $i,$ang, $point, $tc, $sin, $cos;
    for ($i=0;$i<=$npts;$i++) {
 	$ang=($i/$npts)*2*$pi;
 	$sin=sin($ang); $cos=cos($ang);
	
 	$point=vadd($loc,[$cos*$irad,$sin*$irad,0.0]);
 	$tc=[$cos*$texixrad+$texcx,$sin*$texiyrad+$texcy];
 	push (@$verts,$point);
 	push (@$tcs,$tc);

 	$point=vadd($loc,[$cos*$orad,$sin*$orad,0.0]);
 	$tc=[$cos*$texxrad+$texcx,$sin*$texyrad+$texcy];
 	push (@$verts,$point);
 	push (@$tcs,$tc);
    }
    
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;

    transformshape($shape,$mat);
    if (defined wantarray) {
	return [$shape];
    } else {
	push(@shapelist, $shape);
    }
}
# sub disk ($$$$$$$$) {
#     my $tex=shift;
#     my $npts=shift;
#     my $irad=shift;
#     my $rad=shift;
#     my $texrad=shift;
#     my $texx=shift;
#     my $texy=shift;

#     my $texirad=$texrad*($irad/$rad);

#     my $shape={};
#     $shape->{'type'} = 'tristrip';
#     $shape->{'tex'} = $tex;
#     $shape->{'normal'} = [0, 0, $dir];
#     my $verts=[];
#     my $tcs=[];


#     my $i,$ang, $point, $tc, $sin, $cos;
    
#      for ($i=0;$i<=$npts;$i++) {
#  	$ang=($i/$npts)*2*$pi;
#  	$sin=sin($ang); $cos=cos($ang);

#  	$point=[$cos*$irad,$sin*$irad,0.0];
#  	$tc=[$cos*$texirad+$texx,$sin*$texirad+$texy];
#  	push (@$verts,$point);
#  	push (@$tcs,$tc);

#  	$point=[$cos*$rad,$sin*$rad,0.0];
#  	$tc=[$cos*$texrad+$texx,$sin*$texrad+$texy];
#  	push (@$verts,$point);
#  	push (@$tcs,$tc);
#      }
#     $shape->{'verts'}=$verts;
#     $shape->{'texcoords'}=$tcs;

#     return [$shape];
# }

sub rect (&){
    my $subr=shift;

    my $i;
    my @verts;
    my @tcs=([0,0],[1,0],[1,1],[0,1]);
    my $name=0;		local *dbname=setfunc   (\$name);
    
    local *location=sub {
	if ($#_==2) {
	    @verts=@_;
	    my $tvert=vsub(vadd($verts[1],$verts[2]),$verts[0]);
	    $verts[3]=$verts[2];
	    $verts[2]=$tvert;
	} else {
	    @verts=@_;
	}
    };
    local *texture=sub {
	$tex=shift;
	if ($#_==3) {
	    @tcs=@_;
	}
    };
    my $tside=0;	local *twoside=setfunc  (\$tside);
    my $stencil=0;	local *stencil=setfunc  (\$stencil);
    runwithtrans { &$subr(); };

#     for ($i=0;$i<4;$i++) {
# 	$verts->[$i]=shift;
#     }
#     for ($i=0;$i<4;$i++) {
# 	$tcs->[$i]=shift;
#     }
#     my $z;
#     for $z (@$tcs) {
# 	print formattc($z)." ";
#     } 
#     print "\n";

    #my $normal=vsmul(calcnorm ($verts[0],$verts[1],$verts[2]),$normdir);
    #my $normdir=dot($normal,$normfac) <=> 0; # hack for missing sgn()
    #$normal=vsmul($normal,$normfac);

    my $shape={};
    $shape->{'type'} = 'quad';
    $shape->{'tex'} = $tex;
    $shape->{'twoside'} = $tside;
    $shape->{'name'} = $name;
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;

    return [$shape];
}

sub cylinder (&){
    my $subr=shift;

    my $loc=[0,0,0];	local *location=setfunc (\$loc);
    my $npts=8;		local *npoints=setfunc  (\$npts);
    my $rad=1.0;	local *radius=setfunc   (\$rad);
    my $h=1.0;		local *height=setfunc   (\$h);
    my $tside=0;	local *twoside=setfunc  (\$tside);
    my $stencil=0;	local *stencil=setfunc  (\$stencil);
    my $name=0;		local *dbname=setfunc   (\$name);

    my ($tex,$texx,$texy,$texw,$texh)=("",0,0,1,1);
    local *texture=setfunc(\$tex,\$texx,\$texy,\$texw,\$texh);
    my $mat;

    $mat=runwithtrans { &$subr(); };

    my $shape={};
    $shape->{'type'} = 'quadstrip';
    $shape->{'tex'} = $tex;
    $shape->{'twoside'} = $tside;
    $shape->{'stencil'} = $stencil;
    $shape->{'name'} = $name;
    my $verts=[];
    my $tcs=[];


    my $i,$ang, $point, $tc, $sin, $cos;

    for ($i=0;$i<=$npts;$i++) {
	$ang=($i/$npts)*2*$pi;
	$sin=sin($ang); $cos=cos($ang);
	$tcx=(($i/$npts)*$texw)+$texx;

	$pointa=vadd($loc,[$cos*$rad,$sin*$rad,0.0]);
	$tca=[$tcx,$texy+$texh];
	$pointb=vadd($loc,[$cos*$rad,$sin*$rad,$h]);
	$tcb=[$tcx,$texy];

	push (@$verts,$pointa);
	push (@$tcs,$tca);

	
	push (@$verts,$pointb);
	push (@$tcs,$tcb);
    }
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;

    transformshape($shape,$mat);
    if (defined wantarray) {
	return [$shape];
    } else {
	push(@shapelist, $shape);
    }
}
# sub cylinderb ($$$$$$$$$){
#     my $tex=shift;
#     my $npts=shift;
#     my $rad=shift;
#     my $h=shift;

#     my $texx=shift;
#     my $texy=shift;
#     my $texw=shift;
#     my $texh=shift;
#     my $inside=shift;

#     my $shapes=[];

#     my ($i,$ang, $point, $tc, $sin, $cos);

#     my ($oldpointa,$oldtca);
#     my ($oldpointb,$oldtcb);
    
#     for ($i=0;$i<=$npts;$i++) {
# 	my $ang=($i/$npts)*2*$pi;
# 	my $sin=sin($ang); my $cos=cos($ang);
# 	my $tcx=(($i/$npts)*$texw)+$texx;

# 	my $pointa=[$cos*$rad,$sin*$rad,0.0];
# 	my $tca=[$tcx,$texy+$texh];
# 	my $pointb=[$cos*$rad,$sin*$rad,$h];
# 	my $tcb=[$tcx,$texy];

# 	if ($i>0) {
# 	    push (@$shapes,@{rect($tex,$inside,$oldpointa,$oldpointb,$pointb,
# 				  $pointa,$oldtca,$oldtcb,$tcb,$tca)});
# 	}
# 	#print $tca->[0] . " ".$tcb->[0]." $tcx\n";
# 	$oldpointa=$pointa;
# 	$oldpointb=$pointb;
# 	$oldtca=$tca;
# 	$oldtcb=$tcb;
#     }

#     return $shapes;
# }


sub clipcone (&){
    my $subr=shift;

    my $loc=[0,0,0];	local *location=setfunc (\$loc);
    my $npts=8;		local *npoints=setfunc  (\$npts);
    my ($brad,$trad)=(1,1);	local *radius=setfunc   (\$brad,\$trad);
    my $h=1.0;		local *height=setfunc   (\$h);
    my $tside=0;	local *twoside=setfunc  (\$tside);
    my $stencil=0;	local *stencil=setfunc  (\$stencil);
    my $name=0;		local *dbname=setfunc   (\$name);

    my ($tex,$texx,$texy,$texw,$texh)=("",0,0,1,1);
    local *texture=setfunc(\$tex,\$texx,\$texy,\$texw,\$texh);
    my $mat;

    $mat=runwithtrans { &$subr(); };

    my $shape={};
    $shape->{'type'} = 'quadstrip';
    $shape->{'tex'} = $tex;
    $shape->{'twoside'} = $tside;
    $shape->{'stencil'} = $stencil;
    $shape->{'name'} = $name;
    my $verts=[];
    my $tcs=[];


    my ($i,$ang, $point, $tc, $sin, $cos);
    
    for ($i=0;$i<=$npts;$i++) {
	$ang=($i/$npts)*2*$pi;
	$sin=sin($ang); $cos=cos($ang);
	$tcx=(($i/$npts)*$texw)+$texx;

	$point=vadd($loc,[$cos*$brad,$sin*$brad,0.0]);
	$tc=[$tcx,$texy+$texh];
	push (@$verts,$point);
	push (@$tcs,$tc);

	
	$point=vadd($loc,[$cos*$trad,$sin*$trad,$h]);
	$tc=[$tcx,$texy];
	push (@$verts,$point);
	push (@$tcs,$tc);
    }
    $shape->{'verts'}=$verts;
    $shape->{'texcoords'}=$tcs;

    transformshape($shape,$mat);
    if (defined wantarray) {
	return [$shape];
    } else {
	push(@shapelist, $shape);
    }
}

sub union(&) {
    my $subr=shift;
    my @tshapes=();
    {
	local @shapelist=();
	my $mat=runwithtrans { &$subr(); };
	for $i (@shapelist) {
	    transformshape($i,$mat);
	    push (@tshapes,$i);
	}
    }
    if (defined wantarray) {
	return [@tshapes];
    } else {
	push(@shapelist, @tshapes);
    }
}

# sub transout ($) {
#     my $shapes=shift;
#     my $mat=matmul($modmat,$tmat);
#     for $shape (@$shapes) {
# 	transformshape $shape,$mat;
# 	outputshape $shape;
#     }
#     loadident;
# }

sub file(@) { deferror "file"; }
sub usefor(@) { deferror "usefor"; }
sub shapes(&) { deferror "shapes"; }

open OBJLIST,"objlist";
while (<OBJLIST>) {
    if (/(\d+) ([a-zA-Z_]+)/) {
	$objects{$2}="o$1";
    }
}
close OBJLIST;

open STATLIST,"statlist";
while (<STATLIST>) {
    if (/(\d+) ([a-zA-Z_]+)/) {
	$objects{$2}="s$1";
    }
}
close STATLIST;

open INFO,">../gl/model.ifo";

END { close INFO; }

sub ibtofloat($) {
    my ($rv)=unpack("f",pack("l",$_[0]));
    return $rv;
}

sub power2($) {
    my ($in)=@_;
    my $power=1;
    while ($in>$power) {
	$power *= 2;
    }
    return $power;
}

sub from_md2 ($$$;$$) {
    my ($file,$frame,$skin)=@_;
    my $tcxscale=1.0;
    my $tcyscale=1.0;
    my $mdl;
    {
	local $/;
	open MDL,"$file";
	$mdl=<MDL>;
	close MDL;
    }
    
    my ($ident, $version, $skinwidth, $skinheight,
	$framesize, $num_skins, $num_xyz, $num_st,
	$num_tris, $num_glcmds, $num_frames, $ofs_skins,
	$ofs_st, $ofs_tris, $ofs_frames, $ofs_glcmds,
	$ofs_end)=unpack("V17",$mdl);

    my ($scale_x,$scale_y,$scale_z,
	$trans_x,$trans_y,$trans_z,
	$framename,@vertbytes)=unpack("f6Z16C*",substr($mdl,$ofs_frames+($frame*$framesize),$framesize));
    #print "$scale_x\n";
    if ($#_==4) {
	($tcxscale,$tcyscale)=@_[3,4];
    } else {
	$tcxscale=$skinwidth/power2($skinwidth);
	$tcyscale=$skinheight/power2($skinheight);
    }
    my $j=0;
    my @verts;
    for (my $i=0; $i<$num_xyz; $i++) {
	$verts[$i]=[$vertbytes[$j+0]*$scale_x+$trans_x,
		    $vertbytes[$j+1]*$scale_y+$trans_y,
		    $vertbytes[$j+2]*$scale_z+$trans_z,
		    ];
	$j+=4;
    }
    my @order=unpack("l*",substr($mdl,$ofs_glcmds));
    while (1) {
	my $count = shift @order;
	last if (!$count);
	my $shape={};
	my $verts=[];
	my $tcs=[];
	
	if ($count<0) {
	    $shape->{'type'} = 'trifan';
	    $count=-$count;
	} else {
	    $shape->{'type'} = 'tristrip';
	}
	for (my $k=0; $k<$count; $k++) {
	    my $tcx=ibtofloat(shift @order)*$tcxscale;
	    my $tcy=ibtofloat(shift @order)*$tcyscale;
	    my $idx=shift @order;
	    
	    push (@$verts,$verts[$idx]);
	    push (@$tcs,[$tcx,$tcy]);
	}
	$shape->{'tex'} = $skin;
	$shape->{'twoside'} = 0;
	$shape->{'stencil'} = 0;
	$shape->{'name'} = '';
	$shape->{'verts'}=$verts;
	$shape->{'texcoords'}=$tcs;
	push(@shapelist, $shape);
	
    }
    
}


@typenames= qw(quad quadstrip tri tristrip trifan poly);
$idx=0;
for $i (@typenames) {
    $typemap{$i}=$idx++;
}
sub model (&) {
    local *OUTPUT;
    my $fil="";
    my $shaperef=0;
    my @useforl=();
    my $flags=0;
    my $pivt=[0,0,0];
    
    $subr=shift;
    {
	local *file = sub {
	    $fil=shift;
	};
	local *shapes = sub {
	    $shaperef=shift;
	};
	local *usefor = sub {
	    push @useforl,@_;
	};
	local *rotate = sub {
	    $flags |= 1;
	};
	local *pivot = sub {
	    $pivt=$_[0];
	};
	&$subr();
    }
    #open INFO,">>model.ifo";
    for $i (@useforl) {
	print INFO "$i $fil\n";
    }
    #close INFO;
    open OUTPUT, ">../gl/$fil";
    print OUTPUT "SMDL";
    writelelong \*OUTPUT,$flags;
    writevect \*OUTPUT,$pivt;
    debug "-----  File $fil -----\n";
    #print OUTPUT "# Model file generated by genmod\n";
    #print OUTPUT "# Used for: @{[join(' ',@useforl)]}\n\n";
    for $i (0..3) {
	local $qual=$i;
	debug "\nQuality: $qual\n";
	local @shapelist=();
	union { &$shaperef(); };
	#print OUTPUT "qual $i {\n";

	@vertlist=();
	@tclist=();
	for $shp (@shapelist) {
	    $shp->{'vertindex'}=scalar @vertlist;
	    push @vertlist,@{$shp->{'verts'}};
	}
	for $shp (@shapelist) {
	    push @tclist,@{$shp->{'texcoords'}};
	}

	writelelong \*OUTPUT,scalar @vertlist;
	for $vert (@vertlist) {
	    writevect \*OUTPUT,$vert;
	}
	for $tc (@tclist) {
	    writevect \*OUTPUT,$tc;
	}

	writelelong \*OUTPUT,scalar @shapelist;
	for $shp (@shapelist) {
	    if ($debug) {
		debug "Shape: $shp->{'type'} ($typemap{$shp->{'type'}}) '$shp->{'name'}' $shp->{'tex'}\n";
		
		debug "Vertices: \n";
		for $vt (@{$shp->{'verts'}}) {
		    debug "[".join(" ",@$vt)."]\n";
		}
		debug "Texcoords: \n";
		for $vt (@{$shp->{'texcoords'}}) {
		    debug "[".join(" ",@$vt)."]\n";
		}
	    }
	    writebyte \*OUTPUT,$typemap{$shp->{'type'}};
	    #print ($shp->{'type'} ." " . $typemap{$shp->{'type'}} . "\n"); 
	    writestring \*OUTPUT,$shp->{'tex'};
	    $flags=0;
	    if ($shp->{'twoside'} != 0) { $flags |= 1; }
	    if ($shp->{'stencil'} != 0) { $flags |= 2; }
	    writeleshort \*OUTPUT,$flags;
	    writelelong \*OUTPUT,$shp->{'vertindex'};
	    writelelong \*OUTPUT,scalar @{$shp->{'verts'}};
	}
	#print OUTPUT "}\n";
    }
    close OUTPUT;
}

for $i (@ARGV) {
    if ($i eq "-debug") {
	$debug=1;
    } else {
	do $i;
	die $@ if ($@);
    }
}
