=head1 NAME

  PDL::Graphics::TriD::Objects - Simple Graph Objects for TriD

=head1 SYNOPSIS

  Look in PDL/Demos/TkTriD_demo.pm for several examples, the code
  in PDL/Demos/TriD1.pm and PDL/Demos/TriD2.pm also uses objects
  but it hides them from the user.

=head1 DESCRIPTION

GObjects can be either stand-alone or in Graphs, scaled properly.
All the points used by the object must be in the member {Points}.
I guess we can afford to force data to be copied (X,Y,Z) -> (Points)...

=head1 OBJECTS

=head2 PDL::Graphics::TriD::GObject

Inherits from base PDL::Graphics::TriD::Object and adds fields Points, Colors and
Options.  Need lots more here...

=cut

package PDL::Graphics::TriD::GObject;
use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Points Colors Options/;

sub new {
	my($type,$points,$colors,$options) = @_;

	print "GObject new.. calling SUPER::new...\n" if($PDL::debug_trid);
	my $this = $type->SUPER::new();
	print "GObject new - back (SUPER::new returned $this)\n" if($PDL::debug_trid);

	if(!defined $options and ref $colors eq "HASH") {
		$options = $colors;
		undef $colors;
	}

	print "GObject new - calling realcoords\n" if($PDL::debug_trid);
	$points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
	print "GObject new - back from  realcoords\n" if($PDL::debug_trid);

	if(!defined $colors) {$colors = PDL->pdl(1,1,1);
		$colors = $type->cdummies($colors,$points);
	        $options->{UseDefcols} = 1;  # for VRML efficiency
	} else {
		$colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
	}

        $this->{Options} = $options;
	$this->{Points}  = $points;
	$this->{Colors}  = $colors;

	$this->check_options();
	
	print "GObject new - returning\n" if($PDL::debug_trid);
	return $this;
}


sub check_options {
	my($this) = @_;
	my %newopts;
	my $opts = $this->get_valid_options();
	print "FETCHOPT: $this ".(join ',',%$opts)."\n" if $PDL::Graphics::TriD::verbose;
	for(keys %$opts) {
		if(!exists $this->{Options}{$_}) {
			$newopts{$_} = $opts->{$_};
		} else {
			$newopts{$_} = delete $this->{Options}{$_};
		}
	}
	if(keys %{$this->{Options}}) {
		die("Invalid options left: ".(join ',',%{$this->{Options}}));
	}
	$this->{Options} = \%newopts;
}


sub set_colors {
  my($this,$colors) = @_;
  if(ref($colors) eq "ARRAY"){
    $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
  }
  $this->{Colors}=$colors;
  $this->data_changed;
}

sub get_valid_options {
	return {UseDefcols => 0};
}

sub get_points {
	return $_[0]->{Points};
}


# In the future, have this happen automatically by the piddles.
sub data_changed {
	my($this) = @_;
	$this->changed();
}

sub cdummies {return $_[1];}

sub r_type { return ""; }

sub defcols {
  return defined($_[0]->{Options}->{UseDefcols}) &&
    $_[0]->{Options}->{UseDefcols};
}
1;
package PDL::Graphics::TriD::Points;
use base qw/PDL::Graphics::TriD::GObject/;
sub get_valid_options {
	return {UseDefcols => 0, PointSize=> 1};
}



package PDL::Graphics::TriD::Lattice;
use base qw/PDL::Graphics::TriD::GObject/;

sub r_type {return "SURF2D";}

sub cdummies { return $_[1]->dummy(1)->dummy(1); }

package PDL::Graphics::TriD::Lines;
use base qw/PDL::Graphics::TriD::GObject/;

sub cdummies { return $_[1]->dummy(1); }

sub r_type { return "SURF2D";}

sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }

package PDL::Graphics::TriD::LineStrip;
use base qw/PDL::Graphics::TriD::GObject/;

sub cdummies { return $_[1]->dummy(1); }

sub r_type { return "SURF2D";}

sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }

package PDL::Graphics::TriD::GObject_Lattice;
use base qw/PDL::Graphics::TriD::GObject/;

sub r_type {return "SURF2D";}

sub get_valid_options { return {UseDefcols => 0,Lines => 1}; }

# colors associated with vertices, smooth
package PDL::Graphics::TriD::SLattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;

sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2))
			-> dummy(1,$_[2]->getdim(1)); }

# colors associated with surfaces
package PDL::Graphics::TriD::SCLattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;

sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2)-1)
			-> dummy(1,$_[2]->getdim(1)-1); }


# colors associated with vertices
package PDL::Graphics::TriD::SLattice_S;
use base qw/PDL::Graphics::TriD::GObject_Lattice/;
use fields qw/Normals/;

sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2))
			-> dummy(1,$_[2]->getdim(1)); }


sub get_valid_options { return {UseDefcols => 0,Lines => 1, Smooth => 0,
	Material => 0}; }

# calculate smooth normals
sub smoothn {
  my ($this,$p) = @_;
  # coords of parallel sides (left and right via 'lags')
  my $trip = $p->lags(1,1,2)->slice(':,:,:,1:-1') -
		$p->lags(1,1,2)->slice(':,:,:,0:-2');
  # coords of diagonals with dim 2 having original and reflected diags
  my $tmp;
  my $trid = ($p->slice(':,0:-2,1:-1')-$p->slice(':,1:-1,0:-2'))
		    ->dummy(2,2);
  # $ortho is a (3D,x-1,left/right triangle,y-1) array that enumerates
  # all triangles
  my $ortho = $trip->crossp($trid);
  $ortho->norm($ortho); # normalise inplace

  # now add to vertices to smooth
  my $aver = ref($p)->zeroes($p->dims);
  # step 1, upper right tri0, upper left tri1
  ($tmp=$aver->lags(1,1,2)->slice(':,:,:,1:-1')) += $ortho;
  # step 2, lower right tri0, lower left tri1
  ($tmp=$aver->lags(1,1,2)->slice(':,:,:,0:-2')) += $ortho;
  # step 3, upper left tri0
  ($tmp=$aver->slice(':,0:-2,1:-1')) += $ortho->slice(':,:,(0)');
  # step 4, lower right tri1
  ($tmp=$aver->slice(':,1:-1,0:-2')) += $ortho->slice(':,:,(1)');
  $aver->norm($aver);
  return $aver;
}

1;