# The LearningOnline Network with CAPA
# Dynamic plot
#
# $Id: lonplot.pm,v 1.13 2001/12/21 15:27:29 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# 12/15/01 Matthew
# 12/18 12/19 12/20 Matthew
package Apache::lonplot;
use strict;
use Apache::File;
use Apache::response;
use Apache::lonxml;
use Digest::MD5 qw(md5_base64);
sub BEGIN {
&Apache::lonxml::register('Apache::lonplot',('plot'));
}
##
## Description of data structures:
##
## %plot %key %axis
## --------------------------
## height title color
## width box xmin
## bgcolor pos xmax
## fgcolor ymin
## transparent ymax
## grid
## border
## font
##
## @labels: $labels[$i] = \%label
## %label: text, xpos, ypos, justify
##
## @curves: $curves[$i] = \%curve
## %curve: name, linestyle, ( function | data )
##
## $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
## [y1,y2,y3,y4] ]
##
##------------------------------------------------------------
##
## Tests used in checking the validitity of input
##
my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
my $real_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*$/};
my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
my $onoff_test = sub {$_[0]=~/^(on|off)$/};
my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
my $sml_test = sub {$_[0]=~/^(small|medium|large)$/};
my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^(\w+ ?)+$/};
##
## Default values for attributes of elements
##
my %plot_defaults =
(
height => {default => 200, test => $int_test },
width => {default => 200, test => $int_test },
bgcolor => {default => 'xffffff', test => $color_test },
fgcolor => {default => 'x000000', test => $color_test },
transparent => {default => 'off', test => $onoff_test },
grid => {default => 'off', test => $onoff_test },
border => {default => 'on', test => $onoff_test },
font => {default => 'medium', test => $sml_test }
);
my %key_defaults =
(
title => { default => '', test => $words_test },
box => { default => 'off', test => $onoff_test },
pos => { default => 'top right', test => $key_pos_test }
);
my %label_defaults =
(
xpos => {default => 0, test => $real_test },
ypos => {default => 0, test => $real_test },
justify => {default => 'left',
test => sub {$_[0]=~/^(left|right|center)$/} }
);
my %axis_defaults =
(
color => {default => 'x000000', test => $color_test},
xmin => {default => '-10.0', test => $real_test },
xmax => {default => ' 10.0', test => $real_test },
ymin => {default => '-10.0', test => $real_test },
ymax => {default => ' 10.0', test => $real_test }
);
my %curve_defaults =
(
color => {default => 'x000000', test => $color_test },
name => {default => '', test => $words_test },
linestyle => {default => 'lines', test => $linestyle_test }
);
##
## End of defaults
##
my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
sub start_plot {
%plot = undef; %key = undef; %axis = undef;
$title = undef; $xlabel = undef; $ylabel = undef;
$#labels = -1; $#curves = -1;
#
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
&Apache::lonxml::register('Apache::lonplot',
('title','xlabel','ylabel','key','axis','label','curve'));
push (@Apache::lonxml::namespace,'plot');
## Always evaluate the insides of the
'; $result .= $filename.$/; print $fh &write_gnuplot_file(); $result .= ''.$/; ## return image tag for the plot $result .= <<"ENDIMAGE"; ENDIMAGE } return $result; } ##----------------------------------------------------------------- key sub start_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, $tagstack->[-1]); if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------------- title sub start_title { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); my $result=''; if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_title { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------------- xlabel sub start_xlabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_xlabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------------- ylabel sub start_ylabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_ylabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------------- label sub start_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my %label; &get_attributes(\%label,\%label_defaults,$parstack,$safeeval, $tagstack->[-1]); $label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]); if (! &$words_test($label{'text'})) { # I should probably warn about it, too. $label{'text'} = 'Illegal text'; } push(@labels,\%label); if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------------- curve sub start_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my %curve; &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, $tagstack->[-1]); push (@curves,\%curve); &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); if ($target eq 'web') { # This routine should never return anything. } return $result; } sub end_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; pop @Apache::lonxml::namespace; &Apache::lonxml::deregister('Apache::lonplot',('function','data')); if ($target eq 'web') { # This routine should never return anything. } return $result; } ##------------------------------------------------------------ curve function sub start_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if (exists($curves[-1]->{'data'})) { &Apache::lonxml::warning('Use of