# The LearningOnline Network with CAPA # Dynamic plot # # $Id: lonplot.pm,v 1.74 2002/04/29 12:45:57 matthew Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # 12/15/01 Matthew # 12/17 12/18 12/19 12/20 12/21 12/27 12/28 12/30 12/31 Matthew # 01/01/02 Matthew # 01/02 01/03 01/04 01/07 01/08 01/09 Matthew # 01/21 02/05 02/06 2/28Matthew package Apache::lonplot; use strict; use Apache::File; use Apache::response; use Apache::lonxml; use Apache::edit; BEGIN { &Apache::lonxml::register('Apache::lonplot',('gnuplot')); } ## ## Description of data structures: ## ## %plot %key %axis ## -------------------------- ## height title color ## width box xmin ## bgcolor pos xmax ## fgcolor ymin ## transparent ymax ## grid ## border ## font ## align ## ## @labels: $labels[$i] = \%label ## %label: text, xpos, ypos, justify ## ## @curves: $curves[$i] = \%curve ## %curve: name, linestyle, ( function | data ) ## ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], ## [y1,y2,y3,y4] ] ## ################################################################### ## ## ## Tests used in checking the validitity of input ## ## ## ################################################################### my $max_str_len = 50; # if a label, title, xlabel, or ylabel text # is longer than this, it will be truncated. my %linestyles = ( lines => 2, # Maybe this will be used in the future linespoints => 2, # to check on whether or not they have dots => 2, # supplied enough fields points => 2, # to use the given line style. But for steps => 2, # now there are more important things fsteps => 2, # for me to deal with. histeps => 2, errorbars => 3, xerrorbars => [3,4], yerrorbars => [3,4], xyerrorbars => [4,6], boxes => 3, vector => 4 ); my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; my $real_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; my $pos_real_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+]?\d*\.?\d*([eE][+-]\d+)?$/}; my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/}; my $onoff_test = sub {$_[0]=~/^(on|off)$/}; my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/}; my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; my $linestyle_test = sub {exists($linestyles{$_[0]})}; my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/}; ################################################################### ## ## ## Attribute metadata ## ## ## ################################################################### my @gnuplot_edit_order = qw/alttag bgcolor fgcolor height width font transparent grid border align/; my $gnuplot_help_text = <<"ENDPLOTHELP";

The gnuplot tag allows an author to design a plot which can be created on the fly. This is intended for use in homework problems where each student needs to see a distinct plot. It can be used in conjunction with a script tag to generate random plots.

A gnuplot tag can contain the following sub-tags:

Plot Label
Allows you to place text at a given (x,y) coordinate on the plot.
Plot Title
The title of the plot
Plot Xlabel
The label on the horizontal axis of the plot
Plot Ylabel
The label on the vertical axis of the plot
Plot Axes
allows specification of the x and y ranges displayed in the plot
Plot Key
Lists the functions displayed in the plot.
Plot Curve
Sets the data used in the plot.
Plot Tics
Allows specification of the x and y coordinate 'tics' on the axes. This is mostly used to adjust the grid lines when a grid is displayed.
If you are having trouble with your plot, please read the help available on Plot Curve. ENDPLOTHELP my %gnuplot_defaults = ( alttag => { default => 'dynamically generated plot', test => $words_test, description => 'brief description of the plot', edit_type => 'entry', size => '40' }, height => { default => 300, test => $int_test, description => 'height of image (pixels)', edit_type => 'entry', size => '10' }, width => { default => 400, test => $int_test, description => 'width of image (pixels)', edit_type => 'entry', size => '10' }, bgcolor => { default => 'xffffff', test => $color_test, description => 'background color of image (xffffff)', edit_type => 'entry', size => '10' }, fgcolor => { default => 'x000000', test => $color_test, description => 'foreground color of image (x000000)', edit_type => 'entry', size => '10' }, transparent => { default => 'off', test => $onoff_test, description => 'Transparent image', edit_type => 'onoff' }, grid => { default => 'on', test => $onoff_test, description => 'Display grid', edit_type => 'onoff' }, border => { default => 'on', test => $onoff_test, description => 'Draw border around plot', edit_type => 'onoff' }, font => { default => 'medium', test => $sml_test, description => 'Size of font to use', edit_type => 'choice', choices => ['small','medium','large'] }, align => { default => 'center', test => sub {$_[0]=~/^(left|right|center)$/}, description => 'alignment for image in html', edit_type => 'choice', choices => ['left','right','center'] } ); my %key_defaults = ( title => { default => '', test => $words_test, description => 'Title of key', edit_type => 'entry', size => '40' }, box => { default => 'off', test => $onoff_test, description => 'Draw a box around the key?', edit_type => 'onoff' }, pos => { default => 'top right', test => $key_pos_test, description => 'position of the key on the plot', edit_type => 'choice', choices => ['top left','top right','bottom left','bottom right', 'outside','below'] } ); my %label_defaults = ( xpos => { default => 0, test => $real_test, description => 'x position of label (graph coordinates)', edit_type => 'entry', size => '10' }, ypos => { default => 0, test => $real_test, description => 'y position of label (graph coordinates)', edit_type => 'entry', size => '10' }, justify => { default => 'left', test => sub {$_[0]=~/^(left|right|center)$/}, description => 'justification of the label text on the plot', edit_type => 'choice', choices => ['left','right','center'] } ); my @tic_edit_order = ('location','mirror','start','increment','end'); my %tic_defaults = ( location => { default => 'border', test => sub {$_[0]=~/^(border|axis)$/}, description => 'Location of tick marks', edit_type => 'choice', choices => ['border','axis'] }, mirror => { default => 'on', test => $onoff_test, description => 'mirror ticks on opposite axis?', edit_type => 'onoff' }, start => { default => '-10.0', test => $real_test, description => 'Start ticks at', edit_type => 'entry', size => '10' }, increment => { default => '1.0', test => $real_test, description => 'Place a tick every', edit_type => 'entry', size => '10' }, end => { default => ' 10.0', test => $real_test, description => 'Stop ticks at ', edit_type => 'entry', size => '10' }, ); my @axis_edit_order = ('color','xmin','xmax','ymin','ymax'); my %axis_defaults = ( color => { default => 'x000000', test => $color_test, description => 'color of axes (x000000)', edit_type => 'entry', size => '10' }, xmin => { default => '-10.0', test => $real_test, description => 'minimum x-value shown in plot', edit_type => 'entry', size => '10' }, xmax => { default => ' 10.0', test => $real_test, description => 'maximum x-value shown in plot', edit_type => 'entry', size => '10' }, ymin => { default => '-10.0', test => $real_test, description => 'minimum y-value shown in plot', edit_type => 'entry', size => '10' }, ymax => { default => ' 10.0', test => $real_test, description => 'maximum y-value shown in plot', edit_type => 'entry', size => '10' } ); my $curve_help_text = <<"ENDCURVEHELP"; The curve tag is where you set the data to be plotted by gnuplot. There are two ways of entering the information:
Curve Data
Using a data tag you can specify the numbers used to produce the plot.

By default, two data tags will be available in a plot. The first will specify X coordinates of the data and the second will give the Y coordinates of the data. When working with a linestyle that requires more than two data sets, inserting another data tag is required. Unfortunately, you must make sure the data tags appear in the order gnuplot expects the data.

Specifying the data should usually be done with a perl variable or array, such as \@Xdata and \@Ydata. You may also specify numerical data seperated by commas. Again, the order of the data tags is important. The first tag will be the X data and the second will be the Y data.

Curve Function
The function tag allows you to specify the curve to be plotted as a formula that gnuplot can understand. Be careful using this tag. It is surprisingly easy to give gnuplot a function it cannot deal with properly. Be explicit: 2*sin(2*3.141592*x/4) will work but 2sin(2*3.141592x/4) will not. If you do not receive any errors in the gnuplot data but still do not have an image produced, it is likely there is an error in your function tag.
ENDCURVEHELP my @curve_edit_order = ('color','name','linestyle','pointtype','pointsize'); my %curve_defaults = ( color => { default => 'x000000', test => $color_test, description => 'color of curve (x000000)', edit_type => 'entry', size => '10' }, name => { default => '', test => $words_test, description => 'name of curve to appear in key', edit_type => 'entry', size => '20' }, linestyle => { default => 'lines', test => $linestyle_test, description => 'Line style', edit_type => 'choice', choices => [keys(%linestyles)] }, # gnuplots term=gif driver does not handle linewidth :( # linewidth => { # default => 1, # test => $int_test, # description => 'Line width (may not apply to all line styles)', # edit_type => 'choice', # choices => [1,2,3,4,5,6,7,8,9,10] # }, pointsize => { default => 1, test => $pos_real_test, description => 'point size (may not apply to all line styles)', edit_type => 'entry', size => '5' }, pointtype => { default => 1, test => $int_test, description => 'point type (may not apply to all line styles)', edit_type => 'choice', choices => [0,1,2,3,4,5,6] } ); ################################################################### ## ## ## parsing and edit rendering ## ## ## ################################################################### my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); sub start_gnuplot { %plot = (); %key = (); %axis = (); $title = undef; $xlabel = undef; $ylabel = undef; $#labels = -1; $#curves = -1; %xtics = (); %ytics = (); # my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; &Apache::lonxml::register('Apache::lonplot', ('title','xlabel','ylabel','key','axis','label','curve', 'xtics','ytics')); push (@Apache::lonxml::namespace,'lonplot'); if ($target eq 'web' || $target eq 'tex') { &get_attributes(\%plot,\%gnuplot_defaults,$parstack,$safeeval, $tagstack->[-1]); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); $result .= &make_javascript(); $result .= &help_win($gnuplot_help_text); $result .= &edit_attributes($target,$token,\%gnuplot_defaults, \@gnuplot_edit_order); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%gnuplot_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } return $result; } sub end_gnuplot { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; pop @Apache::lonxml::namespace; &Apache::lonxml::deregister('Apache::lonplot', ('title','xlabel','ylabel','key','axis','label','curve')); my $result = ''; my $randnumber; # need to call rand everytime start_script would evaluate, as the # safe space rand number generator and the global rand generator # are not seperate if ($target eq 'web' || $target eq 'tex' || $target eq 'grade' || $target eq 'answer') { $randnumber=int(rand(1000)); } if ($target eq 'web' || $target eq 'tex') { &check_inputs(); # Make sure we have all the data we need ## ## Determine filename my $tmpdir = '/home/httpd/perl/tmp/'; my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}. '_'.time.'_'.$$.$randnumber.'_plot'; ## Write the plot description to the file &write_gnuplot_file($tmpdir,$filename,$target); $filename = &Apache::lonnet::escape($filename); ## return image tag for the plot if ($target eq 'web') { $result .= <<"ENDIMAGE"; $plot{'alttag'} ENDIMAGE } elsif ($target eq 'tex') { &Apache::lonnet::ssi("/cgi-bin/plot.gif?file=$filename.data&output=eps"); $result = '\graphicspath{{/home/httpd/perl/tmp/}}\fbox{\includegraphics{'.&Apache::lonnet::unescape($filename).'.eps}}'; } } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##--------------------------------------------------------------- xtics sub start_xtics { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { &get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval, $tagstack->[-1]); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'xtics'); $result .= &edit_attributes($target,$token,\%tic_defaults, \@tic_edit_order); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%tic_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } return $result; } sub end_xtics { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##--------------------------------------------------------------- ytics sub start_ytics { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { &get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval, $tagstack->[-1]); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'ytics'); $result .= &edit_attributes($target,$token,\%tic_defaults, \@tic_edit_order); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%tic_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } return $result; } sub end_ytics { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##----------------------------------------------------------------- key sub start_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, $tagstack->[-1]); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Plot Key'); $result .= &edit_attributes($target,$token,\%key_defaults); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%key_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } return $result; } sub end_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------------- title sub start_title { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); $title=&Apache::run::evaluate($title,$safeeval,$$parstack[-1]); $title =~ s/\n/ /g; if (length($title) > $max_str_len) { $title = substr($title,0,$max_str_len); } } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token,'Plot Title'); my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]); $result.=&Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { my $text=$$parser[-1]->get_text("/title"); $result.=&Apache::edit::rebuild_tag($token); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_title { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------------- xlabel sub start_xlabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); $xlabel=&Apache::run::evaluate($xlabel,$safeeval,$$parstack[-1]); $xlabel =~ s/\n/ /g; if (length($xlabel) > $max_str_len) { $xlabel = substr($xlabel,0,$max_str_len); } } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel'); my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); $result.=&Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { my $text=$$parser[-1]->get_text("/xlabel"); $result.=&Apache::edit::rebuild_tag($token); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_xlabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------------- ylabel sub start_ylabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); $ylabel = &Apache::run::evaluate($ylabel,$safeeval,$$parstack[-1]); $ylabel =~ s/\n/ /g; if (length($ylabel) > $max_str_len) { $ylabel = substr($ylabel,0,$max_str_len); } } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel'); my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); $result .= &Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { my $text=$$parser[-1]->get_text("/ylabel"); $result.=&Apache::edit::rebuild_tag($token); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_ylabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------------- label sub start_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { my %label; &get_attributes(\%label,\%label_defaults,$parstack,$safeeval, $tagstack->[-1]); my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); $text = &Apache::run::evaluate($text,$safeeval,$$parstack[-1]); $text =~ s/\n/ /g; $text = substr($text,0,$max_str_len) if (length($text) > $max_str_len); $label{'text'} = $text; push(@labels,\%label); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Plot Label'); $result .= &edit_attributes($target,$token,\%label_defaults); my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); $result .= &Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { &Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%label_defaults)); $result.=&Apache::edit::rebuild_tag($token); my $text=$$parser[-1]->get_text("/label"); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------------- curve sub start_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); if ($target eq 'web' || $target eq 'tex') { my %curve; &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, $tagstack->[-1]); push (@curves,\%curve); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Curve'); $result .= &help_win($curve_help_text); $result .= &edit_attributes($target,$token,\%curve_defaults, \@curve_edit_order); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%curve_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); $result.= &Apache::edit::handle_insert(); } } return $result; } sub end_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; pop @Apache::lonxml::namespace; &Apache::lonxml::deregister('Apache::lonplot',('function','data')); if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } return $result; } ##------------------------------------------------------------ curve function sub start_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { if (exists($curves[-1]->{'data'})) { &Apache::lonxml::warning('Use of precludes use of . The will be omitted in favor of the declaration.'); delete $curves[-1]->{'data'} ; } my $function = &Apache::lonxml::get_all_text("/function",$$parser[-1]); $function = &Apache::run::evaluate($function,$safeeval,$$parstack[-1]); $curves[-1]->{'function'} = $function; } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]); $result .= &Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { $result.=&Apache::edit::rebuild_tag($token); my $text=$$parser[-1]->get_text("/function"); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result .= &Apache::edit::end_table(); } return $result; } ##------------------------------------------------------------ curve data sub start_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { if (exists($curves[-1]->{'function'})) { &Apache::lonxml::warning('Use of precludes use of .'. '. The will be omitted in favor of '. 'the declaration.'); delete($curves[-1]->{'function'}); } my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); $datatext=&Apache::run::evaluate($datatext,$safeeval,$$parstack[-1]); # Deal with cases where we're given an array... if ($datatext =~ /^\@/) { $datatext = &Apache::run::run('return "'.$datatext.'"', $safeeval,1); } $datatext =~ s/\s+/ /g; # Need to do some error checking on the @data array - # make sure it's all numbers and make sure each array # is of the same length. my @data; if ($datatext =~ /,/) { # comma deliminated @data = split /,/,$datatext; } else { # Assume it's space seperated. @data = split / /,$datatext; } for (my $i=0;$i<=$#data;$i++) { # Check that it's non-empty if (! defined($data[$i])) { &Apache::lonxml::warning( 'undefined value. Replacing with '. ' pi/e = 1.15572734979092'); $data[$i] = 1.15572734979092; } # Check that it's a number if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) { &Apache::lonxml::warning( 'Bad value of '.$data[$i].' Replacing with '. ' pi/e = 1.15572734979092'); $data[$i] = 1.15572734979092; } } # complain if the number of data points is not the same as # in previous sets of data. if (($curves[-1]->{'data'}) && ($#data != $#{@{$curves[-1]->{'data'}->[0]}})){ &Apache::lonxml::warning ('Number of data points is not consistent with previous '. 'number of data points'); } push @{$curves[-1]->{'data'}},\@data; } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data'); my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]); $result .= &Apache::edit::end_row(). &Apache::edit::start_spanning_row(). &Apache::edit::editline('',$text,'',60); } elsif ($target eq 'modified') { $result.=&Apache::edit::rebuild_tag($token); my $text=$$parser[-1]->get_text("/data"); $result.=&Apache::edit::modifiedfield($token); } return $result; } sub end_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result .= &Apache::edit::end_table(); } return $result; } ##------------------------------------------------------------------- axis sub start_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex') { &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, $tagstack->[-1]); } elsif ($target eq 'edit') { $result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); $result .= &edit_attributes($target,$token,\%axis_defaults, \@axis_edit_order); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args ($token,$parstack,$safeeval,keys(%axis_defaults)); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } return $result; } sub end_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web' || $target eq 'tex') { } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_end($target,$token); } elsif ($target eq 'modified') { } return $result; } ################################################################### ## ## ## Utility Functions ## ## ## ################################################################### ##----------------------------------------------------------- set_defaults sub set_defaults { my ($var,$defaults) = @_; my $key; foreach $key (keys(%$defaults)) { $var->{$key} = $defaults->{$key}->{'default'}; } } ##------------------------------------------------------------------- misc sub get_attributes{ my ($values,$defaults,$parstack,$safeeval,$tag) = @_; foreach my $attr (keys(%{$defaults})) { $values->{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval); if ($values->{$attr} eq '' | !defined($values->{$attr})) { $values->{$attr} = $defaults->{$attr}->{'default'}; next; } my $test = $defaults->{$attr}->{'test'}; if (! &$test($values->{$attr})) { &Apache::lonxml::warning ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' .$defaults->{$attr}->{'default'} ); $values->{$attr} = $defaults->{$attr}->{'default'}; } } return ; } ##------------------------------------------------------- write_gnuplot_file sub write_gnuplot_file { my ($tmpdir,$filename,$target)= @_; my $gnuplot_input = ''; my $curve; # Collect all the colors my @Colors; push @Colors, $plot{'bgcolor'}; push @Colors, $plot{'fgcolor'}; push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'}); foreach $curve (@curves) { push @Colors, ($curve->{'color'} ne '' ? $curve->{'color'} : $plot{'fgcolor'} ); } # set term if ($target eq 'web') { $gnuplot_input .= 'set term gif '; $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on'); $gnuplot_input .= $plot{'font'} . ' '; $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' '; $gnuplot_input .= "@Colors\n"; # set output $gnuplot_input .= "set output\n"; } elsif ($target eq 'tex') { $gnuplot_input .= "set term postscript eps monochrome solid\n"; $gnuplot_input .= "set output \"/home/httpd/perl/tmp/". &Apache::lonnet::unescape($filename).".eps\"\n"; } # grid $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on'); # border $gnuplot_input .= ($plot{'border'} eq 'on'? 'set border'.$/ : 'set noborder'.$/ ); # title, xlabel, ylabel # titles $gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ; $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel)); $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel)); # tics if (%xtics) { $gnuplot_input .= "set xtics $xtics{'location'} "; $gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror "); $gnuplot_input .= "$xtics{'start'}, "; $gnuplot_input .= "$xtics{'increment'}, "; $gnuplot_input .= "$xtics{'end'}\n"; } if (%ytics) { $gnuplot_input .= "set ytics $ytics{'location'} "; $gnuplot_input .= ( $ytics{'mirror'} eq 'on'?"mirror ":"nomirror "); $gnuplot_input .= "$ytics{'start'}, "; $gnuplot_input .= "$ytics{'increment'}, "; $gnuplot_input .= "$ytics{'end'}\n"; } # axis if (%axis) { $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; } # Key if (%key) { $gnuplot_input .= 'set key '.$key{'pos'}.' '; if ($key{'title'} ne '') { $gnuplot_input .= 'title "'.$key{'title'}.'" '; } $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; } else { $gnuplot_input .= 'set nokey'.$/; } # labels my $label; foreach $label (@labels) { $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ; } if ($target eq 'tex') { $gnuplot_input .="set size 1,".$plot{'height'}/$plot{'width'}; $gnuplot_input .="\n"; } # curves $gnuplot_input .= 'plot '; for (my $i = 0;$i<=$#curves;$i++) { $curve = $curves[$i]; $gnuplot_input.= ', ' if ($i > 0); if (exists($curve->{'function'})) { $gnuplot_input.= $curve->{'function'}.' title "'. $curve->{'name'}.'" with '. $curve->{'linestyle'}; $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex'); if (($curve->{'linestyle'} eq 'points') || ($curve->{'linestyle'} eq 'linespoints') || ($curve->{'linestyle'} eq 'errorbars') || ($curve->{'linestyle'} eq 'xerrorbars') || ($curve->{'linestyle'} eq 'yerrorbars') || ($curve->{'linestyle'} eq 'xyerrorbars')) { $gnuplot_input.=' pointtype '.$curve->{'pointtype'}; $gnuplot_input.=' pointsize '.$curve->{'pointsize'}; } } elsif (exists($curve->{'data'})) { # Store data values in $datatext my $datatext = ''; # get new filename my $datafilename = "$tmpdir/$filename.data.$i"; my $fh=Apache::File->new(">$datafilename"); # Compile data my @Data = @{$curve->{'data'}}; my @Data0 = @{$Data[0]}; for (my $i =0; $i<=$#Data0; $i++) { my $dataset; foreach $dataset (@Data) { $datatext .= $dataset->[$i] . ' '; } $datatext .= $/; } # write file print $fh $datatext; close ($fh); # generate gnuplot text $gnuplot_input.= '"'.$datafilename.'" title "'. $curve->{'name'}.'" with '. $curve->{'linestyle'}; $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex'); if (($curve->{'linestyle'} eq 'points') || ($curve->{'linestyle'} eq 'linespoints') || ($curve->{'linestyle'} eq 'errorbars') || ($curve->{'linestyle'} eq 'xerrorbars') || ($curve->{'linestyle'} eq 'yerrorbars') || ($curve->{'linestyle'} eq 'xyerrorbars')) { $gnuplot_input.=' pointtype '.$curve->{'pointtype'}; $gnuplot_input.=' pointsize '.$curve->{'pointsize'}; } } } # Write the output to a file. my $fh=Apache::File->new(">$tmpdir$filename.data"); print $fh $gnuplot_input; close($fh); # That's all folks. return ; } #---------------------------------------------- check_inputs sub check_inputs { ## Note: no inputs, no outputs - this acts only on global variables. ## Make sure we have all the input we need: if (! %plot) { &set_defaults(\%plot,\%gnuplot_defaults); } if (! %key ) {} # No key for this plot, thats okay # if (! %axis) { &set_defaults(\%axis,\%axis_defaults); } if (! defined($title )) {} # No title for this plot, thats okay if (! defined($xlabel)) {} # No xlabel for this plot, thats okay if (! defined($ylabel)) {} # No ylabel for this plot, thats okay if ($#labels < 0) { } # No labels for this plot, thats okay if ($#curves < 0) { &Apache::lonxml::warning("No curves specified for plot!!!!"); return ''; } my $curve; foreach $curve (@curves) { if (!defined($curve->{'function'})&&!defined($curve->{'data'})){ &Apache::lonxml::warning("One of the curves specified did not contain any or declarations\n"); return ''; } } } #------------------------------------------------ make_edit sub edit_attributes { my ($target,$token,$defaults,$keys) = @_; my ($result,@keys); if ($keys && ref($keys) eq 'ARRAY') { @keys = @$keys; } else { @keys = sort(keys(%$defaults)); } foreach my $attr (@keys) { # append a ' ' to the description if it doesn't have one already. my $description = $defaults->{$attr}->{'description'}; $description .= ' ' if ($description !~ / $/); if ($defaults->{$attr}->{'edit_type'} eq 'entry') { $result .= &Apache::edit::text_arg ($description,$attr,$token, $defaults->{$attr}->{'size'}); } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { $result .= &Apache::edit::select_arg ($description,$attr,$defaults->{$attr}->{'choices'},$token); } elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') { $result .= &Apache::edit::select_arg ($description,$attr,['on','off'],$token); } $result .= '
'; } return $result; } ################################################################### ## ## ## Insertion functions for editing plots ## ## ## ################################################################### sub insert_gnuplot { my $result = ''; # plot attributes $result .= "\n{'default'}\""; } $result .= ">"; # Add the components (most are commented out for simplicity) # $result .= &insert_key(); # $result .= &insert_axis(); # $result .= &insert_title(); # $result .= &insert_xlabel(); # $result .= &insert_ylabel(); $result .= &insert_curve(); # close up the $result .= "\n"; return $result; } sub insert_tics { my $result; $result .= &insert_xtics() . &insert_ytics; return $result; } sub insert_xtics { my $result; $result .= "\n {'default'}\" "; } $result .= "/>"; return $result; } sub insert_ytics { my $result; $result .= "\n {'default'}\" "; } $result .= "/>"; return $result; } sub insert_key { my $result; $result .= "\n {'default'}\""; } $result .= " />"; return $result; } sub insert_axis{ my $result; $result .= "\n {'default'}\""; } $result .= " />"; return $result; } sub insert_title { return "\n "; } sub insert_xlabel { return "\n "; } sub insert_ylabel { return "\n "; } sub insert_label { my $result; $result .= "\n "; return $result; } sub insert_curve { my $result; $result .= "\n {'default'}."\""; } $result .= " >"; $result .= &insert_data().&insert_data()."\n "; } sub insert_function { my $result; $result .= "\n "; return $result; } sub insert_data { my $result; $result .= "\n "; return $result; } ##---------------------------------------------------------------------- # Javascript functions to display help for tags sub make_javascript { my $helpwindowwidth = 400; my $helpwindowheight = 400; my $result = ''; $result.=<<"ENDFUNCTION"; ENDFUNCTION return $result; } sub help_win { my ($helptext)=@_; $helptext =~ s/\n/ /g; $helptext =~ s/\'/\\\'/g; my $result = ''; $result.=<<"ENDWIN";
help
ENDWIN return $result; } ##---------------------------------------------------------------------- 1; __END__