use strict; use warnings;
use PDL;
use PDL::IO::GD; # for write_gif_anim, bigger file but nicer looking
use PDL::Demos;
use File::Path qw(mkpath);
use File::Spec::Functions qw(catdir catfile splitpath updir);
my $html_header = <<'EOF';
%s
EOF
my $html_footer = <<'EOF';
EOF
my $index_header = <<'EOF';
Demos and Examples
On the following pages you'll find some examples of how to use PDL
for basic computations and plotting purposes. Several of the examples
are available as demos within perldl. For more details try:
perldl> demo
EOF
my ($name_pat, $name_glob) = qw(output-%d.png output-*.png);
my $destroot = shift;
die "Usage: $0 destroot [singledemo]" unless defined $destroot && -d $destroot;
my $single_demo = shift;
my @infos = map [PDL::Demos->info($_)],
'pdl', sort grep $_ ne 'pdl', $single_demo || PDL::Demos->keywords;
@infos = grep $_->[0] eq 'pdl' || $_->[1] =~ /Simple|GSL/, @infos;
my @this_output;
sub do_output { push @this_output, map "$_", @_; }
my @titles;
for (@infos) {
my ($kw, $blurb, $mod) = @$_;
my $outdir = catdir($destroot, updir, updir, qw(images demos), $kw);
print " $kw -> $outdir\n";
$ENV{PDL_SIMPLE_ENGINE} = 'gnuplot';
$ENV{PDL_SIMPLE_OUTPUT} = catfile($outdir, $name_pat);
mkpath($outdir) or die "$outdir: $!" if !-d $outdir;
unlink($_) or die "unlink $_: $!"
for grep -f, glob catfile($outdir, $name_glob);
PDL::Demos->init($kw);
my ($vidcounter, @outframes, %seen_img) = 0;
for my $frame (PDL::Demos->demo($kw)) {
my ($cmd, $txt) = @$frame;
my @lines = split /\n/, $txt;
shift @lines until $lines[0] =~ /\S/;
pop @lines until $lines[-1] =~ /\S/;
die "No non-blank lines found in a frame of $kw, text '$txt'" if !@lines;
if ($cmd eq 'comment') {
my $final = join "\n", @lines;
$final =~ s#\n\n+#\n\n#g;
push @outframes, [hyperlink($final)];
next;
}
my ($state, $chunk, @to_execute, @thisframe) = ($lines[0] =~ /^\s*#/ ? 'c' : 'w', '');
for (@lines) {
if (/^\s*#+\s*(.*?)\s*#*\s*$/) { # words
if ($state eq 'c') {
chomp $chunk;
push @thisframe, "\n$chunk\n
" if $chunk;
$chunk = '';
}
$state = 'w';
$chunk .= $1 ? "$1\n" : "\n";
} else {
if ($state eq 'w') {
chomp $chunk;
push @thisframe, $chunk if $chunk;
$chunk = '';
}
$state = 'c';
$chunk .= "$_\n" if /\S/;
push @to_execute, $_;
}
}
chomp($chunk), push @thisframe, $state eq 'c' ? "\n$chunk\n
" : $chunk
if $chunk;
if (@to_execute) {
@this_output = ();
s#^(\s*)print\b#do_output +#g for @to_execute;
s#^(\s*)printf\b#do_output sprintf#g for @to_execute;
my $exec_text = join "\n", "package $mod; *do_output=\\&main::do_output; sub do_output; no strict; use PDL;", @to_execute;
eval $exec_text;
die if $@;
my $o = join('', @this_output)."\n";
$o =~ s/\A\n+|\n+\z//g;
$o = "\n$o\n
" if $o;
my @this_imgs = map $_->[1], sort {$a->[0]<=>$b->[0]} map [/(\d+)/, $_],
grep !$seen_img{$_}++, glob catfile($outdir, $name_glob);
if (@this_imgs) {
if (@this_imgs > 1) {
my $multiframe = cat(map rpic($_), @this_imgs);
my $vidfile = catfile($outdir, "vid-".++$vidcounter.".gif");
$multiframe->write_gif_anim($vidfile, 0, 10);
unlink @this_imgs;
delete @seen_img{@this_imgs}; # may reappear with new content
@this_imgs = $vidfile;
}
$o .= sprintf qq{\n
}, $kw, (splitpath $this_imgs[0])[2];
}
push @thisframe, "Output
\n$o" if $o;
}
$_ = hyperlink($_) for @thisframe;
push @outframes, \@thisframe;
}
PDL::Demos->done($kw);
rmdir $outdir if !glob catfile($outdir, $name_glob);
open my $fh, ">", catfile($destroot, "$kw.html");
$blurb =~ s#\s*\(.*##;
push @titles, [$kw, my $title = "$kw - $blurb"];
print $fh sprintf($html_header, $title),
"$title
\n\n",
join("\n\n
\n", map join("\n", @$_), @outframes), "\n",
$html_footer;
}
if (!$single_demo) {
open my $fh, ">", catfile($destroot, "index.html");
print $fh
$index_header,
(map qq{$_->[1]\n}, @titles),
$index_footer;
}
sub hyperlink {
my ($text) = @_;
$text =~ s#PDL::[a-zA-Z0-9_:]+#$&#g;
$text =~ s#([^"])(https?:\S+)#$1$2#g;
$text;
}