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

{ no warnings 'once'; # pass info back to Makefile.PL
$PDL::Core::Dev::EXTRAS{$::PDLMOD}{OBJECT} .= join '', map " $::PDLBASE-$_\$(OBJ_EXT)", qw(font sphere);
}

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 __APPLE__
#include <OpenGL/gl.h>
#else
#include <GL/gl.h>
#endif
');

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

pp_def(
  'gl_spheres',
  GenericTypes => $F,
  Pars => 'coords(tri=3,n);',
  OtherPars => 'double radius; int slices; int stacks;',
  CHeader => "char *pdl_3d_solidSphere(double radius, GLint slices, GLint stacks);\n",
  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
      );
      char *err = pdl_3d_solidSphere($COMP(radius), $COMP(slices), $COMP(stacks));
      if (err) $CROAK("%s", err);
      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 => 'SV *arr',
  CHeader => "void pdl_3d_bitmapString( const unsigned char *string );\n",
  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);
    loop(x) %{
      SV *elem = *(av_fetch(arr, x, 0));
      if (!elem) continue;
      char *str = SvPV_nolen(elem);
      '.RPOS().'
      pdl_3d_bitmapString((const unsigned char *)str);
    %}
  ',
  @internal
);

for my $m (
{Suf => '_mat',
 Func => \&ADCOLOR},
{Suf => '',
 Func => \&COLOR},
) {
for(
{Name => 'gl_triangles',
 NormalCode => ''},
{Name => 'gl_triangles_n',
 NormalInit => '
	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);
        tmp3[0] = tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2];
        tmp3[1] = -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]);
        tmp3[2] = tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1];
        magn = sqrt(tmp3[0]*tmp3[0] + tmp3[1]*tmp3[1] + tmp3[2]*tmp3[2]);
        tmp3[0] = tmp3[0] / magn;
        tmp3[1] = tmp3[1] / magn;
        tmp3[2] = tmp3[2] / magn;',
 NormalCode => '
	glNormal3f(tmp3[0], tmp3[1], tmp3[2]);
 '
},
{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], tmp2[3], tmp3[3], magn;
		glBegin(GL_TRIANGLES);
		broadcastloop %{'.
			($_->{NormalInit}//"\n").
			($_->{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();