"Fossies" - the Fresh Open Source Software Archive  

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

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

TriD.pm  (PDL-2.077):TriD.pm  (PDL-2.078)
=head1 NAME =head1 NAME
PDL::Graphics::TriD -- PDL 3D interface PDL::Graphics::TriD - PDL 3D interface
=head1 SYNOPSIS =head1 SYNOPSIS
use PDL::Graphics::TriD; use PDL::Graphics::TriD;
# Generate a somewhat interesting sequence of points: # Generate a somewhat interesting sequence of points:
$t = sequence(100)/10; $t = sequence(100)/10;
$x = sin($t); $y = cos($t), $z = $t; $x = sin($t); $y = cos($t), $z = $t;
$coords = cat($x, $y, $z)->transpose; $coords = cat($x, $y, $z)->transpose;
my $red = cos(2*$t); my $green = sin($t); my $blue = $t; my $red = cos(2*$t); my $green = sin($t); my $blue = $t;
skipping to change at line 196 skipping to change at line 196
Of course, your data is not required to be regularly gridded. Of course, your data is not required to be regularly gridded.
You could, for example, be measuring the flight path of a bat You could, for example, be measuring the flight path of a bat
flying after mosquitos, which could be wheeling and arching flying after mosquitos, which could be wheeling and arching
all over the space. This is what you might plot using all over the space. This is what you might plot using
C<line3d([$x, $y, $z])>. You could plot the trajectories of C<line3d([$x, $y, $z])>. You could plot the trajectories of
multiple bats, in which case C<$x>, C<$y>, and C<$z> would have multiple bats, in which case C<$x>, C<$y>, and C<$z> would have
multiple columns, but in general you wouldn't expect them to be multiple columns, but in general you wouldn't expect them to be
coordinated. coordinated.
Finally, imagine that you have an air squadron flying in More generally, each coordinate is expected to be arranged in a 3D
formation. Your (x, y, z) data is not regularly gridded, but fashion, similar to C<3,x,y>. The "3" is the actual 3D coordinates of
the (x, y, z) data for each plane should be coordinated and each point. The "x,y" help with gridding, because each point at C<x,y>
we can imagine that their flight path sweep out a surface. is expected to have as geographical neighbours C<x+1,y>, C<x-1,y>,
We could draw this data using C<line3d([$x, $y, $z])>, where C<x,y+1>, C<x,y-1>, and the grid polygon-building relies on that.
each column in the variables corresponds to a different plane, This is how, and why, the 3D earth in C<demo 3d> arranges its data.
but it would also make sense to draw this data using
C<mesh3d([$x, $y, $z])>, since the planes' proximity to each
other should be fairly consistent. In other words, it makes
sense to think of the planes as sweeping out a coordinated
surface, which C<mesh3d> would draw for you, whereas you would
not expect the trajectories of the various bats to describe a
meaningful surface (unless you're into fractals, perhaps).
#!/usr/bin/perl #!/usr/bin/perl
use PDL; use PDL;
use PDL::Graphics::TriD; use PDL::Graphics::TriD;
# Draw out a trajectory in three-space # Draw out a trajectory in three-space
$t = sequence(100)/10; $t = sequence(100)/10;
$x = sin($t); $y = cos($t); $z = $t; $x = sin($t); $y = cos($t); $z = $t;
skipping to change at line 240 skipping to change at line 233
# Draw a regularly-gridded surface: # Draw a regularly-gridded surface:
$surface = sqrt(rvals(zeroes(50,50))/2); $surface = sqrt(rvals(zeroes(50,50))/2);
print "draw a mesh of a regularly-gridded surface using mesh3d\n"; print "draw a mesh of a regularly-gridded surface using mesh3d\n";
mesh3d [$surface]; mesh3d [$surface];
print "draw a regularly-gridded surface using imag3d\n"; print "draw a regularly-gridded surface using imag3d\n";
imag3d [$surface], {Lines=>0}; imag3d [$surface], {Lines=>0};
# Draw a mobius strip: # Draw a mobius strip:
$two_pi = 8 * atan2(1,1); $two_pi = 8 * atan2(1,1);
$t = sequence(50) / 50 * $two_pi; $t = sequence(51) / 50 * $two_pi;
# We want two paths: # We want three paths:
$mobius1_x = cos($t) + 0.5 * sin($t/2); $mobius1_x = cos($t) + 0.5 * sin($t/2);
$mobius2_x = cos($t); $mobius2_x = cos($t);
$mobius3_x = cos($t) - 0.5 * sin($t/2); $mobius3_x = cos($t) - 0.5 * sin($t/2);
$mobius1_y = sin($t) + 0.5 * sin($t/2); $mobius1_y = sin($t) + 0.5 * sin($t/2);
$mobius2_y = sin($t); $mobius2_y = sin($t);
$mobius3_y = sin($t) - 0.5 * sin($t/2); $mobius3_y = sin($t) - 0.5 * sin($t/2);
$mobius1_z = $t - $two_pi/2; $mobius1_z = $t - $two_pi/2;
$mobius2_z = zeroes($t); $mobius2_z = zeroes($t);
$mobius3_z = $two_pi/2 - $t; $mobius3_z = $two_pi/2 - $t;
skipping to change at line 281 skipping to change at line 274
routines are supported: routines are supported:
=head1 FUNCTIONS =head1 FUNCTIONS
=head2 line3d =head2 line3d
=for ref =for ref
3D line plot, defined by a variety of contexts. 3D line plot, defined by a variety of contexts.
Implemented by C<PDL::Graphics::TriD::LineStrip>.
=for usage =for usage
line3d ndarray(3,x), {OPTIONS} line3d ndarray(3,x), {OPTIONS}
line3d [CONTEXT], {OPTIONS} line3d [CONTEXT], {OPTIONS}
=for example =for example
Example: Example:
pdl> line3d [sqrt(rvals(zeroes(50,50))/2)] pdl> line3d [sqrt(rvals(zeroes(50,50))/2)]
skipping to change at line 309 skipping to change at line 304
See module documentation for more information on See module documentation for more information on
contexts and options contexts and options
=head2 imag3d =head2 imag3d
=for ref =for ref
3D rendered image plot, defined by a variety of contexts 3D rendered image plot, defined by a variety of contexts
Implemented by C<PDL::Graphics::TriD::SLattice_S>.
The variant, C<imag3d_ns>, is implemented by C<PDL::Graphics::TriD::SLattice>.
=for usage =for usage
imag3d ndarray(3,x,y), {OPTIONS} imag3d ndarray(3,x,y), {OPTIONS}
imag3d [ndarray,...], {OPTIONS} imag3d [ndarray,...], {OPTIONS}
=for example =for example
Example: Example:
pdl> imag3d [sqrt(rvals(zeroes(50,50))/2)], {Lines=>0}; pdl> imag3d [sqrt(rvals(zeroes(50,50))/2)], {Lines=>0};
skipping to change at line 331 skipping to change at line 330
See module documentation for more information on See module documentation for more information on
contexts and options contexts and options
=head2 mesh3d =head2 mesh3d
=for ref =for ref
3D mesh plot, defined by a variety of contexts 3D mesh plot, defined by a variety of contexts
Implemented by C<PDL::Graphics::TriD::Lattice>.
=for usage =for usage
mesh3d ndarray(3,x,y), {OPTIONS} mesh3d ndarray(3,x,y), {OPTIONS}
mesh3d [ndarray,...], {OPTIONS} mesh3d [ndarray,...], {OPTIONS}
=for example =for example
Example: Example:
pdl> mesh3d [sqrt(rvals(zeroes(50,50))/2)] pdl> mesh3d [sqrt(rvals(zeroes(50,50))/2)]
skipping to change at line 363 skipping to change at line 364
=for ref =for ref
alias for mesh3d alias for mesh3d
=head2 points3d =head2 points3d
=for ref =for ref
3D points plot, defined by a variety of contexts 3D points plot, defined by a variety of contexts
Implemented by C<PDL::Graphics::TriD::Points>.
=for usage =for usage
points3d ndarray(3), {OPTIONS} points3d ndarray(3), {OPTIONS}
points3d [ndarray,...], {OPTIONS} points3d [ndarray,...], {OPTIONS}
=for example =for example
Example: Example:
pdl> points3d [sqrt(rvals(zeroes(50,50))/2)]; pdl> points3d [sqrt(rvals(zeroes(50,50))/2)];
skipping to change at line 384 skipping to change at line 387
See module documentation for more information on See module documentation for more information on
contexts and options contexts and options
=head2 spheres3d =head2 spheres3d
=for ref =for ref
3D spheres plot (preliminary implementation) 3D spheres plot (preliminary implementation)
This is a preliminary implementation as a proof of
concept. It has fixed radii for the spheres being
drawn and no control of color or transparency.
Implemented by C<PDL::Graphics::TriD::Spheres>.
=for usage =for usage
spheres3d ndarray(3), {OPTIONS} spheres3d ndarray(3), {OPTIONS}
spheres3d [ndarray,...], {OPTIONS} spheres3d [ndarray,...], {OPTIONS}
=for example =for example
Example: Example:
pdl> spheres3d ndcoords(10,10,10)->clump(1,2,3) pdl> spheres3d ndcoords(10,10,10)->clump(1,2,3)
- lattice of spheres at coordinates on 10x10x10 grid - lattice of spheres at coordinates on 10x10x10 grid
This is a preliminary implementation as a proof of
concept. It has fixed radii for the spheres being
drawn and no control of color or transparency.
=head2 imagrgb =head2 imagrgb
=for ref =for ref
2D RGB image plot (see also imag2d) 2D RGB image plot (see also imag2d)
Implemented by C<PDL::Graphics::TriD::Image>.
=for usage =for usage
imagrgb ndarray(3,x,y), {OPTIONS} imagrgb ndarray(3,x,y), {OPTIONS}
imagrgb [ndarray,...], {OPTIONS} imagrgb [ndarray,...], {OPTIONS}
This would be used to plot an image, specifying This would be used to plot an image, specifying
red, green and blue values at each point. Note: red, green and blue values at each point. Note:
contexts are very useful here as there are many contexts are very useful here as there are many
ways one might want to do this. ways one might want to do this.
skipping to change at line 430 skipping to change at line 437
pdl> $x=sqrt(rvals(zeroes(50,50))/2) pdl> $x=sqrt(rvals(zeroes(50,50))/2)
pdl> imagrgb [0.5*sin(8*$x)+0.5,0.5*cos(8*$x)+0.5,0.5*cos(4*$x)+0.5] pdl> imagrgb [0.5*sin(8*$x)+0.5,0.5*cos(8*$x)+0.5,0.5*cos(4*$x)+0.5]
=head2 imagrgb3d =head2 imagrgb3d
=for ref =for ref
2D RGB image plot as an object inside a 3D space 2D RGB image plot as an object inside a 3D space
Implemented by C<PDL::Graphics::TriD::Image>.
=for usage =for usage
imagrdb3d ndarray(3,x,y), {OPTIONS} imagrdb3d ndarray(3,x,y), {OPTIONS}
imagrdb3d [ndarray,...], {OPTIONS} imagrdb3d [ndarray,...], {OPTIONS}
The ndarray gives the colors. The option allowed is Points, The ndarray gives the colors. The option allowed is Points,
which should give 4 3D coordinates for the corners of the polygon, which should give 4 3D coordinates for the corners of the polygon,
either as an ndarray or as array ref. either as an ndarray or as array ref.
The default is [[0,0,0],[1,0,0],[1,1,0],[0,1,0]]. The default is [[0,0,0],[1,0,0],[1,1,0],[0,1,0]].
skipping to change at line 507 skipping to change at line 516
When an image is added to the screen, keep twiddling it until When an image is added to the screen, keep twiddling it until
user explicitly presses 'q'. user explicitly presses 'q'.
=for example =for example
keeptwiddling3d(); keeptwiddling3d();
imag3d(..); imag3d(..);
nokeeptwiddling3d(); nokeeptwiddling3d();
$o = imag3d($c); $o = imag3d($c);
while(1) { do {
$c .= nextfunc($c); $c .= nextfunc($c);
$o->data_changed(); $o->data_changed;
twiddle3d(); # animate one step, then return. } while(!twiddle3d()); # animate one step, then iterate
} keeptwiddling3d();
twiddle3d(); # wait one last time
=head2 twiddle3d =head2 twiddle3d
=for ref =for ref
Wait for the user to rotate the image in 3D space. Wait for the user to rotate the image in 3D space.
Let the user rotate the image in 3D space, either for one step Let the user rotate the image in 3D space, either for one step
or until they press 'q', depending on the 'keeptwiddling3d' or until they press 'q', depending on the 'keeptwiddling3d'
setting. If 'keeptwiddling3d' is not set the routine returns setting. If 'keeptwiddling3d' is not set the routine returns
immediately and indicates that a 'q' event was received by immediately and indicates that a 'q' event was received by
returning 1. If the only events received were mouse events, returning 1. If the only events received were mouse events,
returns 0. returns 0.
=head2 close3d =head2 close3d
=for ref =for ref
Close the currently-open 3D window. Close the currently-open 3D window.
=head1 NOT EXPORTED
These functions are not exported, partly because they are not fully
implemented.
=over
=item contour3d
Implemented by C<PDL::Graphics::TriD::Contours>.
=item STrigrid_S_imag3d
Implemented by C<PDL::Graphics::TriD::STrigrid_S>.
=item STrigrid_imag3d
Implemented by C<PDL::Graphics::TriD::STrigrid>.
=back
=head1 CONCEPTS =head1 CONCEPTS
The key concepts (object types) of TriD are explained in the following: The key concepts (object types) of TriD are explained in the following:
=head2 Object =head2 Object
In this 3D abstraction, everything that you can "draw" In this 3D abstraction, everything that you can "draw"
without using indices is an Object. That is, if you have a surface, without using indices is an Object. That is, if you have a surface,
each vertex is not an object and neither is each segment of a long each vertex is not an object and neither is each segment of a long
curve. The whole curve (or a set of curves) is the lowest level Object. curve. The whole curve (or a set of curves) is the lowest level Object.
skipping to change at line 568 skipping to change at line 599
Those that do not have a calling sequence described here should Those that do not have a calling sequence described here should
have their own manual pages. have their own manual pages.
There are objects that are not mentioned here; they are either internal There are objects that are not mentioned here; they are either internal
to PDL3D or in rapidly changing states. If you use them, you do so at to PDL3D or in rapidly changing states. If you use them, you do so at
your own risk. your own risk.
The syntax C<PDL::Graphics::TriD::Scale(x,y,z)> here means that you create The syntax C<PDL::Graphics::TriD::Scale(x,y,z)> here means that you create
an object like an object like
$c = new PDL::Graphics::TriD::Scale($x,$y,$z); $c = PDL::Graphics::TriD::Scale->new($x,$y,$z);
=head2 PDL::Graphics::TriD::LineStrip =head2 PDL::Graphics::TriD::LineStrip
This is just a line or a set of lines. The arguments are 3 1-or-more-D This is just a line or a set of lines. The arguments are 3 1-or-more-D
ndarrays which describe the vertices of a continuous line and an ndarrays which describe the vertices of a continuous line and an
optional color ndarray (which is 1-D also and simply optional color ndarray (which is 1-D also and simply
defines the color between red and blue. This will probably change). defines the color between red and blue. This will probably change).
=head2 PDL::Graphics::TriD::Lines =head2 PDL::Graphics::TriD::Lines
skipping to change at line 639 skipping to change at line 670
=cut =cut
#KGB: NEEDS DOCS ON COMMON OPTIONS!!!!! #KGB: NEEDS DOCS ON COMMON OPTIONS!!!!!
# List of global variables # List of global variables
# #
# $PDL::Graphics::TriD::offline # $PDL::Graphics::TriD::offline
# $PDL::Graphics::TriD::Settings # $PDL::Graphics::TriD::Settings
$PDL::Graphics::TriD::verbose //= 0; $PDL::Graphics::TriD::verbose //= 0;
# $PDL::Graphics::TriD::keeptwiddling # $PDL::Graphics::TriD::keeptwiddling
# $PDL::Graphics::TriD::hold_on # $PDL::Graphics::TriD::only_one
# $PDL::Graphics::TriD::curgraph
# $PDL::Graphics::TriD::create_window_sub # $PDL::Graphics::TriD::create_window_sub
# $PDL::Graphics::TriD::current_window # $PDL::Graphics::TriD::current_window
# #
# ' # '
package PDL::Graphics::TriD; package PDL::Graphics::TriD;
use strict; use strict;
use warnings; use warnings;
use PDL::Exporter; use PDL::Exporter;
skipping to change at line 672 skipping to change at line 702
use PDL::Graphics::TriD::ViewPort; use PDL::Graphics::TriD::ViewPort;
use PDL::Graphics::TriD::Graph; use PDL::Graphics::TriD::Graph;
use PDL::Graphics::TriD::Quaternion; use PDL::Graphics::TriD::Quaternion;
use PDL::Graphics::TriD::Objects; use PDL::Graphics::TriD::Objects;
use PDL::Graphics::TriD::Rout; use PDL::Graphics::TriD::Rout;
# Then, see which display method are we using: # Then, see which display method are we using:
$PDL::Graphics::TriD::device = $PDL::Graphics::TriD::device; $PDL::Graphics::TriD::device = $PDL::Graphics::TriD::device;
BEGIN { BEGIN {
my $dev; my $dev = $PDL::Graphics::TriD::device; # First, take it from this variab
$dev ||= $::PDL::Graphics::TriD::device; # First, take it from this varia le.
ble.
$dev ||= $::ENV{PDL_3D_DEVICE}; $dev ||= $::ENV{PDL_3D_DEVICE};
if(!defined $dev) { if(!defined $dev) {
# warn "Default PDL 3D device is GL (OpenGL): # warn "Default PDL 3D device is GL (OpenGL):
# Set PDL_3D_DEVICE=GL in your environment in order not to see this warning. # Set PDL_3D_DEVICE=GL in your environment in order not to see this warning.
# You must have OpenGL or Mesa installed and the PDL::Graphics::OpenGL extension # You must have OpenGL or Mesa installed and the PDL::Graphics::OpenGL extension
# compiled. Otherwise you will get strange warnings."; # compiled. Otherwise you will get strange warnings.";
$dev = "GL"; # default GL works on all platforms now $dev = "GL"; # default GL works on all platforms now
} }
my $dv; my $dv;
# The following is just a sanity check. # The following is just a sanity check.
for($dev) { for($dev) {
# (/^OOGL$/ and $dv="PDL::Graphics::TriD::OOGL") or # (/^OOGL$/ and $dv="PDL::Graphics::TriD::OOGL") or
(/^GL$/ and $dv="PDL::Graphics::TriD::GL") or (/^GL$/ and $dv="PDL::Graphics::TriD::GL") or
(/^GLpic$/ and $dv="PDL::Graphics::TriD::GL" and $PDL::Graphics: :TriD::offline=1) or (/^GLpic$/ and $dv="PDL::Graphics::TriD::GL" and $PDL::Graphics: :TriD::offline=1) or
(/^VRML$/ and $dv="PDL::Graphics::TriD::VRML" and $PDL::Graphics ::TriD::offline=1) or (/^VRML$/ and $dv="PDL::Graphics::TriD::VRML" and $PDL::Graphics ::TriD::offline=1) or
(barf "Invalid PDL 3D device '$_' specified!"); (barf "Invalid PDL 3D device '$_' specified!");
} }
my $mod = $dv; my $mod = $dv;
$mod =~ s|::|/|g; $mod =~ s|::|/|g;
print "dev = $dev mod=$mod\n" if($verbose); print "dev = $dev mod=$mod\n" if($verbose);
require "$mod.pm"; require "$mod.pm";
$dv->import; $dv->import;
my $verbose; my $verbose;
} }
# currently only used by VRML backend # currently only used by VRML backend
$PDL::Graphics::TriD::Settings = $PDL::Graphics::TriD::Settings; $PDL::Graphics::TriD::Settings = $PDL::Graphics::TriD::Settings;
sub tridsettings {return $PDL::Graphics::TriD::Settings} sub tridsettings {return $PDL::Graphics::TriD::Settings}
# Allowable forms: # Allowable forms:
# x(3,..) [x(..),y(..),z(..)] # x(3,..) [x(..),y(..),z(..)]
sub realcoords { sub realcoords {
my($type,$c) = @_; my($type,$c) = @_;
if(ref $c ne "ARRAY") { if(ref $c ne "ARRAY") {
if($c->getdim(0) != 3) { if($c->getdim(0) != 3) {
barf "If one ndarray given for coordinate, must be (3,... ) or have default interpretation"; barf "If one ndarray given for coordinate, must be (3,... ) or have default interpretation";
} }
return $c ; return $c ;
} }
if(!ref $c->[0]) {$type = shift @$c} my @c = @$c;
if($#$c < 0 || $#$c>2) { if(!ref $c[0]) {$type = shift @c}
if(!@c || @c>3) {
barf "Must have 1..3 array members for coordinates"; barf "Must have 1..3 array members for coordinates";
} }
if($#$c == 0 and $type =~ /^SURF2D$/) { if(@c == 1 and $type eq "SURF2D") {
# surf2d -> this is z axis # surf2d -> this is z axis
@$c = ($c->[0]->xvals,$c->[0]->yvals,$c->[0]); @c = ($c[0]->xvals,$c[0]->yvals,$c[0]);
} elsif($#$c == 0 and $type eq "POLAR2D") { } elsif(@c == 1 and $type eq "POLAR2D") {
my $t = 6.283 * $c->[0]->xvals / ($c->[0]->getdim(0)-1); my $t = 6.283 * $c[0]->xvals / ($c[0]->getdim(0)-1);
my $r = $c->[0]->yvals / ($c->[0]->getdim(1)-1); my $r = $c[0]->yvals / ($c[0]->getdim(1)-1);
@$c = ($r * sin($t), $r * cos($t), $c->[0]); @c = ($r * sin($t), $r * cos($t), $c[0]);
} elsif($#$c == 0 and $type eq "COLOR") { } elsif(@c == 1 and $type eq "COLOR") {
# color -> 1 ndarray = grayscale # color -> 1 ndarray = grayscale
@$c = ($c->[0], $c->[0], $c->[0]); @c = @c[0,0,0];
} elsif($#$c == 0 and $type eq "LINE") { } elsif(@c == 1 and $type eq "LINE") {
@$c = ($c->[0]->xvals, $c->[0], 0); @c = ($c[0]->xvals, $c[0], 0);
} elsif($#$c == 1 and $type eq "LINE") { } elsif(@c == 2 and $type eq "LINE") {
@$c = ($c->[0], $c->[1], $c->[0]->xvals); @c = (@c[0,1], $c[0]->xvals);
} }
# XXX # XXX
if($#$c != 2) { if(@c != 3) {
barf("Must have 3 coordinates if no interpretation (here '$type') "); barf("Must have 3 coordinates if no interpretation (here '$type') ");
} }
# allow a constant (either pdl or not) to be introduced in one dimension # allow a constant (either pdl or not) to be introduced in one dimension
foreach(0..2){ foreach(0..2) {
if(ref($c->[$_]) ne "PDL" or $c->[$_]->nelem==1){ if(ref($c[$_]) ne "PDL" or $c[$_]->nelem==1){
$c->[$_] = $c->[$_]*(PDL->ones($c->[($_+1)%3]->dims)); $c[$_] = $c[$_]*(PDL->ones($c[($_+1)%3]->dims));
} }
} }
my $g = PDL->null; my $g = PDL::Graphics::TriD::Rout::combcoords(@c);
&PDL::Graphics::TriD::Rout::combcoords(@$c,$g);
$g->dump if $PDL::Graphics::TriD::verbose; $g->dump if $PDL::Graphics::TriD::verbose;
return $g; return $g;
} }
sub objplotcommand {
my($object) = @_;
my $win = PDL::Graphics::TriD::get_current_window();
my $world = $win->world();
}
sub checkargs { sub checkargs {
if(ref $_[$#_] eq "HASH" and $PDL::Graphics::TriD::verbose) { if(ref $_[$#_] eq "HASH" and $PDL::Graphics::TriD::verbose) {
print "enter checkargs \n"; print "enter checkargs \n";
for(['KeepTwiddling',\&keeptwiddling3d]) { for(['KeepTwiddling',\&keeptwiddling3d]) {
print "checkargs >$_<\n"; print "checkargs >$_<\n";
if(defined $_[$#_]{$_->[0]}) { if(defined $_[$#_]{$_->[0]}) {
&{$_->[1]}(delete $_[$#_]{$_->[0]}); &{$_->[1]}(delete $_[$#_]{$_->[0]});
} }
} }
} }
} }
*keeptwiddling3d=*keeptwiddling3d=\&PDL::keeptwiddling3d; *keeptwiddling3d=*keeptwiddling3d=\&PDL::keeptwiddling3d;
sub PDL::keeptwiddling3d { sub PDL::keeptwiddling3d {
$PDL::Graphics::TriD::keeptwiddling = (defined $_[0] ? $_[0] : 1); $PDL::Graphics::TriD::keeptwiddling = $_[0] // 1;
} }
*nokeeptwiddling3d=*nokeeptwiddling3d=\&PDL::nokeeptwiddling3d; *nokeeptwiddling3d=*nokeeptwiddling3d=\&PDL::nokeeptwiddling3d;
sub PDL::nokeeptwiddling3d { sub PDL::nokeeptwiddling3d {
$PDL::Graphics::TriD::keeptwiddling = 0 ; $PDL::Graphics::TriD::keeptwiddling = 0 ;
} }
keeptwiddling3d(); keeptwiddling3d();
*twiddle3d = *twiddle3d = \&PDL::twiddle3d; *twiddle3d = *twiddle3d = *PDL::twiddle3d = \&twiddle_current;
sub PDL::twiddle3d {
twiddle_current();
}
*close3d = *close3d = \&PDL::close3d; *close3d = *close3d = \&PDL::close3d;
sub PDL::close3d { sub PDL::close3d {
return if !ref $PDL::Graphics::TriD::current_window; return if !ref $PDL::Graphics::TriD::current_window;
return if !$PDL::Graphics::TriD::current_window->can('close'); return if !$PDL::Graphics::TriD::current_window->can('close');
$PDL::Graphics::TriD::current_window->close; $PDL::Graphics::TriD::current_window->close;
} }
sub graph_object { sub graph_object {
my($obj) = @_; my($obj) = @_;
skipping to change at line 814 skipping to change at line 832
return $obj; return $obj;
} }
# Plotting routines that use the whole viewport # Plotting routines that use the whole viewport
*describe3d=*describe3d=\&PDL::describe3d; *describe3d=*describe3d=\&PDL::describe3d;
sub PDL::describe3d { sub PDL::describe3d {
require PDL::Graphics::TriD::TextObjects; require PDL::Graphics::TriD::TextObjects;
my ($text) = @_; my ($text) = @_;
my $win = PDL::Graphics::TriD::get_current_window(); my $win = PDL::Graphics::TriD::get_current_window();
my $imag = new PDL::Graphics::TriD::Description($text); my $imag = PDL::Graphics::TriD::Description->new($text);
$win->add_object($imag); $win->add_object($imag);
# $win->twiddle(); # $win->twiddle();
} }
*imagrgb=*imagrgb=\&PDL::imagrgb; *imagrgb=*imagrgb=\&PDL::imagrgb;
sub PDL::imagrgb { sub PDL::imagrgb {
require PDL::Graphics::TriD::Image; require PDL::Graphics::TriD::Image;
my (@data) = @_; &checkargs; my (@data) = @_; &checkargs;
my $win = PDL::Graphics::TriD::get_current_window(); my $win = PDL::Graphics::TriD::get_current_window();
my $imag = new PDL::Graphics::TriD::Image(@data); my $imag = PDL::Graphics::TriD::Image->new(@data);
$win->clear_viewports(); $win->clear_viewports();
$win->current_viewport()->add_object($imag); $win->current_viewport()->add_object($imag);
$win->twiddle(); $win->twiddle();
} }
# Plotting routines that use the 3D graph # Plotting routines that use the 3D graph
# Call: line3d([$x,$y,$z],[$color]); # Call: line3d([$x,$y,$z],[$color]);
*line3d=*line3d=\&PDL::line3d; *line3d=*line3d=\&PDL::line3d;
sub PDL::line3d { sub PDL::line3d {
&checkargs; &checkargs;
my $obj = new PDL::Graphics::TriD::LineStrip(@_); my $obj = PDL::Graphics::TriD::LineStrip->new(@_);
print "line3d: object is $obj\n" if($PDL::Graphics::TriD::verbose); print "line3d: object is $obj\n" if($PDL::Graphics::TriD::verbose);
&graph_object($obj); graph_object($obj);
} }
*contour3d=*contour3d=\&PDL::contour3d; *contour3d=*contour3d=\&PDL::contour3d;
sub PDL::contour3d { sub PDL::contour3d {
# &checkargs; # &checkargs;
require PDL::Graphics::TriD::Contours; require PDL::Graphics::TriD::Contours;
&graph_object(new PDL::Graphics::TriD::Contours(@_)); graph_object(PDL::Graphics::TriD::Contours->new(@_));
} }
# XXX Should enable different positioning... # XXX Should enable different positioning...
*imagrgb3d=*imagrgb3d=\&PDL::imagrgb3d; *imagrgb3d=*imagrgb3d=\&PDL::imagrgb3d;
sub PDL::imagrgb3d { &checkargs; sub PDL::imagrgb3d { &checkargs;
require PDL::Graphics::TriD::Image; require PDL::Graphics::TriD::Image;
&graph_object(new PDL::Graphics::TriD::Image(@_)); graph_object(PDL::Graphics::TriD::Image->new(@_));
} }
*imag3d_ns=*imag3d_ns=\&PDL::imag3d_ns; *imag3d_ns=*imag3d_ns=\&PDL::imag3d_ns;
sub PDL::imag3d_ns { &checkargs; sub PDL::imag3d_ns { &checkargs;
&graph_object(new PDL::Graphics::TriD::SLattice(@_)); graph_object(PDL::Graphics::TriD::SLattice->new(@_));
} }
*imag3d=*imag3d=\&PDL::imag3d; *imag3d=*imag3d=\&PDL::imag3d;
sub PDL::imag3d { &checkargs; sub PDL::imag3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::SLattice_S(@_)); graph_object(PDL::Graphics::TriD::SLattice_S->new(@_));
} }
#################################################################### ####################################################################
################ JNK 15mar11 added section start ################### ################ JNK 15mar11 added section start ###################
*STrigrid_S_imag3d=*STrigrid_S_imag3d=\&PDL::STrigrid_S_imag3d; *STrigrid_S_imag3d=*STrigrid_S_imag3d=\&PDL::STrigrid_S_imag3d;
sub PDL::STrigrid_S_imag3d { &checkargs; sub PDL::STrigrid_S_imag3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::STrigrid_S(@_)); } graph_object(PDL::Graphics::TriD::STrigrid_S->new(@_)); }
*STrigrid_imag3d=*STrigrid_imag3d=\&PDL::STrigrid_imag3d; *STrigrid_imag3d=*STrigrid_imag3d=\&PDL::STrigrid_imag3d;
sub PDL::STrigrid_imag3d { &checkargs; sub PDL::STrigrid_imag3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::STrigrid(@_)); } graph_object(PDL::Graphics::TriD::STrigrid->new(@_)); }
################ JNK 15mar11 added section finis ################### ################ JNK 15mar11 added section finis ###################
#################################################################### ####################################################################
*mesh3d=*mesh3d=\&PDL::mesh3d; *mesh3d=*mesh3d=\&PDL::mesh3d;
*lattice3d=*lattice3d=\&PDL::mesh3d; *lattice3d=*lattice3d=\&PDL::mesh3d;
*PDL::lattice3d=*PDL::lattice3d=\&PDL::mesh3d; *PDL::lattice3d=*PDL::lattice3d=\&PDL::mesh3d;
sub PDL::mesh3d { &checkargs; sub PDL::mesh3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::Lattice(@_)); graph_object(PDL::Graphics::TriD::Lattice->new(@_));
} }
*points3d=*points3d=\&PDL::points3d; *points3d=*points3d=\&PDL::points3d;
sub PDL::points3d { &checkargs; sub PDL::points3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::Points(@_)); graph_object(PDL::Graphics::TriD::Points->new(@_));
} }
*spheres3d=*spheres3d=\&PDL::spheres3d; *spheres3d=*spheres3d=\&PDL::spheres3d;
sub PDL::spheres3d { &checkargs; sub PDL::spheres3d { &checkargs;
&graph_object(new PDL::Graphics::TriD::Spheres(@_)); graph_object(PDL::Graphics::TriD::Spheres->new(@_));
} }
*grabpic3d=*grabpic3d=\&PDL::grabpic3d; *grabpic3d=*grabpic3d=\&PDL::grabpic3d;
sub PDL::grabpic3d { sub PDL::grabpic3d {
my $win = PDL::Graphics::TriD::get_current_window(); my $win = PDL::Graphics::TriD::get_current_window();
barf "backend doesn't support grabbing the rendered scene" barf "backend doesn't support grabbing the rendered scene"
unless $win->can('read_picture'); unless $win->can('read_picture');
my $pic = $win->read_picture(); my $pic = $win->read_picture();
return ($pic->float) / 255; return ($pic->float) / 255;
} }
$PDL::Graphics::TriD::hold_on = 0; $PDL::Graphics::TriD::only_one = 1;
sub PDL::hold3d {$PDL::Graphics::TriD::only_one = !($_[0] // 1);}
sub PDL::hold3d {$PDL::Graphics::TriD::hold_on =(!defined $_[0] ? 1 : $_[0]);} sub PDL::release3d {$PDL::Graphics::TriD::only_one = 1;}
sub PDL::release3d {$PDL::Graphics::TriD::hold_on = 0;}
*hold3d=*hold3d=\&PDL::hold3d; *hold3d=*hold3d=\&PDL::hold3d;
*release3d=*release3d=\&PDL::release3d; *release3d=*release3d=\&PDL::release3d;
sub get_new_graph { sub get_new_graph {
print "get_new_graph: calling PDL::Graphics::TriD::get_current_window...\n" if($PDL::Graphics::TriD::verbose); print "get_new_graph: calling PDL::Graphics::TriD::get_current_window...\n" if($PDL::Graphics::TriD::verbose);
my $win = PDL::Graphics::TriD::get_current_window(); my $win = PDL::Graphics::TriD::get_current_window();
print "get_new_graph: calling get_current_graph...\n" if($PDL::Graphics::Tri D::verbose); print "get_new_graph: calling get_current_graph...\n" if($PDL::Graphics::Tri D::verbose);
my $g = get_current_graph($win); my $g = get_current_graph($win);
print "get_new_graph: back get_current_graph returned $g...\n" if($PDL::Grap hics::TriD::verbose); print "get_new_graph: back get_current_graph returned $g...\n" if($PDL::Grap hics::TriD::verbose);
if ($PDL::Graphics::TriD::only_one) {
if(!$PDL::Graphics::TriD::hold_on) { $g->clear_data;
$g->clear_data(); $win->clear_viewport;
$win->clear_viewport();
} }
$g->default_axes(); $g->default_axes;
$win->add_object($g); $win->add_object($g);
return $g; return $g;
} }
sub get_current_graph { sub get_current_graph {
my $win = shift; my $win = shift;
my $g = $win->current_viewport()->graph(); my $g = $win->current_viewport()->graph();
if(!defined $g) { if(!defined $g) {
$g = new PDL::Graphics::TriD::Graph(); $g = PDL::Graphics::TriD::Graph->new;
$g->default_axes(); $g->default_axes();
$win->current_viewport()->graph($g); $win->current_viewport()->graph($g);
} }
return $g; return $g;
} }
# $PDL::Graphics::TriD::create_window_sub = undef; # $PDL::Graphics::TriD::create_window_sub = undef;
sub get_current_window { sub get_current_window {
my $opts = shift @_; my $opts = shift @_;
my $win = $PDL::Graphics::TriD::current_window; my $win = $PDL::Graphics::TriD::current_window;
if(!defined $win) { if(!defined $win) {
if(!$PDL::Graphics::TriD::create_window_sub) { if(!$PDL::Graphics::TriD::create_window_sub) {
barf("PDL::Graphics::TriD must be used with a display mechanism: for example PDL::Graphics::TriD::GL!\n"); barf("PDL::Graphics::TriD must be used with a display mechanism: for example PDL::Graphics::TriD::GL!\n");
} }
print "get_current_window - creating window...\n" if($PDL::Graphics::Tri D::verbose); print "get_current_window - creating window...\n" if($PDL::Graphics::Tri D::verbose);
$PDL::Graphics::TriD::current_window = $win = new PDL::Graphics::TriD::W indow($opts); $PDL::Graphics::TriD::current_window = $win = PDL::Graphics::TriD::Windo w->new($opts);
print "get_current_window - calling set_material...\n" if($PDL::Graphics ::TriD::verbose); print "get_current_window - calling set_material...\n" if($PDL::Graphics ::TriD::verbose);
$win->set_material(new PDL::Graphics::TriD::Material); $win->set_material(PDL::Graphics::TriD::Material->new);
} }
return $PDL::Graphics::TriD::current_window; return $PDL::Graphics::TriD::current_window;
} }
# Get the current graphbox sub twiddle_current { get_current_window()->twiddle() }
sub get_current_graphbox {
die "get_current_graphbox: ERROR graphbox is not implemented! \n";
my $graph = $PDL::Graphics::TriD::curgraph;
if(!defined $graph) {
$graph = new PDL::Graphics::TriD::Graph();
$graph->default_axes();
$PDL::Graphics::TriD::curgraph = $graph;
}
return $graph;
}
sub twiddle_current {
my $win = get_current_window();
$win->twiddle();
}
################################### ###################################
# #
# #
package PDL::Graphics::TriD::Material; package PDL::Graphics::TriD::Material;
sub new { sub new {
my ($type,%ops) = @_; my ($type,%ops) = @_;
my $this = bless {}, $type; my $this = bless {}, $type;
for (['Shine',40], for (['Shine',40],
skipping to change at line 1024 skipping to change at line 1022
$trans->add_transformation( $trans->add_transformation(
PDL::Graphics::TriD::Translation->new( PDL::Graphics::TriD::Translation->new(
($x0-$this->[0]*$sx), ($x0-$this->[0]*$sx),
($y0-$this->[1]*$sy), ($y0-$this->[1]*$sy),
($z0-$this->[2]*$sz) ($z0-$this->[2]*$sz)
)); ));
$trans->add_transformation(PDL::Graphics::TriD::Scale->new($sx,$sy,$sz)); $trans->add_transformation(PDL::Graphics::TriD::Scale->new($sx,$sy,$sz));
return $trans; return $trans;
} }
###################################
#
#
package PDL::Graphics::TriD::OneTransformation; package PDL::Graphics::TriD::OneTransformation;
use fields qw/Args/; use fields qw/Args/;
sub new { sub new {
my($type,@args) = @_; my($type,@args) = @_;
my $this = fields::new($type); my $this = fields::new($type);
$this->{Args} = [@args]; $this->{Args} = [@args];
$this; $this;
} }
package PDL::Graphics::TriD::Scale; package PDL::Graphics::TriD::Scale;
use base qw/PDL::Graphics::TriD::OneTransformation/; use base qw/PDL::Graphics::TriD::OneTransformation/;
package PDL::Graphics::TriD::Translation; package PDL::Graphics::TriD::Translation;
use base qw/PDL::Graphics::TriD::OneTransformation/; use base qw/PDL::Graphics::TriD::OneTransformation/;
package PDL::Graphics::TriD::Transformation; package PDL::Graphics::TriD::Transformation;
use base qw/PDL::Graphics::TriD::Object/; use base qw/PDL::Graphics::TriD::Object/;
#sub new {
# my($type) = @_;
# bless {},$type;
#}
sub add_transformation { sub add_transformation {
my($this,$trans) = @_; my($this,$trans) = @_;
push @{$this->{Transforms}},$trans; push @{$this->{Transforms}},$trans;
} }
=head1 BUGS
Not enough is there yet.
=head1 AUTHOR =head1 AUTHOR
Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu). Documentation Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu). Documentation
contributions from Karl Glazebrook (kgb@aaoepp.aao.gov.au). contributions from Karl Glazebrook (kgb@aaoepp.aao.gov.au).
All rights reserved. There is no warranty. You are allowed All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution, distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file. the copyright notice should be included in the file.
=cut =cut
1;
 End of changes. 56 change blocks. 
122 lines changed or deleted 106 lines changed or added

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