#!/usr/bin/perl -w

use strict;

use blib;

use Tk;
use Tk::Pgplot;
use PGPLOT;

use constant IMAGE_SIZE => 129;
use constant SLICE_SIZE => 100;
use constant XA => int -(IMAGE_SIZE)/2;
use constant XB => int  IMAGE_SIZE/2;
use constant YA => int -(IMAGE_SIZE)/2;
use constant YB => int  IMAGE_SIZE/2;
use constant SCALE => 40/IMAGE_SIZE;

sub create_main_menubar ($);
sub create_image_area ($);
sub create_slice_area ($);
sub create_save_dialog ($);
sub create_help_dialog ($);
sub create_world_labels ($);
sub create_option_menu ($$);

# Define some colour tables.

# Define single-colour ramp functions.
my $grey_l  = [0.0,1.0];
my $grey_c  = [0.0,1.0];


# Define a rainbow colour table.
my $rain_l = [-0.5, 0.0, 0.17, 0.33, 0.50, 0.67, 0.83, 1.0, 1.7];
my $rain_r = [ 0.0, 0.0,  0.0,  0.0,  0.6,  1.0,  1.0, 1.0, 1.0];
my $rain_g = [ 0.0, 0.0,  0.0,  1.0,  1.0,  1.0,  0.6, 0.0, 1.0];
my $rain_b = [ 0.0, 0.3,  0.8,  1.0,  0.3,  0.0,  0.0, 0.0, 1.0];


# Iraf "heat" colour table.
my $heat_l = [0.0, 0.2, 0.4, 0.6, 1.0];
my $heat_r = [0.0, 0.5, 1.0, 1.0, 1.0];
my $heat_g = [0.0, 0.0, 0.5, 1.0, 1.0];
my $heat_b = [0.0, 0.0, 0.0, 0.3, 1.0];


# AIPS tvfiddle discrete rainbow colour table.

my $aips_l = [0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4, 0.5,
	      0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9, 1.0];
my $aips_r = [0.0, 0.0, 0.3, 0.3, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0,
	      0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0];
my $aips_g = [0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.8, 0.8,
	      0.6, 0.6, 1.0, 1.0, 1.0, 1.0, 0.8, 0.8, 0.0, 0.0];
my $aips_b = [0.0, 0.0, 0.3, 0.3, 0.7, 0.7, 0.7, 0.7, 0.9, 0.9,
	      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0];

# List the supported colour tables.
my %cmap = ("grey",    [$grey_l, $grey_c, $grey_c, $grey_c, scalar(@$grey_l)],
	    "rainbow", [$rain_l, $rain_r, $rain_g, $rain_b, scalar(@$rain_l)],
	    "heat",    [$heat_l, $heat_r, $heat_g, $heat_b, scalar(@$heat_l)],
	    "aips",    [$aips_l, $aips_r, $aips_g, $aips_b, scalar(@$aips_l)],
	    );

my $mw = MainWindow->new(-title => 'Pgptkdemo');
$mw->iconname("Pgtkdemo");
$mw->configure(-cursor => 'top_left_arrow');

# Override selected widget defaults.

$mw->optionAdd('*font' => '-Adobe-Times-Medium-R-Normal-*-140-*',
	       'widgetDefault');

# Set default widget colours.

my $bg = '#bfe5ff';
my $alt_bg = '#00ddff';
$mw->configure(bg => $bg);
$mw->optionAdd('*background' => $bg, 'widgetDefault');
$mw->optionAdd('*activeBackground' => $bg, 'widgetDefault');
$mw->optionAdd('*activeForeground' => 'blue', 'widgetDefault');
$mw->optionAdd('*highlightBackground' => $bg, 'widgetDefault');
$mw->optionAdd('*troughColor' => $bg, 'widgetDefault');
$mw->optionAdd('*Scrollbar.width' => '3m', 'widgetDefault');
$mw->optionAdd('*Scrollbar.background' => $alt_bg, 'widgetDefault');
$mw->optionAdd('*Scrollbar*Foreground' => $alt_bg, 'widgetDefault');
$mw->optionAdd('*Button*Background' => $alt_bg, 'widgetDefault');
$mw->optionAdd('*Button*activeBackground' => $alt_bg, 'widgetDefault');
$mw->optionAdd('*Button*activeForeground' => 'black', 'widgetDefault');
$mw->optionAdd('*Menubutton*activeForeground' => 'black', 'widgetDefault');

# Create the menu-bar
my $menubar = create_main_menubar($mw);

# Create label widgets for use in displaying image world coordinates
my ($world, $xworld, $yworld) = create_world_labels($mw);

# Create a PGPLOT window with scroll bars, and enclose them in a frame.
# This is the image window.
my ($imagearea, $pgimage) = create_image_area($mw);

# Create a PGPLOT window, and enclose it in a frame.
# This is the slice window.
my ($slicearea, $pgslice) = create_slice_area($mw);

my %demodata = initialize_demo();

# Create the function-selection option menu.
my $function = create_option_menu($mw, $pgimage);

# Create dialogs for later display.

my $save_dialog = create_save_dialog($mw);
my $help_dialog = create_help_dialog($mw);

# Place the menubar at the top of the main window and the work-areas
# underneath it.
$world->pack(-side => 'top',  -anchor => 'w');
$imagearea->pack(-side => 'top', -fill => 'both', -expand => 1);
$function->pack(-side => 'top',  -fill => 'x');
$slicearea->pack(-side => 'top', -fill => 'both', -expand => 1);

# Windows in Tk do not take on their final sizes until the whole
# application has been mapped. This makes it impossible for the
# PGPLOT widget to correctly guess what size of pixmap to allocate
# when it starts the first page. To avoid this problem, force Tk
# to create all of the windows before drawing the first plot.
$mw->idletasks;

# Draw the initial image.
draw_image($mw, 0);

MainLoop;

# This procedure creates the main menubar of the application.
sub create_main_menubar ($) {
  my $mw = shift;

  my $menubar = $mw->Menu;
  $mw->configure(-menu => $menubar);

  # Create the file menu.
  my $filemenu = $menubar->cascade(-label => 'File',
				   -tearoff => 0,
				   -menuitems => [
	 [Button => 'Save image as ...',
	  -command => sub {$save_dialog->deiconify;
			   $save_dialog->raise}],
	 [Separator => ''],
	 [Button => 'Quit',
	  -command => sub {exit}]
						 ]);
  # Arrange that Alt-Q will abort the application.
  $mw->bind('all', '<Alt-KeyPress-q>' => sub {exit});

  # Create the help menu
  my $helpmenu = $menubar->cascade(-label => 'Help',
				   -tearoff => 0,
				   -menuitems => [
	 [Button => 'Usage',
	  -command => sub {$help_dialog->deiconify;
			   $help_dialog->raise}]]);

  return $menubar;
}

# Create an area in which to display the world coordinates of the cursor
# when it is over the image window.
sub create_world_labels ($) {
  my $mw = shift;

  # Enclose the area in a frame.
  my $world = $mw->Frame(-width => '11c', -height => '1c');

  # Create a static title label.
  my $title = $world->Label(-text => 'World coordinates:');

  # Create the X and Y labels for displaying the respective coordinates.
  my $x = $world->Label(-width => 12,
		    -anchor => 'w');
  my $y = $world->Label(-width => 12,
		    -anchor => 'w');

  # Pack the widgets
  $title->pack(-side => 'left',
	       -anchor => 'w');
  $x->pack(-side => 'left',
	   -anchor => 'w',
	  -padx => '2m');
  $y->pack(-side => 'left',
	   -anchor => 'w',
	  -padx => '2m');

  return $world, $x, $y;
}

# This procedure is called whenever cursor motion is detected in the
# the image widget. It displays the world coordinates of the cursor
# in previously created label widgets.
sub report_motion {
  my $pg = shift;
  my $e = $pg->XEvent;
  my $x = $e->x;
  my $y = $e->y;
  my $xx = sprintf "X=%.2f", $pg->world('x', $x);
  my $yy = sprintf "Y=%.2f", $pg->world('y', $y);
  $xworld->configure(-text => $xx);
  $yworld->configure(-text => $yy);
}

# Create the area that contains the image PGPLOT window.
sub create_image_area ($) {
  my $mw = shift;

  # Frame the workarea
  my $w = $mw->Frame(-width => '11c', -height => '11c');

  # Create the PGPLOT image window.
  my $pgplot = $w->Pgplot(-name => 'image',
			  -share => 1,
			  -width => '10c',
			  -height => '10c',
			  -mincolors => 25,
			  -maxcolors => 64,
			  -bd => 2,
			  -bg => 'black',
			  -fg => 'white',
			  -cursor => ['crosshair', 'black', 'white']);

  # Create horizontal and vertical scroll-bars and have them
  # call the pgplot xview and yview scroll commands to scroll the
  # image within the window.
  my $xscroll = $w->Scrollbar(-orient => 'horizontal',
			      -command => ['xview', $pgplot]);
  my $yscroll = $w->Scrollbar(-orient => 'vertical',
			      -command => ['yview', $pgplot]);

  # Tell the PGPLOT widget how to update the scrollbar sliders.
  $pgplot->configure(-xscrollcommand => ['set', $xscroll]);
  $pgplot->configure(-yscrollcommand => ['set', $yscroll]);


  # Position the PGPLOT widget and the scrollbars.
  $xscroll->pack(-side => 'bottom', -fill => 'x');
  $yscroll->pack(-side => 'right', -fill => 'y');
  $pgplot->pack(-side => 'left',
		-fill => 'both',
		-expand => 1);

  # Bind motion events to the world coordinate x and y label widgets.
  $pgplot->bind('<Motion>' => \&report_motion);

  return ($w, $pgplot);
}

# A sinc(radius) function.
sub sinc_fn ($$) {
  my ($x, $y) = @_;

  my $radius = sqrt($x*$x + $y*$y);
  return (abs($radius) < 1.0e-6) ? 1.0 : sin($radius)/$radius;
}

# A exp(-(x^2+y^2)/20) function.
sub gaus_fn ($$) {
  my ($x, $y) = @_;

  return exp(-(($x*$x)+($y*$y))/20.0);
}

# A cos(radius)*sin(angle) function.
sub ring_fn ($$) {
  my ($x, $y) = @_;
  return cos(sqrt($x*$x + $y*$y)) *
    sin(($x==0.0 && $y==0.0) ? 0.0 : atan2($x,$y));
}

 # A sin(angle) function.
sub sin_angle_fn ($$) {
  my ($x, $y) = @_;
  return sin(($x==0.0 && $y==0.0) ? 0.0 : atan2($x,$y));
}

# A cos(radius) function.
sub cos_radius_fn () {
  my ($x, $y) = @_;
  return cos(sqrt($x*$x + $y*$y));
}

# A (1+sin(6*angle))*exp(-radius^2 / 100)function.
sub star_fn ($$) {
  my ($x, $y) = @_;
  return (1.0 + sin(($x==0.0 && $y==0.0) ? 0.0 : 6.0*atan2($x,$y)))
    * exp(-(($x*$x)+($y*$y))/100.0);
}

sub draw_image {
  my $mw = shift;
  my $plotid = shift;

  # Display a busy-cursor.
  $mw->Busy();

  # Install the new function
  if ($plotid==0) {
    $demodata{fn} = \&ring_fn;
  } elsif ($plotid==1) {
    $demodata{fn} = \&sinc_fn;
  } elsif ($plotid==2) {
    $demodata{fn} = \&gaus_fn;
  } elsif ($plotid==3) {
    $demodata{fn} = \&sin_angle_fn;
  } elsif ($plotid==4) {
    $demodata{fn} = \&cos_radius_fn;
  } elsif ($plotid==5) {
    $demodata{fn} = \&star_fn;
  }
  my $fn = $demodata{fn};

  # Display a "please wait" message in the slice window.
  display_busy(%demodata);

  # Fill the image array via the current display function.
  my $value;
  my $pixel = $demodata{image};
  my $vmin = my $vmax = &$fn(XA*SCALE, YA*SCALE);
  my $i = 0;
  for (my $iy = YA; $iy<=YB; $iy++) {
    for (my $ix = XA; $ix<=XB; $ix++) {
      $value = &$fn($ix*SCALE, $iy*SCALE);
      $pixel->[$i] = $value;
      if ($value<$vmin) {
	$vmin = $value;
      } elsif ($value>$vmax) {
	$vmax = $value;
      }
      $i++;
    }
  }

  # Record the min and max values of the data array.
  $demodata{datamin} = $vmin;
  $demodata{datamax} = $vmax;

  # Display the new image.
  display_image($demodata{image_id});

  # Display instructions in the slice window.
  display_help(%demodata);

  # No slice has been selected yet.
  $demodata{have_slice} = 0;

  # Reset the cursor.
  $mw->Unbusy;

  # Arm the cursor of the image window for the selection of a slice.
  prepare_for_slice(\%demodata);
}

# Display the current image function in a specified PGPLOT device.
sub display_image ($) {
  my $id = shift;

  # Select the specified PGPLOT device and display the image array.
  pgslct($id);
  pgask(0);
  pgpage();
  pgsch(1.0);
  pgvstd();
  pgwnad(XA*SCALE, XB*SCALE, YA*SCALE, YB*SCALE);

  my @tr = (); # Coordinate definition matrix
  $tr[0] = (XA - 1) * SCALE;
  $tr[1] = SCALE;
  $tr[2] = 0.0;
  $tr[3] = (YA - 1) * SCALE;
  $tr[4] = 0.0;
  $tr[5] = SCALE;

  if ($demodata{monochrome}) {
    pggray($demodata{image}, IMAGE_SIZE, IMAGE_SIZE, 1, IMAGE_SIZE,
	   1, IMAGE_SIZE, $demodata{datamax}, $demodata{datamin}, \@tr);
  } else {
    pgimag($demodata{image}, IMAGE_SIZE, IMAGE_SIZE, 1, IMAGE_SIZE, 1, 
	   IMAGE_SIZE, $demodata{datamin}, $demodata{datamax}, \@tr);
  }
  pgsci(1);
 
  pgbox("BCNST", 0.0, 0, "BCNST", 0.0, 0);
  pglab("X", "Y", "Image display demo");
}

# Create a labelled option menu.
sub create_option_menu ($$) {
  my $mw = shift;
  my $pgimage = shift;

  # Create a frame to enclose the menu.
  my $w = $mw->Frame();
  my $w1 = $w->Frame()->pack(-side => 'top', -fill => 'x');
  my $w2 = $w->Frame()->pack(-side => 'top', -fill => 'x');

  # Create the option-menu label.
  my $dlabel = $w1->Label(-text => 'Select a display function:');

  # Create the option menu.
  my ($menutext, $function_menu);
  my $dmenu = $w1->Optionmenu(-command => [\&draw_image, $mw],
			      -variable => \$function_menu,
			      -textvariable => \$menutext);
  $dmenu->addOptions(['cos(R)sin(A)' => 0],
		     ['sinc(R)' => 1],
		     ['exp(-R^2/20.0)' => 2],
		     ['sin(A)' => 3],
		     ['cos(R)' => 4],
		     ['(1+sin(6A))exp(-R^2/100)' => 5]);

  # Create the colormap-selection option menu and label
  my $clabel = $w2->Label(-text => 'Select a color table:');
  my $cmenu = $w2->Optionmenu(-command => [\&recolour_image, $mw, $pgimage, \$function_menu]);
  $cmenu->addOptions(qw(grey rainbow heat aips));

  # Place the label to the left of the menu button.
  $dlabel->pack(-side => 'left');
  $dmenu->pack(-side => 'left');

  $clabel->pack(-side => 'left');
  $cmenu->pack(-side => 'left');

  return $w;
}

# Implement the demo "redraw_slice" command.
sub redraw_slice {
  if ($demodata{have_slice}) {
    display_slice(\%demodata, $demodata{va}, $demodata{vb});
  } else {
    display_help(%demodata);
  }
}

# Implement the demo "recolour_image" command. This takes one of a set of
# supported colour-table names and redisplays the current image with the
# specified colour table.
#
#    "aips"    -  AIPS tvfiddle colour table.
#    "grey"    -  A grey-scale colour table.
#    "heat"    -  The IRAF "heat" colour table.
#    "rainbow" -  A red colour table.
sub recolour_image {
  my $mw = shift; # Main window
  my $pgimage = shift;  # The pgplot widget
  my $fn = shift; # Current displayed function
  my $name = shift;  # The name of the desired colour table

  # If the colour table is found, install it
  if (exists($cmap{$name})) {
    pgslct($demodata{image_id});
    pgctab(@{$cmap{$name}}, 1.0, 0.5);
  } else {
    warn "Unknown colour map name $name\n";
    return;
  }

  # Redraw the current image if necessary.
  if ($pgimage->cget(-share)) {
    draw_image($mw, $$fn);
  }
}

# Create the area that contains the slice PGPLOT window.
sub create_slice_area ($) {
  my $mw = shift;

  # Frame the workarea.
  my $w = $mw->Frame(-width => '11c', -height => '6c');

  # Create the PGPLOT slice window.
  my $pgplot = $w->Pgplot(-name => 'slice',
			  -share => 1,
			  -width => '10c',
			  -height => '5c',
			  -maxcolors => 2,
			  -bd => 2,
			  -bg => 'black',
			  -fg => 'white');

  # Position the PGPLOT widget.
  $pgplot->pack(-side => 'left',
		-fill => 'both',
		-expand => 1);

  # Arrange for the plot to be redrawn whenever the widget is resized.
  $pgplot->bind('<Configure>' => \&redraw_slice);

  return ($w, $pgplot);
}

sub initialize_demo {
  my %demo = ();

  $demo{image_id} = -1;
  $demo{slice_id} = -1;
  $demo{image} = [];
  $demo{slice} = [];
  $demo{fn} = undef;
  $demo{datamin} = undef;
  $demo{datamax} = undef;
  $demo{have_slice} = 0;
  $demo{monochrome} = 0;

  # Attempt to open the image and slice widgets.
  (($demo{image_id} = pgopen('image/ptk')) >= 0) ||
    die "Unable to open pgplot image widget ($demo{image_id})";

  (($demo{slice_id} = pgopen('slice/ptk')) >= 0) ||
    die "Unable to open pgplot slice widget";

  # Now initialize the 2D image array as a 1D array to be indexed in
  # as a FORTRAN array
  for (my $i=0; $i<IMAGE_SIZE*IMAGE_SIZE; $i++) {
    $demo{image}[$i] = 0.0;
  }

 # Initialize an array to be used when constructing slices through the
 # displayed image
  for (my $i=0; $i<SLICE_SIZE; $i++) {
    $demo{slice}[$i] = 0.0;
  }

  # If there are fewer than 2 colours available for plotting images,
  # mark the image as monochrome so that pggray can be asked to
  # produce a stipple version of the image.
  pgslct($demo{image_id});
  my ($minind, $maxind);
  pgqcir($minind, $maxind);
  $demo{monochrome} = $maxind-$minind+1 <= 2;

  return %demo;
};

# Display usage instructions in the slice window
sub display_help (%) {
  my %demo = @_;

  # Clear the slice plot and replace it with instructional text
  pgslct($demo{slice_id});
  pgask(0);
  pgpage();
  pgsch(3.0);
  pgsvp(0.0, 1.0, 0.0, 1.0);
  pgswin(0.0, 1.0, 0.0, 1.0);
  pgmtxt("T", -2.0, 0.5, 0.5, "See the help menu for instructions");
}

# This image-window pgplot-cursor callback is registered by start_slice.
# It receives the start coordinates of a slice from start_slice and
# the coordinate of the end of the slice from the callback arguments
# provided by the pgplot widget.
# Input:
#  pg          The pgplot widget
#  x1,y1       The coordinate of the start of the slice in the image
#               window. These values were supplied when the callback
#               was registered by start_slice.
#  wx2,wy2     The X-window coordinate of the end of the slice.
#  demodata demo hash
sub end_slice ($$$$$%) {
  my ($pg, $x1, $y1, $wx2, $wy2, $demodata) = @_;

  prepare_for_slice($demodata);
  slice($x1, $y1, $pg->world('x',$wx2), $pg->world('y',$wy2), $demodata);
}

# This is used as a pgplot image-widget cursor callback. It augments the
# cursor in the image window with a line rubber-band anchored at the
# selected cursor position and registers a new callback to receive both
# the current coordinates and coordinates of the end of the slice when
# selected.
# Input:
#  pg       pgplot widget
#  x,y      X-window coordinates of the position that the user selected
#           with the cursor.
#  demodata demo hash
sub start_slice ($$$%) {
  my ($pg, $x, $y, $demodata) = @_;

  # Convert from X coordinates to world coordinates.
  $x = $pgimage->world('x', $x);
  $y = $pgimage->world('y', $y);
  $pgimage->setcursor('line', $x, $y, 3);
  $pgimage->bind('<ButtonPress>'
		 => [\&end_slice, $x->[0], $y->[0],
		     Ev('x'), Ev('y'),
		     $demodata]);
}


# Arm the image-widget cursor such that when the user next presses a
# mouse button or key within the image window the start of a slice
# will be selected.
sub prepare_for_slice ($) {
  my $demodata = shift;
  $pgimage->setcursor('norm', 0.0, 0.0, 1);
  $pgimage->bind('<ButtonPress>'
		 => [\&start_slice, Ev('x'), Ev('y'), $demodata]);
}

# Implement the demo "slice" command. This takes two pairs of image
# world coordinates and plots a 1D representation of the currently
# displayed function in the slice window.
#
# Input:
#  x1, x2, x3, x4   The two end points of the slice line.
#  demodata         Demo hash
sub slice ($$$$\%){
  # Read the four coordinate values.
  my %va = (); # The coordinates of one end of the slice
  my %vb = (); # The coordinates of the other end of the slice
  $va{x} = shift;
  $va{y} = shift;
  $vb{x} = shift;
  $vb{y} = shift;
  my $demodata = shift;

  # Record the slice vertices so that the slice can be redrawn
  # when the widget is resized.
  $demodata->{va} = \%va;
  $demodata->{vb} = \%vb;
  $demodata->{have_slice} = 1;

  # Plot the new slice.
  display_slice($demodata, \%va, \%vb);
}

# Display a new slice in the slice window.
# Input:
#  demodata   Demo hash
#  va         The vertex of one end of the slice line.
#  vb         The vertex of the opposite end of the slice line.
sub display_slice ($$$) {
  my ($demodata, $va, $vb) = @_;

  # Determine the slice pixel assignments.
  my $xa = $va->{x};
  my $dx = ($vb->{x} - $va->{x}) / SLICE_SIZE;
  my $ya = $va->{y};
  my $dy = ($vb->{y} - $va->{y}) / SLICE_SIZE;

  # Make sure that the slice has a finite length by setting a
  # minimum size of one pixel.
  my  $min_delta =SCALE / SLICE_SIZE;
  if(abs($dx) < $min_delta && abs($dy) < $min_delta) {
    $dx = $min_delta;
  }

  # Construct the slice in demo->{slice} and keep a tally of the
  # range of slice values seen.
  my ($value, $smin, $smax);
  my $fn = $demodata->{fn};
  for(my $i=0; $i<SLICE_SIZE; $i++) {
    $value = &$fn($xa + $i * $dx, $ya + $i * $dy);
    $demodata->{slice}[$i] = $value;
    if($i==0) {
      $smin = $smax = $value;
    } elsif($value < $smin) {
      $smin = $value;
    } elsif($value > $smax) {
      $smax = $value;
    }
  }

  # Determine the length of the slice.
  my $xlen = $dx * SLICE_SIZE;
  my $ylen = $dy * SLICE_SIZE;
  my $slice_length = sqrt($xlen * $xlen + $ylen * $ylen);

  # Determine the extra length to add to the Y axis to prevent the
  # slice plot hitting the top and bottom of the plot.
  my $ymargin = 0.05 * ($demodata->{datamax} - $demodata->{datamin});

  # Set up the slice axes.
  pgslct($demodata->{slice_id});
  pgask(0);
  pgpage();
  pgbbuf();
  pgsch(2.0);
  pgvstd();
  pgswin(0.0, $slice_length, $demodata->{datamin} - $ymargin,
	 $demodata->{datamax} + $ymargin);
  pgbox("BCNST", 0.0, 0, "BCNST", 0.0, 0);
  pglab("Radius", "Image value", "A 1D slice through the image");

  # Draw the slice.
  for(my $i=0; $i<SLICE_SIZE; $i++) {
    if($i==0) {
      pgmove(0.0, $demodata->{slice}[0]);
    } else {
      pgdraw($slice_length * $i / SLICE_SIZE, $demodata->{slice}[$i]);
    }
  }
  pgebuf();
}

# Display a "Please wait" message in the slice window.
sub display_busy (%) {

  my %demodata = @_;
  # Clear the slice plot and replace it with instructional text.

  pgslct($demodata{slice_id});
  pgask(0);
  pgpage();
  pgsch(3.5);
  pgsvp(0.0, 1.0, 0.0, 1.0);
  pgswin(0.0, 1.0, 0.0, 1.0);
  pgmtxt("T", -2.0, 0.5, 0.5, 'Please wait.');
}

# Create an unmapped help dialog.
#
# Note that the dialog is not initially mapped. To display it temporarily
# use the command {wm deiconify $w} and then when it is no longer required
# call {wm withdraw $w}.
sub create_help_dialog ($) {
  my ($mw) = @_;

  # Create the dialog container and tell the window-manager what to call
  # both it and its icon.
  my $w = $mw->Toplevel(-class => 'dialog');
  $w->withdraw;
  $w->title('Usage information');
  $w->iconname('Dialog');

  # Create the top-half of the dialog and display display the usage message
  # in it.
  my $top = $w->Frame(-relief => 'raised',  -bd => 1);

  my $msg = $top->Message(-width => '12c', -text => 'To see a slice'.
			  ' through the displayed image, move the mouse'.
			  ' into the image display window and use any'.
			  ' mouse button to select the two end points'.
			  ' of a line.'."\n\n". 'To display a different'.
			  ' image select a new image function from the'.
			  ' "Select a display function" option menu.');
  $msg->pack(-side => 'left', -expand=> 1, -fill => 'both');

  # Create the bottom half of the dialog and place a single OK button in
  # it. Arrange that pressing the OK button unmaps the dialog.
  my $bot = $w->Frame(-relief => 'raised',  -bd => 1);
  my $ok = $bot->Button(-text => 'OK', -command => sub {$w->withdraw});
  $ok->pack(-pady => '2m');

  # Arrange for carriage-return to invoke the OK key.
  $w->bind('<Return>' => sub {$ok->invoke});

  # Place the widgets in their assigned places top and bottom.
  $top->pack(-side => 'top', -fill => 'both', -expand => 1);
  $bot->pack(-side => 'top', -fill => 'both', -expand => 1);

  return($w);
}

# Create an unmapped save-image dialog.
# Note that this dialog is not initially mapped. To display it
# temporarily use the command {wm deiconify $w} and then when it is no
# longer required call {wm withdraw $w}.

sub create_save_dialog ($) {
  my $mw = shift;

  # Create the toplevel dialog window withdrawn.
  my $w = $mw->Toplevel(-class => 'dialog');
  $w->withdraw;
  $w->title('Save image');
  $w->iconname('Dialog');

  # Create the top and bottom frames.
  my $top = $w->Frame(-relief => 'raised', -bd => 1);
  $top->pack(-side => 'top', -fill => 'both', -expand => 1);
  my $bot = $w->Frame(-relief => 'raised', -bd => 1);
  $bot->pack(-side => 'bottom',  -fill => 'both', -expand => 1);

  # Create a label and an entry widget in the top frame.
  my $msg = $top->Message(-justify => 'left', -width => '8c',
			  -anchor => 'w', 
			  -text => 'Enter a PGPLOT device string:');
  my $entry = $top->Entry(-relief => 'sunken', -bd => 2, -width => 30);
  $msg->pack(-side => 'top', -anchor => 'w');
  $entry->pack(-side => 'top', -anchor => 'w');

  # Create three buttons in the bottom frame.
  my $ok = $bot->Button(-text => 'OK');
  my $cancel = $bot->Button(-text => 'Cancel', -command => sub {$w->withdraw});
  my $help = $bot->Button(-text => 'Help', -state => 'disabled');
  $ok->pack(-side => 'left', -expand => 1, -pady => '2m', -padx => '2m');
  $cancel->pack(-side => 'left', -expand => 1, -pady => '2m', -padx => '2m');
  $help->pack(-side => 'left', -expand => 1, -pady => '2m', -padx => '2m');

  # Arrange for carriage-return to invoke the OK key.
  $w->bind('<Return>' => [$ok => 'invoke']);

  $ok->configure(-command => sub {$w->withdraw; $mw->idletasks;
				  save_image($entry)});

  return $w;
}

sub save_image ($) {
  my $entry = shift;

  my $device = $entry->get();

  # Open the new PGPLOT device.
  my $device_id = pgopen($device);

  # If the device was successfully opened, plot the current image
  # within it and close the device.
  if($device_id > 0) {
    display_image($device_id);
    pgclos();
  } else {
    warn "cpgopen(\"$device\") failed.\n";
  }
}