"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Demos/TriDGallery.pm" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

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

TriDGallery.pm  (PDL-2.076):TriDGallery.pm  (PDL-2.077)
# 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::TriDGallery; package PDL::Demos::TriDGallery;
use PDL;
use PDL::Graphics::TriD; use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image; use PDL::Graphics::TriD::Image;
PDL::Demos::Routines->import(); sub info {('3dgal', 'the 3D gallery: make cool images with 3-line scripts')}
sub comment($); sub init {'
sub act($); use PDL::Graphics::TriD;
sub actnw($); use PDL::Graphics::TriD::Image;
sub output; '}
sub run {
comment q| my @demo = (
[comment => q|
Welcome to the TriD Gallery Welcome to the TriD Gallery
The following selection of scripts demonstrates that you The following selection of scripts demonstrates that you
can generate interesting images with PDL (and the TriD can generate interesting images with PDL (and the TriD
modules) with just a few lines of code. modules) with just a few lines of code.
Scripts accepted for this category:
These are the rules for scripts to be accepted for this
category:
1) Must be legal Perl with a recent PDL version - may come with 1) Must be legal Perl with a recent PDL version - may come with
a patch to PDL if the patch is general enough to be included a patch to PDL if the patch is general enough to be included
in the next release and usable outside the demo (e.g. in the next release and usable outside the demo (e.g.
$x=mandelbrot($c) is NOT), i.e. you can introduce new $x=mandelbrot($c) is NOT), i.e. you can introduce new
commands commands
2) Must create an interesting image when fed to PDL
2) The code must fit in 4 lines, 72 columns. If you have an interesting new TriD demo,
3) It must create an interesting image when fed to perl.
If you have an interesting new TriD M4LS (Maximal-4-lines-script)
submit it to the PDL mailing list (pdl-general@lists.sourceforge.net) submit it to the PDL mailing list (pdl-general@lists.sourceforge.net)
or on a GitHub issue (https://github.com/PDLPorters/pdl/issues)
and there is a good chance it will soon be included in the gallery and there is a good chance it will soon be included in the gallery
Press 'q' in the graphics window for the next screen. Press 'q' in the graphics window for the next screen.
Rotate the image by pressing mouse button one and Rotate the image by pressing mouse button one and
dragging in the graphics window. dragging in the graphics window.
Zoom in/out by pressing MB3 and drag up/down. Zoom in/out by pressing MB3 and drag up/down.
|; |],
[actnw => q|
$|.__PACKAGE__.q|::we_opened = !defined $PDL::Graphics::TriD::current_window;
actnw q|
# B/W Mandelbrot... [Tjl] # B/W Mandelbrot... [Tjl]
use PDL; use PDL::Graphics::TriD; use PDL; use PDL::Graphics::TriD; # NOTE all demos need this, only showing once
$s=150;$x=zeroes $s,$s;$r=$x->xlinvals(-1.5,0.5);$i=$x->ylinvals(-1,1); $s=150;$x=zeroes $s,$s;$r=$x->xlinvals(-1.5,0.5);$i=$x->ylinvals(-1,1);
$t=$r;$u=$i; $t=$r;$u=$i;
for(0..12){$q=$r**2-$i**2+$t;$h=2*$r*$i+$u;($r,$i)=map{$_->clip(-5,5)}($q,$h);} for(0..12){$q=$r**2-$i**2+$t;$h=2*$r*$i+$u;($r,$i)=map{$_->clip(-5,5)}($q,$h);}
imagrgb[($r**2+$i**2)>2.0]; imagrgb[($r**2+$i**2)>2.0];
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|; |],
if(0) { [actnw => q|
actnw q|
# Greyscale Mandelbrot [Tjl] # Greyscale Mandelbrot [Tjl]
use PDL; use PDL::Graphics::TriD;$x=zeroes 300,300;$r=$x->xlinvals(-1.5, $x=zeroes 300,300; $r=$x->xlinvals(-1.5, 0.5);
0.5);$i=$x->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2 $i=$x->ylinvals(-1,1); $t=$r; $u=$i;
*$r*$i+$u;$d=$r**2+$i**2;$x=lclip($x,$_*($d>2.0)*($x==0));($r,$i)=map{$_ for(1..30){
->clip(-5,5)}($q,$h);}imagrgb[$x/30]; $q=$r**2-$i**2+$t; $h=2*$r*$i+$u;
$d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
# [press 'q' in the graphics window when done] ($r,$i)=map $_->clip(-5,5), $q, $h;
|; }
imagrgb[$x/30];
actnw q|
# Color Mandelbrot anim (nokeeptwiddling3d removed -> fits) [Tjl]
use PDL; use PDL::Graphics::TriD;
nokeeptwiddling3d();
$x=zeroes 300,300;$r=$x->xlinvals(-1.5,
0.5);$i=$x->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2
*$r*$i+$u;$d=$r**2+$i**2;$x=lclip($x,$_*($d>2.0)*($x==0));($r,$i)=map{$_
->clip(-5,5)}$q,$h;imagrgb[($x==0)*($r/2+0.75),($x==0)*($i+1)/2,$x/30]}
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|; |],
}
if(0){ [actnw => q|
actnw q|
# Torus... (barrel) [Tjl] # Torus... (barrel) [Tjl]
use PDL; use PDL::Graphics::TriD;
$s=40;$x=zeroes $s,$s;$t=$x->xlinvals(0,6.284); $s=40;$x=zeroes $s,$s;$t=$x->xlinvals(0,6.284);
$u=$x->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u; $u=$x->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos$u]); imag3d([$v*sin$t,$v*cos$t,$i*cos$u]);
|;
actnw q| # [press 'q' in the graphics window when done]
|],
[actnw => q|
# Ripply torus [Tjl] # Ripply torus [Tjl]
use PDL; use PDL::Graphics::TriD; $s=40; $x=zeroes 2*$s,$s/2; $t=$x->xlinvals(0,6.284);
$s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284); $u=$x->ylinvals(0,6.284); $o=5; $i=1; $v=$o+$i*sin $u;
$u=$x->ylinvals(0,6.284); $o=5;$i=1;$v=$o+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]); imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
|;
actnw q| # [press 'q' in the graphics window when done]
|],
[actnw => q|
# Ripply torus distorted [Tjl] # Ripply torus distorted [Tjl]
use PDL; use PDL::Graphics::TriD; use PDL; use PDL::Graphics::TriD;
$s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284);$u=$x->ylinvals(0, $s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284);$u=$x->ylinvals(0,
6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u; 6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]); imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
|;
actnw q~
# Game of life [Robin Williams (edited by Tjl)]
use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;
$d=byte(random(zeroes(40,40))>0.85);$k=byte [[1,1,1],[1,0,1],[1,1,1]];
do{ imagrgb [$d]; $s=conv2d($d,$k);
$d&=($s<4);$d&=($s>1);$d|=($s==3);} while (!twiddle3d);
~;
actnw q~ # [press 'q' in the graphics window when done]
# Dewdney's voters (parallelized) [Tjl, inspired by the above 'life'] |],
use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;$d=
byte(random(zeroes(100,100))>0.5);do{$k=float [[1,1,1],[1,0,1],[1,1,1]];
imagrgb[$d]; $s=conv2d($d,$k)/8; $r = $s->float->random;
$e = ($s>$r); $d .= $e; }while(!twiddle3d)
~; [actnw => q|
# Volume rendering [Robin Williams]
$y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
$x=byte($y>$c);
foreach(1,2,4) {
$t=($x->slice("0:-2")<<$_); $t+=$x->slice("1:-1"); $x = $t->mv(0,2);
} }
points3d [whichND(($x != 0) & ($x != 255))->transpose->dog];
actnw q| # [press 'q' in the graphics window when done]
# Volume rendering [Robin Williams] |],
use PDL; use PDL::Graphics::TriD; keeptwiddling3d();
$y=zeroes(50,50,50);$y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals);$c=0;
$x=byte($y>$c);foreach(1,2,4){$t=($x->slice("0:-2")<<$_);$t+=$x->slice("1:-1");
$x = $t->mv(0,2);} points3d [whichND(($x != 0) & ($x != 255))];
|;
actnw q| [actnw => q|
# Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)] # one possible addition to volume rendering...
use PDL; use PDL::Graphics::TriD; nokeeptwiddling3d(); $y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));} $x=byte($y>$c);
$x=rfits("m51.fits")->float; $c=$d=avg($x)+0*$x; foreach (1,2,4) {
while(max $c>1.1) {$c=smth($x/smth($d));$d*=$c;imagrgb[$d/850];} $t= $x->slice("0:-2")<<$_;
|; $t+=$x->slice("1:-1");
$x = $t->mv(0,2);
}
points3d[map $_+$_->float->random, whichND(($x!=0)&($x != 255))->transpose->dog]
;
|],
# use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d; # use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;
# $d=byte(random(zeroes(90,90))>0.5);do{$k=byte [[1,1,1],[1,0,1],[1,1,1]]; # $d=byte(random(zeroes(90,90))>0.5);do{$k=byte [[1,1,1],[1,0,1],[1,1,1]];
# imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d-> # imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d->
# clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d) # clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d)
actnw q| [actnw => q~
# spherical dynamics [Mark R Baker]
use PDL;use PDL::Graphics::TriD;for $c(1..99){$n=6.28*$c; $g=$c*rvals(
sin(zeros(5000))*$c);$cz=-1**$g*$c;$cy=$g*cos$g*$c;$cx=$c*rvals($g)*$c;
$g=cos($w=$cz+$cy+$cx);$r=sin$cy+$c+$cz;$y=sin$w;nokeeptwiddling3d();
$i=$cz-$cx-$cy;$q=$i*$n;points3d[$y*sin$q,$r*cos$q,$g*sin$q],[$r,$g,$y]}
|;
actnw q~
# Fractal mountain range [Tuomas Lukka] # Fractal mountain range [Tuomas Lukka]
use PDL;use PDL::Image2D;use PDL::Graphics::TriD; keeptwiddling3d(); $k=ones(5,5 use PDL::Image2D;
) / 25; $k=ones(5,5) / 25; $x=5; $y=ones(1,1)/2;
$x=5;$y=ones(1,1)/2;for(1..7){$c=$y->dummy(0,2)->clump(2)->transpose-> for(1..7) {
dummy(0,2)->clump(2)->transpose->copy;$c+=$x*$c->random;$x/=3; $c=$y->dupN(2,2)->copy;
$y=conv2d($c,$k); imag3d[$y],{Lines => 0}; } $c+=$x*$c->random; $x/=3;
~; $y=conv2d($c,$k); imag3d[$y],{Lines => 0};
}
comment q|
We hope you did like that and got a feeling of
the power of PDL.
Now it's up to you to submit even better TriD M4LSs.
|; # [press 'q' in the graphics window to iterate (runs 7 times)]
~],
[actnw => q~
# Electron simulation by Mark Baker: https://perlmonks.org/?node_id=963819
nokeeptwiddling3d;
$c = 0;
while (1) {
$n = 6.28 * ++$c;
$x = $c*rvals((zeros(9000))*$c);
$cz = -1**$x*$c;
$cy = -1**$x*sin$x*$c;
$cx = -1**$c*rvals($x)*$c;
$w = $cz-$cy-$cx;
$g = sin($w);
$r = cos($cy+$c+$cz);
$b = cos($w);
$i = ($cz-$cx-$cy);
$q = $i*$n;
points3d [ $b*sin($q), $r*cos($q), $g*sin$q], [$g,$b,$r];
last if twiddle3d(); # exit from loop when 'q' pressed
} }
keeptwiddling3d(); # restore waiting for user to press 'q'
~],
if(0) { # one possible addition to volume rendering... [actnw => q~
# Game of life [Robin Williams (edited by Tjl)]
use PDL; use PDL::Graphics::TriD; use PDL::Image2D;
$y=zeroes(50,50,50);$y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals);$c=0; $d=byte(random(zeroes(40,40))>0.85); $k=byte [[1,1,1],[1,0,1],[1,1,1]];
$x=byte($y>$c);foreach(1,2,4){$t=($x->slice("0:-2")<<$_);$t+=$x->slice("1:-1"); nokeeptwiddling3d;
$x = $t->mv(0,2);}points3d[map{$_+$_->float->random}whichND(($x!=0)&($x != 255)) do {
]; imagrgb [$d]; $s=conv2d($d,$k);
$d&=($s<4); $d&=($s>1); $d|=($s==3);
} while (!twiddle3d);
keeptwiddling3d();
~],
[actnw => q|
# We hope you did like that and got a feeling of
# the power of PDL.
# Now it's up to you to submit even better TriD demos.
close3d() if $|.__PACKAGE__.q|::we_opened;
|],
);
} sub demo { @demo }
# Neat, but too big variation of color mandelbrot my @disabled = (
if(0) { [actnw => q|
# Color Mandelbrot anim (nokeeptwiddling3d removed -> fits) [Tjl]
use PDL; use PDL::Graphics::TriD; use PDL; use PDL::Graphics::TriD;
nokeeptwiddling3d(); nokeeptwiddling3d();
sub f {return abs(sin($_[0]*30))}
$x=zeroes 300,300;$r=$x->xlinvals(-1.5, $x=zeroes 300,300;$r=$x->xlinvals(-1.5,
0.5);$i=$x->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2 0.5);$i=$x->ylinvals(-1,1);$t=$r;$u=$i;
*$r*$i+$u;$d=$r**2+$i**2;$x=lclip($x,$_*($d>2.0)*($x==0));($r,$i)=map{$_ for(1..30) {
->clip(-5,5)}$q,$h;imagrgb[f(($x==0)*($r/2+0.75)),f(($x==0)*($i+1)/2),$x/30]} $q=$r**2-$i**2+$t; $h=2*$r*$i+$u; $d=$r**2+$i**2;
$x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[($x==0)*($r/2+0.75),($x==0)*($i+1)/2,$x/30];
}
keeptwiddling3d();
# [press 'q' in the graphics window when done]
|],
[act => q|
# Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)]
nokeeptwiddling3d();
sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));}
$x=rfits("m51.fits")->float; $c=$d=avg($x)+0*$x;
while(max $c>1.1) {$c=smth($x/smth($d));$d*=$c;imagrgb[$d/850];}
keeptwiddling3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# spherical dynamics [Mark R Baker]
nokeeptwiddling3d();
for $c(1..99){
$n=6.28*$c; $g=$c*rvals(sin(zeros(5000))*$c);
$cz=-1**$g*$c; $cy=$g*cos$g*$c; $cx=$c*rvals($g)*$c;
$g=cos($w=$cz+$cy+$cx); $r=sin$cy+$c+$cz; $y=sin$w;
$i=$cz-$cx-$cy; $q=$i*$n;
points3d[$y*sin$q,$r*cos$q,$g*sin$q],[$r,$g,$y];
}
keeptwiddling3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Neat, but too big variation of color mandelbrot
sub f {return abs(sin($_[0]*30))}
$x=zeroes 300,300;
$r=$x->xlinvals(-1.5, 0.5); $i=$x->ylinvals(-1,1); $t=$r; $u=$i;
nokeeptwiddling3d();
for(1..30) {
$q=$r**2-$i**2+$t;
$h=2*$r*$i+$u; $d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[f(($x==0)*($r/2+0.75)),f(($x==0)*($i+1)/2),$x/30];
} }
keeptwiddling3d();
|],
[actnw => q~
# Dewdney's voters (parallelized) [Tjl, inspired by the above 'life']
use PDL::Image2D;
nokeeptwiddling3d;
$d=byte(random(zeroes(100,100))>0.5);
do{
$k=float [[1,1,1],[1,0,1],[1,1,1]];
imagrgb[$d];
$s=conv2d($d,$k)/8;
$r = $s->float->random;
$e = ($s>$r);
$d .= $e;
} while(!twiddle3d);
keeptwiddling3d();
~],
);
1; 1;
 End of changes. 40 change blocks. 
120 lines changed or deleted 185 lines changed or added

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