move PDL::Graphics::LUT to this distro as only useful for PGPLOT

CHANGES

@@ -1,3 +1,5 @@
+- move PDL::Graphics::LUT to this distro
+
 2.30 2024-07-29
 - restructure .pm under "lib", CI and doc tweaks
 

MANIFEST

@@ -11,6 +11,61 @@ INSTALL-MacOSX
 INSTALL-Win32
 lib/PDL/Demos/PGPLOT.pm
 lib/PDL/Demos/PGPLOT_OO.pm
+lib/PDL/Graphics/LUT.pm
+lib/PDL/Graphics/LUT/ramps/equa.fits
+lib/PDL/Graphics/LUT/ramps/expo.fits
+lib/PDL/Graphics/LUT/ramps/gamma.fits
+lib/PDL/Graphics/LUT/ramps/jigsaw.fits
+lib/PDL/Graphics/LUT/ramps/lasritt.fits
+lib/PDL/Graphics/LUT/ramps/log.fits
+lib/PDL/Graphics/LUT/ramps/neg.fits
+lib/PDL/Graphics/LUT/ramps/neglog.fits
+lib/PDL/Graphics/LUT/ramps/null.fits
+lib/PDL/Graphics/LUT/ramps/ramp.fits
+lib/PDL/Graphics/LUT/ramps/stairs.fits
+lib/PDL/Graphics/LUT/tables/aips0.fits
+lib/PDL/Graphics/LUT/tables/backgr.fits
+lib/PDL/Graphics/LUT/tables/bgyrw.fits
+lib/PDL/Graphics/LUT/tables/blue.fits
+lib/PDL/Graphics/LUT/tables/blulut.fits
+lib/PDL/Graphics/LUT/tables/color.fits
+lib/PDL/Graphics/LUT/tables/green.fits
+lib/PDL/Graphics/LUT/tables/heat.fits
+lib/PDL/Graphics/LUT/tables/idl11.fits
+lib/PDL/Graphics/LUT/tables/idl12.fits
+lib/PDL/Graphics/LUT/tables/idl14.fits
+lib/PDL/Graphics/LUT/tables/idl15.fits
+lib/PDL/Graphics/LUT/tables/idl2.fits
+lib/PDL/Graphics/LUT/tables/idl4.fits
+lib/PDL/Graphics/LUT/tables/idl5.fits
+lib/PDL/Graphics/LUT/tables/idl6.fits
+lib/PDL/Graphics/LUT/tables/isophot.fits
+lib/PDL/Graphics/LUT/tables/light.fits
+lib/PDL/Graphics/LUT/tables/manycol.fits
+lib/PDL/Graphics/LUT/tables/pastel.fits
+lib/PDL/Graphics/LUT/tables/rainbow.fits
+lib/PDL/Graphics/LUT/tables/rainbow1.fits
+lib/PDL/Graphics/LUT/tables/rainbow2.fits
+lib/PDL/Graphics/LUT/tables/rainbow3.fits
+lib/PDL/Graphics/LUT/tables/rainbow4.fits
+lib/PDL/Graphics/LUT/tables/ramp.fits
+lib/PDL/Graphics/LUT/tables/random.fits
+lib/PDL/Graphics/LUT/tables/random1.fits
+lib/PDL/Graphics/LUT/tables/random2.fits
+lib/PDL/Graphics/LUT/tables/random3.fits
+lib/PDL/Graphics/LUT/tables/random4.fits
+lib/PDL/Graphics/LUT/tables/random5.fits
+lib/PDL/Graphics/LUT/tables/random6.fits
+lib/PDL/Graphics/LUT/tables/real.fits
+lib/PDL/Graphics/LUT/tables/red.fits
+lib/PDL/Graphics/LUT/tables/smooth.fits
+lib/PDL/Graphics/LUT/tables/smooth1.fits
+lib/PDL/Graphics/LUT/tables/smooth2.fits
+lib/PDL/Graphics/LUT/tables/smooth3.fits
+lib/PDL/Graphics/LUT/tables/staircase.fits
+lib/PDL/Graphics/LUT/tables/stairs8.fits
+lib/PDL/Graphics/LUT/tables/stairs9.fits
+lib/PDL/Graphics/LUT/tables/standard.fits
 lib/PDL/Graphics/PGPLOT.pm
 lib/PDL/Graphics/PGPLOT/Window.pm
 lib/PDL/Graphics/PGPLOTOptions.pm
@@ -23,6 +78,7 @@ pgcompatbility.p
 pgfun.c
 PGPLOT.xs
 README
+t/lut.t
 t/pdl-graphics.t
 t/t1.t
 t/t10.t

README

@@ -1,5 +1,3 @@
-
-
 PGPLOT module for Perl
 ----------------------
 
@@ -51,3 +49,8 @@ Problems - see the file HELP
 
 News - see the file CHANGES for new features/bug fixes.
 
+NOTES FOR LUT TABLES
+--------------------
+The colour tables were taken from STARLINK's GAIA distribution, where they
+have the GNU copyleft. Further information on STARLINK and GAIA can be found
+via http://star-www.rl.ac.uk/ and http://star-www.dur.ac.uk/~pdraper/.

lib/PDL/Graphics/LUT.pm

@@ -0,0 +1,231 @@
+=head1 NAME
+
+PDL::Graphics::LUT - provides access to a number of look-up tables
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::PGPLOT;
+ use PDL::Graphics::LUT;
+
+ # what tables are available
+ my @tables = lut_names();
+
+ # get the reversed colour table 'smooth',
+ # with the gamma intensity ramp
+ my ( $l, $r, $g, $b ) = lut_data( 'smooth', 1, 'gamma' );
+
+ # use the table idl5 in ctab
+ ctab( lut_data('idl5') );
+
+=head1 DESCRIPTION
+
+PDL::Graphics::LUT contains a number of colour look-up tables
+(in rgb format) and intensity ramps, and provides routines to
+access this data.
+The format of the data is suitable for use by
+L<ctab|PDL::Graphics::PGPLOT::Window/ctab>.
+
+Unlike the initial release of the package, the data tables are
+now stored within the PDL distribution as FITS files
+(see L</$tabledir> and L</$rampdir>),
+rather than in the module itself.
+Changes to these directories will be picked up on the next call
+to one of the package functions.
+
+=head1 FUNCTIONS
+
+=head2 lut_names()
+
+=for ref
+
+Return, as a list, the names of the available colour tables.
+
+=for usage
+
+ @tables = lut_names();
+
+=head2 lut_ramps()
+
+=for ref
+
+Return, as a list, the names of the available intensity ramps.
+
+=for usage
+
+ @ramps = lut_ramps();
+
+=head2 lut_data()
+
+=for ref
+
+Load in the requested colour table and intensity ramp.
+
+=for usage
+
+ my ( $l, $r, $g, $b ) = lut_data( $table, [ $reverse, [ $ramp ] ] );
+
+Returns the levels and r, g, b components of the colour table
+C<$table>. If C<$reverse> is 1 (defaults to B<0>
+if not supplied),
+then the r, g, and b components are reversed before being
+returned.
+If not supplied, C<$ramp> defaults to B<"ramp">
+(this is a linear intensity ramp).
+
+The returned values are ndarrays containing values in the range
+0 to 1 inclusive, and are floats.
+
+=head1 VARIABLES
+
+=head2 $tabledir
+
+=for ref
+
+The directory in which the colour tables (in rgb format)
+are stored.
+
+=head2 $rampdir
+
+=for ref
+
+The directory in which the intensity ramps are stored.
+
+=head2 $suffix
+
+=for ref
+
+The suffix for the data files in C<$tabledir> and
+C<$rampdir>.
+
+=head1 FURTHER INFORMATION
+
+The colour tables were taken from the STARLINK GAIA package,
+and are provided under the GNU copyleft.
+See http://star-www.rl.ac.uk/ and
+http://star-www.dur.ac.uk/~pdraper/ for more details.
+
+=head1 AUTHOR
+
+Doug Burke ([email protected]), with thanks to
+Peter Draper/STARLINK for providing the colour-table data,
+and Christian Soeller and Karl Glazebrook for their help.
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+package PDL::Graphics::LUT;
+
+use strict;
+use warnings;
+# Just a plain function exporting package
+use Exporter;
+use Carp;
+
+# attempt to avoid Unix-specific file/directory names
+use File::Spec;
+use File::Basename;
+
+use PDL::Core qw/:Func :Internal/;    # Grab the Core names
+use PDL::Basic;
+use PDL::Types;
+use PDL::Slices;
+use PDL::IO::Misc;
+use PDL::IO::FITS;
+
+# should be careful that $suffix is a valid length on non-Unix systems
+our ($suffix, $tabledir, $rampdir) = ".fits";
+
+# should really use EXPORT_OK
+our @EXPORT    = qw( lut_names lut_ramps lut_data );
+our @EXPORT_OK = qw( $tabledir $rampdir $suffix );
+our @ISA       = qw( Exporter );
+
+# can we find the data?
+my $d = File::Spec->catdir( "PDL", "Graphics", "LUT" );
+my $lutdir = undef;
+foreach my $path ( @INC ) {
+    my $check = File::Spec->catdir( $path, $d );
+    if ( -d $check ) { $lutdir = $check; last; }
+}
+barf "Unable to find directory ${d} within the perl libraries.\n"
+    unless defined $lutdir;
+$tabledir = File::Spec->catdir( $lutdir, "tables" );
+$rampdir  = File::Spec->catdir( $lutdir, "ramps" );
+barf "Unable to find directory $tabledir within the perl libraries.\n"
+    unless -d $tabledir;
+barf "Unable to find directory $rampdir within the perl libraries.\n"
+    unless -d $rampdir;
+
+############################################################################
+
+sub _lsdir_basename {
+    my ($dir, $suffix) = @_;
+    confess "called with undef dir" if !defined $dir;
+    opendir my $fh, $dir or barf "$dir: $!";
+    map basename($_, $suffix), grep /\Q$suffix\E\z/, readdir $fh;
+}
+
+# exported functions
+
+# Return the list of available tables
+sub lut_names () { _lsdir_basename $tabledir, $suffix }
+
+# Return the list of available ramps
+sub lut_ramps () { _lsdir_basename $rampdir, $suffix }
+
+# Return the requested colour table
+sub lut_data ($;$$) {
+    my $table   = shift;
+    my $reverse = $#_ != -1 ? shift : 0;
+    my $ramp    = $#_ != -1 ? shift : "ramp";
+
+    my $lfile = File::Spec->catfile( $tabledir, "$table$suffix" );
+    my $rfile = File::Spec->catfile( $rampdir, "$ramp$suffix" );
+    print "Reading colour table and intensity ramp from:\n $lfile\n $rfile\n"
+	if $PDL::verbose;
+
+    # unknown table?
+    unless ( -e $lfile ) {
+	my @names = lut_names();
+	barf <<"EOD";
+Unknown colour table $table
+Available tables:
+ @names
+EOD
+    }
+
+    # unknown ramp?
+    unless ( -e $rfile ) {
+	my @names = lut_ramps();
+	barf <<"EOD";
+Unknown intensity ramp $ramp
+Available ramps:
+ @names
+EOD
+    }
+
+    # read in rgb data
+    my $rgb = rfits $lfile;
+    $rgb = float($rgb) if $rgb->get_datatype != $PDL_F;
+    my ( @ldims ) = $rgb->dims;
+    barf "LUT file $lfile is not the correct format (ie n by 3)\n"
+	unless $#ldims == 1 and $ldims[1] == 3;
+
+    # read in intensity data
+    my $l = rfits $rfile;
+    $l = float($l) if $l->get_datatype != $PDL_F;
+    barf "Ramp file $rfile does not match the colour table size.\n"
+	unless $l->nelem == $ldims[0];
+
+    my $s = $reverse ? "-1:0" : "";
+    return ( $l, $rgb->slice("${s},(0)"), $rgb->slice("${s},(1)"), $rgb->slice("${s},(2)") );
+
+} # sub: lut_data()
+
+# Exit with OK status
+1;

t/lut.t

@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use Test::More;
+BEGIN {
+  eval {require PDL};
+  plan skip_all => "No PDL, can't test this ($@)" if $@;
+}
+use PDL::LiteF;
+use PDL::Types;
+use PDL::Graphics::LUT;
+
+my @names = lut_names();
+isnt scalar(@names), 0, "lut_names returns non-empty list";
+
+my @cols = lut_data( $names[0] );
+is( scalar(@cols), 4, "lut_data returns 4 columns" );
+is( $cols[0]->nelem, $cols[1]->nelem, "equal number of elements in cols 0 and 1");
+is( $cols[2]->get_datatype, $PDL_F, "datatype of col 2 is float");
+
+# check we can reverse things
+my @cols2 = lut_data( $names[0], 1 );
+ok( all( approx($cols[3]->slice('-1:0'),$cols2[3])), "reverse lut works");
+
+# check we know about the intensity ramps
+my @ramps = lut_ramps();
+isnt scalar(@ramps), 0, "lut_ramps returns some ramps";
+
+# load in a different intensity ramp
+my @cols3 = lut_data( $names[0], 0, $ramps[0] );
+is( $cols3[0]->nelem, $cols3[1]->nelem, "intensity ramp nelem check");
+ok( all(approx($cols[1],$cols3[1], 1e-6)), "intensity ramp vals check")
+  or diag '[ difference, subtract, c[1], c3[1] ]: ', explain [
+    abs($cols[1] - $cols3[1]).'',
+    ($cols[1] - $cols3[1]).'',
+    $cols[1].'',
+    $cols3[1].'',
+  ];
+
+done_testing;