--- loncom/xml/lonplot.pm 2013/01/21 02:25:38 1.171
+++ loncom/xml/lonplot.pm 2022/09/21 11:49:48 1.185
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Dynamic plot
#
-# $Id: lonplot.pm,v 1.171 2013/01/21 02:25:38 raeburn Exp $
+# $Id: lonplot.pm,v 1.185 2022/09/21 11:49:48 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,10 +39,11 @@ use Apache::response;
use Apache::lonxml;
use Apache::edit;
use Apache::lonnet;
+use Apache::lonlocal;
+use Time::HiRes qw(gettimeofday);
use LONCAPA;
-
-use vars qw/$weboutputformat $version/;
+use vars qw/$weboutputformat $version $colorprefix/;
@@ -56,7 +57,10 @@ BEGIN {
if ($version >= 4) {
$weboutputformat = 'png';
}
-
+ $colorprefix = 'x';
+ if ($version >= 4.6) {
+ $colorprefix = '#';
+ }
}
@@ -78,7 +82,7 @@ BEGIN {
## align
##
## @labels: $labels[$i] = \%label
-## %label: text, xpos, ypos, justify
+## %label: text, xpos, ypos, justify, rotate, zlayer
##
## @curves: $curves[$i] = \%curve
## %curve: name, linestyle, ( function | data )
@@ -105,7 +109,7 @@ my %linetypes = # For png use these li
);
my %ps_linetypes = # For ps the line types are different!
(
- solid => 0,
+ solid => 1,
dashed => 7
);
@@ -134,9 +138,9 @@ my $pos_real_test =
sub {$_[0]=~s/\s+//g;$_[0]=~/^[+]?\d*\.?\d*([eE][+-]\d+)?$/};
my $color_test;
if ($version < 4.6) {
- $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~s/^\#/x/;$_[0]=~/^x[\da-fA-F]{6}$/};
+ $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~s/^\#/x/;$_[0]=~s/^x+/x/;$_[0]=~/^x[\da-fA-F]{6}$/};
} else {
- $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~s/^x/#/;$_[0]=~/^\#[\da-fA-F]{6}$/};
+ $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~s/^x/#/;$_[0]=~s/^\#+/#/;$_[0]=~/^\#[\da-fA-F]{6}$/};
}
my $onoff_test = sub {$_[0]=~/^(on|off)$/};
my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
@@ -186,17 +190,17 @@ my %gnuplot_defaults =
size => '10'
},
bgcolor => {
- default => 'xffffff',
- test => $color_test,
- description => 'Background color of image (xffffff)',
+ default => $colorprefix.'ffffff',
+ test => $color_test,
+ description => 'Background color of image ('.$colorprefix.'ffffff)',
edit_type => 'entry',
size => '10',
class => 'colorchooser'
},
fgcolor => {
- default => 'x000000',
+ default => $colorprefix.'000000',
test => $color_test,
- description => 'Foreground color of image (x000000)',
+ description => 'Foreground color of image ('.$colorprefix.'000000)',
edit_type => 'entry',
size => '10',
class => 'colorchooser'
@@ -258,7 +262,7 @@ my %gnuplot_defaults =
test => sub {$_[0]=~/^(left|right|middle|center)$/},
description => 'Alignment for image in HTML',
edit_type => 'choice',
- choices => ['left','right','middle']
+ choices => ['left','right','middle','center']
},
texwidth => {
default => '93',
@@ -367,6 +371,7 @@ my %gnuplot_defaults =
},
);
+
my %key_defaults =
(
title => {
@@ -421,7 +426,14 @@ my %label_defaults =
description => 'Rotation of label (degrees)',
edit_type => 'entry',
size => '10',
- }
+ },
+ zlayer => {
+ default => '',
+ test => sub {$_[0]=~/^(front|back)$/},
+ description => 'Z position of label',
+ edit_type => 'choice',
+ choices => ['front','back'],
+ },
);
my @tic_edit_order = ('location','mirror','start','increment','end',
@@ -481,9 +493,9 @@ my @axis_edit_order = ('color','xmin','x
my %axis_defaults =
(
color => {
- default => 'x000000',
+ default => $colorprefix.'000000',
test => $color_test,
- description => 'Color of grid lines (x000000)',
+ description => 'Color of grid lines ('.$colorprefix.'000000)',
edit_type => 'entry',
size => '10',
class => 'colorchooser'
@@ -518,14 +530,14 @@ my %axis_defaults =
},
xformat => {
default => 'on',
- test => sub {$_[0]=~/^(on|off|\d+(f|F|e|E))$/},
+ test => sub {$_[0]=~/^(on|off|\d+(f|F|e|E|P(|\s*[Pp][Ii])))$/},
description => 'X-axis number formatting',
edit_type => 'choice',
choices => ['on', 'off', '2e', '2f'],
},
yformat => {
default => 'on',
- test => sub {$_[0]=~/^(on|off|\d+(f|F|e|E))$/},
+ test => sub {$_[0]=~/^(on|off|\d+(f|F|e|E|P(|\s*[Pp][Ii])))$/},
description => 'Y-axis number formatting',
edit_type => 'choice',
choices => ['on', 'off', '2e', '2f'],
@@ -557,9 +569,9 @@ my @curve_edit_order = ('color','name','
my %curve_defaults =
(
color => {
- default => 'x000000',
+ default => $colorprefix.'000000',
test => $color_test,
- description => 'Color of curve (x000000)',
+ description => 'Color of curve ('.$colorprefix.'000000)',
edit_type => 'entry',
size => '10',
class => 'colorchooser'
@@ -671,6 +683,7 @@ sub start_gnuplot {
#
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
+
&Apache::lonxml::register('Apache::lonplot',
('title','xlabel','ylabel','key','axis','label','curve',
'xtics','ytics'));
@@ -679,6 +692,7 @@ sub start_gnuplot {
&get_attributes(\%Apache::lonplot::plot,\%gnuplot_defaults,$parstack,$safeeval,
$tagstack->[-1]);
} elsif ($target eq 'edit') {
+ &fixup_colors($token,['bgcolor','fgcolor']);
$result .= &Apache::edit::tag_start($target,$token,'GnuPlot');
$result .= &edit_attributes($target,$token,\%gnuplot_defaults,
\@gnuplot_edit_order)
@@ -687,18 +701,8 @@ sub start_gnuplot {
} elsif ($target eq 'modified') {
my $constructtag=&Apache::edit::get_new_args
($token,$parstack,$safeeval,keys(%gnuplot_defaults));
-
- if ($constructtag) {
- #
- # The color chooser does not prepent x to the color values
- # Do that here:
- #
- foreach my $attribute ('bgcolor', 'fgcolor') {
- my $value = $token->[2]{$attribute};
- if (defined $value && !($value =~ /^x/)) {
- $token->[2]{$attribute} = 'x' . $value;
- }
- }
+ my $fixed = &fixup_colors($token,['bgcolor','fgcolor']);
+ if ($constructtag || $fixed) {
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -725,20 +729,27 @@ sub end_gnuplot {
&check_inputs(); # Make sure we have all the data we need
##
## Determine filename
+ my ($seconds, $microseconds) = gettimeofday;
my $filename = $env{'user.name'}.'_'.$env{'user.domain'}.
- '_'.time.'_'.$$.$randnumber.'_plot';
+ '_'.$seconds.'_'.$microseconds.'_'.$$.$randnumber.'_plot';
## Write the plot description to the file
&write_gnuplot_file($tmpdir,$filename,$target);
$filename = &escape($filename);
## return image tag for the plot
if ($target eq 'web') {
- $result .= <<"ENDIMAGE";
-<img src = "/cgi-bin/plot.$weboutputformat?file=$filename.data"
- width = "$Apache::lonplot::plot{'width'}"
- height = "$Apache::lonplot::plot{'height'}"
- align = "$Apache::lonplot::plot{'align'}"
- alt = "$Apache::lonplot::plot{'alttag'}" />
-ENDIMAGE
+ my $srcatt = "src=\"/cgi-bin/plot.$weboutputformat?file=$filename.data\"";
+ my $widthatt = "width=\"$Apache::lonplot::plot{'width'}\"";
+ my $heightatt = "height=\"$Apache::lonplot::plot{'height'}\"";
+ my $alignatt = "align=\"$Apache::lonplot::plot{'align'}\"";
+ my $altatt = "alt=\"$Apache::lonplot::plot{'alttag'}\"";
+ if ($Apache::lonplot::plot{'align'} eq 'center') {
+ $result .= '<div style="text-align:center">'.
+ "<img $srcatt $widthatt $heightatt $altatt>".
+ "</div>\n";
+
+ } else {
+ $result .= "<img $srcatt $widthatt $heightatt $alignatt $altatt>";
+ }
} elsif ($target eq 'tex') {
&Apache::lonxml::debug(" gnuplot wid = $Apache::lonplot::plot{'width'}");
&Apache::lonxml::debug(" gnuplot ht = $Apache::lonplot::plot{'height'}");
@@ -746,7 +757,13 @@ ENDIMAGE
&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{{'.$tmpdir.'}}'."\n";
+ if ($Apache::lonplot::plot{'align'} eq 'center') {
+ $result .= '\begin{center}';
+ }
$result .= '\includegraphics[width='.$Apache::lonplot::plot{'texwidth'}.' mm]{'.&unescape($filename).'.eps}';
+ if ($Apache::lonplot::plot{'align'} eq 'center') {
+ $result .= '\end{center}';
+ }
}
} elsif ($target eq 'edit') {
$result.=&Apache::edit::tag_end($target,$token);
@@ -1467,6 +1484,7 @@ sub start_curve {
$tagstack->[-1]);
push (@curves,\%curve);
} elsif ($target eq 'edit') {
+ &fixup_colors($token);
$result .= &Apache::edit::tag_start($target,$token,'Curve');
$result .= &edit_attributes($target,$token,\%curve_defaults,
\@curve_edit_order)
@@ -1476,14 +1494,8 @@ sub start_curve {
} elsif ($target eq 'modified') {
my $constructtag=&Apache::edit::get_new_args
($token,$parstack,$safeeval,keys(%curve_defaults));
- if ($constructtag) {
- #
- # Fix up the color attribute as jcolor does not prepend an x
- #
- my $value = $token->[2]{'color'};
- if (defined $value && !($value =~ /^x/)) {
- $token->[2]{'color'} = 'x' . $value;
- }
+ my $fixed = &fixup_colors($token);
+ if ($constructtag || $fixed) {
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -1626,23 +1638,15 @@ sub start_axis {
&get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
$tagstack->[-1]);
} elsif ($target eq 'edit') {
+ &fixup_colors($token);
$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) {
- #
- # Fix up the color attribute since jchooser does not
- # prepend an x to the color:
- #
- my $value = $token->[2]{'color'};
- if (defined $value && !($value =~ /^x/)) {
- $token->[2]{'color'} = 'x' . $value;
- }
-
+ my $fixed = &fixup_colors($token);
+ if ($constructtag || $fixed) {
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -1692,10 +1696,26 @@ sub get_attributes{
}
my $test = $defaults->{$attr}->{'test'};
if (! &$test($values->{$attr})) {
+ my $warning = &mt('Replacing your value with: [_1].',
+ $defaults->{$attr}->{'default'});
+ my $missingprefix;
+ if (($env{'form.problemmode'} eq 'editxml') ||
+ ($env{'form.problemmode'} eq 'edit')) {
+ $warning = &mt('On display your value will be replaced with: [_1].',
+ $defaults->{$attr}->{'default'});
+ if (($env{'form.problemmode'} eq 'edit') &&
+ ($attr =~ /^(|fg|bg)color$/) && ($values->{$attr} =~ /^[\da-fA-F]{6}$/)) {
+ $missingprefix = 1;
+ $warning = &mt('The current value is missing the prefix: [_1].',
+ $colorprefix).' '.
+ &mt('As the color picker entry adds the prefix, saving will fix this issue.');
+ }
+ }
+ unless ($missingprefix) {
+ $values->{$attr} = $defaults->{$attr}->{'default'};
+ }
&Apache::lonxml::warning
- ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
- .$defaults->{$attr}->{'default'} );
- $values->{$attr} = $defaults->{$attr}->{'default'};
+ ($tag.':'.$attr.': '.&mt('Bad value').'. '.$warning);
}
}
return ;
@@ -1714,7 +1734,7 @@ sub generate_tics {
my $result = '';
- if (defined %$spec) {
+ if ((ref($spec) eq 'HASH') && (keys(%{$spec}) > 0)) {
@@ -1786,13 +1806,15 @@ sub write_gnuplot_file {
@curves = @curvescopy;
# Collect all the colors
my @Colors;
- push @Colors, $Apache::lonplot::plot{'bgcolor'};
- push @Colors, $Apache::lonplot::plot{'fgcolor'};
- push @Colors, (defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'});
- foreach $curve (@curves) {
- push @Colors, ($curve->{'color'} ne '' ?
- $curve->{'color'} :
- $Apache::lonplot::plot{'fgcolor'} );
+ if ($version < 4.6) {
+ push(@Colors,$Apache::lonplot::plot{'bgcolor'});
+ push(@Colors,$Apache::lonplot::plot{'fgcolor'});
+ push(@Colors,(defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'}));
+ foreach $curve (@curves) {
+ push(@Colors,($curve->{'color'} ne '' ?
+ $curve->{'color'} :
+ $Apache::lonplot::plot{'fgcolor'}));
+ }
}
# set term
@@ -1803,7 +1825,13 @@ sub write_gnuplot_file {
'/'.$font_properties->{'file'}.'.ttf" ';
$gnuplot_input .= $fontsize;
$gnuplot_input .= ' size '.$Apache::lonplot::plot{'width'}.','.$Apache::lonplot::plot{'height'}.' ';
- $gnuplot_input .= "@Colors\n";
+ if ($version >= 4.6) {
+ if ($Apache::lonplot::plot{'bgcolor'}) {
+ $gnuplot_input .= "background '$Apache::lonplot::plot{'bgcolor'}'\n";
+ }
+ } else {
+ $gnuplot_input .= "@Colors\n";
+ }
# set output
$gnuplot_input .= "set output\n";
} elsif ($target eq 'tex') {
@@ -1813,6 +1841,10 @@ sub write_gnuplot_file {
'fontfile "'.$Apache::lonnet::perlvar{'lonFontsDir'}.
'/'.$font_properties->{'file'}.'.pfb" ';
}
+ if (($version >= 4.6) && ($Apache::lonplot::plot{'plotcolor'} =~ /^colou?r$/) &&
+ ($Apache::lonplot::plot{'bgcolor'} ne '')) {
+ $gnuplot_input .= "background '$Apache::lonplot::plot{'bgcolor'}' ";
+ }
$gnuplot_input .= ' "'.$font_properties->{'printname'}.'" ';
$gnuplot_input .= $fontsize;
$gnuplot_input .= "\nset output \"".$tmpdir.
@@ -1879,11 +1911,38 @@ sub write_gnuplot_file {
if ($Apache::lonplot::plot{'gridlayer'} eq 'on');
# grid
- $gnuplot_input .= 'set grid'.$/ if ($Apache::lonplot::plot{'grid'} eq 'on');
+ if ($Apache::lonplot::plot{'grid'} eq 'on') {
+ if (($version >= 4.6) && (($axis{'color'} ne '') || ($Apache::lonplot::plot{'fgcolor'} ne ''))) {
+ if (($target eq 'web') || (($target eq 'tex') &&
+ ($Apache::lonplot::plot{'plotcolor'} =~ /^colou?r$/))) {
+ $gnuplot_input .= 'set grid linecolor rgb "'.
+ (($axis{'color'} ne '')?$axis{'color'}:
+ $Apache::lonplot::plot{'fgcolor'}).
+ '" '.$/;
+
+ } else {
+ $gnuplot_input .= 'set grid'.$/;
+ }
+ } else {
+ $gnuplot_input .= 'set grid'.$/;
+ }
+ }
# border
- $gnuplot_input .= ($Apache::lonplot::plot{'border'} eq 'on'?
- 'set border'.$/ :
- 'set noborder'.$/ );
+ if ($Apache::lonplot::plot{'border'} eq 'on') {
+ if (($version >= 4.6) && ($Apache::lonplot::plot{'fgcolor'} ne '')) {
+ if (($target eq 'web') || (($target eq 'tex') &&
+ ($Apache::lonplot::plot{'plotcolor'} =~ /^colou?r$/))) {
+ $gnuplot_input .= 'set border linecolor rgb "'.
+ $Apache::lonplot::plot{'fgcolor'}.'" '.$/;
+ } else {
+ $gnuplot_input .= 'set border '.$/;
+ }
+ } else {
+ $gnuplot_input .= 'set border '.$/;
+ }
+ } else {
+ $gnuplot_input .= 'set noborder '.$/;
+ }
# sampling rate for non-data curves
$gnuplot_input .= "set samples $Apache::lonplot::plot{'samples'}\n";
# title, xlabel, ylabel
@@ -1912,6 +1971,14 @@ sub write_gnuplot_file {
if ($axis{'xformat'} eq 'off') {
$gnuplot_input .= "\"\"\n";
} else {
+ if ($axis{'xformat'} =~ /^(\d+P\s*)[Pp][Ii]/) {
+ my $xprefix = $1;
+ if (($target eq 'web') || ($target eq 'tex')) {
+ $axis{'xformat'} = $xprefix.$lookup{'(pi|#960)'}{$target};
+ } else {
+ $axis{'xformat'} = $xprefix;
+ }
+ }
$gnuplot_input .= "\"\%.".$axis{'xformat'}."\"\n";
}
}
@@ -1920,6 +1987,14 @@ sub write_gnuplot_file {
if ($axis{'yformat'} eq 'off') {
$gnuplot_input .= "\"\"\n";
} else {
+ if ($axis{'yformat'} =~ /^(\d+P\s*)[Pp][Ii]/) {
+ my $yprefix = $1;
+ if (($target eq 'web') || ($target eq 'tex')) {
+ $axis{'yformat'} = $yprefix.$lookup{'(pi|#960)'}{$target};
+ } else {
+ $axis{'yformat'} = $yprefix;
+ }
+ }
$gnuplot_input .= "\"\%.".$axis{'yformat'}."\"\n";
}
}
@@ -1967,7 +2042,10 @@ sub write_gnuplot_file {
$gnuplot_input .= ' '.$label->{'justify'};
if ($target eq 'tex') {
- $gnuplot_input .=' font "'.$font_properties->{'printname'}.','.$fontsize.'pt"' ;
+ $gnuplot_input .=' font "'.$font_properties->{'printname'}.','.$fontsize.'pt"';
+ }
+ if (($label->{'zlayer'} eq 'front') || ($label->{'zlayer'} eq 'back')) {
+ $gnuplot_input .= ' '.$label->{'zlayer'};
}
$gnuplot_input .= $/;
}
@@ -1984,7 +2062,7 @@ sub write_gnuplot_file {
#
my $linestyle_index = 50;
my $line_width = '';
- my $plots;
+ my $plots = '';
# If arrows are needed there will be an arrow style for each as well:
#
@@ -1993,8 +2071,11 @@ sub write_gnuplot_file {
for (my $i = 0;$i<=$#curves;$i++) {
$curve = $curves[$i];
- my $plot_command;
- my $plot_type = ', ' if ($i > 0);
+ my $plot_command = '';
+ my $plot_type = '';
+ if ($i > 0) {
+ $plot_type = ', ';
+ }
if ($target eq 'tex') {
$curve->{'linewidth'} *= 2;
}
@@ -2125,7 +2206,7 @@ sub check_inputs {
}
}
-#------------------------------------------------ make_edit
+#------------------------------------------ edit_attributes
sub edit_attributes {
my ($target,$token,$defaults,$keys) = @_;
my ($result,@keys);
@@ -2155,6 +2236,46 @@ sub edit_attributes {
return $result;
}
+#------------------------------------------ fixup_colors
+
+sub fixup_colors {
+ my ($token,$attribref) = @_;
+ my @attributes;
+ if (ref($attribref) eq 'ARRAY') {
+ @attributes = @{$attribref};
+ } else {
+ @attributes = ('color');
+ }
+
+#
+# Fix up the color attribute since jchooser does not
+# prepend an x (or #) to the color:
+#
+ my $had_changes;
+ if ((ref($token) eq 'ARRAY') && (ref($token->[2]) eq 'HASH')) {
+ foreach my $attribute (@attributes) {
+ if ($attribute =~ /^(|bg|fg)color$/) {
+ my $value = $token->[2]{$attribute};
+ if (defined($value)) {
+ if ($version < 4.6) {
+ $value=~s/^\#/x/;
+ } else {
+ $value=~s/^x/#/;
+ }
+ if ($value ne $token->[2]{$attribute}) {
+ $token->[2]{$attribute} = $value;
+ $had_changes = 1;
+ }
+ if ($value !~ /^\Q$colorprefix\E/) {
+ $token->[2]{$attribute} = $colorprefix . $value;
+ $had_changes = 1;
+ }
+ }
+ }
+ }
+ }
+ return $had_changes;
+}
###################################################################
## ##
@@ -2353,6 +2474,8 @@ described at http://www.lon-capa.org.
=item edit_attributes()
+=item fixup_colors()
+
=back
=head1 SUBROUTINES (Insertion functions for editing plots)