loncom/xml/lonplot.pm - diff

Return to lonplot.pm CVS log

Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonplot.pm between versions 1.14 and 1.33

-version 1.14, 2001/12/21 16:59:01
+version 1.33, 2002/01/06 02:19:25
  Line 26
  # http://www.lon-capa.org/
  #
  # 12/15/01 Matthew
- # 12/17 12/18 12/19 12/20 12/21 Matthew
+ # 12/17 12/18 12/19 12/20 12/21 12/27 12/28 12/30 12/31 Matthew
+ # 01/01/02 Matthew
+ # 01/02 01/03 Matthew
  package Apache::lonplot;
  use strict;
  use Apache::File;
  use Apache::response;
  use Apache::lonxml;
+ use Apache::edit;
- use Digest::MD5 qw(md5_base64);
+ BEGIN {
- sub BEGIN {
    &Apache::lonxml::register('Apache::lonplot',('plot'));
  }
- Line 53  sub BEGIN {
+ Line 54  sub BEGIN {
  ##  grid
  ##  border
  ##  font
+ ##  align
  ##
  ##  @labels: $labels[$i] = \%label
  ##           %label: text, xpos, ypos, justify
- Line 63  sub BEGIN {
+ Line 65  sub BEGIN {
  ##  $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
  ##                            [y1,y2,y3,y4] ]
  ##
- ##------------------------------------------------------------
- ##
+ ###################################################################
- ## Tests used in checking the validitity of input
+ ##                                                               ##
- ##
+ ##        Tests used in checking the validitity of input         ##
+ ##                                                               ##
+ ###################################################################
+ my $max_str_len = 50;    # if a label, title, xlabel, or ylabel text
+                          # is longer than this, it will be truncated.
+ my %linestyles =
+     (
+      lines          => 2,     # Maybe this will be used in the future
+      linespoints    => 2,     # to check on whether or not they have
+      dots	    => 2,     # supplied enough <data></data> fields
+      points         => 2,     # to use the given line style.  But for
+      steps	    => 2,     # now there are more important things
+      fsteps	    => 2,     # for me to deal with.
+      histeps        => 2,
+      errorbars	    => 2,
+      xerrorbars	    => 2,
+      yerrorbars	    => 2,
+      xyerrorbars    => 2,
+      boxes          => 2,
+      boxerrorbars   => 2,
+      boxxyerrorbars => 2,
+      financebars    => 2,
+      candlesticks   => 2,
+      vector	    => 2
+     );
  my $int_test       = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
- my $real_test      = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*$/};
+ my $real_test      =
+     sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
  my $color_test     = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
  my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
- my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
+ my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
  my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
- my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
+ my $linestyle_test = sub {exists($linestyles{$_[0]})};
- my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^(\w+ ?)+$/};
+ my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w\(\)]+ ?)+$/};
- ##
- ## Default values for attributes of elements
+ ###################################################################
- ##
+ ##                                                               ##
+ ##                      Attribute metadata                       ##
+ ##                                                               ##
+ ###################################################################
  my %plot_defaults =
      (
-      height       => {default => 200,       test => $int_test   },
+      height       => {
-      width        => {default => 200,       test => $int_test   },
+ 	 default     => 200,
-      bgcolor      => {default => 'xffffff', test => $color_test },
+ 	 test        => $int_test,
-      fgcolor      => {default => 'x000000', test => $color_test },
+ 	 description => 'height of image (pixels)',
-      transparent  => {default => 'off',     test => $onoff_test },
+ 	 edit_type   => 'entry'
-      grid         => {default => 'off',     test => $onoff_test },
+ 	 },
-      border       => {default => 'on',      test => $onoff_test },
+      width        => {
-      font         => {default => 'medium',  test => $sml_test   }
+ 	 default     => 200,
+ 	 test        => $int_test,
+ 	 description => 'width of image (pixels)',
+ 	 edit_type   => 'entry'
+ 	 },
+      bgcolor      => {
+ 	 default     => 'xffffff',
+ 	 test        => $color_test,
+ 	 description => 'background color of image (xffffff)',
+ 	 edit_type   => 'entry'
+ 	 },
+      fgcolor      => {
+ 	 default     => 'x000000',
+ 	 test        => $color_test,
+ 	 description => 'foreground color of image (x000000)',
+ 	 edit_type   => 'entry'
+ 	 },
+      transparent  => {
+ 	 default     => 'off',
+ 	 test        => $onoff_test,
+ 	 description => '',
+ 	 edit_type   => 'on_off'
+ 	 },
+      grid         => {
+ 	 default     => 'off',
+ 	 test        => $onoff_test,
+ 	 description => '',
+ 	 edit_type   => 'on_off'
+ 	 },
+      border       => {
+ 	 default     => 'on',
+ 	 test        => $onoff_test,
+ 	 description => '',
+ 	 edit_type   => 'on_off'
+ 	 },
+      font         => {
+ 	 default     => 'medium',
+ 	 test        => $sml_test,
+ 	 description => 'Size of font to use',
+ 	 edit_type   => 'choice',
+ 	 choices     => ['small','medium','large']
+ 	 },
+      align        => {
+ 	 default     => 'left',
+ 	 test        => sub {$_[0]=~/^(left|right|center)$/},
+ 	 description => 'alignment for image in html',
+ 	 edit_type   => 'choice',
+ 	 choices     => ['left','right','center']
+ 	 }
       );
  my %key_defaults =
      (
-      title => { default => '',          test => $words_test   },
+      title => {
-      box   => { default => 'off',       test => $onoff_test   },
+ 	 default => '',
-      pos   => { default => 'top right', test => $key_pos_test }
+ 	 test => $words_test,
+ 	 description => 'Title of key',
+ 	 edit_type   => 'entry'
+ 	 },
+      box   => {
+ 	 default => 'off',
+ 	 test => $onoff_test,
+ 	 description => 'Draw a box around the key?',
+ 	 edit_type   => 'on_off'
+ 	 },
+      pos   => {
+ 	 default => 'top right',
+ 	 test => $key_pos_test,
+ 	 description => 'position of the key on the plot',
+ 	 edit_type   => 'choice',
+ 	 choices     => ['top left','top right','bottom left','bottom right',
+ 			 'outside','below']
+ 	 }
       );
  my %label_defaults =
      (
-      xpos    => {default => 0,         test => $real_test     },
+      xpos    => {
-      ypos    => {default => 0,         test => $real_test     },
+ 	 default => 0,
-      justify => {default => 'left',
+ 	 test => $real_test,
-                  test => sub {$_[0]=~/^(left|right|center)$/} }
+ 	 description => 'x position of label (graph coordinates)',
+ 	 edit_type   => 'entry'
+ 	 },
+      ypos    => {
+ 	 default => 0,
+ 	 test => $real_test,
+ 	 description => 'y position of label (graph coordinates)',
+ 	 edit_type   => 'entry'
+ 	 },
+      justify => {
+ 	 default => 'left',
+ 	 test => sub {$_[0]=~/^(left|right|center)$/},
+ 	 description => 'justification of the label text on the plot',
+ 	 edit_type   => 'choice',
+ 	 choices     => ['left','right','center']
+      }
       );
  my %axis_defaults =
      (
-      color     => {default => 'x000000', test => $color_test},
+      color   => {
-      xmin      => {default => '-10.0',   test => $real_test },
+ 	 default => 'x000000',
-      xmax      => {default => ' 10.0',   test => $real_test },
+ 	 test => $color_test,
-      ymin      => {default => '-10.0',   test => $real_test },
+ 	 description => 'color of axes (x000000)',
-      ymax      => {default => ' 10.0',   test => $real_test }
+ 	 edit_type   => 'entry'
+ 	 },
+      xmin      => {
+ 	 default => '-10.0',
+ 	 test => $real_test,
+ 	 description => 'minimum x-value shown in plot',
+ 	 edit_type   => 'entry'
+ 	 },
+      xmax      => {
+ 	 default => ' 10.0',
+ 	 test => $real_test,
+ 	 description => 'maximum x-value shown in plot',
+ 	 edit_type   => 'entry'
+ 	 },
+      ymin      => {
+ 	 default => '-10.0',
+ 	 test => $real_test,
+ 	 description => 'minimum y-value shown in plot',
+ 	 edit_type   => 'entry'
+ 	 },
+      ymax      => {
+ 	 default => ' 10.0',
+ 	 test => $real_test,
+ 	 description => 'maximum y-value shown in plot',
+ 	 edit_type   => 'entry'
+ 	 }
       );
  my %curve_defaults =
      (
-      color     => {default => 'x000000', test => $color_test     },
+      color     => {
-      name      => {default => '',        test => $words_test     },
+ 	 default => 'x000000',
-      linestyle => {default => 'lines',   test => $linestyle_test }
+ 	 test => $color_test,
+ 	 description => 'color of curve (x000000)',
+ 	 edit_type   => 'entry'
+ 	 },
+      name      => {
+ 	 default => '',
+ 	 test => $words_test,
+ 	 description => 'name of curve to appear in key',
+ 	 edit_type   => 'entry'
+ 	 },
+      linestyle => {
+ 	 default => 'lines',
+ 	 test => $linestyle_test,
+ 	 description => 'Style of the axis lines',
+ 	 edit_type   => 'choice',
+ 	 choices     => ['lines','linespoints','dots','points','steps',
+ 			 'fsteps','histeps','errorbars','xerrorbars',
+ 			 'yerrorbars','xyerrorbars','boxes','boxerrorbars',
+ 			 'boxxyerrorbars','financebars','candlesticks',
+ 			 'vector']
+ 	 }
       );
- ##
+ ###################################################################
- ## End of defaults
+ ##                                                               ##
- ##
+ ##                    parsing and edit rendering                 ##
+ ##                                                               ##
+ ###################################################################
  my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
  sub start_plot {
-     %plot    = undef;   %key     = undef;   %axis   = undef;
+     %plot    = ();      %key     = ();      %axis   = ();
      $title   = undef;   $xlabel  = undef;   $ylabel = undef;
      $#labels = -1;      $#curves = -1;
      #
- Line 135  sub start_plot {
+ Line 295  sub start_plot {
      my $result='';
      &Apache::lonxml::register('Apache::lonplot',
  	     ('title','xlabel','ylabel','key','axis','label','curve'));
-     push (@Apache::lonxml::namespace,'plot');
+     push (@Apache::lonxml::namespace,'lonplot');
-     ## Always evaluate the insides of the <plot></plot> tags
-     my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
-     $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
-     &Apache::lonxml::newparser($parser,\$inside);
-     ##-------------------------------------------------------
-     &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
- 		    $tagstack->[-1]);
      if ($target eq 'web') {
+ 	my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
+ 	$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
+ 	&Apache::lonxml::newparser($parser,\$inside);
+ 	&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
+ 			$tagstack->[-1]);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Plot');
+ 	$result .= &edit_attributes($target,$token,\%plot_defaults);
+     } elsif ($target eq 'modified') {
+ 	my $constructtag=&Apache::edit::get_new_args
+ 	    ($token,$parstack,$safeeval,keys(%plot_defaults));
+ 	if ($constructtag) {
+ 	    $result = &Apache::edit::rebuild_tag($token);
+ #	    $result.= &Apache::edit::handle_insert();
+ 	}
      }
-     return '';
+     return $result;
  }
  sub end_plot {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      pop @Apache::lonxml::namespace;
      &Apache::lonxml::deregister('Apache::lonplot',
  	('title','xlabel','ylabel','key','axis','label','curve'));
      my $result = '';
      if ($target eq 'web') {
- 	##
+ 	&check_inputs(); # Make sure we have all the data we need
- 	## Make sure we have all the input we need:
- 	if (! defined(%plot  )) { &set_defaults(\%plot,\%plot_defaults); }
- 	if (! defined(%key   )) {} # No key for this plot
- 	if (! defined(%axis  )) { &set_defaults(\%axis,\%axis_defaults); }
- 	if (! defined($title )) {} # No title for this plot
- 	if (! defined($xlabel)) {} # No xlabel for this plot
- 	if (! defined($ylabel)) {} # No ylabel for this plot
- 	if ($#labels < 0) { } # No labels for this plot
- 	if ($#curves < 0) {
- 	    &Apache::lonxml::warning("No curves specified for plot!!!!");
- 	    return '';
- 	}
- 	my $curve;
- 	foreach $curve (@curves) {
- 	    if (!defined($curve->{'function'})&&!defined($curve->{'data'})){
- 		&Apache::lonxml::warning("One of the curves specified did not contain any <data> or <function> declarations\n");
- 		return '';
- 	    }
- 	}
  	##
  	## Determine filename
  	my $tmpdir = '/home/httpd/perl/tmp/';
  	my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
- 	    '_'.time.'_'.$$.'_plot.data';
+ 	    '_'.time.'_'.$$.int(rand(1000)).'_plot.data';
  	## Write the plot description to the file
  	my $fh=Apache::File->new(">$tmpdir$filename");
  	print $fh &write_gnuplot_file();
  	close($fh);
  	## return image tag for the plot
  	$result .= <<"ENDIMAGE";
- <img src = "/cgi-bin/plot.gif?$filename"
+ <img src    = "/cgi-bin/plot.gif?$filename"
-      alt = "/cgi-bin/plot.gif?$filename" />
+      width  = "$plot{'width'}"
+      height = "$plot{'height'}"
+      align  = "$plot{'align'}"
+      alt    = "/cgi-bin/plot.gif?$filename" />
  ENDIMAGE
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
- Line 197  ENDIMAGE
+ Line 352  ENDIMAGE
  sub start_key {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
- 		    $tagstack->[-1]);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	&get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
+ 		    $tagstack->[-1]);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Plot Key');
+ 	$result .= &edit_attributes($target,$token,\%key_defaults);
+     } elsif ($target eq 'modified') {
+ 	my $constructtag=&Apache::edit::get_new_args
+ 	    ($token,$parstack,$safeeval,keys(%key_defaults));
+ 	if ($constructtag) {
+ 	    $result = &Apache::edit::rebuild_tag($token);
+ 	    $result.= &Apache::edit::handle_insert();
+ 	}
      }
      return $result;
  }
- Line 209  sub end_key {
+ Line 373  sub end_key {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
  ##------------------------------------------------------------------- title
  sub start_title {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
-     $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
      my $result='';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
+ 	if (length($title) > $max_str_len) {
+ 	    $title = substr($title,0,$max_str_len);
+ 	}
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_start($target,$token,'Plot Title');
+ 	my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);
+ 	$result.='</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	my $text=$$parser[-1]->get_text("/title");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 228  sub end_title {
+ Line 404  sub end_title {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
- Line 236  sub end_title {
+ Line 413  sub end_title {
  sub start_xlabel {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
+ 	if (length($xlabel) > $max_str_len) {
+ 	    $xlabel = substr($xlabel,0,$max_str_len);
+ 	}
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
+ 	my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
+ 	$result.='</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	my $text=$$parser[-1]->get_text("/xlabel");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 247  sub end_xlabel {
+ Line 434  sub end_xlabel {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
  ##------------------------------------------------------------------- ylabel
  sub start_ylabel {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
+ 	if (length($ylabel) > $max_str_len) {
+ 	    $ylabel = substr($ylabel,0,$max_str_len);
+ 	}
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
+ 	my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
+ 	$result .= '</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	my $text=$$parser[-1]->get_text("/ylabel");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 266  sub end_ylabel {
+ Line 465  sub end_ylabel {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
  ##------------------------------------------------------------------- label
  sub start_label {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     my %label;
-     &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
- 		    $tagstack->[-1]);
-     $label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
-     if (! &$words_test($label{'text'})) {
- 	# I should probably warn about it, too.
- 	$label{'text'} = 'Illegal text';
-     }
-     push(@labels,\%label);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	my %label;
+ 	&get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
+ 		    $tagstack->[-1]);
+ 	my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
+ 	$text = substr($text,0,$max_str_len) if (length($text) > $max_str_len);
+ 	$label{'text'} = $text;
+ 	push(@labels,\%label);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Plot Label');
+ 	$result .= &edit_attributes($target,$token,\%label_defaults);
+ 	my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
+ 	$result .= '</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	my $constructtag=&Apache::edit::get_new_args
+ 	    ($token,$parstack,$safeeval,keys(%label_defaults));
+ 	if ($constructtag) {
+ 	    $result = &Apache::edit::rebuild_tag($token);
+ 	    $result.= &Apache::edit::handle_insert();
+ 	}
+ 	my $text=$$parser[-1]->get_text("/label");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 293  sub end_label {
+ Line 506  sub end_label {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
- Line 302  sub end_label {
+ Line 516  sub end_label {
  sub start_curve {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     my %curve;
-     &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
- 		    $tagstack->[-1]);
-     push (@curves,\%curve);
      &Apache::lonxml::register('Apache::lonplot',('function','data'));
      push (@Apache::lonxml::namespace,'curve');
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	my %curve;
+ 	&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
+ 		    $tagstack->[-1]);
+ 	push (@curves,\%curve);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Curve');
+ 	$result .= &edit_attributes($target,$token,\%curve_defaults);
+     } elsif ($target eq 'modified') {
+ 	my $constructtag=&Apache::edit::get_new_args
+ 	    ($token,$parstack,$safeeval,keys(%label_defaults));
+ 	if ($constructtag) {
+ 	    $result = &Apache::edit::rebuild_tag($token);
+ 	    $result.= &Apache::edit::handle_insert();
+ 	}
      }
      return $result;
  }
- Line 320  sub end_curve {
+ Line 543  sub end_curve {
      pop @Apache::lonxml::namespace;
      &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
      }
      return $result;
  }
  ##------------------------------------------------------------ curve function
  sub start_function {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     if (exists($curves[-1]->{'data'})) {
- 	&Apache::lonxml::warning('Use of <function> precludes use of <data>.  The <data> will be omitted in favor of the <function> declaration.');
- 	delete $curves[-1]->{'data'} ;
-     }
-     $curves[-1]->{'function'} =
- 	&Apache::lonxml::get_all_text("/function",$$parser[-1]);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	if (exists($curves[-1]->{'data'})) {
+ 	    &Apache::lonxml::warning('Use of <function> precludes use of <data>.  The <data> will be omitted in favor of the <function> declaration.');
+ 	    delete $curves[-1]->{'data'} ;
+ 	}
+ 	$curves[-1]->{'function'} =
+ 	    &Apache::lonxml::get_all_text("/function",$$parser[-1]);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Curve Function');
+ 	my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);
+ 	$result .= '</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	# Why do I do this?
+ 	my $text=$$parser[-1]->get_text("/function");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 344  sub end_function {
+ Line 577  sub end_function {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::end_table();
      }
      return $result;
  }
  ##------------------------------------------------------------ curve  data
  sub start_data {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     if (exists($curves[-1]->{'function'})) {
- 	&Apache::lonxml::warning('Use of <data> precludes use of <function>.'.
-             '  The <function> will be omitted in favor of the <data>'.
-             ' declaration.');
- 	delete($curves[-1]->{'function'});
-     }
-     my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
-     $datatext =~ s/\s+//g;  # No whitespace, numbers must be seperated
-                             # by commas
-     if ($datatext !~ /^(([+-]?\d*\.?\d*)[, ]?)+$/) {
- 	&Apache::lonxml::warning('Malformed data: '.$datatext);
- 	$datatext = '';
-     }
-     # Need to do some error checking on the @data array -
-     # make sure it's all numbers and make sure each array
-     # is of the same length.
-     my @data = split /,/,$datatext;
-     for (my $i=0;$i<=$#data;$i++) {
- 	# Check that it's non-empty
- 	# Check that it's a number
- 	# Maybe I need a 'debug=on' switch to list the data set
- 	#    out in a warning?
-     }
-     push  @{$curves[-1]->{'data'}},\@data;
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	if (exists($curves[-1]->{'function'})) {
+ 	    &Apache::lonxml::warning('Use of <data> precludes use of .'.
+ 	    '<function>.  The <function> will be omitted in favor of '.
+             'the <data> declaration.');
+ 	    delete($curves[-1]->{'function'});
+ 	}
+ 	my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
+ 	$datatext =~ s/\s+/ /g;
+ 	# Need to do some error checking on the @data array -
+ 	# make sure it's all numbers and make sure each array
+ 	# is of the same length.
+ 	my @data;
+ 	if ($datatext =~ /,/) {
+ 	    @data = split /,/,$datatext;
+ 	} else { # Assume it's space seperated.
+ 	    @data = split / /,$datatext;
+ 	}
+ 	for (my $i=0;$i<=$#data;$i++) {
+ 	    # Check that it's non-empty
+ 	    if (! defined($data[$i])) {
+ 		&Apache::lonxml::warning(
+ 		    'undefined <data> value.  Replacing with '.
+ 		    ' pi/e = 1.15572734979092');
+ 		$data[$i] = 1.15572734979092;
+ 	    }
+ 	    # Check that it's a number
+ 	    if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) {
+ 		&Apache::lonxml::warning(
+ 		    'Bad <data> value of '.$data[$i].'  Replacing with '.
+ 		    ' pi/e = 1.15572734979092');
+ 		$data[$i] = 1.15572734979092;
+ 	    }
+ 	}
+ 	push  @{$curves[-1]->{'data'}},\@data;
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Curve Data');
+ 	my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
+ 	$result .= '</td></tr><tr><td colspan="3">'.
+ 	    &Apache::edit::editfield('',$text,'',60,1);
+     } elsif ($target eq 'modified') {
+ 	my $text=$$parser[-1]->get_text("/data");
+ 	$result.=&Apache::edit::modifiedfield($token);
      }
      return $result;
  }
- Line 386  sub end_data {
+ Line 638  sub end_data {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::end_table();
      }
      return $result;
  }
- Line 395  sub end_data {
+ Line 648  sub end_data {
  sub start_axis {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result='';
-     &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
- 		    $tagstack->[-1]);
      if ($target eq 'web') {
- 	# This routine should never return anything.
+ 	&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
+ 			$tagstack->[-1]);
+     } elsif ($target eq 'edit') {
+ 	$result .= &Apache::edit::tag_start($target,$token,'Plot Axes');
+ 	$result .= &edit_attributes($target,$token,\%axis_defaults);
+     } elsif ($target eq 'modified') {
+ 	my $constructtag=&Apache::edit::get_new_args
+ 	    ($token,$parstack,$safeeval,keys(%axis_defaults));
+ 	if ($constructtag) {
+ 	    $result = &Apache::edit::rebuild_tag($token);
+ 	    $result.= &Apache::edit::handle_insert();
+ 	}
      }
      return $result;
  }
- Line 407  sub end_axis {
+ Line 669  sub end_axis {
      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
      my $result = '';
      if ($target eq 'web') {
- 	# This routine should never return anything.
+     } elsif ($target eq 'edit') {
+ 	$result.=&Apache::edit::tag_end($target,$token);
+     } elsif ($target eq 'modified') {
      }
      return $result;
  }
+ ###################################################################
+ ##                                                               ##
+ ##        Utility Functions                                      ##
+ ##                                                               ##
+ ###################################################################
  ##----------------------------------------------------------- set_defaults
  sub set_defaults {
-     my $var      = shift;
+     my ($var,$defaults) = @_;
-     my $defaults = shift;
      my $key;
-     foreach $key (keys %$defaults) {
+     foreach $key (keys(%$defaults)) {
  	$var->{$key} = $defaults->{$key}->{'default'};
      }
  }
  ##------------------------------------------------------------------- misc
  sub get_attributes{
-     my $values   = shift;
+     my ($values,$defaults,$parstack,$safeeval,$tag) = @_;
-     my $defaults = shift;
+     foreach my $attr (keys(%{$defaults})) {
-     my $parstack = shift;
-     my $safeeval = shift;
-     my $tag      = shift;
-     my $attr;
-     foreach $attr (keys %{$defaults}) {
  	$values->{$attr} =
- 	             &Apache::lonxml::get_param($attr,$parstack,$safeeval);
+ 	    &Apache::lonxml::get_param($attr,$parstack,$safeeval);
  	if ($values->{$attr} eq '' | !defined($values->{$attr})) {
  	    $values->{$attr} = $defaults->{$attr}->{'default'};
  	    next;
- Line 447  sub get_attributes{
+ Line 711  sub get_attributes{
      }
      return ;
  }
+ ##------------------------------------------------------- write_gnuplot_file
  sub write_gnuplot_file {
      my $gnuplot_input = '';
      my $curve;
- Line 456  sub write_gnuplot_file {
+ Line 720  sub write_gnuplot_file {
      push @Colors, $plot{'bgcolor'};
      push @Colors, $plot{'fgcolor'};
      push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
-     push @Colors, $Colors[-1];  # Redundancy
      foreach $curve (@curves) {
  	push @Colors, ($curve->{'color'} ne '' ?
  		       $curve->{'color'}       :
- Line 478  sub write_gnuplot_file {
+ Line 741  sub write_gnuplot_file {
      $gnuplot_input .= "set title  \"$title\"\n"  if (defined($title)) ;
      $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));
      $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));
-     if (defined(%axis)) {
+     if (%axis) {
  	$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
  	$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
      }
      # Key
-     if (defined(%key)) {
+     if (%key) {
  	$gnuplot_input .= 'set key '.$key{'pos'}.' ';
  	if ($key{'title'} ne '') {
  	    $gnuplot_input .= 'title "'.$key{'title'}.'" ';
- Line 529  sub write_gnuplot_file {
+ Line 792  sub write_gnuplot_file {
      return $gnuplot_input;
  }
-;
+ #---------------------------------------------- check_inputs
- __END__
+ sub check_inputs {
+     ## Note: no inputs, no outputs - this acts only on global variables.
+     ## Make sure we have all the input we need:
+     if (! %plot) { &set_defaults(\%plot,\%plot_defaults); }
+     if (! %key ) {} # No key for this plot, thats okay
+     if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
+     if (! defined($title )) {} # No title for this plot, thats okay
+     if (! defined($xlabel)) {} # No xlabel for this plot, thats okay
+     if (! defined($ylabel)) {} # No ylabel for this plot, thats okay
+     if ($#labels < 0) { }      # No labels for this plot, thats okay
+     if ($#curves < 0) {
+ 	&Apache::lonxml::warning("No curves specified for plot!!!!");
+ 	return '';
+     }
+     my $curve;
+     foreach $curve (@curves) {
+ 	if (!defined($curve->{'function'})&&!defined($curve->{'data'})){
+ 	    &Apache::lonxml::warning("One of the curves specified did not contain any <data> or <function> declarations\n");
+ 	    return '';
+ 	}
+     }
+ }
+ #------------------------------------------------ make_edit
+ sub edit_attributes {
+     my ($target,$token,$defaults) = @_;
+     my $result;
+     foreach my $attr (sort keys(%$defaults)) {
+ 	if ($defaults->{$attr}->{'edit_type'} eq 'entry') {
+ 	    $result .= &Apache::edit::text_arg(
+                  $defaults->{$attr}->{'description'},
+ 		 $attr,
+ 		 $token);
+ 	} elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {
+ 	    $result .= &Apache::edit::select_arg(
+ 		 $defaults->{$attr}->{'description'},
+ 		 $attr,
+ 		 $defaults->{$attr}->{'choices'},
+ 		 $token);
+ 	}
+ 	$result .= '<br />';
+     }
+     return $result;
+ }
+ ###################################################################
+ ##                                                               ##
+ ##           Insertion functions for editing plots               ##
+ ##                                                               ##
+ ###################################################################
+ #------------------------------------------------ insert_xxxxxxx
+ sub insert_plot {
+     my $result = '';
+     #  plot attributes
+     $result .= "<plot \n";
+     foreach my $attr (keys(%plot_defaults)) {
+ 	$result .= "     $attr=\"$plot_defaults{$attr}->{'default'}\"\n";
+     }
+     $result .= ">\n";
+     # Add the components
+     $result .= &insert_key();
+     $result .= &insert_axis();
+     $result .= &insert_title();
+     $result .= &insert_xlabel();
+     $result .= &insert_ylabel();
+     $result .= &insert_curve();
+     # close up the <plot>
+     $result .= "</plot>\n";
+     return $result;
+ }
+ sub insert_key {
+     my $result;
+     $result .= "    <key \n";
+     foreach my $attr (keys(%key_defaults)) {
+ 	$result .= "         $attr=\"$key_defaults{$attr}->{'default'}\"\n";
+     }
+     $result .= "   />\n";
+     return $result;
+ }
+ sub insert_axis{
+     my $result;
+     $result .= '    <axis ';
+    foreach my $attr (keys(%axis_defaults)) {
+ 	$result .= "         $attr=\"$axis_defaults{$attr}->{'default'}\"\n";
+     }
+     $result .= "   />\n";
+     return $result;
+ }
+ sub insert_title { return "    <title></title>\n"; }
+ sub insert_xlabel { return "    <xlabel></xlabel>\n"; }
+ sub insert_ylabel { return "    <ylabel></ylabel>\n"; }
+ sub insert_label {
+     my $result;
+     $result .= '    <label ';
+     foreach my $attr (keys(%label_defaults)) {
+ 	$result .= '         '.$attr.'="'.
+ 	    $label_defaults{$attr}->{'default'}."\"\n";
+     }
+     $result .= "   ></label>\n";
+     return $result;
+ }
+ sub insert_curve {
+     my $result;
+     $result .= '    <curve ';
+     foreach my $attr (keys(%curve_defaults)) {
+ 	$result .= '         '.$attr.'="'.
+ 	    $curve_defaults{$attr}->{'default'}."\"\n";
+     }
+     $result .= "    ></curve>\n";
+ }
+ sub insert_function {
+     my $result;
+     $result .= "<function></function>\n";
+     return $result;
+ }
+ sub insert_data {
+     my $result;
+     $result .= "     <data></data>\n";
+     return $result;
+ }
+ ##----------------------------------------------------------------------
+;
+ __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.14
changed lines
	Added in v.1.33