use strict;
use warnings;
use PDL::Types qw(types ppdefs_all);

my $F = ['F'];

pp_addpm({At=>'Top'},<<'EOD');
=head1 NAME

PDL::Graphics::OpenGLQ - quick routines to plot lots of stuff from ndarrays.

=head1 SYNOPSIS

only for internal use - see source

=head1 DESCRIPTION

only for internal use - see source

=head1 AUTHOR

Copyright (C) 1997,1998 Tuomas J. Lukka.  
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL 
distribution. If this file is separated from the PDL distribution, 
the copyright notice should be included in the file.

=cut

EOD

pp_addhdr('
#ifdef HAVE_AGL_GLUT
#include <OpenGL/gl.h>
#include <OpenGL/glu.h>
#include <GLUT/glut.h>
#else
#include <GL/gl.h>
#include <GL/glu.h>
#include <GL/glut.h>
#include <GL/freeglut.h>
#endif
/* #include <GL/glx.h> */
');

my @internal = (Doc => 'internal', NoPthread => 1);

pp_def(
  'gl_spheres',
  GenericTypes => $F,
  Pars => 'coords(tri=3,n);',
  OtherPars => 'double radius; int slices; int stacks;',
  Code => '
    float oldcoord0 = 0.0, oldcoord1 = 0.0, oldcoord2 = 0.0;
    glPushMatrix();
    loop(n) %{
      glTranslatef(
	$coords(tri=>0) - oldcoord0,
	$coords(tri=>1) - oldcoord1,
	$coords(tri=>2) - oldcoord2
      );
      glutSolidSphere($COMP(radius), $COMP(slices), $COMP(stacks));
      oldcoord0 = $coords(tri=>0), oldcoord1 = $coords(tri=>1), oldcoord2 = $coords(tri=>2);
    %}
    glPopMatrix();
  ',
  @internal
);

sub TRI { my $par = join '', @_; join ',', map "$par(tri => $_)", 0..2 }
sub make_tri { shift()."(".TRI(@_).");\n" }
sub COLOR { make_tri("glColor3f",'$colors',@_) }
sub VERTEX { make_tri("glVertex3f",'$coords',@_) }
sub NORMAL { make_tri("glNormal3f",'$norm',@_) }
sub RPOS { make_tri("glRasterPos3f",'$coords',@_) }
sub ADCOLOR { "
  {
    GLfloat ad[] = { ".TRI('$colors'.$_[0]).",1.0 };
    glMaterialfv(GL_FRONT_AND_BACK,GL_DIFFUSE, ad);
  }
" }

sub make_func {
  my ($name) = @_;
  for (['_col', ' colors(tri,n);', COLOR().VERTEX()], ['_nc', '', VERTEX()]) {
    pp_def(lc($name).$_->[0],
      GenericTypes => $F,
      Pars => 'coords(tri=3,n);'.$_->[1],
      Code => '
        glBegin('.uc($name).');
        loop(n) %{'.$_->[2].'%}
        glEnd();
      ',
      @internal
    );
  }
}

make_func($_) for qw(gl_line_strip gl_lines gl_points);

pp_def(
 	'gl_texts',
	GenericTypes => $F,
 	Pars => 'coords(tri,x); ',
	OtherPars => 'int in_glut; IV base; SV *arr',
	Code => '
		SV *sv = $COMP(arr);
		if(!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV)) {
			$CROAK("gl_texts requires an array ref");
		}
		AV *arr = (AV *)SvRV(sv);
		if ( !$COMP(in_glut) ) {
			glPushAttrib(GL_LIST_BIT);
			glListBase($COMP(base));
		}
		loop(x) %{
			SV *elem = *(av_fetch(arr, x, 0));
			if (!elem) continue;
                        char *str = SvPV_nolen(elem);
			'.RPOS().'
			if ( $COMP(in_glut) )
				glutBitmapString((void *)$COMP(base), (unsigned char *)str);
			else
				glCallLists(strlen(str),GL_UNSIGNED_BYTE,
					(GLubyte*)str);
		%}
		if ( !$COMP(in_glut) )
			glPopAttrib();
	',
	@internal
);

for my $m (
{Suf => '_mat',
 Func => \&ADCOLOR},
{Suf => '',
 Func => \&COLOR},
) {
for(
{Name => 'gl_triangles',
 NormalCode => ''},
{Name => 'gl_triangles_n',
 NormalCode => '
	tmp1[0] = $coordsb(tri => 0) - $coordsa(tri => 0);
	tmp1[1] = $coordsb(tri => 1) - $coordsa(tri => 1);
	tmp1[2] = $coordsb(tri => 2) - $coordsa(tri => 2);
	tmp2[0] = $coordsc(tri => 0) - $coordsa(tri => 0);
	tmp2[1] = $coordsc(tri => 1) - $coordsa(tri => 1);
	tmp2[2] = $coordsc(tri => 2) - $coordsa(tri => 2);
	glNormal3f(
		tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2],
	      -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]),
		tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1]
	);
 '
},
{Name => 'gl_triangles_wn',
 NormalArgs => 'norma(tri); normb(tri); normc(tri);',
 (map {("NormalCode".($_ eq 'A'?'':$_),NORMAL(lc $_))} ('A'..'C')),
}) {
# This may be suboptimal but should still be fast enough..
# We only do triangles with this.
pp_def(
	$_->{Name}.$m->{Suf},
	GenericTypes => $F,
	Pars => 'coordsa(tri=3); coordsb(tri); coordsc(tri);'.
		 ($_->{NormalArgs}//'').
		'colorsa(tri); colorsb(tri); colorsc(tri);',
	Code => '
		float tmp1[3]; float tmp2[3];
		glBegin(GL_TRIANGLES);
		broadcastloop %{'.
			($_->{NormalCode}//'')
			.&{$m->{Func}}("a").VERTEX("a").
			($_->{NormalCodeB}//'')
	  		.&{$m->{Func}}("b").VERTEX("b").
			($_->{NormalCodeC}//'')
			.&{$m->{Func}}("c").VERTEX("c").'
		%}
		glEnd();
		',
		@internal
);
}
}

pp_def('gl_arrows',
	Pars => 'coords(tri=3,n); indx indsa(); indx indsb();',
	OtherPars => 'float headlen; float width;',
	Code => '
		float hl = $COMP(headlen);
		float w = $COMP(width);
		float tmp2[3] = { 0.000001, -0.0001, 1 };
		broadcastloop %{
			PDL_Indx a = $indsa(), b = $indsb();
			float tmp1[3]; 
			float norm[3];
			float norm2[3];
			float normlen,origlen,norm2len;
			tmp1[0] = $coords(tri => 0, n => a) -
				  $coords(tri => 0, n => b);
			tmp1[1] = $coords(tri => 1, n => a) -
				  $coords(tri => 1, n => b);
			tmp1[2] = $coords(tri => 2, n => a) -
				  $coords(tri => 2, n => b);
			float partback[3];
			partback[0] = $coords(tri => 0, n => b) + hl*tmp1[0];
			partback[1] = $coords(tri => 1, n => b) + hl*tmp1[1];
			partback[2] = $coords(tri => 2, n => b) + hl*tmp1[2];
			norm[0] = tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2];
			norm[1] = -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]);
			norm[2] = tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1];
			norm2[0] = tmp1[1]*norm[2] - norm[1]*tmp1[2];
			norm2[1] = -(tmp1[0]*norm[2] - norm[0]*tmp1[2]);
			norm2[2] = tmp1[0]*norm[1] - norm[0]*tmp1[1];
			normlen = sqrt(norm[0] * norm[0] +
				norm[1] * norm[1] + norm[2] * norm[2]);
			norm2len = sqrt(norm2[0] * norm2[0] +
				norm2[1] * norm2[1] + norm2[2] * norm2[2]);
			origlen = sqrt(tmp1[0] * tmp1[0] +
				tmp1[1] * tmp1[1] + tmp1[2] * tmp1[2]);
			norm[0] *= w/normlen;
			norm[1] *= w/normlen;
			norm[2] *= w/normlen;
			norm2[0] *= w/norm2len;
			norm2[1] *= w/norm2len;
			norm2[2] *= w/norm2len;
			tmp1[0] /= origlen;
			tmp1[1] /= origlen;
			tmp1[2] /= origlen;
			glBegin(GL_LINES);
			glVertex3d( $coords(tri => 0, n => a) ,
				    $coords(tri => 1, n => a) ,
				    $coords(tri => 2, n => a) );
			glVertex3d( $coords(tri => 0, n => b) ,
				    $coords(tri => 1, n => b) ,
				    $coords(tri => 2, n => b) );
			glEnd();
			if(w!=0) {
			glBegin(GL_TRIANGLES);
			glVertex3d( $coords(tri => 0, n => b) ,
				    $coords(tri => 1, n => b) ,
				    $coords(tri => 2, n => b) );
			glVertex3d( partback[0] + norm[0],
				    partback[1] + norm[1],
				    partback[2] + norm[2]);
			glVertex3d( partback[0] + norm2[0],
				    partback[1] + norm2[1],
				    partback[2] + norm2[2]);
			glVertex3d( $coords(tri => 0, n => b) ,
				    $coords(tri => 1, n => b) ,
				    $coords(tri => 2, n => b) );
			glVertex3d( partback[0] - norm[0],
				    partback[1] - norm[1],
				    partback[2] - norm[2]);
			glVertex3d( partback[0] - norm2[0],
				    partback[1] - norm2[1],
				    partback[2] - norm2[2]);
			glVertex3d( $coords(tri => 0, n => b) ,
				    $coords(tri => 1, n => b) ,
				    $coords(tri => 2, n => b) );
			glVertex3d( partback[0] + norm2[0],
				    partback[1] + norm2[1],
				    partback[2] + norm2[2]);
			glVertex3d( partback[0] - norm[0],
				    partback[1] - norm[1],
				    partback[2] - norm[2]);
			glVertex3d( $coords(tri => 0, n => b) ,
				    $coords(tri => 1, n => b) ,
				    $coords(tri => 2, n => b) );
			glVertex3d( partback[0] - norm2[0],
				    partback[1] - norm2[1],
				    partback[2] - norm2[2]);
			glVertex3d( partback[0] + norm[0],
				    partback[1] + norm[1],
				    partback[2] + norm[2]);
			glEnd();
			}
		%}
	',
	@internal
);

pp_done();