Diff for /loncom/xml/lonplot.pm between versions 1.35 and 1.40

version 1.35, 2002/01/09 16:51:51 version 1.40, 2002/01/15 16:21:39
Line 119  my $words_test     = sub {$_[0]=~s/\s+/ Line 119  my $words_test     = sub {$_[0]=~s/\s+/
 ##                                                               ##  ##                                                               ##
 ###################################################################  ###################################################################
 my @plot_edit_order =   my @plot_edit_order = 
     qw/bgcolor fgcolor height width font transparent grid border/;      qw/bgcolor fgcolor height width font transparent grid border align/;
 my %plot_defaults =   my %plot_defaults = 
     (      (
      height       => {       height       => {
  default     => 200,   default     => 200,
  test        => $int_test,   test        => $int_test,
  description => 'height of image (pixels)',   description => 'height of image (pixels)',
  edit_type   => 'entry'         edit_type   => 'entry',
    size        => '10'
  },   },
      width        => {       width        => {
  default     => 200,   default     => 200,
  test        => $int_test,   test        => $int_test,
  description => 'width of image (pixels)',   description => 'width of image (pixels)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      bgcolor      => {       bgcolor      => {
  default     => 'xffffff',   default     => 'xffffff',
  test        => $color_test,    test        => $color_test, 
  description => 'background color of image (xffffff)',   description => 'background color of image (xffffff)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      fgcolor      => {       fgcolor      => {
  default     => 'x000000',   default     => 'x000000',
  test        => $color_test,   test        => $color_test,
  description => 'foreground color of image (x000000)',   description => 'foreground color of image (x000000)',
  edit_type   => 'entry'    edit_type   => 'entry',
    size        => '10'
  },   },
      transparent  => {       transparent  => {
  default     => 'off',   default     => 'off',
Line 186  my %key_defaults = Line 190  my %key_defaults =
  default => '',   default => '',
  test => $words_test,   test => $words_test,
  description => 'Title of key',   description => 'Title of key',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '40'
  },   },
      box   => {        box   => { 
  default => 'off',   default => 'off',
Line 210  my %label_defaults = Line 215  my %label_defaults =
  default => 0,   default => 0,
  test => $real_test,   test => $real_test,
  description => 'x position of label (graph coordinates)',   description => 'x position of label (graph coordinates)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      ypos    => {       ypos    => {
  default => 0,    default => 0, 
  test => $real_test,   test => $real_test,
  description => 'y position of label (graph coordinates)',   description => 'y position of label (graph coordinates)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      justify => {       justify => {
  default => 'left',       default => 'left',    
Line 233  my %axis_defaults = Line 240  my %axis_defaults =
  default => 'x000000',    default => 'x000000', 
  test => $color_test,   test => $color_test,
  description => 'color of axes (x000000)',   description => 'color of axes (x000000)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      xmin      => {       xmin      => {
  default => '-10.0',   default => '-10.0',
  test => $real_test,   test => $real_test,
  description => 'minimum x-value shown in plot',   description => 'minimum x-value shown in plot',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      xmax      => {       xmax      => {
  default => ' 10.0',   default => ' 10.0',
  test => $real_test,   test => $real_test,
  description => 'maximum x-value shown in plot',     description => 'maximum x-value shown in plot',  
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      ymin      => {       ymin      => {
  default => '-10.0',   default => '-10.0',
  test => $real_test,   test => $real_test,
  description => 'minimum y-value shown in plot',     description => 'minimum y-value shown in plot',  
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      ymax      => {       ymax      => {
  default => ' 10.0',   default => ' 10.0',
  test => $real_test,   test => $real_test,
  description => 'maximum y-value shown in plot',     description => 'maximum y-value shown in plot',  
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  }   }
      );       );
   
Line 267  my %curve_defaults = Line 279  my %curve_defaults =
  default => 'x000000',   default => 'x000000',
  test => $color_test,   test => $color_test,
  description => 'color of curve (x000000)',   description => 'color of curve (x000000)',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '10'
  },   },
      name      => {       name      => {
  default => '',   default => '',
  test => $words_test,   test => $words_test,
  description => 'name of curve to appear in key',   description => 'name of curve to appear in key',
  edit_type   => 'entry'   edit_type   => 'entry',
    size        => '20'
  },   },
      linestyle => {       linestyle => {
  default => 'lines',   default => 'lines',
  test => $linestyle_test,   test => $linestyle_test,
  description => 'Line style',   description => 'Line style',
  edit_type   => 'choice',   edit_type   => 'choice',
  choices     => ['lines','linespoints','dots','points','steps',   choices     => [keys(%linestyles)]
  'fsteps','histeps','errorbars','xerrorbars',  
  'yerrorbars','xyerrorbars','boxes','boxerrorbars',  
  'boxxyerrorbars','financebars','candlesticks',  
  'vector']  
  }   }
      );       );
   
Line 320  sub start_plot { Line 330  sub start_plot {
     ($token,$parstack,$safeeval,keys(%plot_defaults));      ($token,$parstack,$safeeval,keys(%plot_defaults));
  if ($constructtag) {   if ($constructtag) {
     $result = &Apache::edit::rebuild_tag($token);      $result = &Apache::edit::rebuild_tag($token);
 #    $result.= &Apache::edit::handle_insert();  
  }   }
     }      }
     return $result;      return $result;
Line 341  sub end_plot { Line 350  sub end_plot {
  my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.   my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
     '_'.time.'_'.$$.int(rand(1000)).'_plot.data';      '_'.time.'_'.$$.int(rand(1000)).'_plot.data';
  ## Write the plot description to the file   ## Write the plot description to the file
  my $fh=Apache::File->new(">$tmpdir$filename");   &write_gnuplot_file($tmpdir,$filename);
  print $fh &write_gnuplot_file();  
  close($fh);  
  ## return image tag for the plot   ## return image tag for the plot
  $result .= <<"ENDIMAGE";   $result .= <<"ENDIMAGE";
 <img src    = "/cgi-bin/plot.gif?$filename"   <img src    = "/cgi-bin/plot.gif?$filename" 
Line 401  sub start_title { Line 408  sub start_title {
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token,'Plot Title');   $result.=&Apache::edit::tag_start($target,$token,'Plot Title');
  my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);   my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);
  $result.='</td></tr><tr><td colspan="3">'.   $result.=&Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $text=$$parser[-1]->get_text("/title");   my $text=$$parser[-1]->get_text("/title");
Line 431  sub start_xlabel { Line 439  sub start_xlabel {
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');   $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
  my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);   my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
  $result.='</td></tr><tr><td colspan="3">'.   $result.=&Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $text=$$parser[-1]->get_text("/xlabel");   my $text=$$parser[-1]->get_text("/xlabel");
Line 462  sub start_ylabel { Line 471  sub start_ylabel {
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');   $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
  my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);   my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
  $result .= '</td></tr><tr><td colspan="3">'.   $result .= &Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $text=$$parser[-1]->get_text("/ylabel");   my $text=$$parser[-1]->get_text("/ylabel");
Line 497  sub start_label { Line 507  sub start_label {
  $result .= &Apache::edit::tag_start($target,$token,'Plot Label');   $result .= &Apache::edit::tag_start($target,$token,'Plot Label');
  $result .= &edit_attributes($target,$token,\%label_defaults);   $result .= &edit_attributes($target,$token,\%label_defaults);
  my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);   my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
  $result .= '</td></tr><tr><td colspan="3">'.   $result .= &Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $constructtag=&Apache::edit::get_new_args   my $constructtag=&Apache::edit::get_new_args
Line 571  sub start_function { Line 582  sub start_function {
  $curves[-1]->{'function'} =    $curves[-1]->{'function'} = 
     &Apache::lonxml::get_all_text("/function",$$parser[-1]);      &Apache::lonxml::get_all_text("/function",$$parser[-1]);
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result .= &Apache::edit::tag_start($target,$token,'Curve Function');   $result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function');
  my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);   my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);
  $result .= '</td></tr><tr><td colspan="3">'.   $result .= &Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  # Why do I do this?   # Why do I do this?
Line 605  sub start_data { Line 617  sub start_data {
     delete($curves[-1]->{'function'});      delete($curves[-1]->{'function'});
  }   }
  my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);   my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
    # Deal with cases where we're given an array...
    if ($datatext =~ /^\@/) {
       $datatext = &Apache::run::run('return "'.$datatext.'"',
     $safeeval,1);
    }
  $datatext =~ s/\s+/ /g;     $datatext =~ s/\s+/ /g;  
  # Need to do some error checking on the @data array -    # Need to do some error checking on the @data array - 
  # make sure it's all numbers and make sure each array    # make sure it's all numbers and make sure each array 
Line 633  sub start_data { Line 650  sub start_data {
  }   }
  # complain if the number of data points is not the same as   # complain if the number of data points is not the same as
  # in previous sets of data.   # in previous sets of data.
  if (($curves[-1]->{'data'}) && ($#data != $#{$curves[-1]->{'data'}})){   if (($curves[-1]->{'data'}) && ($#data != $#{@{$curves[-1]->{'data'}->[0]}})){
     &Apache::lonxml::warning      &Apache::lonxml::warning
  ('Number of data points is not consistent with previous '.   ('Number of data points is not consistent with previous '.
  'number of data points');   'number of data points');
  }   }
  push  @{$curves[-1]->{'data'}},\@data;   push  @{$curves[-1]->{'data'}},\@data;
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result .= &Apache::edit::tag_start($target,$token,'Curve Data');   $result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data');
  my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);   my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
  $result .= '</td></tr><tr><td colspan="3">'.   $result .= &Apache::edit::end_row().
       &Apache::edit::start_spanning_row().
     &Apache::edit::editfield('',$text,'',60,1);      &Apache::edit::editfield('',$text,'',60,1);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $text=$$parser[-1]->get_text("/data");   my $text=$$parser[-1]->get_text("/data");
Line 728  sub get_attributes{ Line 746  sub get_attributes{
     }      }
     return ;      return ;
 }  }
   
 ##------------------------------------------------------- write_gnuplot_file  ##------------------------------------------------------- write_gnuplot_file
 sub write_gnuplot_file {  sub write_gnuplot_file {
       my ($tmpdir,$filename)= @_;
     my $gnuplot_input = '';      my $gnuplot_input = '';
     my $curve;      my $curve;
     # Collect all the colors      # Collect all the colors
Line 780  sub write_gnuplot_file { Line 800  sub write_gnuplot_file {
     }      }
     # curves      # curves
     $gnuplot_input .= 'plot ';      $gnuplot_input .= 'plot ';
     my $datatext = '';  
     for (my $i = 0;$i<=$#curves;$i++) {      for (my $i = 0;$i<=$#curves;$i++) {
  $curve = $curves[$i];   $curve = $curves[$i];
  $gnuplot_input.= ', ' if ($i > 0);   $gnuplot_input.= ', ' if ($i > 0);
Line 790  sub write_gnuplot_file { Line 809  sub write_gnuplot_file {
  $curve->{'name'}.'" with '.   $curve->{'name'}.'" with '.
  $curve->{'linestyle'};   $curve->{'linestyle'};
  } elsif (exists($curve->{'data'})) {   } elsif (exists($curve->{'data'})) {
     $gnuplot_input.= '\'-\' title "'.      # Store data values in $datatext
  $curve->{'name'}.'" with '.      my $datatext = '';
  $curve->{'linestyle'};      #   get new filename
       my $datafilename = "$tmpdir/$filename.$i";
       my $fh=Apache::File->new(">$datafilename");
       # Compile data
     my @Data = @{$curve->{'data'}};      my @Data = @{$curve->{'data'}};
     my @Data0 = @{$Data[0]};      my @Data0 = @{$Data[0]};
     for (my $i =0; $i<=$#Data0; $i++) {      for (my $i =0; $i<=$#Data0; $i++) {
Line 802  sub write_gnuplot_file { Line 824  sub write_gnuplot_file {
  }   }
  $datatext .= $/;   $datatext .= $/;
     }      }
     $datatext .=$/;      #   write file
       print $fh $datatext;
       close ($fh);
       #   generate gnuplot text
       $gnuplot_input.= '"'.$datafilename.'" title "'.
    $curve->{'name'}.'" with '.
    $curve->{'linestyle'};
  }   }
     }      }
     $gnuplot_input .= $/.$datatext;      # Write the output to a file.
     return $gnuplot_input;      my $fh=Apache::File->new(">$tmpdir$filename");
       print $fh $gnuplot_input;
       close($fh);
       # That's all folks.
       return ;
 }  }
   
 #---------------------------------------------- check_inputs  #---------------------------------------------- check_inputs
Line 848  sub edit_attributes { Line 880  sub edit_attributes {
  $description .= ' ' if ($description !~ / $/);   $description .= ' ' if ($description !~ / $/);
  if ($defaults->{$attr}->{'edit_type'} eq 'entry') {   if ($defaults->{$attr}->{'edit_type'} eq 'entry') {
     $result .= &Apache::edit::text_arg      $result .= &Apache::edit::text_arg
  ($description,$attr,$token);   ($description,$attr,$token,
    $defaults->{$attr}->{'size'});
  } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {   } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {
     $result .= &Apache::edit::select_arg      $result .= &Apache::edit::select_arg
  ($description,$attr,$defaults->{$attr}->{'choices'},$token);   ($description,$attr,$defaults->{$attr}->{'choices'},$token);

Removed from v.1.35  
changed lines
  Added in v.1.40


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