version 1.22, 2001/12/28 19:04:56
|
version 1.43, 2002/01/21 17:23:31
|
Line 26
|
Line 26
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# 12/15/01 Matthew |
# 12/15/01 Matthew |
# 12/17 12/18 12/19 12/20 12/21 12/27 12/28 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 Matthew |
|
|
package Apache::lonplot; |
package Apache::lonplot; |
|
|
use strict; |
use strict; |
Line 35 use Apache::response;
|
Line 39 use Apache::response;
|
use Apache::lonxml; |
use Apache::lonxml; |
use Apache::edit; |
use Apache::edit; |
|
|
sub BEGIN { |
BEGIN { |
&Apache::lonxml::register('Apache::lonplot',('plot')); |
&Apache::lonxml::register('Apache::lonplot',('plot')); |
} |
} |
|
|
Line 69 sub BEGIN {
|
Line 73 sub BEGIN {
|
## 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, |
|
# boxerrorbars => [3,4,5], |
|
# boxxyerrorbars => [4,6,7], |
|
# financebars => 5, |
|
# candlesticks => 5, |
|
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 = |
my $real_test = |
sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; |
sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; |
Line 76 my $color_test = sub {$_[0]=~s/\s+//
|
Line 105 my $color_test = sub {$_[0]=~s/\s+//
|
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\(\)]+ ?)+$/}; |
|
|
################################################################### |
################################################################### |
Line 84 my $words_test = sub {$_[0]=~s/\s+/
|
Line 113 my $words_test = sub {$_[0]=~s/\s+/
|
## Attribute metadata ## |
## Attribute metadata ## |
## ## |
## ## |
################################################################### |
################################################################### |
|
my @plot_edit_order = |
|
qw/bgcolor fgcolor height width font transparent grid border align/; |
my %plot_defaults = |
my %plot_defaults = |
( |
( |
height => { |
height => { |
default => 200, |
default => 200, |
test => $int_test, |
test => $int_test, |
description => 'vertical size of image (pixels)', |
description => 'height of image (pixels)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
width => { |
width => { |
default => 200, |
default => 200, |
test => $int_test, |
test => $int_test, |
description => 'horizontal size of image (pixels)', |
description => 'width of image (pixels)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
bgcolor => { |
bgcolor => { |
default => 'xffffff', |
default => 'xffffff', |
test => $color_test, |
test => $color_test, |
description => 'background color of image (xffffff)', |
description => 'background color of image (xffffff)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
fgcolor => { |
fgcolor => { |
default => 'x000000', |
default => 'x000000', |
test => $color_test, |
test => $color_test, |
description => 'foreground color of image (x000000)', |
description => 'foreground color of image (x000000)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
transparent => { |
transparent => { |
default => 'off', |
default => 'off', |
test => $onoff_test, |
test => $onoff_test, |
description => '', |
description => 'Transparent image', |
edit_type => 'on_off' |
edit_type => 'on_off' |
}, |
}, |
grid => { |
grid => { |
default => 'off', |
default => 'off', |
test => $onoff_test, |
test => $onoff_test, |
description => '', |
description => 'Display grid', |
edit_type => 'on_off' |
edit_type => 'on_off' |
}, |
}, |
border => { |
border => { |
default => 'on', |
default => 'on', |
test => $onoff_test, |
test => $onoff_test, |
description => '', |
description => 'Draw border around plot', |
edit_type => 'on_off' |
edit_type => 'on_off' |
}, |
}, |
font => { |
font => { |
Line 150 my %key_defaults =
|
Line 185 my %key_defaults =
|
default => '', |
default => '', |
test => $words_test, |
test => $words_test, |
description => 'Title of key', |
description => 'Title of key', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '40' |
}, |
}, |
box => { |
box => { |
default => 'off', |
default => 'off', |
Line 174 my %label_defaults =
|
Line 210 my %label_defaults =
|
default => 0, |
default => 0, |
test => $real_test, |
test => $real_test, |
description => 'x position of label (graph coordinates)', |
description => 'x position of label (graph coordinates)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
ypos => { |
ypos => { |
default => 0, |
default => 0, |
test => $real_test, |
test => $real_test, |
description => 'y position of label (graph coordinates)', |
description => 'y position of label (graph coordinates)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
justify => { |
justify => { |
default => 'left', |
default => 'left', |
Line 193 my %label_defaults =
|
Line 231 my %label_defaults =
|
|
|
my %axis_defaults = |
my %axis_defaults = |
( |
( |
color => { |
color => { |
default => 'x000000', |
default => 'x000000', |
test => $color_test, |
test => $color_test, |
description => 'color of axes (x000000)', |
description => 'color of axes (x000000)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
xmin => { |
xmin => { |
default => '-10.0', |
default => '-10.0', |
test => $real_test, |
test => $real_test, |
description => 'minimum x-value shown in plot', |
description => 'minimum x-value shown in plot', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
xmax => { |
xmax => { |
default => ' 10.0', |
default => ' 10.0', |
test => $real_test, |
test => $real_test, |
description => 'maximum x-value shown in plot', |
description => 'maximum x-value shown in plot', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
ymin => { |
ymin => { |
default => '-10.0', |
default => '-10.0', |
test => $real_test, |
test => $real_test, |
description => 'minimum y-value shown in plot', |
description => 'minimum y-value shown in plot', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
ymax => { |
ymax => { |
default => ' 10.0', |
default => ' 10.0', |
test => $real_test, |
test => $real_test, |
description => 'maximum y-value shown in plot', |
description => 'maximum y-value shown in plot', |
edit_type => 'entry' |
edit_type => 'entry', |
}, |
size => '10' |
linestyle => { |
|
default => 'points', |
|
test => $linestyle_test, |
|
description => 'Style of the axis lines', |
|
edit_type => 'choice', |
|
choices => ['lines','linespoints','dots','points'] |
|
} |
} |
); |
); |
|
|
Line 238 my %curve_defaults =
|
Line 274 my %curve_defaults =
|
default => 'x000000', |
default => 'x000000', |
test => $color_test, |
test => $color_test, |
description => 'color of curve (x000000)', |
description => 'color of curve (x000000)', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '10' |
}, |
}, |
name => { |
name => { |
default => '', |
default => '', |
test => $words_test, |
test => $words_test, |
description => 'name of curve to appear in key', |
description => 'name of curve to appear in key', |
edit_type => 'entry' |
edit_type => 'entry', |
|
size => '20' |
}, |
}, |
linestyle => { |
linestyle => { |
default => 'lines', |
default => 'lines', |
test => $linestyle_test, |
test => $linestyle_test, |
description => 'Style of the axis lines', |
description => 'Line style', |
edit_type => 'choice', |
edit_type => 'choice', |
choices => ['lines','linespoints','dots','points','steps'] |
choices => [keys(%linestyles)] |
} |
} |
); |
); |
|
|
Line 263 my %curve_defaults =
|
Line 301 my %curve_defaults =
|
my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves); |
my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves); |
|
|
sub start_plot { |
sub start_plot { |
%plot = undef; %key = undef; %axis = undef; |
%plot = (); %key = (); %axis = (); |
$title = undef; $xlabel = undef; $ylabel = undef; |
$title = undef; $xlabel = undef; $ylabel = undef; |
$#labels = -1; $#curves = -1; |
$#labels = -1; $#curves = -1; |
# |
# |
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', |
|
('title','xlabel','ylabel','key','axis','label','curve')); |
|
push (@Apache::lonxml::namespace,'lonplot'); |
if ($target eq 'web') { |
if ($target eq 'web') { |
&Apache::lonxml::register('Apache::lonplot', |
|
('title','xlabel','ylabel','key','axis','label','curve')); |
|
push (@Apache::lonxml::namespace,'plot'); |
|
## Always evaluate the insides of the <plot></plot> tags |
|
my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]); |
my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]); |
$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); |
$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); |
&Apache::lonxml::newparser($parser,\$inside); |
&Apache::lonxml::newparser($parser,\$inside); |
##------------------------------------------------------- |
|
&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval, |
&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Plot'); |
$result .= &edit_attributes($target,$token,\%plot_defaults); |
$result .= &edit_attributes($target,$token,\%plot_defaults, |
|
\@plot_edit_order); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $constructtag=&Apache::edit::get_new_args |
my $constructtag=&Apache::edit::get_new_args |
($token,$parstack,$safeeval,keys %plot_defaults); |
($token,$parstack,$safeeval,keys(%plot_defaults)); |
if ($constructtag) { |
if ($constructtag) { |
$result = &Apache::edit::rebuild_tag($token); |
$result = &Apache::edit::rebuild_tag($token); |
$result.= &Apache::edit::handle_insert(); |
|
} |
} |
} |
} |
return $result; |
return $result; |
Line 296 sub start_plot {
|
Line 332 sub start_plot {
|
|
|
sub end_plot { |
sub end_plot { |
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')); |
Line 306 sub end_plot {
|
Line 343 sub end_plot {
|
## Determine filename |
## Determine filename |
my $tmpdir = '/home/httpd/perl/tmp/'; |
my $tmpdir = '/home/httpd/perl/tmp/'; |
my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}. |
my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}. |
'_'.time.'_'.$$.'_plot.data'; |
'_'.time.'_'.$$.int(rand(1000)).'_plot.data'; |
## Write the plot description to the file |
## Write the plot description to the file |
my $fh=Apache::File->new(">$tmpdir$filename"); |
&write_gnuplot_file($tmpdir,$filename); |
print $fh &write_gnuplot_file(); |
|
close($fh); |
|
## return image tag for the plot |
## return image tag for the plot |
$result .= <<"ENDIMAGE"; |
$result .= <<"ENDIMAGE"; |
<img src = "/cgi-bin/plot.gif?$filename" |
<img src = "/cgi-bin/plot.gif?$filename" |
Line 333 sub start_key {
|
Line 368 sub start_key {
|
&get_attributes(\%key,\%key_defaults,$parstack,$safeeval, |
&get_attributes(\%key,\%key_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Plot Key'); |
$result .= &edit_attributes($target,$token,\%key_defaults); |
$result .= &edit_attributes($target,$token,\%key_defaults); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $constructtag=&Apache::edit::get_new_args |
my $constructtag=&Apache::edit::get_new_args |
($token,$parstack,$safeeval,keys %key_defaults); |
($token,$parstack,$safeeval,keys(%key_defaults)); |
if ($constructtag) { |
if ($constructtag) { |
$result = &Apache::edit::rebuild_tag($token); |
$result = &Apache::edit::rebuild_tag($token); |
$result.= &Apache::edit::handle_insert(); |
|
} |
} |
} |
} |
return $result; |
return $result; |
Line 362 sub start_title {
|
Line 396 sub start_title {
|
my $result=''; |
my $result=''; |
if ($target eq 'web') { |
if ($target eq 'web') { |
$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); |
$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); |
|
if (length($title) > $max_str_len) { |
|
$title = substr($title,0,$max_str_len); |
|
} |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result.=&Apache::edit::tag_start($target,$token); |
$result.=&Apache::edit::tag_start($target,$token,'Plot Title'); |
my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]); |
my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]); |
$result.='</td></tr><tr><td colspan="3">'. |
$result.=&Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $text=$$parser[-1]->get_text("/function"); |
my $text=$$parser[-1]->get_text("/title"); |
|
$result.=&Apache::edit::rebuild_tag($token); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
return $result; |
return $result; |
Line 390 sub start_xlabel {
|
Line 428 sub start_xlabel {
|
my $result=''; |
my $result=''; |
if ($target eq 'web') { |
if ($target eq 'web') { |
$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); |
$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); |
|
if (length($xlabel) > $max_str_len) { |
|
$xlabel = substr($xlabel,0,$max_str_len); |
|
} |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result.=&Apache::edit::tag_start($target,$token); |
$result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel'); |
my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); |
my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); |
$result.='</td></tr><tr><td colspan="3">'. |
$result.=&Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $text=$$parser[-1]->get_text("/function"); |
my $text=$$parser[-1]->get_text("/xlabel"); |
|
$result.=&Apache::edit::rebuild_tag($token); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
return $result; |
return $result; |
Line 419 sub start_ylabel {
|
Line 461 sub start_ylabel {
|
my $result=''; |
my $result=''; |
if ($target eq 'web') { |
if ($target eq 'web') { |
$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); |
$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); |
|
if (length($ylabel) > $max_str_len) { |
|
$ylabel = substr($ylabel,0,$max_str_len); |
|
} |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel'); |
my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); |
my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); |
$result .= '</td></tr><tr><td colspan="3">'. |
$result .= &Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $text=$$parser[-1]->get_text("/function"); |
my $text=$$parser[-1]->get_text("/ylabel"); |
|
$result.=&Apache::edit::rebuild_tag($token); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
return $result; |
return $result; |
Line 450 sub start_label {
|
Line 496 sub start_label {
|
my %label; |
my %label; |
&get_attributes(\%label,\%label_defaults,$parstack,$safeeval, |
&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[-1]); |
if (! &$words_test($label{'text'})) { |
$text = substr($text,0,$max_str_len) if (length($text) > $max_str_len); |
# I should probably warn about it, too. |
$label{'text'} = $text; |
$label{'text'} = 'Illegal text'; |
|
} |
|
push(@labels,\%label); |
push(@labels,\%label); |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Plot Label'); |
$result .= &edit_attributes($target,$token,\%label_defaults); |
$result .= &edit_attributes($target,$token,\%label_defaults); |
my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); |
my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); |
$result .= '</td></tr><tr><td colspan="3">'. |
$result .= &Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $constructtag=&Apache::edit::get_new_args |
&Apache::edit::get_new_args |
($token,$parstack,$safeeval,keys %label_defaults); |
($token,$parstack,$safeeval,keys(%label_defaults)); |
if ($constructtag) { |
$result.=&Apache::edit::rebuild_tag($token); |
$result = &Apache::edit::rebuild_tag($token); |
|
$result.= &Apache::edit::handle_insert(); |
|
} |
|
my $text=$$parser[-1]->get_text("/label"); |
my $text=$$parser[-1]->get_text("/label"); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
Line 490 sub end_label {
|
Line 531 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=''; |
|
&Apache::lonxml::register('Apache::lonplot',('function','data')); |
|
push (@Apache::lonxml::namespace,'curve'); |
if ($target eq 'web') { |
if ($target eq 'web') { |
my %curve; |
my %curve; |
&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, |
&get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
push (@curves,\%curve); |
push (@curves,\%curve); |
&Apache::lonxml::register('Apache::lonplot',('function','data')); |
|
push (@Apache::lonxml::namespace,'curve'); |
|
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Curve'); |
$result .= &edit_attributes($target,$token,\%curve_defaults); |
$result .= &edit_attributes($target,$token,\%curve_defaults); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
my $constructtag=&Apache::edit::get_new_args |
my $constructtag=&Apache::edit::get_new_args |
($token,$parstack,$safeeval,keys %label_defaults); |
($token,$parstack,$safeeval,keys(%curve_defaults)); |
if ($constructtag) { |
if ($constructtag) { |
$result = &Apache::edit::rebuild_tag($token); |
$result = &Apache::edit::rebuild_tag($token); |
$result.= &Apache::edit::handle_insert(); |
$result.= &Apache::edit::handle_insert(); |
Line 514 sub start_curve {
|
Line 555 sub start_curve {
|
sub end_curve { |
sub end_curve { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result = ''; |
my $result = ''; |
|
pop @Apache::lonxml::namespace; |
|
&Apache::lonxml::deregister('Apache::lonplot',('function','data')); |
if ($target eq 'web') { |
if ($target eq 'web') { |
pop @Apache::lonxml::namespace; |
|
&Apache::lonxml::deregister('Apache::lonplot',('function','data')); |
|
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result.=&Apache::edit::tag_end($target,$token); |
$result.=&Apache::edit::tag_end($target,$token); |
} |
} |
Line 535 sub start_function {
|
Line 576 sub start_function {
|
$curves[-1]->{'function'} = |
$curves[-1]->{'function'} = |
&Apache::lonxml::get_all_text("/function",$$parser[-1]); |
&Apache::lonxml::get_all_text("/function",$$parser[-1]); |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); |
my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]); |
my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]); |
$result .= '</td></tr><tr><td colspan="3">'. |
$result .= &Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
|
|
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
# Why do I do this? |
$result.=&Apache::edit::rebuild_tag($token); |
my $text=$$parser[-1]->get_text("/function"); |
my $text=$$parser[-1]->get_text("/function"); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
Line 554 sub end_function {
|
Line 594 sub end_function {
|
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web') { |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
|
$result .= &Apache::edit::end_table(); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 570 sub start_data {
|
Line 611 sub start_data {
|
delete($curves[-1]->{'function'}); |
delete($curves[-1]->{'function'}); |
} |
} |
my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); |
my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); |
|
# Deal with cases where we're given an array... |
|
if ($datatext =~ /^\@/) { |
|
$datatext = &Apache::run::run('return "'.$datatext.'"', |
|
$safeeval,1); |
|
} |
$datatext =~ s/\s+/ /g; |
$datatext =~ s/\s+/ /g; |
# Need to do some error checking on the @data array - |
# Need to do some error checking on the @data array - |
# make sure it's all numbers and make sure each array |
# make sure it's all numbers and make sure each array |
# is of the same length. |
# is of the same length. |
my @data; |
my @data; |
if ($datatext =~ /,/) { |
if ($datatext =~ /,/) { # comma deliminated |
@data = split /,/,$datatext; |
@data = split /,/,$datatext; |
} else { # Assume it's space seperated. |
} else { # Assume it's space seperated. |
@data = split / /,$datatext; |
@data = split / /,$datatext; |
Line 596 sub start_data {
|
Line 642 sub start_data {
|
$data[$i] = 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; |
push @{$curves[-1]->{'data'}},\@data; |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data'); |
my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]); |
my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]); |
$result .= '</td></tr><tr><td colspan="3">'. |
$result .= &Apache::edit::end_row(). |
&Apache::edit::editfield('',$text,'',20,1). |
&Apache::edit::start_spanning_row(). |
&Apache::edit::end_table(); |
&Apache::edit::editfield('',$text,'',60,1); |
} elsif ($target eq 'modified') { |
} elsif ($target eq 'modified') { |
|
$result.=&Apache::edit::rebuild_tag($token); |
my $text=$$parser[-1]->get_text("/data"); |
my $text=$$parser[-1]->get_text("/data"); |
$result.=&Apache::edit::modifiedfield($token); |
$result.=&Apache::edit::modifiedfield($token); |
} |
} |
Line 615 sub end_data {
|
Line 669 sub end_data {
|
my $result = ''; |
my $result = ''; |
if ($target eq 'web') { |
if ($target eq 'web') { |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
|
$result .= &Apache::edit::end_table(); |
} |
} |
return $result; |
return $result; |
} |
} |
Line 627 sub start_axis {
|
Line 682 sub start_axis {
|
&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, |
&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, |
$tagstack->[-1]); |
$tagstack->[-1]); |
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result .= &Apache::edit::tag_start($target,$token); |
$result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); |
$result .= &edit_attributes($target,$token,\%axis_defaults); |
$result .= &edit_attributes($target,$token,\%axis_defaults); |
} elsif ($target eq 'modified') { |
} 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 641 sub end_axis {
|
Line 701 sub end_axis {
|
} elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
$result.=&Apache::edit::tag_end($target,$token); |
$result.=&Apache::edit::tag_end($target,$token); |
} elsif ($target eq 'modified') { |
} 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); |
|
$result.= &Apache::edit::handle_insert(); |
|
} |
|
} |
} |
return $result; |
return $result; |
} |
} |
Line 661 sub end_axis {
|
Line 715 sub end_axis {
|
sub set_defaults { |
sub set_defaults { |
my ($var,$defaults) = @_; |
my ($var,$defaults) = @_; |
my $key; |
my $key; |
foreach $key (keys %$defaults) { |
foreach $key (keys(%$defaults)) { |
$var->{$key} = $defaults->{$key}->{'default'}; |
$var->{$key} = $defaults->{$key}->{'default'}; |
} |
} |
} |
} |
Line 669 sub set_defaults {
|
Line 723 sub set_defaults {
|
##------------------------------------------------------------------- misc |
##------------------------------------------------------------------- misc |
sub get_attributes{ |
sub get_attributes{ |
my ($values,$defaults,$parstack,$safeeval,$tag) = @_; |
my ($values,$defaults,$parstack,$safeeval,$tag) = @_; |
foreach my $attr (keys %{$defaults}) { |
foreach my $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})) { |
Line 686 sub get_attributes{
|
Line 740 sub get_attributes{
|
} |
} |
return ; |
return ; |
} |
} |
|
|
##------------------------------------------------------- write_gnuplot_file |
##------------------------------------------------------- write_gnuplot_file |
sub write_gnuplot_file { |
sub write_gnuplot_file { |
|
my ($tmpdir,$filename)= @_; |
my $gnuplot_input = ''; |
my $gnuplot_input = ''; |
my $curve; |
my $curve; |
# Collect all the colors |
# Collect all the colors |
Line 716 sub write_gnuplot_file {
|
Line 772 sub write_gnuplot_file {
|
$gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ; |
$gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ; |
$gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel)); |
$gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel)); |
$gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel)); |
$gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel)); |
if (defined(%axis)) { |
if (%axis) { |
$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; |
$gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; |
$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; |
$gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; |
} |
} |
# Key |
# Key |
if (defined(%key)) { |
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'}.'" '; |
} |
} |
$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; |
$gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; |
} else { |
} else { |
Line 738 sub write_gnuplot_file {
|
Line 794 sub write_gnuplot_file {
|
} |
} |
# 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 748 sub write_gnuplot_file {
|
Line 803 sub write_gnuplot_file {
|
$curve->{'name'}.'" with '. |
$curve->{'name'}.'" with '. |
$curve->{'linestyle'}; |
$curve->{'linestyle'}; |
} 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.$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 760 sub write_gnuplot_file {
|
Line 818 sub write_gnuplot_file {
|
} |
} |
$datatext .= $/; |
$datatext .= $/; |
} |
} |
$datatext .=$/; |
# write file |
|
print $fh $datatext; |
|
close ($fh); |
|
# generate gnuplot text |
|
$gnuplot_input.= '"'.$datafilename.'" title "'. |
|
$curve->{'name'}.'" with '. |
|
$curve->{'linestyle'}; |
} |
} |
} |
} |
$gnuplot_input .= $/.$datatext; |
# Write the output to a file. |
return $gnuplot_input; |
my $fh=Apache::File->new(">$tmpdir$filename"); |
|
print $fh $gnuplot_input; |
|
close($fh); |
|
# That's all folks. |
|
return ; |
} |
} |
|
|
#---------------------------------------------- check_inputs |
#---------------------------------------------- check_inputs |
sub check_inputs { |
sub check_inputs { |
## Note: no inputs, no outputs - this acts only on global variables. |
## Note: no inputs, no outputs - this acts only on global variables. |
## Make sure we have all the input we need: |
## Make sure we have all the input we need: |
if (! defined(%plot )) { &set_defaults(\%plot,\%plot_defaults); } |
if (! %plot) { &set_defaults(\%plot,\%plot_defaults); } |
if (! defined(%key )) {} # No key for this plot, thats okay |
if (! %key ) {} # No key for this plot, thats okay |
if (! defined(%axis )) { &set_defaults(\%axis,\%axis_defaults); } |
# if (! %axis) { &set_defaults(\%axis,\%axis_defaults); } |
if (! defined($title )) {} # No title for this plot, thats okay |
if (! defined($title )) {} # No title for this plot, thats okay |
if (! defined($xlabel)) {} # No xlabel 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 (! defined($ylabel)) {} # No ylabel for this plot, thats okay |
Line 793 sub check_inputs {
|
Line 861 sub check_inputs {
|
|
|
#------------------------------------------------ make_edit |
#------------------------------------------------ make_edit |
sub edit_attributes { |
sub edit_attributes { |
my ($target,$token,$defaults) = @_; |
my ($target,$token,$defaults,$keys) = @_; |
my $result; |
my ($result,@keys); |
foreach my $attr (%$defaults) { |
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') { |
if ($defaults->{$attr}->{'edit_type'} eq 'entry') { |
$result .= &Apache::edit::text_arg( |
$result .= &Apache::edit::text_arg |
$defaults->{$attr}->{'description'}, |
($description,$attr,$token, |
$attr, |
$defaults->{$attr}->{'size'}); |
$token); |
|
} elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { |
} elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { |
$result .= &Apache::edit::select_arg( |
$result .= &Apache::edit::select_arg |
$defaults->{$attr}->{'description'}, |
($description,$attr,$defaults->{$attr}->{'choices'},$token); |
$attr, |
} elsif ($defaults->{$attr}->{'edit_type'} eq 'on_off') { |
$defaults->{$attr}->{'choices'}, |
$result .= &Apache::edit::select_arg |
$token); |
($description,$attr,['on','off'],$token); |
} |
} |
|
$result .= '<br />'; |
} |
} |
return $result; |
return $result; |
} |
} |
Line 821 sub edit_attributes {
|
Line 897 sub edit_attributes {
|
|
|
#------------------------------------------------ insert_xxxxxxx |
#------------------------------------------------ insert_xxxxxxx |
sub insert_plot { |
sub insert_plot { |
my $result; |
my $result = ''; |
# plot attributes |
# plot attributes |
$result .= '<plot '; |
$result .= "<plot \n"; |
foreach my $attr (%plot_defaults) { |
foreach my $attr (keys(%plot_defaults)) { |
$result .= ' '.$attr.' "'.$plot_defaults{$attr}->{'default'}. |
$result .= " $attr=\"$plot_defaults{$attr}->{'default'}\"\n"; |
"\"\n"; |
|
} |
} |
$result .= ">\n"; |
$result .= ">\n"; |
# Add the components |
# Add the components |
$result .= &insert_key(); |
$result .= &insert_key(); |
$result .= &insert_axis(); |
$result .= &insert_axis(); |
$result .= &insert_label(); |
$result .= &insert_title(); |
|
$result .= &insert_xlabel(); |
|
$result .= &insert_ylabel(); |
$result .= &insert_curve(); |
$result .= &insert_curve(); |
$result .= &insert_function(); |
|
$result .= "</curve>\n"; |
|
$result .= &insert_curve(); |
|
$result .= &insert_data(); |
|
$result .= "</curve>\n"; |
|
# close up the <plot> |
# close up the <plot> |
$result .= "</plot>\n"; |
$result .= "</plot>\n"; |
return $result; |
return $result; |
Line 846 sub insert_plot {
|
Line 918 sub insert_plot {
|
|
|
sub insert_key { |
sub insert_key { |
my $result; |
my $result; |
$result .= ' <key '; |
$result .= " <key \n"; |
foreach my $attr (%key_defaults) { |
foreach my $attr (keys(%key_defaults)) { |
$result .= ' '.$attr.' "'.$key_defaults{$attr}->{'default'}. |
$result .= " $attr=\"$key_defaults{$attr}->{'default'}\"\n"; |
"\"\n"; |
|
} |
} |
$result .= " />\n"; |
$result .= " />\n"; |
return $result; |
return $result; |
Line 858 sub insert_key {
|
Line 929 sub insert_key {
|
sub insert_axis{ |
sub insert_axis{ |
my $result; |
my $result; |
$result .= ' <axis '; |
$result .= ' <axis '; |
foreach my $attr (%axis_defaults) { |
foreach my $attr (keys(%axis_defaults)) { |
$result .= ' '.$attr.' "'.$axis_defaults{$attr}->{'default'}. |
$result .= " $attr=\"$axis_defaults{$attr}->{'default'}\"\n"; |
"\"\n"; |
|
} |
} |
$result .= " />\n"; |
$result .= " />\n"; |
return $result; |
return $result; |
} |
} |
|
|
|
sub insert_title { return " <title></title>\n"; } |
|
sub insert_xlabel { return " <xlabel></xlabel>\n"; } |
|
sub insert_ylabel { return " <ylabel></ylabel>\n"; } |
|
|
sub insert_label { |
sub insert_label { |
my $result; |
my $result; |
$result .= ' <label '; |
$result .= ' <label '; |
foreach my $attr (%label_defaults) { |
foreach my $attr (keys(%label_defaults)) { |
$result .= ' '.$attr.' "'. |
$result .= ' '.$attr.'="'. |
$label_defaults{$attr}->{'default'}."\"\n"; |
$label_defaults{$attr}->{'default'}."\"\n"; |
} |
} |
$result .= " ></label>\n"; |
$result .= " ></label>\n"; |
Line 879 sub insert_label {
|
Line 953 sub insert_label {
|
|
|
sub insert_curve { |
sub insert_curve { |
my $result; |
my $result; |
$result .= ' <curve '; |
$result .= "\n <curve "; |
foreach my $attr (%curve_defaults) { |
foreach my $attr (keys(%curve_defaults)) { |
$result .= ' '.$attr.' "'. |
$result .= ' '.$attr.'="'. |
$curve_defaults{$attr}->{'default'}."\"\n"; |
$curve_defaults{$attr}->{'default'}."\"\n"; |
} |
} |
$result .= " >\n"; |
$result .= " >\n"; |
|
$result .= &insert_data().&insert_data()."</curve>\n"; |
} |
} |
|
|
sub insert_function { |
sub insert_function { |
Line 896 sub insert_function {
|
Line 971 sub insert_function {
|
sub insert_data { |
sub insert_data { |
my $result; |
my $result; |
$result .= " <data></data>\n"; |
$result .= " <data></data>\n"; |
$result .= " <data></data>\n"; |
|
return $result; |
return $result; |
} |
} |
|
|