version 1.11, 2001/12/20 20:24:36
|
version 1.111, 2005/07/05 15:05:13
|
Line 25
|
Line 25
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# 12/15/01 Matthew |
|
# 12/18 12/19 12/20 Matthew |
|
package Apache::lonplot; |
package Apache::lonplot; |
|
|
use strict; |
use strict; |
|
use warnings FATAL=>'all'; |
|
no warnings 'uninitialized'; |
use Apache::File; |
use Apache::File; |
use Apache::response; |
use Apache::response; |
use Apache::lonxml; |
use Apache::lonxml; |
|
use Apache::edit; |
|
use Apache::lonnet; |
|
|
|
use vars qw/$weboutputformat $versionstring/; |
|
|
|
|
use Digest::MD5 qw(md5 md5_hex md5_base64); |
|
|
|
sub BEGIN { |
BEGIN { |
&Apache::lonxml::register('Apache::lonplot',('plot')); |
&Apache::lonxml::register('Apache::lonplot',('gnuplot')); |
|
# |
|
# Determine the version of GNUPLOT |
|
$weboutputformat = 'gif'; |
|
$versionstring = `gnuplot --version 2>/dev/null`; |
|
if ($versionstring =~ /^gnuplot 4/) { |
|
$weboutputformat = 'png'; |
|
} |
|
|
} |
} |
|
|
|
|
## |
## |
## Description of data structures: |
## Description of data structures: |
## |
## |
Line 53 sub BEGIN {
|
Line 67 sub BEGIN {
|
## grid |
## grid |
## border |
## border |
## font |
## font |
|
## align |
## |
## |
## @labels: $labels[$i] = \%label |
## @labels: $labels[$i] = \%label |
## %label: text, xpos, ypos, justify |
## %label: text, xpos, ypos, justify |
## |
## |
## @curves: $curves[$i] = \%curve |
## @curves: $curves[$i] = \%curve |
## %curve: name, linestyle, ( function | data ) |
## %curve: name, linestyle, ( function | data ) |
## |
## |
## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], |
## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], |
## [y1,y2,y3,y4] ] |
## [y1,y2,y3,y4] ] |
## |
## |
##------------------------------------------------------------ |
|
## |
################################################################### |
## Tests used in checking the validitity of input |
## ## |
## |
## 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, |
|
filledcurves => 2, |
|
vector => 4 |
|
); |
|
|
my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; |
my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; |
my $real_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*$/}; |
my $real_test = |
my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/}; |
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 $onoff_test = sub {$_[0]=~/^(on|off)$/}; |
my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/}; |
my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/}; |
my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; |
my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; |
my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/}; |
my $linestyle_test = sub {exists($linestyles{$_[0]})}; |
my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^(\w+ ?)+$/}; |
my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/}; |
## |
|
## Default values for attributes of elements |
################################################################### |
## |
## ## |
my %plot_defaults = |
## Attribute metadata ## |
|
## ## |
|
################################################################### |
|
my @gnuplot_edit_order = |
|
qw/alttag bgcolor fgcolor height width font transparent grid samples |
|
border align texwidth texfont plotcolor plottype lmargin rmargin tmargin |
|
bmargin major_ticscale minor_ticscale boxwidth gridlayer fillstyle |
|
pattern solid/; |
|
|
|
my $margin_choices = ['default',0..20]; |
|
|
|
my %gnuplot_defaults = |
( |
( |
height => {default => 200, test => $int_test }, |
alttag => { |
width => {default => 200, test => $int_test }, |
default => 'dynamically generated plot', |
bgcolor => {default => 'xffffff', test => $color_test }, |
test => $words_test, |
fgcolor => {default => 'x000000', test => $color_test }, |
description => 'brief description of the plot', |
transparent => {default => 'off', test => $onoff_test }, |
edit_type => 'entry', |
grid => {default => 'off', test => $onoff_test }, |
size => '40' |
border => {default => 'on', test => $onoff_test }, |
}, |
font => {default => 'medium', test => $sml_test } |
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' |
|
}, |
|
gridlayer => { |
|
default => 'off', |
|
test => $onoff_test, |
|
description => 'Display grid front layer over filled boxes or filled curves', |
|
edit_type => 'onoff' |
|
}, |
|
box_border => { |
|
default => 'noborder', |
|
test => sub {$_[0]=~/^(noborder|border)$/}, |
|
description => 'Draw border for boxes', |
|
edit_type => 'choice', |
|
choices => ['border','noborder'] |
|
}, |
|
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' |
|
}, |
|
texfont => { |
|
default => '22', |
|
test => $int_test, |
|
description => 'Font size to use in TeX output (pts):', |
|
edit_type => 'choice', |
|
choices => [qw/8 10 12 14 16 18 20 22 24 26 28 30 32 34 36/], |
|
}, |
|
plotcolor => { |
|
default => 'monochrome', |
|
test => sub {$_[0]=~/^(monochrome|color|colour)$/}, |
|
description => 'Color setting for printing:', |
|
edit_type => 'choice', |
|
choices => [qw/monochrome color colour/], |
|
}, |
|
pattern => { |
|
default => '', |
|
test => $int_test, |
|
description => 'pattern value for boxes:', |
|
edit_type => 'choice', |
|
choices => [0,1,2,3,4,5,6] |
|
}, |
|
solid => { |
|
default => 0, |
|
test => $real_test, |
|
description => 'The density of fill style for boxes', |
|
edit_type => 'entry', |
|
size => '5' |
|
}, |
|
fillstyle => { |
|
default => 'empty', |
|
test => sub {$_[0]=~/^(empty|solid|pattern)$/}, |
|
description => 'Filled style for boxes:', |
|
edit_type => 'choice', |
|
choices => ['empty','solid','pattern'] |
|
}, |
|
plottype => { |
|
default => 'Cartesian', |
|
test => sub {$_[0]=~/^(Polar|Cartesian)$/}, |
|
description => 'Plot type:', |
|
edit_type => 'choice', |
|
choices => ['Cartesian','Polar'] |
|
}, |
|
lmargin => { |
|
default => 'default', |
|
test => sub {$_[0]=~/^(default|\d+)$/}, |
|
description => 'Left margin width (pts):', |
|
edit_type => 'choice', |
|
choices => $margin_choices, |
|
}, |
|
rmargin => { |
|
default => 'default', |
|
test => sub {$_[0]=~/^(default|\d+)$/}, |
|
description => 'Right margin width (pts):', |
|
edit_type => 'choice', |
|
choices => $margin_choices, |
|
}, |
|
tmargin => { |
|
default => 'default', |
|
test => sub {$_[0]=~/^(default|\d+)$/}, |
|
description => 'Top margin width (pts):', |
|
edit_type => 'choice', |
|
choices => $margin_choices, |
|
}, |
|
bmargin => { |
|
default => 'default', |
|
test => sub {$_[0]=~/^(default|\d+)$/}, |
|
description => 'Bottom margin width (pts):', |
|
edit_type => 'choice', |
|
choices => $margin_choices, |
|
}, |
|
boxwidth => { |
|
default => '', |
|
test => $real_test, |
|
description => 'width of boxes default auto', |
|
edit_type => 'entry', |
|
size => '5' |
|
}, |
|
major_ticscale => { |
|
default => '1', |
|
test => $real_test, |
|
description => 'Size of major tic marks (plot coordinates)', |
|
edit_type => 'entry', |
|
size => '5' |
|
}, |
|
minor_ticscale => { |
|
default => '0.5', |
|
test => $real_test, |
|
description => 'Size of minor tic mark (plot coordinates)', |
|
edit_type => 'entry', |
|
size => '5' |
|
}, |
); |
); |
|
|
my %key_defaults = |
my %key_defaults = |
( |
( |
title => { default => '', test => $words_test }, |
title => { |
box => { default => 'off', test => $onoff_test }, |
default => '', |
pos => { default => 'top right', test => $key_pos_test } |
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 = |
my %label_defaults = |
( |
( |
xpos => {default => 0, test => $real_test }, |
xpos => { |
ypos => {default => 0, test => $real_test }, |
default => 0, |
justify => {default => 'left', |
test => $real_test, |
test => sub {$_[0]=~/^(left|right|center)$/} } |
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', |
|
'minorfreq'); |
|
my %tic_defaults = |
|
( |
|
location => { |
|
default => 'border', |
|
test => sub {$_[0]=~/^(border|axis)$/}, |
|
description => 'Location of major tic marks', |
|
edit_type => 'choice', |
|
choices => ['border','axis'] |
|
}, |
|
mirror => { |
|
default => 'on', |
|
test => $onoff_test, |
|
description => 'mirror tics on opposite axis?', |
|
edit_type => 'onoff' |
|
}, |
|
start => { |
|
default => '-10.0', |
|
test => $real_test, |
|
description => 'Start major tics at', |
|
edit_type => 'entry', |
|
size => '10' |
|
}, |
|
increment => { |
|
default => '1.0', |
|
test => $real_test, |
|
description => 'Place a major tic every', |
|
edit_type => 'entry', |
|
size => '10' |
|
}, |
|
end => { |
|
default => ' 10.0', |
|
test => $real_test, |
|
description => 'Stop major tics at ', |
|
edit_type => 'entry', |
|
size => '10' |
|
}, |
|
minorfreq => { |
|
default => '0', |
|
test => $int_test, |
|
description => 'Number of minor tics per major tic mark', |
|
edit_type => 'entry', |
|
size => '10' |
|
}, |
); |
); |
|
|
|
my @axis_edit_order = ('color','xmin','xmax','ymin','ymax'); |
my %axis_defaults = |
my %axis_defaults = |
( |
( |
color => {default => 'x000000', test => $color_test}, |
color => { |
xmin => {default => '-10.0', test => $real_test }, |
default => 'x000000', |
xmax => {default => ' 10.0', test => $real_test }, |
test => $color_test, |
ymin => {default => '-10.0', test => $real_test }, |
description => 'color of grid lines (x000000)', |
ymax => {default => ' 10.0', test => $real_test } |
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_edit_order = ('color','name','linestyle','pointtype','pointsize','limit'); |
|
|
my %curve_defaults = |
my %curve_defaults = |
( |
( |
color => {default => 'x000000', test => $color_test }, |
color => { |
name => {default => 'x000000', test => sub {1} },#sub {$_[0]=~/^[\w ]*$/} }, |
default => 'x000000', |
linestyle => {default => 'lines', test => $linestyle_test } |
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] |
|
}, |
|
limit => { |
|
default => 'closed', |
|
test => sub {$_[0]=~/^(closed|x1|x2|y1|y2)$/}, |
|
description => 'point to fill -- for filledcurves', |
|
edit_type => 'choice', |
|
choices => ['closed','x1','x2','y1','y2'] |
|
}, |
); |
); |
|
|
## |
################################################################### |
## End of defaults |
## ## |
## |
## parsing and edit rendering ## |
my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves); |
## ## |
|
################################################################### |
sub start_plot { |
|
%plot = undef; %key = undef; %axis = undef; |
undef %Apache::lonplot::plot; |
$title = undef; $xlabel = undef; $ylabel = undef; |
my (%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); |
$#labels = -1; $#curves = -1; |
|
|
sub start_gnuplot { |
|
undef(%Apache::lonplot::plot); undef(%key); undef(%axis); |
|
undef($title); undef($xlabel); undef($ylabel); |
|
undef(@labels); undef(@curves); |
|
undef(%xtics); undef(%ytics); |
# |
# |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
&Apache::lonxml::register('Apache::lonplot', |
&Apache::lonxml::register('Apache::lonplot', |
('title','xlabel','ylabel','key','axis','label','curve')); |
('title','xlabel','ylabel','key','axis','label','curve', |
push (@Apache::lonxml::namespace,'plot'); |
'xtics','ytics')); |
## Always evaluate the insides of the <plot></plot> tags |
push (@Apache::lonxml::namespace,'lonplot'); |
my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]); |
if ($target eq 'web' || $target eq 'tex') { |
$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); |
&get_attributes(\%Apache::lonplot::plot,\%gnuplot_defaults,$parstack,$safeeval, |
&Apache::lonxml::newparser($parser,\$inside); |
$tagstack->[-1]); |
##------------------------------------------------------- |
} elsif ($target eq 'edit') { |
&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval, |
$result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); |
$tagstack->[-1]); |
$result .= &edit_attributes($target,$token,\%gnuplot_defaults, |
if ($target eq 'web') { |
\@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 ''; |
return $result; |
} |
} |
|
|
sub end_plot { |
sub end_gnuplot { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
pop @Apache::lonxml::namespace; |
pop @Apache::lonxml::namespace; |
&Apache::lonxml::deregister('Apache::lonplot', |
&Apache::lonxml::deregister('Apache::lonplot', |
('title','xlabel','ylabel','key','axis','label','curve')); |
('title','xlabel','ylabel','key','axis','label','curve')); |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
my $randnumber; |
## Determine filename -- Need to use the 'id' thingy that Gerd |
# need to call rand everytime start_script would evaluate, as the |
## mentioned. |
# safe space rand number generator and the global rand generator |
|
# are not separate |
|
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 $tmpdir = '/home/httpd/perl/tmp/'; |
my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}. |
my $filename = $env{'user.name'}.'_'.$env{'user.domain'}. |
'_plot.data'; |
'_'.time.'_'.$$.$randnumber.'_plot'; |
my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'}); |
|
|
|
## Write the plot description to the file |
## Write the plot description to the file |
my $fh=Apache::File->new('/home/httpd/perl/tmp/'.$filename); |
&write_gnuplot_file($tmpdir,$filename,$target); |
$result .= '<pre>'; |
$filename = &Apache::lonnet::escape($filename); |
$result .= &write_gnuplot_file($fh); |
|
$result .= '</pre>'.$/; |
|
## return image tag for the plot |
## return image tag for the plot |
$result .= '<img src="/cgi-bin/plot.cgi?'.$usersees.'"/>'; |
if ($target eq 'web') { |
|
$result .= <<"ENDIMAGE"; |
|
<img src = "/cgi-bin/plot.gif?file=$filename.data&output=$weboutputformat" |
|
width = "$Apache::lonplot::plot{'width'}" |
|
height = "$Apache::lonplot::plot{'height'}" |
|
align = "$Apache::lonplot::plot{'align'}" |
|
alt = "$Apache::lonplot::plot{'alttag'}" /> |
|
ENDIMAGE |
|
} elsif ($target eq 'tex') { |
|
&Apache::lonxml::debug(" gnuplot wid = $Apache::lonplot::plot{'width'}"); |
|
&Apache::lonxml::debug(" gnuplot ht = $Apache::lonplot::plot{'height'}"); |
|
#might be inside the safe space, register the URL for later |
|
&Apache::lonxml::register_ssi("/cgi-bin/plot.gif?file=$filename.data&output=eps"); |
|
$result = "%DYNAMICIMAGE:$Apache::lonplot::plot{'width'}:$Apache::lonplot::plot{'height'}:$Apache::lonplot::plot{'texwidth'}\n"; |
|
$result .= '\graphicspath{{/home/httpd/perl/tmp/}}'."\n"; |
|
$result .= '\includegraphics[width='.$Apache::lonplot::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; |
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 |
##----------------------------------------------------------------- key |
sub start_key { |
sub start_key { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
&get_attributes(\%key,\%key_defaults,$parstack,$safeeval, |
if ($target eq 'web' || $target eq 'tex') { |
|
&get_attributes(\%key,\%key_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
if ($target eq 'web') { |
} elsif ($target eq 'edit') { |
# This routine should never return anything. |
$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; |
return $result; |
} |
} |
Line 188 sub start_key {
|
Line 686 sub start_key {
|
sub end_key { |
sub end_key { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
##------------------------------------------------------------------- title |
##------------------------------------------------------------------- title |
sub start_title { |
sub start_title { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); |
|
my $result=''; |
my $result=''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
$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') { |
|
$result.=&Apache::edit::rebuild_tag($token); |
|
$result.=&Apache::edit::modifiedfield("/title",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 207 sub start_title {
|
Line 720 sub start_title {
|
sub end_title { |
sub end_title { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 216 sub end_title {
|
Line 730 sub end_title {
|
sub start_xlabel { |
sub start_xlabel { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); |
if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web') { |
$xlabel = &Apache::lonxml::get_all_text("/xlabel",$parser); |
# This routine should never return anything. |
$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') { |
|
$result.=&Apache::edit::rebuild_tag($token); |
|
$result.=&Apache::edit::modifiedfield("/xlabel",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 226 sub start_xlabel {
|
Line 753 sub start_xlabel {
|
sub end_xlabel { |
sub end_xlabel { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
##------------------------------------------------------------------- ylabel |
##------------------------------------------------------------------- ylabel |
sub start_ylabel { |
sub start_ylabel { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); |
if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web') { |
$ylabel = &Apache::lonxml::get_all_text("/ylabel",$parser); |
# This routine should never return anything. |
$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') { |
|
$result.=&Apache::edit::rebuild_tag($token); |
|
$result.=&Apache::edit::modifiedfield("/ylabel",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 245 sub start_ylabel {
|
Line 787 sub start_ylabel {
|
sub end_ylabel { |
sub end_ylabel { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
##------------------------------------------------------------------- label |
##------------------------------------------------------------------- label |
sub start_label { |
sub start_label { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
my %label; |
if ($target eq 'web' || $target eq 'tex') { |
&get_attributes(\%label,\%label_defaults,$parstack,$safeeval, |
my %label; |
|
&get_attributes(\%label,\%label_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
$label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]); |
my $text = &Apache::lonxml::get_all_text("/label",$parser); |
if (! &$words_test($label{'text'})) { |
$text = &Apache::run::evaluate($text,$safeeval,$$parstack[-1]); |
# I should probably warn about it, too. |
$text =~ s/\n/ /g; |
$label{'text'} = 'Illegal text'; |
$text = substr($text,0,$max_str_len) if (length($text) > $max_str_len); |
} |
$label{'text'} = $text; |
push(@labels,\%label); |
push(@labels,\%label); |
if ($target eq 'web') { |
} elsif ($target eq 'edit') { |
# This routine should never return anything. |
$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); |
|
$result.=&Apache::edit::modifiedfield("/label",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 272 sub start_label {
|
Line 827 sub start_label {
|
sub end_label { |
sub end_label { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 282 sub end_label {
|
Line 838 sub end_label {
|
sub start_curve { |
sub start_curve { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
my %curve; |
|
&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, |
|
$tagstack->[-1]); |
|
push (@curves,\%curve); |
|
&Apache::lonxml::register('Apache::lonplot',('function','data')); |
&Apache::lonxml::register('Apache::lonplot',('function','data')); |
push (@Apache::lonxml::namespace,'curve'); |
push (@Apache::lonxml::namespace,'curve'); |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
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 .= &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; |
return $result; |
} |
} |
Line 299 sub end_curve {
|
Line 865 sub end_curve {
|
my $result = ''; |
my $result = ''; |
pop @Apache::lonxml::namespace; |
pop @Apache::lonxml::namespace; |
&Apache::lonxml::deregister('Apache::lonplot',('function','data')); |
&Apache::lonxml::deregister('Apache::lonplot',('function','data')); |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
##------------------------------------------------------------ curve function |
##------------------------------------------------------------ curve function |
sub start_function { |
sub start_function { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
if (exists($curves[-1]->{'data'})) { |
if ($target eq 'web' || $target eq 'tex') { |
&Apache::lonxml::warning('Use of <function> precludes use of <data>. The <data> will be omitted in favor of the <function> declaration.'); |
if (exists($curves[-1]->{'data'})) { |
delete $curves[-1]->{'data'} ; |
&Apache::lonxml::warning |
} |
('Use of the <b>curve function</b> tag precludes use of '. |
$curves[-1]->{'function'} = |
' the <b>curve data</b> tag. '. |
&Apache::lonxml::get_all_text("/function",$$parser[-1]); |
'The curve data tag will be omitted in favor of the '. |
if ($target eq 'web') { |
'curve function declaration.'); |
# This routine should never return anything. |
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); |
|
$result.=&Apache::edit::modifiedfield("/function",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 323 sub start_function {
|
Line 904 sub start_function {
|
sub end_function { |
sub end_function { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result .= &Apache::edit::end_table(); |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
##------------------------------------------------------------ curve data |
##------------------------------------------------------------ curve data |
sub start_data { |
sub start_data { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
if (exists($curves[-1]->{'function'})) { |
if ($target eq 'web' || $target eq 'tex') { |
&Apache::lonxml::warning('Use of <data> precludes use of <function>.'. |
if (exists($curves[-1]->{'function'})) { |
' The <function> will be omitted in favor of the <data>'. |
&Apache::lonxml::warning |
' declaration.'); |
('Use of the <b>curve function</b> tag precludes use of '. |
delete($curves[-1]->{'function'}); |
' the <b>curve data</b> tag. '. |
} |
'The curve function tag will be omitted in favor of the '. |
my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); |
'curve data declaration.'); |
$datatext =~ s/\s+//g; # No whitespace, numbers must be seperated |
delete($curves[-1]->{'function'}); |
# by commas |
} |
if ($datatext !~ /^(([+-]?\d*\.?\d*)[, ]?)+$/) { |
my $datatext = &Apache::lonxml::get_all_text("/data",$parser); |
&Apache::lonxml::warning('Malformed data: '.$datatext); |
$datatext=&Apache::run::evaluate($datatext,$safeeval,$$parstack[-1]); |
$datatext = ''; |
# Deal with cases where we're given an array... |
} |
if ($datatext =~ /^\@/) { |
# Need to do some error checking on the @data array - |
$datatext = &Apache::run::run('return "'.$datatext.'"', |
# make sure it's all numbers and make sure each array |
$safeeval,1); |
# is of the same length. |
} |
my @data = split /,/,$datatext; |
$datatext =~ s/\s+/ /g; |
for (my $i=0;$i<=$#data;$i++) { |
# Need to do some error checking on the @data array - |
# Check that it's non-empty |
# make sure it's all numbers and make sure each array |
# Check that it's a number |
# is of the same length. |
# Maybe I need a 'debug=on' switch to list the data set |
my @data; |
# out in a warning? |
if ($datatext =~ /,/) { # comma deliminated |
} |
@data = split /,/,$datatext; |
push @{$curves[-1]->{'data'}},\@data; |
} else { # Assume it's space separated. |
if ($target eq 'web') { |
@data = split / /,$datatext; |
# This routine should never return anything. |
} |
|
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); |
|
$result.=&Apache::edit::modifiedfield("/data",$parser); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 365 sub start_data {
|
Line 981 sub start_data {
|
sub end_data { |
sub end_data { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result .= &Apache::edit::end_table(); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 375 sub end_data {
|
Line 992 sub end_data {
|
sub start_axis { |
sub start_axis { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result=''; |
my $result=''; |
&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, |
if ($target eq 'web' || $target eq 'tex') { |
$tagstack->[-1]); |
&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, |
if ($target eq 'web') { |
$tagstack->[-1]); |
# This routine should never return anything. |
} 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; |
return $result; |
} |
} |
Line 386 sub start_axis {
|
Line 1012 sub start_axis {
|
sub end_axis { |
sub end_axis { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web' || $target eq 'tex') { |
# This routine should never return anything. |
} elsif ($target eq 'edit') { |
|
$result.=&Apache::edit::tag_end($target,$token); |
|
} elsif ($target eq 'modified') { |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
|
################################################################### |
|
## ## |
|
## Utility Functions ## |
|
## ## |
|
################################################################### |
|
|
|
##----------------------------------------------------------- set_defaults |
|
sub set_defaults { |
|
my ($var,$defaults) = @_; |
|
my $key; |
|
foreach $key (keys(%$defaults)) { |
|
$var->{$key} = $defaults->{$key}->{'default'}; |
|
} |
|
} |
|
|
##------------------------------------------------------------------- misc |
##------------------------------------------------------------------- misc |
sub get_attributes{ |
sub get_attributes{ |
my $values = shift; |
my ($values,$defaults,$parstack,$safeeval,$tag) = @_; |
my $defaults = shift; |
foreach my $attr (keys(%{$defaults})) { |
my $parstack = shift; |
if ($attr eq 'texwidth' || $attr eq 'texfont') { |
my $safeeval = shift; |
$values->{$attr} = |
my $tag = shift; |
&Apache::lonxml::get_param($attr,$parstack,$safeeval,undef,1); |
my $attr; |
} else { |
foreach $attr (keys %{$defaults}) { |
$values->{$attr} = |
$values->{$attr} = |
&Apache::lonxml::get_param($attr,$parstack,$safeeval); |
&Apache::lonxml::get_param($attr,$parstack,$safeeval); |
} |
if ($values->{$attr} eq '' | !defined($values->{$attr})) { |
if ($values->{$attr} eq '' | !defined($values->{$attr})) { |
$values->{$attr} = $defaults->{$attr}->{'default'}; |
$values->{$attr} = $defaults->{$attr}->{'default'}; |
next; |
next; |
Line 418 sub get_attributes{
|
Line 1061 sub get_attributes{
|
return ; |
return ; |
} |
} |
|
|
|
##------------------------------------------------------- write_gnuplot_file |
sub write_gnuplot_file { |
sub write_gnuplot_file { |
my $fh = shift; |
my ($tmpdir,$filename,$target)= @_; |
my $gnuplot_input = ''; |
my $gnuplot_input = ''; |
my $curve; |
my $curve; |
|
my $pt = $Apache::lonplot::plot{'texfont'}; |
|
# |
|
# Check to be sure we do not have any empty curves |
|
my @curvescopy; |
|
foreach my $curve (@curves) { |
|
if (exists($curve->{'function'})) { |
|
if ($curve->{'function'} !~ /^\s*$/) { |
|
push(@curvescopy,$curve); |
|
} |
|
} elsif (exists($curve->{'data'})) { |
|
foreach my $data (@{$curve->{'data'}}) { |
|
if (scalar(@$data) > 0) { |
|
push(@curvescopy,$curve); |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
@curves = @curvescopy; |
# Collect all the colors |
# Collect all the colors |
my @Colors; |
my @Colors; |
push @Colors, $plot{'bgcolor'}; |
push @Colors, $Apache::lonplot::plot{'bgcolor'}; |
push @Colors, $plot{'fgcolor'}; |
push @Colors, $Apache::lonplot::plot{'fgcolor'}; |
push @Colors, $axis{'color'}; |
push @Colors, (defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'}); |
push @Colors, $axis{'color'}; |
|
foreach $curve (@curves) { |
foreach $curve (@curves) { |
push @Colors, ($curve->{'color'} ne '' ? |
push @Colors, ($curve->{'color'} ne '' ? |
$curve->{'color'} : |
$curve->{'color'} : |
$plot{'fgcolor'} ); |
$Apache::lonplot::plot{'fgcolor'} ); |
} |
} |
# set term |
# set term |
$gnuplot_input .= 'set term gif '; |
if ($target eq 'web') { |
$gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on'); |
$gnuplot_input .= 'set term '.$weboutputformat .' '; |
$gnuplot_input .= $plot{'font'} . ' '; |
$gnuplot_input .= 'transparent ' if ($Apache::lonplot::plot{'transparent'} eq 'on'); |
$gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' '; |
$gnuplot_input .= $Apache::lonplot::plot{'font'} . ' '; |
$gnuplot_input .= "@Colors\n"; |
$gnuplot_input .= 'size '.$Apache::lonplot::plot{'width'}.','.$Apache::lonplot::plot{'height'}.' '; |
|
$gnuplot_input .= "@Colors\n"; |
|
# set output |
|
$gnuplot_input .= "set output\n"; |
|
} elsif ($target eq 'tex') { |
|
$gnuplot_input .= "set term postscript eps $Apache::lonplot::plot{'plotcolor'} solid \"Helvetica\" $pt \n"; |
|
$gnuplot_input .= "set output \"/home/httpd/perl/tmp/". |
|
&Apache::lonnet::unescape($filename).".eps\"\n"; |
|
} |
|
# cartesian or polar? |
|
if (lc($Apache::lonplot::plot{'plottype'}) eq 'polar') { |
|
$gnuplot_input .= 'set polar'.$/; |
|
} else { |
|
# Assume Cartesian |
|
} |
|
# solid or pattern for boxes? |
|
if (lc($Apache::lonplot::plot{'fillstyle'}) eq 'solid') { |
|
$gnuplot_input .= 'set style fill solid '. |
|
$Apache::lonplot::plot{'solid'}.$Apache::lonplot::plot{'box_border'}.$/; |
|
} elsif (lc($Apache::lonplot::plot{'fillstyle'}) eq 'pattern') { |
|
$gnuplot_input .= 'set style fill pattern '.$Apache::lonplot::plot{'pattern'}.$Apache::lonplot::plot{'box_border'}.$/; |
|
} elsif (lc($Apache::lonplot::plot{'fillstyle'}) eq 'empty') { |
|
} |
|
# margin |
|
if (lc($Apache::lonplot::plot{'lmargin'}) ne 'default') { |
|
$gnuplot_input .= 'set lmargin '.$Apache::lonplot::plot{'lmargin'}.$/; |
|
} |
|
if (lc($Apache::lonplot::plot{'rmargin'}) ne 'default') { |
|
$gnuplot_input .= 'set rmargin '.$Apache::lonplot::plot{'rmargin'}.$/; |
|
} |
|
if (lc($Apache::lonplot::plot{'tmargin'}) ne 'default') { |
|
$gnuplot_input .= 'set tmargin '.$Apache::lonplot::plot{'tmargin'}.$/; |
|
} |
|
if (lc($Apache::lonplot::plot{'bmargin'}) ne 'default') { |
|
$gnuplot_input .= 'set bmargin '.$Apache::lonplot::plot{'bmargin'}.$/; |
|
} |
|
# tic scales |
|
$gnuplot_input .= 'set ticscale '. |
|
$Apache::lonplot::plot{'major_ticscale'}.' '.$Apache::lonplot::plot{'minor_ticscale'}.$/; |
|
#boxwidth |
|
if (lc($Apache::lonplot::plot{'boxwidth'}) ne '') { |
|
$gnuplot_input .= 'set boxwidth '.$Apache::lonplot::plot{'boxwidth'}.$/; |
|
} |
|
# gridlayer |
|
$gnuplot_input .= 'set grid noxtics noytics front '.$/ |
|
if ($Apache::lonplot::plot{'gridlayer'} eq 'on'); |
|
|
# grid |
# grid |
$gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on'); |
$gnuplot_input .= 'set grid'.$/ if ($Apache::lonplot::plot{'grid'} eq 'on'); |
# border |
# border |
$gnuplot_input .= ($plot{'border'} eq 'on'? |
$gnuplot_input .= ($Apache::lonplot::plot{'border'} eq 'on'? |
'set border'.$/ : |
'set border'.$/ : |
'set noborder'.$/ ); # title, xlabel, ylabel |
'set noborder'.$/ ); |
{ |
# sampling rate for non-data curves |
$gnuplot_input .= <<"ENDLABELS"; |
$gnuplot_input .= "set samples $Apache::lonplot::plot{'samples'}\n"; |
set output |
# title, xlabel, ylabel |
set title "$title" |
# titles |
set xlabel "$xlabel" |
if ($target eq 'tex') { |
set ylabel "$ylabel" |
$gnuplot_input .= "set title \"$title\" font \"Helvetica,".$pt."pt\"\n" if (defined($title)) ; |
set xrange \[$axis{'xmin'}:$axis{'xmax'}\] |
$gnuplot_input .= "set xlabel \"$xlabel\" font \"Helvetica,".$pt."pt\" \n" if (defined($xlabel)); |
set yrange \[$axis{'ymin'}:$axis{'ymax'}\] |
$gnuplot_input .= "set ylabel \"$ylabel\" font \"Helvetica,".$pt."pt\"\n" if (defined($ylabel)); |
ENDLABELS |
} else { |
|
$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 ($xtics{'minorfreq'} != 0) { |
|
$gnuplot_input .= "set mxtics ".$xtics{'minorfreq'}."\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"; |
|
if ($ytics{'minorfreq'} != 0) { |
|
$gnuplot_input .= "set mytics ".$ytics{'minorfreq'}."\n"; |
|
} |
|
} |
|
# axis |
|
if (%axis) { |
|
$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; |
|
$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; |
} |
} |
# Key |
# Key |
if (defined($key{'pos'})) { |
if (%key) { |
$gnuplot_input .= 'set key '.$key{'pos'}.' '; |
$gnuplot_input .= 'set key '.$key{'pos'}.' '; |
if ($key{'title'} ne '') { |
if ($key{'title'} ne '') { |
$gnuplot_input .= 'title "'.$key{'title'}.'" '; |
$gnuplot_input .= 'title "'.$key{'title'}.'" '; |
Line 464 ENDLABELS
|
Line 1201 ENDLABELS
|
$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; |
$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; |
} else { |
} else { |
$gnuplot_input .= 'set nokey'.$/; |
$gnuplot_input .= 'set nokey'.$/; |
} |
} |
# labels |
# labels |
my $label; |
my $label; |
foreach $label (@labels) { |
foreach $label (@labels) { |
$gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. |
$gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. |
$label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ; |
$label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}; |
} |
if ($target eq 'tex') { |
|
$gnuplot_input .=' font "Helvetica,'.$pt.'pt"' ; |
|
} |
|
$gnuplot_input .= $/; |
|
} |
|
if ($target eq 'tex') { |
|
$gnuplot_input .="set size 1,".$Apache::lonplot::plot{'height'}/$Apache::lonplot::plot{'width'}*1.38; |
|
$gnuplot_input .="\n"; |
|
} |
# curves |
# curves |
$gnuplot_input .= 'plot '; |
$gnuplot_input .= 'plot '; |
my $datatext = ''; |
|
for (my $i = 0;$i<=$#curves;$i++) { |
for (my $i = 0;$i<=$#curves;$i++) { |
$curve = $curves[$i]; |
$curve = $curves[$i]; |
$gnuplot_input.= ', ' if ($i > 0); |
$gnuplot_input.= ', ' if ($i > 0); |
Line 481 ENDLABELS
|
Line 1225 ENDLABELS
|
$gnuplot_input.= |
$gnuplot_input.= |
$curve->{'function'}.' title "'. |
$curve->{'function'}.' title "'. |
$curve->{'name'}.'" with '. |
$curve->{'name'}.'" with '. |
$curve->{'linestyle'}; |
$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 ($curve->{'linestyle'} eq 'filledcurves') { |
|
$gnuplot_input.= ' '.$curve->{'limit'}; |
|
} |
} elsif (exists($curve->{'data'})) { |
} elsif (exists($curve->{'data'})) { |
$gnuplot_input.= '\'-\' title "'. |
# Store data values in $datatext |
$curve->{'name'}.'" with '. |
my $datatext = ''; |
$curve->{'linestyle'}; |
# get new filename |
|
my $datafilename = "$tmpdir/$filename.data.$i"; |
|
my $fh=Apache::File->new(">$datafilename"); |
|
# Compile data |
my @Data = @{$curve->{'data'}}; |
my @Data = @{$curve->{'data'}}; |
my @Data0 = @{$Data[0]}; |
my @Data0 = @{$Data[0]}; |
for (my $i =0; $i<=$#Data0; $i++) { |
for (my $i =0; $i<=$#Data0; $i++) { |
Line 495 ENDLABELS
|
Line 1254 ENDLABELS
|
} |
} |
$datatext .= $/; |
$datatext .= $/; |
} |
} |
$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'}; |
|
} elsif ($curve->{'linestyle'} eq 'filledcurves') { |
|
$gnuplot_input.= ' '.$curve->{'limit'}; |
|
} |
} |
} |
} |
} |
$gnuplot_input .= $/.$datatext; |
# Write the output to a file. |
return $gnuplot_input; |
my $fh=Apache::File->new(">$tmpdir$filename.data"); |
# print $fh $gnuplot_input; |
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 (! %Apache::lonplot::plot) { &set_defaults(\%Apache::lonplot::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_or_text_arg |
|
($description,$attr,$defaults->{$attr}->{'choices'},$token); |
|
} elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') { |
|
$result .= &Apache::edit::select_or_text_arg |
|
($description,$attr,['on','off'],$token); |
|
} |
|
$result .= '<br />'; |
|
} |
|
return $result; |
} |
} |
|
|
1; |
|
__END__ |
|
|
|
|
################################################################### |
|
## ## |
|
## 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; |
|
} |
|
|
|
##---------------------------------------------------------------------- |
|
1; |
|
__END__ |
|
|
|
|