File:  [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.41: download - view: text, annotated - select for diffs
Mon Jan 21 15:20:28 2002 UTC (22 years, 4 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
minor changes on insertering and insert lists.

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

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