|
version 1.156, 2012/07/03 11:29:57
|
version 1.184, 2020/02/02 20:12:31
|
|
Line 39 use Apache::response;
|
Line 39 use Apache::response;
|
| use Apache::lonxml; |
use Apache::lonxml; |
| use Apache::edit; |
use Apache::edit; |
| use Apache::lonnet; |
use Apache::lonnet; |
| |
use Apache::lonlocal; |
| use LONCAPA; |
use LONCAPA; |
| |
|
| |
|
| use vars qw/$weboutputformat $version/; |
use vars qw/$weboutputformat $version $colorprefix/; |
| |
|
| |
|
| |
|
|
Line 56 BEGIN {
|
Line 56 BEGIN {
|
| if ($version >= 4) { |
if ($version >= 4) { |
| $weboutputformat = 'png'; |
$weboutputformat = 'png'; |
| } |
} |
| |
$colorprefix = 'x'; |
| |
if ($version >= 4.6) { |
| |
$colorprefix = '#'; |
| |
} |
| } |
} |
| |
|
| |
|
|
Line 78 BEGIN {
|
Line 81 BEGIN {
|
| ## align |
## align |
| ## |
## |
| ## @labels: $labels[$i] = \%label |
## @labels: $labels[$i] = \%label |
| ## %label: text, xpos, ypos, justify |
## %label: text, xpos, ypos, justify, rotate, zlayer |
| ## |
## |
| ## @curves: $curves[$i] = \%curve |
## @curves: $curves[$i] = \%curve |
| ## %curve: name, linestyle, ( function | data ) |
## %curve: name, linestyle, ( function | data ) |
|
Line 98 BEGIN {
|
Line 101 BEGIN {
|
| my $max_str_len = 50; # if a label, title, xlabel, or ylabel text |
my $max_str_len = 50; # if a label, title, xlabel, or ylabel text |
| # is longer than this, it will be truncated. |
# is longer than this, it will be truncated. |
| |
|
| my %linetypes = |
my %linetypes = # For png use these linetypes. |
| ( |
( |
| solid => 1, |
solid => 1, |
| dashed => 0 |
dashed => 0 |
| ); |
); |
| |
my %ps_linetypes = # For ps the line types are different! |
| |
( |
| |
solid => 1, |
| |
dashed => 7 |
| |
); |
| |
|
| my %linestyles = |
my %linestyles = |
| ( |
( |
|
Line 127 my $real_test =
|
Line 135 my $real_test =
|
| sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; |
sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; |
| my $pos_real_test = |
my $pos_real_test = |
| sub {$_[0]=~s/\s+//g;$_[0]=~/^[+]?\d*\.?\d*([eE][+-]\d+)?$/}; |
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 $color_test; |
| |
if ($version < 4.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]=~s/^\#+/#/;$_[0]=~/^\#[\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]=~/^(\d+|small|medium|large)$/}; |
my $sml_test = sub {$_[0]=~/^(\d+|small|medium|large)$/}; |
| my $linestyle_test = sub {exists($linestyles{$_[0]})}; |
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~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/}; |
| |
|
| |
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 ## |
## Attribute metadata ## |
|
Line 172 my %gnuplot_defaults =
|
Line 189 my %gnuplot_defaults =
|
| size => '10' |
size => '10' |
| }, |
}, |
| bgcolor => { |
bgcolor => { |
| default => 'xffffff', |
default => $colorprefix.'ffffff', |
| test => $color_test, |
test => $color_test, |
| description => 'Background color of image (xffffff)', |
description => 'Background color of image ('.$colorprefix.'ffffff)', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10', |
size => '10', |
| class => 'colorchooser' |
class => 'colorchooser' |
| }, |
}, |
| fgcolor => { |
fgcolor => { |
| default => 'x000000', |
default => $colorprefix.'000000', |
| test => $color_test, |
test => $color_test, |
| description => 'Foreground color of image (x000000)', |
description => 'Foreground color of image ('.$colorprefix.'000000)', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10', |
size => '10', |
| class => 'colorchooser' |
class => 'colorchooser' |
|
Line 244 my %gnuplot_defaults =
|
Line 261 my %gnuplot_defaults =
|
| test => sub {$_[0]=~/^(left|right|middle|center)$/}, |
test => sub {$_[0]=~/^(left|right|middle|center)$/}, |
| description => 'Alignment for image in HTML', |
description => 'Alignment for image in HTML', |
| edit_type => 'choice', |
edit_type => 'choice', |
| choices => ['left','right','middle'] |
choices => ['left','right','middle','center'] |
| }, |
}, |
| texwidth => { |
texwidth => { |
| default => '93', |
default => '93', |
|
Line 353 my %gnuplot_defaults =
|
Line 370 my %gnuplot_defaults =
|
| }, |
}, |
| ); |
); |
| |
|
| |
|
| my %key_defaults = |
my %key_defaults = |
| ( |
( |
| title => { |
title => { |
|
Line 407 my %label_defaults =
|
Line 425 my %label_defaults =
|
| description => 'Rotation of label (degrees)', |
description => 'Rotation of label (degrees)', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10', |
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', |
my @tic_edit_order = ('location','mirror','start','increment','end', |
|
Line 454 my %tic_defaults =
|
Line 479 my %tic_defaults =
|
| description => 'Number of minor tics per major tic mark', |
description => 'Number of minor tics per major tic mark', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10' |
size => '10' |
| }, |
}, |
| |
rotate => { |
| |
default => 'off', |
| |
test => $onoff_test, |
| |
description => 'Rotate tic label by 90 degrees if on', |
| |
edit_type => 'onoff' |
| |
} |
| ); |
); |
| |
|
| my @axis_edit_order = ('color','xmin','xmax','ymin','ymax','xformat', 'yformat', 'xzero', 'yzero'); |
my @axis_edit_order = ('color','xmin','xmax','ymin','ymax','xformat', 'yformat', 'xzero', 'yzero'); |
| my %axis_defaults = |
my %axis_defaults = |
| ( |
( |
| color => { |
color => { |
| default => 'x000000', |
default => $colorprefix.'000000', |
| test => $color_test, |
test => $color_test, |
| description => 'Color of grid lines (x000000)', |
description => 'Color of grid lines ('.$colorprefix.'000000)', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10', |
size => '10', |
| class => 'colorchooser' |
class => 'colorchooser' |
|
Line 498 my %axis_defaults =
|
Line 529 my %axis_defaults =
|
| }, |
}, |
| xformat => { |
xformat => { |
| default => 'on', |
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', |
description => 'X-axis number formatting', |
| edit_type => 'choice', |
edit_type => 'choice', |
| choices => ['on', 'off', '2e', '2f'], |
choices => ['on', 'off', '2e', '2f'], |
| }, |
}, |
| yformat => { |
yformat => { |
| default => 'on', |
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', |
description => 'Y-axis number formatting', |
| edit_type => 'choice', |
edit_type => 'choice', |
| choices => ['on', 'off', '2e', '2f'], |
choices => ['on', 'off', '2e', '2f'], |
|
Line 528 my %axis_defaults =
|
Line 559 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 = |
my %curve_defaults = |
| ( |
( |
| color => { |
color => { |
| default => 'x000000', |
default => $colorprefix.'000000', |
| test => $color_test, |
test => $color_test, |
| description => 'Color of curve (x000000)', |
description => 'Color of curve ('.$colorprefix.'000000)', |
| edit_type => 'entry', |
edit_type => 'entry', |
| size => '10', |
size => '10', |
| class => 'colorchooser' |
class => 'colorchooser' |
|
Line 589 my %curve_defaults =
|
Line 624 my %curve_defaults =
|
| edit_type => 'choice', |
edit_type => 'choice', |
| choices => ['above', 'below', 'closed','x1','x2','y1','y2'] |
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' |
| |
} |
| |
|
| ); |
); |
| |
|
| ################################################################### |
################################################################### |
|
Line 600 my %curve_defaults =
|
Line 672 my %curve_defaults =
|
| undef %Apache::lonplot::plot; |
undef %Apache::lonplot::plot; |
| my (%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); |
my (%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); |
| |
|
| |
my $current_tics; # Reference to the current tick hash |
| |
|
| sub start_gnuplot { |
sub start_gnuplot { |
| undef(%Apache::lonplot::plot); undef(%key); undef(%axis); |
undef(%Apache::lonplot::plot); undef(%key); undef(%axis); |
| undef($title); undef($xlabel); undef($ylabel); |
undef($title); undef($xlabel); undef($ylabel); |
|
Line 608 sub start_gnuplot {
|
Line 682 sub start_gnuplot {
|
| # |
# |
| 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', |
| 'xtics','ytics')); |
'xtics','ytics')); |
|
Line 616 sub start_gnuplot {
|
Line 691 sub start_gnuplot {
|
| &get_attributes(\%Apache::lonplot::plot,\%gnuplot_defaults,$parstack,$safeeval, |
&get_attributes(\%Apache::lonplot::plot,\%gnuplot_defaults,$parstack,$safeeval, |
| $tagstack->[-1]); |
$tagstack->[-1]); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| |
&fixup_colors($token,['bgcolor','fgcolor']); |
| $result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); |
$result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); |
| $result .= &edit_attributes($target,$token,\%gnuplot_defaults, |
$result .= &edit_attributes($target,$token,\%gnuplot_defaults, |
| \@gnuplot_edit_order) |
\@gnuplot_edit_order) |
|
Line 624 sub start_gnuplot {
|
Line 700 sub start_gnuplot {
|
| } 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(%gnuplot_defaults)); |
($token,$parstack,$safeeval,keys(%gnuplot_defaults)); |
| |
my $fixed = &fixup_colors($token,['bgcolor','fgcolor']); |
| if ($constructtag) { |
if ($constructtag || $fixed) { |
| # |
|
| # 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); |
$result = &Apache::edit::rebuild_tag($token); |
| } |
} |
| } |
} |
|
Line 669 sub end_gnuplot {
|
Line 735 sub end_gnuplot {
|
| $filename = &escape($filename); |
$filename = &escape($filename); |
| ## return image tag for the plot |
## return image tag for the plot |
| if ($target eq 'web') { |
if ($target eq 'web') { |
| $result .= <<"ENDIMAGE"; |
my $srcatt = "src=\"/cgi-bin/plot.$weboutputformat?file=$filename.data\""; |
| <img src = "/cgi-bin/plot.$weboutputformat?file=$filename.data" |
my $widthatt = "width=\"$Apache::lonplot::plot{'width'}\""; |
| width = "$Apache::lonplot::plot{'width'}" |
my $heightatt = "height=\"$Apache::lonplot::plot{'height'}\""; |
| height = "$Apache::lonplot::plot{'height'}" |
my $alignatt = "align=\"$Apache::lonplot::plot{'align'}\""; |
| align = "$Apache::lonplot::plot{'align'}" |
my $altatt = "alt=\"$Apache::lonplot::plot{'alttag'}\""; |
| alt = "$Apache::lonplot::plot{'alttag'}" /> |
if ($Apache::lonplot::plot{'align'} eq 'center') { |
| ENDIMAGE |
$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') { |
} elsif ($target eq 'tex') { |
| &Apache::lonxml::debug(" gnuplot wid = $Apache::lonplot::plot{'width'}"); |
&Apache::lonxml::debug(" gnuplot wid = $Apache::lonplot::plot{'width'}"); |
| &Apache::lonxml::debug(" gnuplot ht = $Apache::lonplot::plot{'height'}"); |
&Apache::lonxml::debug(" gnuplot ht = $Apache::lonplot::plot{'height'}"); |
|
Line 683 ENDIMAGE
|
Line 755 ENDIMAGE
|
| &Apache::lonxml::register_ssi("/cgi-bin/plot.gif?file=$filename.data&output=eps"); |
&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 = "%DYNAMICIMAGE:$Apache::lonplot::plot{'width'}:$Apache::lonplot::plot{'height'}:$Apache::lonplot::plot{'texwidth'}\n"; |
| $result .= '\graphicspath{{'.$tmpdir.'}}'."\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}'; |
$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') { |
} elsif ($target eq 'edit') { |
| $result.=&Apache::edit::tag_end($target,$token); |
$result.=&Apache::edit::tag_end($target,$token); |
|
Line 699 sub start_xtics {
|
Line 777 sub start_xtics {
|
| if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web' || $target eq 'tex') { |
| &get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval, |
&get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval, |
| $tagstack->[-1]); |
$tagstack->[-1]); |
| |
$current_tics = \%xtics; |
| |
&Apache::lonxml::register('Apache::lonplot', 'tic'); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| $result .= &Apache::edit::tag_start($target,$token,'xtics'); |
$result .= &Apache::edit::tag_start($target,$token,'xtics'); |
| $result .= &edit_attributes($target,$token,\%tic_defaults, |
$result .= &edit_attributes($target,$token,\%tic_defaults, |
|
Line 717 sub end_xtics {
|
Line 797 sub end_xtics {
|
| my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
| my $result = ''; |
my $result = ''; |
| if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web' || $target eq 'tex') { |
| |
&Apache::lonxml::deregister('Apache::lonplot', 'tic'); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| $result.=&Apache::edit::tag_end($target,$token); |
$result.=&Apache::edit::tag_end($target,$token); |
| } |
} |
|
Line 730 sub start_ytics {
|
Line 811 sub start_ytics {
|
| if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web' || $target eq 'tex') { |
| &get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval, |
&get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval, |
| $tagstack->[-1]); |
$tagstack->[-1]); |
| |
$current_tics = \%ytics; |
| |
&Apache::lonxml::register('Apache::lonplot', 'tic'); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| $result .= &Apache::edit::tag_start($target,$token,'ytics'); |
$result .= &Apache::edit::tag_start($target,$token,'ytics'); |
| $result .= &edit_attributes($target,$token,\%tic_defaults, |
$result .= &edit_attributes($target,$token,\%tic_defaults, |
|
Line 748 sub end_ytics {
|
Line 831 sub end_ytics {
|
| my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
| my $result = ''; |
my $result = ''; |
| if ($target eq 'web' || $target eq 'tex') { |
if ($target eq 'web' || $target eq 'tex') { |
| |
&Apache::lonxml::deregister('Apache::lonplot', 'tic'); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| $result.=&Apache::edit::tag_end($target,$token); |
$result.=&Apache::edit::tag_end($target,$token); |
| } |
} |
| return $result; |
return $result; |
| } |
} |
| |
|
| |
|
| |
##---------------------------------------------------------------- |
| |
# |
| |
# Tic handling: |
| |
# The <tic> tag allows users to specify exact Tic positions and labels |
| |
# for each axis. In this version we only support level 0 tics (major tic). |
| |
# Each tic has associated with it a position and a label |
| |
# $current_tics is a reference to the current tick description hash. |
| |
# We add elements to an array in that has: ticspecs whose elements |
| |
# are 'pos' - the tick position and 'label' - the tic label. |
| |
# |
| |
|
| |
|
| |
sub start_tic { |
| |
my ($target, $token, $tagstack, $parstack, $parser, $safeeval, $style) = @_; |
| |
|
| |
my $result = ''; |
| |
if ($target eq 'web' || $target eq 'tex') { |
| |
my $tic_location = &Apache::lonxml::get_param('location', $parstack, $safeeval); |
| |
my $tic_label = &Apache::lonxml::get_all_text('/tic', $parser); |
| |
|
| |
# Tic location must e a real: |
| |
|
| |
if (!&$real_test($tic_location)) { |
| |
&Apache::lonxml::warning("Tic location: $tic_location must be a real number"); |
| |
} else { |
| |
|
| |
if (!defined $current_tics->{'ticspecs'}) { |
| |
$current_tics->{'ticspecs'} = []; |
| |
} |
| |
my $ticspecs = $current_tics->{'ticspecs'}; |
| |
push (@$ticspecs, {'pos' => $tic_location, 'label' => $tic_label}); |
| |
} |
| |
} |
| |
|
| |
return $result; |
| |
} |
| |
|
| |
sub end_tic { |
| |
return ''; |
| |
} |
| |
|
| ##-----------------------------------------------------------------font |
##-----------------------------------------------------------------font |
| my %font_properties = |
my %font_properties = |
| ( |
( |
|
Line 1356 sub start_curve {
|
Line 1482 sub start_curve {
|
| $tagstack->[-1]); |
$tagstack->[-1]); |
| push (@curves,\%curve); |
push (@curves,\%curve); |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| |
&fixup_colors($token); |
| $result .= &Apache::edit::tag_start($target,$token,'Curve'); |
$result .= &Apache::edit::tag_start($target,$token,'Curve'); |
| $result .= &edit_attributes($target,$token,\%curve_defaults, |
$result .= &edit_attributes($target,$token,\%curve_defaults, |
| \@curve_edit_order) |
\@curve_edit_order) |
|
Line 1365 sub start_curve {
|
Line 1492 sub start_curve {
|
| } 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(%curve_defaults)); |
($token,$parstack,$safeeval,keys(%curve_defaults)); |
| if ($constructtag) { |
my $fixed = &fixup_colors($token); |
| # |
if ($constructtag || $fixed) { |
| # 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); |
$result = &Apache::edit::rebuild_tag($token); |
| } |
} |
| } |
} |
|
Line 1408 sub start_function {
|
Line 1529 sub start_function {
|
| $style); |
$style); |
| $function = &Apache::run::evaluate($function,$safeeval,$$parstack[-1]); |
$function = &Apache::run::evaluate($function,$safeeval,$$parstack[-1]); |
| $function=~s/\^/\*\*/gs; |
$function=~s/\^/\*\*/gs; |
| |
$function=~ s/^\s+//; # Trim leading |
| |
$function=~ s/\s+$//; # And trailing whitespace. |
| $curves[-1]->{'function'} = $function; |
$curves[-1]->{'function'} = $function; |
| } elsif ($target eq 'edit') { |
} elsif ($target eq 'edit') { |
| $result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); |
$result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); |
|
Line 1513 sub start_axis {
|
Line 1636 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') { |
| |
&fixup_colors($token); |
| $result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); |
$result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); |
| $result .= &edit_attributes($target,$token,\%axis_defaults, |
$result .= &edit_attributes($target,$token,\%axis_defaults, |
| \@axis_edit_order); |
\@axis_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(%axis_defaults)); |
($token,$parstack,$safeeval,keys(%axis_defaults)); |
| |
my $fixed = &fixup_colors($token); |
| if ($constructtag) { |
if ($constructtag || $fixed) { |
| # |
|
| # 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); |
$result = &Apache::edit::rebuild_tag($token); |
| } |
} |
| } |
} |
|
Line 1579 sub get_attributes{
|
Line 1694 sub get_attributes{
|
| } |
} |
| my $test = $defaults->{$attr}->{'test'}; |
my $test = $defaults->{$attr}->{'test'}; |
| if (! &$test($values->{$attr})) { |
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 |
&Apache::lonxml::warning |
| ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' |
($tag.':'.$attr.': '.&mt('Bad value').'. '.$warning); |
| .$defaults->{$attr}->{'default'} ); |
|
| $values->{$attr} = $defaults->{$attr}->{'default'}; |
|
| } |
} |
| } |
} |
| return ; |
return ; |
| } |
} |
| |
## |
| |
# Generate tic mark specifications. |
| |
# |
| |
# @param type - type of tics (xtics or ytics). |
| |
# @param spec - Reference to a hash that contains the tic specification. |
| |
# @param target - 'tex' if hard copy target. |
| |
# |
| |
# @return string - the tic specification command. |
| |
# |
| |
sub generate_tics { |
| |
my ($type, $spec, $target) = @_; |
| |
my $result = ''; |
| |
|
| |
|
| |
if ((ref($spec) eq 'HASH') && (keys(%{$spec}) > 0)) { |
| |
|
| |
|
| |
|
| |
# Major tics: - If there are 'ticspecs' these override any other |
| |
# specifications: |
| |
|
| |
|
| |
|
| |
$result .= "set $type $spec->{'location'} "; |
| |
$result .= ($spec->{'mirror'} eq 'on') ? 'mirror ' : 'nomirror '; |
| |
if ($spec->{'rotate'} eq 'on') { |
| |
$result .= ' rotate '; |
| |
} |
| |
if (defined $spec->{'ticspecs'}) { |
| |
$result .= '( '; |
| |
my @ticspecs; |
| |
my $ticinfo = $spec->{'ticspecs'}; |
| |
foreach my $tic (@$ticinfo) { |
| |
push(@ticspecs, '"' . $tic->{'label'} . '" ' . $tic->{'pos'} ); |
| |
} |
| |
$result .= join(', ', (@ticspecs)); |
| |
$result .= ' )'; |
| |
} else { |
| |
$result .= "$spec->{'start'}, "; |
| |
$result .= "$spec->{'increment'}, "; |
| |
$result .= "$spec->{'end'} "; |
| |
} |
| |
if ($target eq 'tex' ) { |
| |
$result .= 'font "Helvetica,22"'; |
| |
} |
| |
$result .= "\n"; |
| |
|
| |
# minor frequency: |
| |
|
| |
if ($spec->{'minorfreq'} != 0) { |
| |
$result .= "set m$type $spec->{'minorfreq'}\n"; |
| |
} |
| |
} elsif ($target eq 'tex' ) { |
| |
$result .= "set $type font " . '"Helvetica,22"' ."\n"; |
| |
} |
| |
|
| |
|
| |
return $result; |
| |
} |
| |
|
| ##------------------------------------------------------- write_gnuplot_file |
##------------------------------------------------------- write_gnuplot_file |
| sub write_gnuplot_file { |
sub write_gnuplot_file { |
|
Line 1614 sub write_gnuplot_file {
|
Line 1804 sub write_gnuplot_file {
|
| @curves = @curvescopy; |
@curves = @curvescopy; |
| # Collect all the colors |
# Collect all the colors |
| my @Colors; |
my @Colors; |
| push @Colors, $Apache::lonplot::plot{'bgcolor'}; |
if ($version < 4.6) { |
| push @Colors, $Apache::lonplot::plot{'fgcolor'}; |
push(@Colors,$Apache::lonplot::plot{'bgcolor'}); |
| push @Colors, (defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'}); |
push(@Colors,$Apache::lonplot::plot{'fgcolor'}); |
| foreach $curve (@curves) { |
push(@Colors,(defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'})); |
| push @Colors, ($curve->{'color'} ne '' ? |
foreach $curve (@curves) { |
| $curve->{'color'} : |
push(@Colors,($curve->{'color'} ne '' ? |
| $Apache::lonplot::plot{'fgcolor'} ); |
$curve->{'color'} : |
| |
$Apache::lonplot::plot{'fgcolor'})); |
| |
} |
| } |
} |
| |
|
| # set term |
# set term |
|
Line 1631 sub write_gnuplot_file {
|
Line 1823 sub write_gnuplot_file {
|
| '/'.$font_properties->{'file'}.'.ttf" '; |
'/'.$font_properties->{'file'}.'.ttf" '; |
| $gnuplot_input .= $fontsize; |
$gnuplot_input .= $fontsize; |
| $gnuplot_input .= ' size '.$Apache::lonplot::plot{'width'}.','.$Apache::lonplot::plot{'height'}.' '; |
$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 |
# set output |
| $gnuplot_input .= "set output\n"; |
$gnuplot_input .= "set output\n"; |
| } elsif ($target eq 'tex') { |
} elsif ($target eq 'tex') { |
|
Line 1641 sub write_gnuplot_file {
|
Line 1839 sub write_gnuplot_file {
|
| 'fontfile "'.$Apache::lonnet::perlvar{'lonFontsDir'}. |
'fontfile "'.$Apache::lonnet::perlvar{'lonFontsDir'}. |
| '/'.$font_properties->{'file'}.'.pfb" '; |
'/'.$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 .= ' "'.$font_properties->{'printname'}.'" '; |
| $gnuplot_input .= $fontsize; |
$gnuplot_input .= $fontsize; |
| $gnuplot_input .= "\nset output \"".$tmpdir. |
$gnuplot_input .= "\nset output \"".$tmpdir. |
|
Line 1648 sub write_gnuplot_file {
|
Line 1850 sub write_gnuplot_file {
|
| $gnuplot_input .= "set encoding iso_8859_1\n"; # Get access to extended font. |
$gnuplot_input .= "set encoding iso_8859_1\n"; # Get access to extended font. |
| |
|
| } |
} |
| |
$gnuplot_input .= "set encoding utf8\n"; |
| # cartesian or polar plot? |
# cartesian or polar plot? |
| if (lc($Apache::lonplot::plot{'plottype'}) eq 'polar') { |
if (lc($Apache::lonplot::plot{'plottype'}) eq 'polar') { |
| $gnuplot_input .= 'set polar'.$/; |
$gnuplot_input .= 'set polar'.$/; |
|
Line 1706 sub write_gnuplot_file {
|
Line 1909 sub write_gnuplot_file {
|
| if ($Apache::lonplot::plot{'gridlayer'} eq 'on'); |
if ($Apache::lonplot::plot{'gridlayer'} eq 'on'); |
| |
|
| # grid |
# 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 |
# border |
| $gnuplot_input .= ($Apache::lonplot::plot{'border'} eq 'on'? |
if ($Apache::lonplot::plot{'border'} eq 'on') { |
| 'set border'.$/ : |
if (($version >= 4.6) && ($Apache::lonplot::plot{'fgcolor'} ne '')) { |
| 'set noborder'.$/ ); |
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 |
# sampling rate for non-data curves |
| $gnuplot_input .= "set samples $Apache::lonplot::plot{'samples'}\n"; |
$gnuplot_input .= "set samples $Apache::lonplot::plot{'samples'}\n"; |
| # title, xlabel, ylabel |
# title, xlabel, ylabel |
| # titles |
# titles |
| my $extra_space_x = ($xtics{'location'} eq 'axis') ? ' 0, -0.5 ' : ''; |
my $extra_space_x = ($xtics{'location'} eq 'axis') ? ' offset 0, -0.5 ' : ''; |
| my $extra_space_y = ($ytics{'location'} eq 'axis') ? ' -0.5, 0 ' : ''; |
my $extra_space_y = ($ytics{'location'} eq 'axis') ? ' offset -0.5, 0 ' : ''; |
| |
|
| if ($target eq 'tex') { |
if ($target eq 'tex') { |
| $gnuplot_input .= "set title \"$title\" font \"".$font_properties->{'printname'}.",".$fontsize."pt\"\n" if (defined($title)) ; |
$gnuplot_input .= "set title \"$title\" font \"".$font_properties->{'printname'}.",".$fontsize."pt\"\n" if (defined($title)) ; |
|
Line 1728 sub write_gnuplot_file {
|
Line 1958 sub write_gnuplot_file {
|
| $gnuplot_input .= "set ylabel \"$ylabel\" $extra_space_y \n" if (defined($ylabel)); |
$gnuplot_input .= "set ylabel \"$ylabel\" $extra_space_y \n" if (defined($ylabel)); |
| } |
} |
| # tics |
# tics |
| if (%xtics) { |
$gnuplot_input .= &generate_tics('xtics', \%xtics, $target); |
| $gnuplot_input .= "set xtics $xtics{'location'} "; |
|
| $gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror "); |
$gnuplot_input .= &generate_tics('ytics', \%ytics, $target); |
| $gnuplot_input .= "$xtics{'start'}, "; |
|
| $gnuplot_input .= "$xtics{'increment'}, "; |
|
| $gnuplot_input .= "$xtics{'end'} "; |
|
| if ($target eq 'tex') { |
|
| $gnuplot_input .= 'font "Helvetica,22"'; # Needed in iso 8859-1 enc. |
|
| } |
|
| $gnuplot_input .= "\n"; |
|
| if ($xtics{'minorfreq'} != 0) { |
|
| $gnuplot_input .= "set mxtics ".$xtics{'minorfreq'}."\n"; |
|
| } |
|
| } else { |
|
| if ($target eq 'tex') { |
|
| $gnuplot_input .= 'set xtics font "Helvetica,22"'."\n"; # needed in iso 8859-1 enc |
|
| } |
|
| } |
|
| 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'} "; |
|
| if ($target eq 'tex') { |
|
| $gnuplot_input .= 'font "Helvetica,22"'; # Needed in iso-8859-1 encoding. |
|
| } |
|
| $gnuplot_input .= "\n"; |
|
| if ($ytics{'minorfreq'} != 0) { |
|
| $gnuplot_input .= "set mytics ".$ytics{'minorfreq'}."\n"; |
|
| } |
|
| } else { |
|
| if ($target eq 'tex') { |
|
| $gnuplot_input .= 'set ytics font "Helvetica,22"'."\n"; # Needed for iso 8859-1 enc. |
|
| } |
|
| } |
|
| # axis |
# axis |
| if (%axis) { |
if (%axis) { |
| if ($axis{'xformat'} ne 'on') { |
if ($axis{'xformat'} ne 'on') { |
|
Line 1771 sub write_gnuplot_file {
|
Line 1969 sub write_gnuplot_file {
|
| if ($axis{'xformat'} eq 'off') { |
if ($axis{'xformat'} eq 'off') { |
| $gnuplot_input .= "\"\"\n"; |
$gnuplot_input .= "\"\"\n"; |
| } else { |
} 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"; |
$gnuplot_input .= "\"\%.".$axis{'xformat'}."\"\n"; |
| } |
} |
| } |
} |
|
Line 1779 sub write_gnuplot_file {
|
Line 1985 sub write_gnuplot_file {
|
| if ($axis{'yformat'} eq 'off') { |
if ($axis{'yformat'} eq 'off') { |
| $gnuplot_input .= "\"\"\n"; |
$gnuplot_input .= "\"\"\n"; |
| } else { |
} 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"; |
$gnuplot_input .= "\"\%.".$axis{'yformat'}."\"\n"; |
| } |
} |
| } |
} |
|
Line 1826 sub write_gnuplot_file {
|
Line 2040 sub write_gnuplot_file {
|
| $gnuplot_input .= ' '.$label->{'justify'}; |
$gnuplot_input .= ' '.$label->{'justify'}; |
| |
|
| if ($target eq 'tex') { |
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 .= $/; |
$gnuplot_input .= $/; |
| } |
} |
|
Line 1842 sub write_gnuplot_file {
|
Line 2059 sub write_gnuplot_file {
|
| # type (solid/dashed), color, width |
# type (solid/dashed), color, width |
| # |
# |
| my $linestyle_index = 50; |
my $linestyle_index = 50; |
| my $line_type = ''; |
|
| my $line_color = ''; |
|
| my $line_width = ''; |
my $line_width = ''; |
| |
my $plots = ''; |
| |
|
| my $plot_command; |
# If arrows are needed there will be an arrow style for each as well: |
| my $plot_type; |
# |
| |
|
| |
my $arrow_style_index = 50; |
| |
|
| for (my $i = 0;$i<=$#curves;$i++) { |
for (my $i = 0;$i<=$#curves;$i++) { |
| $curve = $curves[$i]; |
$curve = $curves[$i]; |
| $plot_command.= ', ' if ($i > 0); |
my $plot_command = ''; |
| |
my $plot_type = ''; |
| |
if ($i > 0) { |
| |
$plot_type = ', '; |
| |
} |
| if ($target eq 'tex') { |
if ($target eq 'tex') { |
| $curve->{'linewidth'} *= 2; |
$curve->{'linewidth'} *= 2; |
| } |
} |
| |
$line_width = $curve->{'linewidth'}; |
| if (exists($curve->{'function'})) { |
if (exists($curve->{'function'})) { |
| $plot_type = |
$plot_type .= |
| $curve->{'function'}.' title "'. |
$curve->{'function'}.' title "'. |
| $curve->{'name'}.'" with '. |
$curve->{'name'}.'" with '. |
| $curve->{'linestyle'}; |
$curve->{'linestyle'}; |
|
Line 1880 sub write_gnuplot_file {
|
Line 2103 sub write_gnuplot_file {
|
| print $fh $datatext; |
print $fh $datatext; |
| close($fh); |
close($fh); |
| # generate gnuplot text |
# generate gnuplot text |
| $plot_type = '"'.$datafilename.'" title "'. |
$plot_type .= '"'.$datafilename.'" title "'. |
| $curve->{'name'}.'" with '. |
$curve->{'name'}.'" with '. |
| $curve->{'linestyle'}; |
$curve->{'linestyle'}; |
| } |
} |
| |
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. |
| |
|
| |
|
| if (($curve->{'linestyle'} eq 'points') || |
if (($curve->{'linestyle'} eq 'points') || |
| ($curve->{'linestyle'} eq 'linespoints') || |
($curve->{'linestyle'} eq 'linespoints') || |
| ($curve->{'linestyle'} eq 'errorbars') || |
($curve->{'linestyle'} eq 'errorbars') || |
| ($curve->{'linestyle'} eq 'xerrorbars') || |
($curve->{'linestyle'} eq 'xerrorbars') || |
| ($curve->{'linestyle'} eq 'yerrorbars') || |
($curve->{'linestyle'} eq 'yerrorbars') || |
| ($curve->{'linestyle'} eq 'xyerrorbars')) { |
($curve->{'linestyle'} eq 'xyerrorbars')) { |
| $plot_command.=' pointtype '.$curve->{'pointtype'}; |
|
| $plot_command.=' pointsize '.$curve->{'pointsize'}; |
$pointtype =' pointtype '.$curve->{'pointtype'}; |
| |
$pointsize =' pointsize '.$curve->{'pointsize'}; |
| } elsif ($curve->{'linestyle'} eq 'filledcurves') { |
} elsif ($curve->{'linestyle'} eq 'filledcurves') { |
| $plot_command.= ' '.$curve->{'limit'}; |
$plot_command.= ' '.$curve->{'limit'}; |
| } elsif ($curve->{'linetype'} ne '' && |
} elsif ($curve->{'linestyle'} eq 'vector') { |
| $curve->{'linestyle'} eq 'lines') { |
|
| $plot_command.= ' linetype '; |
# Create the arrow head style add it to |
| $plot_command.= $linetypes{$curve->{'linetype'}}; |
# $gnuplot_input..and ensure it gets |
| $plot_command.= ' linecolor rgb "'; |
# Selected in the plot command. |
| # convert color from xaaaaaa to #aaaaaa |
|
| $curve->{'color'} =~ s/^x/#/; |
$gnuplot_input .= "set style arrow $arrow_style_index "; |
| $plot_command.= $curve->{'color'}.'"'; |
$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++; |
| } |
} |
| $plot_command.= ' linewidth '.$curve->{'linewidth'}; |
|
| $gnuplot_input .= 'plot ' . $plot_type . ' ' . $plot_command . "\n"; |
my $style_command = "set style line $linestyle_index $pointtype $pointsize linetype $lt linewidth $line_width lc rgb '$color'\n"; |
| |
$gnuplot_input .= $style_command; |
| |
|
| |
# The condition below is because gnuplot lumps the linestyle in with the |
| |
# arrowstyle _sigh_. |
| |
|
| |
if ($curve->{'linestyle'} ne 'vector') { |
| |
$plot_command.= " ls $linestyle_index"; |
| |
} |
| |
|
| |
$plots .= $plot_type . ' ' . $plot_command; |
| |
$linestyle_index++; # Each curve get a unique linestyle. |
| } |
} |
| |
$gnuplot_input .= 'plot '.$plots; |
| # Write the output to a file. |
# Write the output to a file. |
| open (my $fh,">$tmpdir$filename.data"); |
|
| binmode($fh, ":utf8"); |
# &Apache::lonnet::logthis($gnuplot_input); # uncomment to log the gnuplot input. |
| |
open (my $fh, "> $tmpdir$filename.data"); |
| |
binmode($fh, ':utf8'); |
| print $fh $gnuplot_input; |
print $fh $gnuplot_input; |
| close($fh); |
close($fh); |
| # That's all folks. |
# That's all folks. |
|
Line 1939 sub check_inputs {
|
Line 2204 sub check_inputs {
|
| } |
} |
| } |
} |
| |
|
| #------------------------------------------------ make_edit |
#------------------------------------------ edit_attributes |
| sub edit_attributes { |
sub edit_attributes { |
| my ($target,$token,$defaults,$keys) = @_; |
my ($target,$token,$defaults,$keys) = @_; |
| my ($result,@keys); |
my ($result,@keys); |
|
Line 1969 sub edit_attributes {
|
Line 2234 sub edit_attributes {
|
| return $result; |
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; |
| |
} |
| |
|
| ################################################################### |
################################################################### |
| ## ## |
## ## |
|
Line 2167 described at http://www.lon-capa.org.
|
Line 2472 described at http://www.lon-capa.org.
|
| |
|
| =item edit_attributes() |
=item edit_attributes() |
| |
|
| |
=item fixup_colors() |
| |
|
| =back |
=back |
| |
|
| =head1 SUBROUTINES (Insertion functions for editing plots) |
=head1 SUBROUTINES (Insertion functions for editing plots) |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonplot.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml