Diff for /loncom/xml/lonplot.pm between versions 1.19 and 1.20

version 1.19, 2001/12/27 19:47:02 version 1.20, 2001/12/27 22:30:01
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 12/15/01 Matthew  # 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 Matthew
 package Apache::lonplot;  package Apache::lonplot;
   
 use strict;  use strict;
 use Apache::File;  use Apache::File;
 use Apache::response;  use Apache::response;
 use Apache::lonxml;  use Apache::lonxml;
   use Apache::edit;
   
 sub BEGIN {  sub BEGIN {
   &Apache::lonxml::register('Apache::lonplot',('plot'));    &Apache::lonxml::register('Apache::lonplot',('plot'));
Line 76  my $sml_test       = sub {$_[0]=~/^(smal Line 77  my $sml_test       = sub {$_[0]=~/^(smal
 my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};  my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
 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 =   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 => 'vertical size 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,
      align        => {default => 'left',    test =>    test        => $int_test,
   sub {$_[0]=~/^(left|right|center)$/} }   description => 'horizontal size 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 =   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 =   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 =   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'
      linestyle => {default => 'points',  test => $linestyle_test}   },
        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'
    },
        linestyle => {
    default => 'points',
    test => $linestyle_test,
    description => 'Style of the axis lines',
    edit_type   => 'choice',
    choices     => ['lines','linespoints','dots','points']
    }
      );       );
   
 my %curve_defaults =   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']
    }
      );       );
   
 ##  ##
Line 147  sub start_plot { Line 273  sub start_plot {
  ##-------------------------------------------------------   ##-------------------------------------------------------
  &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,   &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
  $tagstack->[-1]);   $tagstack->[-1]);
       } elsif ($target eq 'edit') {
       } 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 '';
 }  }
Line 195  sub end_plot { Line 329  sub end_plot {
      align  = "$plot{'align'}"       align  = "$plot{'align'}"
      alt    = "/cgi-bin/plot.gif?$filename" />       alt    = "/cgi-bin/plot.gif?$filename" />
 ENDIMAGE  ENDIMAGE
       } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 206  sub start_key { Line 342  sub start_key {
     if ($target eq 'web') {      if ($target eq 'web') {
  &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,   &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
     $tagstack->[-1]);      $tagstack->[-1]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } 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;      return $result;
 }  }
Line 215  sub end_key { Line 358  sub end_key {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 225  sub start_title { Line 369  sub start_title {
     my $result='';      my $result='';
     if ($target eq 'web') {      if ($target eq 'web') {
  $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);   $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 234  sub end_title { Line 379  sub end_title {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 244  sub start_xlabel { Line 390  sub start_xlabel {
     my $result='';      my $result='';
     if ($target eq 'web') {      if ($target eq 'web') {
  $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);   $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 253  sub end_xlabel { Line 400  sub end_xlabel {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 263  sub start_ylabel { Line 411  sub start_ylabel {
     my $result='';      my $result='';
     if ($target eq 'web') {      if ($target eq 'web') {
  $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);   $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 272  sub end_ylabel { Line 421  sub end_ylabel {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 290  sub start_label { Line 440  sub start_label {
     $label{'text'} = 'Illegal text';      $label{'text'} = 'Illegal text';
  }   }
  push(@labels,\%label);   push(@labels,\%label);
       } elsif ($target eq 'edit') {
       } 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();
    }
     }      }
     # This routine should never return anything.  
     return $result;      return $result;
 }  }
   
Line 299  sub end_label { Line 456  sub end_label {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 315  sub start_curve { Line 473  sub start_curve {
  push (@curves,\%curve);   push (@curves,\%curve);
  &Apache::lonxml::register('Apache::lonplot',('function','data'));   &Apache::lonxml::register('Apache::lonplot',('function','data'));
  push (@Apache::lonxml::namespace,'curve');   push (@Apache::lonxml::namespace,'curve');
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } 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;      return $result;
 }  }
Line 326  sub end_curve { Line 491  sub end_curve {
     if ($target eq 'web') {      if ($target eq 'web') {
  pop @Apache::lonxml::namespace;   pop @Apache::lonxml::namespace;
  &Apache::lonxml::deregister('Apache::lonplot',('function','data'));   &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 341  sub start_function { Line 507  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]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
    $result.=&Apache::edit::tag_start($target,$token);
    my $text=&Apache::lonxml::get_all_text("/function",$$parser[-1]);
    $result.='</td></tr><tr><td colspan="3">'.
       &Apache::edit::editfield('',$text,'',20,1).
       &Apache::edit::end_table();
       } elsif ($target eq 'modified') {
    # Why do I do this?
    my $text=$$parser[-1]->get_text("/function");
    $result.=&Apache::edit::modifiedfield($token);
     }      }
     return $result;      return $result;
 }  }
Line 350  sub end_function { Line 525  sub end_function {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 393  sub start_data { Line 569  sub start_data {
     }      }
  }   }
  push  @{$curves[-1]->{'data'}},\@data;   push  @{$curves[-1]->{'data'}},\@data;
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 402  sub end_data { Line 579  sub end_data {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 414  sub start_axis { Line 592  sub start_axis {
     if ($target eq 'web') {      if ($target eq 'web') {
  &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,   &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
  $tagstack->[-1]);   $tagstack->[-1]);
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } elsif ($target eq 'modified') {
     }      }
     return $result;      return $result;
 }  }
Line 423  sub end_axis { Line 602  sub end_axis {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.      } elsif ($target eq 'edit') {
       } 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;      return $result;
 }  }
Line 542  sub write_gnuplot_file { Line 728  sub write_gnuplot_file {
     $gnuplot_input .= $/.$datatext;      $gnuplot_input .= $/.$datatext;
     return $gnuplot_input;      return $gnuplot_input;
 }  }
   #------------------------------------------------ make_edit
   sub edit_attributes {
       my $target    = shift;
       my $token     = shift;
       my $defaults  = shift;
       my $result;
       foreach my $attr (%{$token->[2]}) {
    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);
    }
       }
       return $result;
   }
   
 1;  #------------------------------------------------ insert_xxxxxxx
 __END__  sub insert_plot {
       my $result;
       #  plot attributes
       $result .= '<plot ';
       foreach my $attr (%plot_defaults) {
    $result .= '     '.$attr.' "'.$plot_defaults{$attr}->{'default'}.
       "\"\n";
       }
       $result .= ">\n";
       # Add the components
       $result .= &insert_key();
       $result .= &insert_axis();
       $result .= &insert_label();    
       $result .= &insert_curve();
       $result .= &insert_function();    
       $result .= "</curve>\n";
       $result .= &insert_curve();
       $result .= &insert_data();    
       $result .= "</curve>\n";
       # close up the <plot>
       $result .= "</plot>\n";
       return $result;
   }
   
   sub insert_key {
       my $result;
       $result .= '    <key ';
       foreach my $attr (%key_defaults) {
    $result .= '         '.$attr.' "'.$key_defaults{$attr}->{'default'}.
       "\"\n";
       }
       $result .= "   />\n";
       return $result;
   }
   
   sub insert_axis{
       my $result;
       $result .= '    <axis ';
       foreach my $attr (%axis_defaults) {
    $result .= '         '.$attr.' "'.$axis_defaults{$attr}->{'default'}.
       "\"\n";
       }
       $result .= "   />\n";
       return $result;
   }
   
   sub insert_label {
       my $result;
       $result .= '    <label ';
       foreach my $attr (%label_defaults) {
    $result .= '         '.$attr.' "'.
       $label_defaults{$attr}->{'default'}."\"\n";
       }
       $result .= "   ></label>\n";
       return $result;
   }
   
   sub insert_curve {
       my $result;
       $result .= '    <curve ';
       foreach my $attr (%curve_defaults) {
    $result .= '         '.$attr.' "'.
       $curve_defaults{$attr}->{'default'}."\"\n";
       }
       $result .= "    >\n";
   }
   
   sub insert_function {
       my $result;
       $result .= "<function></function>\n";
       return $result;
   }
   
   sub insert_data {
       my $result;
       $result .= "     <data></data>\n";
       $result .= "     <data></data>\n";
       return $result;
   }
   
   1;
   __END__
   
   

Removed from v.1.19  
changed lines
  Added in v.1.20


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