--- loncom/xml/lonplot.pm 2012/02/13 11:24:16 1.154
+++ loncom/xml/lonplot.pm 2012/07/16 10:09:36 1.160
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Dynamic plot
#
-# $Id: lonplot.pm,v 1.154 2012/02/13 11:24:16 foxr Exp $
+# $Id: lonplot.pm,v 1.160 2012/07/16 10:09:36 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -98,11 +98,16 @@ BEGIN {
my $max_str_len = 50; # if a label, title, xlabel, or ylabel text
# is longer than this, it will be truncated.
-my %linetypes =
+my %linetypes = # For png use these linetypes.
(
solid => 1,
dashed => 0
);
+my %ps_linetypes = # For ps the line types are different!
+ (
+ solid => 0,
+ dashed => 7
+ );
my %linestyles =
(
@@ -134,6 +139,10 @@ my $sml_test = sub {$_[0]=~/^(\d+|
my $linestyle_test = sub {exists($linestyles{$_[0]})};
my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/};
+my $arrowhead_test = sub{$_[0]=~/^(nohead|head|heads| )+$/};
+my $arrowstyle_test= sub{$_[0]=~/^(filled|empty|nofilled)+$/};
+my $degree_test = sub{&$pos_real_test($_[0]) && ($_[0] <= 360.0)};
+
###################################################################
## ##
## Attribute metadata ##
@@ -528,7 +537,10 @@ my %axis_defaults =
},
);
-my @curve_edit_order = ('color','name','linestyle','linewidth','linetype','pointtype','pointsize','limit');
+my @curve_edit_order = ('color','name','linestyle','linewidth','linetype',
+ 'pointtype','pointsize','limit', 'arrowhead', 'arrowstyle',
+ 'arrowlength', 'arrowangle', 'arrowbackangle'
+ );
my %curve_defaults =
(
@@ -589,6 +601,43 @@ my %curve_defaults =
edit_type => 'choice',
choices => ['above', 'below', 'closed','x1','x2','y1','y2']
},
+ arrowhead => {
+ default => 'head',
+ test => $arrowhead_test,
+ description => 'Vector arrow head type',
+ edit_type => 'choice',
+ choices => ['nohead', 'head', 'heads']
+ },
+ arrowstyle => {
+ default => 'filled',
+ test => $arrowstyle_test,
+ description => 'Vector arrow head style',
+ edit_type => 'choice',
+ choices => ['filled', 'empty', 'nofilled']
+ },
+ arrowlength => {
+ default => 0.02,
+ test => $pos_real_test,
+ description => "Length of vector arrow (only applies to vector plots)",
+ edit_type => 'entry',
+ size => '5'
+ },
+ arrowangle => {
+ default => 10.0,
+ test => $degree_test,
+ description => 'Angle of arrow branches to arrow body (only applies to vector plots)',
+ edit_type => 'entry',
+ size => '5'
+ },
+
+ arrowbackangle => {
+ default => 90.0,
+ test => $degree_test,
+ descripton => 'Angle of arrow back lines to branches.',
+ edit_type => 'entry',
+ size => '5'
+ }
+
);
###################################################################
@@ -624,7 +673,18 @@ 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;
+ }
+ }
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -1355,6 +1415,13 @@ sub start_curve {
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;
+ }
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -1501,7 +1568,17 @@ sub start_axis {
} 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;
+ }
+
$result = &Apache::edit::rebuild_tag($token);
}
}
@@ -1594,6 +1671,7 @@ sub write_gnuplot_file {
$curve->{'color'} :
$Apache::lonplot::plot{'fgcolor'} );
}
+
# set term
if ($target eq 'web') {
$gnuplot_input .= 'set terminal png enhanced nocrop ';
@@ -1606,7 +1684,7 @@ sub write_gnuplot_file {
# set output
$gnuplot_input .= "set output\n";
} elsif ($target eq 'tex') {
- $gnuplot_input .= "set term postscript eps enhanced $Apache::lonplot::plot{'plotcolor'} solid ";
+ $gnuplot_input .= "set term postscript eps enhanced $Apache::lonplot::plot{'plotcolor'} dash ";
if (!$font_properties->{'tex_no_file'}) {
$gnuplot_input .=
'fontfile "'.$Apache::lonnet::perlvar{'lonFontsDir'}.
@@ -1619,6 +1697,7 @@ sub write_gnuplot_file {
$gnuplot_input .= "set encoding iso_8859_1\n"; # Get access to extended font.
}
+ $gnuplot_input .= "set encoding utf8\n";
# cartesian or polar plot?
if (lc($Apache::lonplot::plot{'plottype'}) eq 'polar') {
$gnuplot_input .= 'set polar'.$/;
@@ -1806,40 +1885,35 @@ sub write_gnuplot_file {
$gnuplot_input .="\n";
}
# curves
- $gnuplot_input .= 'plot ';
+ #
+ # Each curve will have its very own linestyle.
+ # (This should work just fine in web rendition I think).
+ # The line_xxx variables will hold the elements of the line style.
+ # type (solid/dashed), color, width
+ #
+ my $linestyle_index = 50;
+ my $line_width = '';
+
+ # If arrows are needed there will be an arrow style for each as well:
+ #
+
+ my $arrow_style_index = 50;
+
+ my $plot_command;
+ my $plot_type;
+
for (my $i = 0;$i<=$#curves;$i++) {
$curve = $curves[$i];
- $gnuplot_input.= ', ' if ($i > 0);
+ $plot_command.= ', ' if ($i > 0);
if ($target eq 'tex') {
$curve->{'linewidth'} *= 2;
}
+ $line_width = $curve->{'linewidth'};
if (exists($curve->{'function'})) {
- $gnuplot_input.=
+ $plot_type =
$curve->{'function'}.' title "'.
$curve->{'name'}.'" with '.
$curve->{'linestyle'};
-
- 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 ($curve->{'linetype'} ne '' &&
- $curve->{'linestyle'} eq 'lines') {
- $gnuplot_input.= ' linetype ';
- $gnuplot_input.= $linetypes{$curve->{'linetype'}};
- $gnuplot_input.= ' linecolor rgb "';
- # convert color from xaaaaaa to #aaaaaa
- $curve->{'color'} =~ s/^x/#/;
- $gnuplot_input.= $curve->{'color'}.'"';
- }
- $gnuplot_input.= ' linewidth '.$curve->{'linewidth'};
-
} elsif (exists($curve->{'data'})) {
# Store data values in $datatext
my $datatext = '';
@@ -1860,34 +1934,77 @@ sub write_gnuplot_file {
print $fh $datatext;
close($fh);
# generate gnuplot text
- $gnuplot_input.= '"'.$datafilename.'" title "'.
+ $plot_type = '"'.$datafilename.'" title "'.
$curve->{'name'}.'" with '.
$curve->{'linestyle'};
- 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 ($curve->{'linetype'} ne '' &&
- $curve->{'linestyle'} eq 'lines') {
- $gnuplot_input.= ' linetype ';
- $gnuplot_input.= $linetypes{$curve->{'linetype'}};
- $gnuplot_input.= ' linecolor rgb "';
- # convert color from xaaaaaa to #aaaaaa
- $curve->{'color'} =~ s/^x/#/;
- $gnuplot_input.= $curve->{'color'}.'"';
- }
- $gnuplot_input.= ' linewidth '.$curve->{'linewidth'};
}
+ my $pointtype = '';
+ my $pointsize = '';
+
+ # Figure out the linestyle:
+
+ my $lt = $curve->{'linetype'} ne '' ? $curve->{'linetype'}
+ : 'solid'; # Line type defaults to solid.
+ # The mapping of lt -> the actual gnuplot line type depends on the target:
+
+ if ($target eq 'tex') {
+ $lt = $ps_linetypes{$lt};
+ } else {
+ $lt = $linetypes{$lt}
+ }
+
+ my $color = $curve->{'color'};
+ $color =~ s/^x/#/; # Convert xhex color -> #hex color.
+
+ my $style_command = "set style line $linestyle_index $pointtype $pointsize linetype $lt linewidth $line_width lc rgb '$color'\n";
+ $gnuplot_input .= $style_command;
+
+
+
+ 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')) {
+
+ $pointtype =' pointtype '.$curve->{'pointtype'};
+ $pointsize =' pointsize '.$curve->{'pointsize'};
+ } elsif ($curve->{'linestyle'} eq 'filledcurves') {
+ $plot_command.= ' '.$curve->{'limit'};
+ } elsif ($curve->{'linestyle'} eq 'vector') {
+
+ # Create the arrow head style add it to
+ # $gnuplot_input..and ensure it gets
+ # Selected in the plot command.
+
+ $gnuplot_input .= "set style arrow $arrow_style_index ";
+ $gnuplot_input .= ' ' . $curve->{'arrowhead'};
+ $gnuplot_input .= ' size ' . $curve->{'arrowlength'};
+ $gnuplot_input .= ','.$curve->{'arrowangle'};
+ $gnuplot_input .= ',' . $curve->{'arrowbackangle'};
+ $gnuplot_input .= ' ' . $curve->{'arrowstyle'} . " ls $linestyle_index\n";
+
+
+ $plot_command .= " arrowstyle $arrow_style_index ";
+ $arrow_style_index++;
+ }
+
+
+
+
+ # The condition below is because gnuplot lumps the linestyle in with the
+ # arrowstyle _sigh_.
+
+ if ($curve->{'linestyle'} ne 'vector') {
+ $plot_command.= " ls $linestyle_index";
+ }
+
+ $gnuplot_input .= 'plot ' . $plot_type . ' ' . $plot_command . "\n";
+ $linestyle_index++; # Each curve get a unique linestyle.
}
# Write the output to a file.
open (my $fh,">$tmpdir$filename.data");
- binmode($fh, ":utf8");
print $fh $gnuplot_input;
close($fh);
# That's all folks.