File:
[LON-CAPA] /
loncom /
xml /
lonplot.pm
Revision
1.88:
download - view:
text,
annotated -
select for diffs
Wed Sep 10 13:50:29 2003 UTC (20 years, 7 months ago) by
sakharuk
Branches:
MAIN
CVS tags:
HEAD
Bug 2138 (Gnuplot: allow separate font size for print and screen) is fixed. I've implemented one particular font "Helvetica" with default size 25pt. If you want to change these defaults feel free to do this. You even can introduce some additional attributes to have possibility dinamically overwrite these parameters. Unfortunately I do not know sufficiently well lonplot.pm module so this can be done far better by Mattew.
# The LearningOnline Network with CAPA
# Dynamic plot
#
# $Id: lonplot.pm,v 1.88 2003/09/10 13:50:29 sakharuk 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 plottype/;
my $gnuplot_help_text = <<"ENDPLOTHELP";
<p>
The <b>gnuplot</b> 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 <b>script</b> tag to generate random plots.
</p><p>
A <b>gnuplot</b> tag can contain the following sub-tags:
</p>
<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'
},
plottype => {
default => 'Cartesian',
test => sub {$_[0]=~/^(Polar|Cartesian)$/},
description => 'Plot type:',
edit_type => 'choice',
choices => ['Polar','Cartesian']
},
);
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 <b>curve</b> 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 <b>data</b> tag you can specify the numbers used to produce
the plot.
<p>
By default, two <b>data</b> 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 <b>data</b> tag is
required. Unfortunately, you must make sure the <b>data</b> tags appear
in the order gnuplot expects the data.
</p><p>
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 <b>data</b> tags is important. The
first tag will be the X data and the second will be the Y data.
</p>
<dt> Curve Function
<dd> The <b>function</b> tag allows you to specify the curve to be
plotted as a formula that gnuplot can understand. <b>Be careful using this
tag.</b> 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 <b>function</b> 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 <b>curve function</b> tag precludes use of '.
' the <b>curve data</b> 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 <b>curve function</b> tag precludes use of '.
' the <b>curve data</b> 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})) {
if ($attr eq 'texwidth') {
$values->{$attr} =
&Apache::lonxml::get_param($attr,$parstack,$safeeval,undef,1);
} else {
$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 \"Helvetica\" 25 \n";
$gnuplot_input .= "set output \"/home/httpd/perl/tmp/".
&Apache::lonnet::unescape($filename).".eps\"\n";
}
# cartesian or polar?
if (lc($plot{'plottype'}) eq 'polar') {
$gnuplot_input .= 'set polar'.$/;
} else {
# Assume Cartesian
}
# 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\" font \"Helvetica,25pt\"\n" if (defined($title)) ;
$gnuplot_input .= "set xlabel \"$xlabel\" font \"Helvetica,25pt\" \n" if (defined($xlabel));
$gnuplot_input .= "set ylabel \"$ylabel\" font \"Helvetica,25pt\"\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'}.' font "Helvetica,25pt"'.$/ ;
}
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 .= '<br />';
}
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__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonplot.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml