"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Graphics/TriD/TriD/Objects.pm" between
PDL-2.076.tar.gz and PDL-2.077.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.076):Objects.pm  (PDL-2.077)
skipping to change at line 37 skipping to change at line 37
use strict; use strict;
use warnings; use warnings;
use base qw/PDL::Graphics::TriD::Object/; use base qw/PDL::Graphics::TriD::Object/;
use fields qw/Points Colors Options/; use fields qw/Points Colors Options/;
$PDL::Graphics::TriD::verbose //= 0; $PDL::Graphics::TriD::verbose //= 0;
sub new { sub new {
my($type,$points,$colors,$options) = @_; my($type,$points,$colors,$options) = @_;
print "GObject new.. calling SUPER::new...\n" if($PDL::debug_trid); print "GObject new.. calling SUPER::new...\n" if($PDL::Graphics::TriD::ve rbose);
my $this = $type->SUPER::new(); my $this = $type->SUPER::new();
print "GObject new - back (SUPER::new returned $this)\n" if($PDL::debug_t rid); print "GObject new - back (SUPER::new returned $this)\n" if($PDL::Graphic s::TriD::verbose);
if(!defined $options and ref $colors eq "HASH") { if(!defined $options and ref $colors eq "HASH") {
$options = $colors; $options = $colors;
undef $colors; undef $colors;
} }
print "GObject new - calling realcoords\n" if($PDL::debug_trid); print "GObject new - calling realcoords\n" if($PDL::Graphics::TriD::verbo se);
$points = PDL::Graphics::TriD::realcoords($type->r_type,$points); $points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
print "GObject new - back from realcoords\n" if($PDL::debug_trid); print "GObject new - back from realcoords\n" if($PDL::Graphics::TriD::ve rbose);
if(!defined $colors) {$colors = PDL->pdl(1,1,1); if(!defined $colors) {$colors = PDL->pdl(1,1,1);
$colors = $type->cdummies($colors,$points); $colors = $type->cdummies($colors,$points);
$options->{UseDefcols} = 1; # for VRML efficiency $options->{UseDefcols} = 1; # for VRML efficiency
} else { } else {
$colors = PDL::Graphics::TriD::realcoords("COLOR",$colors); $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
} }
$this->{Options} = $options; $this->{Options} = $options;
$this->{Points} = $points; $this->{Points} = $points;
$this->{Colors} = $colors; $this->{Colors} = $colors;
$this->check_options(); $this->check_options();
print "GObject new - returning\n" if($PDL::debug_trid); print "GObject new - returning\n" if($PDL::Graphics::TriD::verbose);
return $this; return $this;
} }
sub check_options { sub check_options {
my($this) = @_; my($this) = @_;
my %newopts; my %newopts;
my $opts = $this->get_valid_options(); my $opts = $this->get_valid_options();
print "FETCHOPT: $this ".(join ',',%$opts)."\n" if $PDL::Graphics::TriD:: verbose; print "FETCHOPT: $this ".(join ',',%$opts)."\n" if $PDL::Graphics::TriD:: verbose;
for(keys %$opts) { for(keys %$opts) {
$newopts{$_} = !exists $this->{Options}{$_} ? $opts->{$_} : delet e $this->{Options}{$_}; $newopts{$_} = !exists $this->{Options}{$_} ? $opts->{$_} : delet e $this->{Options}{$_};
skipping to change at line 136 skipping to change at line 136
########################################################################### ###########################################################################
################# JNK 15mar11 added section start ######################### ################# JNK 15mar11 added section start #########################
# JNK 06dec00 -- edited from PDL::Graphics/TriD/GObject in file Objects.pm # JNK 06dec00 -- edited from PDL::Graphics/TriD/GObject in file Objects.pm
# GObjects can be either stand-alone or in Graphs, scaled properly. # GObjects can be either stand-alone or in Graphs, scaled properly.
# All the points used by the object must be in the member {Points}. # 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)... # 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: I don't like that last assumption for all cases..
# JNK 27nov00 new object type: # JNK 27nov00 new object type:
package PDL::Graphics::TriD::GPObject; package PDL::Graphics::TriD::GPObject;
# @ISA=qw/PDL::Graphics::TriD::GObject/;
use base qw/PDL::Graphics::TriD::GObject/; use base qw/PDL::Graphics::TriD::GObject/;
# use fields qw/.../;
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(1,1,1);
skipping to change at line 165 skipping to change at line 163
} }
sub get_valid_options { sub get_valid_options {
return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; } return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; }
sub cdummies { sub cdummies {
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: # JNK 13dec00 new object type:
package PDL::Graphics::TriD::STrigrid_S; package PDL::Graphics::TriD::STrigrid_S;
# @ISA=qw/PDL::Graphics::TriD::GPObject/;
use base qw/PDL::Graphics::TriD::GPObject/; use base qw/PDL::Graphics::TriD::GPObject/;
# use fields qw/.../;
sub cdummies { sub cdummies {
return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); } return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
sub get_valid_options { sub get_valid_options {
return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; } return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; }
# calculate smooth normals # calculate smooth normals
sub smoothn { my ($this,$ddd) = @_; sub smoothn { my ($this,$ddd) = @_;
my $v=$this->{Points};my $f=$this->{Faces};my $fvi=$this->{Faceidx}; my $v=$this->{Points};my $f=$this->{Faces};my $fvi=$this->{Faceidx};
skipping to change at line 202 skipping to change at line 198
# my $vn = $vmn->mv(1,0)->sumover->norm; # my $vn = $vmn->mv(1,0)->sumover->norm;
# ---------------------------------------------------------------------------- # ----------------------------------------------------------------------------
my $vn=PDL::cat( my $vn=PDL::cat(
map { my $vfi=PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)'); map { my $vfi=PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)');
$fn->dice_axis(1,$vfi)->mv(1,0)->sumover->norm } $fn->dice_axis(1,$vfi)->mv(1,0)->sumover->norm }
(0..(($v->dims)[1]-1)) ); (0..(($v->dims)[1]-1)) );
# ---------------------------------------------------------------------------- # ----------------------------------------------------------------------------
return $vn; } return $vn; }
# JNK 06dec00 new object type: # JNK 06dec00 new object type:
package PDL::Graphics::TriD::STrigrid; package PDL::Graphics::TriD::STrigrid;
# @ISA=qw/PDL::Graphics::TriD::GPObject/;
use base qw/PDL::Graphics::TriD::GPObject/; use base qw/PDL::Graphics::TriD::GPObject/;
# use fields qw/.../;
sub cdummies { # copied from SLattice_S; not yet modified... sub cdummies { # copied from SLattice_S; not yet modified...
# called with (type,colors,faces) # 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)); }
sub get_valid_options { # copied from SLattice_S; not yet modified... sub get_valid_options { # copied from SLattice_S; not yet modified...
return { UseDefcols => 0, Lines => 1, Smooth => 0, Material => 0 }; } return { UseDefcols => 0, Lines => 1, Smooth => 0, Material => 0 }; }
################# JNK 15mar11 added section finis ######################### ################# JNK 15mar11 added section finis #########################
########################################################################### ###########################################################################
 End of changes. 11 change blocks. 
11 lines changed or deleted 5 lines changed or added

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