File:  [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.1: download - view: text, annotated - select for diffs
Mon Dec 17 21:43:12 2001 UTC (22 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Routine to parse <plot> tag.

    1: # The LearningOnline Network with CAPA
    2: # Dynamic plot
    3: #
    4: # $Id: lonplot.pm,v 1.1 2001/12/17 21:43:12 matthew Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # 2/21 Guy
   29: package Apache::lonplot;
   30: use strict;
   31: use Apache::response;
   32: 
   33: sub BEGIN {
   34:   &Apache::lonxml::register('Apache::lonplot',('plot'));
   35: }
   36: 
   37: 
   38: ##
   39: ## Tests used in checking the validitity of input
   40: ##
   41: my $int_test       = sub {$_[0]=~/^\d+$/};
   42: my $real_test      = sub {$_[0]=~/^[+-]?\d*\.?\d*$/};
   43: my $color_test     = sub {$_[0]=~/^x[\da-f]{6}$/};
   44: my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
   45: my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
   46: my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
   47: my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
   48: 
   49: ##
   50: ## Default values for attributes of elements
   51: ##
   52: my %plot_defaults = 
   53:     (
   54:      height       => {default => 200,       test => $int_test  },
   55:      width        => {default => 200,       test => $int_test  },
   56:      bgcolor      => {default => "xffffff", test => $color_test},
   57:      fgcolor      => {default => "x000000", test => $color_test},
   58:      transparent  => {default => "off",     test => $onoff_test},
   59:      grid         => {default => "off",     test => $onoff_test},
   60:      border       => {default => "on" ,     test => $onoff_test},
   61:      font         => {default => "medium",  test => $sml_test  }
   62:      );
   63: 
   64: my %key_defaults = 
   65:     (
   66:      title => { default => "on" ,        test => $onoff_test  },
   67:      box   => { default => "off" ,       test => $onoff_test  },
   68:      pos   => { default => "top right" , test => $key_pos_test}
   69:      );
   70: 
   71: my %label_defaults = 
   72:     (
   73:      xpos    => {default => 0,         test => $real_test                   },
   74:      ypos    => {default => 0,         test => $real_test                   },
   75:      color   => {default => "x000000", test => $color_test                  },
   76:      justify => {default => "left",    
   77:                  test => sub {$_[0]=~/^(left|right|center)$/}}
   78:      );
   79: 
   80: my %axis_defaults = 
   81:     (
   82:      color     => {default => "x000000", test => $color_test},
   83:      thickness => {default => 1,         test => $int_test  },
   84:      xmin      => {default => -10.0,     test => $real_test },
   85:      xmax      => {default =>  10.0,     test => $real_test },
   86:      ymin      => {default => -10.0,     test => $real_test },
   87:      ymax      => {default =>  10.0,     test => $real_test }
   88:      );
   89: 
   90: my %curve_defaults = 
   91:     (
   92:      color     => {default => "x000000", test => $color_test      },
   93:      name      => {default => "x000000", test => sub {$_[0]=~/^[\w ]*$/} },
   94:      linestyle => {default => "lines",   test => $linestyle_test  }
   95:      );
   96: 
   97: ##
   98: ## End of defaults
   99: ##
  100: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
  101: 
  102: sub start_plot {
  103:     %plot = '';   %key='';    %axis=''; 
  104:     $title='';    $xlabel=''; $ylabel='';
  105:     @labels = ''; @curves='';
  106:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  107:     my $result='';
  108:     #
  109:     &Apache::lonxml::register('Apache::plot',
  110: 	     ('title','xlabel','ylabel','key','axis','label','curve'));
  111:     push (@Apache::lonxml::namespace,'plot');
  112:     &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval);
  113:     return '';
  114: }
  115: 
  116: sub get_attributes{
  117:     %values   = %{$_[0]};
  118:     %defaults = %{$_[1]};
  119:     $parstack = $_[2];
  120:     $safeeval = $_[3];
  121:     my $attr;
  122:     foreach $attr (keys %defaults) {
  123: 	$values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
  124: 	my $test = $defaults{$attr}->{'test'};
  125: 	$values{$attr} = (&$test($values{$attr}) ?
  126: 			  $values{$attr}         :
  127: 			  $defaults{$attr}      );
  128:     }
  129:     return ;
  130: }
  131: 
  132: sub end_plot {
  133:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  134:     pop @Apache::lonxml::namespace;
  135:     my $result;
  136:     ## Determine filename
  137:     my $filename = 
  138:     ## Write the plot description to the file
  139:     ## return image tag for the plot
  140:     return $result;
  141: }
  142: ##----------------------------------------------------------------- key
  143: sub start_key {
  144:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  145:     my $result='';
  146:     &get_attributes(\%key,\%key_defaults,$parstack,$safeeval);
  147:     return $result;
  148: }
  149: 
  150: sub end_key {
  151:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  152:     my $result = '';
  153:     return $result;
  154: }
  155: ##------------------------------------------------------------------- title
  156: sub start_title {
  157:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  158:     $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
  159:     my $result='';
  160:     return $result;
  161: }
  162: 
  163: sub end_title {
  164:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  165:     my $result = '';
  166:     return $result;
  167: }
  168: ##------------------------------------------------------------------- xlabel
  169: sub start_xlabel {
  170:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  171:     my $result='';
  172:     $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
  173:     return $result;
  174: }
  175: 
  176: sub end_xlabel {
  177:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  178:     my $result = '';
  179:     return $result;
  180: }
  181: ##------------------------------------------------------------------- ylabel
  182: sub start_ylabel {
  183:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  184:     my $result='';
  185:     $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
  186:     return $result;
  187: }
  188: 
  189: sub end_ylabel {
  190:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  191:     my $result = '';
  192:     return $result;
  193: }
  194: ##------------------------------------------------------------------- label
  195: sub start_label {
  196:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  197:     my $result='';
  198:     my $label = &newhashref();
  199:     &get_attributes($label,\%label_defaults,$parstack,$safeeval);
  200:     $label->{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
  201:     push(@labels,$label);
  202:     return $result;
  203: }
  204: 
  205: sub end_label {
  206:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  207:     my $result = '';
  208:     return $result;
  209: }
  210: 
  211: ##------------------------------------------------------------------- curve
  212: sub start_curve {
  213:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  214:     my $result='';
  215:     my $curve = &newhashref();
  216:     &get_attributes($curve,\%curve_defaults,$parstack,$safeeval);
  217:     push (@curves,$curve);
  218:     
  219:     &Apache::lonxml::register('Apache::plot',('function','data'));
  220:     push (@Apache::lonxml::namespace,'curve');
  221:     
  222:     return $result;
  223: }
  224: 
  225: sub end_curve {
  226:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  227:     my $result = '';
  228:     return $result;
  229: }
  230: 
  231: ##------------------------------------------------------------ curve function
  232: sub start_function {
  233:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  234:     my $result='';
  235: 
  236:     $curves[-1]->{'function'} = 
  237: 	&Apache::lonxml::get_all_text("/function",$$parser[-1]);
  238:     return $result;
  239: }
  240: 
  241: sub end_function {
  242:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  243:     my $result = '';
  244:     return $result;
  245: }
  246: 
  247: ##------------------------------------------------------------ curve  data
  248: sub start_data {
  249:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  250:     my $result='';
  251:     push( @{$curves[-1]->{'data'}},
  252: 	  &Apache::lonxml::get_all_text("/data",$$parser[-1]));
  253:     return $result;
  254: }
  255: 
  256: sub end_data {
  257:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  258:     my $result = '';
  259:     return $result;
  260: }
  261: 
  262: ##------------------------------------------------------------------- axis
  263: sub start_axis {
  264:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  265:     my $result='';
  266:     &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval);
  267:     return $result;
  268: }
  269: 
  270: sub end_axis {
  271:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  272:     my $result = '';
  273:     return $result;
  274: }
  275: 
  276: ##------------------------------------------------------------------- misc
  277: sub newhashref{
  278:     my %hash;
  279:     return \%hash;
  280: }
  281: 
  282: 
  283: 1;
  284: __END__

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