File Coverage

blib/lib/PDL/Graphics/Simple.pm
Criterion Covered Total %
statement 128 340 37.6
branch 48 208 23.0
condition 34 145 23.4
subroutine 12 32 37.5
pod 15 15 100.0
total 237 740 32.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PDL::Graphics::Simple - Simple backend-independent plotting for PDL
4              
5             =head1 SYNOPSIS
6              
7             # Simple interface - throw plots up on-screen, ASAP
8             use PDL::Graphics::Simple;
9             imag $a; # Display an image PDL
10             imag $a, 0, 300; # Display with color range
11             line $rrr, $fit; # Plot a line
12              
13             points $rr, $sec; # Plot points
14             hold; # Hold graphics so subsequent calls overplot
15             line $rrr, $fit; # Overplot a line in a contrasting color
16             release; # Release graphics
17              
18             # Object interface - simple plotting, to file or screen
19             $w = pgswin( size=>[8,4], multi=>[2,2] ); # 2x2 plot grid on an 8"x4" window
20             $w = pgswin( size=>[1000,1000,'px'], output=>'plot.png' ); # output to a PNG
21              
22             $w->plot( with=>'points', $rr, $sec, with=>'line', $rrr, $fit,
23             {title=>"Points and fit", xlabel=>"Abscissa", ylabel=>"Ordinate"});
24              
25             =head1 DESCRIPTION
26              
27             PDL can plot through a plethora of external plotting modules. Each
28             module tends to be less widely available than Perl itself, and to
29             require an additional step or two to install. For simple applications
30             ("throw up an image on the screen", or "plot a curve") it is useful to
31             have a subset of all plotting capability available in a backend-independent
32             layer. PDL::Graphics::Simple provides that capability.
33              
34             PDL::Graphics::Simple implements all the functionality used in the
35             PDL::Book examples, with identical syntax. It also generalizes that
36             syntax - you can use ::Simple graphics, with slight syntactical
37             differences, in the same manner that you would use any of the engine
38             modules. See the Examples below for details.
39              
40             The plot you get will always be what you asked for, regardless of
41             which plotting engine you have installed on your system.
42              
43             Only a small subset of PDL's complete graphics functionality is
44             supported -- each individual plotting module has unique advantages and
45             functionality that are beyond what PDL::Graphics::Simple can do. Only
46             2-D plotting is supported. For 3-D plotting, use
47             L or L directly.
48              
49             When plotting to a file, the file output is not guaranteed to be
50             present until the plot object is destroyed (e.g. by being undefed or
51             going out of scope).
52              
53             =head1 STATE OF DEVELOPMENT
54              
55             PDL::Graphics::Simple currently supports most of the
56             planned functionality. It is being released as a beta
57             test to determine if it meets users' needs and gain feedback on
58             the API -- so please give feedback!
59              
60             =head1 SUPPORTED GRAPHICS ENGINES
61              
62             PDL::Graphics::Simple includes support for the following graphics
63             engines. Additional driver modules can be loaded dynamically; see
64             C, below. Each of the engines has unique capabilities and
65             flavor that are not captured in PDL::Graphics::Simple - you are
66             encouraged to look at the individual modules for more capability!
67              
68             =over 3
69              
70             =item * Gnuplot (via PDL::Graphics::Gnuplot)
71              
72             Gnuplot is an extremely richly featured plotting package that offers
73             markup, rich text control, RGB color, and 2-D and 3-D plotting. Its
74             output is publication quality. It is supported on POSIX systems,
75             MacOS, and Microsoft Windows, and is available from most package
76             managers.
77              
78             =item * PGPLOT (via PDL::Graphics::PGPLOT::Window)
79              
80             PGPLOT is venerable and nearly as fully featured as Gnuplot for 2-D
81             plotting. It lacks RGB color output. It does have rich text control,
82             but uses simple plotter fonts that are generated internally. It
83             is supported on MacOS and POSIX, but is not as widely available as
84             Gnuplot.
85              
86             =item * PLplot (via PDL::Graphics::PLplot)
87              
88             PLplot is a moderately full featured plotting package that
89             generates publication quality output with a simple high-level interface.
90             It is supported on MacOS and POSIX.
91              
92             =item * Prima (via PDL::Graphics::Prima)
93              
94             Prima is based around a widget paradigm that enables complex
95             interaction with data in real-time, and it is highly optimized for
96             that application. It is not as mature as the other platforms,
97             particularly for static plot generation to files. This means that
98             PDL::Graphics::Simple does not play to its considerable strengths,
99             although Prima is serviceable and fast in this application. Please
100             run the Prima demo in the perldl shell for a better sample of Prima's
101             capabilities.
102              
103             =back
104              
105             =head1 EXAMPLES
106              
107             PDL::Graphics::Simple can be called using plot-atomic or curve-atomic
108             plotting styles, using a pidgin form of calls to any of the main
109             modules. The examples are divided into Book-like (very simple),
110             PGPLOT-like (curve-atomic), and Gnuplot-like (plot-atomic) cases.
111              
112             There are three main styles of interaction with plot objects that
113             PDL::Graphics::Simple supports, reflective of the pre-existing
114             modules' styles of interaction. You can mix-and-match them to match
115             your particular needs and coding style. Here are examples showing
116             convenient ways to call the code.
117              
118             =head2 First steps (non-object-oriented)
119              
120             For the very simplest actions there are non-object-oriented shortcuts.
121             Here are some examples of simple tasks, including axis labels and plot
122             titles. These non-object-oriented shortcuts are useful for display
123             with the default window size. They make use of a package-global plot
124             object.
125              
126             The non-object interface will keep using the last plot engine you used
127             successfully. On first start, you can specify an engine with the
128             environment variable C. As of 1.011, only that will be tried, but
129             if you didn't specify one, all known engines are tried in alphabetical
130             order until one works.
131              
132             The value of C should be the "shortname" of the
133             engine, currently:
134              
135             =over
136              
137             =item C
138              
139             =item C
140              
141             =item C
142              
143             =item C
144              
145             =back
146              
147             =over 3
148              
149             =item * Load module and create line plots
150              
151             use PDL::Graphics::Simple;
152             $x = xvals(51)/5;
153             $y = $x**3;
154              
155             $y->line;
156             line( $x, $y );
157             line( $x, $y, {title=>"My plot", ylabel=> "Ordinate", xlabel=>"Abscissa"} );
158              
159             =item * Bin plots
160              
161             $y->bins;
162             bins($y, {title=>"Bin plot", xl=>"Bin number", yl=>"Count"} );
163              
164             =item * Point plots
165              
166             $y->points;
167             points($y, {title=>"Points plot"});
168              
169             =item * Logarithmic scaling
170              
171             line( $y, { log=>'y' } ); # semilog
172             line( $y, { log=>'xy' } ); # log-log
173              
174             =item * Image display
175              
176             $im = 10 * sin(rvals(101,101)) / (10 + rvals(101,101));
177             imag $im; # Display image
178             imag $im, 0, 1; # Set lower/upper color range
179              
180             =item * Overlays
181              
182             points($x, $y, {logx=>1});
183             hold;
184             line($x, sqrt($y)*10);
185             release;
186              
187              
188             =item * Justify aspect ratio
189              
190             imag $im, {justify=>1}
191             points($x, $y, {justify=>1});
192              
193             =item * Erase/delete the plot window
194              
195             erase();
196              
197             =back
198              
199             =head2 Simple object-oriented plotting
200              
201             More functionality is accessible through direct use of the PDL::Graphics::Simple
202             object. You can set plot size, direct plots to files, and set up multi-panel plots.
203              
204             The constructor accepts window configuration options that set the plotting
205             environment, including size, driving plot engine, output, and multiple
206             panels in a single window.
207              
208             For interactive/display plots, the plot is rendered immediately, and lasts until
209             the object is destroyed. For file plots, the file is not guaranteed to exist
210             and be correct until the object is destroyed.
211              
212             The basic plotting method is C. C accepts a collection of
213             arguments that describe one or more "curves" (or datasets) to plot,
214             followed by an optional plot option hash that affects the entire plot.
215             Overplotting is implemented via plot option, via a held/released state
216             (as in PGPLOT), and via a convenience method C that causes the
217             current plot to be overplotted on the previous one.
218              
219             Plot style (line/points/bins/etc.) is selected via the C curve option.
220             Several convenience methods exist to create plots in the various styles.
221              
222             =over 3
223              
224             =item * Load module and create basic objects
225              
226             use PDL::Graphics::Simple;
227             $x = xvals(51)/5;
228             $y = $x**3;
229              
230             $win = pgswin(); # plot to a default-shape window
231             $win = pgswin( size=>[4,3] ); # size is given in inches by default
232             $win = pgswin( size=>[10,5,'cm'] ); # You can feed in other units too
233             $win = pgswin( out=>'plot.ps' ); # Plot to a file (type is via suffix)
234             $win = pgswin( engine=>'gnuplot' ); # Pick a particular plotting engine
235             $win = pgswin( multi=>[2,2] ); # Set up for a 2x2 4-panel plot
236              
237             =item * Simple plots with C
238              
239             $win->plot( with=>'line', $x, $y, {title=>"Simple line plot"} );
240             $win->plot( with=>'errorbars', $x, $y, sqrt($y), {title=>"Error bars"} );
241             $win->plot( with=>'circles', $x, $y, sin($x)**2 );
242              
243             =item * Plot overlays
244              
245             # All at once
246             $win->plot( with=>'line', $x, $y, with=>'circles', $x, $y/2, sqrt($y) );
247              
248             # Using oplot (IDL-style; PLplot-style)
249             $win->plot( with=>'line', $x, $y );
250             $win->oplot( with=>'circles', $x, $y/2, sqrt($y) );
251              
252             # Using object state (PGPLOT-style)
253             $win->line( $x, $y );
254             $win->hold;
255             $win->circles( $x, $y/2, sqrt($y) );
256             $win->release;
257              
258             =back
259              
260              
261             =head1 FUNCTIONS
262              
263             =cut
264              
265             package PDL::Graphics::Simple;
266              
267 1     1   6354 use strict;
  1         3  
  1         38  
268 1     1   4 use warnings;
  1         2  
  1         68  
269 1     1   671 use PDL;
  1         320  
  1         6  
270 1     1   244098 use PDL::Options q/iparse/;
  1         2  
  1         110  
271 1     1   13 use File::Temp qw/tempfile tempdir/;
  1         2  
  1         78  
272 1     1   7 use Scalar::Util q/looks_like_number/;
  1         2  
  1         149  
273              
274             our $VERSION = '1.016';
275             $VERSION =~ s/_//g;
276              
277             ##############################
278             # Exporting
279 1     1   8 use base 'Exporter';
  1         2  
  1         9545  
280             our @EXPORT = qw(pgswin line points bins imag cont hold release erase);
281             our @EXPORT_OK = (@EXPORT, qw(image plot));
282              
283             our $API_VERSION = '1.012'; # PGS version where that API started
284              
285             ##############################
286             # Configuration
287              
288             # Knowledge base containing found info about each possible backend
289             our $mods = {};
290             our $mod_abbrevs = undef;
291             our $last_successful_type = undef;
292             our $global_plot = undef;
293              
294             # lifted from PDL::Demos::list
295             sub _list_submods {
296 1     1   4 my @d = @_;
297 1         2 my @found;
298             my %found_already;
299 1         4 foreach my $path ( @INC ) {
300 8 100       300 next if !-d (my $dir = File::Spec->catdir( $path, @d ));
301 3 50       11 my @c = do { opendir my $dirfh, $dir or die "$dir: $!"; grep !/^\./, readdir $dirfh };
  3         150  
  3         215  
302 3   33     471 for my $f (grep /\.pm$/ && -f File::Spec->catfile( $dir, $_ ), @c) {
303 12         40 $f =~ s/\.pm//;
304 12         36 my $found_mod = join "::", @d, $f;
305 12 100       38 next if $found_already{$found_mod}++;
306 4         11 push @found, $found_mod;
307             }
308 3         327 for my $t (grep -d $_->[1], map [$_, File::Spec->catdir( $dir, $_ )], @c) {
309 0         0 my ($subname, $subd) = @$t;
310             # one extra level
311 0 0       0 my @c = do { opendir my $dirfh, $subd or die "$subd: $!"; grep !/^\./, readdir $dirfh };
  0         0  
  0         0  
312 0   0     0 for my $f (grep /\.pm$/ && -f File::Spec->catfile( $subd, $_ ), @c) {
313 0         0 $f =~ s/\.pm//;
314 0         0 my $found_mod = join "::", @d, $subname, $f;
315 0 0       0 next if $found_already{$found_mod}++;
316 0         0 push @found, $found_mod;
317             }
318             }
319             }
320 1         8 @found;
321             }
322              
323             for my $module (_list_submods(qw(PDL Graphics Simple))) {
324             (my $file = $module) =~ s/::/\//g;
325             require "$file.pm";
326             }
327             $mod_abbrevs ||= _make_abbrevs($mods); # Deal with abbreviations.
328              
329             =head2 show
330              
331             =for usage
332              
333             PDL::Graphics::Simple::show
334              
335             =for ref
336              
337             C lists the supported engines and a one-line synopsis of each.
338              
339             =cut
340             sub show {
341 0     0 1 0 my $format = "%-10s %-30s %-s\n";
342 0         0 printf($format, "NAME","Module","(synopsis)");
343 0         0 printf($format, "----","------","----------");
344 0         0 for my $engine( sort keys %$mods ) {
345 0         0 printf($format, $engine, $mods->{$engine}->{engine}, $mods->{$engine}->{synopsis});
346             }
347 0         0 print "\n";
348             }
349              
350             ##############################
351             # Constructor - scan through registered subclasses and generate the correct one.
352              
353             =head2 pgswin - exported constructor
354              
355             =for usage
356              
357             $w = pgswin( %opts );
358              
359             =for ref
360              
361             C is a constructor that is exported by default into the using package. Calling
362             C is exactly the same as calling C<< PDL::Graphics::Simple->new(%opts) >>.
363              
364              
365             =head2 new
366              
367             =for usage
368              
369             $w = PDL::Graphics::Simple->new( %opts );
370              
371             =for ref
372              
373             C is the main constructor for PDL::Graphics::Simple. It accepts a list of options
374             about the type of window you want:
375              
376             =over 3
377              
378             =item engine
379              
380             If specified, this must be one of the supported plotting engines. You
381             can use a module name or the shortened name. If you don't give one,
382             the constructor will try the last one you used, or else scan through
383             existing modules and pick one that seems to work. It will first check
384             the environment variable C, and as of 1.011, only that will be tried, but
385             if you didn't specify one, all known engines are tried in alphabetical
386             order until one works.
387              
388             =item size
389              
390             This is a window size as an ARRAY ref containing [width, height,
391             units]. If no units are specified, the default is "inches". Accepted
392             units are "in","pt","px","mm", and "cm". The conversion used for pixels
393             is 100 px/inch.
394              
395             =item type
396              
397             This describes the kind of plot to create, and should be either "file"
398             or "interactive" - though only the leading character is checked. If
399             you don't specify either C or C (below), the default is
400             "interactive". If you specify only C, the default is "file".
401              
402             =item output
403              
404             This should be a window number or name for interactive plots, or a
405             file name for file plots. The default file name is "plot.png" in the
406             current working directory. Individual plotting modules all support at
407             least '.png', '.pdf', and '.ps' -- via format conversion if necessary.
408             Most other standard file types are supported but are not guaranteed to
409             work.
410              
411             =item multi
412              
413             This enables plotting multiple plots on a single screen. You feed in
414             a single array ref containing (nx, ny). Subsequent calls to plot
415             send graphics to subsequent locations on the window. The ordering
416             is always horizontal first, and left-to-right, top-to-bottom.
417              
418             B for multiplotting: C does not work and will cause an
419             exception. This is a limitation imposed by Gnuplot.
420              
421             =back
422              
423             =cut
424              
425             our $new_defaults = {
426             engine => '',
427             size => [8,6,'in'],
428             type => '',
429             output => '',
430             multi => undef
431             };
432              
433 0     0 1 0 sub pgswin { __PACKAGE__->new(@_) }
434              
435             sub _translate_new {
436 1     1   2099 my $opt_in = shift;
437 1 50       6 $opt_in = {} unless(defined($opt_in));
438 1 50       5 $opt_in = { $opt_in, @_ } if !ref $opt_in;
439 1         6 my $opt = { iparse( $new_defaults, $opt_in ) };
440              
441             ##############################
442             # Pick out a working plot engine...
443 1 50       385 unless ($opt->{engine}) {
444             # find the first working subclass...
445 1 50       5 unless ($last_successful_type) {
446 1   33     14 my @try = $ENV{'PDL_SIMPLE_ENGINE'} || sort keys %$mods;
447 1         3 attempt: for my $engine( @try ) {
448 4         81 print "Trying $engine ($mods->{$engine}->{engine})...";
449 4         11 my $s;
450 4         6 my $a = eval { $mods->{$engine}{module}->can('check')->() };
  4         96  
451 4 50       14 if ($@) {
452 0         0 chomp $@;
453 0         0 $s = "$@";
454             } else {
455 4 50       27 $s = ($a ? "ok" : "nope");
456             }
457 4         103 print $s."\n";
458 4 50       23 if ($a) {
459 0         0 $last_successful_type = $engine;
460 0         0 last attempt;
461             }
462             }
463 1 50       26 barf "Sorry, all known plotting engines failed. Install one and try again"
464             unless $last_successful_type;
465             }
466 0         0 $opt->{engine} = $last_successful_type;
467             }
468              
469 0         0 my $engine = $mod_abbrevs->{lc($opt->{engine})};
470 0 0 0     0 unless(defined($engine) and defined($mods->{$engine})) {
471 0         0 barf "$opt->{engine} is not a known plotting engine. Use PDL::Graphics::Simple::show() for a list";
472             }
473 0         0 $last_successful_type = $opt->{engine};
474              
475 0         0 my $size = _regularize_size($opt->{size},'in');
476              
477 0 0       0 my $type = $ENV{PDL_SIMPLE_OUTPUT} ? 'f' : $opt->{type};
478 0   0     0 my $output = $ENV{PDL_SIMPLE_OUTPUT} || $opt->{output};
479 0 0       0 unless ($type) {
480             # Default to file if output looks like a filename; to interactive otherwise.
481 0 0       0 $type = ( ($output =~ m/\.(\w{2,4})$/) ? 'f' : 'i' );
482             }
483 0 0       0 unless ($type =~ m/^[fi]/i) {
484 0         0 barf "$type is not a known output type (must be 'file' or 'interactive')";
485             }
486              
487             # Default to 'plot.png' if no output is specified.
488 0 0 0     0 $output ||= $type eq 'f' ? "plot.png" : "";
489              
490             # Hammer it into a '.png' if no suffix is specified
491 0 0 0     0 if ( $type =~ m/^f/i and $output !~ m/\.(\w{2,4})$/ ) {
492 0         0 $output .= ".png";
493             }
494              
495             # Error-check multi
496 0 0       0 if( defined($opt->{multi}) ) {
497 0 0 0     0 if( ref($opt->{multi}) ne 'ARRAY' or @{$opt->{multi}} != 2 ) {
  0         0  
498 0         0 barf "PDL::Graphics::Simple::new: 'multi' option requires a 2-element ARRAY ref";
499             }
500 0   0     0 $opt->{multi}[0] ||= 1;
501 0   0     0 $opt->{multi}[1] ||= 1;
502             }
503              
504 0         0 my $params = { size=>$size, type=>$type, output=>$output, multi=>$opt->{multi} };
505 0         0 ($engine, $params);
506             }
507              
508             sub new {
509 0     0 1 0 my $pkg = shift;
510 0         0 my ($engine, $params) = &_translate_new;
511 0         0 my $obj = $mods->{$engine}{module}->new($params);
512 0         0 bless { engine=>$engine, params=>$params, obj=>$obj }, $pkg;
513             }
514              
515             =head2 plot
516              
517             =for usage
518              
519             $w = PDL::Graphics::Simple->new( %opts );
520             $w->plot($data);
521              
522             =for ref
523              
524             C plots zero or more traces of data on a graph. It accepts two kinds of
525             options: plot options that affect the whole plot, and curve options
526             that affect each curve. The arguments are divided into "curve blocks", each
527             of which contains a curve options hash followed by data.
528              
529             If the last argument is a hash ref, it is always treated as plot options.
530             If the first and second arguments are both hash refs, then the first argument
531             is treated as plot options and the second as curve options for the first curve
532             block.
533              
534             =head3 Plot options:
535              
536             =over 3
537              
538             =item oplot
539              
540             If this is set, then the plot overplots a previous plot.
541              
542             =item title
543              
544             If this is set, it is a title for the plot as a whole.
545              
546             =item xlabel
547              
548             If this is set, it is a title for the X axis.
549              
550             =item ylabel
551              
552             If this is set, it is a title for the Y axis.
553              
554             =item xrange
555              
556             If this is set, it is a two-element ARRAY ref containing a range for
557             the X axis. If it is clear, the axis is autoscaled.
558              
559             =item yrange
560              
561             If this is set, it is a two-element ARRAY ref containing a range for
562             the Y axis. If it is clear, the axis is autoscaled.
563              
564             =item logaxis
565              
566             This should be empty, "x", "y", or "xy" (case and order insensitive).
567             Named axes are scaled logarithmically.
568              
569             =item crange
570              
571             If this is set, it is a two-element ARRAY ref containing a range for
572             color values, full black to full white. If it is clear, the engine or
573             plot module is responsible for setting the range.
574              
575             =item wedge
576              
577             If this is set, then image plots get a scientific colorbar on the
578             right side of the plot. (You can also say "colorbar", "colorbox", or "cb" if
579             you're more familiar with Gnuplot).
580              
581             =item justify
582              
583             If this is set to a true value, then the screen aspect ratio is adjusted
584             to keep the Y axis and X axis scales equal -- so circles appear circular, and
585             squares appear square.
586              
587             =item legend (EXPERIMENTAL)
588              
589             The "legend" plot option is intended for full support but it is currently
590             experimental: it is not fully implemented in all the engines, and
591             implementation is more variable than one would like in the engines that
592             do support it.
593              
594             This controls whether and where a plot legend should be placed. If
595             you set it, you supply a combination of 't','b','c','l', and 'r':
596             indicating top, bottom, center, left, right position for the plot
597             legend. For example, 'tl' for top left, 'tc' for center top, 'c' or
598             'cc' for dead center. If left unset, no legend will be plotted. If
599             you set it but don't specify a position (or part of one), it defaults
600             to top and left.
601              
602             If you supply even one 'key' curve option in the curves, legend defaults
603             to the value 'tl' if it isn't specified.
604              
605             =back
606              
607             =head3 Curve options:
608              
609             =over 3
610              
611             =item with
612              
613             This names the type of curve to be plotted. See below for supported curve types.
614              
615             =item key
616              
617             This gives a name for the following curve, to be placed in a master plot legend.
618             If you don't specify a name but do call for a legend, the curve will be named
619             with the plot type and number (e.g. "line 3" or "points 4").
620              
621             =item width
622              
623             This lets you specify the width of the line, as a multiplier on the standard
624             width the engine uses. That lets you pick normal-width or extra-bold lines
625             for any given curve. The option takes a single positive natural number.
626              
627             =item style
628              
629             You can specify the line style in a very limited way -- as a style
630             number supported by the backend. The styles are generally defined by
631             a mix of color and dash pattern, but the particular color and dash
632             pattern depend on the engine in use. The first 30 styles are
633             guaranteed to be distinguishable. This is useful to produce, e.g.,
634             multiple traces with the same style. C<0> is a valid value.
635              
636             =back
637              
638             =head3 Curve types supported
639              
640             =over 3
641              
642             =item points
643              
644             This is a simple point plot. It takes 1 or 2 columns of data.
645              
646             =item lines
647              
648             This is a simple line plot. It takes 1 or 2 columns of data.
649              
650             =item bins
651              
652             Stepwise line plot, with the steps centered on each X value. 1 or 2 columns.
653              
654             =item errorbars
655              
656             Simple points-with-errorbar plot, with centered errorbars. It takes 2
657             or 3 columns, and the last column is the absolute size of the errorbar (which
658             is centered on the data point).
659              
660             =item limitbars
661              
662             Simple points-with-errorbar plot, with asymmetric errorbars. It takes
663             3 or 4 columns, and the last two columns are the absolute low and high
664             values of the errorbar around each point (specified relative to the
665             origin, not relative to the data point value).
666              
667             =item circles
668              
669             Plot unfilled circles. Requires 2 or 3 columns of data; the last
670             column is the radius of each circle. The circles are circular in
671             scientific coordinates, not necessarily in screen coordinates (unless
672             you specify the "justify" plot option).
673              
674             =item image
675              
676             This is a monochrome or RGB image. It takes a 2-D or 3-D array of
677             values, as (width x height x color-index). Images are displayed in
678             a sepiatone color scale that enhances contrast and preserves intensity
679             when converted to grayscale. If you use the convenience routines
680             (C or C), the "justify" plot option defaults to 1 -- so
681             the image will be displayed with square pixel aspect. If you use
682             C<< plot(with=>'image' ...) >>, "justify" defaults to 0 and you will have
683             to set it if you want square pixels.
684              
685             For RGB images, the numerical values need to be in the range 0-255,
686             as they are interpreted as 8 bits per plane colour values. E.g.:
687              
688             $w = pgswin(); # plot to a default-shape window
689             $w->image( pdl(xvals(9,9),yvals(9,9),rvals(9,9))*20 );
690              
691             # or, from an image on disk:
692             $image_data = rpic( 'my-image.png' )->mv(0,-1); # need RGB 3-dim last
693             $w->image( $image_data );
694              
695             If you have a 2-D field of values that you would like to see with a heatmap:
696              
697             use PDL::Graphics::ColorSpace;
698             sub as_heatmap {
699             my ($d) = @_;
700             my $max = $d->max;
701             die "as_heatmap: can't work if max == 0" if $max == 0;
702             $d /= $max; # negative OK
703             my $hue = (1 - $d)*240;
704             $d = cat($hue, pdl(1), pdl(1));
705             (hsv_to_rgb($d->mv(-1,0)) * 255)->byte->mv(0,-1);
706             }
707             $w->image( as_heatmap(rvals 300,300) );
708              
709             =item contours
710              
711             As of 1.012. Draws contours. Takes a 2-D array of values, as (width x
712             height), and optionally a 1-D vector of contour values.
713              
714             =item fits
715              
716             As of 1.012. Displays an image from an ndarray with a FITS header.
717             Uses C etc to make X & Y axes including labels.
718              
719             =item polylines
720              
721             As of 1.012. Draws polylines, with 2 arguments (C<$xy>, C<$pen>).
722             The "pen" has value 0 for the last point in that polyline.
723              
724             use PDL::Transform::Cartography;
725             use PDL::Graphics::Simple qw(pgswin);
726             $coast = earth_coast()->glue( 1, scalar graticule(15,1) );
727             $w = pgswin();
728             $w->plot(with => 'polylines', $coast->clean_lines);
729              
730             =item labels
731              
732             This places text annotations on the plot. It requires three input
733             arguments: the X and Y location(s) as PDLs, and the label(s) as a list
734             ref. The labels are normally left-justified, but you can explicitly
735             set the alignment for each one by beginning the label with "<" for
736             left "|" for center, and ">" for right justification, or a single " "
737             to denote default justification (left).
738              
739             =back
740              
741             =cut
742              
743             # Plot options have a bunch of names for familiarity to different package users.
744             # They're hammered into a single simplified set for transfer to the engines.
745              
746             our $plot_options = PDL::Options->new( {
747             oplot=> 0,
748             title => undef,
749             xlabel=> undef,
750             ylabel=> undef,
751             legend => undef,
752             xrange=> undef,
753             yrange=> undef,
754             logaxis=> "",
755             crange=> undef,
756             bounds=> undef,
757             wedge => 0,
758             justify=>undef,
759             });
760              
761             $plot_options->synonyms( {
762             cbrange=>'crange',
763             replot=>'oplot',
764             xtitle=>'xlabel',
765             ytitle=>'ylabel',
766             key=>'legend',
767             colorbar=>'wedge',
768             colorbox=>'wedge',
769             cb=>'wedge',
770             logscale => 'logaxis',
771             });
772             our $plot_types = {
773             points => { args=>[1,2], ndims=>[1] },
774             polylines => { args=>[1,2], ndims=>[1,2] },
775             lines => { args=>[1,2], ndims=>[1] },
776             bins => { args=>[1,2], ndims=>[1] },
777             circles => { args=>[2,3], ndims=>[1] },
778             errorbars => { args=>[2,3], ndims=>[1] },
779             limitbars => { args=>[3,4], ndims=>[1] },
780             image => { args=>[1,3], ndims=>[2,3] },
781             fits => { args=>[1], ndims=>[2,3] },
782             contours => { args=>[1,2], ndims=>[2] },
783             labels => { args=>[3], ndims=>[1] },
784             };
785             our $plot_type_abbrevs = _make_abbrevs($plot_types);
786              
787             our $curve_options = PDL::Options->new( {
788             with => 'lines',
789             key => undef,
790             style => undef,
791             width => undef
792             });
793             $curve_options->synonyms( {
794             legend =>'key',
795             name=>'key'
796             });
797             $curve_options->incremental(0);
798              
799             sub _fits_convert {
800 0     0   0 my ($data, $opts) = @_;
801 0         0 eval "use PDL::Transform";
802 0 0       0 barf "PDL::Graphics::Simple: couldn't load PDL::Transform for 'with fits' option: $@" if $@;
803 0 0 0     0 barf "PDL::Graphics::Simple: 'with fits' needs an image, RGB triplet, or RGBA quad" unless $data->ndims==2 || ($data->ndims==3 && ($data->dim(2)==4 || $data->dim(2)==3 || $data->dim(2)==1));
      0        
      0        
804 0         0 my $h = $data->gethdr;
805             barf "PDL::Graphics::Simple: 'with fits' expected a FITS header"
806 0 0 0     0 unless $h && ref $h eq 'HASH' && !grep !$h->{$_}, qw(NAXIS NAXIS1 NAXIS2);
      0        
807             # Now update plot options to set the axis labels, if they haven't been updated already...
808 0         0 my %new_opts = %$opts;
809 0         0 for ([qw(xlabel CTYPE1 X CUNIT1 (pixels))],
810             [qw(ylabel CTYPE2 Y CUNIT2 (pixels))],
811             ) {
812 0         0 my ($label, $type, $typel, $unit, $unitdef) = @$_;
813 0 0       0 next if defined $new_opts{$label};
814             $new_opts{$label} = join(" ",
815             $h->{$type} || $typel,
816 0 0 0     0 $h->{$unit} ? "($h->{$unit})" : $unitdef
817             );
818             }
819 0         0 my @dims01 = map $data->dim($_), 0,1;
820 0         0 $data = $data->map(t_identity(), \@dims01, $h); # resample removing rotation etc
821 0         0 my ($xcoords, $ycoords) = ndcoords(@dims01)->apply(t_fits($data->hdr, {ignore_rgb=>1}))->mv(0,-1)->dog;
822 0 0       0 $new_opts{xrange} = [$xcoords->minmax] if !grep defined, @{$new_opts{xrange}};
  0         0  
823 0 0       0 $new_opts{yrange} = [$ycoords->minmax] if !grep defined, @{$new_opts{yrange}};
  0         0  
824 0         0 ('image', \%new_opts, $data, $xcoords, $ycoords);
825             }
826              
827             sub _translate_plot {
828 19     19   511934 my ($held, $keys) = (shift, shift);
829              
830             ##############################
831             # Trap some simple errors
832 19 100       98 barf "plot: requires at least one argument to plot!" if !@_;
833 18 100 66     72 barf "plot: requires at least one argument to plot, in addition to plot options"
834             if @_ == 1 and ref($_[0]) eq 'HASH';
835 17 100       76 barf "Undefined value given in plot args" if grep !defined(), @_;
836              
837             ##############################
838             # Collect plot options. These can be in a leading or trailing
839             # hash ref, with the leading overriding the trailing one. If the first
840             # two elements are hash refs, then the first is plot options and
841             # the second is curve options, otherwise we treat the first as curve options.
842             # A curve option hash is required for every curve.
843 16         31 my $po = {};
844              
845 16         63 while (ref($_[-1]) eq 'HASH') {
846 11         19 my $h = pop;
847 11         61 @$po{keys %$h} = values %$h;
848             }
849              
850 16 50 33     55 if (ref($_[0]) eq 'HASH' and ref($_[1]) eq 'HASH') {
851 0         0 my $h = shift;
852 0         0 @$po{keys %$h} = values %$h;
853             }
854              
855 16         39 my $called_from_imag = delete $po->{called_from_imag};
856              
857 16         80 $po = $plot_options->options($po);
858 16 50       5026 $po->{oplot} = 1 if $held;
859              
860             ##############################
861             # Check the plot options for correctness.
862              
863             ### bounds is a synonym for xrange/yrange together.
864             ### (dcm likes it)
865 16 100       55 if (defined($po->{bounds})) {
866             barf "Bounds option must be a 2-element ARRAY ref containing (xrange, yrange)"
867 3 50 100     34 if !ref($po->{bounds}) or ref($po->{bounds}) ne 'ARRAY' or @{$po->{bounds}} != 2;
  1   66     9  
868 0         0 for my $t ([0,'xrange'], [1, 'yrange']) {
869 0         0 my ($i, $r) = @$t;
870 0 0       0 next if !defined $po->{bounds}[$i];
871             warn "WARNING: bounds overriding $r since both were specified\n"
872 0 0       0 if defined $po->{$r};
873 0         0 $po->{$r} = $po->{bounds}[$i];
874             }
875             }
876              
877 13         54 for my $r (grep defined($po->{$_}), qw(xrange yrange)) {
878             barf "Invalid ".(uc substr $r, 0, 1)." range (must be a 2-element ARRAY ref with differing values)"
879 4         40 if !ref($po->{$r}) or ref($po->{$r}) ne 'ARRAY' or @{$po->{$r}} != 2
880 8 50 100     73 or $po->{$r}[0] == $po->{$r}[1];
      100        
      66        
881             }
882              
883 5 50       17 if( defined($po->{wedge}) ) {
884 5         16 $po->{wedge} = !!$po->{wedge};
885             }
886              
887 5 50       17 if( length($po->{logaxis}) ) {
888 0 0       0 if($po->{logaxis} =~ m/[^xyXY]/) {
889 0         0 barf "logaxis must be X, Y, or XY (case insensitive)";
890             }
891 0         0 $po->{logaxis} =~ tr/XY/xy/;
892 0         0 $po->{logaxis} =~ s/yx/xy/;
893             }
894              
895 5 50       20 unless($po->{oplot}) {
896 5         11 $keys = [];
897             }
898              
899 5 50 33     68 $po->{justify} //= ($called_from_imag ? 1 : 0);
900              
901             ##############################
902             # Parse out curve blocks and check each one for existence.
903 5         10 my @blocks = ();
904 5         15 my $xminmax = [undef,undef];
905 5         26 my $yminmax = [undef,undef];
906              
907 5         55 while( @_ ) {
908 5         12 my $co = {};
909 5         9 my @args = ();
910              
911 5 50       16 if (ref $_[0] eq 'HASH') {
912 0         0 $co = shift;
913             } else {
914             # Attempt to parse out curve option hash entries from an inline hash.
915             # Keys must exist and not be refs and contain at least one letter.
916 5   100     52 while( @_ and !ref($_[0]) and $_[0] =~ m/[a-zA-Z]/ ) {
      66        
917 5         10 my $a = shift;
918 5         9 my $b = shift;
919 5         30 $co->{$a} = $b;
920             }
921             }
922              
923             ##############################
924             # Parse curve options and expand into standard form so we can find "with".
925 5         35 $curve_options->options({key=>undef});
926 5         1284 my %co2 = %{$curve_options->options( $co )};
  5         20  
927              
928 5         1254 my $ptn = $plot_type_abbrevs->{ $co2{with} };
929             barf "Unknown plot type $co2{with}"
930 5 100 66     38 unless defined($ptn) and defined($plot_types->{$ptn});
931              
932 4 50 33     17 if($co2{key} and !defined($po->{legend})) {
933 0         0 $po->{legend} = 'tl';
934             }
935              
936 4 50       16 unless( $ptn eq 'labels' ) {
937 4         8 my $ptns = $ptn;
938 4         20 $ptns=~s/s$//;
939 4   33     43 push @$keys, $co2{key} // sprintf "%s %d",$ptns,1+@$keys;
940             }
941              
942 4         13 my $pt = $plot_types->{$co2{with} = $ptn};
943              
944             ##############################
945             # Snarf up the other arguments.
946              
947 4   33     35 while( @_ and ( UNIVERSAL::isa($_[0], 'PDL') or
      66        
948             looks_like_number($_[0]) or
949             ref $_[0] eq 'ARRAY'
950             )
951             ) {
952 7         25 push @args, shift;
953             }
954              
955             ##############################
956             # Most array refs get immediately converted to
957             # PDLs. But the last argument to a "with=labels" curve
958             # needs to be left as an array ref. If it's a PDL we throw
959             # an error, since that's a common mistake case.
960 4 50       14 if ( $ptn eq 'labels' ) {
961 0 0       0 barf "Last argument to 'labels' plot type must be an array ref!"
962             if ref($args[-1]) ne 'ARRAY';
963 0         0 $_ = PDL->pdl($_) for grep !UNIVERSAL::isa($_,'PDL'), @args[0..$#args-1];
964             } else {
965 4         21 $_ = PDL->pdl($_) for grep !UNIVERSAL::isa($_,'PDL'), @args;
966             }
967              
968             ##############################
969             # Now check options
970 2         17 barf "plot style $ptn requires ".join(" or ", @{$pt->{args}})." columns; you gave ".(0+@args)
971 4 100       9 if !grep @args == $_, @{$pt->{args}};
  4         25  
972              
973 2 50 33     22 if ($ptn eq 'contours' and @args == 1) {
    100 66        
    50          
974 0         0 my $cntr_cnt = 9;
975 0         0 push @args, zeroes($cntr_cnt)->xlinvals($args[-1]->minmax);
976             } elsif ($ptn eq 'polylines' and @args == 1) {
977 1 50       47 barf "Single-arg form of '$ptn' must have dim 0 of 3"
978             if $args[0]->dim(0) != 3;
979 0         0 @args = ($args[0]->slice('0:1'), $args[0]->slice('(2)'));
980             } elsif (defined($pt->{args}[1])) { # Add an index variable if needed
981             barf "First arg to '$ptn' must have at least $pt->{ndims}[0] dims"
982 1 50       15 if $args[0]->ndims < $pt->{ndims}[0];
983 0 0       0 if ( $pt->{args}[1] - @args == 2 ) {
984 0         0 my @dims = ($args[0]->dims)[0,1];
985 0         0 unshift @args, xvals(@dims), yvals(@dims);
986             }
987 0 0       0 if ( $pt->{args}[1] - @args == 1 ) {
988 0         0 unshift @args, xvals($args[0]);
989             }
990             }
991              
992 0 0       0 if ($ptn eq 'contours') { # not supposed to be compatible
    0          
993 0 0 0     0 barf "Wrong dims for contours: need 2-D values, 1-D contour values"
994             unless $args[0]->ndims == 2 and $args[1]->ndims == 1;
995 0         0 ($xminmax, $yminmax) = ([0, $args[0]->dim(0)-1], [0, $args[0]->dim(1)-1]);
996             } elsif ($ptn eq 'polylines') { # not supposed to be compatible
997 0 0 0     0 barf "Wrong dims for contours: need 2-D values, 1-D contour values"
998             unless $args[0]->ndims == 2 and $args[1]->ndims == 1;
999 0         0 ($xminmax, $yminmax) = map [$_->minmax], $args[0]->using(0,1);
1000             } else {
1001             # Check that the PDL arguments all agree in a threading sense.
1002             # Since at least one type of args has an array ref in there, we have to
1003             # consider that case as a pseudo-PDL.
1004 0         0 my $dims = do {
1005 0         0 local $PDL::undefval = 1;
1006 0 0       0 pdl([map [ ref($_) eq 'ARRAY' ? 0+@{$_} : $_->dims ], @args]);
  0         0  
1007             };
1008 0         0 my $dmax = $dims->mv(1,0)->maximum;
1009 0 0       0 barf "Data dimensions do not agree in plot: $dims vs max=$dmax"
1010             unless ( ($dims==1) | ($dims==$dmax) )->all;
1011              
1012             # Check that the number of dimensions is correct...
1013             barf "Data dimension (".$dims->dim(0)."-D PDLs) is not correct for plot type $ptn (all dims=$dims)"
1014             if $dims->dim(0) != $pt->{ndims}[0] and
1015 0 0 0     0 (!defined($pt->{ndims}[1]) or $dims->dim(0) != $pt->{ndims}[1]);
      0        
1016              
1017 0 0       0 if (@args > 1) {
1018             # Accumulate x and y ranges...
1019 0         0 my $dcorner = pdl(0,0);
1020             # Deal with half-pixel offset at edges of images
1021 0 0       0 if ($args[0]->dims > 1) {
1022 0         0 my $xymat = pdl(
1023             [ ($args[0]->slice("(1),(0)")-$args[0]->slice("(0),(0)")),
1024             ($args[0]->slice("(0),(1)")-$args[0]->slice("(0),(0)")) ],
1025             [ ($args[1]->slice("(1),(0)")-$args[1]->slice("(0),(0)")),
1026             ($args[1]->slice("(0),(1)")-$args[1]->slice("(0),(0)")) ]
1027             );
1028 0         0 $dcorner = ($xymat x pdl(0.5,0.5)->slice("*1"))->slice("(0)")->abs;
1029             }
1030 0         0 for my $t ([0, qr/x/, $xminmax], [1, qr/y/, $yminmax]) {
1031 0         0 my ($i, $re, $var) = @$t;
1032 0         0 my @minmax = $args[$i]->minmax;
1033 0         0 $minmax[0] -= $dcorner->at($i);
1034 0         0 $minmax[1] += $dcorner->at($i);
1035 0 0       0 if ($po->{logaxis} =~ $re) {
1036 0 0       0 if ($minmax[1] > 0) {
1037 0 0       0 $minmax[0] = $args[0]->where( ($args[0]>0) )->min if $minmax[0] <= 0;
1038             } else {
1039 0         0 $minmax[0] = $minmax[1] = undef;
1040             }
1041             }
1042 0 0 0     0 $var->[0] = $minmax[0] if defined($minmax[0])
      0        
1043             and ( !defined($var->[0]) or $minmax[0] < $var->[0] );
1044 0 0 0     0 $var->[1] = $minmax[1] if defined($minmax[1])
      0        
1045             and ( !defined($var->[1]) or $minmax[1] > $var->[1] );
1046             }
1047             }
1048             }
1049              
1050             # Push the curve block to the list.
1051 0         0 unshift @args, \%co2;
1052 0         0 push @blocks, \@args;
1053             }
1054              
1055             ##############################
1056             # Deal with context-dependent defaults.
1057              
1058 0         0 for my $t (['xrange',$xminmax], ['yrange',$yminmax]) {
1059 0         0 my ($r, $var) = @$t;
1060 0   0     0 $po->{$r}[0] //= $var->[0];
1061 0   0     0 $po->{$r}[1] //= $var->[1];
1062 0         0 my $defined_range_vals = grep defined, @{$po->{$r}}[0,1];
  0         0  
1063 0 0       0 next if !$defined_range_vals;
1064 0 0       0 barf "got 1 defined value for '$r'" if $defined_range_vals < 2;
1065 0 0       0 if ($po->{$r}[0] == $po->{$r}[1]) {
1066 0         0 $po->{$r}[0] -= 0.5;
1067 0         0 $po->{$r}[1] += 0.5;
1068             }
1069             }
1070              
1071 0         0 for my $t (grep $po->{logaxis} =~ $_->[1], ['xrange', qr/x/], ['yrange', qr/y/]) {
1072 0         0 my ($r) = @$t;
1073             barf "logarithmic ".(uc substr $r, 0, 1)." axis requires positive limits ($r is [$po->{$r}[0],$po->{$r}[1]])"
1074 0 0 0     0 if $po->{$r}[0] <= 0 or $po->{$r}[1] <= 0;
1075             }
1076 0         0 ($keys, $po, @blocks);
1077             }
1078              
1079             sub plot {
1080 0     0 1 0 my $obj = &_invocant_or_global;
1081 0         0 my @args = _translate_plot(@$obj{qw(held keys)}, @_);
1082 0 0 0     0 barf "Can't oplot in multiplot" if $obj->{params}{multi} and $args[1]{oplot};
1083 0         0 $obj->{obj}{keys} = $obj->{keys} = shift @args;
1084 0         0 $obj->{obj}->plot(@args);
1085             }
1086              
1087             =head2 oplot
1088              
1089             =for usage
1090              
1091             $w = PDL::Graphics::Simple->new( %opts );
1092             $w->plot($data);
1093             $w->oplot($more_data);
1094              
1095             =for ref
1096              
1097             C is a convenience interface. It is exactly
1098             equivalent to C except it sets the plot option C,
1099             so that the plot will be overlain on the previous one.
1100              
1101             =cut
1102              
1103             sub oplot {
1104 0 0   0 1 0 push @_, {} if ref($_[-1]) ne 'HASH';
1105 0         0 $_[-1]{oplot} = 1;
1106 0         0 plot(@_);
1107             }
1108              
1109             =head2 line, points, bins, image, imag, cont
1110              
1111             =for usage
1112              
1113             # Object-oriented convenience
1114             $w = PDL::Graphics::Simple->new( % opts );
1115             $w->line($data);
1116              
1117             # Very Lazy Convenience
1118             $a = xvals(50);
1119             lines $a;
1120             $im = sin(rvals(100,100)/3);
1121             imag $im;
1122             imag $im, 0, 1, {title=>"Bullseye?", j=>1};
1123              
1124             =for ref
1125              
1126             C, C, and C are convenience
1127             interfaces. They are exactly equivalent to C except that
1128             they set the default "with" curve option to the appropriate
1129             plot type.
1130              
1131             C is even more DWIMMy for PGPLOT users or PDL Book readers:
1132             it accepts up to three non-hash arguments at the start of the
1133             argument list. The second and third are taken to be values for
1134             the C plot option.
1135              
1136             C resembles the PGPLOT function.
1137              
1138             =cut
1139              
1140             sub _translate_convenience {
1141 0     0   0 my $type = shift;
1142 0         0 my @args = @_;
1143 0 0       0 barf "Not enough args to PDL::Graphics::Simple::$type()" if( @args < 1 );
1144 0 0       0 if( ref($args[0]) eq 'HASH' ) {
1145 0 0       0 if( ref($args[1]) eq 'HASH' ) {
1146 0         0 $args[1]->{with} = $type;
1147             } else {
1148 0         0 $args[0]->{with} = $type;
1149             }
1150             } else {
1151 0         0 unshift(@args, 'with', $type);
1152             }
1153 0         0 @args;
1154             }
1155              
1156             sub _convenience_plot {
1157 0     0   0 my $type = shift;
1158 0         0 my $me = &_invocant_or_global;
1159 0         0 my @args = _translate_plot(@$me{qw(held keys)}, _translate_convenience($type, @_));
1160 0         0 $me->{obj}{keys} = $me->{keys} = shift @args;
1161 0         0 $me->{obj}->plot(@args);
1162             }
1163              
1164 0     0 1 0 sub line { _convenience_plot( 'line', @_ ); }
1165             *PDL::lines = *lines = *PDL::line = \&line;
1166              
1167 0     0 1 0 sub bins { _convenience_plot( 'bins', @_ ); }
1168             *PDL::bins = \&bins;
1169              
1170 0     0 1 0 sub points { _convenience_plot( 'points', @_ ); }
1171             *PDL::points = \&points;
1172              
1173 0     0 1 0 sub image { _convenience_plot( 'image', @_, {called_from_imag=>1}); }
1174             # Don't PDL-namespace image since it's so different from imag.
1175              
1176 0     0 1 0 sub cont { _convenience_plot( 'contours', @_ ); }
1177              
1178             sub _translate_imag {
1179 0     0   0 my $me = &_invocant_or_global;
1180 0         0 my $data = shift;
1181 0         0 my $crange = [];
1182 0 0       0 unless(ref($_[0]) eq 'HASH') {
1183 0         0 $crange->[0] = shift;
1184 0 0       0 unless(ref($_[0]) eq 'HASH') {
1185 0         0 $crange->[1] = shift;
1186             }
1187             }
1188             # Try to put the crange into the plot options, if they are present
1189 0 0       0 unless( ref($_[$#_]) eq 'HASH' ) {
1190 0         0 push @_, {};
1191             }
1192 0         0 $_[$#_]->{crange} = $crange;
1193 0         0 ($me, $data, @_, {called_from_imag=>1});
1194             }
1195              
1196 0     0 1 0 sub imag { _convenience_plot( 'image', &_translate_imag ); }
1197             *PDL::imag = \&imag;
1198              
1199             =head2 erase
1200              
1201             =for usage
1202              
1203             use PDL::Graphics::Simple qw/erase hold release/;
1204             line xvals(10), xvals(10)**2 ;
1205             sleep 5;
1206             erase;
1207              
1208             =for ref
1209              
1210             C removes a global plot window. It should not be called as a method.
1211             To remove a plot window contained in a variable, undefine it.
1212              
1213             =cut
1214              
1215             our $global_object;
1216              
1217             sub erase {
1218 0     0 1 0 my $me = shift;
1219 0 0       0 if(defined($me)) {
1220 0         0 barf "PDL::Graphics::Simple::erase: no arguments, please";
1221             }
1222 0 0       0 if(defined($global_object)) {
1223 0         0 undef $global_object;
1224             }
1225             }
1226              
1227             =head2 hold
1228              
1229             =for usage
1230              
1231             use PDL::Graphics::Simple;
1232             line xvals(10);
1233             hold;
1234             line xvals(10)**0.5;
1235              
1236             =for ref
1237              
1238             Causes subsequent plots to be overplotted on any existing one. Called
1239             as a function with no arguments, C applies to the global object.
1240             Called as an object method, it applies to the object.
1241              
1242             =cut
1243              
1244             sub hold {
1245 0     0 1 0 my $me = shift;
1246 0 0 0     0 if(defined($me) and UNIVERSAL::isa($me,"PDL::Graphics::Simple")) {
    0          
1247 0         0 $me->{held} =1;
1248             } elsif(defined($global_object)) {
1249 0         0 $global_object->{held}=1;
1250             } else {
1251 0         0 barf "Can't hold a nonexistent window!";
1252             }
1253             }
1254              
1255             =head2 release
1256              
1257             =for usage
1258              
1259             use PDL::Graphics::Simple;
1260             line xvals(10);
1261             hold;
1262             line xvals(10)**0.5;
1263             release;
1264             line xvals(10)**0.5;
1265              
1266             =for ref
1267              
1268             Releases a hold placed by C.
1269              
1270             =cut
1271              
1272             sub release {
1273 0     0 1 0 my $me = shift;
1274 0 0 0     0 if(defined($me) and UNIVERSAL::isa($me,"PDL::Graphics::Simple")) {
    0          
1275 0         0 $me->{held} = 0;
1276             } elsif(defined($global_object)) {
1277 0         0 $global_object->{held} = 0;
1278             } else {
1279 0         0 barf "Can't release a nonexistent window!";
1280             }
1281             }
1282              
1283             ##############################
1284             # Utilities.
1285              
1286              
1287             sub _invocant_or_global {
1288 0 0   0   0 return shift if UNIVERSAL::isa($_[0], "PDL::Graphics::Simple");
1289 0 0       0 return $global_object if defined $global_object;
1290 0         0 $global_object = pgswin();
1291             }
1292              
1293              
1294             ### Units table - cheesy but also horrible.
1295             our $units = {
1296             'inch'=>1,
1297             'inc'=>1,
1298             'in' =>1,
1299             'i' => 1,
1300             'char'=>16,
1301             'cha'=>16,
1302             'ch'=>16,
1303             'c'=>16,
1304             'points'=>72,
1305             'point'=>72,
1306             'poin'=>72,
1307             'poi'=>72,
1308             'po'=>72,
1309             'pt'=>72,
1310             'px'=>100,
1311             'pixels'=>100,
1312             'pixel'=>100,
1313             'pixe'=>100,
1314             'pix'=>100,
1315             'pi'=>100,
1316             'p'=>100,
1317             'mm' => 25.4,
1318             'cm' => 2.54
1319             };
1320              
1321             ### regularize_size -- handle the various cases for the size option to new.
1322             sub _regularize_size {
1323 0     0   0 my $size = shift;
1324 0         0 my $unit = shift;
1325              
1326 0         0 $unit =~ tr/A-Z/a-z/;
1327 0 0       0 barf "size specifier unit '$unit' is unrecognized" unless($units->{$unit});
1328              
1329 0 0 0     0 unless(ref($size)) {
1330 0         0 $size = [ $size, $size, 'in' ];
1331             } elsif(ref($size) ne 'ARRAY') {
1332             barf "size option requires an ARRAY ref or scalar";
1333             }
1334 0 0       0 barf "size array must have at least one element" unless(@{$size});
  0         0  
1335 0 0       0 $size->[1] = $size->[0] if(@{$size}==1);
  0         0  
1336 0 0       0 $size->[2] = 'in' if(@{$size}==2);
  0         0  
1337 0 0       0 barf "size array can have at most three elements" if(@{$size}>3);
  0         0  
1338 0 0       0 barf "size array unit '$unit' is unrecognized" unless($units->{$unit});
1339 0 0 0     0 barf "new: size must be nonnegative" unless( $size->[0] > 0 and $size->[1] > 0 );
1340              
1341 0         0 my $ret = [];
1342 0         0 $ret->[0] = $size->[0] / $units->{$size->[2]} * $units->{$unit};
1343 0         0 $ret->[1] = $size->[1] / $units->{$size->[2]} * $units->{$unit};
1344 0         0 $ret->[2] = $unit;
1345 0         0 return $ret;
1346             }
1347              
1348             ##########
1349             # make_abbrevs - generate abbrev hash for module list. Cheesy but fast to code.
1350             sub _make_abbrevs {
1351 2     2   7 my $hash = shift;
1352 2         5 my $abbrevs = {};
1353 2         5 my %ab = ();
1354 2         12 for my $k(keys %$hash) {
1355 15         48 my $s = $k;
1356 15         38 while(length($s)) {
1357 96         204 push @{$ab{$s}},$k;
  96         308  
1358 96         211 chop $s;
1359             }
1360             }
1361 2         22 for my $k(keys %ab) {
1362 88 100       124 $abbrevs->{$k} = $ab{$k}->[0] if( @{$ab{$k}} == 1);
  88         294  
1363             }
1364 2         38 return $abbrevs;
1365             }
1366              
1367             =head2 register
1368              
1369             =for usage
1370              
1371             PDL::Graphics::Simple::register( \%description );
1372              
1373             =for ref
1374              
1375             This is the registration mechanism for new driver methods for
1376             C. Compliant drivers should announce
1377             themselves at compile time by calling C, passing
1378             a hash ref containing the following keys:
1379              
1380             =over
1381              
1382             =item shortname
1383              
1384             This is the short name of the engine, by which users refer to it colloquially.
1385              
1386             =item module
1387              
1388             This is the fully qualified package name of the module itself.
1389              
1390             =item engine
1391              
1392             This is the fully qualified package name of the Perl API for the graphics engine.
1393              
1394             =item synopsis
1395              
1396             This is a brief string describing the backend
1397              
1398             =item pgs_api_version
1399              
1400             This is a one-period version number of PDL::Graphics::Simple against which
1401             the module has been tested. A warning will be thrown if the version isn't the
1402             same as C<$PDL::Graphics::Simple::API_VERSION>.
1403              
1404             That value will only change when the API changes, allowing the modules
1405             to be released independently, rather than with every version of
1406             PDL::Graphics::Simple as up to 1.010.
1407              
1408             =back
1409              
1410             =cut
1411              
1412             sub register {
1413 4     4 1 15 my $mod = shift;
1414 4         12 my $module = $mod->{module};
1415 4 50       24 barf __PACKAGE__."::register: \\%description from ".caller()." looks fishy, no 'module' key found; I give up" unless defined $module;
1416 4         13 for (qw/shortname engine synopsis pgs_api_version/) {
1417             barf __PACKAGE__."::register: \\%description from $module looks fishy, no '$_' key found; I give up"
1418 16 50       53 unless defined $mod->{$_};
1419             }
1420             warn __PACKAGE__."::register: $module is out of date (mod='$mod->{pgs_api_version}' PGS='$API_VERSION') - winging it"
1421 4 50       17 unless $mod->{pgs_api_version} eq $API_VERSION;
1422 4         25 $mods->{$mod->{shortname}} = $mod;
1423             }
1424              
1425              
1426             =head1 IMPLEMENTATION
1427              
1428             PDL::Graphics::Simple defines an object that represents a plotting
1429             window/interface. When you construct the object, you can either
1430             specify a backend or allow PDL::Graphics::Simple to find a backend
1431             that seems to work on your system. Subsequent plotting commands are
1432             translated and passed through to that working plotting module.
1433              
1434             PDL::Graphics::Simple calls are dispatched in a two-step process. The
1435             main module curries the arguments, parsing them into a regularized
1436             form and carrying out DWIM optimizations. The regularized arguments
1437             are passed to implementation classes that translate them into the APIs of their
1438             respective plot engines. The classes are very simple and implement
1439             only a few methods, outlined below. They are intended only to be
1440             called by the PDL::Graphics::Simple driver, which limits the need for
1441             argument processing, currying, and parsing. The classes are thus
1442             responsible only for converting the regularized parameters to plot
1443             calls in the form expected by their corresponding plot modules.
1444              
1445             PDL::Graphics::Simple works through a call-and-dispatch system rather
1446             than taking full advantage of inheritance. That is for two reasons:
1447             (1) it makes central control mildly easier going forward, since calls
1448             are dispatched through the main module; and (2) it makes the
1449             non-object-oriented interface easier to implement since the main
1450             interface modules are in one place and can access the global object
1451             easily.
1452              
1453             =head2 Interface class methods
1454              
1455             Each interface module supports the following methods:
1456              
1457             =cut
1458              
1459             # Note that these are =head3; that means they won't be indexed by PDL::Doc,
1460             # which is a Good Thing as they are internal routines.
1461              
1462             =head3 check
1463              
1464             C attempts to load the relevant engine module and test that it
1465             is working. In addition to returning a boolean value indicating
1466             success if true, it registers its success or failure in
1467             the main $mods hash, under the "ok" flag. If there is a failure that
1468             generates an error message, the error is logged under the "msg" flag.
1469              
1470             C accepts one parameter, "force". If it is missing or false,
1471             and "ok" is defined, check just echoes the prior result. If it is
1472             true, then check actually checks the status regardless of the "ok"
1473             flag.
1474              
1475             =head3 new
1476              
1477             C creates and returns an appropriate plot object, or dies on
1478             failure.
1479              
1480             Each C method should accept the following options, defined as in
1481             the description for PDL::Graphics::Simple::new (above). There is
1482             no need to set default values as all arguments should be set to
1483             reasonable values by the superclass.
1484              
1485             For file output, the method should autodetect file type by dot-suffix.
1486             At least ".png" and ".ps" should be supported.
1487              
1488             Required options: C, C, C, C.
1489              
1490             =head3 plot
1491              
1492             C generates a plot. It should accept a standardized collection
1493             of options as generated by the PDL::Graphics::Simple plot method:
1494             standard plot options as a hash ref, followed by a list of curve
1495             blocks. It should render either a full-sized plot that fills the plot
1496             window or, if the object C option was set on construction, the
1497             current subwindow. For interactive plot types it should act as an
1498             atomic plot operation, displaying the complete plot. For file plot
1499             types the atomicity is not well defined, since multiplot grids may
1500             be problematic, but the plot should be closed as soon as practical.
1501              
1502             The plot options hash contains the plot options listed under C,
1503             above, plus one additional flag - C - that indicates the new
1504             data is to be overplotted on top of whatever is already present in the
1505             plotting window. All options are present in the hash. The C, </td> </tr> <tr> <td class="h" > <a name="1506">1506</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> C<xlabel>, C<ylabel>, and C<legend> options default to undef, which </td> </tr> <tr> <td class="h" > <a name="1507">1507</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> indicates the corresponding plot feature should not be rendered. The </td> </tr> <tr> <td class="h" > <a name="1508">1508</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> C<oplot>, C<xrange>, C<yrange>, C<crange>, C<wedge>, and C<justify> </td> </tr> <tr> <td class="h" > <a name="1509">1509</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> parameters are always both present and defined. </td> </tr> <tr> <td class="h" > <a name="1510">1510</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1511">1511</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If the C<oplot> plot option is set, then the plot should be overlain on </td> </tr> <tr> <td class="h" > <a name="1512">1512</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> a previous plot, not losing any range settings, nor obeying any given. </td> </tr> <tr> <td class="h" > <a name="1513">1513</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> B<NOTE> that if any data given to the original plot or any overplots might </td> </tr> <tr> <td class="h" > <a name="1514">1514</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> be changed before plot updates happen, it is the user's responsibility </td> </tr> <tr> <td class="h" > <a name="1515">1515</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> to pass in copies, since some engines (Prima and Gnuplot) only store </td> </tr> <tr> <td class="h" > <a name="1516">1516</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> data by reference for performance reasons. </td> </tr> <tr> <td class="h" > <a name="1517">1517</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Otherwise the module should display a fresh plot. </td> </tr> <tr> <td class="h" > <a name="1518">1518</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1519">1519</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Each curve block consists of an ARRAY ref with a hash in the 0 element </td> </tr> <tr> <td class="h" > <a name="1520">1520</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> and all required data in the following elements, one PDL per </td> </tr> <tr> <td class="h" > <a name="1521">1521</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (ordinate/abscissa). For 1-D plot types (like points and lines) the </td> </tr> <tr> <td class="h" > <a name="1522">1522</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> PDLs must be 1D. For image plot types the lone PDL must be 2D </td> </tr> <tr> <td class="h" > <a name="1523">1523</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (monochrome) or 3D(RGB). </td> </tr> <tr> <td class="h" > <a name="1524">1524</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1525">1525</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> The hash in the curve block contains the curve options for that </td> </tr> <tr> <td class="h" > <a name="1526">1526</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> particular curve. They are all set to have reasonable default values. </td> </tr> <tr> <td class="h" > <a name="1527">1527</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> The values passed in are C<with> and C<key>. If the C<legend> </td> </tr> <tr> <td class="h" > <a name="1528">1528</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> option is undefined, then the curve should not be placed into a plot </td> </tr> <tr> <td class="h" > <a name="1529">1529</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> legend (if present). </td> </tr> <tr> <td class="h" > <a name="1530">1530</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1531">1531</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 ENVIRONMENT </td> </tr> <tr> <td class="h" > <a name="1532">1532</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1533">1533</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Setting some environment variables affects operation of the module: </td> </tr> <tr> <td class="h" > <a name="1534">1534</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1535">1535</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 PDL_SIMPLE_ENGINE </td> </tr> <tr> <td class="h" > <a name="1536">1536</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1537">1537</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> See L</new>. </td> </tr> <tr> <td class="h" > <a name="1538">1538</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1539">1539</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 PDL_SIMPLE_DEVICE </td> </tr> <tr> <td class="h" > <a name="1540">1540</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1541">1541</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If this is a meaningful thing for the given engine, this value will be </td> </tr> <tr> <td class="h" > <a name="1542">1542</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> used instead of the driver module guessing. </td> </tr> <tr> <td class="h" > <a name="1543">1543</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1544">1544</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 PDL_SIMPLE_OUTPUT </td> </tr> <tr> <td class="h" > <a name="1545">1545</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1546">1546</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Overrides passed-in arguments, to create the given file as output. </td> </tr> <tr> <td class="h" > <a name="1547">1547</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If it contains C<%d>, then with Gnuplot that will be replaced with an </td> </tr> <tr> <td class="h" > <a name="1548">1548</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> increasing number (an amazing L<PDL::Graphics::Gnuplot> feature). </td> </tr> <tr> <td class="h" > <a name="1549">1549</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1550">1550</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 TO-DO </td> </tr> <tr> <td class="h" > <a name="1551">1551</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1552">1552</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Deal with legend generation. In particular: adding legends with multi-call </td> </tr> <tr> <td class="h" > <a name="1553">1553</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> protocols is awkward and leads to many edge cases in the internal protocol. </td> </tr> <tr> <td class="h" > <a name="1554">1554</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This needs more thought. </td> </tr> <tr> <td class="h" > <a name="1555">1555</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1556">1556</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 REPOSITORY </td> </tr> <tr> <td class="h" > <a name="1557">1557</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1558">1558</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> L<https://github.com/PDLPorters/PDL-Graphics-Simple> </td> </tr> <tr> <td class="h" > <a name="1559">1559</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1560">1560</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 AUTHOR </td> </tr> <tr> <td class="h" > <a name="1561">1561</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1562">1562</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Craig DeForest, C<< <craig@deforest.org> >> </td> </tr> <tr> <td class="h" > <a name="1563">1563</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1564">1564</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1565">1565</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 LICENSE AND COPYRIGHT </td> </tr> <tr> <td class="h" > <a name="1566">1566</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1567">1567</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Copyright 2013 Craig DeForest </td> </tr> <tr> <td class="h" > <a name="1568">1568</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1569">1569</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This program is free software; you can redistribute it and/or modify </td> </tr> <tr> <td class="h" > <a name="1570">1570</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> it under the terms of either: the Gnu General Public License v1 as </td> </tr> <tr> <td class="h" > <a name="1571">1571</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> published by the Free Software Foundation; or the Perl Artistic </td> </tr> <tr> <td class="h" > <a name="1572">1572</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> License included with the Perl language. </td> </tr> <tr> <td class="h" > <a name="1573">1573</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1574">1574</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> see http://dev.perl.org/licenses/ for more information. </td> </tr> <tr> <td class="h" > <a name="1575">1575</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1576">1576</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="1577">1577</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1578">1578</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> </table> </body> </html>