PDL-Graphics-Simple-1.016/0000755000175000017500000000000014742232265015062 5ustar osboxesosboxesPDL-Graphics-Simple-1.016/META.json0000644000175000017500000000265014742232265016506 0ustar osboxesosboxes{ "abstract" : "Simple backend-independent plotting for PDL", "author" : [ "Craig DeForest " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PDL-Graphics-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "7.12" } }, "runtime" : { "requires" : { "File::Temp" : "0", "PDL" : "2.089", "Time::HiRes" : "0" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/PDLPorters/PDL-Graphics-Simple/issues" }, "homepage" : "https://github.com/PDLPorters/PDL-Graphics-Simple", "repository" : { "type" : "git", "url" : "git://github.com/PDLPorters/PDL-Graphics-Simple.git" } }, "version" : "1.016", "x_serialization_backend" : "JSON::PP version 4.04" } PDL-Graphics-Simple-1.016/README.pod0000644000175000017500000006467514742232135016541 0ustar osboxesosboxes=head1 OVERVIEW PDL::Graphics::Simple is a unified plotting interface for PDL. The main distribution site is CPAN; the development repository is on github.com. =cut =head1 NAME PDL::Graphics::Simple - Simple backend-independent plotting for PDL =head1 SYNOPSIS # Simple interface - throw plots up on-screen, ASAP use PDL::Graphics::Simple; imag $a; # Display an image PDL imag $a, 0, 300; # Display with color range line $rrr, $fit; # Plot a line points $rr, $sec; # Plot points hold; # Hold graphics so subsequent calls overplot line $rrr, $fit; # Overplot a line in a contrasting color release; # Release graphics # Object interface - simple plotting, to file or screen $w = pgswin( size=>[8,4], multi=>[2,2] ); # 2x2 plot grid on an 8"x4" window $w = pgswin( size=>[1000,1000,'px'], output=>'plot.png' ); # output to a PNG $w->plot( with=>'points', $rr, $sec, with=>'line', $rrr, $fit, {title=>"Points and fit", xlabel=>"Abscissa", ylabel=>"Ordinate"}); =head1 DESCRIPTION PDL can plot through a plethora of external plotting modules. Each module tends to be less widely available than Perl itself, and to require an additional step or two to install. For simple applications ("throw up an image on the screen", or "plot a curve") it is useful to have a subset of all plotting capability available in a backend-independent layer. PDL::Graphics::Simple provides that capability. PDL::Graphics::Simple implements all the functionality used in the PDL::Book examples, with identical syntax. It also generalizes that syntax - you can use ::Simple graphics, with slight syntactical differences, in the same manner that you would use any of the engine modules. See the Examples below for details. The plot you get will always be what you asked for, regardless of which plotting engine you have installed on your system. Only a small subset of PDL's complete graphics functionality is supported -- each individual plotting module has unique advantages and functionality that are beyond what PDL::Graphics::Simple can do. Only 2-D plotting is supported. For 3-D plotting, use L or L directly. When plotting to a file, the file output is not guaranteed to be present until the plot object is destroyed (e.g. by being undefed or going out of scope). =head1 STATE OF DEVELOPMENT PDL::Graphics::Simple currently supports most of the planned functionality. It is being released as a beta test to determine if it meets users' needs and gain feedback on the API -- so please give feedback! =head1 SUPPORTED GRAPHICS ENGINES PDL::Graphics::Simple includes support for the following graphics engines. Additional driver modules can be loaded dynamically; see C, below. Each of the engines has unique capabilities and flavor that are not captured in PDL::Graphics::Simple - you are encouraged to look at the individual modules for more capability! =over 3 =item * Gnuplot (via PDL::Graphics::Gnuplot) Gnuplot is an extremely richly featured plotting package that offers markup, rich text control, RGB color, and 2-D and 3-D plotting. Its output is publication quality. It is supported on POSIX systems, MacOS, and Microsoft Windows, and is available from most package managers. =item * PGPLOT (via PDL::Graphics::PGPLOT::Window) PGPLOT is venerable and nearly as fully featured as Gnuplot for 2-D plotting. It lacks RGB color output. It does have rich text control, but uses simple plotter fonts that are generated internally. It is supported on MacOS and POSIX, but is not as widely available as Gnuplot. =item * PLplot (via PDL::Graphics::PLplot) PLplot is a moderately full featured plotting package that generates publication quality output with a simple high-level interface. It is supported on MacOS and POSIX. =item * Prima (via PDL::Graphics::Prima) Prima is based around a widget paradigm that enables complex interaction with data in real-time, and it is highly optimized for that application. It is not as mature as the other platforms, particularly for static plot generation to files. This means that PDL::Graphics::Simple does not play to its considerable strengths, although Prima is serviceable and fast in this application. Please run the Prima demo in the perldl shell for a better sample of Prima's capabilities. =back =head1 EXAMPLES PDL::Graphics::Simple can be called using plot-atomic or curve-atomic plotting styles, using a pidgin form of calls to any of the main modules. The examples are divided into Book-like (very simple), PGPLOT-like (curve-atomic), and Gnuplot-like (plot-atomic) cases. There are three main styles of interaction with plot objects that PDL::Graphics::Simple supports, reflective of the pre-existing modules' styles of interaction. You can mix-and-match them to match your particular needs and coding style. Here are examples showing convenient ways to call the code. =head2 First steps (non-object-oriented) For the very simplest actions there are non-object-oriented shortcuts. Here are some examples of simple tasks, including axis labels and plot titles. These non-object-oriented shortcuts are useful for display with the default window size. They make use of a package-global plot object. The non-object interface will keep using the last plot engine you used successfully. On first start, you can specify an engine with the environment variable C. As of 1.011, only that will be tried, but if you didn't specify one, all known engines are tried in alphabetical order until one works. The value of C should be the "shortname" of the engine, currently: =over =item C =item C =item C =item C =back =over 3 =item * Load module and create line plots use PDL::Graphics::Simple; $x = xvals(51)/5; $y = $x**3; $y->line; line( $x, $y ); line( $x, $y, {title=>"My plot", ylabel=> "Ordinate", xlabel=>"Abscissa"} ); =item * Bin plots $y->bins; bins($y, {title=>"Bin plot", xl=>"Bin number", yl=>"Count"} ); =item * Point plots $y->points; points($y, {title=>"Points plot"}); =item * Logarithmic scaling line( $y, { log=>'y' } ); # semilog line( $y, { log=>'xy' } ); # log-log =item * Image display $im = 10 * sin(rvals(101,101)) / (10 + rvals(101,101)); imag $im; # Display image imag $im, 0, 1; # Set lower/upper color range =item * Overlays points($x, $y, {logx=>1}); hold; line($x, sqrt($y)*10); release; =item * Justify aspect ratio imag $im, {justify=>1} points($x, $y, {justify=>1}); =item * Erase/delete the plot window erase(); =back =head2 Simple object-oriented plotting More functionality is accessible through direct use of the PDL::Graphics::Simple object. You can set plot size, direct plots to files, and set up multi-panel plots. The constructor accepts window configuration options that set the plotting environment, including size, driving plot engine, output, and multiple panels in a single window. For interactive/display plots, the plot is rendered immediately, and lasts until the object is destroyed. For file plots, the file is not guaranteed to exist and be correct until the object is destroyed. The basic plotting method is C. C accepts a collection of arguments that describe one or more "curves" (or datasets) to plot, followed by an optional plot option hash that affects the entire plot. Overplotting is implemented via plot option, via a held/released state (as in PGPLOT), and via a convenience method C that causes the current plot to be overplotted on the previous one. Plot style (line/points/bins/etc.) is selected via the C curve option. Several convenience methods exist to create plots in the various styles. =over 3 =item * Load module and create basic objects use PDL::Graphics::Simple; $x = xvals(51)/5; $y = $x**3; $win = pgswin(); # plot to a default-shape window $win = pgswin( size=>[4,3] ); # size is given in inches by default $win = pgswin( size=>[10,5,'cm'] ); # You can feed in other units too $win = pgswin( out=>'plot.ps' ); # Plot to a file (type is via suffix) $win = pgswin( engine=>'gnuplot' ); # Pick a particular plotting engine $win = pgswin( multi=>[2,2] ); # Set up for a 2x2 4-panel plot =item * Simple plots with C $win->plot( with=>'line', $x, $y, {title=>"Simple line plot"} ); $win->plot( with=>'errorbars', $x, $y, sqrt($y), {title=>"Error bars"} ); $win->plot( with=>'circles', $x, $y, sin($x)**2 ); =item * Plot overlays # All at once $win->plot( with=>'line', $x, $y, with=>'circles', $x, $y/2, sqrt($y) ); # Using oplot (IDL-style; PLplot-style) $win->plot( with=>'line', $x, $y ); $win->oplot( with=>'circles', $x, $y/2, sqrt($y) ); # Using object state (PGPLOT-style) $win->line( $x, $y ); $win->hold; $win->circles( $x, $y/2, sqrt($y) ); $win->release; =back =head1 FUNCTIONS =cut =head2 show =for usage PDL::Graphics::Simple::show =for ref C lists the supported engines and a one-line synopsis of each. =cut =head2 pgswin - exported constructor =for usage $w = pgswin( %opts ); =for ref C is a constructor that is exported by default into the using package. Calling C is exactly the same as calling C<< PDL::Graphics::Simple->new(%opts) >>. =head2 new =for usage $w = PDL::Graphics::Simple->new( %opts ); =for ref C is the main constructor for PDL::Graphics::Simple. It accepts a list of options about the type of window you want: =over 3 =item engine If specified, this must be one of the supported plotting engines. You can use a module name or the shortened name. If you don't give one, the constructor will try the last one you used, or else scan through existing modules and pick one that seems to work. It will first check the environment variable C, and as of 1.011, only that will be tried, but if you didn't specify one, all known engines are tried in alphabetical order until one works. =item size This is a window size as an ARRAY ref containing [width, height, units]. If no units are specified, the default is "inches". Accepted units are "in","pt","px","mm", and "cm". The conversion used for pixels is 100 px/inch. =item type This describes the kind of plot to create, and should be either "file" or "interactive" - though only the leading character is checked. If you don't specify either C or C (below), the default is "interactive". If you specify only C, the default is "file". =item output This should be a window number or name for interactive plots, or a file name for file plots. The default file name is "plot.png" in the current working directory. Individual plotting modules all support at least '.png', '.pdf', and '.ps' -- via format conversion if necessary. Most other standard file types are supported but are not guaranteed to work. =item multi This enables plotting multiple plots on a single screen. You feed in a single array ref containing (nx, ny). Subsequent calls to plot send graphics to subsequent locations on the window. The ordering is always horizontal first, and left-to-right, top-to-bottom. =back =cut =head2 plot =for usage $w = PDL::Graphics::Simple->new( %opts ); $w->plot($data); =for ref C plots zero or more traces of data on a graph. It accepts two kinds of options: plot options that affect the whole plot, and curve options that affect each curve. The arguments are divided into "curve blocks", each of which contains a curve options hash followed by data. If the last argument is a hash ref, it is always treated as plot options. If the first and second arguments are both hash refs, then the first argument is treated as plot options and the second as curve options for the first curve block. =head3 Plot options: =over 3 =item oplot If this is set, then the plot overplots a previous plot. =item title If this is set, it is a title for the plot as a whole. =item xlabel If this is set, it is a title for the X axis. =item ylabel If this is set, it is a title for the Y axis. =item xrange If this is set, it is a two-element ARRAY ref containing a range for the X axis. If it is clear, the axis is autoscaled. =item yrange If this is set, it is a two-element ARRAY ref containing a range for the Y axis. If it is clear, the axis is autoscaled. =item logaxis This should be empty, "x", "y", or "xy" (case and order insensitive). Named axes are scaled logarithmically. =item crange If this is set, it is a two-element ARRAY ref containing a range for color values, full black to full white. If it is clear, the engine or plot module is responsible for setting the range. =item wedge If this is set, then image plots get a scientific colorbar on the right side of the plot. (You can also say "colorbar", "colorbox", or "cb" if you're more familiar with Gnuplot). =item justify If this is set to a true value, then the screen aspect ratio is adjusted to keep the Y axis and X axis scales equal -- so circles appear circular, and squares appear square. =item legend (EXPERIMENTAL) The "legend" plot option is intended for full support but it is currently experimental: it is not fully implemented in all the engines, and implementation is more variable than one would like in the engines that do support it. This controls whether and where a plot legend should be placed. If you set it, you supply a combination of 't','b','c','l', and 'r': indicating top, bottom, center, left, right position for the plot legend. For example, 'tl' for top left, 'tc' for center top, 'c' or 'cc' for dead center. If left unset, no legend will be plotted. If you set it but don't specify a position (or part of one), it defaults to top and left. If you supply even one 'key' curve option in the curves, legend defaults to the value 'tl' if it isn't specified. =back =head3 Curve options: =over 3 =item with This names the type of curve to be plotted. See below for supported curve types. =item key This gives a name for the following curve, to be placed in a master plot legend. If you don't specify a name but do call for a legend, the curve will be named with the plot type and number (e.g. "line 3" or "points 4"). =item width This lets you specify the width of the line, as a multiplier on the standard width the engine uses. That lets you pick normal-width or extra-bold lines for any given curve. The option takes a single positive natural number. =item style You can specify the line style in a very limited way -- as a style number supported by the backend. The styles are generally defined by a mix of color and dash pattern, but the particular color and dash pattern depend on the engine in use. The first 30 styles are guaranteed to be distinguishable. This is useful to produce, e.g., multiple traces with the same style. C<0> is a valid value. =back =head3 Curve types supported =over 3 =item points This is a simple point plot. It takes 1 or 2 columns of data. =item lines This is a simple line plot. It takes 1 or 2 columns of data. =item bins Stepwise line plot, with the steps centered on each X value. 1 or 2 columns. =item errorbars Simple points-with-errorbar plot, with centered errorbars. It takes 2 or 3 columns, and the last column is the absolute size of the errorbar (which is centered on the data point). =item limitbars Simple points-with-errorbar plot, with asymmetric errorbars. It takes 3 or 4 columns, and the last two columns are the absolute low and high values of the errorbar around each point (specified relative to the origin, not relative to the data point value). =item circles Plot unfilled circles. Requires 2 or 3 columns of data; the last column is the radius of each circle. The circles are circular in scientific coordinates, not necessarily in screen coordinates (unless you specify the "justify" plot option). =item image This is a monochrome or RGB image. It takes a 2-D or 3-D array of values, as (width x height x color-index). Images are displayed in a sepiatone color scale that enhances contrast and preserves intensity when converted to grayscale. If you use the convenience routines (C or C), the "justify" plot option defaults to 1 -- so the image will be displayed with square pixel aspect. If you use C<< plot(with=>'image' ...) >>, "justify" defaults to 0 and you will have to set it if you want square pixels. For RGB images, the numerical values need to be in the range 0-255, as they are interpreted as 8 bits per plane colour values. E.g.: $w = pgswin(); # plot to a default-shape window $w->image( pdl(xvals(9,9),yvals(9,9),rvals(9,9))*20 ); # or, from an image on disk: $image_data = rpic( 'my-image.png' )->mv(0,-1); # need RGB 3-dim last $w->image( $image_data ); If you have a 2-D field of values that you would like to see with a heatmap: use PDL::Graphics::ColorSpace; sub as_heatmap { my ($d) = @_; my $max = $d->max; die "as_heatmap: can't work if max == 0" if $max == 0; $d /= $max; # negative OK my $hue = (1 - $d)*240; $d = cat($hue, pdl(1), pdl(1)); (hsv_to_rgb($d->mv(-1,0)) * 255)->byte->mv(0,-1); } $w->image( as_heatmap(rvals 300,300) ); =item contours As of 1.012. Draws contours. Takes a 2-D array of values, as (width x height), and optionally a 1-D vector of contour values. =item fits As of 1.012. Displays an image from an ndarray with a FITS header. Uses C etc to make X & Y axes including labels. =item polylines As of 1.012. Draws polylines, with 2 arguments (C<$xy>, C<$pen>). The "pen" has value 0 for the last point in that polyline. use PDL::Transform::Cartography; use PDL::Graphics::Simple qw(pgswin); $coast = earth_coast()->glue( 1, scalar graticule(15,1) ); $w = pgswin(); $w->plot(with => 'polylines', $coast->clean_lines); =item labels This places text annotations on the plot. It requires three input arguments: the X and Y location(s) as PDLs, and the label(s) as a list ref. The labels are normally left-justified, but you can explicitly set the alignment for each one by beginning the label with "<" for left "|" for center, and ">" for right justification, or a single " " to denote default justification (left). =back =cut =head2 oplot =for usage $w = PDL::Graphics::Simple->new( %opts ); $w->plot($data); $w->oplot($more_data); =for ref C is a convenience interface. It is exactly equivalent to C except it sets the plot option C, so that the plot will be overlain on the previous one. =cut =head2 line, points, image, imag, cont =for usage # Object-oriented convenience $w = PDL::Graphics::Simple->new( % opts ); $w->line($data); # Very Lazy Convenience $a = xvals(50); lines $a; $im = sin(rvals(100,100)/3); imag $im; imag $im, 0, 1, {title=>"Bullseye?", j=>1}; =for ref C, C, and C are convenience interfaces. They are exactly equivalent to C except that they set the default "with" curve option to the appropriate plot type. C is even more DWIMMy for PGPLOT users or PDL Book readers: it accepts up to three non-hash arguments at the start of the argument list. The second and third are taken to be values for the C plot option. C resembles the PGPLOT function. =cut =head2 erase =for usage use PDL::Graphics::Simple qw/erase hold release/; line xvals(10), xvals(10)**2 ; sleep 5; erase; =for ref C removes a global plot window. It should not be called as a method. To remove a plot window contained in a variable, undefine it. =cut =head2 hold =for usage use PDL::Graphics::Simple; line xvals(10); hold; line xvals(10)**0.5; =for ref Causes subsequent plots to be overplotted on any existing one. Called as a function with no arguments, C applies to the global object. Called as an object method, it applies to the object. =cut =head2 release =for usage use PDL::Graphics::Simple; line xvals(10); hold; line xvals(10)**0.5; release; line xvals(10)**0.5; =for ref Releases a hold placed by C. =cut =head2 register =for usage PDL::Graphics::Simple::register( \%description ); =for ref This is the registration mechanism for new driver methods for C. Compliant drivers should announce themselves at compile time by calling C, passing a hash ref containing the following keys: =over =item shortname This is the short name of the engine, by which users refer to it colloquially. =item module This is the fully qualified package name of the module itself. =item engine This is the fully qualified package name of the Perl API for the graphics engine. =item synopsis This is a brief string describing the backend =item pgs_api_version This is a one-period version number of PDL::Graphics::Simple against which the module has been tested. A warning will be thrown if the version isn't the same as C<$PDL::Graphics::Simple::API_VERSION>. That value will only change when the API changes, allowing the modules to be released independently, rather than with every version of PDL::Graphics::Simple as up to 1.010. =back =cut =head1 IMPLEMENTATION PDL::Graphics::Simple defines an object that represents a plotting window/interface. When you construct the object, you can either specify a backend or allow PDL::Graphics::Simple to find a backend that seems to work on your system. Subsequent plotting commands are translated and passed through to that working plotting module. PDL::Graphics::Simple calls are dispatched in a two-step process. The main module curries the arguments, parsing them into a regularized form and carrying out DWIM optimizations. The regularized arguments are passed to implementation classes that translate them into the APIs of their respective plot engines. The classes are very simple and implement only a few methods, outlined below. They are intended only to be called by the PDL::Graphics::Simple driver, which limits the need for argument processing, currying, and parsing. The classes are thus responsible only for converting the regularized parameters to plot calls in the form expected by their corresponding plot modules. PDL::Graphics::Simple works through a call-and-dispatch system rather than taking full advantage of inheritance. That is for two reasons: (1) it makes central control mildly easier going forward, since calls are dispatched through the main module; and (2) it makes the non-object-oriented interface easier to implement since the main interface modules are in one place and can access the global object easily. =head2 Interface class methods Each interface module supports the following methods: =cut =head3 check C attempts to load the relevant engine module and test that it is working. In addition to returning a boolean value indicating success if true, it registers its success or failure in the main $mods hash, under the "ok" flag. If there is a failure that generates an error message, the error is logged under the "msg" flag. C accepts one parameter, "force". If it is missing or false, and "ok" is defined, check just echoes the prior result. If it is true, then check actually checks the status regardless of the "ok" flag. =head3 new C creates and returns an appropriate plot object, or dies on failure. Each C method should accept the following options, defined as in the description for PDL::Graphics::Simple::new (above). There is no need to set default values as all arguments should be set to reasonable values by the superclass. For file output, the method should autodetect file type by dot-suffix. At least ".png" and ".ps" should be supported. Required options: C, C, C, C. =head3 plot C generates a plot. It should accept a standardized collection of options as generated by the PDL::Graphics::Simple plot method: standard plot options as a hash ref, followed by a list of curve blocks. It should render either a full-sized plot that fills the plot window or, if the object C option was set on construction, the current subwindow. For interactive plot types it should act as an atomic plot operation, displaying the complete plot. For file plot types the atomicity is not well defined, since multiplot grids may be problematic, but the plot should be closed as soon as practical. The plot options hash contains the plot options listed under C, above, plus one additional flag - C - that indicates the new data is to be overplotted on top of whatever is already present in the plotting window. All options are present in the hash. The C, C<xlabel>, C<ylabel>, and C<legend> options default to undef, which indicates the corresponding plot feature should not be rendered. The C<oplot>, C<xrange>, C<yrange>, C<crange>, C<wedge>, and C<justify> parameters are always both present and defined. If the C<oplot> plot option is set, then the plot should be overlain on a previous plot - otherwise the module should display a fresh plot. Each curve block consists of an ARRAY ref with a hash in the 0 element and all required data in the following elements, one PDL per (ordinate/abscissa). For 1-D plot types (like points and lines) the PDLs must be 1D. For image plot types the lone PDL must be 2D (monochrome) or 3D(RGB). The hash in the curve block contains the curve options for that particular curve. They are all set to have reasonable default values. The values passed in are C<with> and C<key>. If the C<legend> option is undefined, then the curve should not be placed into a plot legend (if present). =head1 ENVIRONMENT Setting some environment variables affects operation of the module: =head2 PDL_SIMPLE_ENGINE See L</new>. =head2 PDL_SIMPLE_DEVICE If this is a meaningful thing for the given engine, this value will be used instead of the driver module guessing. =head2 PDL_SIMPLE_OUTPUT Overrides passed-in arguments, to create the given file as output. If it contains C<%d>, then with Gnuplot that will be replaced with an increasing number (an amazing L<PDL::Graphics::Gnuplot> feature). =head1 TO-DO Deal with legend generation. In particular: adding legends with multi-call protocols is awkward and leads to many edge cases in the internal protocol. This needs more thought. =head1 REPOSITORY L<https://github.com/PDLPorters/PDL-Graphics-Simple> =head1 AUTHOR Craig DeForest, C<< <craig@deforest.org> >> =head1 LICENSE AND COPYRIGHT Copyright 2013 Craig DeForest This program is free software; you can redistribute it and/or modify it under the terms of either: the Gnu General Public License v1 as published by the Free Software Foundation; or the Perl Artistic License included with the Perl language. see http://dev.perl.org/licenses/ for more information. =cut �������������������������������������������������������������������PDL-Graphics-Simple-1.016/t/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�14742232265�015325� 5����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/t/simple.t����������������������������������������������������������������0000644�0001750�0001750�00000045233�14700643564�017014� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use PDL::Graphics::Simple; use Test::More; use PDL; use PDL::Constants qw(PI); use File::Spec::Functions; my $tests_per_engine = 17; my @engines = $ENV{PDL_SIMPLE_ENGINE} || qw/plplot gnuplot pgplot prima/; my $smoker = ($ENV{'PERL_MM_USE_DEFAULT'} or $ENV{'AUTOMATED_TESTING'}); $ENV{PGPLOT_DEV} ||= '/NULL' if $smoker; sub ask_yn { my ($msg, $label) = @_; return pass $label if $smoker; print STDERR qq{\n\n$msg OK? (Y/n) > }; my $a = <STDIN>; unlike($a, qr/n/i, $label); } # error handling eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'line', undef); }; like $@, qr/Undefined value/i; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'NEVER_USED'); }; like $@, qr/unknown.*NEVER_USED/i; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'image', xvals(8)); }; like $@, qr/at least 2/i; eval { PDL::Graphics::Simple::_translate_plot(undef, undef) }; like $@, qr/at least one argument/; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, {}) }; like $@, qr/at least one argument/; for my $bounds (5, {}, [1..3]) { eval { PDL::Graphics::Simple::_translate_plot(undef, undef, pdl(1), {bounds => $bounds}) }; like $@, qr/must be a 2-element ARRAY/; } for my $bounds (5, {}, [1..3], [1,1]) { eval { PDL::Graphics::Simple::_translate_plot(undef, undef, pdl(1), {xrange => $bounds}) }; like $@, qr/must be a 2-element ARRAY/; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, pdl(1), {yrange => $bounds}) }; like $@, qr/must be a 2-element ARRAY/; } { my @w; local $SIG{__WARN__} = sub {push @w, @_}; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'lines', pdl(1), pdl(1), pdl(1)) }; like $@, qr/requires 1 or 2 columns/; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'fits', pdl(1), pdl(1)) }; like $@, qr/requires 1 columns/; eval { PDL::Graphics::Simple::_translate_plot(undef, undef, with=>'polylines', pdl(1)) }; like $@, qr/Single-arg/; is "@w", "", "no warnings"; } { my @new = eval {PDL::Graphics::Simple::_translate_new()}; if ($@ =~ /Sorry, all known/) { diag(join '',explain $PDL::Graphics::Simple::mods); ok 1, 'No plotting engines installed, stopping'; done_testing; exit 0; } # ignore $engine is_deeply $new[1], { 'multi' => undef, 'output' => '', 'size' => [ 8, 6, 'in' ], 'type' => 'i' } or diag explain \@new; } ############################## # Try the simple engine and convenience interfaces... { my $a = xvals(50); my $sin = sin($a/3); my $type = 'line'; my $me = PDL::Graphics::Simple::_invocant_or_global(); my @args = PDL::Graphics::Simple::_translate_plot(@$me{qw(held keys)}, PDL::Graphics::Simple::_translate_convenience($type, $a, $sin, {xlabel=>"Abscissa", ylabel=>"Ordinate"})); delete $args[1]{yrange}; # so different sin can't cause spurious fails is_deeply \@args, [ [ 'line 1' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => undef, 'wedge' => '', xlabel=>"Abscissa", ylabel=>"Ordinate", 'xrange' => [ 0, 49 ], }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'lines' }, $a, $sin, ] ]; } eval { $a = xvals(50); lines $a sin($a/3), {xlabel=>"Abscissa", ylabel=>"Ordinate"} }; is($@, '', "simple lines plot succeeded"); ok( defined($PDL::Graphics::Simple::global_object), "Global convenience object got spontaneously set" ); ask_yn q{ test> $a = xvals(50); lines $a sin($a/3); You should see a sine wave, X and Y axes labelled: }, "convenience plot OK"; eval { erase }; is($@, '', 'erase worked'); ok(!defined($PDL::Graphics::Simple::global_object), 'erase erased the global object'); eval { PDL::Graphics::Simple::show() }; is($@, ''); my $mods = do { no warnings 'once'; $PDL::Graphics::Simple::mods }; ok( ( defined($mods) and ref $mods eq 'HASH' ) , "module registration hash exists"); # line & bin my $x10 = xvals(10); my $x10sqrt = $x10->sqrt * sqrt(10); my $x10_12 = $x10 * 0.5; my $sin10 = sin($x10)*10; # errorbars my $x37 = xvals(37); my $x37_2 = $x37*2; my $x37sqrd = (xvals(37)/3)**2; my $x90 = xvals(90); my $sin90 = sin($x90*4*PI()/90)*30 + 72; my $x90_2 = $x90/2; my $ones_90 = ones(90)*110; # Image & circles plot my $x11 = xvals(11,11); my $y11 = yvals(11,11); my $r11 = rvals(11,11); my $x15 = xvals(15); my $x15_15 = $x15*1.5; my $sin15 = sin(xvals(15))**2 * 4; my $x500 = xvals(500)+1; my $x5 = xvals(5); # multi my $r9 = rvals(9,9); my $r9minus = -$r9; my $s9 = sequence(9,9); my $xyr9 = pdl(xvals(9,9),yvals(9,9),$r9)*20; my $sqpoly = pdl('1 5; 3 5; 3 3; 1 3; 1 5; 5 5; 7 5; 7 3; 5 3; 5 5'); my $pen = pdl('1 1 1 1 0 1 1 1 1 0'); # Test imag my $x100 = xvals(100,100); my $y100 = yvals(100,100); my $im = 1000 * sin(rvals(100,100)/3) / (rvals(100,100)+30); my $pgplot_ran = 0; for my $engine (@engines) { my $w; my $module; my $mod_hash = $mods->{$engine}; diag("skipping $engine as unregistered"), next if !$mod_hash; # if didn't register ok( ( ref($mod_hash) eq 'HASH' and ($module = $mod_hash->{module}) ), "there is a modules entry for $engine ($module)" ); SKIP: { my $check_ok = eval {$module->can('check')->(1)}; is($@, '', "${module}::check() ran OK"); diag "module '$engine' registration hash: ", explain $mod_hash; unless($check_ok) { diag qq{Skipping $module: $mod_hash->{msg}}; skip "Skipping tests for engine $engine (not working)", $tests_per_engine - 2; } $pgplot_ran ||= $engine eq 'pgplot'; # overplot eval { $w=PDL::Graphics::Simple->new(engine=>$engine); }; is($@, '', "window open OK"); my ($sq1, $p1) = (pdl('-3 1; -1 1; -1 -1; -3 -1; -3 1'), pdl('1 1 1 1 0')); $w->plot(with=>'polylines', $sq1, $p1, {xrange=>[-4,4],yrange=>[-4,4],j=>1}); my $sq2 = pdl('1 1; 3 1; 3 -1; 1 -1; 1 1'); $w->oplot(with=>'polylines', $sq2, $p1); ask_yn qq{Testing $engine engine: You should see 2 squares}, "oplot OK"; eval { $w = PDL::Graphics::Simple->new(engine=>$engine, multi=>[2,2], size=>[6,6]) }; is($@, '', "constructor for $engine worked OK"); isa_ok($w, 'PDL::Graphics::Simple', "constructor for $engine worked OK"); ############################## # FITS plot of Europe my $europe = rfits(catfile(qw(t europe.fits))); eval { $w->plot( with=>'image', $europe, {title=>"PDL: $engine engine, Europe image"}) }; is($@, '', "image plot succeeded"); eval { $w->plot( with=>'fits', $europe, {xrange=>[-20,20], yrange=>[40,80], title=>"Europe FITS", J=>0}) }; is($@, '', "FITS plot succeeded"); ############################## # Image & circles plot { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'image', $x11, $y11, $r11, with=>'circle', $x15, $x15_15, $sin15, {title=>"PDL: $engine engine, image & circle plots (not justified)"}, ); is_deeply \@args, [ [ 'image 1', 'circle 2' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => "PDL: $engine engine, image & circle plots (not justified)", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ '-0.5', 14 ], 'yrange' => [ '-0.5', 21 ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'image' }, $x11, $y11, $r11, ], [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'circles' }, $x15, $x15_15, $sin15, ] ]; } eval { $w->plot(with=>'image', $r11, with=>'circle', $x15, $x15_15, $sin15, {title=>"PDL: $engine engine, image & circle plots (not justified)"} ); }; is($@, '', "plot succeeded\n"); ############################## # Image & circles plot (justified) { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'image', $x11, $y11, $r11, with=>'circle', $x15, $x15_15, $sin15, {title=>"PDL: $engine engine, image & circle plots (not justified)", j=>1}, ); is_deeply \@args, [ [ 'image 1', 'circle 2' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 1, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => "PDL: $engine engine, image & circle plots (not justified)", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ '-0.5', 14 ], 'yrange' => [ '-0.5', 21 ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'image' }, $x11, $y11, $r11, ], [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'circles' }, $x15, $x15_15, $sin15, ] ] or diag explain \@args; } eval { $w->plot(with=>'image', $r11, with=>'circle', $x15, $x15_15, $sin15, {title=>"PDL: $engine engine, image & circle plots (justified)", j=>1} ); }; is($@, '', "justified image and circles plot succeeded"); ask_yn qq{ Testing $engine engine: You should see in a 2x2 grid: 1) an image of Europe rotated by 30 degrees clockwise 2) the same image, but rectified for scientific coordinates so upright again 3) a radial 11x11 "target" image and some superimposed "circles". Since the plot is not justified, the pixels in the target image should be oblong and the "circles" should be ellipses. 4) the same plot as (2), but justified. superimposed "circles". Since the plot is justified, the pixels in the target image should be square and the "circles" should really be circles.}, "plots look OK"; ############################## # Error bars plot { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'errorbars', $x37_2, $x37sqrd, $x37, with=>'limitbars', $x90, $sin90, $x90_2, $ones_90, {title=>"PDL: $engine engine, error (rel.) & limit (abs.) bars"}, ); is_deeply \@args, [ [ 'errorbar 1', 'limitbar 2' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => "PDL: $engine engine, error (rel.) & limit (abs.) bars", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ 0, 89 ], 'yrange' => [ 0, 144 ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'errorbars' }, $x37_2, $x37sqrd, $x37, ], [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'limitbars' }, $x90, $sin90, $x90_2, $ones_90, ] ]; } eval { $w->plot( with=>'errorbars', $x37_2, $x37sqrd, $x37, with=>'limitbars', $sin90, $x90_2, $ones_90, {title=>"PDL: $engine engine, error (rel.) & limit (abs.) bars"} ); }; is($@, '', "errorbar plot succeeded"); ############################## # Simple line & bin plot { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'line', style=>0, $x10, $x10sqrt, with=>'line', style=>0, $x10, $x10_12, with=>'bins', $x10, $sin10, {title=>"PDL: $engine engine, line & bin plots"} ); delete $args[1]{yrange}; # so different sin can't cause spurious fails is_deeply \@args, [ [ 'line 1', 'line 2', 'bin 3' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => "PDL: $engine engine, line & bin plots", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ 0, 9 ], }, [ { 'key' => undef, 'style' => 0, 'width' => undef, 'with' => 'lines' }, $x10, $x10sqrt, ], [ { 'key' => undef, 'style' => 0, 'width' => undef, 'with' => 'lines' }, $x10, $x10_12, ], [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'bins' }, $x10, $sin10, ] ]; } eval { $w->plot(with=>'line', style=>0, $x10, $x10sqrt, with=>'line', style=>0, $x10, $x10_12, with=>'bins', style=>3, $sin10, {title=>"PDL: $engine engine, line & bin plots"}), }; is($@, '', "plot succeeded\n"); ############################## # Text { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'labels', $x5, $x5, ["<left-justified","< left-with-spaces", "|centered","|>start with '>'",">right-justified"], {title=>"PDL: $engine engine, text on graph", yrange=>[-1,5] } ); is_deeply \@args, [ [], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => "PDL: $engine engine, text on graph", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ 0, 4 ], 'yrange' => [ -1, 5 ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'labels' }, $x5, $x5, [ '<left-justified', '< left-with-spaces', '|centered', '|>start with \'>\'', '>right-justified' ] ] ]; } eval { $w->plot(with=>'labels', $x5, $x5, ["<left-justified","< left-with-spaces", "|centered","|>start with '>'",">right-justified"], {title=>"PDL: $engine engine, text on graph", yrange=>[-1,5] } ); }; is($@, '', "labels plot succeeded" ); ############################## # Log scaling { my @args = PDL::Graphics::Simple::_translate_plot(@$w{qw(held keys)}, with=>'line',$x500,$x500,{log=>'y',title=>"PDL: $engine engine, Y=X (semilog)"} ); is_deeply \@args, [ [ 'line 1' ], { 'bounds' => undef, 'crange' => undef, 'justify' => 0, 'legend' => undef, 'logaxis' => 'y', 'oplot' => 0, 'title' => "PDL: $engine engine, Y=X (semilog)", 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ 1, 500 ], 'yrange' => [ 1, 500 ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'lines' }, $x500, $x500, ] ]; } eval { $w->plot(with=>'line',$x500,{log=>'y',title=>"PDL: $engine engine, Y=X (semilog)"}); }; is($@, '', "log scaling succeeded"); ask_yn qq{ Testing $engine engine: You should see in a 2x2 grid: 1) error bars (symmetric relative to each plotted point) and limit bars (asymmetric about each plotted point). 2) 2 superposed line plots with same style and a bin plot with different, with x range from 0 to 9 and yrange from 0 to 9. 3) "left-justified" text left aligned on x=0, "left-with-spaces" just right of x=1, "centered" centered on x=2, ">start with '>'" centered on x=3, and "right-justified" right-aligned on x=4. 4) a simple logarithmically scaled plot, with appropriate title.}, "plots look OK"; ############################## # Multiplot { my @new = PDL::Graphics::Simple::_translate_new(multi=>[2,2]); # ignore $engine is_deeply $new[1], { 'multi' => [2,2], 'output' => '', 'size' => [ 8, 6, 'in' ], 'type' => 'i' } or diag explain \@new; } eval { $w=PDL::Graphics::Simple->new(engine=>$engine, multi=>[2,2]); }; is($@, '', "Multiplot declaration was OK"); $w->image( $r9,{wedge=>1} ); $w->image( $r9minus,{wedge=>1} ); $w->plot(with=>'image', $r9, with=>'contours', $r9, {j=>1}); $w->plot(with=>'image', $xyr9, with=>'polylines', $sqpoly, $pen, {xrange=>[0,8],yrange=>[0,8],j=>1}); ask_yn qq{Testing $engine engine: You should see two bullseyes across the top (one in negative print), a bullseye with contours at bottom left, and an RGB blur (if supported by the engine - otherwise a modified gradient) at bottom right w/2 squares. The top two panels should have colorbar wedges to the right of the image.}, "multiplot OK"; } } # Continue the simple engine and convenience interfaces { my $type = 'image'; my $me = PDL::Graphics::Simple::_invocant_or_global(); my @imag_args = PDL::Graphics::Simple::_translate_imag($me, $im); shift @imag_args; # $me my @args = PDL::Graphics::Simple::_translate_plot(@$me{qw(held keys)}, PDL::Graphics::Simple::_translate_convenience($type, $x100, $y100, @imag_args)); is_deeply \@args, [ [ 'image 1' ], { 'bounds' => undef, 'crange' => [ undef, undef ], 'justify' => 1, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => undef, 'wedge' => '', 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ '-0.5', '99.5' ], 'yrange' => [ '-0.5', '99.5' ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'image' }, $x100, $y100, $im ] ]; } eval { imag $im }; is($@, '', "imag worked with no additional arguments" ); ask_yn q{ test> $im = 1000 * sin(rvals(100,100)/3) / (rvals(100,100)+30); test> imag $im; You should see a bullseye pattern with a brighter inner ring.}, "bullseye OK"; { my $type = 'image'; my $me = PDL::Graphics::Simple::_invocant_or_global(); my @imag_args = PDL::Graphics::Simple::_translate_imag($me, $im, {wedge=>1, title=>"Bullseye!"}); shift @imag_args; # $me my @args = PDL::Graphics::Simple::_translate_plot(@$me{qw(held keys)}, PDL::Graphics::Simple::_translate_convenience($type, $x100, $y100, @imag_args)); is_deeply \@args, [ [ 'image 1' ], { 'bounds' => undef, 'crange' => [], 'justify' => 1, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => 'Bullseye!', 'wedge' => 1, 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ '-0.5', '99.5' ], 'yrange' => [ '-0.5', '99.5' ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'image' }, $x100, $y100, $im ] ] or diag explain \@args; } eval { imag $im, {wedge=>1, title=>"Bullseye!"} }; is($@, '', "imag worked with plot options"); ask_yn q{ test> imag $im, {wedge=>1, title=>"Bullseye!", j=>1}; You should see the same image, but with a colorbar wedge on the right; a title up top; and a justified aspect ratio (circular rings). The color scale may be slightly less contrasty than the last frame, because some engines extend the colorbar wedge to round numbers.}, "justified bullseye and wedge OK"; { my $type = 'image'; my $me = PDL::Graphics::Simple::_invocant_or_global(); my @imag_args = PDL::Graphics::Simple::_translate_imag($me, $im, 0, 30, {wedge=>1, j=>1}); shift @imag_args; # $me my @args = PDL::Graphics::Simple::_translate_plot(@$me{qw(held keys)}, PDL::Graphics::Simple::_translate_convenience($type, $x100, $y100, @imag_args)); is_deeply \@args, [ [ 'image 1' ], { 'bounds' => undef, 'crange' => [0,30], 'justify' => 1, 'legend' => undef, 'logaxis' => '', 'oplot' => 0, 'title' => undef, 'wedge' => 1, 'xlabel' => undef, 'ylabel' => undef, 'xrange' => [ '-0.5', '99.5' ], 'yrange' => [ '-0.5', '99.5' ] }, [ { 'key' => undef, 'style' => undef, 'width' => undef, 'with' => 'image' }, $x100, $y100, $im ] ] or diag explain \@args; } eval { imag $im, 0, 30, {wedge=>1, j=>1} }; is($@, '', "imag worked with bounds"); ask_yn q{ test> imag $im, 0, 30, {wedge=>1, j=>1}; You should see the same image, but with no title and with a tighter dynamic range that cuts off the low values (black rings instead of the fainter parts of the bullseye).}, "crange shortcut is OK"; eval { erase }; is($@, '', "erase executed"); my $extra = $pgplot_ran ? ' (for PGPLOT on X you need to close the X window to continue)' : ''; ask_yn qq{ test> erase The window should have disappeared$extra.}, "erase worked"; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/t/europe.fits�������������������������������������������������������������0000644�0001750�0001750�00000103400�14672430270�017507� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SIMPLE = T / Created with PDL (http://pdl.perl.org) BITPIX = 8 NAXIS = 3 NAXIS1 = 100 NAXIS2 = 100 NAXIS3 = 3 CTYPE3 = 'RGB ' CUNIT1 = 'degrees ' CRVAL3 = 0 CUNIT2 = 'degrees ' CDELT3 = 1 CRPIX3 = 1 COMMENT Plate Carree Projection CROTA2 = 30 CRPIX2 = 50.5 CRPIX1 = 50.5 CRVAL1 = 0 CTYPE2 = 'Latitude' CDELT1 = 0.4 CRVAL2 = 60 CTYPE1 = 'Longitude' CUNIT3 = 'index ' BUNIT = 'Data Value' BLANK = 255 HISTORY Header written by PDL::Transform::Cartography::map HISTORY PDL conversion from raster image CDELT2 = 0.4 END ��� ��� ��O'��JZPEW)��82"(78:F:HNHMK@@3+)-576@B?37DA=>=9DD9-;vi5�����N�  ! %_K@dZG.�/850 8;<KRJJNJ6/&6/14>>6/?FE>6;@JB93@M#$4err>  �� J9F`����XF� ���32HaKC*,/"0*1705FPQXEA38*.7?A?<;<ONC88AB>42=J9� :mim��nvz1� � ��9QS]<<<;I@73#(+&)4TQ<=A:7%14AFHEFBDGHDBG>8BJ8>C.� GC Xr[vB�� ���� (<JZOKA941-4#2*,),-3ORJD?&;4<87EC<:?AKEJCG)@D12;40����(NDacr}v||zH��������*'$'(5D>ML>L6.5@$FDC7*3;;JQEH7B8D@44?974BD7BIO@F5N69>>37��p\c}zmpL� �����0IB=@A@GfHKGE7J'7(KZA,4;LG05GG;;@?2KH8<CIBDHA??EKB?&;++-//5��lpqnlmltxQ,<WaQ475��*YPBXhDGT2CP?%/ccqDC2(%-=>-83:B=A;998CDDEEIJE@?BI1;12074)4- !mvqbgxvx}z}v|ynNB80L� �"MSP<F=>A:<F2)'fhG[=2.98:8&,J>@=F@9:G?COIC?OHGFP??2<<3H=327:1 � ifaowkYqwxeD9D9GBAXiUjSE4|_Yz,J%:UJ)737E2:>@?&<9@>CH63AEB5CIOQ@LIK8+1+-13<1:;;52 ,fxiarqerswf{\QCE78XfDCFJMM3=5.PLixOK@?3$@@>FBB:%51/CHD<4<53<NKMSFAGA@0;7/.3@D@=;::;:Qyyhw~gijxyzFP;9RV33F?048I>B*?,9G36-B2B@@@@:840.67=G56)307?BCHOEDLJ<(32,)/@$A8=>CB5�RwvfmLgrp|w~`HQ8?URZMHCB85:5GA7432:H:?DDB=J@@@>44-,'3:7$<8%108F9GK?C?K5?)/,(.5;;2?@/#$ drwuhbxogi\tr_XRrcIYGESXKIGC>2;23ABH9+583+1,*B<<<@@G9<4,+(9<C92.*418A>JE?)4559H"/:+6>;8, "'Tamgbbjibef\T]aI6BEUSWRRJ>31=?'H?O@;13:86=. 4IFDEE;>//;DIKE8;-+/*%'+6?,+++��� 49B@(. Ub][Tk^cOSl~yHSjFBCNCB32OH9C9/./J=D4@FB>>5/)=G<;MDGNB;60=FHB=:#2517/.4<'-1'���� *8/0+ �+bWF5W\idftwzzdD9 2-*GPBA=6.4=I@D5A@=>;:64;1;@N30,6;%?DGJ:K;=>@1C9202/3)$������� % �� /G9NQoajswGL9+;Q8A;=648;C<<6A;19;>@@@D9DXFE1929DB>LB6>A75A(1-$$ �����  ��<9?QWjf_aczdO8D:���$=?QQB?@:;?IA<DB;B>@>BE=3@=5=@;47B)+OG?BC85B'!��������������� ���� ,MJP_TLP_K<I*������ +<QXOLG?G:7=BINZVJ>;D?=1718$1541.-<;>F?>*7'&������������������������ADNL<IKHF8��������7EQQSMPPJ33@VUZeeT@::>?7<A3.05<8E?:<><G?<D?B���������  ����������������,AIF<=9>6��������$6JQSPLJFSYN@V[KjO32,13MS155F<@@:13:<97;F18 � "��)���������5@FD<6-��������FWYS=<TQf[IYN^UT?.672<TG?;C@FAF<64:9+0��3-5   %������58?;0�������0\a^RJ7AR\SUV`FYX=AENGIJF;@@>;@A:ABC8;� ,>>-#) ����*����� -(�������� ATa^WUD=EQLMZ]d\QDCFA;?<7><97694&=?C-$&#@2($&'! /����� ��������� #=JUONMI8IQ?@SWW`HQ?;8AME:A86894%,49<  .0%.&#%)(&$* ,�������������������&7JFCCHL28=280:OQQ0(-=0A>84<4! 4(.+ . %  !& '$%"'' ��!����������������������� '?CFGL>A=& *Q,:;8('$3D4924 �&#.$(* ��">A*%.1,$���$���������������� FGEA%" A*���� 726 50,7�����%*,2%5&0��+/!+(/2,%" ���������������4GLB/������>/,���&���������:<5021  #:),(02*')  ������������  $<������B>2<5>50#��������;C9:1& "!'4 ��%$$&$"" ������ ������� � �����DF7;FG65)� ���� � -.)-59��+' ' !%"""" ��������� ���������/3987FQdH@?�������  ��$/"���)*'&."+!$%#&""" ���  ��������38AIJMOR[QI �������������$ ('*$!$"""%&�������6,5?AGNQLOQRF:����������������"('#&$%#$(%%%%"!!!.������ %'&#*8CBDINPMMNA(������������� $(((.#'*'*(&0,-#%%%% #$&&%%+.����� ����� ���!*24HHEDJJOH���� ��������#%!/((((($!"3/04(+#%%%%&+--)(((0��� �������� ���� %)5HE>:?PTF � ������ )-,)#-$*((("&(%411701(!$%%%&+230&((()������� ���������(%*,-6B;?NV=;����'05>'6-)-#&(/0&.65266.&&#'&')*0-()((((���������� ���������((7<:?AI2#����������06BH<AA9+.$3)<03<>A2.;;$%(!*++''(($((.����������������!.4@;;O������  9LL_OFO)-2=4<7IO;>GH2*-'-'$+))#'*&0$���������� 3 � ���!+B?=52 ��� �� .=i_M\FC&94FS>3LBCF2.1D.1,980)!42 +D%,������������ //7E>)�����-6001&�������� ~/Exn^`;<AMEI;B;=<95A,0@43117<*5-)7@�����������/;A6<CD=/  ��5;3JI(�������������&@]R5!RuhX>1-8///66>LCfRCBDBOBHNhjV�������������� +:;965:>?37�).39G'���������������MLDa\TPN,0 &*2):MIJ,F:C`kblYVEeS���������������"9>D64;:7:415$-===C3����������������$5D3McmS?),!!!.,!$%*5GEC4E6]_jSOACGlu��������������� &@7<9754$' +:6EH=,#�������� 8;;6./ !1:XDF6:'H8'H������������������ +:?84585, & 54EGB<.6=������������% ����  8 8( @'����������������-*6 12<;  (MRIC=:<�������������������������  �$( !1�������������7�+%��0JM@C3���������������������������������/  ����������������  GS?75&- �����������������������������  ������� ���� ������   %CLAB2#) � ���������������������������������������������� (. &�������������������������������������������   ���� ������ ������������������������������������ &� �������� ��������������������������������� ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ ������������������������������������������������������������������������������������������3( �������������������������������������������������������������������������������������������������������� ��������������������������������������������������������������������������������������������������������������� ���������������������������������������������������������������������������������������������������������������������������������b������������������������������������������������������������ �������������������������������������������������������� ���������������������������������������������������I������������������������������������������������������������������������������������������������������������������.ih���������������� ����������������������������������������������� ��T���������������������������������������������� ������������������8j������������������ �������������������������������� ������������� ������<�oy������������������G^wPn5���������������������������������������������������N�^��������������YETVWf������������������������������������������������ <C Ra�����������%;#kJH=za�������������������������������������������������WO�������c>IzRAJA ������������������������������������������������+ A������:tyIxtHQ:R5+������������� �������������������������������������� �� �����1=XNty_p78E@'������������� ��������������������������������oѱ�����9R>`V~LggX>R ���������������� ����������������������������� F�K��� =DZܳaT_M �����������������������������������������������qL���#>ROVAS@@x �������������������������������������������������K�����Q=SJ3>6�������������������������������������������������T�������3PV0" , �������������������������������������������2a����&)=B� ������� ���������������� ���� L��������� ��������������07h>� �������������������� ������� !������������ ������������� ������;�� ���������������������������������������������������������������������������i����� �������������������� ������������������������������������������� ��������������'� ������ ����������������������������� A2Z$X�� �����A������������������������:ܶ  �� *T"� �A� ,������������������ T'2 ky|�����������������������)Y'��UfTUxPEG6<LMP]QZ]W\]TUHA?CKMLVXUHKVPLMLHSSH<Jm}m^}( ����������R �����' *k[EpnhP.GLIE5NQS`a\^c_KD<LEGJTTLCQUTMEJOYQHBO\%T~kj2��  ?0�?Y���� ��]L����������>AYh^^A*2CH7D>FLFL[dfmZVHM?DMUWURNL_]RGGPQMCALYM���,dde��h|lq&�������������(Gbdm_YUP`XQJ7<@;?HccQRVOL:FJW\^ZYRTWWSQVMGQYGPWC���� IA SkUl7�� ������������ 1J[k^Y]VKEBI9E<@=??B^a^YT;PIQMMZVLJOQ[UYRV8OSCFPIE�����3TE__krmrvrq;���������1/*++:$NL][LZD?9LT8ZVRC<DJJY`TWKWMYUIHQIGDRTGRY^OUD`JOTTHL�����{g`x|}k]ofssC� � �����6VOHJKLVuVYUSEX5K;\lP:?M^V?DVVJJRTG`]JLSYRTXQOOU[QN8QAACEDJ������u{ea\mj{w^]evP'5RcZDI;�.caRfvSXhEQ^M3=qqURA64@RS?GBIQLPJ3NMJSTTUUYZUPORYCOGHFMJ?JB��� qqjYXhtikovmpnsmfOKHBW �#S_`MULMSNQ[C75tvUi,K?=MMOM;@YMOLUOHLYOS_YSO_XWV`ONEQRI^SIHMPG�� �c]TdmqZov~wMdkvgZEGTIUIH`tc{fVBrnA_8HcX7EAESDOSUT;2QKOMRWHGVWRESY_aP\Y[G7BDNTIRGPQQKH� ,ftz[Ptqsb]UeyfkZzo}PZSUGHhqSSW\^]APJCea~bYNMA2OOP[WWO:JFCRWSNIQJGL^[]cVQWQN<OSV[`[ZVSQPPM�<QuuiTdxutlZgzs^lnqL`KIbfCCYQADFZRX@TAN\H4K>P@POOOONMIECKLRYGJ>HELTTSX_UT\ZK2ETUU[jEWNST]XA�V{wnhqelJkpi|oun{r{aJ^HOebj]XSPEENK]WMIHGO]OTWRQLYOOOPIIBA<HNI9QM:FEM[KW[OVO_R[IZZTTUURHVcTA;�hbhogcviajWkiVQPvelP`QUch[YWSNANHIWX^OAJMH@FA?TKKKOOVHPIA@<KKRKGC?IFMVRZUXBQYeotGLTYEKQMSP<EC�-`\fhebgcZba{y|`LbkR@MThcgbbZNNPSU=^UeVQFHOMKRC4CXUSTTJPDDOSXZTGOB@D?:<@JYIKR\O9B!-NPUT>LB=58��Ymh][rccLMezvwyxIRqNKKYPSKF_XIVRNOH`SZJV\XTSJD>R\QM\SV]QJE1BLUWQLI5GJFLDBBLDJRMI*(%&&*,@NFHO@>0<���,lgS@^aia`l{|ywptweM<"AAA_`RTSQKS\_VZKWVSTPOKIPFPU`B?;EM9TVVYIZJLMTFXRKDC@K@>"#.3<1<@77?��<WDYXtagmy|~xLWI &=QlKQNROOW\\RRLWQISPSUUUYNYlUT@MGNYVM[QEMPFGVFORI8;<0+4/;?FQR�IEJX^of\[bweWETL3Wal_RTVUX^hWRZVOVVZSWZRHURJOROILW>@aVNQRGD^SOG4$6=KUO� 8YUWdTLSfSGY<  .S]mi__\XbYX\TTYij_VUYTRFLFL6FJIFCBQOMUNM=Y_XV5$(08-*POYSBPSRSJ  <]cjga]cecNPac\crthXTOSTLPP@=DJQMZTOQPKXPO]gu:"$%%-#" "'�<MOMDFDI< AQ^bc^\_\]gdR]dVycHJFFH\`@DGZQUUOFHOQOVPWK[G)##"B(A30!""0; "HHPPGA5 "XbdaKLg\e^P`Ue^aNBNQEKaVQMWU[V[QKINUTM72' (B4&%+BR/$&" !$*;D�KFJE6��  BjhbZT[^`_UVU^MbcLUX]RXYZPUXVUXVOSILTf*4?;#.BHK<**1(/1!%,;C3@-0$ ���� 4[ehb\Ye_Y[VU^\icZONTJABPLVVUSTUUNUIPJ57TZMHL[B8..-/3952((&&!#',1@:;  ���"0Naag_YX]Zdh[]jc^gM[Y[ROPWR[TTVY[ai\TV<6CN[\RHK711201135>EC47C040*(+.7=A8   5V`e\WV\bSY`ckdbh_XglUc`J_ZVR\[YcznVYQ7KB=I8.$91.0431(18CF,/6A<8-%"")3ZM7   $C[^_`dX^^IAFHqgq~|yck_YXiSJ@Ol^^OQS4+"%%7554/3.HL9489<>@;3%! +048   \][Y;96]I+([vxzawG7-/29Ik[UXJZFO+& #::9?A5"4+5<??>=7&##&28   @X\R; &4  %)dmrRDhWB"**9,KSTPSYR&-'97@O:?07;?7460-1*(%!"",8   *H <mhVYgt}TL-/2! 'CKTW^UG9(37?J3113(1//0-,+" $%,2    !0nm\Y]Z[or_.6$)  )FDBJTY8&97' 3-+.2////14/""""&&+    TZ^YS\^ZNZh@(   <?2///9610:.7-1203,///1@82/''&&45*     2(%T]_b`][]\cqT-*%   &1"(*,4371.,1///25:85.-33>:9 ')4URT[]]^`YZ]a|@.:!     013)/'3120152+2223840475564= +>DRVX]`\SVY]\`dik1+  12229/374764=9:0222285557777;6  #$FW[YSWTTW`bd_;$  !,2581,;333451/0A=>@58,02223435888557  "EX[WX`XTRQU]g6  :A>81:16444/353B?>A8<5.122232/1625554�    2U[a]SR[WQS\N_+  6DHI/?;6:036>?4<C?:>>73304346714565555     #40P\SZe\YR]PR,    !>GKQEIHE8;1A8L@BIFI:6CC'125.7872455155;    .CT\EHZ_VZy?/" !  *=QTgWMX6:?KCLFRWCFOP:252:41854.473+'=1   -PB67(%)PW`\]]`% !  /AofTcMN2FBS\E:UJKN:69L7>9FE=5.B?-8Q29   5IGK\]M:&$CX\IMUN ! $   4J}tdgFDGTLRFJCEDA=I4<OCA??EK7B:6DM     DUbZ]a_YP. 3&-$#[_V_aG &  ,CbV8$Vo`G;9F<77>>FTElbRQSQ^PV[uu]   ?SY[^[ZZZS\AF)6JPQU\9)    #3VRJlk\WV6:+-'12:2CUOP:VIRnyoxeaKiX    ,6QXaUWZXY`_^b"*>KZWTTL/    1:=K9Woz_I15,-.;;.-.4?QMJ@SCiku^_XMKp|   %>^YVY]`aNO' !DTKQPLRE&   5E?A>6)8 (,<DaNODTA[?.Q    BZ`TUX\ZL+,;3JGNOIBMXW    :#!  *B)#B(?(#2K/    ?CP9#JLVV%/&5TXSNEAA        9<*:   �K&95 37NTKP?       �#-B'    '#4T\LCA16  �    "'      .9:OZON?."4 �       )4/.39 )       +!&           :0            &                                    ���       ��      �        0'       ���            �              �   �o �    �/      *        +`      �     "Crn  ��       3^          'R}  �          V~&  Pf}PqE      Y�pȵ  $bGTWZs     "EQi{  4C*rKNEg#     �be.4  o>EvVLWN*        #+?)!V ( ExvAmjBUBaD7         0,  :>S>`oYn:@TN6       $~߹BT8TBnFej^G\%#  '�   J[EDXױ_NbV        u] $(;QR[DWEI       O OAYN6DA    X3MX0! 3          2] (*3-DF�        *&Z        @J}.S        $/$4        >                    r       "(        �     �  0   � �     �I:] -b �(%K �  Fì  9c.�K &5       V-5 o~x>X^`L4Do&)99@3>3853335..8/7C8 ..((3366565)&NI,#(74!KU@@'M $## �  {Z[YI6,1p<.>1JD=#&%0113527766A]D55.(3666883,%;D+.G&1au?%# �("#($ �      #'3:JYT7F4#<Q8-7G5 Fk'.9.FB+YL1F>:3166681.1,H9" ;;10&� )+2   !$  +2%,[Qb!6@L- RfQ}lt6A71=D6"0A@FA:866;8107>?J=" !8AF&  �� *)�  2:65 HF335N5[\LSa`ocE07@BC97'9<?AA?=6<B( (0)B '%&"�  %(#�  � 5=EC715F7J<cA[D*+/Hh?R+$%7;375'11/8;?7-&*$(4:@"5"'�#  '  # $  338??7(}E7NVLGQK4!3MI+TZ4$)/%6GF2%2(#&/0&<!&" %&2$  %" ��� 3,*383'dAIKNG)*)BEYTRR?@FgK++LXG*3;,EFD9J1E +� >>J�� �  � 3.#5H.P=3/&4XcouE<AJOCCJTG?%9 ,%?Q9! AC"6��   !  33 :1+i1"&0"@O^iKHE7X9\mH3"  $BAST.4Y:3T$�0% ��  "  ��� 13 4^[U*$LF2'*$1RYG29*J;WkHC )O*&CR*&� �  $ ���/(Q-576/DVK?7%.SSOF>.<U8_D?8! #' �&! �      �  � 0*-?(2<AR9$+072F:?7J]BGVP55( &#+   "  ��  ,31-#   :9+C1?='=7-042LJ8R<)6$)    �5OPO\\J��>0?N(+<2:/,.41)+)UFBDP% @"$(## �$ �  ! � <O\a]THC��3PldDF<eM0,%<-/1DXBAA?;".�     !#$ ��   � %>]cxzudG')  +=iyuAKBKc@(+5..;HJFC:BD,5# $�!  &  � !  $?JcuvidYBB@4*-BXfW:JH?A50 !">-4;GK\ZK?('&*' %    1 "  $272-AH,N^b`UCDSHKJJE3BETY?166J>3@"(92))2D, '46=:80:<$!$ ' #0BJA19GQV[XRI<J\TRVWOGCKJPI;=1+:HD88+!. $3,$$8HEA@ANR."% !0/$  �  � "6b]UONVZXRMJ?=KOGR\YWTKGENKK?3$$8LB*/!2$6BF:4??Pih?(##$! *.&,:;- ��#EnS_bcTNKIHTTGQVL>?VWXXKGfjOL63#-AH% .!8DHB:/80?MRSH)" )65"'-@(  #(   %DLoribZL@?GBAU_T\o\S<KQSV]_g\OF63*$(;F2(  &(:FA:1/8<=@RF=H&"& '$5/&6!/') )  %*UYWNMe[YT9=.1M>s]RPXPPRJS\^cSG?"9961-6A0 > ((8=:1/58<?@GX?NI#($*).++ 60 ,RWaXH8JP-:9 �  QZXSMT[Ucb^]XIA-�99=B:DJ=3G%!0/1?=33589:?AAPYVR. $&,&1-#   +0N>4/<<.��� (GI@Q]HS[]]]WN>�99;8;GMJ40$"3?@<38;;:<=>FIT\WG !0214#1 .;=('$<d'"CK2�&FBF@.=JQ\[XVE&�9;==8EMLG747E9358;;;=>>@IGPeZ>.+;*?NL>&&$.@C&1& /NkzL/,(RjdDSOFD� �� 4IZZW]`tC=>>>=@GED=;>>5;>>;;;;;>ACDUQ+??8B3@MK@L_uKQ_ezscFD[)3oh\Wob>6$3OTjWV^Q; ��� �D]pk[ah^?A>>>>@DDB>=@@>>>>;;A@<?BE;8I93A^L&A^Wyn{u`^eiXUZev>-)9Eddd^D#�� '���� ��-]utg`eeZP5AA>>>@EE@==>>>>>>>@>=>@C?26BGI2AOR?HHvVWXkoljZVUYghnOM,"$GHgpN��(') 'EkrhWWRNYaZAA>>>>EE@>>>>>>>>>=>AELLFJV*"BINNBDu\(-Btlkg[QNLEQ]__L@' 2ML`a*  ��#<QXUZbaWU]a[AAA>>>@@>>>>>>>>?@CEJMLXS8):8NWXRZLZ@)%%%G_dKmac[PIKLEC>HYa\?,@ 4NN<?@,� �':?I^`[SWZQ;AAA>>>>>>>>>>>>>BCFULJHLO>657GCP`C-+"*VS[jbYKGHFDF=<BS_IA<TLB=>F=>A6%"  .=DOLIDCU;-AAAA>>>>>>>>>>>>DFQNHHJLM@5+.NH7C*+)"'ORLbcXMGFEB==97=JVIID9;LMEBCDI>�� (%,+.73;+AA>>>>>>>>>>>>>@KOPKJLNSJAA8=W9(*" \[`v^NIA>>=;;77:7@JII9:JJ@@GP=0 � � ��>>>>>>>>>>>>>@DFNSPLOMTNVURV[C1)& &Fjd[PHGB=;977;B@8DONE2.1.#'7'  �����>>>>>B>>>>>>FDGV\TJKKKQJXN9UJG7$"&+3^_NNDDDB;977;BFGDJMD;$! ��  ���� >>>>?@>>>>@DGIOWKBKKKKFKT?JcOL;'$$RGQPMNB@>=7;FHFIJKH:+! �      >>;;>><>>>@@KU[QFGJKKKMGGO_iejM9&!""SOONKE@>=>KMLIHKKJG-!�      @>==>=:>>>>?K\VKIFGJOURQWanf]Y7;6&Ba* "4ZbUC@=>=FHMNMJILKKM3- �  �    BA@@A?AA>>>>JRRMJGFO^`\RPOTQMS>GAR^X' !eUjb@>?ABMU[[MLNMIJNA,1%4(!+  &    ��EDCBAAAAA>>>@MXWMIW\DQ@1%/TMViU^djPF$�CpXL=AQTG[[TMNNMLFGG7'**K=+9!$ '    &GGDDCAAAA>>>>OTUIF:-):@#$4CPbW`_Z=' �IhJKOFZYX^MIOLLJILI;2%n*]R@;l!      "CECB@?A>>>>>>@aUF.$;. =PH^[_D$,$AI5QcJ6GLPQMJd\IHHSM@) .B;#;fKCW1  #>$'%0JgK3AB@?>>>>>>>>@FVWE6=3*=,8VBC73-:YhK=4=LHHHMMJD<CPQR=1'7,(}0&+.1  &#"�;HAP=7%D0A@=>>>>>>>@NKHLW@I771)  )/?;)" (HHA;6=FSLHHHGBDB=9EPNB,% !5AL7."!%24%))$,$"AGS<;.(&KSC@B>>>>>@HKLIHHIE@9' $ ��,!+ %94(2KZ`XHHGICHID:@MQ>0.5/' 7)(%'&'/(=63&$&,,P6:*/=2GDA?>>>@EHHGDCEEF?<540 ��=2A@ #  !7XAUVOE;GFDEIHB:AIMG750'*-*5%A<247:.@GE>F81/0(N$A'+&;$HC@=>>>>@IHFDEEGHEB@K#+;O=JT;#3(/=*AJA623@AABCC>>@BHGE5@=+5;:9@B=GSKAAFEBENG@:9E9+7>-2:)'1IMD@=;>>>>KJLGFGJKM[5/L!CDEA8BK<:'-( ELC::;79>>@>>>>>>B;77779LPNLEC?DEAAACBADLJHJB9D;DGB9F79@:7KA;;;;>>>HMONMJJFK\L@,46??<?FARO116-)-G;GJA:406::>>>>>>>=779<<?BESPJE@AAAAAAAADDFACJNDBRZKCD&6:GNQC<;;;;>>=DKOSSJDCBKH=F;BEBC8U^RIC=1'6BLHDBbG;89=3A6>>>>>>>=7;;=>@BFLHC@AAAAAAAADDDD:>CACCB;DC8325DIA?<;;;;;::@HMRKHB@?@BAAAFDDHX`ZPCADA)/O8*1FH?8;A\F;6=>>>>>>>>==>@CFJKC>@BAAAAACEGDDDAAAAACBAAGA84<;=?@=<;;;;;:=DGCBA@>>AA@@@@@GMURLKP>A?I?H>;HC?;8?<<<667=>>>>>>>>BEFIJKI@BDDAA>>EGGEDAA@AAAAAA@?=?;7A?AA@?<;;;;;:;;<;;>BAAAA@>@IIHMXPJF@[UVTRPCA?<<==<;:858:>>>>>>>>@FIJMKFDEDB@>>>>>ECA>@?=<AAA@?=<;@AAAA?=A@=<;;;;;<=?@=AAAAAA@@FJKGKW`JHFADRXLGBAB=>>><876>=>>>>>>>>>>IMK@AAAB@>>>>>>>>>>>><;;>A@?<;;>>AAAA;>A@@=<;;;<?@AAAAAAAAAADFIJGIPROQOG=MLGE=>@>>>>=68=>>>>>>AA@>>>@@>>>>>@>>>>>>>>>>>>>;>>>?=<;>>>>AAA>>>AA@?>><=?AAAAAAAAAAAACFGJHFGGJ\SNKMJFC:>>>>>>>=>>>>>>>A@?=>>>>>>>>>>>>>>>>>>>>>>>>>>>>>;;>>>>>>A>>>>AA>>>>?@A>AAAAAAA?AAAADFHHABEFKOKNOFA<?>>>>>>>>>>>>>>>>=<;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>A<;>>>>A>>@AAAC=>?>AAAAGHHHHHFDEGJFC98:=>>>>>>>>>>A>>>>;;>>>>>>>>>>>>>=8>>>>>>>>>>>>>;;;>>>>>>>>>>>>@=<>>>>>?@CACJKBBB@=AAACHHGCDDDFHEA=;647>889>>>>AAAA>>>>>>>>>>>>>>>>=866=>>>>>>>>>>;;;;;;>>>>>>>>>>>@?<;>>?@BCFGKKKKJHDDAAAAGCAADDDD?A?;@;6359:<>>>>?AAAA>>>>>>>>>>>>>>=96668>>>>>>>>>;;;;;;;>>>>>>>>>>>C@=>?@BCDFHHHKKKJDCB@AAAAAAAADD<;9962@*26<=>>>>@BAAAA>>>>>>>>>>>>=;996666=>>>>>>;;;;;;;;;;>>>>>>>>>>JEBABCDFJHHHHKKHHE@?>AAAAAAAAA@=<5559[S755>>>?@CDFAAAA>>>>>>>>>>>=99996999=>>>;;;;;;;>;;;;>>>>>>>>>ANLBACGJKKKHHHKHHHG>>>>AAAAAAAA@?<<?)12)52;>?@BCFJKCAAA>>>>>>>>>>>>;9999999;>;;;;;;;>>>>;;;;>>>>>>>>BLJA?JKKKKKHKKKHHHH>>>>AAA>AAAAA@?;863676;>@BCDFKKKJAAAA>>>>>>>>>>>>;999999;;;;;;;;>>>>>;;>>>>>>>>>>>IHGJKKKKKKNKKKKHG@>>>>>A>>>AAAA;;;;/278=@DEDFJKKKKKCAAA>>>>D>>>>>>;:9999;:;;;;;;>>>>>>>>>>>>>>>>>>>>HKKKKKKKNNMKKKJ@>>>>>>;;>>>>A;;;;;;:68;=EHHJKKKKKKHGAAAA>DDC>>>>;;;;;9;=;;;;;;;;>>>>>>>>>>>>;>>>>>>MKKKKKKNNMLJIJD@=>>>>;;;;>>>;;;;;;;;;<=ABHKKKKKKKKHHHGAAAACB@?>;;;;;;:;>>>;;;;;<=?>>>>>>>>>>;;>>>>=><KKKKKNMLJIHGAB?<9>>>>;;;;>;;;;;;;;<=?BEEJKKKKKKKKHHHHCA@?@?>>;;;;;;;>>>>>;;;;=?@AA>>>>>>>>;;;;>=6>3KKKKKLJIHGCAA@>;8>>>>;;;;;;;;;;;;<?@AEKKKKKKKKKKKKHGCA@?<;>>>>;;;;>>>>>>>;;<=@AAAA>>>>>>>>;;;=5>6F7aKKKKKKHGCAAAAA=>>>>>>=;;;;;;;;;<=?ACJKKKKKKKKJKKKJCA@?=<;>>>>>;;>>>>>>>;;<=?@AAAAAA>>AA>>>>;DFD7PCaKKKKKJCAAAAAA>>>>>>>76:;;;;;;<=?@AMKKKKKKKKJIGFKJAA?=<;;>>>>>>>>>>>>>>;<=?@AAAAAAAA>A@?>>>@DGJLLFdKKKKJAAAAAAA>>>>>>=99=@;;;;<=?@ACMMKKKKKKKKGFEDCAAA<;;>>>>>>>>>>>>>>;;<?@AAAAAAAAA>>@=<;@DEELOPQ?7KKJCAAAAAA>>>>>>>===@BEE;;<?@AEPNMLIKKHHKKKKDCAAAAAA>>>>>>>>>>>>>>>><=?AAAAAAAAA>>>>=;;>@EEGJQ]M|J@>>AAAA>>>>>>>?@@>@BB>K<=?@@DNUNJIHHHHHKKJCAAAAAAAAA>>>>>>>>>>>A>?@B@AAAAAAAAAAA>>>>;>>>@BFK[KJl>>>>AAAA>>>>>FEDA@@>>>7=;@A<8BJQRHHHHHHHHJAAAAAAAAAAA>>>A>>>>>>AA@BCDAAAAAAAAAAAAA>>?>>>>@?APE`S>>>>>AAAA>>BKHIGD=9.633A452'0>FNOHHHHHHHCAAAAAADDDAAAAAAAA>>>AAAAADDAAAAAAA>>>AAAADC@?>>>>AJOX=A>>>AAAAAA@OQOKIFAA2&a{Hh\08<FGHGHHHHHGFECAADDDDDAADDAAAA>AAAAAAAAAAAAAAAA>>>>AAAACB?>>?@ELUI:M>>AAAAAE<7KMKF@63?q107?*<AEGGGEHKKKJIHGDDDDDDDDDDDDAAAAAAAAAAAAAAAAAAAA>>>>AAAADC@>@CEHS\TU(>?@AAAGXNFJF?:KV:|,[Y/2>EHHGEGKKKKMLKNFDDDDDDCDDDDAAAAAAAA>AAAAAAAAAAAA>AAAAAAA>>?BHINF5WWbAN@BCAAIWf\MD8+>Bj5!44GSEJJJHNNNKKKKNNMIDDDADCB?DDAAAAAAA>>>AAAAAAAAAACJCAAAAA>>?@BDNNV^_rZNU+>CDHMFTekYD6Ywm4yYO 06-CLWcNPLSNNNNKKKKMLJIFA>JB@?>AAAAAAA>>>>>>AAAAAAAAJKKJAAAA>?@BCDZPLH1:5O#N8FIT[WaijC)C9?=T7G-OMAFNJCNMNONNNNKJIGIHGA@NB@>>AAAAAAA>>>>>>>AAAAAACGKKKKCAAAABCDCNWA@BINW]_dcR8?<,T$>?:4^1PQKF9:BKJKLNNHHIGFED>@KJ]3DAAAAAAA>>>>>>>>>>AAACGHILKKKKCAAADA8m:I|KRWVXXTJG('~9,7eC5L[aYD1>EEEGHJHHHHHEDCAAB@@>AAAAAAA>>>>>>>;>>>>ACJKIJLNNKKKJAA<<{GHNQU][F4% 465RYgg^GBFEEEEEHHHHHHHDAAAA;A>>AAAAA==>>>>>@?>=>>>GKLMOMNNNKKKKC>r?=AGPZU-8+5-80NVaZXIGEFFEEEEKHHHHHHHGCAAAB>?@AAAA=>>@>>>ABBBAA@GJMOPQQNNLJKKCC{;>CDNUN?:@2A7O 8WQXN>BCGLKGDKKKKHHHHKJJIAADD?BCDA=<<@@BBAABEFEFIIJMRQQLSMLIHCXx;=BGHPC;4cE]M;BSLNKCDGLQOKKKKKKHHHIMMMLFDDDBDFGAA@AEDHHICEFIQOMMORTUPMOOI@>@CLQ8%%6:Y`WIIPKIGEILMNKKKKKKJKIJLMPNNLDDDDGGEDIHIHJMNRJGIOPNNPSTRNJEFK>>AFBCWPt"D$OPD=GMGEEGMNNMKKKKKFJMLMNNNMLJFDFFDDEHLMOJNRSVPTLRFLMPKRKJKTFCMKFKC?*:$?H=@FPNHGIKHNMJIKKMNGKNQNNNMJIHHJHDAHLOTUUQTVTPMFQBUJKKKKJM@MBCQHA<$6)=uYPNJMMGKHHHLJHGGILMILOKKMLJIHHHIFFGLTUVXVTWQPMKIIHKKKKKKM@CHJD?:6ILHNMLJHKJLHHHHH@>AIILMKKJIJIHHHIJLKNNWVVSOSUSNLIHERKJIGKKF?BADAADUFFIKJIHEFHIHHHG@>@BEIJKIIGFEHHHHLMNNY_YUOJFHSPFACCGDIGFEF2)@>BREHLNMKC@HHD:FHGEHCAA@CDDJIGEFEDCGHHHNNPSLPRKGGEGKF;7<,??BE@>WG?OLOJJ@>B>AVT=K:JKSMAAAADAACEEGJCAACHHHHHLNLHGEEGGHH=#9ma5IJ1N}<?BYIQJE0WR>6YOWLQDUCAAAAAAAFIJFAAAAGHHHHIIHEEGGHGEC:^FF>CITEE4LdV)>8>B^xRQLAFD?AAAEBGCOAAA=HHHHIIGEGHHGCBC|E-b;3����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/META.yml������������������������������������������������������������������0000644�0001750�0001750�00000001522�14742232265�016333� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'Simple backend-independent plotting for PDL' author: - 'Craig DeForest <craig@deforest.org>' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '7.12' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PDL-Graphics-Simple no_index: directory: - t - inc requires: File::Temp: '0' PDL: '2.089' Time::HiRes: '0' resources: bugtracker: https://github.com/PDLPorters/PDL-Graphics-Simple/issues homepage: https://github.com/PDLPorters/PDL-Graphics-Simple repository: git://github.com/PDLPorters/PDL-Graphics-Simple.git version: '1.016' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/Changes�������������������������������������������������������������������0000644�0001750�0001750�00000003100�14742232214�016341� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1.016 2025-01-16 - fix licence 1.015 2024-10-28 - tests report versions of underlying graphics engines 1.014 2024-10-25 - exception when oplot in multiplot mode - oplot now leaves {x,y}range alone 1.013 2024-09-24 - adjust tests to avoid spurious "UNKNOWN" results 1.012 2024-09-21 - add "contours", "fits", "polylines" plot types 1.011 2024-04-22 - P{GPLOT,Lplot} to read devices using proper API not subprocesses - if PDL_SIMPLE_ENGINE in ENV, use ONLY that if engine unspecified - each driver module now publishes which $P:G:S::API_VERSION it conforms to - PGS::register takes hashref instead of magic var in driver namespace - loading driver module not eval-ed - PDL_SIMPLE_DEVICE in env replaces driver guessing - PDL_SIMPLE_OUTPUT in env overrides input parameters 1.010 2024-03-24 - fix PGPLOT to read devices correctly 1.009 2023-01-28 - Prima driver now working again - thanks @dk 1.008 2022-12-29 - fix precedence error in PDL::Graphics::Simple::PGPLOT 1.007 2021-08-17 - tests will skip_all if no engines installed to minimise false negatives 1.006 2021-08-16 - in ::PGPLOT, can set PGPLOT_DEV in env to override for "interactive" so automated tests don't hang - in ::PLplot and ::Gnuplot add Qt devices 1.005 2013-03-25 - require PGG >= 1.5 for Gnuplot to work - use newer curve option style - justify images by default; document sepiatone behavior 1.004 2013-03-21 - autojustify images 1.003 2013-03-20 - Fix tests for smoker compatibility 1.002 2013-03-20 - window name, default to inches 1.001 2013-03-20 - Include Prima support 1.000 2013-03-14 - initial CPAN release ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/����������������������������������������������������������������������0000755�0001750�0001750�00000000000�14742232265�015630� 5����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/������������������������������������������������������������������0000755�0001750�0001750�00000000000�14742232265�016247� 5����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/���������������������������������������������������������0000755�0001750�0001750�00000000000�14742232265�020007� 5����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple/��������������������������������������������������0000755�0001750�0001750�00000000000�14742232265�021240� 5����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple/Gnuplot.pm����������������������������������������0000644�0001750�0001750�00000026672�14707600631�023240� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###################################################################### ###################################################################### ###################################################################### ### ### ### Gnuplot backend for PDL::Graphics:Simple ### ### See the PDL::Graphics::Simple docs for details ### ## # package PDL::Graphics::Simple::Gnuplot; use strict; use warnings; use File::Temp qw/tempfile/; use PDL::Options q/iparse/; use PDL; use PDL::ImageND; # for polylines our $required_PGG_version = 1.5; our $mod = { shortname => 'gnuplot', module=>'PDL::Graphics::Simple::Gnuplot', engine => 'PDL::Graphics::Gnuplot', synopsis=> 'Gnuplot 2D/3D (versatile; beautiful output)', pgs_api_version=> '1.012', }; PDL::Graphics::Simple::register( $mod ); our $filetypes = { ps => ['pscairo','postscript'], dxf => 'dxf', png => ['pngcairo','png'], pdf => ['pdfcairo','pdf'], txt => 'dumb', jpg => 'jpeg', svg => 'svg', gif => 'gif' }; our @disp_terms = qw/ qt wxt x11 aqua windows /; our $disp_opts = { wxt=>{persist=>1}, x11=>{persist=>1}, aqua=>{persist=>0}, windows=>{persist=>0} }; ########## # PDL::Graphics::Simple::Gnuplot::check # Checker sub check { my $force = shift; $force = 0 unless(defined($force)); return $mod->{ok} unless( $force or !defined($mod->{ok}) ); # Eval PDL::Graphics::Gnuplot. Require relatively recent version. # We don't specify the version in the 'use', so we can issue a # warning on an older version. eval { require PDL::Graphics::Gnuplot; PDL::Graphics::Gnuplot->import; }; if ($@) { $mod->{ok} = 0; $mod->{msg} = $@; return 0; } if ($PDL::Graphics::Gnuplot::VERSION < $required_PGG_version) { $mod->{msg} = sprintf("PDL::Graphics::Gnuplot was found, but is too old (v%s < v%s). Ignoring it.\n", $PDL::Graphics::Gnuplot::VERSION, $required_PGG_version ); $mod->{ok} = 0; return 0; } my $gpw = eval { gpwin() }; if ($@) { $mod->{ok} = 0; $mod->{msg} = $@; die "PDL::Graphics::Simple: PDL::Graphics::Gnuplot didn't construct properly.\n\t$@"; } $mod->{valid_terms} = $gpw->{valid_terms}; my $okterm = undef; if ($ENV{PDL_SIMPLE_DEVICE}) { $okterm = 1; } else { for my $term (@disp_terms) { if ($mod->{valid_terms}{$term}) { $okterm = $term; last; } } } unless ( defined $okterm ) { $mod->{ok} = 0; my $s = "Gnuplot doesn't seem to support any of the known display terminals:\n they are: (".join(",",@disp_terms).")\n"; $mod->{msg} = $s; die "PDL::Graphics::Simple: $s"; } $mod->{gp_version} = $PDL::Graphics::Gnuplot::gp_version; $mod->{ok} = 1; return 1; } ########## # PDL::Graphics::Simple::Gnuplot::new # Constructor our $new_defaults = { size => [6,4.5,'in'], type => '', output => '', multi=>undef }; sub new { my $class = shift; my $opt_in = shift; $opt_in = {} unless(defined($opt_in)); my $opt = { iparse( $new_defaults, $opt_in ) }; my $gpw; # Force a recheck on failure, in case the user fixed gnuplot. # Also loads PDL::Graphics::Gnuplot. unless(check()) { die "$mod->{shortname} appears nonfunctional: $mod->{msg}\n" unless(check(1)); } # Generate the @params array to feed to gnuplot my @params = (); push( @params, "size" => $opt->{size} ); # tempfile gets set if we need to write to a temporary file for image conversion my $conv_tempfile = ''; # Do different things for interactive and file types if ($opt->{type} =~ m/^i/i) { push(@params, title=>$opt->{output}) if defined $opt->{output}; # Interactive - try known terminals unless PDL_SIMPLE_DEVICE given push @params, font=>"=16", dashed=>1; if (my $try = $mod->{itype}) { $gpw = gpwin($mod->{itype}, @params, ($disp_opts->{$try} // {})->{persist} ? (persist=>0) : () ); } else { if (my $try = $ENV{PDL_SIMPLE_DEVICE}) { $gpw = gpwin($try, @params, ($disp_opts->{$try} // {})->{persist} ? (persist=>0) : () ); } else { attempt:for my $try( @disp_terms ) { eval { $gpw = gpwin($try, @params, ($disp_opts->{$try} // {})->{persist} ? (persist=>0) : () ); }; last attempt if $gpw; } } die "Couldn't start a gnuplot interactive window" unless($gpw); $mod->{itype} = $gpw->{terminal}; } } else { # File output - parse out file type, and then see if we support it. # (Maybe the parsing part could be pushed into a utility routine...) # Filename extension -- 2-4 characters my $ext; if ($opt->{output} =~ m/\.(\w{2,4})$/) { $ext = $1; } else { $ext = '.png'; print STDERR "PDL::Graphics::Simple::Gnuplot: Warning - defaulting to .png type for file '$opt->{output}'\n"; } $opt->{ext} = $ext; ########## # Scan through the supported file types. Gnuplot has several drivers for some # of the types, so we search until we find a valid one. # At the end, $ft has either a valid terminal name from the table (at top), # or undef. my $ft = $filetypes->{$ext}; if (ref $ft eq 'ARRAY') { try:for my $try (@$ft) { if ($mod->{valid_terms}{$try}) { $ft = $try; last try; } } if (ref($ft)) { $ft = undef; } } elsif (!defined($mod->{valid_terms}{$ft})) { $ft = undef; } # Now $ext has the file type - check if its a supported type. If not, make a # tempfilename to hold gnuplot's output. unless ( defined($ft) ) { unless ($mod->{valid_terms}{pscairo} or $mod->{valid_terms}{postscript}) { die "PDL::Graphics::Simple: $ext isn't a valid output file type for your gnuplot,\n\tand it doesn't support .ps either. Sorry, I give up.\n"; } # Term is invalid but png is supported - set up a tempfile for conversion. my($fh); ($fh,$conv_tempfile) = tempfile('pgs_gnuplot_XXXX'); close $fh; unlink($conv_tempfile); # just to be sure; $conv_tempfile .= ".ps"; $ft = $mod->{valid_terms}{pscairo} ? 'pscairo' : 'postscript'; } push @params, output => ($conv_tempfile || $opt->{output}); push @params, color => 1 if $PDL::Graphics::Gnuplot::termTab->{$ft}{color}; push @params, dashed => 1 if $PDL::Graphics::Gnuplot::termTab->{$ft}{dashed}; $gpw = gpwin( $ft, @params ); } my $me = { opt => $opt, conv_fn => $conv_tempfile, obj=>$gpw }; # Deal with multiplot setup... if (defined($opt->{multi})) { $me->{nplots} = $opt->{multi}[0] * $opt->{multi}[1]; $me->{plot_no} = 0; } else { $me->{nplots} = 0; } return bless($me, 'PDL::Graphics::Simple::Gnuplot'); } ############################## # PDL::Graphics::Simple::Gnuplot::plot # Most of the curve types are implemented by passing them on to gnuplot -- circles is an # exception, since the gnuplot "circles" curve type doesn't scale the circles in scientific # coordinates (they are always rendered as circular on the screen), and we want to match # the scaling behavior of the other engines. our $curve_types = { points => 'points', lines => 'lines', bins => 'histeps', errorbars => 'yerrorbars', limitbars => 'yerrorbars', image => 'image', circles => sub { my($me, $po, $co, @data) = @_; my $ang = PDL->xvals(362)*3.14159/180; my $c = $ang->cos; my $s = $ang->sin; $s->slice("361") .= $c->slice("361") .= PDL->pdl(1.1)->acos; # NaN my $dr = $data[2]->flat; my $dx = ($data[0]->flat->slice("*1") + $dr->slice("*1") * $c)->flat; my $dy = ($data[1]->flat->slice("*1") + $dr->slice("*1") * $s)->flat; $co->{with} = "lines"; return [ $co, $dx, $dy ]; }, contours => sub { my ($me, $po, $co, $vals, $cvals) = @_; $co->{with} = "lines"; $co->{style} //= 6; # so all contour parts have same style, blue somewhat visible against sepia my @out; for my $thresh ($cvals->list) { my ($pi, $p) = contour_polylines($thresh, $vals, $vals->ndcoords); next if $pi->at(0) < 0; push @out, map [ $co, $_->dog ], path_segs($pi, $p->mv(0,-1)); } @out; }, polylines => sub { my ($me, $po, $co, $xy, $pen) = @_; $co->{with} = "lines"; $co->{style} //= 6; # so all polylines have same style, blue somewhat visible against sepia my $pi = $pen->eq(0)->which; map [ $co, $_->dog ], path_segs($pi, $xy->mv(0,-1)); }, fits => 'fits', labels => sub { my($me, $po, $co, @data) = @_; my $label_list = ($po->{label} or []); for my $i(0..$data[0]->dim(0)-1) { my $j = ""; my $s = $data[2]->[$i]; if ( $s =~ s/^([\<\>\| ])// ) { $j = $1; } my @spec = ("$s", at=>[$data[0]->at($i), $data[1]->at($i)]); push @spec,"left" if $j eq '<'; push @spec,"center" if $j eq '|'; push @spec,"right" if $j eq '>'; push @{$label_list}, \@spec; } $po->{label} = $label_list; $co->{with} = "labels"; return [ $co, [$po->{xrange}[0]], [$po->{yrange}[0]], [""] ]; }, }; sub plot { my $me = shift; my $ipo = shift; my $po = { title => $ipo->{title}, xlab => $ipo->{xlabel}, ylab => $ipo->{ylabel}, key => $ipo->{key}, xrange => $ipo->{xrange}, yrange => $ipo->{yrange}, cbrange => $ipo->{crange}, colorbox => $ipo->{wedge}, justify => $ipo->{justify}>0 ? $ipo->{justify} : undef, clut => 'sepia', }; if ( defined($ipo->{legend}) ) { my $legend = ""; if ( $ipo->{legend} =~ m/l/i ) { $legend .= ' left '; } elsif ($ipo->{legend} =~ m/r/i) { $legend .= ' right '; } else { $legend .= ' center '; } if ( $ipo->{legend} =~ m/t/i) { $legend .= ' top '; } elsif ( $ipo->{legend} =~ m/b/i) { $legend .= ' bottom '; } else { $legend .= ' center '; } $po->{key} = $legend; } $po->{logscale} = [$ipo->{logaxis}] if $ipo->{logaxis}; unless ($ipo->{oplot}) { $me->{curvestyle} = 0; } my @arglist = $po; for my $block (@_) { die "PDL::Graphics::Simple::Gnuplot: undefined curve type $block->[0]{with}" unless my $ct = $curve_types->{ $block->[0]{with} }; my @blocks = ref($ct) eq 'CODE' ? $ct->($me, $po, @$block) : [{%{$block->[0]}, with=>$ct}, @$block[1..$#$block]]; # Now parse out curve options and deal with line styles... for my $b (@blocks) { my ($co, @rest) = @$b; my $gco = { with => $co->{with} }; unless($co->{with} eq 'labels') { $me->{curvestyle} = $co->{style} // ($me->{curvestyle}//0)+1; $gco->{dashtype} = $gco->{linetype} = $me->{curvestyle}; if ( $co->{width} ) { $gco->{pointsize} = $co->{width} if $co->{with} =~ m/^points/; $gco->{linewidth} = $co->{width}; } } $gco->{legend} = $co->{key} if defined $co->{key}; push @arglist, $gco, @rest; } } if ($me->{nplots}) { unless($me->{plot_no}) { $me->{obj}->multiplot( layout=>[@{$me->{opt}{multi}}[0,1]] ); } } if ($ipo->{oplot}) { delete @$po{qw(logaxis xrange yrange cbrange justify)}; $me->{obj}->replot(@arglist); } else { $me->{obj}->plot(@arglist); } if ($me->{nplots}) { $me->{plot_no}++; if ($me->{plot_no} >= $me->{nplots}) { $me->{obj}->end_multi; $me->{plot_no} = 0; $me->{obj}->close if $me->{opt}{type} =~ m/^f/i; } } else { $me->{obj}->close if $me->{opt}{type} =~ m/^f/i; } if ($me->{opt}{type} =~ m/^f/i and $me->{conv_fn}) { print "converting $me->{conv_fn} to $me->{opt}{output}..."; $a = rim($me->{conv_fn}); wim($a->slice('-1:0:-1')->mv(1,0), $me->{opt}{output}); unlink($me->{conv_fn}); } } 1; ����������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple/PLplot.pm�����������������������������������������0000644�0001750�0001750�00000026510�14707601707�023016� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ###################################################################### ###################################################################### ###################################################################### ### ### ### PLplot interface to PDL::Graphics::Simple ### ### See the PDL::Graphics::Simple docs for details ### ## # package PDL::Graphics::Simple::PLplot; use strict; use warnings; use File::Temp qw/tempfile/; use Time::HiRes qw/usleep/; use PDL::Options q/iparse/; use PDL; our $mod = { shortname => 'plplot', module=>'PDL::Graphics::Simple::PLplot', engine => 'PDL::Graphics::PLplot', synopsis=> 'PLplot (nice plotting, sloooow images)', pgs_api_version=> '1.012', }; PDL::Graphics::Simple::register( $mod ); my @DEVICES = qw( qtwidget wxwidgets xcairo xwin wingcc ); our $guess_filetypes = { ps => ['pscairo','psc', 'psttfc', 'ps'], svg => ['svgcairo','svg','svgqt'], pdf => ['pdfcairo','pdfqt'], png => ['pngcairo','pngqt'] }; our $filetypes; ########## # PDL::Graphics::Simple::PLplot::check # Checker sub check { my $force = shift; $force = 0 unless(defined($force)); return $mod->{ok} unless( $force or !defined($mod->{ok}) ); eval { require PDL::Graphics::PLplot; PDL::Graphics::PLplot->import }; if ($@) { $mod->{ok} = 0; $mod->{msg} = $@; return 0; } # Module loaded OK, now try to extract valid devices from it. my $plgDevs = plgDevs(); $mod->{devices} = {map +($_=>1), keys %$plgDevs}; if ( my ($good_dev) = $ENV{PDL_SIMPLE_DEVICE} || grep $mod->{devices}{$_}, @DEVICES ) { $mod->{disp_dev} = $good_dev; } else { $mod->{ok} = 0; $mod->{msg} = join("\n\t", "No suitable display device found among:", sort keys %{ $mod->{devices} }) . "\n"; return 0; } $filetypes = {}; for my $k (keys %{$guess_filetypes}) { VAL:for my $v ( @{$guess_filetypes->{$k}} ) { if ($mod->{devices}->{$v}) { $filetypes->{$k} = $v; last VAL; } } } unless ($filetypes->{ps}) { $mod->{ok} = 0; $mod->{msg} = "No PostScript found"; return 0; } $mod->{plplot_version} = PDL::Graphics::PLplot::plgver(); $mod->{ok} = 1; return 1; } ########## # PDL::Graphics::Simple::PLplot::new our $new_defaults ={ size => [8,6,'in'], type => '', output=>'', multi=>undef }; sub new { my $pkg = shift; my $opt_in = shift; my $opt = { iparse( $new_defaults, $opt_in ) }; # Force a recheck on failure, in case the user fixed PLplot. unless(check()) { die "$mod->{shortname} appears nonfunctional: $mod->{msg}\n" unless(check(1)); } # Figure the device name and size to feed to PLplot. my $conv_tempfile; my $dev; my @params; if ( $opt->{type} =~ m/^i/i) { ## Interactive devices $dev = $mod->{disp_dev}; if ($opt->{output}) { push(@params, FILE=>$opt->{output}); } } else { my $ext; ## File devices if ( $opt->{output} =~ m/\.(\w{2,4})$/ ) { $ext = $1; } else { $ext = 'png'; $opt->{output} .= ".png"; } unless( $filetypes->{$ext} and $mod->{devices}->{$filetypes->{$ext}} ) { ## Have to set up file conversion my($fh); ($fh, $conv_tempfile) = tempfile('pgs_plplot_XXXX'); close $fh; unlink $conv_tempfile; # just to be sure... $conv_tempfile .= ".ps"; $dev = $filetypes->{ps}; push(@params, FILE=>$conv_tempfile); } else { $dev = "$filetypes->{$ext}"; push(@params, FILE=>$opt->{output}); } } push @params, DEV=>$dev; my $size = PDL::Graphics::Simple::_regularize_size($opt->{size},'px'); push(@params, PAGESIZE => [ @$size[0,1] ]); my $me = { opt=>$opt, conv_fn=>$conv_tempfile }; if ( defined($opt->{multi}) ) { push @params, SUBPAGES => [@{$opt->{multi}}[0,1]]; $me->{multi_cur} = 0; $me->{multi_n} = $opt->{multi}[0] * $opt->{multi}[1]; } $me->{obj} = my $w = PDL::Graphics::PLplot->new( @params ); plsstrm($w->{STREAMNUMBER}); plspause(0); return bless $me; } sub DESTROY { # Make sure X11 windows disappear when destroyed... my $me = shift; if( $me->{opt}->{type} =~ m/^i/i and defined($me->{obj}) ) { $me->{obj}->close; delete $me->{obj}; } } # if the value is a string, it's a PLOTTYPE parameter sent to xplot. Otherwise # it's a plotting sub... our $plplot_methods = { lines => 'LINE', bins => sub { my ($me, $ipo, $data, $ppo) = @_; my $x = $data->[0]; my $x1 = $x->range( [[0],[-1]], [$x->dim(0)], 'e' )->average; my $x2 = $x->range( [[1],[0]], [$x->dim(0)], 'e' )->average; my $newx = pdl($x1,$x2)->mv(-1,0)->clump(2)->sever; my $y = $data->[1]; my $newy = $y->dummy(0,2)->clump(2)->sever; $me->{obj}->xyplot($newx, $newy, PLOTTYPE=>'LINE', %{$ppo}); }, points => 'POINTS', errorbars => sub { my ($me, $ipo, $data, $ppo) = @_; $me->{obj}->xyplot(@$data[0,1], %$ppo, YERRORBAR=>$data->[2]*2); }, limitbars => sub { my ($me, $ipo, $data, $ppo) = @_; $me->{obj}->xyplot($data->[0], 0.5*($data->[2]+$data->[3]), %$ppo, YERRORBAR=>($data->[3]-$data->[2])->abs, PLOTTYPE=>'POINTS', SYMBOLSIZE=>0.0001, %$ppo); $me->{obj}->xyplot($data->[0], $data->[1], PLOTTYPE=>'LINE', %$ppo); }, contours => sub { my ($me,$ipo,$data,$ppo) = @_; my ($vals, $cvals) = @$data; my $obj = $me->{obj}; plsstrm($obj->{STREAMNUMBER}); $obj->setparm(%$ppo); pllsty($ppo->{LINESTYLE}); plwidth($ppo->{LINEWIDTH}) if $ppo->{LINEWIDTH}; my ($nx,$ny) = $vals->dims; $obj->_setwindow; $obj->_drawlabels; my $grid = plAlloc2dGrid($vals->xvals, $vals->yvals); plcont($vals, 1, $nx, 1, $ny, $cvals, \&pltr2, $grid); plFree2dGrid($grid); }, image => sub { my ($me,$ipo,$data,$ppo) = @_; # Hammer RGB into greyscale if($data->[2]->dims>2) { $data->[2] = $data->[2]->mv(2,0)->average; } my ($immin,$immax) = $data->[2]->minmax; $ppo->{ZRANGE} = [] unless defined($ppo->{ZRANGE}); $ppo->{ZRANGE}->[0] = $immin unless defined($ppo->{ZRANGE}->[0]); $ppo->{ZRANGE}->[1] = $immax unless defined($ppo->{ZRANGE}->[1]); my $xmin = $data->[0]->min - 0.5 * ($data->[0]->max - $data->[0]->min) / $data->[0]->dim(0); my $xmax = $data->[0]->max + 0.5 * ($data->[0]->max - $data->[0]->min) / $data->[0]->dim(0); my $ymin = $data->[1]->min - 0.5 * ($data->[1]->max - $data->[1]->min) / $data->[1]->dim(1); my $ymax = $data->[1]->max + 0.5 * ($data->[1]->max - $data->[1]->min) / $data->[1]->dim(1); my $min = ($ipo->{crange} and defined($ipo->{crange}->[0])) ? $ipo->{crange}->[0] : $data->[2]->min; my $max = ($ipo->{crange} and defined($ipo->{crange}->[1])) ? $ipo->{crange}->[1] : $data->[2]->max; my $nsteps = 128; my $obj = $me->{obj}; plsstrm($obj->{STREAMNUMBER}); $obj->setparm(%$ppo); my($nx,$ny) = $data->[0]->dims; $obj->_setwindow; $obj->_drawlabels; plcol0(1); plbox ($obj->{XTICK}, $obj->{NXSUB}, $obj->{YTICK}, $obj->{NYSUB}, $obj->{XBOX}, $obj->{YBOX}); # !!! note out of order call # Set color map my $r = (xvals(128)/127)->sqrt; my $g = (xvals(128)/127); my $b = (xvals(128)/127)**2; plscmap1l( 1, xvals(128)/127, $r, $g, $b, ones(128)); my ($fill_width, $cont_color, $cont_width) = (2, 0, 0); my $clevel = ((PDL->sequence($nsteps)*(($max - $min)/($nsteps-1))) + $min); my $grid = plAlloc2dGrid($data->[0], $data->[1]); plshades( $data->[2], $xmin, $xmax, $ymin, $ymax, $clevel, $fill_width, $cont_color, $cont_width, 0, 0, \&pltr2, $grid ); plFree2dGrid($grid); if($ipo->{wedge}) { # Work around PLplot justify bug local($obj->{JUST}) = 0; $obj->colorkey($data->[2], 'v', VIEWPORT=>[0.93,0.96,0.15,0.85], TITLE=>""); } }, circles => sub { my ($me,$ipo,$data,$ppo) = @_; my $ang = PDL->xvals(362)*3.14159/180; my $c = $ang->cos; my $s = $ang->sin; $s->slice("361") .= $c->slice("361") .= PDL->pdl(1.1)->acos; # NaN my $dr = $data->[2]->flat; my $dx = ($data->[0]->flat->slice("*1") + $dr->slice("*1") * $c)->flat; my $dy = ($data->[1]->flat->slice("*1") + $dr->slice("*1") * $s)->flat; $me->{obj}->xyplot( $dx, $dy, PLOTTYPE=>'LINE',%{$ppo}); }, polylines => sub { require PDL::ImageND; my ($me,$ipo,$data,$ppo) = @_; my ($xy, $pen) = @$data; my $pi = $pen->eq(0)->which; $me->{obj}->xyplot($_->dog, PLOTTYPE=>'LINE', %$ppo) for PDL::ImageND::path_segs($pi, $xy->mv(0,-1)); }, labels => sub { my ($me, $ipo, $data, $ppo) = @_; # Call xyplot to make sure the axes get set up. $me->{obj}->xyplot( pdl(1.1)->asin, pdl(1.1)->asin, %{$ppo} ); for my $i (0..$data->[0]->dim(0)-1) { my $j = 0; my $s = $data->[2]->[$i]; if ($s =~ s/^([\<\|\> ])//) { $j = 1 if($1 eq '>'); $j = 0.5 if($1 eq '|'); } $me->{obj}->text($s, TEXTPOSITION=>[ $data->[0]->at($i), $data->[1]->at($i), 1,0, $j ], ); } } }; our @colors = qw/BLACK RED GREEN BLUE MAGENTA CYAN YELLOW TURQUOISE PINK AQUAMARINE LIGHTSEAGREEN GOLD2 BROWN/; ############################## # PDL::Graphics::Simple::PLplot::plot sub plot { my $me = shift; my $ipo = shift; my $ppo = {}; $ppo->{TITLE} = $ipo->{title} if(defined($ipo->{title})); $ppo->{XLAB} = $ipo->{xlabel} if(defined($ipo->{xlabel})); $ppo->{YLAB} = $ipo->{ylabel} if(defined($ipo->{ylabel})); $ppo->{ZRANGE} = $ipo->{crange} if(defined($ipo->{crange})); unless( $ipo->{oplot} ) { $me->{style} = 0; $me->{logaxis} = $ipo->{logaxis}; plsstrm($me->{obj}{STREAMNUMBER}); $me->{multi_cur} %= $me->{multi_n}, $me->{multi_cur}++ if $me->{opt}{multi}; pladv($me->{multi_cur} || 1); if (!$me->{multi_n} or $me->{multi_cur}==1) { if ($me->{opt}->{type}=~ m/^i/) { pleop(); plclear(); plbop(); } } if($ipo->{logaxis} =~ m/x/i) { $me->{obj}{XBOX} = 'bcnstl'; $ipo->{xrange} = [ map log10($_), @{$ipo->{xrange}}[0,1] ]; } if($ipo->{logaxis} =~ m/y/i) { $me->{obj}{YBOX} = 'bcnstl'; $ipo->{yrange} = [ map log10($_), @{$ipo->{yrange}}[0,1] ]; } $me->{obj}{BOX} = [ @{$ipo->{xrange}}[0,1], @{$ipo->{yrange}}[0,1] ]; $me->{obj}{VIEWPORT} = [0.1,0.87,0.13,0.82]; # copied from defaults in PLplot.pm. Blech. $me->{obj}{JUST} = !!$ipo->{justify}; } warn "P::G::S::PLplot: legends not implemented yet for PLplot" if($ipo->{legend}); while (@_) { my ($co, @data) = @{shift()}; my @extra_opts = (); if (defined $co->{style}) { $me->{style} = $co->{style}; } else { $me->{style}++; } $ppo->{COLOR} = $colors[$me->{style}%(@colors)]; $ppo->{LINESTYLE} = (($me->{style}-1) % 8) + 1; $ppo->{LINEWIDTH} = $co->{width} if $co->{width}; my $with = $co->{with}; if ($with eq 'fits') { ($with, my $new_opts, my $new_img, my @coords) = PDL::Graphics::Simple::_fits_convert($data[0], $ipo); $data[-1] = $new_img; unshift @data, @coords; $ppo->{XLAB} = delete $new_opts->{xlabel}; $ppo->{YLAB} = delete $new_opts->{ylabel}; $me->{obj}{BOX} = [ @{$new_opts->{xrange}}[0,1], @{$new_opts->{yrange}}[0,1] ]; } die "Unknown curve option 'with $with'!" unless my $plpm = $plplot_methods->{$with}; $data[0] = $data[0]->log10 if $me->{logaxis} =~ m/x/i; $data[1] = $data[1]->log10 if $me->{logaxis} =~ m/y/i; if (ref($plpm) eq 'CODE') { $plpm->($me, $ipo, \@data, $ppo); } else { $me->{obj}->xyplot(@data,PLOTTYPE=>$plpm,%$ppo); } plflush(); } $me->{obj}->close if $me->{opt}{type} =~ m/^f/i and !defined $me->{opt}{multi}; if ($me->{conv_fn}) { my $im = rim($me->{conv_fn}); wim($im->mv(1,0)->slice(':,-1:0:-1'), $me->{opt}{output}); unlink($me->{conv_fn}); } } 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple/PGPLOT.pm�����������������������������������������0000644�0001750�0001750�00000023510�14707602115�022600� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ###################################################################### ###################################################################### ###################################################################### ### ### ### PGPLOT interface to PDL::Graphics::Simple. ### ### See the PDL::Graphics::Simple docs for details ### ## # package PDL::Graphics::Simple::PGPLOT; use strict; use warnings; use File::Temp qw/tempfile/; use PDL::Options q/iparse/; use PDL; our $mod = { shortname => 'pgplot', module=>'PDL::Graphics::Simple::PGPLOT', engine => 'PDL::Graphics::PGPLOT::Window', synopsis=> 'PGPLOT (venerable but trusted)', pgs_api_version=> '1.012', }; PDL::Graphics::Simple::register( $mod ); print $@; sub check { my $force = shift; $force = 0 unless(defined($force)); return $mod->{ok} unless( $force or !defined($mod->{ok}) ); eval { require PDL::Graphics::PGPLOT::Window; PDL::Graphics::PGPLOT::Window->import; }; if ($@) { $mod->{ok} = 0; $mod->{msg} = $@; return 0; } # Module loaded OK, now try to extract valid devices from it eval { my %devs; PGPLOT::pgqndt(my $n); for my $count (1..$n) { PGPLOT::pgqdt($count,my ($type,$v1,$descr,$v2,$v3)); $devs{substr $type, 1} = 1; # chop off "/" } $mod->{devices} = \%devs; }; if ($@) { $mod->{ok} = 0; $mod->{msg} = $@; return 0; } delete $mod->{disp_dev}; if ($ENV{PDL_SIMPLE_DEVICE} || $ENV{PGPLOT_DEV}) { $mod->{disp_dev} = $ENV{PDL_SIMPLE_DEVICE} || $ENV{PGPLOT_DEV}; $mod->{disp_dev} =~ s#^/+##; } else { TRY:for my $try (qw/XWINDOW XSERVE CGW GW/) { if ($mod->{devices}->{$try}) { $mod->{disp_dev} = $try; last TRY; } } } unless (exists($mod->{disp_dev})) { $mod->{ok} = 0; $mod->{msg} = "Couldn't identify a PGPLOT display device -- giving up.\n"; return 0; } unless ($mod->{devices}{VCPS}) { $mod->{ok} = 0; $mod->{msg} = "Couldn't find the VCPS file-output device -- giving up.\n"; return 0; } $mod->{pgplotpm_version} = $PGPLOT::VERSION; { PGPLOT::pgqinf('VERSION', $mod->{pgplot_version}, my $len); } $mod->{ok} = 1; return 1; } ########## # PDL::Graphics::Simple::PGPLOT::new our $new_defaults ={ size => [8,6,'in'], type => '', output=>'', multi=>undef }; our $filetypes = { png => 'PNG', ps => 'VCPS' }; sub new { my $pkg = shift; my $opt_in = shift; my $opt = { iparse( $new_defaults, $opt_in ) }; # Force a recheck on failure, in case the user fixed PGPLOT. # Also loads PDL::Graphics::PGPLOT::Window. unless(check()) { die "$mod->{shortname} appears nonfunctional: $mod->{msg}\n" unless(check(1)); } # Figure the device name and size to feed to PGPLOT. # size has already been regularized. my $conv_tempfile; my $dev; if( $opt->{type} =~ m/^i/i) { $dev = ( $opt->{output} // "" ) . "/$mod->{disp_dev}"; } else { my $ext; if($PDL::VERSION < 3 and ($PDL::VERSION > 2.1 or $PDL::VERSION < 2.005)) { print STDERR "WARNING - file output shapes vary under PDL < 2.005 (early version: $PDL::VERSION)\n"; } if( $opt->{output} =~ m/\.(\w{2,4})$/ ) { $ext = $1; } else { $ext = 'png'; $opt->{output} .= ".png"; } unless ($filetypes->{$ext} and $mod->{devices}{$filetypes->{$ext}}) { my($fh); ($fh, $conv_tempfile) = tempfile('pgs_pgplot_XXXX'); close $fh; unlink $conv_tempfile; # just to be sure... $conv_tempfile .= ".ps"; $dev = "$conv_tempfile/VCPS"; } else { $dev = "$opt->{output}/$filetypes->{$ext}"; } } $ENV{PGPLOT_PS_WIDTH} = $opt->{size}[0] * 1000; $ENV{PGPLOT_PS_HEIGHT} = $opt->{size}[1] * 1000; my @params = (size => [@{$opt->{size}}[0,1]]); push @params, nx=>$opt->{multi}[0], ny=>$opt->{multi}[1] if defined $opt->{multi}; my $pgw = pgwin( $dev, { @params } ); my $me = { opt=>$opt, conv_fn=>$conv_tempfile, obj=>$pgw }; return bless $me; } our $pgplot_methods = { polylines => 'lines', 'lines' => 'line', 'bins' => 'bin', 'points' => 'points', 'errorbars' => sub { my ($me, $ipo, $data, $ppo) = @_; $me->{obj}->points($data->[0],$data->[1],$ppo); $me->{obj}->errb($data->[0],$data->[1],$data->[2]); }, 'limitbars'=> sub { my ($me, $ipo, $data, $ppo) = @_; # use XY absolute error form, but with X errorbars right on the point $me->{obj}->points($data->[0],$data->[1],$ppo); my $z = zeroes($data->[0]); $me->{obj}->errb($data->[0],$data->[1], $z, $z, -($data->[2]-$data->[1]), $data->[3]-$data->[1], $ppo); }, 'image' => 'imag', 'contours' => 'cont', fits => 'fits_imag', 'circles'=> sub { my ($me,$ipo,$data,$ppo) = @_; $ppo->{filltype}='outline'; $me->{obj}->tcircle(@$data, $ppo); }, 'labels'=> sub { my ($me,$ipo,$data,$ppo) = @_; for my $i (0..$data->[0]->dim(0)-1) { my $s = $data->[2]->[$i]; my $j = 0.0; if ( $s =~ s/^([\<\|\>\ ])// ) { $j = 0.5 if($1 eq '|'); $j = 1.0 if($1 eq '>'); } $me->{obj}->text( $s, $data->[0]->at($i), $data->[1]->at($i), {JUSTIFICATION=>$j} ); } } }; sub plot { my $me = shift; my $ipo = shift; my $po = {}; $po->{title} = $ipo->{title} if defined $ipo->{title}; $po->{xtitle} = $ipo->{xlabel} if defined $ipo->{xlabel}; $po->{ytitle} = $ipo->{ylabel} if defined $ipo->{ylabel}; $po->{justify} = $ipo->{justify} if defined $ipo->{justify}; my %color_opts; if (defined $ipo->{crange}) { $color_opts{MIN} = $ipo->{crange}[0] if defined $ipo->{crange}[0]; $color_opts{MAX} = $ipo->{crange}[1] if defined $ipo->{crange}[1]; } if ($ipo->{oplot} and $me->{opt}->{type} =~ m/^f/i) { die "The PGPLOT engine does not yet support oplot for files. Instead, \nglom all your lines together into one call to plot.\n"; } unless ($ipo->{oplot}) { $me->{curvestyle} = 0; $me->{logaxis} = $ipo->{logaxis}; $po->{axis} = 0; if($ipo->{logaxis} =~ m/x/i) { $po->{axis} += 10; $ipo->{xrange} = [ map log10($_), @{$ipo->{xrange}}[0,1] ]; } if($ipo->{logaxis} =~ m/y/i) { $po->{axis} += 20; $ipo->{yrange} = [ map log10($_), @{$ipo->{yrange}}[0,1] ]; } $me->{obj}->release; my @range_vals = (@{$ipo->{xrange}}, @{$ipo->{yrange}}); $me->{obj}->env(@range_vals, $po) if grep defined, @range_vals; } # ppo is "post-plot options", which are really a mix of plot and curve options. # Currently we don't parse any plot options into it (they're handled by the "env" # call) but if we end up doing so, it should go here. The linestyle and color # are curve options that are autoincremented each curve. my %ppo = (); while (@_) { my ($co, @data) = @{shift()}; my @extra_opts = (); if ( defined $co->{style} ) { $me->{curvestyle} = int($co->{style}) + 1; } else { $me->{curvestyle}++; } $ppo{ color } = $me->{curvestyle}-1 % 7 + 1; $ppo{ linestyle } = ($me->{curvestyle}-1) % 5 + 1; $ppo{ linewidth } = int($co->{width}) if $co->{width}; our $pgplot_methods; my $pgpm = $pgplot_methods->{$co->{with}}; die "Unknown curve option 'with $co->{with}'!" unless($pgpm); my @ppo_added; if ($pgpm eq 'fits_imag') { $ppo{$_} = $po->{$_} for @ppo_added = grep defined $po->{$_}, qw(justify title); } if($pgpm eq 'imag') { @ppo{keys %color_opts} = values %color_opts; $ppo{ drawwedge } = ($ipo->{wedge} != 0); # Extract transform parameters from the corners of the image... my $xcoords = shift(@data); my $ycoords = shift(@data); my $datum_pix = [0,0]; my $datum_sci = [$xcoords->at(0,0), $ycoords->at(0,0)]; my $t1 = ($xcoords->slice("(-1),(0)") - $xcoords->slice("(0),(0)")) / ($xcoords->dim(0)-1); my $t2 = ($xcoords->slice("(0),(-1)") - $xcoords->slice("(0),(0)")) / ($xcoords->dim(1)-1); my $t4 = ($ycoords->slice("(-1),(0)") - $ycoords->slice("(0),(0)")) / ($ycoords->dim(0)-1); my $t5 = ($ycoords->slice("(0),(-1)") - $ycoords->slice("(0),(0)")) / ($ycoords->dim(1)-1); my $transform = pdl( $datum_sci->[0] - $t1 * $datum_pix->[0] - $t2 * $datum_pix->[1], $t1, $t2, $datum_sci->[1] - $t4 * $datum_pix->[0] - $t5 * $datum_pix->[1], $t4, $t5 )->flat; { # sepia color table my $r = (xvals(256)/255)->sqrt; my $g = (xvals(256)/255); my $b = (xvals(256)/255)**2; $me->{obj}->ctab($g, $r, $g, $b); } } $data[0] = $data[0]->log10 if $me->{logaxis} =~ m/x/i; $data[1] = $data[1]->log10 if $me->{logaxis} =~ m/y/i; if (ref $pgpm eq 'CODE') { $pgpm->($me, $ipo, \@data, \%ppo); } else { $me->{obj}->$pgpm(@data,\%ppo); } delete @ppo{@ppo_added} if @ppo_added; $me->{obj}->hold; } ############################## # End of curve plotting. # Now place the legend if necessary. if ($ipo->{legend}) { my $xp; my $xrdiff = $ipo->{xrange}->[1] - $ipo->{xrange}->[0]; if( $ipo->{legend}=~ m/l/i ) { $xp = 0.03 * $xrdiff + $ipo->{xrange}->[0]; } elsif($ipo->{legend} =~ m/r/i) { $xp = 0.8 * $xrdiff + $ipo->{xrange}->[0]; } else { $xp = 0.4 * $xrdiff + $ipo->{xrange}->[0]; } my $yp; my $yrdiff = $ipo->{yrange}->[1] - $ipo->{yrange}->[0]; if( $ipo->{legend}=~ m/t/i ) { $yp = 0.95 * $yrdiff + $ipo->{yrange}->[0]; } elsif($ipo->{legend} =~ m/b/i) { $yp = 0.2 * $yrdiff + $ipo->{yrange}->[0]; } else { $yp = 0.6 * $yrdiff + $ipo->{yrange}->[0]; } print "keys is [".join(",",@{$me->{keys}})."]; xp is $xp; yp is $yp\n"; $me->{obj}->legend( $me->{keys}, $xp, $yp, { Color => [ (xvals(0+@{$me->{keys}}) % 7 + 1)->list ], LineStyle => [ (xvals(0+@{$me->{keys}}) % 5 + 1)->list ] } ); } $me->{obj}->release; } sub DESTROY { my $me = shift; eval { # in case of global destruction $me->{obj}->release; }; if (defined $me->{type} and $me->{type} =~ m/^f/i) { eval { $me->{obj}->close; }; if ($me->{conv_fn}) { wim(rim($me->{conv_fn}), $me->{opt}{output}); unlink($me->{conv_fn}); } } } 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple/Prima.pm������������������������������������������0000644�0001750�0001750�00000044363�14707602010�022646� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###################################################################### ###################################################################### ###################################################################### ### ### ### Prima backend for PDL::Graphics:Simple ### ### See the PDL::Graphics::Simple docs for details ### ### Prima setup is borrowed from D. Mertens' PDL::Graphics::Prima::Simple ### ## # package PDL::Graphics::Simple::Prima; use strict; use warnings; use PDL; use PDL::ImageND; # for polylines use PDL::Options q/iparse/; use File::Temp qw/tempfile/; our $mod = { shortname => 'prima', module => 'PDL::Graphics::Simple::Prima', engine => 'PDL::Graphics::Prima', synopsis => 'Prima (interactive, fast, PDL-specific)', pgs_api_version=> '1.012', }; PDL::Graphics::Simple::register( $mod ); our (@colors, @patterns, $types); ########## # PDL::Graphics::Simple::Prima::check # Checker sub check { my $force = shift; $force = 0 unless(defined($force)); return $mod->{ok} unless( $force or !defined($mod->{ok})); $mod->{ok} = 0; # makes default case simpler # Check Prima availability my $min_version = 0.18; eval { require PDL::Graphics::Prima; }; if($@) { $mod->{msg} = "Couldn't load PDL::Graphics::Prima: ".$@; undef $@; return 0; } if ($PDL::Graphics::Prima::VERSION < $min_version) { $mod->{msg} = "Prima version $PDL::Graphics::Prima::VERSION is too low ($min_version required)"; return 0; } eval { require PDL::Graphics::Prima::Simple; }; if($@) { $mod->{msg} = "Couldn't load PDL::Graphics::Prima::Simple: ".$@; undef $@; return 0; } eval { require Prima::Application; Prima::Application->import(); }; if($@) { $mod->{msg} = "Couldn't load Prima application: ".$@; undef $@; return 0; } # Don't know if all these are actually needed; I'm stealing from the demo. # --CED eval { require Prima::Label; require Prima::PodView; require Prima::Buttons; require Prima::Utils; require Prima::Edit; require Prima::Const; }; if($@){ $mod->{msg} = "Couldn't load auxiliary Prima modules: ".$@; undef $@; return 0; } @colors = ( cl::Black(), cl::Red(), cl::Green(), cl::Blue(), cl::Cyan(), cl::Magenta(), cl::Yellow(), cl::Brown(), cl::LightRed(), cl::LightGreen(), cl::LightBlue(), cl::Gray(), ); @patterns = ( lp::Solid(), lp::Dash(), lp::LongDash(), lp::ShortDash(), lp::DotDot(), lp::DashDot(), lp::DashDotDot(), ); _load_types(); $mod->{prima_version} = $Prima::VERSION; $mod->{ok} =1; return 1; } ############################## # New - constructor our $new_defaults = { size => [6,4.5,'in'], type=>'i', output=>'', multi=>undef }; ## Much of this boilerplate is stolen from PDL::Graphics::Prima::Simple... our $N_windows = 0; sub new { my $class = shift; my $opt_in = shift; $opt_in = {} unless(defined($opt_in)); my $opt = { iparse($new_defaults, $opt_in) }; unless( check() ) { die "$mod->{shortname} appears nonfunctional: $mod->{msg}\n" unless(check(1)); } my $size = PDL::Graphics::Simple::_regularize_size($opt->{size},'px'); my $pw = Prima::Window->create( text => $opt->{output} || "PDL/Prima Plot", size => [$size->[0], $size->[1]], onCreate => sub { $PDL::Graphics::Prima::Simple::N_windows++; }, onDestroy => sub { $PDL::Graphics::Prima::Simple::N_windows--; PDL::Graphics::Prima::Simple::twiddling(0) if($PDL::Graphics::Prima::Simple::N_windows==0); } ); die "Couldn't create a Prima window!" unless(defined($pw)); if($opt_in->{type} =~ m/^f/i) { $pw->hide; } my $me = { obj => $pw, widgets => [], next_plotno=>0, multi=>$opt_in->{multi}, type=>$opt->{type}, output=>$opt->{output} }; return bless($me, "PDL::Graphics::Simple::Prima"); } sub DESTROY { my $me = shift; if($me->{type} =~ m/f/i) { ############################## # File-saving code... unless( $me->{multi} ) { ############################## # Save plot to file if($me->{widgets}->[0]) { eval {$me->{widgets}->[0]->save_to_file($me->{output})}; if($@) { print $@; undef $@; } } else { print STDERR "No plot was sent to $me->{output}\n"; } } else { ############################## # Multiplot - save the plots individually, then splice them together. # Lame, lame - I think this can be done in memory with Prima. # But it gets us to a place where we are supporting stuff. if(@{$me->{widgets}} < 1) { print STDERR "No plot was sent to $me->{output}\n"; } else { print STDERR "WARNING - multiplot support is experimental for the Prima engine\n"; my ($h,$tmpfile) = tempfile('PDL-Graphics-Simple-XXXX'); close $h; unlink($tmpfile); my $suffix; if($me->{output}=~ s/(\.\w{2,4})$//) { $suffix = $1; } else { $suffix = ".png"; } $tmpfile .= $suffix; my $widget_dex = 0; my $im = undef; my $ztile = undef; ROW:for my $row(0..$me->{multi}->[1]-1) { my $imrow = undef; for my $col(0..$me->{multi}->[0]-1) { my $tile; if($widget_dex < @{$me->{widgets}}) { eval { $me->{widgets}->[$widget_dex++]->save_to_file($tmpfile) }; last ROW if($@); $tile = rim($tmpfile); $ztile = zeroes($tile)+255; unlink($tmpfile); } else { # ztile is always initialized by first run through... $tile = $ztile; } if(!defined($imrow)) { $imrow = $tile; } else { $imrow = $imrow->glue(0,$tile); } } # end of row loop if(!defined($im)) { $im = $imrow; } else { $im = $imrow->glue(1,$im); } } unless($@) { wim($im, $me->{output}.$suffix); } else { print STDERR $@; undef $@; } } } } eval { # in case of global destruction $me->{obj}->hide; $me->{obj}->destroy; }; } ############################## # apply method makes sepiatone values for input data, # to match the style of PDL::Graphics::Prima::Palette, # in order to make the Matrix plot type happy (for 'with=>image'). @PDL::Graphics::Simple::Prima::Sepia_Palette::ISA = 'PDL::Graphics::Prima::Palette'; sub PDL::Graphics::Simple::Prima::Sepia_Palette::apply { my $h = shift; my $data = shift; my ($min, $max) = @$h{qw(min max)}; my $g = ($min==$max)? $data->zeroes : (($data->double - $min)/($max-$min))->clip(0,1); my $r = $g->sqrt; my $b = $g*$g; return (pdl($r,$g,$b)*255.999)->floor->mv(-1,0)->rgb_to_color; } ############################## # Plot types # # This probably needs a little more smarts. # Currently each entry is either a ppair::<foo> return or a sub that implements # the plot type in terms of others. sub _load_types { $types = { lines => 'Lines', points => [ map ppair->can($_)->(), qw/Blobs Triangles Squares Crosses Xs Asterisks/ ], bins => sub { my ($me, $plot, $block, $cprops) = @_; my ($x, $y) = @$block; my $x1 = $x->range( [[0],[-1]], [$x->dim(0)], 'e' )->average; my $x2 = $x->range( [[1],[0]], [$x->dim(0)], 'e' )->average; my $newx = pdl($x1, $x2)->mv(-1,0)->clump(2)->sever; my $newy = $y->dummy(0,2)->clump(2)->sever; $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair($newx,$newy,plotType=>ppair::Lines(), @$cprops); }, # as of 1.012, known to not draw all its lines(!) overplotting an image # draws them all without an image in same plot() call, or separate plot() contours => sub { my ($me, $plot, $block, $cprops) = @_; my ($vals, $cvals) = @$block; for my $thresh ($cvals->list) { my ($pi, $p) = contour_polylines($thresh, $vals, $vals->ndcoords); next if $pi->at(0) < 0; $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair($_->dog, plotType=>ppair::Lines(), @$cprops) for path_segs($pi, $p->mv(0,-1)); } }, polylines => sub { my ($me, $plot, $block, $cprops) = @_; my ($xy, $pen) = @$block; my $pi = $pen->eq(0)->which; $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair($_->dog, plotType=>ppair::Lines(), @$cprops) for path_segs($pi, $xy->mv(0,-1)); }, image => sub { my ($me, $plot, $data, $cprops, $co, $ipo) = @_; my ($xmin, $xmax) = $data->[0]->minmax; my $dx = 0.5 * ($xmax-$xmin) / ($data->[0]->dim(0) - (($data->[0]->dim(0)==1) ? 0 : 1)); $xmin -= $dx; $xmax += $dx; my ($ymin, $ymax) = $data->[1]->minmax; my $dy = 0.5 * ($ymax-$ymin) / ($data->[0]->dim(1) - (($data->[1]->dim(1)==1) ? 0 : 1)); $ymin -= $dy; $ymax += $dy; my $dataset; my $imdata = $data->[2]; my @bounds = (x_bounds=>[ $xmin, $xmax ], y_bounds=>[ $ymin, $ymax ]); if ($imdata->ndims > 2) { $imdata = $imdata->mv(-1,0) if $imdata->dim(0) != 3; $dataset = ds::Image($imdata, @bounds); } else { my $crange = $me->{ipo}{crange}; my ($cmin, $cmax) = defined($crange) ? @$crange : (); $cmin //= $imdata->min; $cmax //= $imdata->max; my $palette = PDL::Graphics::Simple::Prima::Sepia_Palette->new( min => $cmin, max => $cmax, data => $imdata, ); $dataset = ds::Grid($imdata, @bounds, plotType=>pgrid::Matrix($ipo->{wedge} ? () : (palette => $palette)), ); $plot->color_map($palette) if $ipo->{wedge}; } $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = $dataset; }, circles => sub { my ($me, $plot, $data, $cprops) = @_; our $cstash; unless(defined($cstash)) { my $ang = PDL->xvals(362)*3.14159/180; $cstash = {c => $ang->cos, s => $ang->sin}; $cstash->{s}->slice("361") .= $cstash->{c}->slice("361") .= PDL->pdl(1.1)->acos; # NaN } my $dr = $data->[2]->flat; my $dx = ($data->[0]->flat->dummy(0,1) + $dr->dummy(0,1)*$cstash->{c})->flat; my $dy = ($data->[1]->flat->dummy(0,1) + $dr->dummy(0,1)*$cstash->{s})->flat; $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair( $dx, $dy, plotType=>ppair::Lines(), @$cprops); }, labels => sub { my ($me,$plot,$block,$cprops,$co,$ipo) = @_; my ($x, $y) = map $_->flat->copy, @$block[0,1]; # copy as mutate below my @labels = @{$block->[2]}; my @lrc = (); for my $i(0..$x->dim(0)-1) { my $j =0; if($labels[$i] =~ s/^([\<\|\> ])//) { my $ch = $1; if($ch =~ m/[\|\>]/) { my $tw = $plot->get_text_width($labels[$i]); $tw /= 2 if($ch eq '|'); $x->slice("($i)") .= $plot->x->pixels_to_reals( $plot->x->reals_to_pixels( $x->slice("($i)") ) - $tw ); } } } $plot->dataSets()->{1+keys(%{$plot->dataSets()})} = ds::Note( map pnote::Text($labels[$_],x=>$x->slice("($_)"),y=>$y->slice("($_)")), 0..$#labels ); }, limitbars => sub { # Strategy: make T-errorbars out of the x/y/height data and generate a Line # plot. The T-errorbar width is 4x the LineWidth (+/- 2x). my ($me, $plot, $block, $cprops, $co, $ipo) = @_; my $x = $block->[0]->flat; my $y = $block->[1]->flat; my $ylo = $block->[2]->flat; my $yhi = $block->[3]->flat; # Calculate T bar X ranges my $of = ($co->{width}||1) * 2; my $xp = $plot->x->reals_to_pixels($x); my $xlo = $plot->x->pixels_to_reals( $xp - $of ); my $xhi = $plot->x->pixels_to_reals( $xp + $of ); my $nan = PDL->new_from_specification($x->dim(0)); $nan .= asin(pdl(1.1)); my $xdraw = pdl($xlo,$xhi,$x, $x, $xlo,$xhi,$nan)->mv(1,0)->flat; my $ydraw = pdl($ylo,$ylo,$ylo,$yhi,$yhi,$yhi,$nan)->mv(1,0)->flat; $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair($xdraw,$ydraw,plotType=>ppair::Lines(), @$cprops); $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair($x,$y,plotType=>$types->{points}->[ ($me->{curvestyle}-1) %(0+@{$types->{points}}) ], @$cprops); }, errorbars => sub { # Strategy: make T-errorbars out of the x/y/height data and generate a Line # plot. The T-errorbar width is 4x the LineWidth (+/- 2x). my ($me, $plot, $block, $cprops, $co, $ipo) = @_; my $halfwidth = $block->[2]->flat; $block->[2] = $block->[1] - $halfwidth; $block->[3] = $block->[1] + $halfwidth; $types->{limitbars}->($me, $plot, $block, $cprops, $co, $ipo); }, }; } ############################## # Plot subroutine # # sub plot { my $me = shift; my $ipo = shift; $me->{ipo} = $ipo; if(defined($ipo->{legend})) { printf(STDERR "WARNING: Ignoring 'legend' option (Legends not yet supported by PDL::Graphics::Simple::Prima v%s)",$PDL::Graphics::Simple::VERSION); } my $plot; if ($ipo->{oplot} and defined($me->{last_plot})) { $plot = $me->{last_plot}; } else { $me->{curvestyle} = 0; if ($me->{multi}) { # Multiplot - handle logic and plot placement # Advance to the next plot position. Erase the window if necessary. if ($me->{next_plotno} and $me->{next_plotno} >= $me->{multi}->[0] * $me->{multi}->[1]) { map {$_->destroy} @{$me->{widgets}}; $me->{widgets} = []; $me->{next_plotno} = 0; } my $pno = $me->{next_plotno}; $plot = $me->{obj}->insert('Plot', place => { relx => ($pno % $me->{multi}->[0])/$me->{multi}->[0], relwidth => 1.0/$me->{multi}->[0], rely => 1.0 - (1 + int($pno / $me->{multi}->[0]))/$me->{multi}->[1], relheight => 1.0/$me->{multi}->[1], anchor => 'sw'}); $plot->titleFont(size => 12); $me->{next_plotno}++; } else { # No multiplot - just instantiate a plot (and destroy any widgets from earlier) $_->destroy for @{$me->{widgets}}; $me->{widgets} = []; $plot = $me->{obj}->insert('Plot', pack=>{fill=>'both',expand=>1} ); $plot->titleFont(size => 14); } } push(@{$me->{widgets}}, $plot); $me->{last_plot} = $plot; for my $block (@_) { my $co = $block->[0]; if ($co->{with} eq 'fits') { ($co->{with}, my $new_opts, my $new_img, my @coords) = PDL::Graphics::Simple::_fits_convert($block->[1], $ipo); $block = [ $co, @coords, $new_img ]; @$ipo{keys %$new_opts} = values %$new_opts; } } if (!$ipo->{oplot}) { ## Set global plot options: titles, axis labels, and ranges. $plot->hide; $plot->lock; $plot->title( $ipo->{title} ) if(defined($ipo->{title})); $plot->x->label( $ipo->{xlabel} ) if(defined($ipo->{xlabel})); $plot->y->label( $ipo->{ylabel} ) if(defined($ipo->{ylabel})); $plot->x->scaling(sc::Log()) if($ipo->{logaxis}=~ m/x/i); $plot->y->scaling(sc::Log()) if($ipo->{logaxis}=~ m/y/i); $plot->x->min($ipo->{xrange}[0]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[0])); $plot->x->max($ipo->{xrange}[1]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}[1])); $plot->y->min($ipo->{yrange}[0]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[0])); $plot->y->max($ipo->{yrange}[1]) if(defined($ipo->{yrange}) and defined($ipo->{yrange}[1])); ############################## # I couldn't find a way to scale the plot to make the plot area justified, so # we cheat and adjust the axis values instead. # This is a total hack, but at least it produces justified plots. if ($ipo->{justify}) { my ($dmin,$pmin,$dmax,$pmax,$xscale,$yscale); ($dmin,$dmax) = $plot->x->minmax; $pmin = $plot->x->reals_to_pixels($dmin); $pmax = $plot->x->reals_to_pixels($dmax); $xscale = ($pmax-$pmin)/($dmax-$dmin); ($dmin,$dmax) = $plot->y->minmax; $pmin = $plot->y->reals_to_pixels($dmin); $pmax = $plot->y->reals_to_pixels($dmax); $yscale = ($pmax-$pmin)/($dmax-$dmin); my $ratio = $yscale / $xscale; if($ratio > 1) { # More Y pixels per datavalue than X pixels. Hence we expand the Y range. my $ycen = ($dmax+$dmin)/2; my $yof = ($dmax-$dmin)/2; my $new_yof = $yof * $yscale/$xscale; $plot->y->min($ycen-$new_yof); $plot->y->max($ycen+$new_yof); } elsif($ratio < 1) { # More X pixels per datavalue than Y pixels. Hence we expand the X range. ($dmin,$dmax) = $plot->x->minmax; my $xcen = ($dmax+$dmin)/2; my $xof = ($dmax-$dmin)/2; my $new_xof = $xof * $xscale/$yscale; $plot->x->min($xcen-$new_xof); $plot->x->max($xcen+$new_xof); } } } ############################## # Rubber meets the road -- loop over data blocks and # ship out each curve to the appropriate dispatcher in the $types table for my $block (@_) { my ($co, @rest) = @$block; # Parse out curve style (for points type selection) if (defined $co->{style}) { $me->{curvestyle} = $co->{style}; } else { $me->{curvestyle}++; } my $cprops = [ color => $colors[ ($me->{curvestyle}-1) % @colors ], linePattern => $patterns[ ($me->{curvestyle}-1) % @patterns ], lineWidth => $co->{width} || 1 ]; my $with = $co->{with}; my $type = $types->{$with}; die "$with is not yet implemented in PDL::Graphics::Simple for Prima.\n" if !defined $type; if ( ref($type) eq 'CODE' ) { $type->($me, $plot, \@rest, $cprops, $co, $ipo); } else { my $pt = ref($type) eq 'ARRAY' ? $type->[ ($me->{curvestyle}-1) % (0+@{$type}) ] : ppair->can($type)->(); $plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair(@rest, plotType => $pt, @$cprops); } } if ($me->{type} !~ m/f/i) { $plot->show; $plot->unlock; } else { # Belt-and-suspenders to stay hidden $plot->hide; $me->{obj}->hide; } ############################## # Another lame kludge. Run the event loop for 50 milliseconds, to enable a redraw, # then exit it. Prima::Timer->create( onTick=>sub{$_[0]->stop; die "done with event loop\n"}, timeout=>50 )->start; eval { no warnings 'once'; $::application->go }; die unless $@ =~ /^done with event loop/; undef $@; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/lib/PDL/Graphics/Simple.pm������������������������������������������������0000644�0001750�0001750�00000141033�14742232157�021600� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������=head1 NAME PDL::Graphics::Simple - Simple backend-independent plotting for PDL =head1 SYNOPSIS # Simple interface - throw plots up on-screen, ASAP use PDL::Graphics::Simple; imag $a; # Display an image PDL imag $a, 0, 300; # Display with color range line $rrr, $fit; # Plot a line points $rr, $sec; # Plot points hold; # Hold graphics so subsequent calls overplot line $rrr, $fit; # Overplot a line in a contrasting color release; # Release graphics # Object interface - simple plotting, to file or screen $w = pgswin( size=>[8,4], multi=>[2,2] ); # 2x2 plot grid on an 8"x4" window $w = pgswin( size=>[1000,1000,'px'], output=>'plot.png' ); # output to a PNG $w->plot( with=>'points', $rr, $sec, with=>'line', $rrr, $fit, {title=>"Points and fit", xlabel=>"Abscissa", ylabel=>"Ordinate"}); =head1 DESCRIPTION PDL can plot through a plethora of external plotting modules. Each module tends to be less widely available than Perl itself, and to require an additional step or two to install. For simple applications ("throw up an image on the screen", or "plot a curve") it is useful to have a subset of all plotting capability available in a backend-independent layer. PDL::Graphics::Simple provides that capability. PDL::Graphics::Simple implements all the functionality used in the PDL::Book examples, with identical syntax. It also generalizes that syntax - you can use ::Simple graphics, with slight syntactical differences, in the same manner that you would use any of the engine modules. See the Examples below for details. The plot you get will always be what you asked for, regardless of which plotting engine you have installed on your system. Only a small subset of PDL's complete graphics functionality is supported -- each individual plotting module has unique advantages and functionality that are beyond what PDL::Graphics::Simple can do. Only 2-D plotting is supported. For 3-D plotting, use L<PDL::Graphics::Gnuplot> or L<PDL::Graphics::TriD> directly. When plotting to a file, the file output is not guaranteed to be present until the plot object is destroyed (e.g. by being undefed or going out of scope). =head1 STATE OF DEVELOPMENT PDL::Graphics::Simple currently supports most of the planned functionality. It is being released as a beta test to determine if it meets users' needs and gain feedback on the API -- so please give feedback! =head1 SUPPORTED GRAPHICS ENGINES PDL::Graphics::Simple includes support for the following graphics engines. Additional driver modules can be loaded dynamically; see C<register>, below. Each of the engines has unique capabilities and flavor that are not captured in PDL::Graphics::Simple - you are encouraged to look at the individual modules for more capability! =over 3 =item * Gnuplot (via PDL::Graphics::Gnuplot) Gnuplot is an extremely richly featured plotting package that offers markup, rich text control, RGB color, and 2-D and 3-D plotting. Its output is publication quality. It is supported on POSIX systems, MacOS, and Microsoft Windows, and is available from most package managers. =item * PGPLOT (via PDL::Graphics::PGPLOT::Window) PGPLOT is venerable and nearly as fully featured as Gnuplot for 2-D plotting. It lacks RGB color output. It does have rich text control, but uses simple plotter fonts that are generated internally. It is supported on MacOS and POSIX, but is not as widely available as Gnuplot. =item * PLplot (via PDL::Graphics::PLplot) PLplot is a moderately full featured plotting package that generates publication quality output with a simple high-level interface. It is supported on MacOS and POSIX. =item * Prima (via PDL::Graphics::Prima) Prima is based around a widget paradigm that enables complex interaction with data in real-time, and it is highly optimized for that application. It is not as mature as the other platforms, particularly for static plot generation to files. This means that PDL::Graphics::Simple does not play to its considerable strengths, although Prima is serviceable and fast in this application. Please run the Prima demo in the perldl shell for a better sample of Prima's capabilities. =back =head1 EXAMPLES PDL::Graphics::Simple can be called using plot-atomic or curve-atomic plotting styles, using a pidgin form of calls to any of the main modules. The examples are divided into Book-like (very simple), PGPLOT-like (curve-atomic), and Gnuplot-like (plot-atomic) cases. There are three main styles of interaction with plot objects that PDL::Graphics::Simple supports, reflective of the pre-existing modules' styles of interaction. You can mix-and-match them to match your particular needs and coding style. Here are examples showing convenient ways to call the code. =head2 First steps (non-object-oriented) For the very simplest actions there are non-object-oriented shortcuts. Here are some examples of simple tasks, including axis labels and plot titles. These non-object-oriented shortcuts are useful for display with the default window size. They make use of a package-global plot object. The non-object interface will keep using the last plot engine you used successfully. On first start, you can specify an engine with the environment variable C<PDL_SIMPLE_ENGINE>. As of 1.011, only that will be tried, but if you didn't specify one, all known engines are tried in alphabetical order until one works. The value of C<PDL_SIMPLE_ENGINE> should be the "shortname" of the engine, currently: =over =item C<gnuplot> =item C<plplot> =item C<pgplot> =item C<prima> =back =over 3 =item * Load module and create line plots use PDL::Graphics::Simple; $x = xvals(51)/5; $y = $x**3; $y->line; line( $x, $y ); line( $x, $y, {title=>"My plot", ylabel=> "Ordinate", xlabel=>"Abscissa"} ); =item * Bin plots $y->bins; bins($y, {title=>"Bin plot", xl=>"Bin number", yl=>"Count"} ); =item * Point plots $y->points; points($y, {title=>"Points plot"}); =item * Logarithmic scaling line( $y, { log=>'y' } ); # semilog line( $y, { log=>'xy' } ); # log-log =item * Image display $im = 10 * sin(rvals(101,101)) / (10 + rvals(101,101)); imag $im; # Display image imag $im, 0, 1; # Set lower/upper color range =item * Overlays points($x, $y, {logx=>1}); hold; line($x, sqrt($y)*10); release; =item * Justify aspect ratio imag $im, {justify=>1} points($x, $y, {justify=>1}); =item * Erase/delete the plot window erase(); =back =head2 Simple object-oriented plotting More functionality is accessible through direct use of the PDL::Graphics::Simple object. You can set plot size, direct plots to files, and set up multi-panel plots. The constructor accepts window configuration options that set the plotting environment, including size, driving plot engine, output, and multiple panels in a single window. For interactive/display plots, the plot is rendered immediately, and lasts until the object is destroyed. For file plots, the file is not guaranteed to exist and be correct until the object is destroyed. The basic plotting method is C<plot>. C<plot> accepts a collection of arguments that describe one or more "curves" (or datasets) to plot, followed by an optional plot option hash that affects the entire plot. Overplotting is implemented via plot option, via a held/released state (as in PGPLOT), and via a convenience method C<oplot> that causes the current plot to be overplotted on the previous one. Plot style (line/points/bins/etc.) is selected via the C<with> curve option. Several convenience methods exist to create plots in the various styles. =over 3 =item * Load module and create basic objects use PDL::Graphics::Simple; $x = xvals(51)/5; $y = $x**3; $win = pgswin(); # plot to a default-shape window $win = pgswin( size=>[4,3] ); # size is given in inches by default $win = pgswin( size=>[10,5,'cm'] ); # You can feed in other units too $win = pgswin( out=>'plot.ps' ); # Plot to a file (type is via suffix) $win = pgswin( engine=>'gnuplot' ); # Pick a particular plotting engine $win = pgswin( multi=>[2,2] ); # Set up for a 2x2 4-panel plot =item * Simple plots with C<plot> $win->plot( with=>'line', $x, $y, {title=>"Simple line plot"} ); $win->plot( with=>'errorbars', $x, $y, sqrt($y), {title=>"Error bars"} ); $win->plot( with=>'circles', $x, $y, sin($x)**2 ); =item * Plot overlays # All at once $win->plot( with=>'line', $x, $y, with=>'circles', $x, $y/2, sqrt($y) ); # Using oplot (IDL-style; PLplot-style) $win->plot( with=>'line', $x, $y ); $win->oplot( with=>'circles', $x, $y/2, sqrt($y) ); # Using object state (PGPLOT-style) $win->line( $x, $y ); $win->hold; $win->circles( $x, $y/2, sqrt($y) ); $win->release; =back =head1 FUNCTIONS =cut package PDL::Graphics::Simple; use strict; use warnings; use PDL; use PDL::Options q/iparse/; use File::Temp qw/tempfile tempdir/; use Scalar::Util q/looks_like_number/; our $VERSION = '1.016'; $VERSION =~ s/_//g; ############################## # Exporting use base 'Exporter'; our @EXPORT = qw(pgswin line points bins imag cont hold release erase); our @EXPORT_OK = (@EXPORT, qw(image plot)); our $API_VERSION = '1.012'; # PGS version where that API started ############################## # Configuration # Knowledge base containing found info about each possible backend our $mods = {}; our $mod_abbrevs = undef; our $last_successful_type = undef; our $global_plot = undef; # lifted from PDL::Demos::list sub _list_submods { my @d = @_; my @found; my %found_already; foreach my $path ( @INC ) { next if !-d (my $dir = File::Spec->catdir( $path, @d )); my @c = do { opendir my $dirfh, $dir or die "$dir: $!"; grep !/^\./, readdir $dirfh }; for my $f (grep /\.pm$/ && -f File::Spec->catfile( $dir, $_ ), @c) { $f =~ s/\.pm//; my $found_mod = join "::", @d, $f; next if $found_already{$found_mod}++; push @found, $found_mod; } for my $t (grep -d $_->[1], map [$_, File::Spec->catdir( $dir, $_ )], @c) { my ($subname, $subd) = @$t; # one extra level my @c = do { opendir my $dirfh, $subd or die "$subd: $!"; grep !/^\./, readdir $dirfh }; for my $f (grep /\.pm$/ && -f File::Spec->catfile( $subd, $_ ), @c) { $f =~ s/\.pm//; my $found_mod = join "::", @d, $subname, $f; next if $found_already{$found_mod}++; push @found, $found_mod; } } } @found; } for my $module (_list_submods(qw(PDL Graphics Simple))) { (my $file = $module) =~ s/::/\//g; require "$file.pm"; } $mod_abbrevs ||= _make_abbrevs($mods); # Deal with abbreviations. =head2 show =for usage PDL::Graphics::Simple::show =for ref C<show> lists the supported engines and a one-line synopsis of each. =cut sub show { my $format = "%-10s %-30s %-s\n"; printf($format, "NAME","Module","(synopsis)"); printf($format, "----","------","----------"); for my $engine( sort keys %$mods ) { printf($format, $engine, $mods->{$engine}->{engine}, $mods->{$engine}->{synopsis}); } print "\n"; } ############################## # Constructor - scan through registered subclasses and generate the correct one. =head2 pgswin - exported constructor =for usage $w = pgswin( %opts ); =for ref C<pgswin> is a constructor that is exported by default into the using package. Calling C<pgswin(%opts)> is exactly the same as calling C<< PDL::Graphics::Simple->new(%opts) >>. =head2 new =for usage $w = PDL::Graphics::Simple->new( %opts ); =for ref C<new> is the main constructor for PDL::Graphics::Simple. It accepts a list of options about the type of window you want: =over 3 =item engine If specified, this must be one of the supported plotting engines. You can use a module name or the shortened name. If you don't give one, the constructor will try the last one you used, or else scan through existing modules and pick one that seems to work. It will first check the environment variable C<PDL_SIMPLE_ENGINE>, and as of 1.011, only that will be tried, but if you didn't specify one, all known engines are tried in alphabetical order until one works. =item size This is a window size as an ARRAY ref containing [width, height, units]. If no units are specified, the default is "inches". Accepted units are "in","pt","px","mm", and "cm". The conversion used for pixels is 100 px/inch. =item type This describes the kind of plot to create, and should be either "file" or "interactive" - though only the leading character is checked. If you don't specify either C<type> or C<output> (below), the default is "interactive". If you specify only C<output>, the default is "file". =item output This should be a window number or name for interactive plots, or a file name for file plots. The default file name is "plot.png" in the current working directory. Individual plotting modules all support at least '.png', '.pdf', and '.ps' -- via format conversion if necessary. Most other standard file types are supported but are not guaranteed to work. =item multi This enables plotting multiple plots on a single screen. You feed in a single array ref containing (nx, ny). Subsequent calls to plot send graphics to subsequent locations on the window. The ordering is always horizontal first, and left-to-right, top-to-bottom. B<NOTE> for multiplotting: C<oplot> does not work and will cause an exception. This is a limitation imposed by Gnuplot. =back =cut our $new_defaults = { engine => '', size => [8,6,'in'], type => '', output => '', multi => undef }; sub pgswin { __PACKAGE__->new(@_) } sub _translate_new { my $opt_in = shift; $opt_in = {} unless(defined($opt_in)); $opt_in = { $opt_in, @_ } if !ref $opt_in; my $opt = { iparse( $new_defaults, $opt_in ) }; ############################## # Pick out a working plot engine... unless ($opt->{engine}) { # find the first working subclass... unless ($last_successful_type) { my @try = $ENV{'PDL_SIMPLE_ENGINE'} || sort keys %$mods; attempt: for my $engine( @try ) { print "Trying $engine ($mods->{$engine}->{engine})..."; my $s; my $a = eval { $mods->{$engine}{module}->can('check')->() }; if ($@) { chomp $@; $s = "$@"; } else { $s = ($a ? "ok" : "nope"); } print $s."\n"; if ($a) { $last_successful_type = $engine; last attempt; } } barf "Sorry, all known plotting engines failed. Install one and try again" unless $last_successful_type; } $opt->{engine} = $last_successful_type; } my $engine = $mod_abbrevs->{lc($opt->{engine})}; unless(defined($engine) and defined($mods->{$engine})) { barf "$opt->{engine} is not a known plotting engine. Use PDL::Graphics::Simple::show() for a list"; } $last_successful_type = $opt->{engine}; my $size = _regularize_size($opt->{size},'in'); my $type = $ENV{PDL_SIMPLE_OUTPUT} ? 'f' : $opt->{type}; my $output = $ENV{PDL_SIMPLE_OUTPUT} || $opt->{output}; unless ($type) { # Default to file if output looks like a filename; to interactive otherwise. $type = ( ($output =~ m/\.(\w{2,4})$/) ? 'f' : 'i' ); } unless ($type =~ m/^[fi]/i) { barf "$type is not a known output type (must be 'file' or 'interactive')"; } # Default to 'plot.png' if no output is specified. $output ||= $type eq 'f' ? "plot.png" : ""; # Hammer it into a '.png' if no suffix is specified if ( $type =~ m/^f/i and $output !~ m/\.(\w{2,4})$/ ) { $output .= ".png"; } # Error-check multi if( defined($opt->{multi}) ) { if( ref($opt->{multi}) ne 'ARRAY' or @{$opt->{multi}} != 2 ) { barf "PDL::Graphics::Simple::new: 'multi' option requires a 2-element ARRAY ref"; } $opt->{multi}[0] ||= 1; $opt->{multi}[1] ||= 1; } my $params = { size=>$size, type=>$type, output=>$output, multi=>$opt->{multi} }; ($engine, $params); } sub new { my $pkg = shift; my ($engine, $params) = &_translate_new; my $obj = $mods->{$engine}{module}->new($params); bless { engine=>$engine, params=>$params, obj=>$obj }, $pkg; } =head2 plot =for usage $w = PDL::Graphics::Simple->new( %opts ); $w->plot($data); =for ref C<plot> plots zero or more traces of data on a graph. It accepts two kinds of options: plot options that affect the whole plot, and curve options that affect each curve. The arguments are divided into "curve blocks", each of which contains a curve options hash followed by data. If the last argument is a hash ref, it is always treated as plot options. If the first and second arguments are both hash refs, then the first argument is treated as plot options and the second as curve options for the first curve block. =head3 Plot options: =over 3 =item oplot If this is set, then the plot overplots a previous plot. =item title If this is set, it is a title for the plot as a whole. =item xlabel If this is set, it is a title for the X axis. =item ylabel If this is set, it is a title for the Y axis. =item xrange If this is set, it is a two-element ARRAY ref containing a range for the X axis. If it is clear, the axis is autoscaled. =item yrange If this is set, it is a two-element ARRAY ref containing a range for the Y axis. If it is clear, the axis is autoscaled. =item logaxis This should be empty, "x", "y", or "xy" (case and order insensitive). Named axes are scaled logarithmically. =item crange If this is set, it is a two-element ARRAY ref containing a range for color values, full black to full white. If it is clear, the engine or plot module is responsible for setting the range. =item wedge If this is set, then image plots get a scientific colorbar on the right side of the plot. (You can also say "colorbar", "colorbox", or "cb" if you're more familiar with Gnuplot). =item justify If this is set to a true value, then the screen aspect ratio is adjusted to keep the Y axis and X axis scales equal -- so circles appear circular, and squares appear square. =item legend (EXPERIMENTAL) The "legend" plot option is intended for full support but it is currently experimental: it is not fully implemented in all the engines, and implementation is more variable than one would like in the engines that do support it. This controls whether and where a plot legend should be placed. If you set it, you supply a combination of 't','b','c','l', and 'r': indicating top, bottom, center, left, right position for the plot legend. For example, 'tl' for top left, 'tc' for center top, 'c' or 'cc' for dead center. If left unset, no legend will be plotted. If you set it but don't specify a position (or part of one), it defaults to top and left. If you supply even one 'key' curve option in the curves, legend defaults to the value 'tl' if it isn't specified. =back =head3 Curve options: =over 3 =item with This names the type of curve to be plotted. See below for supported curve types. =item key This gives a name for the following curve, to be placed in a master plot legend. If you don't specify a name but do call for a legend, the curve will be named with the plot type and number (e.g. "line 3" or "points 4"). =item width This lets you specify the width of the line, as a multiplier on the standard width the engine uses. That lets you pick normal-width or extra-bold lines for any given curve. The option takes a single positive natural number. =item style You can specify the line style in a very limited way -- as a style number supported by the backend. The styles are generally defined by a mix of color and dash pattern, but the particular color and dash pattern depend on the engine in use. The first 30 styles are guaranteed to be distinguishable. This is useful to produce, e.g., multiple traces with the same style. C<0> is a valid value. =back =head3 Curve types supported =over 3 =item points This is a simple point plot. It takes 1 or 2 columns of data. =item lines This is a simple line plot. It takes 1 or 2 columns of data. =item bins Stepwise line plot, with the steps centered on each X value. 1 or 2 columns. =item errorbars Simple points-with-errorbar plot, with centered errorbars. It takes 2 or 3 columns, and the last column is the absolute size of the errorbar (which is centered on the data point). =item limitbars Simple points-with-errorbar plot, with asymmetric errorbars. It takes 3 or 4 columns, and the last two columns are the absolute low and high values of the errorbar around each point (specified relative to the origin, not relative to the data point value). =item circles Plot unfilled circles. Requires 2 or 3 columns of data; the last column is the radius of each circle. The circles are circular in scientific coordinates, not necessarily in screen coordinates (unless you specify the "justify" plot option). =item image This is a monochrome or RGB image. It takes a 2-D or 3-D array of values, as (width x height x color-index). Images are displayed in a sepiatone color scale that enhances contrast and preserves intensity when converted to grayscale. If you use the convenience routines (C<image> or C<imag>), the "justify" plot option defaults to 1 -- so the image will be displayed with square pixel aspect. If you use C<< plot(with=>'image' ...) >>, "justify" defaults to 0 and you will have to set it if you want square pixels. For RGB images, the numerical values need to be in the range 0-255, as they are interpreted as 8 bits per plane colour values. E.g.: $w = pgswin(); # plot to a default-shape window $w->image( pdl(xvals(9,9),yvals(9,9),rvals(9,9))*20 ); # or, from an image on disk: $image_data = rpic( 'my-image.png' )->mv(0,-1); # need RGB 3-dim last $w->image( $image_data ); If you have a 2-D field of values that you would like to see with a heatmap: use PDL::Graphics::ColorSpace; sub as_heatmap { my ($d) = @_; my $max = $d->max; die "as_heatmap: can't work if max == 0" if $max == 0; $d /= $max; # negative OK my $hue = (1 - $d)*240; $d = cat($hue, pdl(1), pdl(1)); (hsv_to_rgb($d->mv(-1,0)) * 255)->byte->mv(0,-1); } $w->image( as_heatmap(rvals 300,300) ); =item contours As of 1.012. Draws contours. Takes a 2-D array of values, as (width x height), and optionally a 1-D vector of contour values. =item fits As of 1.012. Displays an image from an ndarray with a FITS header. Uses C<CUNIT[12]> etc to make X & Y axes including labels. =item polylines As of 1.012. Draws polylines, with 2 arguments (C<$xy>, C<$pen>). The "pen" has value 0 for the last point in that polyline. use PDL::Transform::Cartography; use PDL::Graphics::Simple qw(pgswin); $coast = earth_coast()->glue( 1, scalar graticule(15,1) ); $w = pgswin(); $w->plot(with => 'polylines', $coast->clean_lines); =item labels This places text annotations on the plot. It requires three input arguments: the X and Y location(s) as PDLs, and the label(s) as a list ref. The labels are normally left-justified, but you can explicitly set the alignment for each one by beginning the label with "<" for left "|" for center, and ">" for right justification, or a single " " to denote default justification (left). =back =cut # Plot options have a bunch of names for familiarity to different package users. # They're hammered into a single simplified set for transfer to the engines. our $plot_options = PDL::Options->new( { oplot=> 0, title => undef, xlabel=> undef, ylabel=> undef, legend => undef, xrange=> undef, yrange=> undef, logaxis=> "", crange=> undef, bounds=> undef, wedge => 0, justify=>undef, }); $plot_options->synonyms( { cbrange=>'crange', replot=>'oplot', xtitle=>'xlabel', ytitle=>'ylabel', key=>'legend', colorbar=>'wedge', colorbox=>'wedge', cb=>'wedge', logscale => 'logaxis', }); our $plot_types = { points => { args=>[1,2], ndims=>[1] }, polylines => { args=>[1,2], ndims=>[1,2] }, lines => { args=>[1,2], ndims=>[1] }, bins => { args=>[1,2], ndims=>[1] }, circles => { args=>[2,3], ndims=>[1] }, errorbars => { args=>[2,3], ndims=>[1] }, limitbars => { args=>[3,4], ndims=>[1] }, image => { args=>[1,3], ndims=>[2,3] }, fits => { args=>[1], ndims=>[2,3] }, contours => { args=>[1,2], ndims=>[2] }, labels => { args=>[3], ndims=>[1] }, }; our $plot_type_abbrevs = _make_abbrevs($plot_types); our $curve_options = PDL::Options->new( { with => 'lines', key => undef, style => undef, width => undef }); $curve_options->synonyms( { legend =>'key', name=>'key' }); $curve_options->incremental(0); sub _fits_convert { my ($data, $opts) = @_; eval "use PDL::Transform"; barf "PDL::Graphics::Simple: couldn't load PDL::Transform for 'with fits' option: $@" if $@; 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)); my $h = $data->gethdr; barf "PDL::Graphics::Simple: 'with fits' expected a FITS header" unless $h && ref $h eq 'HASH' && !grep !$h->{$_}, qw(NAXIS NAXIS1 NAXIS2); # Now update plot options to set the axis labels, if they haven't been updated already... my %new_opts = %$opts; for ([qw(xlabel CTYPE1 X CUNIT1 (pixels))], [qw(ylabel CTYPE2 Y CUNIT2 (pixels))], ) { my ($label, $type, $typel, $unit, $unitdef) = @$_; next if defined $new_opts{$label}; $new_opts{$label} = join(" ", $h->{$type} || $typel, $h->{$unit} ? "($h->{$unit})" : $unitdef ); } my @dims01 = map $data->dim($_), 0,1; $data = $data->map(t_identity(), \@dims01, $h); # resample removing rotation etc my ($xcoords, $ycoords) = ndcoords(@dims01)->apply(t_fits($data->hdr, {ignore_rgb=>1}))->mv(0,-1)->dog; $new_opts{xrange} = [$xcoords->minmax] if !grep defined, @{$new_opts{xrange}}; $new_opts{yrange} = [$ycoords->minmax] if !grep defined, @{$new_opts{yrange}}; ('image', \%new_opts, $data, $xcoords, $ycoords); } sub _translate_plot { my ($held, $keys) = (shift, shift); ############################## # Trap some simple errors barf "plot: requires at least one argument to plot!" if !@_; barf "plot: requires at least one argument to plot, in addition to plot options" if @_ == 1 and ref($_[0]) eq 'HASH'; barf "Undefined value given in plot args" if grep !defined(), @_; ############################## # Collect plot options. These can be in a leading or trailing # hash ref, with the leading overriding the trailing one. If the first # two elements are hash refs, then the first is plot options and # the second is curve options, otherwise we treat the first as curve options. # A curve option hash is required for every curve. my $po = {}; while (ref($_[-1]) eq 'HASH') { my $h = pop; @$po{keys %$h} = values %$h; } if (ref($_[0]) eq 'HASH' and ref($_[1]) eq 'HASH') { my $h = shift; @$po{keys %$h} = values %$h; } my $called_from_imag = delete $po->{called_from_imag}; $po = $plot_options->options($po); $po->{oplot} = 1 if $held; ############################## # Check the plot options for correctness. ### bounds is a synonym for xrange/yrange together. ### (dcm likes it) if (defined($po->{bounds})) { barf "Bounds option must be a 2-element ARRAY ref containing (xrange, yrange)" if !ref($po->{bounds}) or ref($po->{bounds}) ne 'ARRAY' or @{$po->{bounds}} != 2; for my $t ([0,'xrange'], [1, 'yrange']) { my ($i, $r) = @$t; next if !defined $po->{bounds}[$i]; warn "WARNING: bounds overriding $r since both were specified\n" if defined $po->{$r}; $po->{$r} = $po->{bounds}[$i]; } } for my $r (grep defined($po->{$_}), qw(xrange yrange)) { barf "Invalid ".(uc substr $r, 0, 1)." range (must be a 2-element ARRAY ref with differing values)" if !ref($po->{$r}) or ref($po->{$r}) ne 'ARRAY' or @{$po->{$r}} != 2 or $po->{$r}[0] == $po->{$r}[1]; } if( defined($po->{wedge}) ) { $po->{wedge} = !!$po->{wedge}; } if( length($po->{logaxis}) ) { if($po->{logaxis} =~ m/[^xyXY]/) { barf "logaxis must be X, Y, or XY (case insensitive)"; } $po->{logaxis} =~ tr/XY/xy/; $po->{logaxis} =~ s/yx/xy/; } unless($po->{oplot}) { $keys = []; } $po->{justify} //= ($called_from_imag ? 1 : 0); ############################## # Parse out curve blocks and check each one for existence. my @blocks = (); my $xminmax = [undef,undef]; my $yminmax = [undef,undef]; while( @_ ) { my $co = {}; my @args = (); if (ref $_[0] eq 'HASH') { $co = shift; } else { # Attempt to parse out curve option hash entries from an inline hash. # Keys must exist and not be refs and contain at least one letter. while( @_ and !ref($_[0]) and $_[0] =~ m/[a-zA-Z]/ ) { my $a = shift; my $b = shift; $co->{$a} = $b; } } ############################## # Parse curve options and expand into standard form so we can find "with". $curve_options->options({key=>undef}); my %co2 = %{$curve_options->options( $co )}; my $ptn = $plot_type_abbrevs->{ $co2{with} }; barf "Unknown plot type $co2{with}" unless defined($ptn) and defined($plot_types->{$ptn}); if($co2{key} and !defined($po->{legend})) { $po->{legend} = 'tl'; } unless( $ptn eq 'labels' ) { my $ptns = $ptn; $ptns=~s/s$//; push @$keys, $co2{key} // sprintf "%s %d",$ptns,1+@$keys; } my $pt = $plot_types->{$co2{with} = $ptn}; ############################## # Snarf up the other arguments. while( @_ and ( UNIVERSAL::isa($_[0], 'PDL') or looks_like_number($_[0]) or ref $_[0] eq 'ARRAY' ) ) { push @args, shift; } ############################## # Most array refs get immediately converted to # PDLs. But the last argument to a "with=labels" curve # needs to be left as an array ref. If it's a PDL we throw # an error, since that's a common mistake case. if ( $ptn eq 'labels' ) { barf "Last argument to 'labels' plot type must be an array ref!" if ref($args[-1]) ne 'ARRAY'; $_ = PDL->pdl($_) for grep !UNIVERSAL::isa($_,'PDL'), @args[0..$#args-1]; } else { $_ = PDL->pdl($_) for grep !UNIVERSAL::isa($_,'PDL'), @args; } ############################## # Now check options barf "plot style $ptn requires ".join(" or ", @{$pt->{args}})." columns; you gave ".(0+@args) if !grep @args == $_, @{$pt->{args}}; if ($ptn eq 'contours' and @args == 1) { my $cntr_cnt = 9; push @args, zeroes($cntr_cnt)->xlinvals($args[-1]->minmax); } elsif ($ptn eq 'polylines' and @args == 1) { barf "Single-arg form of '$ptn' must have dim 0 of 3" if $args[0]->dim(0) != 3; @args = ($args[0]->slice('0:1'), $args[0]->slice('(2)')); } elsif (defined($pt->{args}[1])) { # Add an index variable if needed barf "First arg to '$ptn' must have at least $pt->{ndims}[0] dims" if $args[0]->ndims < $pt->{ndims}[0]; if ( $pt->{args}[1] - @args == 2 ) { my @dims = ($args[0]->dims)[0,1]; unshift @args, xvals(@dims), yvals(@dims); } if ( $pt->{args}[1] - @args == 1 ) { unshift @args, xvals($args[0]); } } if ($ptn eq 'contours') { # not supposed to be compatible barf "Wrong dims for contours: need 2-D values, 1-D contour values" unless $args[0]->ndims == 2 and $args[1]->ndims == 1; ($xminmax, $yminmax) = ([0, $args[0]->dim(0)-1], [0, $args[0]->dim(1)-1]); } elsif ($ptn eq 'polylines') { # not supposed to be compatible barf "Wrong dims for contours: need 2-D values, 1-D contour values" unless $args[0]->ndims == 2 and $args[1]->ndims == 1; ($xminmax, $yminmax) = map [$_->minmax], $args[0]->using(0,1); } else { # Check that the PDL arguments all agree in a threading sense. # Since at least one type of args has an array ref in there, we have to # consider that case as a pseudo-PDL. my $dims = do { local $PDL::undefval = 1; pdl([map [ ref($_) eq 'ARRAY' ? 0+@{$_} : $_->dims ], @args]); }; my $dmax = $dims->mv(1,0)->maximum; barf "Data dimensions do not agree in plot: $dims vs max=$dmax" unless ( ($dims==1) | ($dims==$dmax) )->all; # Check that the number of dimensions is correct... barf "Data dimension (".$dims->dim(0)."-D PDLs) is not correct for plot type $ptn (all dims=$dims)" if $dims->dim(0) != $pt->{ndims}[0] and (!defined($pt->{ndims}[1]) or $dims->dim(0) != $pt->{ndims}[1]); if (@args > 1) { # Accumulate x and y ranges... my $dcorner = pdl(0,0); # Deal with half-pixel offset at edges of images if ($args[0]->dims > 1) { my $xymat = pdl( [ ($args[0]->slice("(1),(0)")-$args[0]->slice("(0),(0)")), ($args[0]->slice("(0),(1)")-$args[0]->slice("(0),(0)")) ], [ ($args[1]->slice("(1),(0)")-$args[1]->slice("(0),(0)")), ($args[1]->slice("(0),(1)")-$args[1]->slice("(0),(0)")) ] ); $dcorner = ($xymat x pdl(0.5,0.5)->slice("*1"))->slice("(0)")->abs; } for my $t ([0, qr/x/, $xminmax], [1, qr/y/, $yminmax]) { my ($i, $re, $var) = @$t; my @minmax = $args[$i]->minmax; $minmax[0] -= $dcorner->at($i); $minmax[1] += $dcorner->at($i); if ($po->{logaxis} =~ $re) { if ($minmax[1] > 0) { $minmax[0] = $args[0]->where( ($args[0]>0) )->min if $minmax[0] <= 0; } else { $minmax[0] = $minmax[1] = undef; } } $var->[0] = $minmax[0] if defined($minmax[0]) and ( !defined($var->[0]) or $minmax[0] < $var->[0] ); $var->[1] = $minmax[1] if defined($minmax[1]) and ( !defined($var->[1]) or $minmax[1] > $var->[1] ); } } } # Push the curve block to the list. unshift @args, \%co2; push @blocks, \@args; } ############################## # Deal with context-dependent defaults. for my $t (['xrange',$xminmax], ['yrange',$yminmax]) { my ($r, $var) = @$t; $po->{$r}[0] //= $var->[0]; $po->{$r}[1] //= $var->[1]; my $defined_range_vals = grep defined, @{$po->{$r}}[0,1]; next if !$defined_range_vals; barf "got 1 defined value for '$r'" if $defined_range_vals < 2; if ($po->{$r}[0] == $po->{$r}[1]) { $po->{$r}[0] -= 0.5; $po->{$r}[1] += 0.5; } } for my $t (grep $po->{logaxis} =~ $_->[1], ['xrange', qr/x/], ['yrange', qr/y/]) { my ($r) = @$t; barf "logarithmic ".(uc substr $r, 0, 1)." axis requires positive limits ($r is [$po->{$r}[0],$po->{$r}[1]])" if $po->{$r}[0] <= 0 or $po->{$r}[1] <= 0; } ($keys, $po, @blocks); } sub plot { my $obj = &_invocant_or_global; my @args = _translate_plot(@$obj{qw(held keys)}, @_); barf "Can't oplot in multiplot" if $obj->{params}{multi} and $args[1]{oplot}; $obj->{obj}{keys} = $obj->{keys} = shift @args; $obj->{obj}->plot(@args); } =head2 oplot =for usage $w = PDL::Graphics::Simple->new( %opts ); $w->plot($data); $w->oplot($more_data); =for ref C<oplot> is a convenience interface. It is exactly equivalent to C<plot> except it sets the plot option C<oplot>, so that the plot will be overlain on the previous one. =cut sub oplot { push @_, {} if ref($_[-1]) ne 'HASH'; $_[-1]{oplot} = 1; plot(@_); } =head2 line, points, bins, image, imag, cont =for usage # Object-oriented convenience $w = PDL::Graphics::Simple->new( % opts ); $w->line($data); # Very Lazy Convenience $a = xvals(50); lines $a; $im = sin(rvals(100,100)/3); imag $im; imag $im, 0, 1, {title=>"Bullseye?", j=>1}; =for ref C<line>, C<points>, and C<image> are convenience interfaces. They are exactly equivalent to C<plot> except that they set the default "with" curve option to the appropriate plot type. C<imag> is even more DWIMMy for PGPLOT users or PDL Book readers: it accepts up to three non-hash arguments at the start of the argument list. The second and third are taken to be values for the C<crange> plot option. C<cont> resembles the PGPLOT function. =cut sub _translate_convenience { my $type = shift; my @args = @_; barf "Not enough args to PDL::Graphics::Simple::$type()" if( @args < 1 ); if( ref($args[0]) eq 'HASH' ) { if( ref($args[1]) eq 'HASH' ) { $args[1]->{with} = $type; } else { $args[0]->{with} = $type; } } else { unshift(@args, 'with', $type); } @args; } sub _convenience_plot { my $type = shift; my $me = &_invocant_or_global; my @args = _translate_plot(@$me{qw(held keys)}, _translate_convenience($type, @_)); $me->{obj}{keys} = $me->{keys} = shift @args; $me->{obj}->plot(@args); } sub line { _convenience_plot( 'line', @_ ); } *PDL::lines = *lines = *PDL::line = \&line; sub bins { _convenience_plot( 'bins', @_ ); } *PDL::bins = \&bins; sub points { _convenience_plot( 'points', @_ ); } *PDL::points = \&points; sub image { _convenience_plot( 'image', @_, {called_from_imag=>1}); } # Don't PDL-namespace image since it's so different from imag. sub cont { _convenience_plot( 'contours', @_ ); } sub _translate_imag { my $me = &_invocant_or_global; my $data = shift; my $crange = []; unless(ref($_[0]) eq 'HASH') { $crange->[0] = shift; unless(ref($_[0]) eq 'HASH') { $crange->[1] = shift; } } # Try to put the crange into the plot options, if they are present unless( ref($_[$#_]) eq 'HASH' ) { push @_, {}; } $_[$#_]->{crange} = $crange; ($me, $data, @_, {called_from_imag=>1}); } sub imag { _convenience_plot( 'image', &_translate_imag ); } *PDL::imag = \&imag; =head2 erase =for usage use PDL::Graphics::Simple qw/erase hold release/; line xvals(10), xvals(10)**2 ; sleep 5; erase; =for ref C<erase> removes a global plot window. It should not be called as a method. To remove a plot window contained in a variable, undefine it. =cut our $global_object; sub erase { my $me = shift; if(defined($me)) { barf "PDL::Graphics::Simple::erase: no arguments, please"; } if(defined($global_object)) { undef $global_object; } } =head2 hold =for usage use PDL::Graphics::Simple; line xvals(10); hold; line xvals(10)**0.5; =for ref Causes subsequent plots to be overplotted on any existing one. Called as a function with no arguments, C<hold> applies to the global object. Called as an object method, it applies to the object. =cut sub hold { my $me = shift; if(defined($me) and UNIVERSAL::isa($me,"PDL::Graphics::Simple")) { $me->{held} =1; } elsif(defined($global_object)) { $global_object->{held}=1; } else { barf "Can't hold a nonexistent window!"; } } =head2 release =for usage use PDL::Graphics::Simple; line xvals(10); hold; line xvals(10)**0.5; release; line xvals(10)**0.5; =for ref Releases a hold placed by C<hold>. =cut sub release { my $me = shift; if(defined($me) and UNIVERSAL::isa($me,"PDL::Graphics::Simple")) { $me->{held} = 0; } elsif(defined($global_object)) { $global_object->{held} = 0; } else { barf "Can't release a nonexistent window!"; } } ############################## # Utilities. sub _invocant_or_global { return shift if UNIVERSAL::isa($_[0], "PDL::Graphics::Simple"); return $global_object if defined $global_object; $global_object = pgswin(); } ### Units table - cheesy but also horrible. our $units = { 'inch'=>1, 'inc'=>1, 'in' =>1, 'i' => 1, 'char'=>16, 'cha'=>16, 'ch'=>16, 'c'=>16, 'points'=>72, 'point'=>72, 'poin'=>72, 'poi'=>72, 'po'=>72, 'pt'=>72, 'px'=>100, 'pixels'=>100, 'pixel'=>100, 'pixe'=>100, 'pix'=>100, 'pi'=>100, 'p'=>100, 'mm' => 25.4, 'cm' => 2.54 }; ### regularize_size -- handle the various cases for the size option to new. sub _regularize_size { my $size = shift; my $unit = shift; $unit =~ tr/A-Z/a-z/; barf "size specifier unit '$unit' is unrecognized" unless($units->{$unit}); unless(ref($size)) { $size = [ $size, $size, 'in' ]; } elsif(ref($size) ne 'ARRAY') { barf "size option requires an ARRAY ref or scalar"; } barf "size array must have at least one element" unless(@{$size}); $size->[1] = $size->[0] if(@{$size}==1); $size->[2] = 'in' if(@{$size}==2); barf "size array can have at most three elements" if(@{$size}>3); barf "size array unit '$unit' is unrecognized" unless($units->{$unit}); barf "new: size must be nonnegative" unless( $size->[0] > 0 and $size->[1] > 0 ); my $ret = []; $ret->[0] = $size->[0] / $units->{$size->[2]} * $units->{$unit}; $ret->[1] = $size->[1] / $units->{$size->[2]} * $units->{$unit}; $ret->[2] = $unit; return $ret; } ########## # make_abbrevs - generate abbrev hash for module list. Cheesy but fast to code. sub _make_abbrevs { my $hash = shift; my $abbrevs = {}; my %ab = (); for my $k(keys %$hash) { my $s = $k; while(length($s)) { push @{$ab{$s}},$k; chop $s; } } for my $k(keys %ab) { $abbrevs->{$k} = $ab{$k}->[0] if( @{$ab{$k}} == 1); } return $abbrevs; } =head2 register =for usage PDL::Graphics::Simple::register( \%description ); =for ref This is the registration mechanism for new driver methods for C<PDL::Graphics::Simple>. Compliant drivers should announce themselves at compile time by calling C<register>, passing a hash ref containing the following keys: =over =item shortname This is the short name of the engine, by which users refer to it colloquially. =item module This is the fully qualified package name of the module itself. =item engine This is the fully qualified package name of the Perl API for the graphics engine. =item synopsis This is a brief string describing the backend =item pgs_api_version This is a one-period version number of PDL::Graphics::Simple against which the module has been tested. A warning will be thrown if the version isn't the same as C<$PDL::Graphics::Simple::API_VERSION>. That value will only change when the API changes, allowing the modules to be released independently, rather than with every version of PDL::Graphics::Simple as up to 1.010. =back =cut sub register { my $mod = shift; my $module = $mod->{module}; barf __PACKAGE__."::register: \\%description from ".caller()." looks fishy, no 'module' key found; I give up" unless defined $module; for (qw/shortname engine synopsis pgs_api_version/) { barf __PACKAGE__."::register: \\%description from $module looks fishy, no '$_' key found; I give up" unless defined $mod->{$_}; } warn __PACKAGE__."::register: $module is out of date (mod='$mod->{pgs_api_version}' PGS='$API_VERSION') - winging it" unless $mod->{pgs_api_version} eq $API_VERSION; $mods->{$mod->{shortname}} = $mod; } =head1 IMPLEMENTATION PDL::Graphics::Simple defines an object that represents a plotting window/interface. When you construct the object, you can either specify a backend or allow PDL::Graphics::Simple to find a backend that seems to work on your system. Subsequent plotting commands are translated and passed through to that working plotting module. PDL::Graphics::Simple calls are dispatched in a two-step process. The main module curries the arguments, parsing them into a regularized form and carrying out DWIM optimizations. The regularized arguments are passed to implementation classes that translate them into the APIs of their respective plot engines. The classes are very simple and implement only a few methods, outlined below. They are intended only to be called by the PDL::Graphics::Simple driver, which limits the need for argument processing, currying, and parsing. The classes are thus responsible only for converting the regularized parameters to plot calls in the form expected by their corresponding plot modules. PDL::Graphics::Simple works through a call-and-dispatch system rather than taking full advantage of inheritance. That is for two reasons: (1) it makes central control mildly easier going forward, since calls are dispatched through the main module; and (2) it makes the non-object-oriented interface easier to implement since the main interface modules are in one place and can access the global object easily. =head2 Interface class methods Each interface module supports the following methods: =cut # Note that these are =head3; that means they won't be indexed by PDL::Doc, # which is a Good Thing as they are internal routines. =head3 check C<check> attempts to load the relevant engine module and test that it is working. In addition to returning a boolean value indicating success if true, it registers its success or failure in the main $mods hash, under the "ok" flag. If there is a failure that generates an error message, the error is logged under the "msg" flag. C<check> accepts one parameter, "force". If it is missing or false, and "ok" is defined, check just echoes the prior result. If it is true, then check actually checks the status regardless of the "ok" flag. =head3 new C<new> creates and returns an appropriate plot object, or dies on failure. Each C<new> method should accept the following options, defined as in the description for PDL::Graphics::Simple::new (above). There is no need to set default values as all arguments should be set to reasonable values by the superclass. For file output, the method should autodetect file type by dot-suffix. At least ".png" and ".ps" should be supported. Required options: C<size>, C<type>, C<output>, C<multi>. =head3 plot C<plot> generates a plot. It should accept a standardized collection of options as generated by the PDL::Graphics::Simple plot method: standard plot options as a hash ref, followed by a list of curve blocks. It should render either a full-sized plot that fills the plot window or, if the object C<multi> option was set on construction, the current subwindow. For interactive plot types it should act as an atomic plot operation, displaying the complete plot. For file plot types the atomicity is not well defined, since multiplot grids may be problematic, but the plot should be closed as soon as practical. The plot options hash contains the plot options listed under C<plot>, above, plus one additional flag - C<oplot> - that indicates the new data is to be overplotted on top of whatever is already present in the plotting window. All options are present in the hash. The C<title>, C<xlabel>, C<ylabel>, and C<legend> options default to undef, which indicates the corresponding plot feature should not be rendered. The C<oplot>, C<xrange>, C<yrange>, C<crange>, C<wedge>, and C<justify> parameters are always both present and defined. If the C<oplot> plot option is set, then the plot should be overlain on a previous plot, not losing any range settings, nor obeying any given. B<NOTE> that if any data given to the original plot or any overplots might be changed before plot updates happen, it is the user's responsibility to pass in copies, since some engines (Prima and Gnuplot) only store data by reference for performance reasons. Otherwise the module should display a fresh plot. Each curve block consists of an ARRAY ref with a hash in the 0 element and all required data in the following elements, one PDL per (ordinate/abscissa). For 1-D plot types (like points and lines) the PDLs must be 1D. For image plot types the lone PDL must be 2D (monochrome) or 3D(RGB). The hash in the curve block contains the curve options for that particular curve. They are all set to have reasonable default values. The values passed in are C<with> and C<key>. If the C<legend> option is undefined, then the curve should not be placed into a plot legend (if present). =head1 ENVIRONMENT Setting some environment variables affects operation of the module: =head2 PDL_SIMPLE_ENGINE See L</new>. =head2 PDL_SIMPLE_DEVICE If this is a meaningful thing for the given engine, this value will be used instead of the driver module guessing. =head2 PDL_SIMPLE_OUTPUT Overrides passed-in arguments, to create the given file as output. If it contains C<%d>, then with Gnuplot that will be replaced with an increasing number (an amazing L<PDL::Graphics::Gnuplot> feature). =head1 TO-DO Deal with legend generation. In particular: adding legends with multi-call protocols is awkward and leads to many edge cases in the internal protocol. This needs more thought. =head1 REPOSITORY L<https://github.com/PDLPorters/PDL-Graphics-Simple> =head1 AUTHOR Craig DeForest, C<< <craig@deforest.org> >> =head1 LICENSE AND COPYRIGHT Copyright 2013 Craig DeForest This program is free software; you can redistribute it and/or modify it under the terms of either: the Gnu General Public License v1 as published by the Free Software Foundation; or the Perl Artistic License included with the Perl language. see http://dev.perl.org/licenses/ for more information. =cut 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/MANIFEST������������������������������������������������������������������0000644�0001750�0001750�00000000641�14742232265�016214� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Changes lib/PDL/Graphics/Simple.pm lib/PDL/Graphics/Simple/Gnuplot.pm lib/PDL/Graphics/Simple/PGPLOT.pm lib/PDL/Graphics/Simple/PLplot.pm lib/PDL/Graphics/Simple/Prima.pm Makefile.PL MANIFEST This list of files README.pod t/europe.fits t/simple.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) �����������������������������������������������������������������������������������������������PDL-Graphics-Simple-1.016/Makefile.PL���������������������������������������������������������������0000644�0001750�0001750�00000005025�14674573425�017050� 0����������������������������������������������������������������������������������������������������ustar �osboxes�������������������������osboxes����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use ExtUtils::MakeMaker; sub MY::libscan { package MY; my ($self, $file) = @_; # Don't install the README.pod or any .pl file return undef if $file =~ /\.pl$|^README.pod/; return $self->SUPER::libscan ($file); } sub MY::postamble { my $text = <<'FOO'; install :: @echo "Updating PDL documentation database..."; @$(PERL) -e 'sub PDL::Doc::add_module {print STDERR "legacy PDL detected. Cannot install docs.\n"}; eval q{use PDL::Doc; PDL::Doc::add_module(q[PDL::Graphics::Simple];}' FOO return $text; } my %prereq = ( 'PDL' => '2.089', # contour_polylines 'File::Temp' => 0, 'Time::HiRes' => 0); my %min_version = ( 'PDL::Graphics::Gnuplot' => '2.029', # Gnuplot 6 warnings fixes ); for my $opt_dep (sort keys %min_version) { (my $file = $opt_dep) =~ s#::#/#g; next if !eval { require "$file.pm"; 1 }; # not installed, fine next if eval { $opt_dep->VERSION($min_version{$opt_dep}); 1 }; $prereq{$opt_dep} = $min_version{$opt_dep}; } WriteMakefile( NAME => 'PDL::Graphics::Simple', AUTHOR => ['Craig DeForest <craig@deforest.org>'], VERSION_FROM => 'lib/PDL/Graphics/Simple.pm', ABSTRACT_FROM => 'lib/PDL/Graphics/Simple.pm', LICENSE=> 'perl', PREREQ_PM => \%prereq, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '7.12', # working .g.c }, TEST_REQUIRES => { 'Test::More' => '0.88', }, META_ADD => { resources => { homepage => 'https://github.com/PDLPorters/PDL-Graphics-Simple', repository => 'git://github.com/PDLPorters/PDL-Graphics-Simple.git', bugtracker => 'https://github.com/PDLPorters/PDL-Graphics-Simple/issues' } }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'PDL-Graphics-Simple-*' }, ); # reroute the main POD into a separate README.pod if requested. This is here # purely to generate a README.pod for the github front page my $POD_header = <<EOF; =head1 OVERVIEW PDL::Graphics::Simple is a unified plotting interface for PDL. The main distribution site is CPAN; the development repository is on github.com. =cut EOF $POD_header =~ s{^ }{}gm; if(exists $ARGV[0] && $ARGV[0] eq 'README.pod') { open MOD, 'lib/PDL/Graphics/Simple.pm' or die "Couldn't open main module"; open README, '>README.pod' or die "Couldn't open README.pod"; print README $POD_header; while (<MOD>) { if (/^=/../^=cut/) { print README; } } } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������