loncom/xml/lonplot.pm - view

File: [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.85: download - view: text, annotated - select for diffs
Tue Jun 10 18:46:02 2003 UTC (20 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, version_0_99_3, version_0_99_2, HEAD

Putting <tag> in html output supresses the display the thing in "<",">"'s.
Who knew?

# The LearningOnline Network with CAPA # Dynamic plot # # $Id: lonplot.pm,v 1.85 2003/06/10 18:46:02 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 <data></data> 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-fA-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 samples border align texwidth/; 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: <dl> <dt> Plot Label <dd> Allows you to place text at a given (x,y) coordinate on the plot. <dt> Plot Title <dd> The title of the plot <dt> Plot Xlabel <dd> The label on the horizontal axis of the plot <dt> Plot Ylabel <dd> The label on the vertical axis of the plot <dt> Plot Axes <dd> allows specification of the x and y ranges displayed in the plot <dt> Plot Key <dd> Lists the functions displayed in the plot. <dt> Plot Curve <dd> Sets the data used in the plot. <dt> Plot Tics <dd> 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. </dl> 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'] }, samples => { default => '100', test => $int_test, description => 'Number of samples for non-data plots', edit_type => 'choice', choices => ['100','200','500','1000','2000','5000'] }, align => { default => 'center', test => sub {$_[0]=~/^(left|right|center)$/}, description => 'alignment for image in html', edit_type => 'choice', choices => ['left','right','center'] }, texwidth => { default => '93', test => $int_test, description => 'Width of plot when printed (mm)', edit_type => 'entry', size => '5' }, ); 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 grid lines (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: <dl> <dt> Curve Data <dd> 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. <dt> Curve Function <dd> 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. </dl> 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"; <img src = "/cgi-bin/plot.gif?file=$filename.data&output=gif" width = "$plot{'width'}" height = "$plot{'height'}" align = "$plot{'align'}" alt = "$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/}}\includegraphics[width='.$plot{'texwidth'}.' mm]{'.&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); $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); $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); $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); $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); $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); $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); $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); $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 the curve function tag precludes use of '. ' the curve data tag. '. 'The curve data tag will be omitted in favor of the '. 'curve function declaration.'); delete $curves[-1]->{'data'} ; } my $function = &Apache::lonxml::get_all_text("/function",$parser); $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); $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 the curve function tag precludes use of '. ' the curve data tag. '. 'The curve function tag will be omitted in favor of the '. 'curve data declaration.'); delete($curves[-1]->{'function'}); } my $datatext = &Apache::lonxml::get_all_text("/data",$parser); $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 curve data 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 curve data 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); $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'.$/ ); # sampling rate for non-data curves $gnuplot_input .= "set samples $plot{'samples'}\n"; # 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'}*1.38; $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 curve data or curve function 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<gnuplot "; foreach my $attr (keys(%gnuplot_defaults)) { $result .= "\n $attr=\"$gnuplot_defaults{$attr}->{'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 <gnuplot> $result .= "\n</gnuplot>"; return $result; } sub insert_tics { my $result; $result .= &insert_xtics() . &insert_ytics; return $result; } sub insert_xtics { my $result; $result .= "\n <xtics "; foreach my $attr (keys(%tic_defaults)) { $result .= "\n $attr=\"$tic_defaults{$attr}->{'default'}\" "; } $result .= "/>"; return $result; } sub insert_ytics { my $result; $result .= "\n <ytics "; foreach my $attr (keys(%tic_defaults)) { $result .= "\n $attr=\"$tic_defaults{$attr}->{'default'}\" "; } $result .= "/>"; return $result; } sub insert_key { my $result; $result .= "\n <key "; foreach my $attr (keys(%key_defaults)) { $result .= "\n $attr=\"$key_defaults{$attr}->{'default'}\""; } $result .= " />"; return $result; } sub insert_axis{ my $result; $result .= "\n <axis "; foreach my $attr (keys(%axis_defaults)) { $result .= "\n $attr=\"$axis_defaults{$attr}->{'default'}\""; } $result .= " />"; return $result; } sub insert_title { return "\n <title></title>"; } sub insert_xlabel { return "\n <xlabel></xlabel>"; } sub insert_ylabel { return "\n <ylabel></ylabel>"; } sub insert_label { my $result; $result .= "\n <label "; foreach my $attr (keys(%label_defaults)) { $result .= "\n $attr=\"". $label_defaults{$attr}->{'default'}."\""; } $result .= "></label>"; return $result; } sub insert_curve { my $result; $result .= "\n <curve "; foreach my $attr (keys(%curve_defaults)) { $result .= "\n $attr=\"". $curve_defaults{$attr}->{'default'}."\""; } $result .= " >"; $result .= &insert_data().&insert_data()."\n </curve>"; } sub insert_function { my $result; $result .= "\n <function></function>"; return $result; } sub insert_data { my $result; $result .= "\n <data></data>"; return $result; } ##---------------------------------------------------------------------- # Javascript functions to display help for tags sub make_javascript { my $helpwindowwidth = 400; my $helpwindowheight = 400; my $result = ''; $result.=<<"ENDFUNCTION"; <script language="JavaScript"> function openWin(text) { newWin = open("", "new_W", "width=$helpwindowwidth,height=$helpwindowheight,resizable=1,scrollbars=1"); newWin.document.open("text/html", "replace"); newWin.document.writeln(text); newWin.document.writeln('<center><a href=\"javascript:window.close()\">close this window</a></center>'); newWin.document.close(); } </script> ENDFUNCTION return $result; } sub help_win { my ($helptext)=@_; $helptext =~ s/\n/ /g; $helptext =~ s/\'/\\\'/g; my $result = ''; $result.=<<"ENDWIN"; <table width="100%"><tr><td align="right"> <a href="javascript:openWin('$helptext')">help</a> </td></tr></table><hr /> ENDWIN return $result; } ##---------------------------------------------------------------------- 1; __END__