--- loncom/xml/lonplot.pm 2017/04/02 21:38:15 1.177
+++ loncom/xml/lonplot.pm 2020/02/02 20:12:31 1.184
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Dynamic plot
#
-# $Id: lonplot.pm,v 1.177 2017/04/02 21:38:15 raeburn Exp $
+# $Id: lonplot.pm,v 1.184 2020/02/02 20:12:31 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,10 +39,10 @@ use Apache::response;
use Apache::lonxml;
use Apache::edit;
use Apache::lonnet;
+use Apache::lonlocal;
use LONCAPA;
-
-use vars qw/$weboutputformat $version/;
+use vars qw/$weboutputformat $version $colorprefix/;
@@ -56,7 +56,10 @@ BEGIN {
if ($version >= 4) {
$weboutputformat = 'png';
}
-
+ $colorprefix = 'x';
+ if ($version >= 4.6) {
+ $colorprefix = '#';
+ }
}
@@ -134,9 +137,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 +189,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'
@@ -367,6 +370,7 @@ my %gnuplot_defaults =
},
);
+
my %key_defaults =
(
title => {
@@ -488,9 +492,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'
@@ -525,14 +529,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'],
@@ -564,9 +568,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'
@@ -678,6 +682,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'));
@@ -686,6 +691,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)
@@ -694,18 +700,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);
}
}
@@ -1486,6 +1482,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)
@@ -1495,14 +1492,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);
}
}
@@ -1645,23 +1636,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);
}
}
@@ -1711,10 +1694,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 ;
@@ -1805,13 +1804,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
@@ -1822,7 +1823,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') {
@@ -1832,6 +1839,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.
@@ -1898,11 +1909,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
@@ -1931,6 +1969,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";
}
}
@@ -1939,6 +1985,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";
}
}
@@ -2150,7 +2204,7 @@ sub check_inputs {
}
}
-#------------------------------------------------ make_edit
+#------------------------------------------ edit_attributes
sub edit_attributes {
my ($target,$token,$defaults,$keys) = @_;
my ($result,@keys);
@@ -2180,6 +2234,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;
+}
###################################################################
## ##
@@ -2378,6 +2472,8 @@ described at http://www.lon-capa.org.
=item edit_attributes()
+=item fixup_colors()
+
=back
=head1 SUBROUTINES (Insertion functions for editing plots)