"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Graphics/TriD/TriD/Objects.pm" between
PDL-2.078.tar.gz and PDL-2.079.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

Objects.pm  (PDL-2.078):Objects.pm  (PDL-2.079)
skipping to change at line 114 skipping to change at line 114
sub cdummies { return $_[1]->dummy(1); } sub cdummies { return $_[1]->dummy(1); }
sub r_type { return "SURF2D";} sub r_type { return "SURF2D";}
sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; } sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
package PDL::Graphics::TriD::LineStrip; package PDL::Graphics::TriD::LineStrip;
use base qw/PDL::Graphics::TriD::GObject/; use base qw/PDL::Graphics::TriD::GObject/;
sub cdummies { return $_[1]->dummy(1); } sub cdummies { return $_[1]->dummy(1); }
sub r_type { return "SURF2D";} sub r_type { return "SURF2D";}
sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; } sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
########################################################################### package PDL::Graphics::TriD::STrigrid;
################# JNK 15mar11 added section start #########################
# JNK 06dec00 -- edited from PDL::Graphics/TriD/GObject in file Objects.pm
# 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)...
# JNK: I don't like that last assumption for all cases..
# JNK 27nov00 new object type:
package PDL::Graphics::TriD::GPObject;
use base qw/PDL::Graphics::TriD::GObject/; use base qw/PDL::Graphics::TriD::GObject/;
sub new { sub new {
my($type,$points,$faceidx,$colors,$options) = @_; my($type,$points,$faceidx,$colors,$options) = @_;
# faceidx is 2D pdl of indices into points for each face # faceidx is 2D pdl of indices into points for each face
if(!defined $options and ref $colors eq "HASH") { if(!defined $options and ref $colors eq "HASH") {
$options = $colors;undef $colors; } $options = $colors;undef $colors; }
$points = PDL::Graphics::TriD::realcoords($type->r_type,$points); $points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
my $faces = $points->dice_axis(1,$faceidx->clump(-1))->splitdim(1,3); my $faces = $points->dice_axis(1,$faceidx->clump(-1))->splitdim(1,3);
# faces is 3D pdl slices of points, giving cart coords of face verts # faces is 3D pdl slices of points, giving cart coords of face verts
if(!defined $colors) { $colors = PDL->pdl(1,1,1); if(!defined $colors) { $colors = PDL->pdl(0.8,0.8,0.8);
$colors = $type->cdummies($colors,$faces); $colors = $type->cdummies($colors,$faces);
$options->{ UseDefcols } = 1; } # for VRML efficiency $options->{ UseDefcols } = 1; } # for VRML efficiency
else { $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors); } else { $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors); }
my $this = bless { Points => $points, Faceidx => $faceidx, Faces => $faces, my $this = bless { Points => $points, Faceidx => $faceidx, Faces => $faces,
Colors => $colors, Options => $options},$type; Colors => $colors, Options => $options},$type;
$this->check_options; $this->check_options;
$this; $this;
} }
sub get_valid_options { { UseDefcols=>0, Lines=>0, Smooth=>1 } } sub get_valid_options { { UseDefcols => 0, Lines => 1 } }
sub cdummies { sub cdummies { # called with (type,colors,faces)
return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); } return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
# JNK 13dec00 new object type:
package PDL::Graphics::TriD::STrigrid_S; package PDL::Graphics::TriD::STrigrid_S;
use base qw/PDL::Graphics::TriD::GPObject/; use base qw/PDL::Graphics::TriD::STrigrid/;
sub cdummies {
return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
sub new { sub new {
my ($class,$points,$faceidx,$colors,$options) = @_; my $this = shift->SUPER::new(@_);
my $this = $class->SUPER::new($points,$faceidx,$colors,$options); $this->{Normals} //= $this->smoothn if $this->{Options}{Smooth};
$this->{Normals} //= $this->smoothn($this->{Points}) if $this->{Options}{Smoot
h};
$this; $this;
} }
# calculate smooth normals sub get_valid_options { { UseDefcols=>0, Lines=>0, Smooth=>1, ShowNormals=>0 } }
sub smoothn { my ($this,$ddd) = @_; sub smoothn { my ($this) = @_;
my $v=$this->{Points};my $f=$this->{Faces};my $fvi=$this->{Faceidx}; my ($points, $faces, $faceidx) = @$this{qw(Points Faces Faceidx)};
# ---------------------------------------------------------------------------- my @p = $faces->mv(1,-1)->dog;
my @p = map { $f->slice(":,($_),:") } (0..(($fvi->dims)[0]-1)); my $fn = ($p[1]-$p[0])->crossp($p[2]-$p[1])->norm; # flat faces, >= 3 points
# ---------------------------------------------------------------------------- $this->{FaceNormals} = $fn if $this->{Options}{ShowNormals};
# the following line assumes all faces are triangles PDL::cat(
my $fn = ($p[1]-$p[0])->crossp($p[2]-$p[1])->norm; map $fn->dice_axis(1,($faceidx==$_)->whichND->slice('(1)'))->mv(1,0)->sumove
# my $vfi = PDL::cat(map {PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)')} r->norm,
# (0..(($v->dims)[1]-1))); 0..($points->dim(1)-1) );
# the above, spread into several statements:
# my @vfi2=();for my $idx (0..($v->dims)[1]-1) {
# my @vfi0=PDL::whichND($fvi==$idx);
# my $vfi1=PDL::cat(@vfi0);
# $vfi2[$idx]=$vfi1->slice(':,(1)'); }
# my $vfi=PDL::cat(@vfi2);
# my $vmn = $fn->dice_axis(1,$vfi->clump(-1))->splitdim(1,($fvi->dims)[0]);
# my $vn = $vmn->mv(1,0)->sumover->norm;
# ----------------------------------------------------------------------------
my $vn=PDL::cat(
map { my $vfi=PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)');
$fn->dice_axis(1,$vfi)->mv(1,0)->sumover->norm }
0..($v->dim(1)-1) );
# ----------------------------------------------------------------------------
return $vn;
} }
# JNK 06dec00 new object type:
package PDL::Graphics::TriD::STrigrid;
use base qw/PDL::Graphics::TriD::GPObject/;
sub cdummies { # copied from SLattice_S; not yet modified...
# called with (type,colors,faces)
return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
sub get_valid_options { { UseDefcols => 0, Lines => 1, Smooth => 1 } }
################# JNK 15mar11 added section finis #########################
###########################################################################
package PDL::Graphics::TriD::GObject_Lattice; package PDL::Graphics::TriD::GObject_Lattice;
use base qw/PDL::Graphics::TriD::GObject/; use base qw/PDL::Graphics::TriD::GObject/;
sub r_type {return "SURF2D";} sub r_type {return "SURF2D";}
sub get_valid_options { return {UseDefcols => 0,Lines => 1}; } sub get_valid_options { return {UseDefcols => 0,Lines => 1}; }
package PDL::Graphics::TriD::Lattice; package PDL::Graphics::TriD::Lattice;
use base qw/PDL::Graphics::TriD::GObject_Lattice/; use base qw/PDL::Graphics::TriD::GObject_Lattice/;
sub cdummies { return $_[1]->dummy(1)->dummy(1); } sub cdummies { return $_[1]->dummy(1)->dummy(1); }
 End of changes. 8 change blocks. 
56 lines changed or deleted 17 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)