1: # The LearningOnline Network with CAPA
2: # Dynamic plot
3: #
4: # $Id: lonplot.pm,v 1.1 2001/12/17 21:43:12 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: # 2/21 Guy
29: package Apache::lonplot;
30: use strict;
31: use Apache::response;
32:
33: sub BEGIN {
34: &Apache::lonxml::register('Apache::lonplot',('plot'));
35: }
36:
37:
38: ##
39: ## Tests used in checking the validitity of input
40: ##
41: my $int_test = sub {$_[0]=~/^\d+$/};
42: my $real_test = sub {$_[0]=~/^[+-]?\d*\.?\d*$/};
43: my $color_test = sub {$_[0]=~/^x[\da-f]{6}$/};
44: my $onoff_test = sub {$_[0]=~/^(on|off)$/};
45: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
46: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/};
47: my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
48:
49: ##
50: ## Default values for attributes of elements
51: ##
52: my %plot_defaults =
53: (
54: height => {default => 200, test => $int_test },
55: width => {default => 200, test => $int_test },
56: bgcolor => {default => "xffffff", test => $color_test},
57: fgcolor => {default => "x000000", test => $color_test},
58: transparent => {default => "off", test => $onoff_test},
59: grid => {default => "off", test => $onoff_test},
60: border => {default => "on" , test => $onoff_test},
61: font => {default => "medium", test => $sml_test }
62: );
63:
64: my %key_defaults =
65: (
66: title => { default => "on" , test => $onoff_test },
67: box => { default => "off" , test => $onoff_test },
68: pos => { default => "top right" , test => $key_pos_test}
69: );
70:
71: my %label_defaults =
72: (
73: xpos => {default => 0, test => $real_test },
74: ypos => {default => 0, test => $real_test },
75: color => {default => "x000000", test => $color_test },
76: justify => {default => "left",
77: test => sub {$_[0]=~/^(left|right|center)$/}}
78: );
79:
80: my %axis_defaults =
81: (
82: color => {default => "x000000", test => $color_test},
83: thickness => {default => 1, test => $int_test },
84: xmin => {default => -10.0, test => $real_test },
85: xmax => {default => 10.0, test => $real_test },
86: ymin => {default => -10.0, test => $real_test },
87: ymax => {default => 10.0, test => $real_test }
88: );
89:
90: my %curve_defaults =
91: (
92: color => {default => "x000000", test => $color_test },
93: name => {default => "x000000", test => sub {$_[0]=~/^[\w ]*$/} },
94: linestyle => {default => "lines", test => $linestyle_test }
95: );
96:
97: ##
98: ## End of defaults
99: ##
100: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
101:
102: sub start_plot {
103: %plot = ''; %key=''; %axis='';
104: $title=''; $xlabel=''; $ylabel='';
105: @labels = ''; @curves='';
106: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
107: my $result='';
108: #
109: &Apache::lonxml::register('Apache::plot',
110: ('title','xlabel','ylabel','key','axis','label','curve'));
111: push (@Apache::lonxml::namespace,'plot');
112: &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval);
113: return '';
114: }
115:
116: sub get_attributes{
117: %values = %{$_[0]};
118: %defaults = %{$_[1]};
119: $parstack = $_[2];
120: $safeeval = $_[3];
121: my $attr;
122: foreach $attr (keys %defaults) {
123: $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
124: my $test = $defaults{$attr}->{'test'};
125: $values{$attr} = (&$test($values{$attr}) ?
126: $values{$attr} :
127: $defaults{$attr} );
128: }
129: return ;
130: }
131:
132: sub end_plot {
133: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
134: pop @Apache::lonxml::namespace;
135: my $result;
136: ## Determine filename
137: my $filename =
138: ## Write the plot description to the file
139: ## return image tag for the plot
140: return $result;
141: }
142: ##----------------------------------------------------------------- key
143: sub start_key {
144: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
145: my $result='';
146: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval);
147: return $result;
148: }
149:
150: sub end_key {
151: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
152: my $result = '';
153: return $result;
154: }
155: ##------------------------------------------------------------------- title
156: sub start_title {
157: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
158: $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
159: my $result='';
160: return $result;
161: }
162:
163: sub end_title {
164: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
165: my $result = '';
166: return $result;
167: }
168: ##------------------------------------------------------------------- xlabel
169: sub start_xlabel {
170: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
171: my $result='';
172: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
173: return $result;
174: }
175:
176: sub end_xlabel {
177: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
178: my $result = '';
179: return $result;
180: }
181: ##------------------------------------------------------------------- ylabel
182: sub start_ylabel {
183: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
184: my $result='';
185: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
186: return $result;
187: }
188:
189: sub end_ylabel {
190: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
191: my $result = '';
192: return $result;
193: }
194: ##------------------------------------------------------------------- label
195: sub start_label {
196: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
197: my $result='';
198: my $label = &newhashref();
199: &get_attributes($label,\%label_defaults,$parstack,$safeeval);
200: $label->{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
201: push(@labels,$label);
202: return $result;
203: }
204:
205: sub end_label {
206: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
207: my $result = '';
208: return $result;
209: }
210:
211: ##------------------------------------------------------------------- curve
212: sub start_curve {
213: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
214: my $result='';
215: my $curve = &newhashref();
216: &get_attributes($curve,\%curve_defaults,$parstack,$safeeval);
217: push (@curves,$curve);
218:
219: &Apache::lonxml::register('Apache::plot',('function','data'));
220: push (@Apache::lonxml::namespace,'curve');
221:
222: return $result;
223: }
224:
225: sub end_curve {
226: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
227: my $result = '';
228: return $result;
229: }
230:
231: ##------------------------------------------------------------ curve function
232: sub start_function {
233: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
234: my $result='';
235:
236: $curves[-1]->{'function'} =
237: &Apache::lonxml::get_all_text("/function",$$parser[-1]);
238: return $result;
239: }
240:
241: sub end_function {
242: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
243: my $result = '';
244: return $result;
245: }
246:
247: ##------------------------------------------------------------ curve data
248: sub start_data {
249: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
250: my $result='';
251: push( @{$curves[-1]->{'data'}},
252: &Apache::lonxml::get_all_text("/data",$$parser[-1]));
253: return $result;
254: }
255:
256: sub end_data {
257: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
258: my $result = '';
259: return $result;
260: }
261:
262: ##------------------------------------------------------------------- axis
263: sub start_axis {
264: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
265: my $result='';
266: &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval);
267: return $result;
268: }
269:
270: sub end_axis {
271: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
272: my $result = '';
273: return $result;
274: }
275:
276: ##------------------------------------------------------------------- misc
277: sub newhashref{
278: my %hash;
279: return \%hash;
280: }
281:
282:
283: 1;
284: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>