# The LearningOnline Network with CAPA
# Dynamic plot
#
# $Id: lonplot.pm,v 1.2 2001/12/18 15:33:47 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/
#
# 2/21 Guy
package Apache::lonplot;
use strict;
use Apache::response;
use Apache::lonxml;
use Digest::MD5 qw(md5 md5_hex md5_base64);
sub BEGIN {
&Apache::lonxml::register('Apache::lonplot',('plot'));
}
##
## Tests used in checking the validitity of input
##
my $int_test = sub {$_[0]=~/^\d+$/};
my $real_test = sub {$_[0]=~/^[+-]?\d*\.?\d*$/};
my $color_test = sub {$_[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)$/};
##
## 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 => "on" , test => $onoff_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 },
color => {default => "x000000", test => $color_test },
justify => {default => "left",
test => sub {$_[0]=~/^(left|right|center)$/}}
);
my %axis_defaults =
(
color => {default => "x000000", test => $color_test},
thickness => {default => 1, test => $int_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 => "x000000", test => sub {$_[0]=~/^[\w ]*$/} },
linestyle => {default => "lines", test => $linestyle_test }
);
##
## End of defaults
##
my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
sub start_plot {
%plot = ''; %key=''; %axis='';
$title=''; $xlabel=''; $ylabel='';
@labels = ''; @curves='';
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
&Apache::lonxml::register('Apache::plot',
('title','xlabel','ylabel','key','axis','label','curve'));
push (@Apache::lonxml::namespace,'plot');
##-------------------------------------------------------
## How do I do this? I need to "eval" and I need to keep the info
## available for the parser.
##
my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
my $eval=&Apache::lonxml::get_param('eval',$parstack,$safeeval);
if ($eval eq 'on') {
$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
#&Apache::lonxml::debug("M is evaulated to:$inside:");
}
##-------------------------------------------------------
&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot');
return '';
}
sub end_plot {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
pop @Apache::lonxml::namespace;
my $result;
## Determine filename
my $tmpdir = '/home/httpd/perl/tmp/';
my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
'_plot.data';
my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});
## Write the plot description to the file
my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname);
## Ack!
## return image tag for the plot
$result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';
return $result;
}
##----------------------------------------------------------------- key
sub start_key {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
&get_attributes(\%key,\%key_defaults,$parstack,$safeeval,'key');
return $result;
}
sub end_key {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
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='';
return $result;
}
sub end_title {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
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]);
return $result;
}
sub end_xlabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
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]);
return $result;
}
sub end_ylabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------------- label
sub start_label {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
my $label = &newhashref();
&get_attributes($label,\%label_defaults,$parstack,$safeeval,'label');
$label->{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
push(@labels,$label);
return $result;
}
sub end_label {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------------- curve
sub start_curve {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
my $curve = &newhashref();
&get_attributes($curve,\%curve_defaults,$parstack,$safeeval,'curve');
push (@curves,$curve);
&Apache::lonxml::register('Apache::plot',('function','data'));
push (@Apache::lonxml::namespace,'curve');
return $result;
}
sub end_curve {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------ curve function
sub start_function {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
$curves[-1]->{'function'} =
&Apache::lonxml::get_all_text("/function",$$parser[-1]);
return $result;
}
sub end_function {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------ curve data
sub start_data {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
push( @{$curves[-1]->{'data'}},
&Apache::lonxml::get_all_text("/data",$$parser[-1]));
return $result;
}
sub end_data {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------------- axis
sub start_axis {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';
&get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,'axis');
return $result;
}
sub end_axis {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';
return $result;
}
##------------------------------------------------------------------- misc
sub newhashref{
my %hash;
return \%hash;
}
sub get_attributes{
%values = %{shift};
%defaults = %{shift};
$parstack = shift;
$safeeval = shift;
$tag = shift;
my $attr;
foreach $attr (keys %defaults) {
$values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
my $test = $defaults{$attr}->{'test'};
if (! &$test($values{$attr})) {
&Apache::lonxml::warning($tag.':'.$attr.': Bad value. Replacing your value with : '.$defaults{$attr});
$values{$attr} = $defaults{$attr};
}
return ;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>