(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 |
|---|
"Fossies" - the Fresh Open Source Software Archive 