Return to lonplot.pm CVS log

Up to [LON-CAPA] / loncom / xml

Routine to parse <plot> tag.

# The LearningOnline Network with CAPA
# Dynamic plot
#
# $Id: lonplot.pm,v 1.1 2001/12/17 21:43:12 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;

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');
    &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval);
    return '';
}

sub get_attributes{
    %values   = %{$_[0]};
    %defaults = %{$_[1]};
    $parstack = $_[2];
    $safeeval = $_[3];
    my $attr;
    foreach $attr (keys %defaults) {
	$values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
	my $test = $defaults{$attr}->{'test'};
	$values{$attr} = (&$test($values{$attr}) ?
			  $values{$attr}         :
			  $defaults{$attr}      );
    }
    return ;
}

sub end_plot {
    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
    pop @Apache::lonxml::namespace;
    my $result;
    ## Determine filename
    my $filename = 
    ## Write the plot description to the file
    ## return image tag for the plot
    return $result;
}
##----------------------------------------------------------------- key
sub start_key {
    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
    my $result='';
    &get_attributes(\%key,\%key_defaults,$parstack,$safeeval);
    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->{'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);
    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);
    return $result;
}

sub end_axis {
    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
    my $result = '';
    return $result;
}

##------------------------------------------------------------------- misc
sub newhashref{
    my %hash;
    return \%hash;
}


1;
__END__