PDL::Graphics::PGPLOT - PGPLOT enhanced interface for PDL

  PDL::Graphics::PGPLOT - PGPLOT enhanced interface for PDL

 pdl> $a = pdl [1..100]
 pdl> $b = sqrt($a)
 pdl> line $b
 pdl> hold
 Graphics on HOLD
 pdl> $c = sin($a/10)*2 + 4
 pdl> line $c

 imag       -  Display an image (uses pgimag()/pggray() as appropriate)
 im         -  Shorthand to display an image with aspect ratio of 1
 fits_imag  -  Display a FITS image with appropriate transforms & labels
 cont       -  Display image as contour map
 fits_cont  -  Display a FITS image in scientific coordinates as a contour map
 vect       -  Display 2 images as a vector field
 fits_vect  -  Display 2 FITS images in sci. coordinates as a vector field
 ctab       -  Load an image colour table
 ctab_info  -  Get information about currently loaded colour table
 line       -  Plot vector as connected points
 points     -  Plot vector as points
 errb       -  Plot error bars
 bin        -  Plot vector as histogram (e.g. bin(hist($data)) )
 hi2d       -  Plot image as 2d histogram (not very good IMHO...)
 poly       -  Draw a polygon
 text       -  Write text in the plot area
 label_axes -  Print axis titles
 legend     -  Create a legend with different texts, linestyles etc.
 cursor     -  Interactively read cursor positions.
 circle     -  Draw a circle
 ellipse    -  Draw an ellipse.

 hold         -  Hold current plot window range - allows overlays etc.
 release      -  Release back to autoscaling of new plot window for each 
                 command
 rel          -  short alias for 'release'
 env          -  Define a plot window, put on 'hold'
 dev          -  Explicitly set a new PGPLOT graphics device
 new_window   -  Create a new plot window (use of dev is recommended)
 focus_window -  Change focus to a new window
 window_list  -  Get a list of currently exisiting plot windows
 close_window -  Close an open window

 Usage: dev $device, [$nx,$ny, $opt];

  $win = dev('/xs');

  $win1 = dev('/xs', {Aspect => 1, WindowWidth => 4});
  $win2 = dev('/xs', {Aspect => 0.5, WindowWidth => 10});

  $win = new_window($dev, $nx, $ny, $opt);

 Usage: close_window($id)

 Usage: focus_window($id);

  $win1 = dev('/xs', {WindowName => 'X-output'});
  $win2 = dev('test.ps/ps', {WindowName => 'PS-output'});

  focus_window('X-output');  # Or focus_window($win1);
  <.. Commands ..>
  focus_window($win2);       # Or focus_window('PS-output');
  <.. Commands ..>

 Usage: ($numbers, $names)=window_list();

# Graphics functions for the PDL module, this module
# requires the PGPLOT module be previously installed.
# PGPLOT functions are also made available to the caller.

package PDL::Graphics::PGPLOT;

# Just a plain function exporting package

use PDL::Core qw/:Func :Internal/; # Grab the Core names
use PDL::Graphics::PGPLOTOptions qw(default_options);
use PDL::Graphics::PGPLOT::Window;
use PGPLOT;
use Exporter;

use strict;

use vars qw (@ISA @EXPORT);

@ISA = ('Exporter');

@EXPORT = qw( dev hold release rel env bin errb line points
	      fits_imag imag imag1 fits_cont cont fits_vect vect
	      draw_wedge ctab ctab_info hi2d poly CtoF77coords
	      new_window focus_window window_list close_window
	      label_axes text legend cursor circle ellipse rectangle
	      tpoints tline retrieve_state replay turn_off_recording
	      turn_on_recording clear_state autolog get_current_window
              transform
	    );

*rel = *release;		# Alias
*image = *imag;

############################################################################

#############################################################
# This is a new version of PGPLOT which uses PDL::Options for
# option parsing.
#############################################################

# Option explanation:
#
#   Each routine has a set of options, and there is also a set of
#   global options that may or may not affect a particular routine.
#   The global options are defined here in the start of the code.
#
#   This require a minor adjustment to the PDL::Options code since
#   otherwise we would need to define the global options everywhere.
#
#   The actual setting of default parameters is split off in a separate
#   file PDL::Graphics::PGPLOTOptions - which also exports default_options
#   used below.

# The list of default global opttions, synonyms and translations.
#

END {				# Destructor to close plot when perl exits
  _close_windows();
}

#############################################################
# We now want to be able to have several plotting windows   #
# The current set of windows is stored in these             #
# variables - accessed by the local subs.  Added JB 12/7/00 #
#                                                           #
# This has lead to a substantial rewrite of the code since  #
# all the real work is now done in the Window object which  #
# this routine only provides a convenient (and backwards    #
# compatible) interface to.                                 #
#############################################################




my @_WINDOWS=();		# The list of windows to access - the value is the options.
my %_WINDOWNAMES = ();		# A map of names for each window to their number.
my $CW = undef;

sub new_window {
  my ($dev, $nx, $ny, $opt)=@_;

  if (ref($dev) eq 'HASH') {
    $opt = $dev;
    ($dev, $nx, $ny)=(undef, undef, undef);
  } elsif (ref($nx) eq 'HASH') {
    $opt = $nx;
    ($nx, $ny)=(undef, undef);
  }

  $opt={}  unless defined($opt);

  # This will cause problems if people both pass dev, nx & ny _and_
  # passes them in an options hash with poor spelling - don't do that..
  $opt->{Device}=$dev if defined($dev);
  $opt->{NXPanel}=$nx if defined($nx);
  $opt->{NYPanel}=$ny if defined($ny);

  # Now insert the necessary information in the variables above.
  #    barf "Options must be an anonymous hash!\n" if defined($_[0]) && 
  #      ref($_[0]) ne 'HASH';
  my $win = PDL::Graphics::PGPLOT::Window->new($opt);
  my ($name, $id) = ($win->name(), $win->id());
  $_WINDOWS[$id] = $name;
  $_WINDOWNAMES{$name}=$win;
  $_WINDOWNAMES{$id}=$name;	# Reverse lookup for speed

  $CW = $win;
  if (wantarray) {
    return ($id, $name, $win);
  } else {
    return $id;
  }
}


# Close all windows.
sub _close_windows {
  close_window({All=>1});	# Do all windows...
}

sub close_window {
  my ($name)=@_;

  if (ref($name) eq 'HASH') {	# Hack - to avoid checking window names..
    for (my $id=0; $id<=$#_WINDOWS; $id++) {
      next unless defined($_WINDOWS[$id]);
      my $n = $_WINDOWS[$id];
      $_WINDOWNAMES{$n}->close();
      delete $_WINDOWNAMES{$n};
      delete $_WINDOWNAMES{$id};
    }
    @_WINDOWS=();  # Remove all windows.
    $CW = undef;   # No current window
  } else {
    #
    # Delete a specific window
    #
    my $id = _get_windownumber($name);
    my $CWid = $CW->id();

    my $n= $_WINDOWNAMES{$id};	# In case the name was not passed..
    $_WINDOWNAMES{$n}->close();
    delete $_WINDOWNAMES{$n};
    delete $_WINDOWNAMES{$id};
    $_WINDOWS[$id]=undef; #splice(@_WINDOWS, $id, 1);


    if ($CWid == $id) {
      # Now determine the current window, viz the lowest numbered
      # window existing.

      $CW = undef;
      for (my $i=0; $i<=$#_WINDOWS; $i++) {
	if (defined($_WINDOWS[$i])) {
	  $CW = $_WINDOWNAMES{$_WINDOWS[$i]};
	  last;
	}
      }
    }

    # Since we set the corresponding array elements to undef - we
    # have to check if we have in fact deleted the whole shebang in
    # which case @_WINDOWS should be reset.
    @_WINDOWS=() if (!defined($CW));
  }
}

# Utility function - allowing both numbers and names to be used.

sub _get_windownumber {
  my ($name)=@_;
  if (!defined($name) || $name eq '') {
    return -1 unless defined($CW);
    return $CW->id();
  }
  my $windownumber = -1;
  if (!exists($_WINDOWNAMES{$name}) || !ref($_WINDOWNAMES{$name})) {
    # Then it ought to be a number
    if ($name =~ m/^\d+$/) {
      $windownumber = $name;
    } else {
      print "Valid window names: \n";
      foreach my $k (keys %_WINDOWNAMES) {
	print "$k\n";
      }
      barf ("I cannot switch to window $name - no such name\n");
    }
  } else {
    $windownumber = $_WINDOWNAMES{$name}->id();
  }
  barf("Invalid windownumber ($name)\n") if
    !defined($_WINDOWS[$windownumber]);

  return $windownumber;
}



{
  my $dev_options = undef; 

  sub dev {
    # This delayed creation of the options variable is for increased speed.
    # Although for dev() this is unnecessary...
    if (!defined($dev_options)) {
      $dev_options = PDL::Options->new({NewWindow => 0});
      $dev_options->warnonmissing(0); # Turn off warnings.
    }

    # Get the input options.
    my ($dev, $nx, $ny, $u_opt)=@_;

    if (ref($nx) eq 'HASH') {
      $u_opt = $nx;
      ($nx, $ny)=(undef, undef);
    }
    $u_opt = {} if !defined($u_opt);
    my $opt = $dev_options->options($u_opt);

    # Then we want to close the current one before opening a new one.
    if (!$opt->{NewWindow}) {
      my ($state,$len);
      pgqinf('STATE',$state,$len);
      close_window() if $state eq 'OPEN';
    }

    my $win=new_window(@_);
    return $win;
  }

}

# Switch to a new window.
sub focus_window {
  my ($name)=@_;
  my $windownumber = _get_windownumber($name);
  die "No such window ($name)\n" if $windownumber < 0;
  $CW = $_WINDOWNAMES{$_WINDOWS[$windownumber]};
  print "Window focus switched to Window nr $windownumber ($_WINDOWNAMES{$windownumber})\n" if $PDL::verbose;
  $CW->focus();
}

# And getting a list of windows
sub window_list {
  my @numbers=();
  my @names=();
  foreach (keys %_WINDOWNAMES) {
    if (ref($_WINDOWNAMES{$_}) eq 'PDL::Graphics::PGPLOT::Window') {
      push @names, $_;
    } else {
      push @numbers, $_;
    }
  }
  return (wantarray ? (\@numbers, \@names) : \@numbers);
}


sub label_axes {
  # We do not label axes when there is no plot window.
  return if !defined($CW);
  $CW->label_axes(@_);
}

sub turn_on_recording {
  if (!defined($CW)) {
    warn "You can only turn on recording when you have a device open!\n";
    return;
  }
  $CW->turn_on_recording();
}

sub turn_off_recording {
  if (!defined($CW)) {
    warn "You can only turn off recording when you have a device open!\n";
    return;
  }
  $CW->turn_off_recording();
}

sub retrieve_state {
  if (!defined($CW)) {
    warn "You can only retrieve the state when a device is open\n";
    return;
  }
  $CW->retrieve_state();
}


sub replay {
  if (!defined($CW)) {
    warn "You can only replay plotting commands when a device is open!\n";
    return;
  }
  $CW->replay(@_);
}

sub clear_state {
  if (!defined($CW)) {
    warn "You can only clear the state when a device is open\n";
    return;
  }
  $CW->clear_state();
}


sub autolog { # for this one we use the class method to set autolog globally
  dev() if !defined($CW);
  PDL::Graphics::PGPLOT::Window->autolog(@_);
}

sub text {
  barf 'Open a plot window first!' if !defined($CW);
  $CW->text(@_);
}

sub cursor {
  barf 'Open a plot window first!' if !defined($CW);
  $CW->cursor(@_);
}

sub legend {
  barf 'Open a plot window first!' if !defined($CW);
  $CW->legend(@_);
}

# should add these routines to EXPORT array as we create
# each routine
#
foreach my $func (
		  qw(
		     env bin cont fits_cont errb line tline points tpoints
		     imag fits_imag imag1 draw_wedge 
		     ctab ctab_info hi2d poly vect fits_vect
		     CtoF77coords circle ellipse rectangle 
		     ) ) {
    eval <<"ENDOFFUNC";
sub $func {
    dev() if !defined(\$CW);
    \$CW->${func}(\@_);
}
ENDOFFUNC
}

sub transform {
  barf 'Open a plot window first!' if !defined($CW);
  $CW->transform(@_);
}

sub hold    { return if !defined($CW); $CW->hold(); print "Graphics on HOLD\n" if $PDL::verbose;};
sub release { return if !defined($CW); $CW->release(); print "Graphics RELEASED\n" if $PDL::verbose;};
#sub held { return 0 if !defined($CW); return $CW->held()};
#sub current_device { return $CW->device(); };

sub get_current_window { return $CW; }  # return current window or undef if none exists

1;				# Exit with OK status