Annotation of loncom/xml/lonplot.pm, revision 1.34
1.1 matthew 1: # The LearningOnline Network with CAPA
2: # Dynamic plot
3: #
1.34 ! matthew 4: # $Id: lonplot.pm,v 1.33 2002/01/06 02:19:25 harris41 Exp $
1.1 matthew 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.3 matthew 28: # 12/15/01 Matthew
1.31 matthew 29: # 12/17 12/18 12/19 12/20 12/21 12/27 12/28 12/30 12/31 Matthew
30: # 01/01/02 Matthew
1.34 ! matthew 31: # 01/02 01/03 01/04 Matthew
1.1 matthew 32: package Apache::lonplot;
1.10 matthew 33:
1.1 matthew 34: use strict;
1.10 matthew 35: use Apache::File;
1.1 matthew 36: use Apache::response;
1.2 matthew 37: use Apache::lonxml;
1.20 matthew 38: use Apache::edit;
1.10 matthew 39:
1.33 harris41 40: BEGIN {
1.1 matthew 41: &Apache::lonxml::register('Apache::lonplot',('plot'));
42: }
43:
1.10 matthew 44: ##
45: ## Description of data structures:
46: ##
47: ## %plot %key %axis
48: ## --------------------------
49: ## height title color
50: ## width box xmin
51: ## bgcolor pos xmax
52: ## fgcolor ymin
53: ## transparent ymax
54: ## grid
55: ## border
56: ## font
1.19 matthew 57: ## align
1.10 matthew 58: ##
59: ## @labels: $labels[$i] = \%label
60: ## %label: text, xpos, ypos, justify
1.14 matthew 61: ##
1.10 matthew 62: ## @curves: $curves[$i] = \%curve
1.14 matthew 63: ## %curve: name, linestyle, ( function | data )
1.10 matthew 64: ##
65: ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
66: ## [y1,y2,y3,y4] ]
67: ##
1.21 matthew 68:
69: ###################################################################
70: ## ##
71: ## Tests used in checking the validitity of input ##
72: ## ##
73: ###################################################################
1.29 matthew 74:
1.32 matthew 75: my $max_str_len = 50; # if a label, title, xlabel, or ylabel text
76: # is longer than this, it will be truncated.
77:
1.29 matthew 78: my %linestyles =
79: (
80: lines => 2, # Maybe this will be used in the future
81: linespoints => 2, # to check on whether or not they have
82: dots => 2, # supplied enough <data></data> fields
83: points => 2, # to use the given line style. But for
84: steps => 2, # now there are more important things
85: fsteps => 2, # for me to deal with.
86: histeps => 2,
1.34 ! matthew 87: errorbars => 3,
! 88: xerrorbars => [3,4],
! 89: yerrorbars => [3,4],
! 90: xyerrorbars => [4,6,7],
! 91: boxes => 3,
! 92: boxerrorbars => [3,4,5],
! 93: boxxyerrorbars => [4,6,7],
! 94: financebars => 5,
! 95: candlesticks => 5,
1.29 matthew 96: vector => 2
97: );
98:
1.11 matthew 99: my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
1.19 matthew 100: my $real_test =
101: sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
1.11 matthew 102: my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
1.1 matthew 103: my $onoff_test = sub {$_[0]=~/^(on|off)$/};
1.15 matthew 104: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
1.1 matthew 105: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/};
1.29 matthew 106: my $linestyle_test = sub {exists($linestyles{$_[0]})};
1.15 matthew 107: my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w\(\)]+ ?)+$/};
1.21 matthew 108:
109: ###################################################################
110: ## ##
111: ## Attribute metadata ##
112: ## ##
113: ###################################################################
1.34 ! matthew 114: my @plot_edit_order =
! 115: qw/bgcolor fgcolor height width font transparent grid border/;
1.1 matthew 116: my %plot_defaults =
117: (
1.20 matthew 118: height => {
119: default => 200,
120: test => $int_test,
1.29 matthew 121: description => 'height of image (pixels)',
1.20 matthew 122: edit_type => 'entry'
123: },
124: width => {
125: default => 200,
126: test => $int_test,
1.29 matthew 127: description => 'width of image (pixels)',
1.20 matthew 128: edit_type => 'entry'
129: },
130: bgcolor => {
131: default => 'xffffff',
132: test => $color_test,
133: description => 'background color of image (xffffff)',
134: edit_type => 'entry'
135: },
136: fgcolor => {
137: default => 'x000000',
138: test => $color_test,
139: description => 'foreground color of image (x000000)',
140: edit_type => 'entry'
141: },
142: transparent => {
143: default => 'off',
144: test => $onoff_test,
1.34 ! matthew 145: description => 'Transparent image',
1.20 matthew 146: edit_type => 'on_off'
147: },
148: grid => {
149: default => 'off',
150: test => $onoff_test,
1.34 ! matthew 151: description => 'Display grid',
1.20 matthew 152: edit_type => 'on_off'
153: },
154: border => {
155: default => 'on',
156: test => $onoff_test,
1.34 ! matthew 157: description => 'Draw border around plot',
1.20 matthew 158: edit_type => 'on_off'
159: },
160: font => {
161: default => 'medium',
162: test => $sml_test,
163: description => 'Size of font to use',
164: edit_type => 'choice',
165: choices => ['small','medium','large']
166: },
167: align => {
168: default => 'left',
169: test => sub {$_[0]=~/^(left|right|center)$/},
170: description => 'alignment for image in html',
171: edit_type => 'choice',
172: choices => ['left','right','center']
173: }
1.1 matthew 174: );
175:
176: my %key_defaults =
177: (
1.20 matthew 178: title => {
179: default => '',
180: test => $words_test,
181: description => 'Title of key',
182: edit_type => 'entry'
183: },
184: box => {
185: default => 'off',
186: test => $onoff_test,
187: description => 'Draw a box around the key?',
188: edit_type => 'on_off'
189: },
190: pos => {
191: default => 'top right',
192: test => $key_pos_test,
193: description => 'position of the key on the plot',
194: edit_type => 'choice',
195: choices => ['top left','top right','bottom left','bottom right',
196: 'outside','below']
197: }
1.1 matthew 198: );
199:
200: my %label_defaults =
201: (
1.20 matthew 202: xpos => {
203: default => 0,
204: test => $real_test,
205: description => 'x position of label (graph coordinates)',
206: edit_type => 'entry'
207: },
208: ypos => {
209: default => 0,
210: test => $real_test,
211: description => 'y position of label (graph coordinates)',
212: edit_type => 'entry'
213: },
214: justify => {
215: default => 'left',
216: test => sub {$_[0]=~/^(left|right|center)$/},
217: description => 'justification of the label text on the plot',
218: edit_type => 'choice',
219: choices => ['left','right','center']
220: }
1.1 matthew 221: );
222:
223: my %axis_defaults =
224: (
1.28 matthew 225: color => {
1.20 matthew 226: default => 'x000000',
227: test => $color_test,
228: description => 'color of axes (x000000)',
229: edit_type => 'entry'
230: },
231: xmin => {
232: default => '-10.0',
233: test => $real_test,
234: description => 'minimum x-value shown in plot',
235: edit_type => 'entry'
236: },
237: xmax => {
238: default => ' 10.0',
239: test => $real_test,
240: description => 'maximum x-value shown in plot',
241: edit_type => 'entry'
242: },
243: ymin => {
244: default => '-10.0',
245: test => $real_test,
246: description => 'minimum y-value shown in plot',
247: edit_type => 'entry'
248: },
249: ymax => {
250: default => ' 10.0',
251: test => $real_test,
252: description => 'maximum y-value shown in plot',
253: edit_type => 'entry'
254: }
1.1 matthew 255: );
256:
257: my %curve_defaults =
258: (
1.20 matthew 259: color => {
260: default => 'x000000',
261: test => $color_test,
262: description => 'color of curve (x000000)',
263: edit_type => 'entry'
264: },
265: name => {
266: default => '',
267: test => $words_test,
268: description => 'name of curve to appear in key',
269: edit_type => 'entry'
270: },
271: linestyle => {
272: default => 'lines',
273: test => $linestyle_test,
274: description => 'Style of the axis lines',
275: edit_type => 'choice',
1.29 matthew 276: choices => ['lines','linespoints','dots','points','steps',
277: 'fsteps','histeps','errorbars','xerrorbars',
278: 'yerrorbars','xyerrorbars','boxes','boxerrorbars',
279: 'boxxyerrorbars','financebars','candlesticks',
280: 'vector']
1.20 matthew 281: }
1.1 matthew 282: );
283:
1.21 matthew 284: ###################################################################
285: ## ##
286: ## parsing and edit rendering ##
287: ## ##
288: ###################################################################
1.1 matthew 289: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
290:
291: sub start_plot {
1.23 matthew 292: %plot = (); %key = (); %axis = ();
1.10 matthew 293: $title = undef; $xlabel = undef; $ylabel = undef;
294: $#labels = -1; $#curves = -1;
1.6 matthew 295: #
1.1 matthew 296: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
297: my $result='';
1.25 matthew 298: &Apache::lonxml::register('Apache::lonplot',
299: ('title','xlabel','ylabel','key','axis','label','curve'));
1.29 matthew 300: push (@Apache::lonxml::namespace,'lonplot');
1.4 matthew 301: if ($target eq 'web') {
1.29 matthew 302: my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
1.17 matthew 303: $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
1.29 matthew 304: &Apache::lonxml::newparser($parser,\$inside);
1.17 matthew 305: &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
306: $tagstack->[-1]);
1.20 matthew 307: } elsif ($target eq 'edit') {
1.25 matthew 308: $result .= &Apache::edit::tag_start($target,$token,'Plot');
1.34 ! matthew 309: $result .= &edit_attributes($target,$token,\%plot_defaults,
! 310: \@plot_edit_order);
1.20 matthew 311: } elsif ($target eq 'modified') {
312: my $constructtag=&Apache::edit::get_new_args
1.24 matthew 313: ($token,$parstack,$safeeval,keys(%plot_defaults));
1.20 matthew 314: if ($constructtag) {
315: $result = &Apache::edit::rebuild_tag($token);
1.26 matthew 316: # $result.= &Apache::edit::handle_insert();
1.20 matthew 317: }
1.4 matthew 318: }
1.21 matthew 319: return $result;
1.1 matthew 320: }
321:
322: sub end_plot {
323: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.25 matthew 324:
1.1 matthew 325: pop @Apache::lonxml::namespace;
1.4 matthew 326: &Apache::lonxml::deregister('Apache::lonplot',
327: ('title','xlabel','ylabel','key','axis','label','curve'));
328: my $result = '';
329: if ($target eq 'web') {
1.21 matthew 330: &check_inputs(); # Make sure we have all the data we need
1.13 matthew 331: ##
332: ## Determine filename
1.4 matthew 333: my $tmpdir = '/home/httpd/perl/tmp/';
1.12 matthew 334: my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
1.29 matthew 335: '_'.time.'_'.$$.int(rand(1000)).'_plot.data';
1.4 matthew 336: ## Write the plot description to the file
1.12 matthew 337: my $fh=Apache::File->new(">$tmpdir$filename");
338: print $fh &write_gnuplot_file();
1.14 matthew 339: close($fh);
1.4 matthew 340: ## return image tag for the plot
1.12 matthew 341: $result .= <<"ENDIMAGE";
1.16 matthew 342: <img src = "/cgi-bin/plot.gif?$filename"
343: width = "$plot{'width'}"
344: height = "$plot{'height'}"
345: align = "$plot{'align'}"
346: alt = "/cgi-bin/plot.gif?$filename" />
1.12 matthew 347: ENDIMAGE
1.20 matthew 348: } elsif ($target eq 'edit') {
1.21 matthew 349: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 350: }
1.1 matthew 351: return $result;
352: }
1.2 matthew 353:
1.1 matthew 354: ##----------------------------------------------------------------- key
355: sub start_key {
356: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
357: my $result='';
1.17 matthew 358: if ($target eq 'web') {
359: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
1.11 matthew 360: $tagstack->[-1]);
1.20 matthew 361: } elsif ($target eq 'edit') {
1.25 matthew 362: $result .= &Apache::edit::tag_start($target,$token,'Plot Key');
1.21 matthew 363: $result .= &edit_attributes($target,$token,\%key_defaults);
1.20 matthew 364: } elsif ($target eq 'modified') {
365: my $constructtag=&Apache::edit::get_new_args
1.24 matthew 366: ($token,$parstack,$safeeval,keys(%key_defaults));
1.20 matthew 367: if ($constructtag) {
368: $result = &Apache::edit::rebuild_tag($token);
369: $result.= &Apache::edit::handle_insert();
370: }
1.4 matthew 371: }
1.1 matthew 372: return $result;
373: }
374:
375: sub end_key {
376: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
377: my $result = '';
1.4 matthew 378: if ($target eq 'web') {
1.20 matthew 379: } elsif ($target eq 'edit') {
1.21 matthew 380: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 381: }
1.1 matthew 382: return $result;
383: }
1.21 matthew 384:
1.1 matthew 385: ##------------------------------------------------------------------- title
386: sub start_title {
387: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
388: my $result='';
1.4 matthew 389: if ($target eq 'web') {
1.17 matthew 390: $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
1.32 matthew 391: if (length($title) > $max_str_len) {
392: $title = substr($title,0,$max_str_len);
393: }
1.20 matthew 394: } elsif ($target eq 'edit') {
1.25 matthew 395: $result.=&Apache::edit::tag_start($target,$token,'Plot Title');
1.22 matthew 396: my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);
397: $result.='</td></tr><tr><td colspan="3">'.
1.30 matthew 398: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 399: } elsif ($target eq 'modified') {
1.29 matthew 400: my $text=$$parser[-1]->get_text("/title");
1.21 matthew 401: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 402: }
1.1 matthew 403: return $result;
404: }
405:
406: sub end_title {
407: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
408: my $result = '';
1.4 matthew 409: if ($target eq 'web') {
1.20 matthew 410: } elsif ($target eq 'edit') {
1.27 matthew 411: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 412: }
1.1 matthew 413: return $result;
414: }
415: ##------------------------------------------------------------------- xlabel
416: sub start_xlabel {
417: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
418: my $result='';
1.4 matthew 419: if ($target eq 'web') {
1.17 matthew 420: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
1.32 matthew 421: if (length($xlabel) > $max_str_len) {
422: $xlabel = substr($xlabel,0,$max_str_len);
423: }
1.20 matthew 424: } elsif ($target eq 'edit') {
1.25 matthew 425: $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
1.22 matthew 426: my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
427: $result.='</td></tr><tr><td colspan="3">'.
1.30 matthew 428: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 429: } elsif ($target eq 'modified') {
1.29 matthew 430: my $text=$$parser[-1]->get_text("/xlabel");
1.21 matthew 431: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 432: }
1.1 matthew 433: return $result;
434: }
435:
436: sub end_xlabel {
437: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
438: my $result = '';
1.4 matthew 439: if ($target eq 'web') {
1.20 matthew 440: } elsif ($target eq 'edit') {
1.27 matthew 441: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 442: }
1.1 matthew 443: return $result;
444: }
1.21 matthew 445:
1.1 matthew 446: ##------------------------------------------------------------------- ylabel
447: sub start_ylabel {
448: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
449: my $result='';
1.4 matthew 450: if ($target eq 'web') {
1.17 matthew 451: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
1.32 matthew 452: if (length($ylabel) > $max_str_len) {
453: $ylabel = substr($ylabel,0,$max_str_len);
454: }
1.20 matthew 455: } elsif ($target eq 'edit') {
1.25 matthew 456: $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
1.22 matthew 457: my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
458: $result .= '</td></tr><tr><td colspan="3">'.
1.30 matthew 459: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 460: } elsif ($target eq 'modified') {
1.29 matthew 461: my $text=$$parser[-1]->get_text("/ylabel");
1.21 matthew 462: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 463: }
1.1 matthew 464: return $result;
465: }
466:
467: sub end_ylabel {
468: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
469: my $result = '';
1.4 matthew 470: if ($target eq 'web') {
1.20 matthew 471: } elsif ($target eq 'edit') {
1.27 matthew 472: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 473: }
1.1 matthew 474: return $result;
475: }
1.21 matthew 476:
1.1 matthew 477: ##------------------------------------------------------------------- label
478: sub start_label {
479: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
480: my $result='';
1.17 matthew 481: if ($target eq 'web') {
482: my %label;
483: &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
1.11 matthew 484: $tagstack->[-1]);
1.32 matthew 485: my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
486: $text = substr($text,0,$max_str_len) if (length($text) > $max_str_len);
487: $label{'text'} = $text;
1.17 matthew 488: push(@labels,\%label);
1.20 matthew 489: } elsif ($target eq 'edit') {
1.25 matthew 490: $result .= &Apache::edit::tag_start($target,$token,'Plot Label');
1.21 matthew 491: $result .= &edit_attributes($target,$token,\%label_defaults);
1.22 matthew 492: my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
493: $result .= '</td></tr><tr><td colspan="3">'.
1.30 matthew 494: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 495: } elsif ($target eq 'modified') {
496: my $constructtag=&Apache::edit::get_new_args
1.24 matthew 497: ($token,$parstack,$safeeval,keys(%label_defaults));
1.20 matthew 498: if ($constructtag) {
499: $result = &Apache::edit::rebuild_tag($token);
500: $result.= &Apache::edit::handle_insert();
501: }
1.22 matthew 502: my $text=$$parser[-1]->get_text("/label");
1.21 matthew 503: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 504: }
1.1 matthew 505: return $result;
506: }
507:
508: sub end_label {
509: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
510: my $result = '';
1.4 matthew 511: if ($target eq 'web') {
1.20 matthew 512: } elsif ($target eq 'edit') {
1.21 matthew 513: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 514: }
1.1 matthew 515: return $result;
516: }
517:
518: ##------------------------------------------------------------------- curve
519: sub start_curve {
520: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
521: my $result='';
1.25 matthew 522: &Apache::lonxml::register('Apache::lonplot',('function','data'));
523: push (@Apache::lonxml::namespace,'curve');
1.17 matthew 524: if ($target eq 'web') {
525: my %curve;
526: &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
1.11 matthew 527: $tagstack->[-1]);
1.17 matthew 528: push (@curves,\%curve);
1.20 matthew 529: } elsif ($target eq 'edit') {
1.26 matthew 530: $result .= &Apache::edit::tag_start($target,$token,'Curve');
1.21 matthew 531: $result .= &edit_attributes($target,$token,\%curve_defaults);
1.20 matthew 532: } elsif ($target eq 'modified') {
533: my $constructtag=&Apache::edit::get_new_args
1.24 matthew 534: ($token,$parstack,$safeeval,keys(%label_defaults));
1.20 matthew 535: if ($constructtag) {
536: $result = &Apache::edit::rebuild_tag($token);
537: $result.= &Apache::edit::handle_insert();
538: }
1.4 matthew 539: }
1.1 matthew 540: return $result;
541: }
542:
543: sub end_curve {
544: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
545: my $result = '';
1.25 matthew 546: pop @Apache::lonxml::namespace;
547: &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
1.4 matthew 548: if ($target eq 'web') {
1.20 matthew 549: } elsif ($target eq 'edit') {
1.21 matthew 550: $result.=&Apache::edit::tag_end($target,$token);
1.4 matthew 551: }
1.1 matthew 552: return $result;
553: }
1.21 matthew 554:
1.1 matthew 555: ##------------------------------------------------------------ curve function
556: sub start_function {
557: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
558: my $result='';
1.4 matthew 559: if ($target eq 'web') {
1.17 matthew 560: if (exists($curves[-1]->{'data'})) {
561: &Apache::lonxml::warning('Use of <function> precludes use of <data>. The <data> will be omitted in favor of the <function> declaration.');
562: delete $curves[-1]->{'data'} ;
563: }
564: $curves[-1]->{'function'} =
565: &Apache::lonxml::get_all_text("/function",$$parser[-1]);
1.20 matthew 566: } elsif ($target eq 'edit') {
1.25 matthew 567: $result .= &Apache::edit::tag_start($target,$token,'Curve Function');
1.22 matthew 568: my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);
569: $result .= '</td></tr><tr><td colspan="3">'.
1.30 matthew 570: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 571: } elsif ($target eq 'modified') {
572: # Why do I do this?
573: my $text=$$parser[-1]->get_text("/function");
574: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 575: }
1.1 matthew 576: return $result;
577: }
578:
579: sub end_function {
580: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
581: my $result = '';
1.4 matthew 582: if ($target eq 'web') {
1.20 matthew 583: } elsif ($target eq 'edit') {
1.26 matthew 584: $result .= &Apache::edit::end_table();
1.4 matthew 585: }
1.1 matthew 586: return $result;
587: }
1.21 matthew 588:
1.1 matthew 589: ##------------------------------------------------------------ curve data
590: sub start_data {
591: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
592: my $result='';
1.4 matthew 593: if ($target eq 'web') {
1.17 matthew 594: if (exists($curves[-1]->{'function'})) {
595: &Apache::lonxml::warning('Use of <data> precludes use of .'.
596: '<function>. The <function> will be omitted in favor of '.
597: 'the <data> declaration.');
598: delete($curves[-1]->{'function'});
599: }
600: my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
601: $datatext =~ s/\s+/ /g;
602: # Need to do some error checking on the @data array -
603: # make sure it's all numbers and make sure each array
604: # is of the same length.
605: my @data;
606: if ($datatext =~ /,/) {
607: @data = split /,/,$datatext;
608: } else { # Assume it's space seperated.
609: @data = split / /,$datatext;
610: }
611: for (my $i=0;$i<=$#data;$i++) {
612: # Check that it's non-empty
1.19 matthew 613: if (! defined($data[$i])) {
614: &Apache::lonxml::warning(
615: 'undefined <data> value. Replacing with '.
616: ' pi/e = 1.15572734979092');
617: $data[$i] = 1.15572734979092;
618: }
1.17 matthew 619: # Check that it's a number
1.19 matthew 620: if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) {
621: &Apache::lonxml::warning(
622: 'Bad <data> value of '.$data[$i].' Replacing with '.
623: ' pi/e = 1.15572734979092');
624: $data[$i] = 1.15572734979092;
625: }
1.17 matthew 626: }
627: push @{$curves[-1]->{'data'}},\@data;
1.20 matthew 628: } elsif ($target eq 'edit') {
1.25 matthew 629: $result .= &Apache::edit::tag_start($target,$token,'Curve Data');
1.22 matthew 630: my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
631: $result .= '</td></tr><tr><td colspan="3">'.
1.30 matthew 632: &Apache::edit::editfield('',$text,'',60,1);
1.20 matthew 633: } elsif ($target eq 'modified') {
1.21 matthew 634: my $text=$$parser[-1]->get_text("/data");
635: $result.=&Apache::edit::modifiedfield($token);
1.4 matthew 636: }
1.1 matthew 637: return $result;
638: }
639:
640: sub end_data {
641: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
642: my $result = '';
1.4 matthew 643: if ($target eq 'web') {
1.20 matthew 644: } elsif ($target eq 'edit') {
1.26 matthew 645: $result .= &Apache::edit::end_table();
1.4 matthew 646: }
1.1 matthew 647: return $result;
648: }
649:
650: ##------------------------------------------------------------------- axis
651: sub start_axis {
652: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
653: my $result='';
1.4 matthew 654: if ($target eq 'web') {
1.17 matthew 655: &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
656: $tagstack->[-1]);
1.20 matthew 657: } elsif ($target eq 'edit') {
1.25 matthew 658: $result .= &Apache::edit::tag_start($target,$token,'Plot Axes');
1.21 matthew 659: $result .= &edit_attributes($target,$token,\%axis_defaults);
1.20 matthew 660: } elsif ($target eq 'modified') {
1.29 matthew 661: my $constructtag=&Apache::edit::get_new_args
662: ($token,$parstack,$safeeval,keys(%axis_defaults));
663: if ($constructtag) {
664: $result = &Apache::edit::rebuild_tag($token);
665: $result.= &Apache::edit::handle_insert();
666: }
1.4 matthew 667: }
1.1 matthew 668: return $result;
669: }
670:
671: sub end_axis {
672: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
673: my $result = '';
1.4 matthew 674: if ($target eq 'web') {
1.20 matthew 675: } elsif ($target eq 'edit') {
1.21 matthew 676: $result.=&Apache::edit::tag_end($target,$token);
1.20 matthew 677: } elsif ($target eq 'modified') {
1.4 matthew 678: }
1.1 matthew 679: return $result;
680: }
681:
1.21 matthew 682: ###################################################################
683: ## ##
684: ## Utility Functions ##
685: ## ##
686: ###################################################################
687:
1.13 matthew 688: ##----------------------------------------------------------- set_defaults
689: sub set_defaults {
1.21 matthew 690: my ($var,$defaults) = @_;
1.13 matthew 691: my $key;
1.24 matthew 692: foreach $key (keys(%$defaults)) {
1.13 matthew 693: $var->{$key} = $defaults->{$key}->{'default'};
694: }
695: }
696:
1.1 matthew 697: ##------------------------------------------------------------------- misc
1.2 matthew 698: sub get_attributes{
1.21 matthew 699: my ($values,$defaults,$parstack,$safeeval,$tag) = @_;
1.24 matthew 700: foreach my $attr (keys(%{$defaults})) {
1.10 matthew 701: $values->{$attr} =
1.15 matthew 702: &Apache::lonxml::get_param($attr,$parstack,$safeeval);
1.10 matthew 703: if ($values->{$attr} eq '' | !defined($values->{$attr})) {
1.11 matthew 704: $values->{$attr} = $defaults->{$attr}->{'default'};
1.6 matthew 705: next;
706: }
1.10 matthew 707: my $test = $defaults->{$attr}->{'test'};
708: if (! &$test($values->{$attr})) {
1.6 matthew 709: &Apache::lonxml::warning
710: ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
1.11 matthew 711: .$defaults->{$attr}->{'default'} );
712: $values->{$attr} = $defaults->{$attr}->{'default'};
1.10 matthew 713: }
1.2 matthew 714: }
1.11 matthew 715: return ;
1.6 matthew 716: }
1.15 matthew 717: ##------------------------------------------------------- write_gnuplot_file
1.6 matthew 718: sub write_gnuplot_file {
719: my $gnuplot_input = '';
1.10 matthew 720: my $curve;
1.6 matthew 721: # Collect all the colors
722: my @Colors;
723: push @Colors, $plot{'bgcolor'};
724: push @Colors, $plot{'fgcolor'};
1.13 matthew 725: push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
1.9 matthew 726: foreach $curve (@curves) {
727: push @Colors, ($curve->{'color'} ne '' ?
728: $curve->{'color'} :
1.13 matthew 729: $plot{'fgcolor'} );
1.6 matthew 730: }
731: # set term
732: $gnuplot_input .= 'set term gif ';
733: $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on');
734: $gnuplot_input .= $plot{'font'} . ' ';
1.10 matthew 735: $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';
1.6 matthew 736: $gnuplot_input .= "@Colors\n";
1.7 matthew 737: # grid
1.10 matthew 738: $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');
1.7 matthew 739: # border
1.9 matthew 740: $gnuplot_input .= ($plot{'border'} eq 'on'?
741: 'set border'.$/ :
742: 'set noborder'.$/ ); # title, xlabel, ylabel
1.13 matthew 743: $gnuplot_input .= "set output\n";
744: $gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ;
745: $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));
746: $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));
1.23 matthew 747: if (%axis) {
1.13 matthew 748: $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
749: $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
1.6 matthew 750: }
751: # Key
1.23 matthew 752: if (%key) {
1.9 matthew 753: $gnuplot_input .= 'set key '.$key{'pos'}.' ';
754: if ($key{'title'} ne '') {
1.11 matthew 755: $gnuplot_input .= 'title "'.$key{'title'}.'" ';
756: }
757: $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/;
1.6 matthew 758: } else {
1.9 matthew 759: $gnuplot_input .= 'set nokey'.$/;
1.13 matthew 760: }
1.6 matthew 761: # labels
1.10 matthew 762: my $label;
1.6 matthew 763: foreach $label (@labels) {
764: $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '.
1.9 matthew 765: $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ;
1.6 matthew 766: }
767: # curves
768: $gnuplot_input .= 'plot ';
769: my $datatext = '';
1.9 matthew 770: for (my $i = 0;$i<=$#curves;$i++) {
771: $curve = $curves[$i];
772: $gnuplot_input.= ', ' if ($i > 0);
1.6 matthew 773: if (exists($curve->{'function'})) {
1.9 matthew 774: $gnuplot_input.=
775: $curve->{'function'}.' title "'.
776: $curve->{'name'}.'" with '.
777: $curve->{'linestyle'};
1.6 matthew 778: } elsif (exists($curve->{'data'})) {
1.9 matthew 779: $gnuplot_input.= '\'-\' title "'.
780: $curve->{'name'}.'" with '.
781: $curve->{'linestyle'};
1.6 matthew 782: my @Data = @{$curve->{'data'}};
1.9 matthew 783: my @Data0 = @{$Data[0]};
784: for (my $i =0; $i<=$#Data0; $i++) {
1.10 matthew 785: my $dataset;
1.6 matthew 786: foreach $dataset (@Data) {
1.9 matthew 787: $datatext .= $dataset->[$i] . ' ';
1.6 matthew 788: }
1.9 matthew 789: $datatext .= $/;
1.6 matthew 790: }
1.9 matthew 791: $datatext .=$/;
1.6 matthew 792: }
793: }
1.9 matthew 794: $gnuplot_input .= $/.$datatext;
1.10 matthew 795: return $gnuplot_input;
1.2 matthew 796: }
1.21 matthew 797:
798: #---------------------------------------------- check_inputs
799: sub check_inputs {
800: ## Note: no inputs, no outputs - this acts only on global variables.
801: ## Make sure we have all the input we need:
1.23 matthew 802: if (! %plot) { &set_defaults(\%plot,\%plot_defaults); }
803: if (! %key ) {} # No key for this plot, thats okay
1.34 ! matthew 804: # if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
1.21 matthew 805: if (! defined($title )) {} # No title for this plot, thats okay
806: if (! defined($xlabel)) {} # No xlabel for this plot, thats okay
807: if (! defined($ylabel)) {} # No ylabel for this plot, thats okay
808: if ($#labels < 0) { } # No labels for this plot, thats okay
809: if ($#curves < 0) {
810: &Apache::lonxml::warning("No curves specified for plot!!!!");
811: return '';
812: }
813: my $curve;
814: foreach $curve (@curves) {
815: if (!defined($curve->{'function'})&&!defined($curve->{'data'})){
816: &Apache::lonxml::warning("One of the curves specified did not contain any <data> or <function> declarations\n");
817: return '';
818: }
819: }
820: }
821:
1.20 matthew 822: #------------------------------------------------ make_edit
823: sub edit_attributes {
1.34 ! matthew 824: my ($target,$token,$defaults,$keys) = @_;
! 825: my ($result,@keys);
! 826: if ($keys && ref($keys) eq 'ARRAY') {
! 827: @keys = @$keys;
! 828: } else {
! 829: @keys = sort(keys(%$defaults));
! 830: }
! 831: foreach my $attr (@keys) {
1.20 matthew 832: if ($defaults->{$attr}->{'edit_type'} eq 'entry') {
833: $result .= &Apache::edit::text_arg(
834: $defaults->{$attr}->{'description'},
835: $attr,
836: $token);
837: } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') {
838: $result .= &Apache::edit::select_arg(
839: $defaults->{$attr}->{'description'},
840: $attr,
841: $defaults->{$attr}->{'choices'},
1.34 ! matthew 842: $token);
! 843: } elsif ($defaults->{$attr}->{'edit_type'} eq 'on_off') {
! 844: $result .= &Apache::edit::select_arg(
! 845: $defaults->{$attr}->{'description'},
! 846: $attr,
! 847: ['on','off'],
1.20 matthew 848: $token);
849: }
1.25 matthew 850: $result .= '<br />';
1.20 matthew 851: }
852: return $result;
853: }
1.1 matthew 854:
1.21 matthew 855:
856: ###################################################################
857: ## ##
858: ## Insertion functions for editing plots ##
859: ## ##
860: ###################################################################
861:
1.20 matthew 862: #------------------------------------------------ insert_xxxxxxx
863: sub insert_plot {
1.29 matthew 864: my $result = '';
1.20 matthew 865: # plot attributes
1.29 matthew 866: $result .= "<plot \n";
1.30 matthew 867: foreach my $attr (keys(%plot_defaults)) {
1.29 matthew 868: $result .= " $attr=\"$plot_defaults{$attr}->{'default'}\"\n";
1.20 matthew 869: }
870: $result .= ">\n";
871: # Add the components
872: $result .= &insert_key();
873: $result .= &insert_axis();
1.29 matthew 874: $result .= &insert_title();
875: $result .= &insert_xlabel();
876: $result .= &insert_ylabel();
1.20 matthew 877: $result .= &insert_curve();
878: # close up the <plot>
879: $result .= "</plot>\n";
880: return $result;
881: }
882:
883: sub insert_key {
884: my $result;
1.29 matthew 885: $result .= " <key \n";
1.30 matthew 886: foreach my $attr (keys(%key_defaults)) {
1.29 matthew 887: $result .= " $attr=\"$key_defaults{$attr}->{'default'}\"\n";
1.20 matthew 888: }
889: $result .= " />\n";
890: return $result;
891: }
892:
893: sub insert_axis{
894: my $result;
895: $result .= ' <axis ';
1.30 matthew 896: foreach my $attr (keys(%axis_defaults)) {
1.29 matthew 897: $result .= " $attr=\"$axis_defaults{$attr}->{'default'}\"\n";
1.20 matthew 898: }
899: $result .= " />\n";
900: return $result;
901: }
1.28 matthew 902:
903: sub insert_title { return " <title></title>\n"; }
1.29 matthew 904: sub insert_xlabel { return " <xlabel></xlabel>\n"; }
905: sub insert_ylabel { return " <ylabel></ylabel>\n"; }
1.20 matthew 906:
907: sub insert_label {
908: my $result;
909: $result .= ' <label ';
1.30 matthew 910: foreach my $attr (keys(%label_defaults)) {
1.27 matthew 911: $result .= ' '.$attr.'="'.
1.20 matthew 912: $label_defaults{$attr}->{'default'}."\"\n";
913: }
914: $result .= " ></label>\n";
915: return $result;
916: }
917:
918: sub insert_curve {
919: my $result;
920: $result .= ' <curve ';
1.30 matthew 921: foreach my $attr (keys(%curve_defaults)) {
1.27 matthew 922: $result .= ' '.$attr.'="'.
1.20 matthew 923: $curve_defaults{$attr}->{'default'}."\"\n";
924: }
1.29 matthew 925: $result .= " ></curve>\n";
1.20 matthew 926: }
1.4 matthew 927:
1.20 matthew 928: sub insert_function {
929: my $result;
930: $result .= "<function></function>\n";
931: return $result;
932: }
1.4 matthew 933:
1.20 matthew 934: sub insert_data {
935: my $result;
936: $result .= " <data></data>\n";
937: return $result;
938: }
1.4 matthew 939:
1.21 matthew 940: ##----------------------------------------------------------------------
1.20 matthew 941: 1;
942: __END__
1.4 matthew 943:
944:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonplot.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml