The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# Create BAD2_demo.pm
# - requires both bad-value support and PGPLOT
#

use strict;

use Config;
use File::Basename qw(&basename &dirname);
use blib;

# check for bad value support
use lib '../Basic/Core';  # so Config.pm is found during build
use PDL::Config;
my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
my $file;
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";

if ( $bvalflag ) {
    print "Extracting $file (WITH bad value support)\n";
} else {
    print "Extracting $file (NO bad value support)\n";
}
chmod 0644, $file;

print OUT <<'!NO!SUBS!';
#
# Created by BAD2_demo.pm.PL
#  ** DO NOT EDIT THIS FILE **
#
package PDL::Demos::BAD2_demo;
use PDL;
use PDL::IO::Misc;
use PDL::Graphics::PGPLOT;

use File::Spec;

PDL::Demos::Routines->import();
sub comment($);
sub act($);
sub output;

sub run {

!NO!SUBS!

    if ( ! $bvalflag ) {
	print OUT <<'!NO!SUBS!';

comment q|

    Your version of PDL has been compiled without support for bad
    values, hence this demo cannot do anything.

|;

!NO!SUBS!

} else {
    print OUT <<'!NO!SUBS!';

$ENV{PGPLOT_XW_WIDTH}=0.6;
$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";

# try and find m51.fits
$d = File::Spec->catdir( "PDL", "Demos" );
$m51path = undef;
foreach my $path ( @INC ) {
    my $check = File::Spec->catdir( $path, $d );
    if ( -d $check ) { $m51path = $check; last; }
}
barf "Unable to find directory ${m51path} within the perl libraries.\n"
    unless defined $m51path;

comment q|
    This demo is just a bit of eye-candy to show bad values in action,
    and requires PGPLOT support in PDL. It makes use of the image of
    M51 kindly provided by the Hubble Heritage group at the
    Space Telescope Science Institute.

    It also serves to demonstrate that you often don't need to change
    your code to handle bad values, as the routines may 'do it' for you.

|;

act q|

    # read in the image ($m51path has been set up by this demo to
    # contain the location of the file)
    $m51 = rfits "$m51path/m51.fits";

    # display it
    $just = { JUSTIFY => 1 };
    imag $m51, $just;

    # These are used to create the next image
    ( $nx, $ny ) = $m51->dims;
    $centre = [ $nx/2, $ny/2 ];
|;

act q|

    # now, let's mask out the central 40 pixels and display it
    $masked = $m51->setbadif( $m51->rvals({CENTRE=>$centre}) < 40 );

    # since imag auto-scales the output, the bad values are not displayed
    imag $masked, $just;

    # compare the statistics of the images
    # (as $PDL::verbose = 1, stats prints out the answers itself)
    print "Original:\n"; $m51->stats;
    print "Masked:\n";   $masked->stats;

|;

act q|

    # let's filter it a little bit
    use PDL::Image2D;
    $nb = 15;
    $filtered = med2d $masked, ones($nb,$nb), { Boundary => 'Truncate' };

    # this is a model of the diffuse component of M51
    imag $filtered, $just;

|;

act q|

    # unsharp masking, to bring out the small-scale detail
    $unsharp = $masked - $filtered;

    imag $unsharp, $just;

|;

act q|

    # add on some contours showing the large scale structure of the galaxy
    imag $unsharp, $just;
    hold;
    cont $filtered;
    rel;

|;

!NO!SUBS!

} # if: $bvalflag

print OUT <<'!NO!SUBS!';

}

1;

!NO!SUBS!

# end