[BACK]Return to lonplot.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonplot.pm between versions 1.5 and 1.6

version 1.5, 2001/12/18 22:29:42 version 1.6, 2001/12/19 18:27:30
Line 37  sub BEGIN { Line 37  sub BEGIN {
   &Apache::lonxml::register('Apache::lonplot',('plot'));    &Apache::lonxml::register('Apache::lonplot',('plot'));
 }  }
   
   
 ##  ##
 ## Tests used in checking the validitity of input  ## Tests used in checking the validitity of input
 ##  ##
Line 75  my %label_defaults = Line 74  my %label_defaults =
     (      (
      xpos    => {default => 0,         test => $real_test                   },       xpos    => {default => 0,         test => $real_test                   },
      ypos    => {default => 0,         test => $real_test                   },       ypos    => {default => 0,         test => $real_test                   },
      color   => {default => 'x000000', test => $color_test                  },  
      justify => {default => 'left',           justify => {default => 'left',    
                  test => sub {$_[0]=~/^(left|right|center)$/}}                   test => sub {$_[0]=~/^(left|right|center)$/}}
      );       );
Line 83  my %label_defaults = Line 81  my %label_defaults =
 my %axis_defaults =   my %axis_defaults = 
     (      (
      color     => {default => 'x000000', test => $color_test},       color     => {default => 'x000000', test => $color_test},
      thickness => {default => 1,         test => $int_test  },  #     thickness => {default => 1,         test => $int_test  },
      xmin      => {default => -10.0,     test => $real_test },       xmin      => {default => -10.0,     test => $real_test },
      xmax      => {default =>  10.0,     test => $real_test },       xmax      => {default =>  10.0,     test => $real_test },
      ymin      => {default => -10.0,     test => $real_test },       ymin      => {default => -10.0,     test => $real_test },
Line 106  sub start_plot { Line 104  sub start_plot {
     %plot = '';   %key='';    %axis='';       %plot = '';   %key='';    %axis=''; 
     $title='';    $xlabel=''; $ylabel='';      $title='';    $xlabel=''; $ylabel='';
     @labels = ''; @curves='';      @labels = ''; @curves='';
       #
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     &Apache::lonxml::register('Apache::plot',      &Apache::lonxml::register('Apache::plot',
Line 130  sub end_plot { Line 128  sub end_plot {
  ('title','xlabel','ylabel','key','axis','label','curve'));   ('title','xlabel','ylabel','key','axis','label','curve'));
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  ## Determine filename -- may need a better way later   ## Determine filename -- Need to use the 'id' thingy that Gerd 
    ## mentioned.
  my $tmpdir = '/home/httpd/perl/tmp/';   my $tmpdir = '/home/httpd/perl/tmp/';
  my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.   my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
     '_plot.data';      '_plot.data';
Line 138  sub end_plot { Line 137  sub end_plot {
   
  ## Write the plot description to the file   ## Write the plot description to the file
  my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname);   my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname);
  # write plot values   &write_gnuplot_file($fh);
  # write title, xlabel, ylabel  
  # write key values  
  # write axis values  
  # write label values  
  # write curve values  
  ## Ack!   
  ## return image tag for the plot   ## return image tag for the plot
  $result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';   $result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';
     }      }
Line 275  sub end_curve { Line 268  sub end_curve {
     }      }
     return $result;      return $result;
 }  }
   
 ##------------------------------------------------------------ curve function  ##------------------------------------------------------------ curve function
 sub start_function {  sub start_function {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
Line 300  sub end_function { Line 292  sub end_function {
     }      }
     return $result;      return $result;
 }  }
   
 ##------------------------------------------------------------ curve  data  ##------------------------------------------------------------ curve  data
 sub start_data {  sub start_data {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
Line 316  sub start_data { Line 307  sub start_data {
  &Apache::lonxml::warning('Malformed data: '.$datatext);   &Apache::lonxml::warning('Malformed data: '.$datatext);
  $datatext = '';   $datatext = '';
     }      }
     push( @{$curves[-1]->{'data'}},$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;
       push( @{$curves[-1]->{'data'}},\@data;
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.   # This routine should never return anything.
     }      }
Line 362  sub get_attributes{ Line 357  sub get_attributes{
     my $attr;      my $attr;
     foreach $attr (keys %defaults) {      foreach $attr (keys %defaults) {
  $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);   $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
    if ($values{$attr} eq '' | !defined($values{$attr})) {
       $values{$attr} = $defaults{$attr};
       next;
    }
  my $test = $defaults{$attr}->{'test'};   my $test = $defaults{$attr}->{'test'};
  if (! &$test($values{$attr})) {   if (! &$test($values{$attr})) {
     &Apache::lonxml::warning($tag.':'.$attr.': Bad value.  Replacing your value with : '.$defaults{$attr});      &Apache::lonxml::warning
    ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
    .$defaults{$attr} );
     $values{$attr} = $defaults{$attr};      $values{$attr} = $defaults{$attr};
     }      }
     return ;      return ;
 }  }
   
   sub write_gnuplot_file {
       my $fh = shift;
       my $gnuplot_input = '';
       # Collect all the colors
       my @Colors;
       push @Colors, $plot{'bgcolor'};
       push @Colors, $plot{'fgcolor'}; 
       push @Colors, $axis{'color'};
       push @Colors, $axis{'color'}; 
       foreach $curve (@Curves) {
    push @Colors, ($curve{'color'} ne '' ? 
          $curve{'color'}       : 
          $plot{'fgcolor'}      );
       }
       # set term
       $gnuplot_input .= 'set term gif ';
       $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on');
       $gnuplot_input .= $plot{'font'} . ' ';
       $gnuplot_input .= 'size ' . $plot{'width'} . ' ';
       $gnuplot_input .= $plot{'height'} . ' ';
       $gnuplot_input .= "@Colors\n";
       # title, xlabel, ylabel
       {
       $gnuplot_input .<<"ENDLABELS";
   set title  $title->{'text'}
   set xlabel $xlabel->{'text'}
   set ylabel $ylabel->{'text'}
   set xrange $axis->{'xmin'}:$axis->{'xmax'}
   set yrange $axis->{'ymin'}:$axis->{'ymax'}
   ENDLABELS
       }
       # Key
       if (defined($key{'pos'})) {
    $gnuplot_input .= 'set key '.$key->{'pos'}.' ';
    $gnuplot_input .= ($key->{'box'} eq 'on' ? 'box ' : 'nobox ');
    if ($key->{'title'} ne '') {
       $gnuplot_input .= 'title "'$key->{'title'}.'"\n';
    } else {
       $gnuplot_input .= '\n';
    }
       } else {
    $gnuplot_input .= 'set nokey\n';
       }    
       # axis
       $gnuplot_input .= 'set xrange ['.$axis{'xmin'}.':'.$axis{'xmin'}.']\n';
       $gnuplot_input .= 'set yrange ['.$axis{'ymin'}.':'.$axis{'ymin'}.']\n';
       # labels
       foreach $label (@labels) {
    $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '.
       $label->{'x'}.','.$label->{'y'}.'\n';
       }
       # curves
       $gnuplot_input .= 'plot ';
       my $datatext = '';
       foreach $curve (@curves) {
    if (exists($curve->{'function'})) {
       $gnuplot_input.= $curve->{'function'}.' with '.$curve->{'linestyle'};
    } elsif (exists($curve->{'data'})) {
       $gnuplot_input.= '\'-\' with '.$curve->{'linestyle'};
       my @Data = @{$curve->{'data'}};
       for ($i =0; $i<=$#Data; $i++) {
    foreach $dataset (@Data) {
       $datatext .= $dataset[$i] . ' ';
    }
    $datatext .='\n';
       }
       $datatext .='\n';
    }
       }
       $gnuplot_input .= $datatext;
       print $fh $gnuplot_input;
   }
   
 1;  1;
 __END__  __END__
   
Removed from v.1.5  
changed lines
  Added in v.1.6

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