#!/usr/bin/perl -w
{
$version = "plotopt version 2.2  1 Jun 2012";

#  1 Jun 12.  WJS v 2.2
#	Recode read loop to properly check for errors
#  4 Jun 09.  WJS v 2.1
#	Comment out the require for backtick, since it apparently gets
#	  imported when we do opt-build-env.pl.  Some day I'll figure out
#	  this scoping stuff ...
# 29 May 09.  WJS  v 2.1
#	Not really necessary to `cat file` to read a 1-line file!
#	But IS necessary to check the 1 line (don't know exactly how,
#	  but there were errors in log - presumably from some follow-every-
#	  link bots)
#	Change from SUBSELS_QS to SUBSELS.  SUBSELS_QS was untrigrammed
#	  (and also htmlesc'ed (eg, could have had had &lt; rather than <)
#	  except that I don't think html escapes could ever make it into
#	  QUERY_STRING).  This is a housekeeping move, in prep for
#	  SUBSELS to trigram more stuff.
# 20 Jul 08.  WJS  v 2.1 (apparently never used! since apparently
#			  never finished!!)
#	Check some stuff we think we get from build-opt-env.pl
#	Get varlist from wjs_web_perl_utilities.pl routine
# 27 Jul 05.  WJS  v 2.0
#	Rewrite in perl.  More transcription than rewrite except for next items


require ("cgi-lib.pl");
require "wjs_web_perl_utilities.pl";
#  require "backtick.pl";  # We get backtick in the require for build-opt-env
require "build-opt-env.pl";

&printheader();

$object = &check_build_opt_env_var('OBJECT',$build_opt_env); 
$tempdir = &check_build_opt_env_var('USETEMPDIR',$build_opt_env);
$bindir = &check_build_opt_env_var('OPTHOME',$build_opt_env) . "/bin";

$dispfull = $callurl = $callfull = $object;
if ($subsels = $ENV{'SUBSELS'}) {
  $dispfull .= "($ENV{'DISPSS'})";
  $callurl .= "?$subsels";
  $callfull .= "($subsels)";
}

$listvar = "$bindir/listvar";
&check_x_access ($listvar);

$curopt_file = "$tempdir/plotopt";
$curopt_list = &get_current_options($curopt_file);
($x_var,$x_axis,$y_var,$y_axis,$symbol,$dummy) = split (' ',$curopt_list);
$symbol || 
     &quit ("Not enough fields in $curopt_file record","record = $curopt_list");
$dummy &&
     &quit ("Too many fields in $curopt_file record","record = $curopt_list");

$cleanploturl = '/jg/cleanplot' . $object . '.plotopt?' . $subsels;
print <<XXstuffXX;
<html><head><title>Simple XY Plotting</title></head>
<body>
<h1>Simple XY Plot</h1>
<b>Current object is:  $dispfull</b></br>
</br>
<font size=\"2\">
Note: this routine plots non-numeric data at (-9999,-9999)</br>
You may wish to go to the Subsetting Data page and remove known</br>
non-numeric data such as "nd"s or "NaN"s
</font>
<hr noshade>
<p>
<font size=\"3\">
<a href=\"$cleanploturl\">Select this link, if the form looks incomplete</a>.
</font>
<form action=\"/jg/plotxy$callurl\" method=\"POST\">
XXstuffXX

#   May want to play w/caching and/or coordinate it with cleanplot button
#   The undef and the 0 are the things to be played with - see doc
(undef,@def_varlist) = &get_cached_varlist($listvar,$tempdir,$callfull,0);

&print_variable_selection('x',$x_var);
&print_axis_selection('x',$x_axis);
print "<br>\n";

&print_variable_selection('y',$y_var);
&print_axis_selection('y',$y_axis);
print "<br>\n";

&print_symbol_selection($symbol);

print <<XXstuffXX;
<hr noshade>
<input type=\"submit\" value=\"Make the Plot\"> if the selected options are satisfactory.
</form>
</body>
</html>
XXstuffXX

undef $version;	# Avoid "1-time" use diagnostic. $version used by &quit
exit 0;
}

sub get_current_options
{
  my ($curopt_file,$dummy) = @_;
  my ($curopt_list,$nlines);
  $dummy && 
    &quit("Internal error - get_current_options called w/ too many args");
  $curopt_file || 
    &quit("Internal error - no file passed to get_current_options");
  (open (CUROPT,$curopt_file)) || 
				&quit("Could not read $curopt_file","\$! = $!");
  $nlines = 0;
  while (! eof(CUROPT)) {
    $nlines++;
    (defined ($curopt_list = <CUROPT>)) || 
	    &quit ("Error reading $curopt_file record $nlines; ","\$! = $!");
  }
  close (CUROPT);
  ($nlines == 0) && &quit ("System inconsistency - empty $curopt_file");
  ($nlines > 1)  && 
	&quit ("System inconsistency - $nlines records in $curopt_file");
  return $curopt_list;
}

sub print_variable_selection
{
  my ($xy,$default) = @_;
  my ($temp);

  if ($xy eq 'x') {
    $temp = "an X";
  } elsif ($xy eq 'y') {
    $temp = "a Y";
  } else {
    &quit ("print_variable_selection received unknown arg $xy");
  }

#   Note that code prints $default in the next line even if $default
#   does not happen to be in variable list of object.  This duplicates
#   original csh coding...
  print
	"Select $temp variable ($default): <select name=\"" . 
	$xy . 
	"var\" size=\"4\">\n";

  foreach (@def_varlist) {
    foreach (split (' ',$_)) {
      ($_ eq '>') && next;
      print "<option";
      ($_ eq $default) && (print " selected");
      print ">$_\n";
    }
  }

  print "</select><br>\n";
  return;
}

sub print_axis_selection
{
  my ($xy,$default) = @_;

  print "Select a reverse or log " . uc($xy) . 
	" axis ($default):  <select name=\"" . $xy . "opt\">\n";

  foreach ('none','reverse','log','rev/log') {
    print "<option";
    ($_ eq $default) && (print " selected");
    print ">$_\n";
  }

  print "</select><br>\n";
  return;
}

sub print_symbol_selection
{
  my ($default) = @_;

  print "Select a symbol for plotting the values ($default): " .
						"<select name=\"sym\">\n";

  foreach ('line','+','o','x','+(connected)','o(connected)','x(connected)') {
    print "<option";
    ($_ eq $default) && (print " selected");
    print ">$_\n";
  }

  print "</select><br>\n";
  return;
}

