(Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).
| TriD1.pm (PDL-2.078) | : | TriD1.pm (PDL-2.079) |
|---|
| # Copyright (C) 1998 Tuomas J. Lukka. | | # Copyright (C) 1998 Tuomas J. Lukka. |
| # All rights reserved, except redistribution | | # All rights reserved, except redistribution |
| # with PDL under the PDL License permitted. | | # with PDL under the PDL License permitted. |
| | |
| package PDL::Demos::TriD1; | | package PDL::Demos::TriD1; |
| | |
| use PDL::Graphics::TriD; | | use PDL::Graphics::TriD; |
|
| | use Carp; |
| | require File::Spec; |
| | |
| | my @f = qw(PDL IO STL owl.stl); |
| | our $owlfile = undef; |
| | foreach my $path ( @INC ) { |
| | my $file = File::Spec->catfile( $path, @f ); |
| | if ( -f $file ) { $owlfile = $file; last; } |
| | } |
| | confess "Unable to find owl.stl within the perl libraries.\n" |
| | unless defined $owlfile; |
| | |
| sub info {('3d', '3d demo (requires TriD with OpenGL or Mesa)')} | | sub info {('3d', '3d demo (requires TriD with OpenGL or Mesa)')} |
| sub init {' | | sub init {' |
| use PDL::Graphics::TriD; | | use PDL::Graphics::TriD; |
| '} | | '} |
| | |
| my @demo = ( | | my @demo = ( |
| [comment => q| | | [comment => q| |
| Welcome to a short tour of the capabilities of | | Welcome to a short tour of the capabilities of |
| PDL::Graphics::TriD. | | PDL::Graphics::TriD. |
| | |
| skipping to change at line 34 | | skipping to change at line 45 |
|---|
| | |
| use PDL; | | use PDL; |
| use PDL::Graphics::TriD; | | use PDL::Graphics::TriD; |
| | |
| to work properly. | | to work properly. |
| |], | | |], |
| | |
| [actnw => q| | | [actnw => q| |
| # See if we had a 3D window open already | | # See if we had a 3D window open already |
| $|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_win
dow; | | $|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_win
dow; |
|
| | $vertices = pdl([ [0,0,-1], [1,0,-1], [0.5,1,-1], [0.5,0.5,0] ]); |
| | $faceidx = pdl([ [0,2,1], [0,1,3], [0,3,2], [1,2,3] ]); |
| | # show the vertex and face normal vectors on a triangular grid |
| | trigrid3d($vertices,$faceidx,{ShowNormals=>1}); |
| | # [press 'q' in the graphics window when done] |
| | |], |
| | |
| | [actnw => q| |
| | # Show a PDL logo |
| | require PDL::Graphics::TriD::Logo; |
| | $vertices = $PDL::Graphics::TriD::Logo::POINTS; |
| | $faceidx = $PDL::Graphics::TriD::Logo::FACES; |
| | $rotate_m = pdl [1,0,0],[0,0,1],[0,-1,0]; # top towards X axis |
| | $c22 = cos(PI/8); $s22 = sin(PI/8); |
| | $rot22 = pdl [$c22,$s22,0],[-$s22,$c22,0],[0,0,1]; # +22deg about vert |
| | $vertices = ($vertices x $rotate_m x $rot22); |
| | trigrid3d($vertices,$faceidx); |
| | # [press 'q' in the graphics window when done] |
| | |], |
| | |
|
| | [actnw => q| |
| | # Show an owl loaded from an STL file |
| | use PDL::IO::STL; |
| | ($vertices, $faceidx) = rstl $|.__PACKAGE__.q|::owlfile; |
| | trigrid3d($vertices,$faceidx); |
| | # [press 'q' in the graphics window when done] |
| | |], |
| | |
| | [actnw => q| |
| # Number of subdivisions for lines / surfaces. | | # Number of subdivisions for lines / surfaces. |
| $size = 25; | | $size = 25; |
|
| | | |
| $cz = (xvals zeroes $size+1) / $size; # interval 0..1 | | $cz = (xvals zeroes $size+1) / $size; # interval 0..1 |
| $cx = sin($cz*12.6); # Corkscrew | | $cx = sin($cz*12.6); # Corkscrew |
| $cy = cos($cz*12.6); | | $cy = cos($cz*12.6); |
| line3d [$cx,$cy,$cz]; # Draw a line | | line3d [$cx,$cy,$cz]; # Draw a line |
| # [press 'q' in the graphics window when done] | | # [press 'q' in the graphics window when done] |
| |], | | |], |
| | |
| [actnw => q| | | [actnw => q| |
| $r = sin($cz*6.3)/2 + 0.5; | | $r = sin($cz*6.3)/2 + 0.5; |
| $g = cos($cz*6.3)/2 + 0.5; | | $g = cos($cz*6.3)/2 + 0.5; |
| | |
| skipping to change at line 190 | | skipping to change at line 228 |
|---|
| } | | } |
| } | | } |
| keeptwiddling3d(); | | keeptwiddling3d(); |
| release3d(); | | release3d(); |
| # [press 'q' in the graphics window when done] | | # [press 'q' in the graphics window when done] |
| |], | | |], |
| | |
| [actnw => q| | | [actnw => q| |
| # Show the world! | | # Show the world! |
| use PDL::Transform::Cartography; | | use PDL::Transform::Cartography; |
|
| $shape = earth_shape(); | | eval { # this is in case no NetPBM, i.e. can't load Earth images |
| $floats = t_raster2float()->apply($shape->mv(2,0)); | | $shape = earth_shape(); |
| $radius = $floats->slice('(2)'); # r g b all same | | $floats = t_raster2float()->apply($shape->mv(2,0)); |
| $radius *= float((6377.09863 - 6370.69873) / 6371); | | $radius = $floats->slice('(2)'); # r g b all same |
| $radius += float(6370.69873 / 6371); | | $radius *= float((6377.09863 - 6370.69873) / 6371); |
| $e_i = earth_image('day'); | | $radius += float(6370.69873 / 6371); |
| $earth = t_raster2float()->apply($e_i->mv(2,0)); | | $e_i = earth_image('day'); |
| $earth = $earth->append($radius->dummy(0)); | | $earth = t_raster2float()->apply($e_i->mv(2,0)); |
| $shrink = 2.5; # how much to shrink by | | $earth = $earth->append($radius->dummy(0)); |
| $new_x = int($e_i->dim(0) / $shrink); | | $shrink = 2.5; # how much to shrink by |
| $earth2 = $earth->mv(0,2)->match([$new_x,int($new_x/2),6])->mv(2,0); # sh | | $new_x = int($e_i->dim(0) / $shrink); |
| rink | | $earth2 = $earth->mv(0,2)->match([$new_x,int($new_x/2),6])->mv(2,0); # |
| ($lonlatrad, $rgb) = map $earth2->slice($_), pdl(0,1,5), '2:4'; | | shrink |
| $sph = t_spherical()->inverse()->apply($lonlatrad); | | ($lonlatrad, $rgb) = map $earth2->slice($_), pdl(0,1,5), '2:4'; |
| imag3d($sph, $rgb, {Lines=>0}); | | $sph = t_spherical()->inverse()->apply($lonlatrad); |
| | imag3d($sph, $rgb, {Lines=>0}); |
| | }; |
| # [press 'q' in the graphics window when done] | | # [press 'q' in the graphics window when done] |
| |], | | |], |
| | |
| [actnw => q| | | [actnw => q| |
|
| | return if !defined $earth; # failed to load |
| # Show off the world! | | # Show off the world! |
| # The Earth's radius doesn't proportionally vary much, | | # The Earth's radius doesn't proportionally vary much, |
| # but let's exaggerate it to prove we have height information! | | # but let's exaggerate it to prove we have height information! |
| $lonlatrad->slice('2') -= 1; | | $lonlatrad->slice('2') -= 1; |
| $lonlatrad->slice('2') *= 100; | | $lonlatrad->slice('2') *= 100; |
| $lonlatrad->slice('2') += 1; | | $lonlatrad->slice('2') += 1; |
| $sph = t_spherical()->inverse()->apply($lonlatrad); | | $sph = t_spherical()->inverse()->apply($lonlatrad); |
| imag3d($sph, $rgb, {Lines=>0}); | | imag3d($sph, $rgb, {Lines=>0}); |
| # [press 'q' in the graphics window when done] | | # [press 'q' in the graphics window when done] |
| |], | | |], |
| | |
| [actnw => q| | | [actnw => q| |
|
| | return if !defined $earth; # failed to load |
| # Now zoom in over Europe | | # Now zoom in over Europe |
| ($lats, $lons) = map $_ / 180, pdl(22, 72), pdl(-10, 40); | | ($lats, $lons) = map $_ / 180, pdl(22, 72), pdl(-10, 40); |
| $lats = indx(($lats + 0.5) * $earth->dim(2)); | | $lats = indx(($lats + 0.5) * $earth->dim(2)); |
| $lons = indx((($lons + 1) / 2) * $earth->dim(1)); | | $lons = indx((($lons + 1) / 2) * $earth->dim(1)); |
| $earth3 = $earth->slice(':', map [$_->list], $lons, $lats)->sever; # zoom | | $earth3 = $earth->slice(':', map [$_->list], $lons, $lats)->sever; # zoom |
| ($lonlatrad, $rgb) = map $earth3->slice($_), pdl(0,1,5), '2:4'; | | ($lonlatrad, $rgb) = map $earth3->slice($_), pdl(0,1,5), '2:4'; |
| $lonlatrad->slice('2') -= 1; | | $lonlatrad->slice('2') -= 1; |
| $lonlatrad->slice('2') *= 50; # exaggerate terrain but less | | $lonlatrad->slice('2') *= 50; # exaggerate terrain but less |
| $lonlatrad->slice('2') += 1; | | $lonlatrad->slice('2') += 1; |
| $sph = t_spherical()->inverse()->apply($lonlatrad); | | $sph = t_spherical()->inverse()->apply($lonlatrad); |
| | | |
| End of changes. 7 change blocks. |
|---|
| 16 lines changed or deleted | | 58 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 