~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to Demos/BAD2_demo.pm.PL

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#
 
2
# Create BAD2_demo.pm
 
3
# - requires both bad-value support and PGPLOT
 
4
#
 
5
 
 
6
use strict;
 
7
 
 
8
use Config;
 
9
use File::Basename qw(&basename &dirname);
 
10
 
 
11
# check for bad value support
 
12
use PDL::Config;
 
13
my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
 
14
 
 
15
# This forces PL files to create target in same directory as PL file.
 
16
# This is so that make depend always knows where to find PL derivatives.
 
17
chdir(dirname($0));
 
18
my $file;
 
19
($file = basename($0)) =~ s/\.PL$//;
 
20
$file =~ s/\.pl$//
 
21
        if ($Config{'osname'} eq 'VMS' or
 
22
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
 
23
open OUT,">$file" or die "Can't create $file: $!";
 
24
 
 
25
if ( $bvalflag ) {
 
26
    print "Extracting $file (WITH bad value support)\n";
 
27
} else {
 
28
    print "Extracting $file (NO bad value support)\n";
 
29
}
 
30
chmod 0644, $file;
 
31
 
 
32
print OUT <<'!NO!SUBS!';
 
33
#
 
34
# Created by BAD2_demo.pm.PL
 
35
#  ** DO NOT EDIT THIS FILE **
 
36
#
 
37
package PDL::Demos::BAD2_demo;
 
38
use PDL;
 
39
use PDL::IO::Misc;
 
40
use PDL::Graphics::PGPLOT;
 
41
 
 
42
use File::Spec;
 
43
 
 
44
PDL::Demos::Routines->import();
 
45
sub comment($);
 
46
sub act($);
 
47
sub output;
 
48
 
 
49
sub run {
 
50
 
 
51
!NO!SUBS!
 
52
 
 
53
    if ( ! $bvalflag ) {
 
54
        print OUT <<'!NO!SUBS!';
 
55
 
 
56
comment q|
 
57
 
 
58
    Your version of PDL has been compiled without support for bad
 
59
    values, hence this demo doesn't do anything.
 
60
 
 
61
|;
 
62
 
 
63
!NO!SUBS!
 
64
 
 
65
} else {
 
66
    print OUT <<'!NO!SUBS!';
 
67
 
 
68
$ENV{PGPLOT_XW_WIDTH}=0.6;
 
69
$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";
 
70
 
 
71
# try and find m51.fits
 
72
$d = File::Spec->catdir( "PDL", "Demos" );
 
73
$m51path = undef;
 
74
foreach my $path ( @INC ) {
 
75
    my $check = File::Spec->catdir( $path, $d );
 
76
    if ( -d $check ) { $m51path = $check; last; }
 
77
}
 
78
barf "Unable to find directory ${m51path} within the perl libraries.\n"
 
79
    unless defined $m51path;
 
80
 
 
81
comment q|
 
82
    This demo is just a bit of eye-candy to show bad values in action,
 
83
    and requires PGPLOT support in PDL. It makes use of the image of
 
84
    m51 kindly provided by the IRAF group at the National Optical and 
 
85
    Astronomical Observatories.
 
86
 
 
87
    It also serves to demonstrate that you often don't need to change
 
88
    your code to handle bad values, as the routines may 'do it' for you.
 
89
    
 
90
|;
 
91
 
 
92
act q|
 
93
 
 
94
    # read in the image ($m51path has been set up by this demo to 
 
95
    # contain the location of the file)
 
96
    $m51 = rfits "$m51path/m51.fits";
 
97
 
 
98
    # display it
 
99
    $just = { JUSTIFY => 1 };
 
100
    imag $m51, $just;
 
101
 
 
102
|;
 
103
 
 
104
act q|
 
105
 
 
106
    # now, let's mask out the central 30 pixels and display it
 
107
    $masked = $m51->setbadif( $m51->rvals({CENTRE=>[128,128]}) < 30 );
 
108
 
 
109
    # since imag auto-scales the output, the bad values are not displayed
 
110
    imag $masked, $just;
 
111
 
 
112
    # compare the statistics of the images
 
113
    # (as $PDL::verbose = 1, stats prints out the answers itself)
 
114
    print "Original:\n"; $m51->stats;
 
115
    print "Masked:\n";   $masked->stats;
 
116
 
 
117
|;
 
118
 
 
119
act q|
 
120
 
 
121
    # let's filter it a little bit
 
122
    use PDL::Image2D;
 
123
    $nb = 9;
 
124
    $filtered = med2d $masked, ones($nb,$nb), { Boundary => 'Truncate' };
 
125
 
 
126
    # this is a model of the diffuse component of m51
 
127
    imag $filtered, $just;
 
128
 
 
129
|;
 
130
 
 
131
act q|
 
132
 
 
133
    # unsharp masking, to bring out the small-scale detail
 
134
    $unsharp = $masked - $filtered;
 
135
 
 
136
    imag $unsharp, $just;
 
137
 
 
138
|;
 
139
 
 
140
act q|
 
141
 
 
142
    # add on some contours showing the large scale structure of the galaxy
 
143
    imag $unsharp, $just;
 
144
    hold;
 
145
    cont $filtered;
 
146
    rel;
 
147
 
 
148
|;
 
149
 
 
150
!NO!SUBS!
 
151
 
 
152
} # if: $bvalflag
 
153
 
 
154
print OUT <<'!NO!SUBS!';
 
155
 
 
156
}
 
157
 
 
158
1;
 
159
 
 
160
!NO!SUBS!
 
161
 
 
162
# end
 
163