1: # The LearningOnline Network with CAPA
2: # Dynamic plot
3: #
4: # $Id: lonplot.pm,v 1.34 2002/01/08 21:41:20 matthew Exp $
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: #
28: # 12/15/01 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
31: # 01/02 01/03 01/04 Matthew
32: package Apache::lonplot;
33:
34: use strict;
35: use Apache::File;
36: use Apache::response;
37: use Apache::lonxml;
38: use Apache::edit;
39:
40: BEGIN {
41: &Apache::lonxml::register('Apache::lonplot',('plot'));
42: }
43:
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
57: ## align
58: ##
59: ## @labels: $labels[$i] = \%label
60: ## %label: text, xpos, ypos, justify
61: ##
62: ## @curves: $curves[$i] = \%curve
63: ## %curve: name, linestyle, ( function | data )
64: ##
65: ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4],
66: ## [y1,y2,y3,y4] ]
67: ##
68:
69: ###################################################################
70: ## ##
71: ## Tests used in checking the validitity of input ##
72: ## ##
73: ###################################################################
74:
75: my $max_str_len = 50; # if a label, title, xlabel, or ylabel text
76: # is longer than this, it will be truncated.
77:
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,
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,
96: vector => 2
97: );
98:
99: my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
100: my $real_test =
101: sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
102: my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
103: my $onoff_test = sub {$_[0]=~/^(on|off)$/};
104: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
105: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/};
106: my $linestyle_test = sub {exists($linestyles{$_[0]})};
107: my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w\(\)]+ ?)+$/};
108:
109: ###################################################################
110: ## ##
111: ## Attribute metadata ##
112: ## ##
113: ###################################################################
114: my @plot_edit_order =
115: qw/bgcolor fgcolor height width font transparent grid border/;
116: my %plot_defaults =
117: (
118: height => {
119: default => 200,
120: test => $int_test,
121: description => 'height of image (pixels)',
122: edit_type => 'entry'
123: },
124: width => {
125: default => 200,
126: test => $int_test,
127: description => 'width of image (pixels)',
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,
145: description => 'Transparent image',
146: edit_type => 'on_off'
147: },
148: grid => {
149: default => 'off',
150: test => $onoff_test,
151: description => 'Display grid',
152: edit_type => 'on_off'
153: },
154: border => {
155: default => 'on',
156: test => $onoff_test,
157: description => 'Draw border around plot',
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: }
174: );
175:
176: my %key_defaults =
177: (
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: }
198: );
199:
200: my %label_defaults =
201: (
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: }
221: );
222:
223: my %axis_defaults =
224: (
225: color => {
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: }
255: );
256:
257: my %curve_defaults =
258: (
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',
276: choices => ['lines','linespoints','dots','points','steps',
277: 'fsteps','histeps','errorbars','xerrorbars',
278: 'yerrorbars','xyerrorbars','boxes','boxerrorbars',
279: 'boxxyerrorbars','financebars','candlesticks',
280: 'vector']
281: }
282: );
283:
284: ###################################################################
285: ## ##
286: ## parsing and edit rendering ##
287: ## ##
288: ###################################################################
289: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
290:
291: sub start_plot {
292: %plot = (); %key = (); %axis = ();
293: $title = undef; $xlabel = undef; $ylabel = undef;
294: $#labels = -1; $#curves = -1;
295: #
296: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
297: my $result='';
298: &Apache::lonxml::register('Apache::lonplot',
299: ('title','xlabel','ylabel','key','axis','label','curve'));
300: push (@Apache::lonxml::namespace,'lonplot');
301: if ($target eq 'web') {
302: my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
303: $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
304: &Apache::lonxml::newparser($parser,\$inside);
305: &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
306: $tagstack->[-1]);
307: } elsif ($target eq 'edit') {
308: $result .= &Apache::edit::tag_start($target,$token,'Plot');
309: $result .= &edit_attributes($target,$token,\%plot_defaults,
310: \@plot_edit_order);
311: } elsif ($target eq 'modified') {
312: my $constructtag=&Apache::edit::get_new_args
313: ($token,$parstack,$safeeval,keys(%plot_defaults));
314: if ($constructtag) {
315: $result = &Apache::edit::rebuild_tag($token);
316: # $result.= &Apache::edit::handle_insert();
317: }
318: }
319: return $result;
320: }
321:
322: sub end_plot {
323: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
324:
325: pop @Apache::lonxml::namespace;
326: &Apache::lonxml::deregister('Apache::lonplot',
327: ('title','xlabel','ylabel','key','axis','label','curve'));
328: my $result = '';
329: if ($target eq 'web') {
330: &check_inputs(); # Make sure we have all the data we need
331: ##
332: ## Determine filename
333: my $tmpdir = '/home/httpd/perl/tmp/';
334: my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
335: '_'.time.'_'.$$.int(rand(1000)).'_plot.data';
336: ## Write the plot description to the file
337: my $fh=Apache::File->new(">$tmpdir$filename");
338: print $fh &write_gnuplot_file();
339: close($fh);
340: ## return image tag for the plot
341: $result .= <<"ENDIMAGE";
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" />
347: ENDIMAGE
348: } elsif ($target eq 'edit') {
349: $result.=&Apache::edit::tag_end($target,$token);
350: }
351: return $result;
352: }
353:
354: ##----------------------------------------------------------------- key
355: sub start_key {
356: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
357: my $result='';
358: if ($target eq 'web') {
359: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
360: $tagstack->[-1]);
361: } elsif ($target eq 'edit') {
362: $result .= &Apache::edit::tag_start($target,$token,'Plot Key');
363: $result .= &edit_attributes($target,$token,\%key_defaults);
364: } elsif ($target eq 'modified') {
365: my $constructtag=&Apache::edit::get_new_args
366: ($token,$parstack,$safeeval,keys(%key_defaults));
367: if ($constructtag) {
368: $result = &Apache::edit::rebuild_tag($token);
369: $result.= &Apache::edit::handle_insert();
370: }
371: }
372: return $result;
373: }
374:
375: sub end_key {
376: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
377: my $result = '';
378: if ($target eq 'web') {
379: } elsif ($target eq 'edit') {
380: $result.=&Apache::edit::tag_end($target,$token);
381: }
382: return $result;
383: }
384:
385: ##------------------------------------------------------------------- title
386: sub start_title {
387: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
388: my $result='';
389: if ($target eq 'web') {
390: $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
391: if (length($title) > $max_str_len) {
392: $title = substr($title,0,$max_str_len);
393: }
394: } elsif ($target eq 'edit') {
395: $result.=&Apache::edit::tag_start($target,$token,'Plot Title');
396: my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]);
397: $result.='</td></tr><tr><td colspan="3">'.
398: &Apache::edit::editfield('',$text,'',60,1);
399: } elsif ($target eq 'modified') {
400: my $text=$$parser[-1]->get_text("/title");
401: $result.=&Apache::edit::modifiedfield($token);
402: }
403: return $result;
404: }
405:
406: sub end_title {
407: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
408: my $result = '';
409: if ($target eq 'web') {
410: } elsif ($target eq 'edit') {
411: $result.=&Apache::edit::tag_end($target,$token);
412: }
413: return $result;
414: }
415: ##------------------------------------------------------------------- xlabel
416: sub start_xlabel {
417: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
418: my $result='';
419: if ($target eq 'web') {
420: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
421: if (length($xlabel) > $max_str_len) {
422: $xlabel = substr($xlabel,0,$max_str_len);
423: }
424: } elsif ($target eq 'edit') {
425: $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel');
426: my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
427: $result.='</td></tr><tr><td colspan="3">'.
428: &Apache::edit::editfield('',$text,'',60,1);
429: } elsif ($target eq 'modified') {
430: my $text=$$parser[-1]->get_text("/xlabel");
431: $result.=&Apache::edit::modifiedfield($token);
432: }
433: return $result;
434: }
435:
436: sub end_xlabel {
437: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
438: my $result = '';
439: if ($target eq 'web') {
440: } elsif ($target eq 'edit') {
441: $result.=&Apache::edit::tag_end($target,$token);
442: }
443: return $result;
444: }
445:
446: ##------------------------------------------------------------------- ylabel
447: sub start_ylabel {
448: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
449: my $result='';
450: if ($target eq 'web') {
451: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
452: if (length($ylabel) > $max_str_len) {
453: $ylabel = substr($ylabel,0,$max_str_len);
454: }
455: } elsif ($target eq 'edit') {
456: $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel');
457: my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
458: $result .= '</td></tr><tr><td colspan="3">'.
459: &Apache::edit::editfield('',$text,'',60,1);
460: } elsif ($target eq 'modified') {
461: my $text=$$parser[-1]->get_text("/ylabel");
462: $result.=&Apache::edit::modifiedfield($token);
463: }
464: return $result;
465: }
466:
467: sub end_ylabel {
468: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
469: my $result = '';
470: if ($target eq 'web') {
471: } elsif ($target eq 'edit') {
472: $result.=&Apache::edit::tag_end($target,$token);
473: }
474: return $result;
475: }
476:
477: ##------------------------------------------------------------------- label
478: sub start_label {
479: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
480: my $result='';
481: if ($target eq 'web') {
482: my %label;
483: &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
484: $tagstack->[-1]);
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;
488: push(@labels,\%label);
489: } elsif ($target eq 'edit') {
490: $result .= &Apache::edit::tag_start($target,$token,'Plot Label');
491: $result .= &edit_attributes($target,$token,\%label_defaults);
492: my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
493: $result .= '</td></tr><tr><td colspan="3">'.
494: &Apache::edit::editfield('',$text,'',60,1);
495: } elsif ($target eq 'modified') {
496: my $constructtag=&Apache::edit::get_new_args
497: ($token,$parstack,$safeeval,keys(%label_defaults));
498: if ($constructtag) {
499: $result = &Apache::edit::rebuild_tag($token);
500: $result.= &Apache::edit::handle_insert();
501: }
502: my $text=$$parser[-1]->get_text("/label");
503: $result.=&Apache::edit::modifiedfield($token);
504: }
505: return $result;
506: }
507:
508: sub end_label {
509: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
510: my $result = '';
511: if ($target eq 'web') {
512: } elsif ($target eq 'edit') {
513: $result.=&Apache::edit::tag_end($target,$token);
514: }
515: return $result;
516: }
517:
518: ##------------------------------------------------------------------- curve
519: sub start_curve {
520: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
521: my $result='';
522: &Apache::lonxml::register('Apache::lonplot',('function','data'));
523: push (@Apache::lonxml::namespace,'curve');
524: if ($target eq 'web') {
525: my %curve;
526: &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
527: $tagstack->[-1]);
528: push (@curves,\%curve);
529: } elsif ($target eq 'edit') {
530: $result .= &Apache::edit::tag_start($target,$token,'Curve');
531: $result .= &edit_attributes($target,$token,\%curve_defaults);
532: } elsif ($target eq 'modified') {
533: my $constructtag=&Apache::edit::get_new_args
534: ($token,$parstack,$safeeval,keys(%label_defaults));
535: if ($constructtag) {
536: $result = &Apache::edit::rebuild_tag($token);
537: $result.= &Apache::edit::handle_insert();
538: }
539: }
540: return $result;
541: }
542:
543: sub end_curve {
544: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
545: my $result = '';
546: pop @Apache::lonxml::namespace;
547: &Apache::lonxml::deregister('Apache::lonplot',('function','data'));
548: if ($target eq 'web') {
549: } elsif ($target eq 'edit') {
550: $result.=&Apache::edit::tag_end($target,$token);
551: }
552: return $result;
553: }
554:
555: ##------------------------------------------------------------ curve function
556: sub start_function {
557: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
558: my $result='';
559: if ($target eq 'web') {
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]);
566: } elsif ($target eq 'edit') {
567: $result .= &Apache::edit::tag_start($target,$token,'Curve Function');
568: my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]);
569: $result .= '</td></tr><tr><td colspan="3">'.
570: &Apache::edit::editfield('',$text,'',60,1);
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);
575: }
576: return $result;
577: }
578:
579: sub end_function {
580: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
581: my $result = '';
582: if ($target eq 'web') {
583: } elsif ($target eq 'edit') {
584: $result .= &Apache::edit::end_table();
585: }
586: return $result;
587: }
588:
589: ##------------------------------------------------------------ curve data
590: sub start_data {
591: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
592: my $result='';
593: if ($target eq 'web') {
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
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: }
619: # Check that it's a number
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: }
626: }
627: push @{$curves[-1]->{'data'}},\@data;
628: } elsif ($target eq 'edit') {
629: $result .= &Apache::edit::tag_start($target,$token,'Curve Data');
630: my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]);
631: $result .= '</td></tr><tr><td colspan="3">'.
632: &Apache::edit::editfield('',$text,'',60,1);
633: } elsif ($target eq 'modified') {
634: my $text=$$parser[-1]->get_text("/data");
635: $result.=&Apache::edit::modifiedfield($token);
636: }
637: return $result;
638: }
639:
640: sub end_data {
641: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
642: my $result = '';
643: if ($target eq 'web') {
644: } elsif ($target eq 'edit') {
645: $result .= &Apache::edit::end_table();
646: }
647: return $result;
648: }
649:
650: ##------------------------------------------------------------------- axis
651: sub start_axis {
652: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
653: my $result='';
654: if ($target eq 'web') {
655: &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
656: $tagstack->[-1]);
657: } elsif ($target eq 'edit') {
658: $result .= &Apache::edit::tag_start($target,$token,'Plot Axes');
659: $result .= &edit_attributes($target,$token,\%axis_defaults);
660: } elsif ($target eq 'modified') {
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: }
667: }
668: return $result;
669: }
670:
671: sub end_axis {
672: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
673: my $result = '';
674: if ($target eq 'web') {
675: } elsif ($target eq 'edit') {
676: $result.=&Apache::edit::tag_end($target,$token);
677: } elsif ($target eq 'modified') {
678: }
679: return $result;
680: }
681:
682: ###################################################################
683: ## ##
684: ## Utility Functions ##
685: ## ##
686: ###################################################################
687:
688: ##----------------------------------------------------------- set_defaults
689: sub set_defaults {
690: my ($var,$defaults) = @_;
691: my $key;
692: foreach $key (keys(%$defaults)) {
693: $var->{$key} = $defaults->{$key}->{'default'};
694: }
695: }
696:
697: ##------------------------------------------------------------------- misc
698: sub get_attributes{
699: my ($values,$defaults,$parstack,$safeeval,$tag) = @_;
700: foreach my $attr (keys(%{$defaults})) {
701: $values->{$attr} =
702: &Apache::lonxml::get_param($attr,$parstack,$safeeval);
703: if ($values->{$attr} eq '' | !defined($values->{$attr})) {
704: $values->{$attr} = $defaults->{$attr}->{'default'};
705: next;
706: }
707: my $test = $defaults->{$attr}->{'test'};
708: if (! &$test($values->{$attr})) {
709: &Apache::lonxml::warning
710: ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
711: .$defaults->{$attr}->{'default'} );
712: $values->{$attr} = $defaults->{$attr}->{'default'};
713: }
714: }
715: return ;
716: }
717: ##------------------------------------------------------- write_gnuplot_file
718: sub write_gnuplot_file {
719: my $gnuplot_input = '';
720: my $curve;
721: # Collect all the colors
722: my @Colors;
723: push @Colors, $plot{'bgcolor'};
724: push @Colors, $plot{'fgcolor'};
725: push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
726: foreach $curve (@curves) {
727: push @Colors, ($curve->{'color'} ne '' ?
728: $curve->{'color'} :
729: $plot{'fgcolor'} );
730: }
731: # set term
732: $gnuplot_input .= 'set term gif ';
733: $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on');
734: $gnuplot_input .= $plot{'font'} . ' ';
735: $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' ';
736: $gnuplot_input .= "@Colors\n";
737: # grid
738: $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on');
739: # border
740: $gnuplot_input .= ($plot{'border'} eq 'on'?
741: 'set border'.$/ :
742: 'set noborder'.$/ ); # title, xlabel, ylabel
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));
747: if (%axis) {
748: $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
749: $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
750: }
751: # Key
752: if (%key) {
753: $gnuplot_input .= 'set key '.$key{'pos'}.' ';
754: if ($key{'title'} ne '') {
755: $gnuplot_input .= 'title "'.$key{'title'}.'" ';
756: }
757: $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/;
758: } else {
759: $gnuplot_input .= 'set nokey'.$/;
760: }
761: # labels
762: my $label;
763: foreach $label (@labels) {
764: $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '.
765: $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ;
766: }
767: # curves
768: $gnuplot_input .= 'plot ';
769: my $datatext = '';
770: for (my $i = 0;$i<=$#curves;$i++) {
771: $curve = $curves[$i];
772: $gnuplot_input.= ', ' if ($i > 0);
773: if (exists($curve->{'function'})) {
774: $gnuplot_input.=
775: $curve->{'function'}.' title "'.
776: $curve->{'name'}.'" with '.
777: $curve->{'linestyle'};
778: } elsif (exists($curve->{'data'})) {
779: $gnuplot_input.= '\'-\' title "'.
780: $curve->{'name'}.'" with '.
781: $curve->{'linestyle'};
782: my @Data = @{$curve->{'data'}};
783: my @Data0 = @{$Data[0]};
784: for (my $i =0; $i<=$#Data0; $i++) {
785: my $dataset;
786: foreach $dataset (@Data) {
787: $datatext .= $dataset->[$i] . ' ';
788: }
789: $datatext .= $/;
790: }
791: $datatext .=$/;
792: }
793: }
794: $gnuplot_input .= $/.$datatext;
795: return $gnuplot_input;
796: }
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:
802: if (! %plot) { &set_defaults(\%plot,\%plot_defaults); }
803: if (! %key ) {} # No key for this plot, thats okay
804: # if (! %axis) { &set_defaults(\%axis,\%axis_defaults); }
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:
822: #------------------------------------------------ make_edit
823: sub edit_attributes {
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) {
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'},
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'],
848: $token);
849: }
850: $result .= '<br />';
851: }
852: return $result;
853: }
854:
855:
856: ###################################################################
857: ## ##
858: ## Insertion functions for editing plots ##
859: ## ##
860: ###################################################################
861:
862: #------------------------------------------------ insert_xxxxxxx
863: sub insert_plot {
864: my $result = '';
865: # plot attributes
866: $result .= "<plot \n";
867: foreach my $attr (keys(%plot_defaults)) {
868: $result .= " $attr=\"$plot_defaults{$attr}->{'default'}\"\n";
869: }
870: $result .= ">\n";
871: # Add the components
872: $result .= &insert_key();
873: $result .= &insert_axis();
874: $result .= &insert_title();
875: $result .= &insert_xlabel();
876: $result .= &insert_ylabel();
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;
885: $result .= " <key \n";
886: foreach my $attr (keys(%key_defaults)) {
887: $result .= " $attr=\"$key_defaults{$attr}->{'default'}\"\n";
888: }
889: $result .= " />\n";
890: return $result;
891: }
892:
893: sub insert_axis{
894: my $result;
895: $result .= ' <axis ';
896: foreach my $attr (keys(%axis_defaults)) {
897: $result .= " $attr=\"$axis_defaults{$attr}->{'default'}\"\n";
898: }
899: $result .= " />\n";
900: return $result;
901: }
902:
903: sub insert_title { return " <title></title>\n"; }
904: sub insert_xlabel { return " <xlabel></xlabel>\n"; }
905: sub insert_ylabel { return " <ylabel></ylabel>\n"; }
906:
907: sub insert_label {
908: my $result;
909: $result .= ' <label ';
910: foreach my $attr (keys(%label_defaults)) {
911: $result .= ' '.$attr.'="'.
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 ';
921: foreach my $attr (keys(%curve_defaults)) {
922: $result .= ' '.$attr.'="'.
923: $curve_defaults{$attr}->{'default'}."\"\n";
924: }
925: $result .= " ></curve>\n";
926: }
927:
928: sub insert_function {
929: my $result;
930: $result .= "<function></function>\n";
931: return $result;
932: }
933:
934: sub insert_data {
935: my $result;
936: $result .= " <data></data>\n";
937: return $result;
938: }
939:
940: ##----------------------------------------------------------------------
941: 1;
942: __END__
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