--- loncom/xml/lonplot.pm 2001/12/21 22:45:47 1.17 +++ loncom/xml/lonplot.pm 2001/12/27 22:30:01 1.20 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Dynamic plot # -# $Id: lonplot.pm,v 1.17 2001/12/21 22:45:47 matthew Exp $ +# $Id: lonplot.pm,v 1.20 2001/12/27 22:30:01 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,15 +26,14 @@ # http://www.lon-capa.org/ # # 12/15/01 Matthew -# 12/17 12/18 12/19 12/20 12/21 Matthew +# 12/17 12/18 12/19 12/20 12/21 12/27 Matthew package Apache::lonplot; use strict; use Apache::File; use Apache::response; use Apache::lonxml; - -use Digest::MD5 qw(md5_base64); +use Apache::edit; sub BEGIN { &Apache::lonxml::register('Apache::lonplot',('plot')); @@ -53,6 +52,7 @@ sub BEGIN { ## grid ## border ## font +## align ## ## @labels: $labels[$i] = \%label ## %label: text, xpos, ypos, justify @@ -68,7 +68,8 @@ sub BEGIN { ## 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 $real_test = + sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\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| )+$/}; @@ -76,51 +77,177 @@ my $sml_test = sub {$_[0]=~/^(smal 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 +## Attribute metadata ## 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 }, - align => {default => 'left', test => $words_test } + height => { + default => 200, + test => $int_test, + description => 'vertical size of image (pixels)', + edit_type => 'entry' + }, + width => { + default => 200, + test => $int_test, + description => 'horizontal size of image (pixels)', + edit_type => 'entry' + }, + bgcolor => { + default => 'xffffff', + test => $color_test, + description => 'background color of image (xffffff)', + edit_type => 'entry' + }, + fgcolor => { + default => 'x000000', + test => $color_test, + description => 'foreground color of image (x000000)', + edit_type => 'entry' + }, + transparent => { + default => 'off', + test => $onoff_test, + description => '', + edit_type => 'on_off' + }, + grid => { + default => 'off', + test => $onoff_test, + description => '', + edit_type => 'on_off' + }, + border => { + default => 'on', + test => $onoff_test, + description => '', + edit_type => 'on_off' + }, + font => { + default => 'medium', + test => $sml_test, + description => 'Size of font to use', + edit_type => 'choice', + choices => ['small','medium','large'] + }, + align => { + default => 'left', + test => sub {$_[0]=~/^(left|right|center)$/}, + description => 'alignment for image in html', + edit_type => 'choice', + choices => ['left','right','center'] + } ); my %key_defaults = ( - title => { default => '', test => $words_test }, - box => { default => 'off', test => $onoff_test }, - pos => { default => 'top right', test => $key_pos_test } + title => { + default => '', + test => $words_test, + description => 'Title of key', + edit_type => 'entry' + }, + box => { + default => 'off', + test => $onoff_test, + description => 'Draw a box around the key?', + edit_type => 'on_off' + }, + pos => { + default => 'top right', + test => $key_pos_test, + description => 'position of the key on the plot', + edit_type => 'choice', + choices => ['top left','top right','bottom left','bottom right', + 'outside','below'] + } ); my %label_defaults = ( - xpos => {default => 0, test => $real_test }, - ypos => {default => 0, test => $real_test }, - justify => {default => 'left', - test => sub {$_[0]=~/^(left|right|center)$/} } + xpos => { + default => 0, + test => $real_test, + description => 'x position of label (graph coordinates)', + edit_type => 'entry' + }, + ypos => { + default => 0, + test => $real_test, + description => 'y position of label (graph coordinates)', + edit_type => 'entry' + }, + justify => { + default => 'left', + test => sub {$_[0]=~/^(left|right|center)$/}, + description => 'justification of the label text on the plot', + edit_type => 'choice', + choices => ['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 }, - linestyle => {default => 'points', test => $linestyle_test} + color => { + default => 'x000000', + test => $color_test, + description => 'color of axes (x000000)', + edit_type => 'entry' + }, + xmin => { + default => '-10.0', + test => $real_test, + description => 'minimum x-value shown in plot', + edit_type => 'entry' + }, + xmax => { + default => ' 10.0', + test => $real_test, + description => 'maximum x-value shown in plot', + edit_type => 'entry' + }, + ymin => { + default => '-10.0', + test => $real_test, + description => 'minimum y-value shown in plot', + edit_type => 'entry' + }, + ymax => { + default => ' 10.0', + test => $real_test, + description => 'maximum y-value shown in plot', + edit_type => 'entry' + }, + linestyle => { + default => 'points', + test => $linestyle_test, + description => 'Style of the axis lines', + edit_type => 'choice', + choices => ['lines','linespoints','dots','points'] + } ); my %curve_defaults = ( - color => {default => 'x000000', test => $color_test }, - name => {default => '', test => $words_test }, - linestyle => {default => 'lines', test => $linestyle_test } + color => { + default => 'x000000', + test => $color_test, + description => 'color of curve (x000000)', + edit_type => 'entry' + }, + name => { + default => '', + test => $words_test, + description => 'name of curve to appear in key', + edit_type => 'entry' + }, + linestyle => { + default => 'lines', + test => $linestyle_test, + description => 'Style of the axis lines', + edit_type => 'choice', + choices => ['lines','linespoints','dots','points','steps'] + } ); ## @@ -146,6 +273,14 @@ sub start_plot { ##------------------------------------------------------- &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval, $tagstack->[-1]); + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args + ($token,$parstack,$safeeval,keys %plot_defaults); + if ($constructtag) { + $result = &Apache::edit::rebuild_tag($token); + $result.= &Apache::edit::handle_insert(); + } } return ''; } @@ -194,6 +329,8 @@ sub end_plot { align = "$plot{'align'}" alt = "/cgi-bin/plot.gif?$filename" /> ENDIMAGE + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -205,7 +342,14 @@ sub start_key { if ($target eq 'web') { &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, $tagstack->[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args + ($token,$parstack,$safeeval,keys %key_defaults); + if ($constructtag) { + $result = &Apache::edit::rebuild_tag($token); + $result.= &Apache::edit::handle_insert(); + } } return $result; } @@ -214,7 +358,8 @@ sub end_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -224,7 +369,8 @@ sub start_title { my $result=''; if ($target eq 'web') { $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -233,7 +379,8 @@ sub end_title { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -243,7 +390,8 @@ sub start_xlabel { my $result=''; if ($target eq 'web') { $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -252,7 +400,8 @@ sub end_xlabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -262,7 +411,8 @@ sub start_ylabel { my $result=''; if ($target eq 'web') { $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -271,7 +421,8 @@ sub end_ylabel { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -289,8 +440,15 @@ sub start_label { $label{'text'} = 'Illegal text'; } push(@labels,\%label); + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args + ($token,$parstack,$safeeval,keys %label_defaults); + if ($constructtag) { + $result = &Apache::edit::rebuild_tag($token); + $result.= &Apache::edit::handle_insert(); + } } - # This routine should never return anything. return $result; } @@ -298,7 +456,8 @@ sub end_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -314,7 +473,14 @@ sub start_curve { push (@curves,\%curve); &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args + ($token,$parstack,$safeeval,keys %label_defaults); + if ($constructtag) { + $result = &Apache::edit::rebuild_tag($token); + $result.= &Apache::edit::handle_insert(); + } } return $result; } @@ -325,7 +491,8 @@ sub end_curve { if ($target eq 'web') { pop @Apache::lonxml::namespace; &Apache::lonxml::deregister('Apache::lonplot',('function','data')); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -340,7 +507,16 @@ sub start_function { } $curves[-1]->{'function'} = &Apache::lonxml::get_all_text("/function",$$parser[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + $result.=&Apache::edit::tag_start($target,$token); + my $text=&Apache::lonxml::get_all_text("/function",$$parser[-1]); + $result.=''. + &Apache::edit::editfield('',$text,'',20,1). + &Apache::edit::end_table(); + } elsif ($target eq 'modified') { + # Why do I do this? + my $text=$$parser[-1]->get_text("/function"); + $result.=&Apache::edit::modifiedfield($token); } return $result; } @@ -349,7 +525,8 @@ sub end_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -365,13 +542,7 @@ sub start_data { delete($curves[-1]->{'function'}); } my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); - &Apache::lonxml::warning( - ' Length of data string: '.length($datatext)); $datatext =~ s/\s+/ /g; - if ($datatext !~ /^(([+-]?\d*\.?\d*)[, ]?)+$/) { - &Apache::lonxml::warning('Malformed data: '.$datatext); - $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. @@ -381,15 +552,25 @@ sub start_data { } else { # Assume it's space seperated. @data = split / /,$datatext; } - &Apache::lonxml::warning(' Data Points: '.$#data); for (my $i=0;$i<=$#data;$i++) { # Check that it's non-empty + if (! defined($data[$i])) { + &Apache::lonxml::warning( + 'undefined value. Replacing with '. + ' pi/e = 1.15572734979092'); + $data[$i] = 1.15572734979092; + } # Check that it's a number - # Maybe I need a 'debug=on' switch to list the data set - # out in a warning? + if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) { + &Apache::lonxml::warning( + 'Bad value of '.$data[$i].' Replacing with '. + ' pi/e = 1.15572734979092'); + $data[$i] = 1.15572734979092; + } } push @{$curves[-1]->{'data'}},\@data; - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -398,7 +579,8 @@ sub end_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -410,7 +592,8 @@ sub start_axis { if ($target eq 'web') { &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, $tagstack->[-1]); - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { } return $result; } @@ -419,7 +602,14 @@ sub end_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; if ($target eq 'web') { - # This routine should never return anything. + } elsif ($target eq 'edit') { + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args + ($token,$parstack,$safeeval,keys %axis_defaults); + if ($constructtag) { + $result = &Apache::edit::rebuild_tag($token); + $result.= &Apache::edit::handle_insert(); + } } return $result; } @@ -441,8 +631,7 @@ sub get_attributes{ my $parstack = shift; my $safeeval = shift; my $tag = shift; - my $attr; - foreach $attr (keys %{$defaults}) { + foreach my $attr (keys %{$defaults}) { $values->{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval); if ($values->{$attr} eq '' | !defined($values->{$attr})) { @@ -539,11 +728,111 @@ sub write_gnuplot_file { $gnuplot_input .= $/.$datatext; return $gnuplot_input; } +#------------------------------------------------ make_edit +sub edit_attributes { + my $target = shift; + my $token = shift; + my $defaults = shift; + my $result; + foreach my $attr (%{$token->[2]}) { + if ($defaults->{$attr}->{'edit_type'} eq 'entry') { + $result .= &Apache::edit::text_arg( + $defaults->{$attr}->{'description'}, + $attr, + $token); + } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { + $result .= &Apache::edit::select_arg( + $defaults->{$attr}->{'description'}, + $attr, + $defaults->{$attr}->{'choices'}, + $token); + } + } + return $result; +} -1; -__END__ +#------------------------------------------------ insert_xxxxxxx +sub insert_plot { + my $result; + # plot attributes + $result .= '{'default'}. + "\"\n"; + } + $result .= ">\n"; + # Add the components + $result .= &insert_key(); + $result .= &insert_axis(); + $result .= &insert_label(); + $result .= &insert_curve(); + $result .= &insert_function(); + $result .= "\n"; + $result .= &insert_curve(); + $result .= &insert_data(); + $result .= "\n"; + # close up the + $result .= "\n"; + return $result; +} +sub insert_key { + my $result; + $result .= ' {'default'}. + "\"\n"; + } + $result .= " />\n"; + return $result; +} + +sub insert_axis{ + my $result; + $result .= ' {'default'}. + "\"\n"; + } + $result .= " />\n"; + return $result; +} +sub insert_label { + my $result; + $result .= ' \n"; + return $result; +} +sub insert_curve { + my $result; + $result .= ' {'default'}."\"\n"; + } + $result .= " >\n"; +} + +sub insert_function { + my $result; + $result .= "\n"; + return $result; +} + +sub insert_data { + my $result; + $result .= " \n"; + $result .= " \n"; + return $result; +} + +1; +__END__