File:  [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.106: download - view: text, annotated - select for diffs
Thu Apr 7 06:56:27 2005 UTC (19 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: version_1_99_0_tmcc, HEAD
- ENV -> env

    1: # The LearningOnline Network with CAPA
    2: # Dynamic plot
    3: #
    4: # $Id: lonplot.pm,v 1.106 2005/04/07 06:56:27 albertel 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: 
   29: package Apache::lonplot;
   30: 
   31: use strict;
   32: use warnings FATAL=>'all';
   33: no warnings 'uninitialized';
   34: use Apache::File;
   35: use Apache::response;
   36: use Apache::lonxml;
   37: use Apache::edit;
   38: use Apache::lonnet;
   39: 
   40: use vars qw/$weboutputformat $versionstring/;
   41: 
   42: BEGIN {
   43:     &Apache::lonxml::register('Apache::lonplot',('gnuplot'));
   44:     #
   45:     # Determine the version of GNUPLOT
   46:     $weboutputformat = 'gif';
   47:     $versionstring = `gnuplot --version 2>/dev/null`;
   48:     if ($versionstring =~ /^gnuplot 4/) {
   49:         $weboutputformat = 'png';
   50:     }
   51: }
   52: 
   53: ## 
   54: ## Description of data structures:
   55: ##
   56: ##  %plot       %key    %axis
   57: ## --------------------------
   58: ##  height      title   color
   59: ##  width       box     xmin
   60: ##  bgcolor     pos     xmax
   61: ##  fgcolor             ymin
   62: ##  transparent         ymax
   63: ##  grid
   64: ##  border
   65: ##  font
   66: ##  align
   67: ##
   68: ##  @labels: $labels[$i] = \%label
   69: ##           %label: text, xpos, ypos, justify
   70: ##
   71: ##  @curves: $curves[$i] = \%curve
   72: ##           %curve: name, linestyle, ( function | data )
   73: ##
   74: ##  $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
   75: ##                            [y1,y2,y3,y4] ]
   76: ##
   77: 
   78: ###################################################################
   79: ##                                                               ##
   80: ##        Tests used in checking the validitity of input         ##
   81: ##                                                               ##
   82: ###################################################################
   83: 
   84: my $max_str_len = 50;    # if a label, title, xlabel, or ylabel text
   85:                          # is longer than this, it will be truncated.
   86: 
   87: my %linestyles = 
   88:     (
   89:      lines          => 2,     # Maybe this will be used in the future
   90:      linespoints    => 2,     # to check on whether or not they have 
   91:      dots	    => 2,     # supplied enough <data></data> fields
   92:      points         => 2,     # to use the given line style.  But for
   93:      steps	    => 2,     # now there are more important things 
   94:      fsteps	    => 2,     # for me to deal with.
   95:      histeps        => 2,
   96:      errorbars	    => 3,
   97:      xerrorbars	    => [3,4],
   98:      yerrorbars	    => [3,4],
   99:      xyerrorbars    => [4,6],
  100:      boxes          => 3,
  101:      vector	    => 4
  102:     );		    
  103: 
  104: my $int_test       = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
  105: my $real_test      = 
  106:     sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
  107: my $pos_real_test  =
  108:     sub {$_[0]=~s/\s+//g;$_[0]=~/^[+]?\d*\.?\d*([eE][+-]\d+)?$/};
  109: my $color_test     = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-fA-F]{6}$/};
  110: my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
  111: my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
  112: my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
  113: my $linestyle_test = sub {exists($linestyles{$_[0]})};
  114: my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/};
  115: 
  116: ###################################################################
  117: ##                                                               ##
  118: ##                      Attribute metadata                       ##
  119: ##                                                               ##
  120: ###################################################################
  121: my @gnuplot_edit_order = 
  122:     qw/alttag bgcolor fgcolor height width font transparent grid samples 
  123:     border align texwidth texfont plotcolor plottype lmargin rmargin tmargin
  124:     bmargin major_ticscale minor_ticscale/;
  125: 
  126: my $margin_choices = ['default',0..20];
  127: 
  128: my %gnuplot_defaults = 
  129:     (
  130:      alttag       => {
  131: 	 default     => 'dynamically generated plot',
  132: 	 test        => $words_test,
  133: 	 description => 'brief description of the plot',
  134:       	 edit_type   => 'entry',
  135: 	 size        => '40'
  136: 	 },
  137:      height       => {
  138: 	 default     => 300,
  139: 	 test        => $int_test,
  140: 	 description => 'height of image (pixels)',
  141:       	 edit_type   => 'entry',
  142: 	 size        => '10'
  143: 	 },
  144:      width        => {
  145: 	 default     => 400,
  146: 	 test        => $int_test,
  147: 	 description => 'width of image (pixels)',
  148: 	 edit_type   => 'entry',
  149: 	 size        => '10'
  150: 	 },
  151:      bgcolor      => {
  152: 	 default     => 'xffffff',
  153: 	 test        => $color_test, 
  154: 	 description => 'background color of image (xffffff)',
  155: 	 edit_type   => 'entry',
  156: 	 size        => '10'
  157: 	 },
  158:      fgcolor      => {
  159: 	 default     => 'x000000',
  160: 	 test        => $color_test,
  161: 	 description => 'foreground color of image (x000000)',
  162: 	 edit_type   => 'entry',
  163: 	 size        => '10'
  164: 	 },
  165:      transparent  => {
  166: 	 default     => 'off',
  167: 	 test        => $onoff_test, 
  168: 	 description => 'Transparent image',
  169: 	 edit_type   => 'onoff'
  170: 	 },
  171:      grid         => {
  172: 	 default     => 'on',
  173: 	 test        => $onoff_test, 
  174: 	 description => 'Display grid',
  175: 	 edit_type   => 'onoff'
  176: 	 },
  177:      border       => {
  178: 	 default     => 'on',
  179: 	 test        => $onoff_test, 
  180: 	 description => 'Draw border around plot',
  181: 	 edit_type   => 'onoff'
  182: 	 },
  183:      font         => {
  184: 	 default     => 'medium',
  185: 	 test        => $sml_test,
  186: 	 description => 'Size of font to use',
  187: 	 edit_type   => 'choice',
  188: 	 choices     => ['small','medium','large']
  189: 	 },
  190:      samples         => {
  191: 	 default     => '100',
  192: 	 test        => $int_test,
  193: 	 description => 'Number of samples for non-data plots',
  194: 	 edit_type   => 'choice',
  195: 	 choices     => ['100','200','500','1000','2000','5000']
  196: 	 },
  197:      align        => {
  198: 	 default     => 'center',
  199: 	 test        => sub {$_[0]=~/^(left|right|center)$/},
  200: 	 description => 'alignment for image in html',
  201: 	 edit_type   => 'choice',
  202: 	 choices     => ['left','right','center']
  203: 	 },
  204:      texwidth     => {
  205:          default     => '93',
  206:          test        => $int_test,
  207:          description => 'Width of plot when printed (mm)',
  208:          edit_type   => 'entry',
  209:          size        => '5'
  210:          },
  211:      texfont     => {
  212:          default     => '22',
  213:          test        => $int_test,
  214:          description => 'Font size to use in TeX output (pts):',
  215:          edit_type   => 'choice',
  216:          choices     => [qw/8 10 12 14 16 18 20 22 24 26 28 30 32 34 36/],
  217:          },
  218:      plotcolor   => {
  219:          default     => 'monochrome',
  220:          test        => sub {$_[0]=~/^(monochrome|color|colour)$/},
  221:          description => 'Color setting for printing:',
  222:          edit_type   => 'choice',
  223:          choices     => [qw/monochrome color colour/],
  224:          },
  225:      plottype  => {
  226: 	 default     => 'Cartesian',
  227: 	 test        => sub {$_[0]=~/^(Polar|Cartesian)$/},
  228: 	 description => 'Plot type:',
  229: 	 edit_type   => 'choice',
  230:          choices     => ['Cartesian','Polar']
  231:          },
  232:      lmargin   => {
  233: 	 default     => 'default',
  234: 	 test        => sub {$_[0]=~/^(default|\d+)$/},
  235: 	 description => 'Left margin width (pts):',
  236: 	 edit_type   => 'choice',
  237:          choices     => $margin_choices,
  238:          },
  239:      rmargin   => {
  240: 	 default     => 'default',
  241: 	 test        => sub {$_[0]=~/^(default|\d+)$/},
  242: 	 description => 'Right margin width (pts):',
  243: 	 edit_type   => 'choice',
  244:          choices     => $margin_choices,
  245:          },
  246:      tmargin   => {
  247: 	 default     => 'default',
  248: 	 test        => sub {$_[0]=~/^(default|\d+)$/},
  249: 	 description => 'Top margin width (pts):',
  250: 	 edit_type   => 'choice',
  251:          choices     => $margin_choices,
  252:          },
  253:      bmargin   => {
  254: 	 default     => 'default',
  255: 	 test        => sub {$_[0]=~/^(default|\d+)$/},
  256: 	 description => 'Bottom margin width (pts):',
  257: 	 edit_type   => 'choice',
  258:          choices     => $margin_choices,
  259:          },
  260:      major_ticscale  => {
  261:          default     => '1',
  262:          test        => $real_test,
  263:          description => 'Size of major tic marks (plot coordinates)',
  264:          edit_type   => 'entry',
  265:          size        => '5'
  266:          },
  267:      minor_ticscale  => {
  268:          default     => '0.5',
  269:          test        => $real_test,
  270:          description => 'Size of minor tic mark (plot coordinates)',
  271:          edit_type   => 'entry',
  272:          size        => '5'
  273:          },
  274:      );
  275: 
  276: my %key_defaults = 
  277:     (
  278:      title => { 
  279: 	 default => '',
  280: 	 test => $words_test,
  281: 	 description => 'Title of key',
  282: 	 edit_type   => 'entry',
  283: 	 size        => '40'
  284: 	 },
  285:      box   => { 
  286: 	 default => 'off',
  287: 	 test => $onoff_test,
  288: 	 description => 'Draw a box around the key?',
  289: 	 edit_type   => 'onoff'
  290: 	 },
  291:      pos   => { 
  292: 	 default => 'top right', 
  293: 	 test => $key_pos_test, 
  294: 	 description => 'position of the key on the plot',
  295: 	 edit_type   => 'choice',
  296: 	 choices     => ['top left','top right','bottom left','bottom right',
  297: 			 'outside','below']
  298: 	 }
  299:      );
  300: 
  301: my %label_defaults = 
  302:     (
  303:      xpos    => {
  304: 	 default => 0,
  305: 	 test => $real_test,
  306: 	 description => 'x position of label (graph coordinates)',
  307: 	 edit_type   => 'entry',
  308: 	 size        => '10'
  309: 	 },
  310:      ypos    => {
  311: 	 default => 0, 
  312: 	 test => $real_test,
  313: 	 description => 'y position of label (graph coordinates)',
  314: 	 edit_type   => 'entry',
  315: 	 size        => '10'
  316: 	 },
  317:      justify => {
  318: 	 default => 'left',    
  319: 	 test => sub {$_[0]=~/^(left|right|center)$/},
  320: 	 description => 'justification of the label text on the plot',
  321: 	 edit_type   => 'choice',
  322: 	 choices     => ['left','right','center']
  323:      }
  324:      );
  325: 
  326: my @tic_edit_order = ('location','mirror','start','increment','end',
  327:                       'minorfreq');
  328: my %tic_defaults =
  329:     (
  330:      location => {
  331: 	 default => 'border', 
  332: 	 test => sub {$_[0]=~/^(border|axis)$/},
  333: 	 description => 'Location of major tic marks',
  334: 	 edit_type   => 'choice',
  335: 	 choices     => ['border','axis']
  336: 	 },
  337:      mirror => {
  338: 	 default => 'on', 
  339: 	 test => $onoff_test,
  340: 	 description => 'mirror tics on opposite axis?',
  341: 	 edit_type   => 'onoff'
  342: 	 },
  343:      start => {
  344: 	 default => '-10.0',
  345: 	 test => $real_test,
  346: 	 description => 'Start major tics at',
  347: 	 edit_type   => 'entry',
  348: 	 size        => '10'
  349: 	 },
  350:      increment => {
  351: 	 default => '1.0',
  352: 	 test => $real_test,
  353: 	 description => 'Place a major tic every',
  354: 	 edit_type   => 'entry',
  355: 	 size        => '10'
  356: 	 },
  357:      end => {
  358: 	 default => ' 10.0',
  359: 	 test => $real_test,
  360: 	 description => 'Stop major tics at ',
  361: 	 edit_type   => 'entry',
  362: 	 size        => '10'
  363: 	 },
  364:      minorfreq => {
  365: 	 default => '0',
  366: 	 test => $int_test,
  367: 	 description => 'Number of minor tics per major tic mark',
  368: 	 edit_type   => 'entry',
  369: 	 size        => '10'
  370: 	 },         
  371:      );
  372: 
  373: my @axis_edit_order = ('color','xmin','xmax','ymin','ymax');
  374: my %axis_defaults = 
  375:     (
  376:      color   => {
  377: 	 default => 'x000000', 
  378: 	 test => $color_test,
  379: 	 description => 'color of grid lines (x000000)',
  380: 	 edit_type   => 'entry',
  381: 	 size        => '10'
  382: 	 },
  383:      xmin      => {
  384: 	 default => '-10.0',
  385: 	 test => $real_test,
  386: 	 description => 'minimum x-value shown in plot',
  387: 	 edit_type   => 'entry',
  388: 	 size        => '10'
  389: 	 },
  390:      xmax      => {
  391: 	 default => ' 10.0',
  392: 	 test => $real_test,
  393: 	 description => 'maximum x-value shown in plot',	 
  394: 	 edit_type   => 'entry',
  395: 	 size        => '10'
  396: 	 },
  397:      ymin      => {
  398: 	 default => '-10.0',
  399: 	 test => $real_test,
  400: 	 description => 'minimum y-value shown in plot',	 
  401: 	 edit_type   => 'entry',
  402: 	 size        => '10'
  403: 	 },
  404:      ymax      => {
  405: 	 default => ' 10.0',
  406: 	 test => $real_test,
  407: 	 description => 'maximum y-value shown in plot',	 
  408: 	 edit_type   => 'entry',
  409: 	 size        => '10'
  410: 	 }
  411:      );
  412: 
  413: my @curve_edit_order = ('color','name','linestyle','pointtype','pointsize');
  414: 
  415: my %curve_defaults = 
  416:     (
  417:      color     => {
  418: 	 default => 'x000000',
  419: 	 test => $color_test,
  420: 	 description => 'color of curve (x000000)',
  421: 	 edit_type   => 'entry',
  422: 	 size        => '10'
  423: 	 },
  424:      name      => {
  425: 	 default => '',
  426: 	 test => $words_test,
  427: 	 description => 'name of curve to appear in key',
  428: 	 edit_type   => 'entry',
  429: 	 size        => '20'
  430: 	 },
  431:      linestyle => {
  432: 	 default => 'lines',
  433: 	 test => $linestyle_test,
  434: 	 description => 'Line style',
  435: 	 edit_type   => 'choice',
  436: 	 choices     => [keys(%linestyles)]
  437: 	 },
  438: # gnuplots term=gif driver does not handle linewidth :(
  439: #     linewidth => {
  440: #         default     => 1,
  441: #         test        => $int_test,
  442: #         description => 'Line width (may not apply to all line styles)',
  443: #         edit_type   => 'choice',
  444: #         choices     => [1,2,3,4,5,6,7,8,9,10]
  445: #         },
  446:      pointsize => {
  447:          default     => 1,
  448:          test        => $pos_real_test,
  449:          description => 'point size (may not apply to all line styles)',
  450:          edit_type   => 'entry',
  451:          size        => '5'
  452:          },
  453:      pointtype => {
  454:          default     => 1,
  455:          test        => $int_test,
  456:          description => 'point type (may not apply to all line styles)',
  457:          edit_type   => 'choice',
  458:          choices     => [0,1,2,3,4,5,6]
  459:          }
  460:      );
  461: 
  462: ###################################################################
  463: ##                                                               ##
  464: ##                    parsing and edit rendering                 ##
  465: ##                                                               ##
  466: ###################################################################
  467: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics);
  468: 
  469: sub start_gnuplot {
  470:     undef(%plot);   undef(%key);    undef(%axis);
  471:     undef($title);  undef($xlabel); undef($ylabel);
  472:     undef(@labels); undef(@curves);
  473:     undef(%xtics);  undef(%ytics);
  474:     #
  475:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  476:     my $result='';
  477:     &Apache::lonxml::register('Apache::lonplot',
  478: 	     ('title','xlabel','ylabel','key','axis','label','curve',
  479: 	      'xtics','ytics'));
  480:     push (@Apache::lonxml::namespace,'lonplot');
  481:     if ($target eq 'web' || $target eq 'tex') {
  482: 	&get_attributes(\%plot,\%gnuplot_defaults,$parstack,$safeeval,
  483: 			$tagstack->[-1]);
  484:     } elsif ($target eq 'edit') {
  485: 	$result .= &Apache::edit::tag_start($target,$token,'GnuPlot');
  486: 	$result .= &edit_attributes($target,$token,\%gnuplot_defaults,
  487: 				    \@gnuplot_edit_order);
  488:     } elsif ($target eq 'modified') {
  489: 	my $constructtag=&Apache::edit::get_new_args
  490: 	    ($token,$parstack,$safeeval,keys(%gnuplot_defaults));
  491: 	if ($constructtag) {
  492: 	    $result = &Apache::edit::rebuild_tag($token);
  493: 	}
  494:     }
  495:     return $result;
  496: }
  497: 
  498: sub end_gnuplot {
  499:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  500:     pop @Apache::lonxml::namespace;
  501:     &Apache::lonxml::deregister('Apache::lonplot',
  502: 	('title','xlabel','ylabel','key','axis','label','curve'));
  503:     my $result = '';
  504:     my $randnumber;
  505:     # need to call rand everytime start_script would evaluate, as the
  506:     # safe space rand number generator and the global rand generator 
  507:     # are not separate
  508:     if ($target eq 'web' || $target eq 'tex' || $target eq 'grade' ||
  509: 	$target eq 'answer') {
  510:       $randnumber=int(rand(1000));
  511:     }
  512:     if ($target eq 'web' || $target eq 'tex') {
  513: 	&check_inputs(); # Make sure we have all the data we need
  514: 	##
  515: 	## Determine filename
  516: 	my $tmpdir = '/home/httpd/perl/tmp/';
  517: 	my $filename = $env{'user.name'}.'_'.$env{'user.domain'}.
  518: 	    '_'.time.'_'.$$.$randnumber.'_plot';
  519: 	## Write the plot description to the file
  520: 	&write_gnuplot_file($tmpdir,$filename,$target);
  521: 	$filename = &Apache::lonnet::escape($filename);
  522: 	## return image tag for the plot
  523: 	if ($target eq 'web') {
  524: 	    $result .= <<"ENDIMAGE";
  525: <img src    = "/cgi-bin/plot.gif?file=$filename.data&output=$weboutputformat" 
  526:      width  = "$plot{'width'}"
  527:      height = "$plot{'height'}"
  528:      align  = "$plot{'align'}"
  529:      alt    = "$plot{'alttag'}" />
  530: ENDIMAGE
  531:         } elsif ($target eq 'tex') {
  532: 	    #might be inside the safe space, register the URL for later
  533: 	    &Apache::lonxml::register_ssi("/cgi-bin/plot.gif?file=$filename.data&output=eps");
  534: 	    $result = '\graphicspath{{/home/httpd/perl/tmp/}}\includegraphics[width='.$plot{'texwidth'}.' mm]{'.&Apache::lonnet::unescape($filename).'.eps}';
  535: 	}
  536:     } elsif ($target eq 'edit') {
  537: 	$result.=&Apache::edit::tag_end($target,$token);
  538:     }
  539:     return $result;
  540: }
  541: 
  542: 
  543: ##--------------------------------------------------------------- xtics
  544: sub start_xtics {
  545:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  546:     my $result='';
  547:     if ($target eq 'web' || $target eq 'tex') {
  548: 	&get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval,
  549: 		    $tagstack->[-1]);
  550:     } elsif ($target eq 'edit') {
  551: 	$result .= &Apache::edit::tag_start($target,$token,'xtics');
  552: 	$result .= &edit_attributes($target,$token,\%tic_defaults,
  553: 				    \@tic_edit_order);
  554:     } elsif ($target eq 'modified') {
  555: 	my $constructtag=&Apache::edit::get_new_args
  556: 	    ($token,$parstack,$safeeval,keys(%tic_defaults));
  557: 	if ($constructtag) {
  558: 	    $result = &Apache::edit::rebuild_tag($token);
  559: 	}
  560:     }
  561:     return $result;
  562: }
  563: 
  564: sub end_xtics {
  565:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  566:     my $result = '';
  567:     if ($target eq 'web' || $target eq 'tex') {
  568:     } elsif ($target eq 'edit') {
  569: 	$result.=&Apache::edit::tag_end($target,$token);
  570:     }
  571:     return $result;
  572: }
  573: 
  574: ##--------------------------------------------------------------- ytics
  575: sub start_ytics {
  576:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  577:     my $result='';
  578:     if ($target eq 'web' || $target eq 'tex') {
  579: 	&get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval,
  580: 		    $tagstack->[-1]);
  581:     } elsif ($target eq 'edit') {
  582: 	$result .= &Apache::edit::tag_start($target,$token,'ytics');
  583: 	$result .= &edit_attributes($target,$token,\%tic_defaults,
  584: 				    \@tic_edit_order);
  585:     } elsif ($target eq 'modified') {
  586: 	my $constructtag=&Apache::edit::get_new_args
  587: 	    ($token,$parstack,$safeeval,keys(%tic_defaults));
  588: 	if ($constructtag) {
  589: 	    $result = &Apache::edit::rebuild_tag($token);
  590: 	}
  591:     }
  592:     return $result;
  593: }
  594: 
  595: sub end_ytics {
  596:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  597:     my $result = '';
  598:     if ($target eq 'web' || $target eq 'tex') {
  599:     } elsif ($target eq 'edit') {
  600: 	$result.=&Apache::edit::tag_end($target,$token);
  601:     }
  602:     return $result;
  603: }
  604: 
  605: 
  606: ##----------------------------------------------------------------- key
  607: sub start_key {
  608:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  609:     my $result='';
  610:     if ($target eq 'web' || $target eq 'tex') {
  611: 	&get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
  612: 		    $tagstack->[-1]);
  613:     } elsif ($target eq 'edit') {
  614: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Key');
  615: 	$result .= &edit_attributes($target,$token,\%key_defaults);
  616:     } elsif ($target eq 'modified') {
  617: 	my $constructtag=&Apache::edit::get_new_args
  618: 	    ($token,$parstack,$safeeval,keys(%key_defaults));
  619: 	if ($constructtag) {
  620: 	    $result = &Apache::edit::rebuild_tag($token);
  621: 	}
  622:     }
  623:     return $result;
  624: }
  625: 
  626: sub end_key {
  627:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  628:     my $result = '';
  629:     if ($target eq 'web' || $target eq 'tex') {
  630:     } elsif ($target eq 'edit') {
  631: 	$result.=&Apache::edit::tag_end($target,$token);
  632:     }
  633:     return $result;
  634: }
  635: 
  636: ##------------------------------------------------------------------- title
  637: sub start_title {
  638:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  639:     my $result='';
  640:     if ($target eq 'web' || $target eq 'tex') {
  641: 	$title = &Apache::lonxml::get_all_text("/title",$parser);
  642: 	$title=&Apache::run::evaluate($title,$safeeval,$$parstack[-1]);
  643: 	$title =~ s/\n/ /g;
  644: 	if (length($title) > $max_str_len) {
  645: 	    $title = substr($title,0,$max_str_len);
  646: 	}
  647:     } elsif ($target eq 'edit') {
  648: 	$result.=&Apache::edit::tag_start($target,$token,'Plot Title');
  649: 	my $text=&Apache::lonxml::get_all_text("/title",$parser);
  650: 	$result.=&Apache::edit::end_row().
  651: 	    &Apache::edit::start_spanning_row().
  652: 	    &Apache::edit::editline('',$text,'',60);
  653:     } elsif ($target eq 'modified') {
  654: 	$result.=&Apache::edit::rebuild_tag($token);
  655: 	$result.=&Apache::edit::modifiedfield("/title",$parser);
  656:     }
  657:     return $result;
  658: }
  659: 
  660: sub end_title {
  661:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  662:     my $result = '';
  663:     if ($target eq 'web' || $target eq 'tex') {
  664:     } elsif ($target eq 'edit') {
  665: 	$result.=&Apache::edit::tag_end($target,$token);
  666:     }
  667:     return $result;
  668: }
  669: ##------------------------------------------------------------------- xlabel
  670: sub start_xlabel {
  671:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  672:     my $result='';
  673:     if ($target eq 'web' || $target eq 'tex') {
  674: 	$xlabel = &Apache::lonxml::get_all_text("/xlabel",$parser);
  675: 	$xlabel=&Apache::run::evaluate($xlabel,$safeeval,$$parstack[-1]);
  676: 	$xlabel =~ s/\n/ /g;
  677: 	if (length($xlabel) > $max_str_len) {
  678: 	    $xlabel = substr($xlabel,0,$max_str_len);
  679: 	}
  680:     } elsif ($target eq 'edit') {
  681: 	$result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
  682: 	my $text=&Apache::lonxml::get_all_text("/xlabel",$parser);
  683: 	$result.=&Apache::edit::end_row().
  684: 	    &Apache::edit::start_spanning_row().
  685: 	    &Apache::edit::editline('',$text,'',60);
  686:     } elsif ($target eq 'modified') {
  687: 	$result.=&Apache::edit::rebuild_tag($token);	
  688: 	$result.=&Apache::edit::modifiedfield("/xlabel",$parser);
  689:     }
  690:     return $result;
  691: }
  692: 
  693: sub end_xlabel {
  694:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  695:     my $result = '';
  696:     if ($target eq 'web' || $target eq 'tex') {
  697:     } elsif ($target eq 'edit') {
  698: 	$result.=&Apache::edit::tag_end($target,$token);
  699:     }
  700:     return $result;
  701: }
  702: 
  703: ##------------------------------------------------------------------- ylabel
  704: sub start_ylabel {
  705:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  706:     my $result='';
  707:     if ($target eq 'web' || $target eq 'tex') {
  708: 	$ylabel = &Apache::lonxml::get_all_text("/ylabel",$parser);
  709: 	$ylabel = &Apache::run::evaluate($ylabel,$safeeval,$$parstack[-1]);
  710: 	$ylabel =~ s/\n/ /g;
  711: 	if (length($ylabel) > $max_str_len) {
  712: 	    $ylabel = substr($ylabel,0,$max_str_len);
  713: 	}
  714:     } elsif ($target eq 'edit') {
  715: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
  716: 	my $text = &Apache::lonxml::get_all_text("/ylabel",$parser);
  717: 	$result .= &Apache::edit::end_row().
  718: 	    &Apache::edit::start_spanning_row().
  719: 	    &Apache::edit::editline('',$text,'',60);
  720:     } elsif ($target eq 'modified') {
  721: 	$result.=&Apache::edit::rebuild_tag($token);
  722: 	$result.=&Apache::edit::modifiedfield("/ylabel",$parser);
  723:     }
  724:     return $result;
  725: }
  726: 
  727: sub end_ylabel {
  728:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  729:     my $result = '';
  730:     if ($target eq 'web' || $target eq 'tex') {
  731:     } elsif ($target eq 'edit') {
  732: 	$result.=&Apache::edit::tag_end($target,$token);
  733:     }
  734:     return $result;
  735: }
  736: 
  737: ##------------------------------------------------------------------- label
  738: sub start_label {
  739:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  740:     my $result='';
  741:     if ($target eq 'web' || $target eq 'tex') {
  742: 	my %label;
  743: 	&get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
  744: 		    $tagstack->[-1]);
  745: 	my $text = &Apache::lonxml::get_all_text("/label",$parser);
  746: 	$text = &Apache::run::evaluate($text,$safeeval,$$parstack[-1]);
  747: 	$text =~ s/\n/ /g;
  748: 	$text = substr($text,0,$max_str_len) if (length($text) > $max_str_len);
  749: 	$label{'text'} = $text;
  750: 	push(@labels,\%label);
  751:     } elsif ($target eq 'edit') {
  752: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Label');
  753: 	$result .= &edit_attributes($target,$token,\%label_defaults);
  754: 	my $text = &Apache::lonxml::get_all_text("/label",$parser);
  755: 	$result .= &Apache::edit::end_row().
  756: 	    &Apache::edit::start_spanning_row().
  757: 	    &Apache::edit::editline('',$text,'',60);
  758:     } elsif ($target eq 'modified') {
  759: 	&Apache::edit::get_new_args
  760: 	    ($token,$parstack,$safeeval,keys(%label_defaults));
  761: 	$result.=&Apache::edit::rebuild_tag($token);
  762: 	$result.=&Apache::edit::modifiedfield("/label",$parser);
  763:     }
  764:     return $result;
  765: }
  766: 
  767: sub end_label {
  768:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  769:     my $result = '';
  770:     if ($target eq 'web' || $target eq 'tex') {
  771:     } elsif ($target eq 'edit') {
  772: 	$result.=&Apache::edit::tag_end($target,$token);
  773:     }
  774:     return $result;
  775: }
  776: 
  777: ##------------------------------------------------------------------- curve
  778: sub start_curve {
  779:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  780:     my $result='';
  781:     &Apache::lonxml::register('Apache::lonplot',('function','data'));
  782:     push (@Apache::lonxml::namespace,'curve');
  783:     if ($target eq 'web' || $target eq 'tex') {
  784: 	my %curve;
  785: 	&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
  786: 		    $tagstack->[-1]);
  787: 	push (@curves,\%curve);
  788:     } elsif ($target eq 'edit') {
  789: 	$result .= &Apache::edit::tag_start($target,$token,'Curve');
  790: 	$result .= &edit_attributes($target,$token,\%curve_defaults,
  791:                                     \@curve_edit_order);
  792:     } elsif ($target eq 'modified') {
  793: 	my $constructtag=&Apache::edit::get_new_args
  794: 	    ($token,$parstack,$safeeval,keys(%curve_defaults));
  795: 	if ($constructtag) {
  796: 	    $result = &Apache::edit::rebuild_tag($token);
  797: 	    $result.= &Apache::edit::handle_insert();
  798: 	}
  799:     }
  800:     return $result;
  801: }
  802: 
  803: sub end_curve {
  804:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  805:     my $result = '';
  806:     pop @Apache::lonxml::namespace;
  807:     &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
  808:     if ($target eq 'web' || $target eq 'tex') {
  809:     } elsif ($target eq 'edit') {
  810: 	$result.=&Apache::edit::tag_end($target,$token);
  811:     }
  812:     return $result;
  813: }
  814: 
  815: ##------------------------------------------------------------ curve function
  816: sub start_function {
  817:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  818:     my $result='';
  819:     if ($target eq 'web' || $target eq 'tex') {
  820: 	if (exists($curves[-1]->{'data'})) {
  821: 	    &Apache::lonxml::warning
  822:                 ('Use of the <b>curve function</b> tag precludes use of '.
  823:                  ' the <b>curve data</b> tag.  '.
  824:                  'The curve data tag will be omitted in favor of the '.
  825:                  'curve function declaration.');
  826: 	    delete $curves[-1]->{'data'} ;
  827: 	}
  828:         my $function = &Apache::lonxml::get_all_text("/function",$parser);
  829: 	$function = &Apache::run::evaluate($function,$safeeval,$$parstack[-1]);
  830: 	$curves[-1]->{'function'} = $function; 
  831:     } elsif ($target eq 'edit') {
  832: 	$result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function');
  833: 	my $text = &Apache::lonxml::get_all_text("/function",$parser);
  834: 	$result .= &Apache::edit::end_row().
  835: 	    &Apache::edit::start_spanning_row().
  836: 	    &Apache::edit::editline('',$text,'',60);
  837:     } elsif ($target eq 'modified') {
  838: 	$result.=&Apache::edit::rebuild_tag($token);
  839: 	$result.=&Apache::edit::modifiedfield("/function",$parser);
  840:     }
  841:     return $result;
  842: }
  843: 
  844: sub end_function {
  845:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  846:     my $result = '';
  847:     if ($target eq 'web' || $target eq 'tex') {
  848:     } elsif ($target eq 'edit') {
  849: 	$result .= &Apache::edit::end_table();
  850:     }
  851:     return $result;
  852: }
  853: 
  854: ##------------------------------------------------------------ curve  data
  855: sub start_data {
  856:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  857:     my $result='';
  858:     if ($target eq 'web' || $target eq 'tex') {
  859: 	if (exists($curves[-1]->{'function'})) {
  860: 	    &Apache::lonxml::warning
  861:                 ('Use of the <b>curve function</b> tag precludes use of '.
  862:                  ' the <b>curve data</b> tag.  '.
  863:                  'The curve function tag will be omitted in favor of the '.
  864:                  'curve data declaration.');
  865: 	    delete($curves[-1]->{'function'});
  866: 	}
  867: 	my $datatext = &Apache::lonxml::get_all_text("/data",$parser);
  868: 	$datatext=&Apache::run::evaluate($datatext,$safeeval,$$parstack[-1]);
  869: 	# Deal with cases where we're given an array...
  870: 	if ($datatext =~ /^\@/) {
  871: 	    $datatext = &Apache::run::run('return "'.$datatext.'"',
  872: 					  $safeeval,1);
  873: 	}
  874: 	$datatext =~ s/\s+/ /g;
  875: 	# Need to do some error checking on the @data array - 
  876: 	# make sure it's all numbers and make sure each array 
  877: 	# is of the same length.
  878: 	my @data;
  879: 	if ($datatext =~ /,/) { # comma deliminated
  880: 	    @data = split /,/,$datatext;
  881: 	} else { # Assume it's space separated.
  882: 	    @data = split / /,$datatext;
  883: 	}
  884: 	for (my $i=0;$i<=$#data;$i++) {
  885: 	    # Check that it's non-empty
  886: 	    if (! defined($data[$i])) {
  887: 		&Apache::lonxml::warning(
  888: 		    'undefined curve data value.  Replacing with '.
  889: 		    ' pi/e = 1.15572734979092');
  890: 		$data[$i] = 1.15572734979092;
  891: 	    }
  892: 	    # Check that it's a number
  893: 	    if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) {
  894: 		&Apache::lonxml::warning(
  895: 		    'Bad curve data value of '.$data[$i].'  Replacing with '.
  896: 		    ' pi/e = 1.15572734979092');
  897: 		$data[$i] = 1.15572734979092;
  898: 	    }
  899: 	}
  900: 	# complain if the number of data points is not the same as
  901: 	# in previous sets of data.
  902: 	if (($curves[-1]->{'data'}) && ($#data != $#{@{$curves[-1]->{'data'}->[0]}})){
  903: 	    &Apache::lonxml::warning
  904: 		('Number of data points is not consistent with previous '.
  905: 		 'number of data points');
  906: 	}
  907: 	push  @{$curves[-1]->{'data'}},\@data;
  908:     } elsif ($target eq 'edit') {
  909: 	$result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data');
  910: 	my $text = &Apache::lonxml::get_all_text("/data",$parser);
  911: 	$result .= &Apache::edit::end_row().
  912: 	    &Apache::edit::start_spanning_row().
  913: 	    &Apache::edit::editline('',$text,'',60);
  914:     } elsif ($target eq 'modified') {
  915: 	$result.=&Apache::edit::rebuild_tag($token);
  916: 	$result.=&Apache::edit::modifiedfield("/data",$parser);
  917:     }
  918:     return $result;
  919: }
  920: 
  921: sub end_data {
  922:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  923:     my $result = '';
  924:     if ($target eq 'web' || $target eq 'tex') {
  925:     } elsif ($target eq 'edit') {
  926: 	$result .= &Apache::edit::end_table();
  927:     }
  928:     return $result;
  929: }
  930: 
  931: ##------------------------------------------------------------------- axis
  932: sub start_axis {
  933:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  934:     my $result='';
  935:     if ($target eq 'web' || $target eq 'tex') {
  936: 	&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
  937: 			$tagstack->[-1]);
  938:     } elsif ($target eq 'edit') {
  939: 	$result .= &Apache::edit::tag_start($target,$token,'Plot Axes');
  940: 	$result .= &edit_attributes($target,$token,\%axis_defaults,
  941: 				    \@axis_edit_order);
  942:     } elsif ($target eq 'modified') {
  943: 	my $constructtag=&Apache::edit::get_new_args
  944: 	    ($token,$parstack,$safeeval,keys(%axis_defaults));
  945: 	if ($constructtag) {
  946: 	    $result = &Apache::edit::rebuild_tag($token);
  947: 	}
  948:     }
  949:     return $result;
  950: }
  951: 
  952: sub end_axis {
  953:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  954:     my $result = '';
  955:     if ($target eq 'web' || $target eq 'tex') {
  956:     } elsif ($target eq 'edit') {
  957: 	$result.=&Apache::edit::tag_end($target,$token);
  958:     } elsif ($target eq 'modified') {
  959:     }
  960:     return $result;
  961: }
  962: 
  963: ###################################################################
  964: ##                                                               ##
  965: ##        Utility Functions                                      ##
  966: ##                                                               ##
  967: ###################################################################
  968: 
  969: ##----------------------------------------------------------- set_defaults
  970: sub set_defaults {
  971:     my ($var,$defaults) = @_;
  972:     my $key;
  973:     foreach $key (keys(%$defaults)) {
  974: 	$var->{$key} = $defaults->{$key}->{'default'};
  975:     }
  976: }
  977: 
  978: ##------------------------------------------------------------------- misc
  979: sub get_attributes{
  980:     my ($values,$defaults,$parstack,$safeeval,$tag) = @_;
  981:     foreach my $attr (keys(%{$defaults})) {
  982: 	if ($attr eq 'texwidth' || $attr eq 'texfont') {
  983: 	    $values->{$attr} = 
  984: 		&Apache::lonxml::get_param($attr,$parstack,$safeeval,undef,1);
  985: 	} else {
  986: 	    $values->{$attr} = 
  987: 		&Apache::lonxml::get_param($attr,$parstack,$safeeval);
  988: 	}
  989: 	if ($values->{$attr} eq '' | !defined($values->{$attr})) {
  990: 	    $values->{$attr} = $defaults->{$attr}->{'default'};
  991: 	    next;
  992: 	}
  993: 	my $test = $defaults->{$attr}->{'test'};
  994: 	if (! &$test($values->{$attr})) {
  995: 	    &Apache::lonxml::warning
  996: 		($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
  997: 		 .$defaults->{$attr}->{'default'} );
  998: 	    $values->{$attr} = $defaults->{$attr}->{'default'};
  999: 	}
 1000:     }
 1001:     return ;
 1002: }
 1003: 
 1004: ##------------------------------------------------------- write_gnuplot_file
 1005: sub write_gnuplot_file {
 1006:     my ($tmpdir,$filename,$target)= @_;
 1007:     my $gnuplot_input = '';
 1008:     my $curve;
 1009:     my $pt = $plot{'texfont'};
 1010:     #
 1011:     # Check to be sure we do not have any empty curves
 1012:     my @curvescopy;
 1013:     foreach my $curve (@curves) {
 1014:         if (exists($curve->{'function'})) {
 1015:             if ($curve->{'function'} !~ /^\s*$/) {
 1016:                 push(@curvescopy,$curve);
 1017:             }
 1018:         } elsif (exists($curve->{'data'})) {
 1019:             foreach my $data (@{$curve->{'data'}}) {
 1020:                 if (scalar(@$data) > 0) {
 1021:                     push(@curvescopy,$curve);
 1022:                     last;
 1023:                 }
 1024:             }
 1025:         }
 1026:     }
 1027:     @curves = @curvescopy;
 1028:     # Collect all the colors
 1029:     my @Colors;
 1030:     push @Colors, $plot{'bgcolor'};
 1031:     push @Colors, $plot{'fgcolor'}; 
 1032:     push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
 1033:     foreach $curve (@curves) {
 1034: 	push @Colors, ($curve->{'color'} ne '' ? 
 1035: 		       $curve->{'color'}       : 
 1036: 		       $plot{'fgcolor'}        );
 1037:     }
 1038:     # set term
 1039:     if ($target eq 'web') {
 1040: 	$gnuplot_input .= 'set term '.$weboutputformat .' ';
 1041: 	$gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on');
 1042: 	$gnuplot_input .= $plot{'font'} . ' ';
 1043: 	$gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';
 1044: 	$gnuplot_input .= "@Colors\n";
 1045: 	# set output
 1046: 	$gnuplot_input .= "set output\n";
 1047:     } elsif ($target eq 'tex') {
 1048: 	$gnuplot_input .= "set term postscript eps $plot{'plotcolor'} solid \"Helvetica\" $pt \n";
 1049: 	$gnuplot_input .= "set output \"/home/httpd/perl/tmp/".
 1050: 	    &Apache::lonnet::unescape($filename).".eps\"\n";
 1051:     }
 1052:     # cartesian or polar?
 1053:     if (lc($plot{'plottype'}) eq 'polar') {
 1054:         $gnuplot_input .= 'set polar'.$/;
 1055:     } else {
 1056:         # Assume Cartesian
 1057:     }
 1058:     # margin
 1059:     if (lc($plot{'lmargin'}) ne 'default') {
 1060:         $gnuplot_input .= 'set lmargin '.$plot{'lmargin'}.$/;
 1061:     }
 1062:     if (lc($plot{'rmargin'}) ne 'default') {
 1063:         $gnuplot_input .= 'set rmargin '.$plot{'rmargin'}.$/;
 1064:     }
 1065:     if (lc($plot{'tmargin'}) ne 'default') {
 1066:         $gnuplot_input .= 'set tmargin '.$plot{'tmargin'}.$/;
 1067:     }
 1068:     if (lc($plot{'bmargin'}) ne 'default') {
 1069:         $gnuplot_input .= 'set bmargin '.$plot{'bmargin'}.$/;
 1070:     }
 1071:     # tic scales
 1072:     $gnuplot_input .= 'set ticscale '.
 1073:         $plot{'major_ticscale'}.' '.$plot{'minor_ticscale'}.$/;
 1074:     # grid
 1075:     $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');
 1076:     # border
 1077:     $gnuplot_input .= ($plot{'border'} eq 'on'?
 1078: 		       'set border'.$/           :
 1079: 		       'set noborder'.$/         );
 1080:     # sampling rate for non-data curves
 1081:     $gnuplot_input .= "set samples $plot{'samples'}\n";
 1082:     # title, xlabel, ylabel
 1083:     # titles
 1084:     if ($target eq 'tex') {
 1085:         $gnuplot_input .= "set title  \"$title\" font \"Helvetica,".$pt."pt\"\n"  if (defined($title)) ;
 1086:         $gnuplot_input .= "set xlabel \"$xlabel\" font \"Helvetica,".$pt."pt\" \n" if (defined($xlabel));
 1087:         $gnuplot_input .= "set ylabel \"$ylabel\" font \"Helvetica,".$pt."pt\"\n" if (defined($ylabel));
 1088:     } else {
 1089:         $gnuplot_input .= "set title  \"$title\"  \n"  if (defined($title)) ;
 1090:         $gnuplot_input .= "set xlabel \"$xlabel\" \n" if (defined($xlabel));
 1091:         $gnuplot_input .= "set ylabel \"$ylabel\" \n" if (defined($ylabel));
 1092:     }
 1093:     # tics
 1094:     if (%xtics) {    
 1095: 	$gnuplot_input .= "set xtics $xtics{'location'} ";
 1096: 	$gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror ");
 1097: 	$gnuplot_input .= "$xtics{'start'}, ";
 1098: 	$gnuplot_input .= "$xtics{'increment'}, ";
 1099: 	$gnuplot_input .= "$xtics{'end'}\n";
 1100:         if ($xtics{'minorfreq'} != 0) {
 1101:             $gnuplot_input .= "set mxtics ".$xtics{'minorfreq'}."\n";
 1102:         } 
 1103:     }
 1104:     if (%ytics) {    
 1105: 	$gnuplot_input .= "set ytics $ytics{'location'} ";
 1106: 	$gnuplot_input .= ( $ytics{'mirror'} eq 'on'?"mirror ":"nomirror ");
 1107: 	$gnuplot_input .= "$ytics{'start'}, ";
 1108: 	$gnuplot_input .= "$ytics{'increment'}, ";
 1109:         $gnuplot_input .= "$ytics{'end'}\n";
 1110:         if ($ytics{'minorfreq'} != 0) {
 1111:             $gnuplot_input .= "set mytics ".$ytics{'minorfreq'}."\n";
 1112:         } 
 1113:     }
 1114:     # axis
 1115:     if (%axis) {
 1116: 	$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
 1117: 	$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
 1118:     }
 1119:     # Key
 1120:     if (%key) {
 1121: 	$gnuplot_input .= 'set key '.$key{'pos'}.' ';
 1122: 	if ($key{'title'} ne '') {
 1123: 	    $gnuplot_input .= 'title "'.$key{'title'}.'" ';
 1124: 	} 
 1125: 	$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/;
 1126:     } else {
 1127: 	$gnuplot_input .= 'set nokey'.$/;
 1128:     }
 1129:     # labels
 1130:     my $label;
 1131:     foreach $label (@labels) {
 1132: 	$gnuplot_input .= 'set label "'.$label->{'text'}.'" at '.
 1133: 	    $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'};
 1134:         if ($target eq 'tex') {
 1135:             $gnuplot_input .=' font "Helvetica,'.$pt.'pt"' ;
 1136:         }
 1137:         $gnuplot_input .= $/;
 1138:     }
 1139:     if ($target eq 'tex') {
 1140:         $gnuplot_input .="set size 1,".$plot{'height'}/$plot{'width'}*1.38;
 1141:         $gnuplot_input .="\n";
 1142:         }
 1143:     # curves
 1144:     $gnuplot_input .= 'plot ';
 1145:     for (my $i = 0;$i<=$#curves;$i++) {
 1146: 	$curve = $curves[$i];
 1147: 	$gnuplot_input.= ', ' if ($i > 0);
 1148: 	if (exists($curve->{'function'})) {
 1149: 	    $gnuplot_input.= 
 1150: 		$curve->{'function'}.' title "'.
 1151: 		$curve->{'name'}.'" with '.
 1152:                 $curve->{'linestyle'};
 1153:             $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex');
 1154:             if (($curve->{'linestyle'} eq 'points')      ||
 1155:                 ($curve->{'linestyle'} eq 'linespoints') ||
 1156:                 ($curve->{'linestyle'} eq 'errorbars')   ||
 1157:                 ($curve->{'linestyle'} eq 'xerrorbars')  ||
 1158:                 ($curve->{'linestyle'} eq 'yerrorbars')  ||
 1159:                 ($curve->{'linestyle'} eq 'xyerrorbars')) {
 1160:                 $gnuplot_input.=' pointtype '.$curve->{'pointtype'};
 1161:                 $gnuplot_input.=' pointsize '.$curve->{'pointsize'};
 1162:             }
 1163: 	} elsif (exists($curve->{'data'})) {
 1164: 	    # Store data values in $datatext
 1165: 	    my $datatext = '';
 1166: 	    #   get new filename
 1167: 	    my $datafilename = "$tmpdir/$filename.data.$i";
 1168: 	    my $fh=Apache::File->new(">$datafilename");
 1169: 	    # Compile data
 1170: 	    my @Data = @{$curve->{'data'}};
 1171: 	    my @Data0 = @{$Data[0]};
 1172: 	    for (my $i =0; $i<=$#Data0; $i++) {
 1173: 		my $dataset;
 1174: 		foreach $dataset (@Data) {
 1175: 		    $datatext .= $dataset->[$i] . ' ';
 1176: 		}
 1177: 		$datatext .= $/;
 1178: 	    }
 1179: 	    #   write file
 1180: 	    print $fh $datatext;
 1181: 	    close ($fh);
 1182: 	    #   generate gnuplot text
 1183: 	    $gnuplot_input.= '"'.$datafilename.'" title "'.
 1184: 		$curve->{'name'}.'" with '.
 1185: 		$curve->{'linestyle'};
 1186:             $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex');
 1187:             if (($curve->{'linestyle'} eq 'points')      ||
 1188:                 ($curve->{'linestyle'} eq 'linespoints') ||
 1189:                 ($curve->{'linestyle'} eq 'errorbars')   ||
 1190:                 ($curve->{'linestyle'} eq 'xerrorbars')  ||
 1191:                 ($curve->{'linestyle'} eq 'yerrorbars')  ||
 1192:                 ($curve->{'linestyle'} eq 'xyerrorbars')) {
 1193:                 $gnuplot_input.=' pointtype '.$curve->{'pointtype'};
 1194:                 $gnuplot_input.=' pointsize '.$curve->{'pointsize'};
 1195:             }
 1196: 	}
 1197:     }
 1198:     # Write the output to a file.
 1199:     my $fh=Apache::File->new(">$tmpdir$filename.data");
 1200:     print $fh $gnuplot_input;
 1201:     close($fh);
 1202:     # That's all folks.
 1203:     return ;
 1204: }
 1205: 
 1206: #---------------------------------------------- check_inputs
 1207: sub check_inputs {
 1208:     ## Note: no inputs, no outputs - this acts only on global variables.
 1209:     ## Make sure we have all the input we need:
 1210:     if (! %plot) { &set_defaults(\%plot,\%gnuplot_defaults); }
 1211:     if (! %key ) {} # No key for this plot, thats okay
 1212: #    if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
 1213:     if (! defined($title )) {} # No title for this plot, thats okay
 1214:     if (! defined($xlabel)) {} # No xlabel for this plot, thats okay
 1215:     if (! defined($ylabel)) {} # No ylabel for this plot, thats okay
 1216:     if ($#labels < 0) { }      # No labels for this plot, thats okay
 1217:     if ($#curves < 0) { 
 1218: 	&Apache::lonxml::warning("No curves specified for plot!!!!");
 1219: 	return '';
 1220:     }
 1221:     my $curve;
 1222:     foreach $curve (@curves) {
 1223: 	if (!defined($curve->{'function'})&&!defined($curve->{'data'})){
 1224: 	    &Apache::lonxml::warning("One of the curves specified did not contain any curve data or curve function declarations\n");
 1225: 	    return '';
 1226: 	}
 1227:     }
 1228: }
 1229: 
 1230: #------------------------------------------------ make_edit
 1231: sub edit_attributes {
 1232:     my ($target,$token,$defaults,$keys) = @_;
 1233:     my ($result,@keys);
 1234:     if ($keys && ref($keys) eq 'ARRAY') {
 1235:         @keys = @$keys;
 1236:     } else {
 1237: 	@keys = sort(keys(%$defaults));
 1238:     }
 1239:     foreach my $attr (@keys) {
 1240: 	# append a ' ' to the description if it doesn't have one already.
 1241: 	my $description = $defaults->{$attr}->{'description'};
 1242: 	$description .= ' ' if ($description !~ / $/);
 1243: 	if ($defaults->{$attr}->{'edit_type'} eq 'entry') {
 1244: 	    $result .= &Apache::edit::text_arg
 1245: 		($description,$attr,$token,
 1246: 		 $defaults->{$attr}->{'size'});
 1247: 	} elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {
 1248: 	    $result .= &Apache::edit::select_or_text_arg
 1249: 		($description,$attr,$defaults->{$attr}->{'choices'},$token);
 1250: 	} elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') {
 1251: 	    $result .= &Apache::edit::select_or_text_arg
 1252: 		($description,$attr,['on','off'],$token);
 1253: 	}
 1254: 	$result .= '<br />';
 1255:     }
 1256:     return $result;
 1257: }
 1258: 
 1259: 
 1260: ###################################################################
 1261: ##                                                               ##
 1262: ##           Insertion functions for editing plots               ##
 1263: ##                                                               ##
 1264: ###################################################################
 1265: 
 1266: sub insert_gnuplot {
 1267:     my $result = '';
 1268:     #  plot attributes
 1269:     $result .= "\n<gnuplot ";
 1270:     foreach my $attr (keys(%gnuplot_defaults)) {
 1271: 	$result .= "\n     $attr=\"$gnuplot_defaults{$attr}->{'default'}\"";
 1272:     }
 1273:     $result .= ">";
 1274:     # Add the components (most are commented out for simplicity)
 1275:     # $result .= &insert_key();
 1276:     # $result .= &insert_axis();
 1277:     # $result .= &insert_title();    
 1278:     # $result .= &insert_xlabel();    
 1279:     # $result .= &insert_ylabel();    
 1280:     $result .= &insert_curve();
 1281:     # close up the <gnuplot>
 1282:     $result .= "\n</gnuplot>";
 1283:     return $result;
 1284: }
 1285: 
 1286: sub insert_tics {
 1287:     my $result;
 1288:     $result .= &insert_xtics() . &insert_ytics;
 1289:     return $result;
 1290: }
 1291: 
 1292: sub insert_xtics {
 1293:     my $result;
 1294:     $result .= "\n    <xtics ";
 1295:     foreach my $attr (keys(%tic_defaults)) {
 1296: 	$result .= "\n        $attr=\"$tic_defaults{$attr}->{'default'}\" ";
 1297:     }
 1298:     $result .= "/>";
 1299:     return $result;
 1300: }
 1301: 
 1302: sub insert_ytics {
 1303:     my $result;
 1304:     $result .= "\n    <ytics ";
 1305:     foreach my $attr (keys(%tic_defaults)) {
 1306: 	$result .= "\n        $attr=\"$tic_defaults{$attr}->{'default'}\" ";
 1307:     }
 1308:     $result .= "/>";
 1309:     return $result;
 1310: }
 1311: 
 1312: sub insert_key {
 1313:     my $result;
 1314:     $result .= "\n    <key ";
 1315:     foreach my $attr (keys(%key_defaults)) {
 1316: 	$result .= "\n         $attr=\"$key_defaults{$attr}->{'default'}\"";
 1317:     }
 1318:     $result .= " />";
 1319:     return $result;
 1320: }
 1321: 
 1322: sub insert_axis{
 1323:     my $result;
 1324:     $result .= "\n    <axis ";
 1325:    foreach my $attr (keys(%axis_defaults)) {
 1326: 	$result .= "\n         $attr=\"$axis_defaults{$attr}->{'default'}\"";
 1327:     }
 1328:     $result .= " />";
 1329:     return $result;
 1330: }
 1331: 
 1332: sub insert_title  { return "\n    <title></title>"; }
 1333: sub insert_xlabel { return "\n    <xlabel></xlabel>"; }
 1334: sub insert_ylabel { return "\n    <ylabel></ylabel>"; }
 1335: 
 1336: sub insert_label {
 1337:     my $result;
 1338:     $result .= "\n    <label ";
 1339:     foreach my $attr (keys(%label_defaults)) {
 1340: 	$result .= "\n         $attr=\"".
 1341:             $label_defaults{$attr}->{'default'}."\"";
 1342:     }
 1343:     $result .= "></label>";
 1344:     return $result;
 1345: }
 1346: 
 1347: sub insert_curve {
 1348:     my $result;
 1349:     $result .= "\n    <curve ";
 1350:     foreach my $attr (keys(%curve_defaults)) {
 1351: 	$result .= "\n         $attr=\"".
 1352: 	    $curve_defaults{$attr}->{'default'}."\"";
 1353:     }
 1354:     $result .= " >";
 1355:     $result .= &insert_data().&insert_data()."\n    </curve>";
 1356: }
 1357: 
 1358: sub insert_function {
 1359:     my $result;
 1360:     $result .= "\n        <function></function>";
 1361:     return $result;
 1362: }
 1363: 
 1364: sub insert_data {
 1365:     my $result;
 1366:     $result .= "\n        <data></data>";
 1367:     return $result;
 1368: }
 1369: 
 1370: ##----------------------------------------------------------------------
 1371: 1;
 1372: __END__
 1373: 
 1374: 

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