File:  [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.25: download - view: text, annotated - select for diffs
Fri Dec 28 21:56:16 2001 UTC (22 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
More $target eq 'edit' changes.

    1: # The LearningOnline Network with CAPA
    2: # Dynamic plot
    3: #
    4: # $Id: lonplot.pm,v 1.25 2001/12/28 21:56:16 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: # 12/15/01 Matthew
   29: # 12/17 12/18 12/19 12/20 12/21 12/27 12/28 Matthew
   30: package Apache::lonplot;
   31: 
   32: use strict;
   33: use Apache::File;
   34: use Apache::response;
   35: use Apache::lonxml;
   36: use Apache::edit;
   37: 
   38: sub BEGIN {
   39:   &Apache::lonxml::register('Apache::lonplot',('plot'));
   40: }
   41: 
   42: ## 
   43: ## Description of data structures:
   44: ##
   45: ##  %plot       %key    %axis
   46: ## --------------------------
   47: ##  height      title   color
   48: ##  width       box     xmin
   49: ##  bgcolor     pos     xmax
   50: ##  fgcolor             ymin
   51: ##  transparent         ymax
   52: ##  grid
   53: ##  border
   54: ##  font
   55: ##  align
   56: ##
   57: ##  @labels: $labels[$i] = \%label
   58: ##           %label: text, xpos, ypos, justify
   59: ##
   60: ##  @curves: $curves[$i] = \%curve
   61: ##           %curve: name, linestyle, ( function | data )
   62: ##
   63: ##  $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
   64: ##                            [y1,y2,y3,y4] ]
   65: ##
   66: 
   67: ###################################################################
   68: ##                                                               ##
   69: ##        Tests used in checking the validitity of input         ##
   70: ##                                                               ##
   71: ###################################################################
   72: my $int_test       = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
   73: my $real_test      = 
   74:     sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
   75: my $color_test     = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
   76: my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
   77: my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
   78: my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
   79: my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
   80: my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w\(\)]+ ?)+$/};
   81: 
   82: ###################################################################
   83: ##                                                               ##
   84: ##                      Attribute metadata                       ##
   85: ##                                                               ##
   86: ###################################################################
   87: my %plot_defaults = 
   88:     (
   89:      height       => {
   90: 	 default     => 200,
   91: 	 test        => $int_test,
   92: 	 description => 'vertical size of image (pixels)',
   93: 	 edit_type   => 'entry' 
   94: 	 },
   95:      width        => {
   96: 	 default     => 200,
   97: 	 test        => $int_test,
   98: 	 description => 'horizontal size of image (pixels)',
   99: 	 edit_type   => 'entry'
  100: 	 },
  101:      bgcolor      => {
  102: 	 default     => 'xffffff',
  103: 	 test        => $color_test, 
  104: 	 description => 'background color of image (xffffff)',
  105: 	 edit_type   => 'entry'
  106: 	 },
  107:      fgcolor      => {
  108: 	 default     => 'x000000',
  109: 	 test        => $color_test,
  110: 	 description => 'foreground color of image (x000000)',
  111: 	 edit_type   => 'entry' 
  112: 	 },
  113:      transparent  => {
  114: 	 default     => 'off',
  115: 	 test        => $onoff_test, 
  116: 	 description => '',
  117: 	 edit_type   => 'on_off'
  118: 	 },
  119:      grid         => {
  120: 	 default     => 'off',
  121: 	 test        => $onoff_test, 
  122: 	 description => '',
  123: 	 edit_type   => 'on_off'
  124: 	 },
  125:      border       => {
  126: 	 default     => 'on',
  127: 	 test        => $onoff_test, 
  128: 	 description => '',
  129: 	 edit_type   => 'on_off'
  130: 	 },
  131:      font         => {
  132: 	 default     => 'medium',
  133: 	 test        => $sml_test,
  134: 	 description => 'Size of font to use',
  135: 	 edit_type   => 'choice',
  136: 	 choices     => ['small','medium','large']
  137: 	 },
  138:      align        => {
  139: 	 default     => 'left',
  140: 	 test        => sub {$_[0]=~/^(left|right|center)$/},
  141: 	 description => 'alignment for image in html',
  142: 	 edit_type   => 'choice',
  143: 	 choices     => ['left','right','center']
  144: 	 } 
  145:      );
  146: 
  147: my %key_defaults = 
  148:     (
  149:      title => { 
  150: 	 default => '',
  151: 	 test => $words_test,
  152: 	 description => 'Title of key',
  153: 	 edit_type   => 'entry'
  154: 	 },
  155:      box   => { 
  156: 	 default => 'off',
  157: 	 test => $onoff_test,
  158: 	 description => 'Draw a box around the key?',
  159: 	 edit_type   => 'on_off'
  160: 	 },
  161:      pos   => { 
  162: 	 default => 'top right', 
  163: 	 test => $key_pos_test, 
  164: 	 description => 'position of the key on the plot',
  165: 	 edit_type   => 'choice',
  166: 	 choices     => ['top left','top right','bottom left','bottom right',
  167: 			 'outside','below']
  168: 	 }
  169:      );
  170: 
  171: my %label_defaults = 
  172:     (
  173:      xpos    => {
  174: 	 default => 0,
  175: 	 test => $real_test,
  176: 	 description => 'x position of label (graph coordinates)',
  177: 	 edit_type   => 'entry'
  178: 	 },
  179:      ypos    => {
  180: 	 default => 0, 
  181: 	 test => $real_test,
  182: 	 description => 'y position of label (graph coordinates)',
  183: 	 edit_type   => 'entry'
  184: 	 },
  185:      justify => {
  186: 	 default => 'left',    
  187: 	 test => sub {$_[0]=~/^(left|right|center)$/},
  188: 	 description => 'justification of the label text on the plot',
  189: 	 edit_type   => 'choice',
  190: 	 choices     => ['left','right','center']
  191:      }
  192:      );
  193: 
  194: my %axis_defaults = 
  195:     (
  196:      color     => {
  197: 	 default => 'x000000', 
  198: 	 test => $color_test,
  199: 	 description => 'color of axes (x000000)',
  200: 	 edit_type   => 'entry'
  201: 	 },
  202:      xmin      => {
  203: 	 default => '-10.0',
  204: 	 test => $real_test,
  205: 	 description => 'minimum x-value shown in plot',
  206: 	 edit_type   => 'entry'
  207: 	 },
  208:      xmax      => {
  209: 	 default => ' 10.0',
  210: 	 test => $real_test,
  211: 	 description => 'maximum x-value shown in plot',	 
  212: 	 edit_type   => 'entry'
  213: 	 },
  214:      ymin      => {
  215: 	 default => '-10.0',
  216: 	 test => $real_test,
  217: 	 description => 'minimum y-value shown in plot',	 
  218: 	 edit_type   => 'entry'
  219: 	 },
  220:      ymax      => {
  221: 	 default => ' 10.0',
  222: 	 test => $real_test,
  223: 	 description => 'maximum y-value shown in plot',	 
  224: 	 edit_type   => 'entry'
  225: 	 },
  226:      linestyle => {
  227: 	 default => 'points',
  228: 	 test => $linestyle_test,
  229: 	 description => 'Style of the axis lines',
  230: 	 edit_type   => 'choice',
  231: 	 choices     => ['lines','linespoints','dots','points']
  232: 	 }
  233:      );
  234: 
  235: my %curve_defaults = 
  236:     (
  237:      color     => {
  238: 	 default => 'x000000',
  239: 	 test => $color_test,
  240: 	 description => 'color of curve (x000000)',
  241: 	 edit_type   => 'entry'
  242: 	 },
  243:      name      => {
  244: 	 default => '',
  245: 	 test => $words_test,
  246: 	 description => 'name of curve to appear in key',
  247: 	 edit_type   => 'entry'
  248: 	 },
  249:      linestyle => {
  250: 	 default => 'lines',
  251: 	 test => $linestyle_test,
  252: 	 description => 'Style of the axis lines',
  253: 	 edit_type   => 'choice',
  254: 	 choices     => ['lines','linespoints','dots','points','steps']
  255: 	 }
  256:      );
  257: 
  258: ###################################################################
  259: ##                                                               ##
  260: ##                    parsing and edit rendering                 ##
  261: ##                                                               ##
  262: ###################################################################
  263: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
  264: 
  265: sub start_plot {
  266:     %plot    = ();      %key     = ();      %axis   = (); 
  267:     $title   = undef;   $xlabel  = undef;   $ylabel = undef;
  268:     $#labels = -1;      $#curves = -1;
  269:     #
  270:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  271:     my $result='';
  272:     &Apache::lonxml::register('Apache::lonplot',
  273: 	     ('title','xlabel','ylabel','key','axis','label','curve'));
  274:     push (@Apache::lonxml::namespace,'plot');
  275:     my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
  276:     if ($target eq 'web') {
  277: 	$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
  278:     }
  279:     &Apache::lonxml::newparser($parser,\$inside);
  280:     if ($target eq 'web') {
  281: 	&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
  282: 			$tagstack->[-1]);
  283:     } elsif ($target eq 'edit') {
  284: 	$result .= &Apache::edit::tag_start($target,$token,'Plot');
  285: 	$result .= &edit_attributes($target,$token,\%plot_defaults);
  286:     } elsif ($target eq 'modified') {
  287: 	my $constructtag=&Apache::edit::get_new_args
  288: 	    ($token,$parstack,$safeeval,keys(%plot_defaults));
  289: 	if ($constructtag) {
  290: 	    $result = &Apache::edit::rebuild_tag($token);
  291: 	    $result.= &Apache::edit::handle_insert();
  292: 	}
  293:     }
  294:     return $result;
  295: }
  296: 
  297: sub end_plot {
  298:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  299: 
  300:     pop @Apache::lonxml::namespace;
  301:     &Apache::lonxml::deregister('Apache::lonplot',
  302: 	('title','xlabel','ylabel','key','axis','label','curve'));
  303:     my $result = '';
  304:     if ($target eq 'web') {
  305: 	&check_inputs(); # Make sure we have all the data we need
  306: 	##
  307: 	## Determine filename
  308: 	my $tmpdir = '/home/httpd/perl/tmp/';
  309: 	my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
  310: 	    '_'.time.'_'.$$.'_plot.data';
  311: 	## Write the plot description to the file
  312: 	my $fh=Apache::File->new(">$tmpdir$filename");
  313: 	print $fh &write_gnuplot_file();
  314: 	close($fh);
  315: 	## return image tag for the plot
  316: 	$result .= <<"ENDIMAGE";
  317: <img src    = "/cgi-bin/plot.gif?$filename" 
  318:      width  = "$plot{'width'}" 
  319:      height = "$plot{'height'}"
  320:      align  = "$plot{'align'}"
  321:      alt    = "/cgi-bin/plot.gif?$filename" />
  322: ENDIMAGE
  323:     } elsif ($target eq 'edit') {
  324: 	$result.=&Apache::edit::tag_end($target,$token);
  325:     }
  326:     return $result;
  327: }
  328: 
  329: ##----------------------------------------------------------------- key
  330: sub start_key {
  331:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  332:     my $result='';
  333:     if ($target eq 'web') {
  334: 	&get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
  335: 		    $tagstack->[-1]);
  336:     } elsif ($target eq 'edit') {
  337: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Key');
  338: 	$result .= &edit_attributes($target,$token,\%key_defaults);
  339:     } elsif ($target eq 'modified') {
  340: 	my $constructtag=&Apache::edit::get_new_args
  341: 	    ($token,$parstack,$safeeval,keys(%key_defaults));
  342: 	if ($constructtag) {
  343: 	    $result = &Apache::edit::rebuild_tag($token);
  344: 	    $result.= &Apache::edit::handle_insert();
  345: 	}
  346:     }
  347:     return $result;
  348: }
  349: 
  350: sub end_key {
  351:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  352:     my $result = '';
  353:     if ($target eq 'web') {
  354:     } elsif ($target eq 'edit') {
  355: 	$result.=&Apache::edit::tag_end($target,$token);
  356:     }
  357:     return $result;
  358: }
  359: 
  360: ##------------------------------------------------------------------- title
  361: sub start_title {
  362:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  363:     my $result='';
  364:     if ($target eq 'web') {
  365: 	$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
  366:     } elsif ($target eq 'edit') {
  367: 	$result.=&Apache::edit::tag_start($target,$token,'Plot Title');
  368: 	my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);
  369: 	$result.='</td></tr><tr><td colspan="3">'.
  370: 	    &Apache::edit::editfield('',$text,'',20,1).
  371: 	    &Apache::edit::end_table();
  372:     } elsif ($target eq 'modified') {
  373: 	my $text=$$parser[-1]->get_text("/function");
  374: 	$result.=&Apache::edit::modifiedfield($token);
  375:     }
  376:     return $result;
  377: }
  378: 
  379: sub end_title {
  380:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  381:     my $result = '';
  382:     if ($target eq 'web') {
  383:     } elsif ($target eq 'edit') {
  384:     }
  385:     return $result;
  386: }
  387: ##------------------------------------------------------------------- xlabel
  388: sub start_xlabel {
  389:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  390:     my $result='';
  391:     if ($target eq 'web') {
  392: 	$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
  393:     } elsif ($target eq 'edit') {
  394: 	$result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
  395: 	my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
  396: 	$result.='</td></tr><tr><td colspan="3">'.
  397: 	    &Apache::edit::editfield('',$text,'',20,1).
  398: 	    &Apache::edit::end_table();
  399:     } elsif ($target eq 'modified') {
  400: 	my $text=$$parser[-1]->get_text("/function");
  401: 	$result.=&Apache::edit::modifiedfield($token);
  402:     }
  403:     return $result;
  404: }
  405: 
  406: sub end_xlabel {
  407:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  408:     my $result = '';
  409:     if ($target eq 'web') {
  410:     } elsif ($target eq 'edit') {
  411:     }
  412:     return $result;
  413: }
  414: 
  415: ##------------------------------------------------------------------- ylabel
  416: sub start_ylabel {
  417:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  418:     my $result='';
  419:     if ($target eq 'web') {
  420: 	$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
  421:     } elsif ($target eq 'edit') {
  422: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
  423: 	my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
  424: 	$result .= '</td></tr><tr><td colspan="3">'.
  425: 	    &Apache::edit::editfield('',$text,'',20,1).
  426: 	    &Apache::edit::end_table();
  427:     } elsif ($target eq 'modified') {
  428: 	my $text=$$parser[-1]->get_text("/function");
  429: 	$result.=&Apache::edit::modifiedfield($token);
  430:     }
  431:     return $result;
  432: }
  433: 
  434: sub end_ylabel {
  435:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  436:     my $result = '';
  437:     if ($target eq 'web') {
  438:     } elsif ($target eq 'edit') {
  439:     }
  440:     return $result;
  441: }
  442: 
  443: ##------------------------------------------------------------------- label
  444: sub start_label {
  445:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  446:     my $result='';
  447:     if ($target eq 'web') {
  448: 	my %label;
  449: 	&get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
  450: 		    $tagstack->[-1]);
  451: 	$label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
  452: 	if (! &$words_test($label{'text'})) {
  453: 	    # I should probably warn about it, too.
  454: 	    $label{'text'} = 'Illegal text';
  455: 	}
  456: 	push(@labels,\%label);
  457:     } elsif ($target eq 'edit') {
  458: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Label');
  459: 	$result .= &edit_attributes($target,$token,\%label_defaults);
  460: 	my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
  461: 	$result .= '</td></tr><tr><td colspan="3">'.
  462: 	    &Apache::edit::editfield('',$text,'',20,1).
  463: 	    &Apache::edit::end_table();
  464:     } elsif ($target eq 'modified') {
  465: 	my $constructtag=&Apache::edit::get_new_args
  466: 	    ($token,$parstack,$safeeval,keys(%label_defaults));
  467: 	if ($constructtag) {
  468: 	    $result = &Apache::edit::rebuild_tag($token);
  469: 	    $result.= &Apache::edit::handle_insert();
  470: 	}
  471: 	my $text=$$parser[-1]->get_text("/label");
  472: 	$result.=&Apache::edit::modifiedfield($token);
  473:     }
  474:     return $result;
  475: }
  476: 
  477: sub end_label {
  478:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  479:     my $result = '';
  480:     if ($target eq 'web') {
  481:     } elsif ($target eq 'edit') {
  482: 	$result.=&Apache::edit::tag_end($target,$token);
  483:     }
  484:     return $result;
  485: }
  486: 
  487: ##------------------------------------------------------------------- curve
  488: sub start_curve {
  489:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  490:     my $result='';
  491:     &Apache::lonxml::register('Apache::lonplot',('function','data'));
  492:     push (@Apache::lonxml::namespace,'curve');
  493:     if ($target eq 'web') {
  494: 	my %curve;
  495: 	&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
  496: 		    $tagstack->[-1]);
  497: 	push (@curves,\%curve);
  498:     } elsif ($target eq 'edit') {
  499: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Curve');
  500: 	$result .= &edit_attributes($target,$token,\%curve_defaults);
  501:     } elsif ($target eq 'modified') {
  502: 	my $constructtag=&Apache::edit::get_new_args
  503: 	    ($token,$parstack,$safeeval,keys(%label_defaults));
  504: 	if ($constructtag) {
  505: 	    $result = &Apache::edit::rebuild_tag($token);
  506: 	    $result.= &Apache::edit::handle_insert();
  507: 	}
  508:     }
  509:     return $result;
  510: }
  511: 
  512: sub end_curve {
  513:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  514:     my $result = '';
  515:     pop @Apache::lonxml::namespace;
  516:     &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
  517:     if ($target eq 'web') {
  518:     } elsif ($target eq 'edit') {
  519: 	$result.=&Apache::edit::tag_end($target,$token);
  520:     }
  521:     return $result;
  522: }
  523: 
  524: ##------------------------------------------------------------ curve function
  525: sub start_function {
  526:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  527:     my $result='';
  528:     if ($target eq 'web') {
  529: 	if (exists($curves[-1]->{'data'})) {
  530: 	    &Apache::lonxml::warning('Use of <function> precludes use of <data>.  The <data> will be omitted in favor of the <function> declaration.');
  531: 	    delete $curves[-1]->{'data'} ;
  532: 	}
  533: 	$curves[-1]->{'function'} = 
  534: 	    &Apache::lonxml::get_all_text("/function",$$parser[-1]);
  535:     } elsif ($target eq 'edit') {
  536: 	$result .= &Apache::edit::tag_start($target,$token,'Curve Function');
  537: 	my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);
  538: 	$result .= '</td></tr><tr><td colspan="3">'.
  539: 	    &Apache::edit::editfield('',$text,'',20,1).
  540: 	    &Apache::edit::end_table();
  541: 
  542:     } elsif ($target eq 'modified') {
  543: 	# Why do I do this?
  544: 	my $text=$$parser[-1]->get_text("/function");
  545: 	$result.=&Apache::edit::modifiedfield($token);
  546:     }
  547:     return $result;
  548: }
  549: 
  550: sub end_function {
  551:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  552:     my $result = '';
  553:     if ($target eq 'web') {
  554:     } elsif ($target eq 'edit') {
  555:     }
  556:     return $result;
  557: }
  558: 
  559: ##------------------------------------------------------------ curve  data
  560: sub start_data {
  561:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  562:     my $result='';
  563:     if ($target eq 'web') {
  564: 	if (exists($curves[-1]->{'function'})) {
  565: 	    &Apache::lonxml::warning('Use of <data> precludes use of .'.
  566: 	    '<function>.  The <function> will be omitted in favor of '.
  567:             'the <data> declaration.');
  568: 	    delete($curves[-1]->{'function'});
  569: 	}
  570: 	my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
  571: 	$datatext =~ s/\s+/ /g;  
  572: 	# Need to do some error checking on the @data array - 
  573: 	# make sure it's all numbers and make sure each array 
  574: 	# is of the same length.
  575: 	my @data;
  576: 	if ($datatext =~ /,/) {
  577: 	    @data = split /,/,$datatext;
  578: 	} else { # Assume it's space seperated.
  579: 	    @data = split / /,$datatext;
  580: 	}
  581: 	for (my $i=0;$i<=$#data;$i++) {
  582: 	    # Check that it's non-empty
  583: 	    if (! defined($data[$i])) {
  584: 		&Apache::lonxml::warning(
  585: 		    'undefined <data> value.  Replacing with '.
  586: 		    ' pi/e = 1.15572734979092');
  587: 		$data[$i] = 1.15572734979092;
  588: 	    }
  589: 	    # Check that it's a number
  590: 	    if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) {
  591: 		&Apache::lonxml::warning(
  592: 		    'Bad <data> value of '.$data[$i].'  Replacing with '.
  593: 		    ' pi/e = 1.15572734979092');
  594: 		$data[$i] = 1.15572734979092;
  595: 	    }
  596: 	}
  597: 	push  @{$curves[-1]->{'data'}},\@data;
  598:     } elsif ($target eq 'edit') {
  599: 	$result .= &Apache::edit::tag_start($target,$token,'Curve Data');
  600: 	my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
  601: 	$result .= '</td></tr><tr><td colspan="3">'.
  602: 	    &Apache::edit::editfield('',$text,'',20,1).
  603: 	    &Apache::edit::end_table();
  604:     } elsif ($target eq 'modified') {
  605: 	my $text=$$parser[-1]->get_text("/data");
  606: 	$result.=&Apache::edit::modifiedfield($token);
  607:     }
  608:     return $result;
  609: }
  610: 
  611: sub end_data {
  612:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  613:     my $result = '';
  614:     if ($target eq 'web') {
  615:     } elsif ($target eq 'edit') {
  616:     }
  617:     return $result;
  618: }
  619: 
  620: ##------------------------------------------------------------------- axis
  621: sub start_axis {
  622:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  623:     my $result='';
  624:     if ($target eq 'web') {
  625: 	&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
  626: 			$tagstack->[-1]);
  627:     } elsif ($target eq 'edit') {
  628: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Axes');
  629: 	$result .= &edit_attributes($target,$token,\%axis_defaults);
  630:     } elsif ($target eq 'modified') {
  631:     }
  632:     return $result;
  633: }
  634: 
  635: sub end_axis {
  636:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  637:     my $result = '';
  638:     if ($target eq 'web') {
  639:     } elsif ($target eq 'edit') {
  640: 	$result.=&Apache::edit::tag_end($target,$token);
  641:     } elsif ($target eq 'modified') {
  642: 	my $constructtag=&Apache::edit::get_new_args
  643: 	    ($token,$parstack,$safeeval,keys(%axis_defaults));
  644: 	if ($constructtag) {
  645: 	    $result = &Apache::edit::rebuild_tag($token);
  646: 	    $result.= &Apache::edit::handle_insert();
  647: 	}
  648:     }
  649:     return $result;
  650: }
  651: 
  652: ###################################################################
  653: ##                                                               ##
  654: ##        Utility Functions                                      ##
  655: ##                                                               ##
  656: ###################################################################
  657: 
  658: ##----------------------------------------------------------- set_defaults
  659: sub set_defaults {
  660:     my ($var,$defaults) = @_;
  661:     my $key;
  662:     foreach $key (keys(%$defaults)) {
  663: 	$var->{$key} = $defaults->{$key}->{'default'};
  664:     }
  665: }
  666: 
  667: ##------------------------------------------------------------------- misc
  668: sub get_attributes{
  669:     my ($values,$defaults,$parstack,$safeeval,$tag) = @_;
  670:     foreach my $attr (keys(%{$defaults})) {
  671: 	$values->{$attr} = 
  672: 	    &Apache::lonxml::get_param($attr,$parstack,$safeeval);
  673: 	if ($values->{$attr} eq '' | !defined($values->{$attr})) {
  674: 	    $values->{$attr} = $defaults->{$attr}->{'default'};
  675: 	    next;
  676: 	}
  677: 	my $test = $defaults->{$attr}->{'test'};
  678: 	if (! &$test($values->{$attr})) {
  679: 	    &Apache::lonxml::warning
  680: 		($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
  681: 		 .$defaults->{$attr}->{'default'} );
  682: 	    $values->{$attr} = $defaults->{$attr}->{'default'};
  683: 	}
  684:     }
  685:     return ;
  686: }
  687: ##------------------------------------------------------- write_gnuplot_file
  688: sub write_gnuplot_file {
  689:     my $gnuplot_input = '';
  690:     my $curve;
  691:     # Collect all the colors
  692:     my @Colors;
  693:     push @Colors, $plot{'bgcolor'};
  694:     push @Colors, $plot{'fgcolor'}; 
  695:     push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
  696:     foreach $curve (@curves) {
  697: 	push @Colors, ($curve->{'color'} ne '' ? 
  698: 		       $curve->{'color'}       : 
  699: 		       $plot{'fgcolor'}        );
  700:     }
  701:     # set term
  702:     $gnuplot_input .= 'set term gif ';
  703:     $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on');
  704:     $gnuplot_input .= $plot{'font'} . ' ';
  705:     $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';
  706:     $gnuplot_input .= "@Colors\n";
  707:     # grid
  708:     $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');
  709:     # border
  710:     $gnuplot_input .= ($plot{'border'} eq 'on'?
  711: 		       'set border'.$/           :
  712: 		       'set noborder'.$/         );    # title, xlabel, ylabel
  713:     $gnuplot_input .= "set output\n";
  714:     $gnuplot_input .= "set title  \"$title\"\n"  if (defined($title)) ;
  715:     $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));
  716:     $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));
  717:     if (%axis) {
  718: 	$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
  719: 	$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
  720:     }
  721:     # Key
  722:     if (%key) {
  723: 	$gnuplot_input .= 'set key '.$key{'pos'}.' ';
  724: 	if ($key{'title'} ne '') {
  725: 	    $gnuplot_input .= 'title "'.$key{'title'}.'" ';
  726: 	} 
  727: 	$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/;
  728:     } else {
  729: 	$gnuplot_input .= 'set nokey'.$/;
  730:     }
  731:     # labels
  732:     my $label;
  733:     foreach $label (@labels) {
  734: 	$gnuplot_input .= 'set label "'.$label->{'text'}.'" at '.
  735: 	    $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ;
  736:     }
  737:     # curves
  738:     $gnuplot_input .= 'plot ';
  739:     my $datatext = '';
  740:     for (my $i = 0;$i<=$#curves;$i++) {
  741: 	$curve = $curves[$i];
  742: 	$gnuplot_input.= ', ' if ($i > 0);
  743: 	if (exists($curve->{'function'})) {
  744: 	    $gnuplot_input.= 
  745: 		$curve->{'function'}.' title "'.
  746: 		$curve->{'name'}.'" with '.
  747: 		$curve->{'linestyle'};
  748: 	} elsif (exists($curve->{'data'})) {
  749: 	    $gnuplot_input.= '\'-\' title "'.
  750: 		$curve->{'name'}.'" with '.
  751: 		$curve->{'linestyle'};
  752: 	    my @Data = @{$curve->{'data'}};
  753: 	    my @Data0 = @{$Data[0]};
  754: 	    for (my $i =0; $i<=$#Data0; $i++) {
  755: 		my $dataset;
  756: 		foreach $dataset (@Data) {
  757: 		    $datatext .= $dataset->[$i] . ' ';
  758: 		}
  759: 		$datatext .= $/;
  760: 	    }
  761: 	    $datatext .=$/;
  762: 	}
  763:     }
  764:     $gnuplot_input .= $/.$datatext;
  765:     return $gnuplot_input;
  766: }
  767: 
  768: #---------------------------------------------- check_inputs
  769: sub check_inputs {
  770:     ## Note: no inputs, no outputs - this acts only on global variables.
  771:     ## Make sure we have all the input we need:
  772:     if (! %plot) { &set_defaults(\%plot,\%plot_defaults); }
  773:     if (! %key ) {} # No key for this plot, thats okay
  774:     if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
  775:     if (! defined($title )) {} # No title for this plot, thats okay
  776:     if (! defined($xlabel)) {} # No xlabel for this plot, thats okay
  777:     if (! defined($ylabel)) {} # No ylabel for this plot, thats okay
  778:     if ($#labels < 0) { }      # No labels for this plot, thats okay
  779:     if ($#curves < 0) { 
  780: 	&Apache::lonxml::warning("No curves specified for plot!!!!");
  781: 	return '';
  782:     }
  783:     my $curve;
  784:     foreach $curve (@curves) {
  785: 	if (!defined($curve->{'function'})&&!defined($curve->{'data'})){
  786: 	    &Apache::lonxml::warning("One of the curves specified did not contain any <data> or <function> declarations\n");
  787: 	    return '';
  788: 	}
  789:     }
  790: }
  791: 
  792: #------------------------------------------------ make_edit
  793: sub edit_attributes {
  794:     my ($target,$token,$defaults) = @_;
  795:     my $result;
  796:     foreach my $attr (sort keys(%$defaults)) {
  797: 	if ($defaults->{$attr}->{'edit_type'} eq 'entry') {
  798: 	    $result .= &Apache::edit::text_arg(
  799:                  $defaults->{$attr}->{'description'},
  800: 		 $attr,
  801: 		 $token);
  802: 	} elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {
  803: 	    $result .= &Apache::edit::select_arg(
  804: 		 $defaults->{$attr}->{'description'},
  805: 		 $attr,
  806: 		 $defaults->{$attr}->{'choices'},
  807: 		 $token);
  808: 	}
  809: 	$result .= '<br />';
  810:     }
  811:     return $result;
  812: }
  813: 
  814: 
  815: ###################################################################
  816: ##                                                               ##
  817: ##           Insertion functions for editing plots               ##
  818: ##                                                               ##
  819: ###################################################################
  820: 
  821: #------------------------------------------------ insert_xxxxxxx
  822: sub insert_plot {
  823:     my $result;
  824:     #  plot attributes
  825:     $result .= '<plot ';
  826:     foreach my $attr (%plot_defaults) {
  827: 	$result .= '     '.$attr.' "'.$plot_defaults{$attr}->{'default'}.
  828: 	    "\"\n";
  829:     }
  830:     $result .= ">\n";
  831:     # Add the components
  832:     $result .= &insert_key();
  833:     $result .= &insert_axis();
  834:     $result .= &insert_label();    
  835:     $result .= &insert_curve();
  836:     $result .= &insert_function();    
  837:     $result .= "</curve>\n";
  838:     $result .= &insert_curve();
  839:     $result .= &insert_data();    
  840:     $result .= "</curve>\n";
  841:     # close up the <plot>
  842:     $result .= "</plot>\n";
  843:     return $result;
  844: }
  845: 
  846: sub insert_key {
  847:     my $result;
  848:     $result .= '    <key ';
  849:     foreach my $attr (%key_defaults) {
  850: 	$result .= '         '.$attr.' "'.$key_defaults{$attr}->{'default'}.
  851: 	    "\"\n";
  852:     }
  853:     $result .= "   />\n";
  854:     return $result;
  855: }
  856: 
  857: sub insert_axis{
  858:     my $result;
  859:     $result .= '    <axis ';
  860:     foreach my $attr (%axis_defaults) {
  861: 	$result .= '         '.$attr.' "'.$axis_defaults{$attr}->{'default'}.
  862: 	    "\"\n";
  863:     }
  864:     $result .= "   />\n";
  865:     return $result;
  866: }
  867: 
  868: sub insert_label {
  869:     my $result;
  870:     $result .= '    <label ';
  871:     foreach my $attr (%label_defaults) {
  872: 	$result .= '         '.$attr.' "'.
  873: 	    $label_defaults{$attr}->{'default'}."\"\n";
  874:     }
  875:     $result .= "   ></label>\n";
  876:     return $result;
  877: }
  878: 
  879: sub insert_curve {
  880:     my $result;
  881:     $result .= '    <curve ';
  882:     foreach my $attr (%curve_defaults) {
  883: 	$result .= '         '.$attr.' "'.
  884: 	    $curve_defaults{$attr}->{'default'}."\"\n";
  885:     }
  886:     $result .= "    >\n";
  887: }
  888: 
  889: sub insert_function {
  890:     my $result;
  891:     $result .= "<function></function>\n";
  892:     return $result;
  893: }
  894: 
  895: sub insert_data {
  896:     my $result;
  897:     $result .= "     <data></data>\n";
  898:     $result .= "     <data></data>\n";
  899:     return $result;
  900: }
  901: 
  902: ##----------------------------------------------------------------------
  903: 1;
  904: __END__
  905: 
  906: 

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