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 |