test default-colour behaviour

Author: mohawk2

lib/PDL/Graphics/TriD/Object.pm

@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Scalar::Util qw(weaken);
 use Carp 'confess';
-use PDL::ImageND;
+use PDL::ImageND ();
 
 use fields qw(Objects IsValid ChangedSub Impl Options);
 
@@ -43,7 +43,7 @@ sub normalise_as {
 # Allowable forms:
 # x(3,..)  [x(..),y(..),z(..)]
 sub realcoords {
-  my($type,$c) = @_;
+  my ($type,$c) = @_;
   if (ref $c ne "ARRAY") {
     my $dim0 = $c->getdim(0);
     confess "If one ndarray given for coordinate, must be (2|3,...) or have default interpretation" if $dim0 != 2 and $dim0 != 3;
@@ -96,13 +96,13 @@ sub get_valid_options { +{
 }}
 
 sub clear_objects {
-	my($this) = @_;
+	my ($this) = @_;
 	$this->{Objects} = [];
 	$this->{IsValid} = 0;
 }
 
 sub delete_object {
-  my($this,$object) = @_;
+  my ($this,$object) = @_;
   my $ref = $this->{Objects};
   return unless defined $object && defined $ref;
   my @inds = grep $object == $ref->[$_], 0..$#$ref;
@@ -127,13 +127,13 @@ sub contained_objects {
 }
 
 sub changed_from_above {
-	my($this) = @_;
+	my ($this) = @_;
 	print "CHANGED_FROM_ABOVE\n" if $PDL::Graphics::TriD::verbose;
 	$this->changed;
 }
 
 sub add_changedsub {
-	my($this,$chsub) = @_;
+	my ($this,$chsub) = @_;
 	push @{$this->{ChangedSub}}, $chsub;
 	for (@{$this->{Objects}}) {
 		$_->add_changedsub($chsub);
@@ -142,7 +142,7 @@ sub add_changedsub {
 
 
 sub clear {
-	my($this) = @_;
+	my ($this) = @_;
 	# print "Clear: $this\n";
 	for (@{$this->{Objects}}) {
 		$_->clear();
@@ -153,15 +153,15 @@ sub clear {
 }
 
 sub changed {
-  my($this) = @_;
+  my ($this) = @_;
   print "VALID0 $this\n" if $PDL::Graphics::TriD::verbose;
   $this->{IsValid} = 0;
   $_->($this) for @{$this->{ChangedSub}};
 }
 
 # In the future, have this happen automatically by the ndarrays.
 sub data_changed {
-  my($this) = @_;
+  my ($this) = @_;
   $this->changed;
   $_->changed for $this->contained_objects;
 }

lib/PDL/Graphics/TriD/Objects.pm

@@ -100,7 +100,7 @@ package # hide from PAUSE
   PDL::Graphics::TriD::Lines;
 use base qw/PDL::Graphics::TriD::GObject/;
 sub cdummies { $_[1]->slice(":," . join ',', map "*$_", grep defined, ($_[2]->dims)[1,2]) }
-sub r_type { return "SURF2D";}
+sub r_type { "SURF2D" }
 sub get_valid_options { +{
   UseDefcols => 0,
 }}
@@ -109,7 +109,7 @@ package # hide from PAUSE
   PDL::Graphics::TriD::LineStrip;
 use base qw/PDL::Graphics::TriD::Object/;
 sub cdummies { $_[1]->slice(":," . join ',', map "*$_", grep defined, ($_[2]->dims)[1,2]) }
-sub r_type { return "SURF2D";}
+sub r_type { "SURF2D" }
 sub get_valid_options { +{
   UseDefcols => 0,
 }}
@@ -155,7 +155,7 @@ sub new {
   }
   $this;
 }
-sub r_type { return "";}
+sub r_type { "" }
 sub get_valid_options { +{
   UseDefcols => 0,
   Lines => 0,
@@ -234,7 +234,7 @@ use base qw/PDL::Graphics::TriD::Object/;
 sub cdummies {
   $_[1]->slice(":," . join ',', map "*$_", ($_[2]->dims)[1,2])
 }
-sub r_type {return "SURF2D";}
+sub r_type {"SURF2D" }
 sub get_valid_options { +{
   UseDefcols => 0,
   Lines => 1,
@@ -324,7 +324,7 @@ sub set_labels {
 package # hide from PAUSE
   PDL::Graphics::TriD::Arrows;
 use base qw/PDL::Graphics::TriD::Object/;
-sub r_type { return "";}
+sub r_type { "" }
 sub get_valid_options { +{
   UseDefcols => 0,
   FromTo => [],

t/object.t

@@ -14,6 +14,9 @@ like $@, qr/Given 1D ndarray as colour but no points to match/;
 
 sub PDL::Graphics::TriD::Object::cdummies { $_[1]->dummy(1,$_[2]->getdim(1)); }
 is_pdl $o->normalise_as('COLOR', pdl(1,4,7), zeroes(2,4)), float('1 4 7; 1 4 7; 1 4 7; 1 4 7');
+eval { $o->normalise_as('COLOR', pdl(1,4,7)) };
+like $@, qr/Given 1D ndarray as colour but no points to match/;
+is_pdl $o->normalise_as('COLOR', undef, zeroes(2,4)), float('1 1 1; 1 1 1; 1 1 1; 1 1 1');
 
 is_pdl $o->normalise_as('', [SURF2D=>pdl('1 4 7;5 8 9')]), float('
   [0 0 1; 1 0 4; 2 0 7]