--- loncom/xml/lonplot.pm 2001/12/18 22:29:42 1.5 +++ loncom/xml/lonplot.pm 2001/12/19 18:27:30 1.6 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Dynamic plot # -# $Id: lonplot.pm,v 1.5 2001/12/18 22:29:42 matthew Exp $ +# $Id: lonplot.pm,v 1.6 2001/12/19 18:27:30 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,6 @@ sub BEGIN { &Apache::lonxml::register('Apache::lonplot',('plot')); } - ## ## Tests used in checking the validitity of input ## @@ -75,7 +74,6 @@ 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)$/}} ); @@ -83,7 +81,7 @@ my %label_defaults = my %axis_defaults = ( color => {default => 'x000000', test => $color_test}, - thickness => {default => 1, test => $int_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 }, @@ -106,7 +104,7 @@ 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', @@ -130,7 +128,8 @@ sub end_plot { ('title','xlabel','ylabel','key','axis','label','curve')); my $result = ''; if ($target eq 'web') { - ## Determine filename -- may need a better way later + ## Determine filename -- Need to use the 'id' thingy that Gerd + ## mentioned. my $tmpdir = '/home/httpd/perl/tmp/'; my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}. '_plot.data'; @@ -138,13 +137,7 @@ sub end_plot { ## Write the plot description to the file my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname); - # write plot values - # write title, xlabel, ylabel - # write key values - # write axis values - # write label values - # write curve values - ## Ack! + &write_gnuplot_file($fh); ## return image tag for the plot $result = '{'data'}},$datatext; + # Need to do some error checking on the @data array - + # make sure it's all numbers and make sure each array + # is of the same length. + my @data = split /[, ]/,$datatext; + push( @{$curves[-1]->{'data'}},\@data; if ($target eq 'web') { # This routine should never return anything. } @@ -362,14 +357,93 @@ sub get_attributes{ my $attr; foreach $attr (keys %defaults) { $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval); + if ($values{$attr} eq '' | !defined($values{$attr})) { + $values{$attr} = $defaults{$attr}; + next; + } my $test = $defaults{$attr}->{'test'}; if (! &$test($values{$attr})) { - &Apache::lonxml::warning($tag.':'.$attr.': Bad value. Replacing your value with : '.$defaults{$attr}); + &Apache::lonxml::warning + ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' + .$defaults{$attr} ); $values{$attr} = $defaults{$attr}; } return ; } +sub write_gnuplot_file { + my $fh = shift; + my $gnuplot_input = ''; + # Collect all the colors + my @Colors; + push @Colors, $plot{'bgcolor'}; + push @Colors, $plot{'fgcolor'}; + push @Colors, $axis{'color'}; + push @Colors, $axis{'color'}; + foreach $curve (@Curves) { + push @Colors, ($curve{'color'} ne '' ? + $curve{'color'} : + $plot{'fgcolor'} ); + } + # set term + $gnuplot_input .= 'set term gif '; + $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on'); + $gnuplot_input .= $plot{'font'} . ' '; + $gnuplot_input .= 'size ' . $plot{'width'} . ' '; + $gnuplot_input .= $plot{'height'} . ' '; + $gnuplot_input .= "@Colors\n"; + # title, xlabel, ylabel + { + $gnuplot_input .<<"ENDLABELS"; +set title $title->{'text'} +set xlabel $xlabel->{'text'} +set ylabel $ylabel->{'text'} +set xrange $axis->{'xmin'}:$axis->{'xmax'} +set yrange $axis->{'ymin'}:$axis->{'ymax'} +ENDLABELS + } + # Key + if (defined($key{'pos'})) { + $gnuplot_input .= 'set key '.$key->{'pos'}.' '; + $gnuplot_input .= ($key->{'box'} eq 'on' ? 'box ' : 'nobox '); + if ($key->{'title'} ne '') { + $gnuplot_input .= 'title "'$key->{'title'}.'"\n'; + } else { + $gnuplot_input .= '\n'; + } + } else { + $gnuplot_input .= 'set nokey\n'; + } + # axis + $gnuplot_input .= 'set xrange ['.$axis{'xmin'}.':'.$axis{'xmin'}.']\n'; + $gnuplot_input .= 'set yrange ['.$axis{'ymin'}.':'.$axis{'ymin'}.']\n'; + # labels + foreach $label (@labels) { + $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. + $label->{'x'}.','.$label->{'y'}.'\n'; + } + # curves + $gnuplot_input .= 'plot '; + my $datatext = ''; + foreach $curve (@curves) { + if (exists($curve->{'function'})) { + $gnuplot_input.= $curve->{'function'}.' with '.$curve->{'linestyle'}; + } elsif (exists($curve->{'data'})) { + $gnuplot_input.= '\'-\' with '.$curve->{'linestyle'}; + my @Data = @{$curve->{'data'}}; + for ($i =0; $i<=$#Data; $i++) { + foreach $dataset (@Data) { + $datatext .= $dataset[$i] . ' '; + } + $datatext .='\n'; + } + $datatext .='\n'; + } + } + $gnuplot_input .= $datatext; + print $fh $gnuplot_input; +} + 1; __END__