Diff for /loncom/xml/lonplot.pm between versions 1.43 and 1.47

version 1.43, 2002/01/21 17:23:31 version 1.47, 2002/02/05 15:05:44
Line 40  use Apache::lonxml; Line 40  use Apache::lonxml;
 use Apache::edit;  use Apache::edit;
   
 BEGIN {  BEGIN {
   &Apache::lonxml::register('Apache::lonplot',('plot'));    &Apache::lonxml::register('Apache::lonplot',('gnuplot'));
 }  }
   
 ##   ## 
Line 113  my $words_test     = sub {$_[0]=~s/\s+/ Line 113  my $words_test     = sub {$_[0]=~s/\s+/
 ##                      Attribute metadata                       ##  ##                      Attribute metadata                       ##
 ##                                                               ##  ##                                                               ##
 ###################################################################  ###################################################################
 my @plot_edit_order =   my @gnuplot_edit_order = 
     qw/bgcolor fgcolor height width font transparent grid border align/;      qw/bgcolor fgcolor height width font transparent grid border align/;
 my %plot_defaults =   my %gnuplot_defaults = 
     (      (
      height       => {       height       => {
  default     => 200,   default     => 200,
Line 149  my %plot_defaults = Line 149  my %plot_defaults =
  default     => 'off',   default     => 'off',
  test        => $onoff_test,    test        => $onoff_test, 
  description => 'Transparent image',   description => 'Transparent image',
  edit_type   => 'on_off'   edit_type   => 'onoff'
  },   },
      grid         => {       grid         => {
  default     => 'off',   default     => 'off',
  test        => $onoff_test,    test        => $onoff_test, 
  description => 'Display grid',   description => 'Display grid',
  edit_type   => 'on_off'   edit_type   => 'onoff'
  },   },
      border       => {       border       => {
  default     => 'on',   default     => 'on',
  test        => $onoff_test,    test        => $onoff_test, 
  description => 'Draw border around plot',   description => 'Draw border around plot',
  edit_type   => 'on_off'   edit_type   => 'onoff'
  },   },
      font         => {       font         => {
  default     => 'medium',   default     => 'medium',
Line 192  my %key_defaults = Line 192  my %key_defaults =
  default => 'off',   default => 'off',
  test => $onoff_test,   test => $onoff_test,
  description => 'Draw a box around the key?',   description => 'Draw a box around the key?',
  edit_type   => 'on_off'   edit_type   => 'onoff'
  },   },
      pos   => {        pos   => { 
  default => 'top right',    default => 'top right', 
Line 229  my %label_defaults = Line 229  my %label_defaults =
      }       }
      );       );
   
   my @tic_edit_order = ('location','mirror','start','increment','end');
   my %tic_defaults =
       (
        location => {
    default => 'border', 
    test => sub {$_[0]=~/^(border|axis)$/},
    description => 'Location of tick marks',
    edit_type   => 'choice',
    choices     => ['border','axis']
    },
        mirror => {
    default => 'on', 
    test => $onoff_test,
    description => 'mirror ticks on opposite axis?',
    edit_type   => 'onoff'
    },
        start => {
    default => '-10.0',
    test => $real_test,
    description => 'Start ticks at',
    edit_type   => 'entry',
    size        => '10'
    },
        increment => {
    default => '1.0',
    test => $real_test,
    description => 'Place a tick every',
    edit_type   => 'entry',
    size        => '10'
    },
        end => {
    default => ' 10.0',
    test => $real_test,
    description => 'Stop ticks at ',
    edit_type   => 'entry',
    size        => '10'
    },
        );
   
 my %axis_defaults =   my %axis_defaults = 
     (      (
      color   => {       color   => {
Line 298  my %curve_defaults = Line 337  my %curve_defaults =
 ##                    parsing and edit rendering                 ##  ##                    parsing and edit rendering                 ##
 ##                                                               ##  ##                                                               ##
 ###################################################################  ###################################################################
 my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);  my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics);
   
 sub start_plot {  sub start_gnuplot {
     %plot    = ();      %key     = ();      %axis   = ();       %plot    = ();      %key     = ();      %axis   = (); 
     $title   = undef;   $xlabel  = undef;   $ylabel = undef;      $title   = undef;   $xlabel  = undef;   $ylabel = undef;
     $#labels = -1;      $#curves = -1;      $#labels = -1;      $#curves = -1;
       %xtics    = ();      %ytics    = ();
     #      #
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     &Apache::lonxml::register('Apache::lonplot',      &Apache::lonxml::register('Apache::lonplot',
      ('title','xlabel','ylabel','key','axis','label','curve'));       ('title','xlabel','ylabel','key','axis','label','curve',
         'xtics','ytics'));
     push (@Apache::lonxml::namespace,'lonplot');      push (@Apache::lonxml::namespace,'lonplot');
     if ($target eq 'web') {      if ($target eq 'web') {
  my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);   my $inside = &Apache::lonxml::get_all_text("/gnuplot",$$parser[-1]);
  $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);   $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
  &Apache::lonxml::newparser($parser,\$inside);   &Apache::lonxml::newparser($parser,\$inside);
  &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,   &get_attributes(\%plot,\%gnuplot_defaults,$parstack,$safeeval,
  $tagstack->[-1]);   $tagstack->[-1]);
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result .= &Apache::edit::tag_start($target,$token,'Plot');   $result .= &Apache::edit::tag_start($target,$token,'GnuPlot');
  $result .= &edit_attributes($target,$token,\%plot_defaults,   $result .= &edit_attributes($target,$token,\%gnuplot_defaults,
     \@plot_edit_order);      \@gnuplot_edit_order);
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $constructtag=&Apache::edit::get_new_args   my $constructtag=&Apache::edit::get_new_args
     ($token,$parstack,$safeeval,keys(%plot_defaults));      ($token,$parstack,$safeeval,keys(%gnuplot_defaults));
  if ($constructtag) {   if ($constructtag) {
     $result = &Apache::edit::rebuild_tag($token);      $result = &Apache::edit::rebuild_tag($token);
  }   }
Line 330  sub start_plot { Line 371  sub start_plot {
     return $result;      return $result;
 }  }
   
 sub end_plot {  sub end_gnuplot {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
     pop @Apache::lonxml::namespace;      pop @Apache::lonxml::namespace;
     &Apache::lonxml::deregister('Apache::lonplot',      &Apache::lonxml::deregister('Apache::lonplot',
  ('title','xlabel','ylabel','key','axis','label','curve'));   ('title','xlabel','ylabel','key','axis','label','curve'));
Line 352  sub end_plot { Line 392  sub end_plot {
      width  = "$plot{'width'}"        width  = "$plot{'width'}" 
      height = "$plot{'height'}"       height = "$plot{'height'}"
      align  = "$plot{'align'}"       align  = "$plot{'align'}"
      alt    = "/cgi-bin/plot.gif?$filename" />       alt    = "image should be /cgi-bin/plot.gif?$filename" />
 ENDIMAGE  ENDIMAGE
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_end($target,$token);   $result.=&Apache::edit::tag_end($target,$token);
Line 360  ENDIMAGE Line 400  ENDIMAGE
     return $result;      return $result;
 }  }
   
   
   ##--------------------------------------------------------------- xtics
   sub start_xtics {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result='';
       if ($target eq 'web') {
    &get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
       } elsif ($target eq 'edit') {
    $result .= &Apache::edit::tag_start($target,$token,'xtics');
    $result .= &edit_attributes($target,$token,\%tic_defaults,
       \@tic_edit_order);
       } elsif ($target eq 'modified') {
    my $constructtag=&Apache::edit::get_new_args
       ($token,$parstack,$safeeval,keys(%tic_defaults));
    if ($constructtag) {
       $result = &Apache::edit::rebuild_tag($token);
    }
       }
       return $result;
   }
   
   sub end_xtics {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result = '';
       if ($target eq 'web') {
       } elsif ($target eq 'edit') {
    $result.=&Apache::edit::tag_end($target,$token);
       }
       return $result;
   }
   
   ##--------------------------------------------------------------- ytics
   sub start_ytics {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result='';
       if ($target eq 'web') {
    &get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
       } elsif ($target eq 'edit') {
    $result .= &Apache::edit::tag_start($target,$token,'ytics');
    $result .= &edit_attributes($target,$token,\%tic_defaults,
       \@tic_edit_order);
       } elsif ($target eq 'modified') {
    my $constructtag=&Apache::edit::get_new_args
       ($token,$parstack,$safeeval,keys(%tic_defaults));
    if ($constructtag) {
       $result = &Apache::edit::rebuild_tag($token);
    }
       }
       return $result;
   }
   
   sub end_ytics {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result = '';
       if ($target eq 'web') {
       } elsif ($target eq 'edit') {
    $result.=&Apache::edit::tag_end($target,$token);
       }
       return $result;
   }
   
   
 ##----------------------------------------------------------------- key  ##----------------------------------------------------------------- key
 sub start_key {  sub start_key {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
Line 762  sub write_gnuplot_file { Line 866  sub write_gnuplot_file {
     $gnuplot_input .= $plot{'font'} . ' ';      $gnuplot_input .= $plot{'font'} . ' ';
     $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';      $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';
     $gnuplot_input .= "@Colors\n";      $gnuplot_input .= "@Colors\n";
       # set output
       $gnuplot_input .= "set output\n";
     # grid      # grid
     $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');      $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');
     # border      # border
     $gnuplot_input .= ($plot{'border'} eq 'on'?      $gnuplot_input .= ($plot{'border'} eq 'on'?
        'set border'.$/           :         'set border'.$/           :
        'set noborder'.$/         );    # title, xlabel, ylabel         'set noborder'.$/         );    # title, xlabel, ylabel
     $gnuplot_input .= "set output\n";      # titles
     $gnuplot_input .= "set title  \"$title\"\n"  if (defined($title)) ;      $gnuplot_input .= "set title  \"$title\"\n"  if (defined($title)) ;
     $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));      $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));
     $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));      $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));
       # tics
       if (%xtics) {    
    $gnuplot_input .= "set xtics $xtics{'location'} ";
    $gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror ");
    $gnuplot_input .= "$xtics{'start'}, ";
    $gnuplot_input .= "$xtics{'increment'}, ";
    $gnuplot_input .= "$xtics{'end'}\n";
       }
       if (%ytics) {    
    $gnuplot_input .= "set ytics $ytics{'location'} ";
    $gnuplot_input .= ( $ytics{'mirror'} eq 'on'?"mirror ":"nomirror ");
    $gnuplot_input .= "$ytics{'start'}, ";
    $gnuplot_input .= "$ytics{'increment'}, ";
           $gnuplot_input .= "$ytics{'end'}\n";
       }
       # axis
     if (%axis) {      if (%axis) {
  $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";   $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
  $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";   $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
Line 839  sub write_gnuplot_file { Line 961  sub write_gnuplot_file {
 sub check_inputs {  sub check_inputs {
     ## Note: no inputs, no outputs - this acts only on global variables.      ## Note: no inputs, no outputs - this acts only on global variables.
     ## Make sure we have all the input we need:      ## Make sure we have all the input we need:
     if (! %plot) { &set_defaults(\%plot,\%plot_defaults); }      if (! %plot) { &set_defaults(\%plot,\%gnuplot_defaults); }
     if (! %key ) {} # No key for this plot, thats okay      if (! %key ) {} # No key for this plot, thats okay
 #    if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }  #    if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
     if (! defined($title )) {} # No title for this plot, thats okay      if (! defined($title )) {} # No title for this plot, thats okay
Line 879  sub edit_attributes { Line 1001  sub edit_attributes {
  } 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);
  } elsif ($defaults->{$attr}->{'edit_type'} eq 'on_off') {   } elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') {
     $result .= &Apache::edit::select_arg      $result .= &Apache::edit::select_arg
  ($description,$attr,['on','off'],$token);   ($description,$attr,['on','off'],$token);
  }   }
Line 895  sub edit_attributes { Line 1017  sub edit_attributes {
 ##                                                               ##  ##                                                               ##
 ###################################################################  ###################################################################
   
 #------------------------------------------------ insert_xxxxxxx  sub insert_gnuplot {
 sub insert_plot {  
     my $result = '';      my $result = '';
     #  plot attributes      #  plot attributes
     $result .= "<plot \n";      $result .= "<plot \n";
     foreach my $attr (keys(%plot_defaults)) {      foreach my $attr (keys(%gnuplot_defaults)) {
  $result .= "     $attr=\"$plot_defaults{$attr}->{'default'}\"\n";   $result .= "     $attr=\"$gnuplot_defaults{$attr}->{'default'}\"\n";
     }      }
     $result .= ">\n";      $result .= ">\n";
     # Add the components      # Add the components (most are commented out for simplicity)
     $result .= &insert_key();      # $result .= &insert_key();
     $result .= &insert_axis();      # $result .= &insert_axis();
     $result .= &insert_title();          # $result .= &insert_title();    
     $result .= &insert_xlabel();          # $result .= &insert_xlabel();    
     $result .= &insert_ylabel();          # $result .= &insert_ylabel();    
     $result .= &insert_curve();      $result .= &insert_curve();
     # close up the <plot>      # close up the <plot>
     $result .= "</plot>\n";      $result .= "</plot>\n";
     return $result;      return $result;
 }  }
   
   sub insert_tics {
       my $result;
       $result .= &insert_xtics() . &insert_ytics;
       return $result;
   }
   
   sub insert_xtics {
       my $result;
       $result .= "\n    <xtics ";
       foreach my $attr (keys(%tic_defaults)) {
    $result .= "$attr=\"$tic_defaults{$attr}->{'default'}\" ";
       }
       $result .= "/>\n";
       return $result;
   }
   
   sub insert_ytics {
       my $result;
       $result .= "\n    <ytics ";
       foreach my $attr (keys(%tic_defaults)) {
    $result .= "$attr=\"$tic_defaults{$attr}->{'default'}\" ";
       }
       $result .= "/>\n";
       return $result;
   }
   
 sub insert_key {  sub insert_key {
     my $result;      my $result;
     $result .= "    <key \n";      $result .= "\n    <key \n";
     foreach my $attr (keys(%key_defaults)) {      foreach my $attr (keys(%key_defaults)) {
  $result .= "         $attr=\"$key_defaults{$attr}->{'default'}\"\n";   $result .= "         $attr=\"$key_defaults{$attr}->{'default'}\"\n";
     }      }
Line 928  sub insert_key { Line 1075  sub insert_key {
   
 sub insert_axis{  sub insert_axis{
     my $result;      my $result;
     $result .= '    <axis ';      $result .= "\n    <axis ";
    foreach my $attr (keys(%axis_defaults)) {     foreach my $attr (keys(%axis_defaults)) {
  $result .= "         $attr=\"$axis_defaults{$attr}->{'default'}\"\n";   $result .= "         $attr=\"$axis_defaults{$attr}->{'default'}\"\n";
     }      }
Line 936  sub insert_axis{ Line 1083  sub insert_axis{
     return $result;      return $result;
 }  }
   
 sub insert_title { return "    <title></title>\n"; }  sub insert_title { return "\n    <title></title>\n"; }
 sub insert_xlabel { return "    <xlabel></xlabel>\n"; }  sub insert_xlabel { return "\n    <xlabel></xlabel>\n"; }
 sub insert_ylabel { return "    <ylabel></ylabel>\n"; }  sub insert_ylabel { return "\n    <ylabel></ylabel>\n"; }
   
 sub insert_label {  sub insert_label {
     my $result;      my $result;
     $result .= '    <label ';      $result .= "\n    <label ";
     foreach my $attr (keys(%label_defaults)) {      foreach my $attr (keys(%label_defaults)) {
  $result .= '         '.$attr.'="'.   $result .= '         '.$attr.'="'.
     $label_defaults{$attr}->{'default'}."\"\n";      $label_defaults{$attr}->{'default'}."\"\n";

Removed from v.1.43  
changed lines
  Added in v.1.47


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