incorporate SLattice_S into Lattice with options

Author: mohawk2

demos/DemoTkTriD.pm

@@ -306,7 +306,7 @@ sub Torusdemos{
         {Shading=>2}
       );
     }else{
-      $data=PDL::Graphics::TriD::SLattice_S->new([$x,$y,$z]);
+      $data=PDL::Graphics::TriD::Lattice->new([$x,$y,$z], {Shading=>3, Lighting=>1, Smooth=>1});
     }
     $graph->add_dataseries($data,"Torus$demo");
   }

demos/test5.p

@@ -19,8 +19,8 @@ my @objs = (
   ['Lattice', {Shading=>0}],
   ['Lattice', {Shading=>1}],
   ['Lattice', {Shading=>2}],
-  ['SLattice_S', {Smooth=>0}],
-  ['SLattice_S'],
+  ['Lattice', {Shading=>3, Lighting => 1}],
+  ['Lattice', {Shading=>3, Lighting => 1, Smooth=>1}],
 );
 my $i = 0;
 @objs = map [$i++, @$_], @objs;

demos/tvrml.p

@@ -32,8 +32,8 @@ $name = $g->add_dataseries(PDL::Graphics::TriD::Points->new($pdl,$cols));
 $g->bind_default($name);
 $name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x]));
 $g->bind_default($name);
-$name = $g->add_dataseries(PDL::Graphics::TriD::SLattice_S->new([SURF2D,$x+1],$cx,
-						     {Smooth=>1,Lines=>0}));
+$name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x+1],$cx,
+						     {Smooth=>1,Lines=>0,Shading=>3, Lighting=>1, Smooth=>1}));
 $g->bind_default($name);
 $g->scalethings();
 describe3d('A simple test of

demos/tvrml2.p

@@ -38,8 +38,8 @@ $name = $g->add_dataseries(PDL::Graphics::TriD::Points->new($pdl,$cols));
 $g->bind_default($name);
 $name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x]));
 $g->bind_default($name);
-$name = $g->add_dataseries(PDL::Graphics::TriD::SLattice_S->new([SURF2D,$x+1],$cx,
-						     {Smooth=>1,Lines=>0}));
+$name = $g->add_dataseries(PDL::Graphics::TriD::Lattice->new([SURF2D,$x+1],$cx,
+						     {Smooth=>1,Lines=>0,Shading=>3, Lighting=>1, Smooth=>1}}));
 $g->bind_default($name);
 $g->scalethings();
 $win = PDL::Graphics::TriD::get_current_window();

lib/PDL/Graphics/TriD.pm

@@ -319,7 +319,7 @@ as produced by L<PDL::ImageND/contour_segments>.
 
 3D rendered image plot, defined by a variety of contexts
 
-Implemented by L<PDL::Graphics::TriD::SLattice_S>.
+Implemented by L<PDL::Graphics::TriD::Lattice> defaulting to C<< Shading=>3, Smooth => 1, Lighting => 1 >>.
 
 The variant, C<imag3d_ns>, is implemented by L<PDL::Graphics::TriD::Lattice> defaulting to C<< Shading=>2 >>.
 
@@ -907,8 +907,9 @@ sub PDL::imag3d_ns {  &checkargs;
 }
 
 *imag3d=*imag3d=\&PDL::imag3d;
+my %imag3d_defs = (Shading => 3, Smooth => 1, Lighting => 1);
 sub PDL::imag3d { &checkargs;
-	graph_object(PDL::Graphics::TriD::SLattice_S->new(@_));
+  graph_object(_mod_defaults('PDL::Graphics::TriD::Lattice', \%imag3d_defs, @_));
 }
 
 sub _mod_defaults {

lib/PDL/Graphics/TriD/GL.pm

@@ -197,9 +197,19 @@ sub PDL::Graphics::TriD::Lattice::gdraw {
     $this->_lattice_lines($points,$this->{Colors});
   } else {
     glShadeModel($shading == 1 ? GL_FLAT : GL_SMOOTH);
-    _lattice_slice(\&PDL::gl_triangles, $points, $this->{Colors});
+    my $f = 'PDL::gl_triangles';
+    $f .= '_' . ($this->{Options}{Smooth} ? 'w' : '') . 'n_mat' if $shading > 2;
+    { no strict 'refs'; $f = \&$f; }
+    _lattice_slice($f, $points, $this->{Options}{Smooth} ? $this->{Normals} : (), $this->{Colors});
     $this->_lattice_lines($points) if $this->{Options}{Lines};
   }
+  if ($this->{Options}{ShowNormals}) {
+    die "No normals to show!" if !defined $this->{Normals};
+    my $arrows = $points->append($points + $this->{Normals}*0.1)->splitdim(0,3);
+    glDisable(GL_LIGHTING);
+    glColor3d(1,1,1);
+    PDL::Graphics::OpenGLQ::gl_arrows($arrows, 0, 1, 0.5, 0.02);
+  }
 }
 
 sub PDL::Graphics::TriD::LineStrip::gdraw {
@@ -235,29 +245,6 @@ sub PDL::Graphics::TriD::Contours::gdraw {
   }
 }
 
-sub PDL::Graphics::TriD::SLattice_S::gdraw {
-  my($this,$points) = @_;
-  barf "Need 3D points"
-    if grep $_->ndims < 3, $points;
-  glShadeModel(GL_SMOOTH); # By-vertex doesn't make sense otherwise.
-  my $f = 'PDL::gl_triangles_';
-  $f .= 'w' if $this->{Options}{Smooth};
-  $f .= 'n_mat';
-  { no strict 'refs'; $f = \&$f; }
-  my @pdls = $points;
-  push @pdls, $this->{Normals} if $this->{Options}{Smooth};
-  push @pdls, $this->{Colors};
-  _lattice_slice($f, @pdls);
-  $this->_lattice_lines($points) if $this->{Options}{Lines};
-  if ($this->{Options}{ShowNormals}) {
-    die "No normals to show!" if !defined $this->{Normals};
-    my $arrows = $points->append($points + $this->{Normals}*0.1)->splitdim(0,3);
-    glDisable(GL_LIGHTING);
-    glColor3d(1,1,1);
-    PDL::Graphics::OpenGLQ::gl_arrows($arrows, 0, 1, 0.5, 0.02);
-  }
-}
-
 sub PDL::Graphics::TriD::Trigrid::gdraw {
   my($this,$points) = @_;
   my $faces = $points->dice_axis(1,$this->{Faceidx}->flat)->splitdim(1,3);

lib/PDL/Graphics/TriD/Objects.pm

@@ -17,8 +17,7 @@ This provides the following class hierarchy:
   ├ PDL::Graphics::TriD::LineStrip       continuous paths
   ├ PDL::Graphics::TriD::Trigrid         polygons
   └ PDL::Graphics::TriD::GObject_Lattice (abstract) base class
-    ├ PDL::Graphics::TriD::Lattice       colored lattice
-    └ PDL::Graphics::TriD::SLattice_S    ...filled, smooth-shaded, and with normals
+    └ PDL::Graphics::TriD::Lattice       colored lattice
 
 =head1 DESCRIPTION
 
@@ -192,32 +191,20 @@ sub get_valid_options { +{
 
 package PDL::Graphics::TriD::Lattice;
 use base qw/PDL::Graphics::TriD::GObject_Lattice/;
+use fields qw/Normals/;
 sub cdummies {
   my $shading = $_[0]{Options}{Shading};
   !$shading ? $_[1]->dummy(1)->dummy(1) :
   $shading == 1 ? $_[1]->dummy(1,$_[2]->getdim(2)-1)->dummy(1,$_[2]->getdim(1)-1) :
-  $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1));
-}
-sub get_valid_options { +{
-  UseDefcols => 0,
-  Lines => 1,
-  Lighting => 0,
-  Shading => 2, # 0=no fill, 1=flat colour per triangle, 2=smooth colour per vertex
-}}
-
-# colors associated with vertices
-package PDL::Graphics::TriD::SLattice_S;
-use base qw/PDL::Graphics::TriD::GObject_Lattice/;
-use fields qw/Normals/;
-sub cdummies {
   $_[1]->slice(":," . join ',', map "*$_", ($_[2]->dims)[1,2])
 }
 sub get_valid_options { +{
   UseDefcols => 0,
   Lines => 1,
-  Smooth => 1,
+  Lighting => 0,
+  Shading => 2, # 0=no fill, 1=flat colour per triangle, 2=smooth colour per vertex, 3=colors associated with vertices
+  Smooth => 0,
   ShowNormals => 0,
-  Lighting => 1,
 }}
 sub new {
   my ($class,$points,$colors,$options) = @_;