[system] / trunk / pg / lib / Fun.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/Fun.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1094 - (view) (download) (as text)

1 : sh002i 1050
2 : apizer 1079
3 : sh002i 1050 # Fun.pm
4 :     # methods:
5 :     # new Fun($rule,$graphRef)
6 : jj 1094 # If $rule is a subroutine then a function object is created,
7 : sh002i 1050 # with default data. If the graphRef is present the function is
8 :     # installed into the
9 : jj 1094 # graph and the domain is reset to the graphRef's domain.
10 :     # If the $rule is another function object then a copy of that function is
11 : sh002i 1050 # made with all of its data and it is installed in the graphRef if that is present.
12 :     # In this case the domain of the function is not affected by the domain of the graphRef.
13 :     # initial data
14 :     # @domain = ($tstart, $tstop) the domain of the function -- initially (-1,1)
15 :     # steps the number of steps in drawing -- initially 20
16 :     # color the pen color to draw with -- initially 'red'
17 :     # weight the width of the pen in pixels -- initially 2
18 :     # rule reference to a subroutine
19 :     # which calculates the function -- initially null
20 :     # graph reference to the enclosing graph -- initially $ref or else null
21 :    
22 :     # What will the domain of new Fun($rule, $graphRef) be?
23 :     # It will be the same as $rule if $rule is actually another function object
24 :     # ELSE the same as the domain of $graphRef if that is present
25 :     # ELSE the interval (-1,1)
26 : jj 1094 # public access methods:
27 : sh002i 1050 # domain
28 :     # steps
29 :     # color
30 :     # rule
31 :     # weight
32 :     ;
33 :    
34 :     =head1 NAME
35 :    
36 :     Fun
37 :    
38 :     =head1 SYNPOSIS
39 :    
40 :     use Carp;
41 :     use GD;
42 :     use WWPlot;
43 :     use Fun;
44 :     $fn = new Fun( rule_reference);
45 :     $fn = new Fun( rule_reference , graph_reference);
46 :     $fn = new Fun ( x_rule_ref, y_rule_ref );
47 :     $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
48 :    
49 :     =head1 DESCRIPTION
50 :    
51 :     This module defines a parametric or non-parametric function object. The function object is designed to
52 : jj 1094 be inserted into a graph object defined by WWPlot.
53 : sh002i 1050
54 :     The following functions are provided:
55 :    
56 :    
57 :    
58 :     =head2 new (non-parametric version)
59 :    
60 : jj 1094 =over 4
61 : sh002i 1050
62 :     =item $fn = new Fun( rule_reference);
63 :    
64 :     rule_reference is a reference to a subroutine which accepts a numerical value and returns a numerical value.
65 : jj 1094 The Fun object will draw the graph associated with this subroutine.
66 : sh002i 1050 For example: $rule = sub { my $x= shift; $x**2}; will produce a plot of the x squared.
67 :     The new method returns a reference to the function object.
68 :    
69 :     =item $fn = new Fun( rule_reference , graph_reference);
70 :    
71 : jj 1094 The function is also placed into the printing queue of the graph object pointed to by graph_reference and the
72 : sh002i 1050 domain of the function object is set to the domain of the graph.
73 :    
74 :     =back
75 :    
76 : jj 1094 =head2 new (parametric version)
77 : sh002i 1050
78 : jj 1094 =over 4
79 : sh002i 1050
80 :     =item $fn = new Fun ( x_rule_ref, y_rule_ref );
81 :    
82 :     A parametric function object is created where the subroutines refered to by x_rule_ref and y_rule_ref define
83 : jj 1094 the x and y outputs in terms of the input t.
84 : sh002i 1050
85 :     =item $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
86 :    
87 :     This variant inserts the parametric function object into the graph object referred to by graph_ref. The domain
88 :     of the function object is not adjusted. The domain's default value is (-1, 1).
89 :    
90 :     =back
91 :    
92 :     =head2 Properites
93 :    
94 : jj 1094 All of the properties are set using the construction $new_value = $fn->property($new_value)
95 : sh002i 1050 and read using $current_value = $fn->property()
96 :    
97 : jj 1094 =over 4
98 : sh002i 1050
99 :     =item tstart, tstop, steps
100 :    
101 :     The domain of the function is (tstart, tstop). steps is the number of subintervals
102 :     used in graphing the function.
103 :    
104 :     =item color
105 :    
106 : jj 1094 The color used to draw the function is specified by a word such as 'orange' or 'yellow'.
107 : sh002i 1050 C<$fn->color('blue')> sets the drawing color to blue. The RGB values for the color are defined in the graph
108 :     object in which the function is drawn. If the color, e.g. 'mauve', is not defined by the graph object
109 :     then the function is drawn using the color 'default_color' which is always defined (and usually black).
110 :    
111 :     =item x_rule
112 :    
113 :     A reference to the subroutine used to calculate the x value of the graph. This is set to the identity function (x = t )
114 :     when using the function object in non-parametric mode.
115 :    
116 :     =item y_rule
117 :    
118 :     A reference to the subroutine used to calculate the y value of the graph.
119 :    
120 :     =item weight
121 :    
122 :     The width in pixels of the pen used to draw the graph. The pen is square.
123 :    
124 :     =back
125 :    
126 :     =head2 Actions which affect more than one property.
127 :    
128 :     =over 4
129 :    
130 : jj 1094 =item rule
131 : sh002i 1050
132 : jj 1094 This defines a non-parametric function.
133 : sh002i 1050
134 : jj 1094 $fn->rule(sub {my $x =shift; $x**2;} )
135 :    
136 : sh002i 1050 is equivalent to
137 : jj 1094
138 : sh002i 1050 $fn->x_rule(sub {my $x = shift; $x;});
139 :     $fn->y_rule(sub {my $x = shift; $x**2;);
140 : jj 1094
141 : sh002i 1050 $fn->rule() returns the reference to the y_rule.
142 :    
143 :     =item domain
144 :    
145 : jj 1094 $array_ref = $fn->domain(-1,1) sets tstart to -1 and tstop to 1 and
146 : sh002i 1050 returns a reference to an array containing this pair of numbers.
147 :    
148 :    
149 :     =item draw
150 :    
151 :     $fn->draw($graph_ref) draws the function in the graph object pointed to by $graph_ref. If one of
152 :     the points bounding a subinterval is undefined then that segment is not drawn. This usually does the "right thing" for
153 :     functions which have simple singularities.
154 :    
155 :     The graph object must
156 :     respond to the methods below. The draw call is mainly for internal use by the graph object. Most users will not
157 :     call it directly.
158 :    
159 : jj 1094 =over 4
160 : sh002i 1050
161 : jj 1094 =item $graph_ref->{colors}
162 : sh002i 1050
163 :     a hash containing the defined colors
164 :    
165 : jj 1094 =item $graph_ref ->im
166 : sh002i 1050
167 :     a GD image object
168 :    
169 :     =item $graph_ref->lineTo(x,y, color_number)
170 :    
171 :     draw line to the point (x,y) from the current position using the specified color. To obtain the color number
172 :     use a construction such as C<$color_number = $graph_ref->{colors}{'blue'};>
173 :    
174 :     =item $graph_ref->lineTo(x,y,gdBrushed)
175 :    
176 :     draw line to the point (x,y) using the pattern set by SetBrushed (see GD documentation)
177 :    
178 :     =item $graph_ref->moveTo(x,y)
179 :    
180 :     set the current position to (x,y)
181 :    
182 : jj 1094 =back
183 : sh002i 1050
184 :     =back
185 :    
186 :     =cut
187 :    
188 :     BEGIN {
189 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
190 :     }
191 :    
192 :     package Fun;
193 :    
194 :    
195 :     #use "WWPlot.pm";
196 :     #Because of the way problem modules are loaded 'use' is disabled.
197 :    
198 :    
199 :    
200 :    
201 :    
202 :     @Fun::ISA = qw(WWPlot);
203 :     # import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported.
204 :     sub gdBrushed {
205 :     &GD::gdBrushed();
206 :     }
207 :    
208 : jj 1094 my $GRAPH_REFERENCE = "WWPlot";
209 : sh002i 1050 my $FUNCTION_REFERENCE = "Fun";
210 :    
211 :     my %fields =(
212 :     tstart => -1, # (tstart,$tstop) constitutes the domain
213 :     tstop => 1,
214 :     steps => 50,
215 :     color => 'blue',
216 :     x_rule => \&identity,
217 :     y_rule => \&identity,
218 :     weight => 2, # line thickness
219 :     );
220 :    
221 :    
222 :     sub new {
223 :     my $class = shift;
224 :     # my ($rule,$graphRef) = @_;
225 :    
226 : jj 1094 my $self = {
227 : sh002i 1050 _permitted => \%fields,
228 :     %fields,
229 :     };
230 : jj 1094
231 : sh002i 1050 bless $self, $class;
232 :     $self -> _initialize(@_);
233 :     return $self;
234 :     }
235 :    
236 :     sub identity { # the identity function
237 :     shift;
238 :     }
239 :     sub rule { # non-parametric functions are defined using rule; use x_rule and y_rule to define parametric functions
240 :     my $self = shift;
241 :     my $rule = shift;
242 :     my $out;
243 :     if ( defined($rule) ){
244 :     $self->x_rule (\&identity);
245 :     $self->y_rule($rule);
246 :     $out = $self->y_rule;
247 :     } else {
248 :     $out = $self->y_rule
249 :     }
250 :     $out;
251 :     }
252 :    
253 : jj 1094 sub _initialize {
254 : sh002i 1050 my $self = shift;
255 :     my ($xrule,$yrule, $rule,$graphRef);
256 :     my @input = @_;
257 :     if (ref($input[$#input]) eq $GRAPH_REFERENCE ) {
258 : jj 1094 $graphRef = pop @input; # get the last argument if it refers to a graph.
259 : sh002i 1050 $graphRef->fn($self); # Install this function in the graph.
260 : jj 1094 }
261 :    
262 : sh002i 1050 if ( @input == 1 ) { # only one argument left -- this is a non parametric function
263 :     $rule = $input[0];
264 :     if ( ref($rule) eq $FUNCTION_REFERENCE ) { # clone another function
265 :     my $k;
266 :     foreach $k (keys %fields) {
267 :     $self->{$k} = $rule->{$k};
268 :     }
269 :     } else {
270 : jj 1094 $self->rule($rule);
271 : sh002i 1050 if (ref($graphRef) eq $GRAPH_REFERENCE) { # use graph to initialize domain
272 :     $self->domain($graphRef->xmin,$graphRef->xmax);
273 :     }
274 :     }
275 :     } elsif (@input == 2 ) { # two arguments -- parametric functions
276 :     $self->x_rule($input[0]);
277 :     $self->y_rule($input[1]);
278 : jj 1094
279 : sh002i 1050 } else {
280 :     wwerror("$0:Fun.pm:_initialize:", "Can't call function with more than two arguments", "");
281 :     }
282 : jj 1094
283 : sh002i 1050 }
284 :    
285 :     sub draw {
286 : jj 1094 my $self = shift; # this function
287 : sh002i 1050 my $g = shift; # the graph containing the function.
288 :     my $color; # get color scheme from graph
289 :     if ( defined( $g->{'colors'}{$self->color} ) ) {
290 : jj 1094 $color = $g->{'colors'}{$self->color};
291 : sh002i 1050 } else {
292 :     $color = $g->{'colors'}{'default_color'}; # what you do if the color isn't there
293 :     }
294 :     my $brush = new GD::Image($self->weight,$self->weight);
295 :     my $brush_color = $brush->colorAllocate($g->im->rgb($color)); # transfer color
296 :     $g->im->setBrush($brush);
297 :     my $stepsize = ( $self->tstop - $self->tstart )/$self->steps;
298 : jj 1094
299 : sh002i 1050 my ($t,$x,$i,$y);
300 :     my $x_prev = undef;
301 : jj 1094 my $y_prev = undef;
302 : sh002i 1050 foreach $i (0..$self->steps) {
303 :     $t=$stepsize*$i + $self->tstart;
304 :     $x=&{$self->x_rule}( $t );;
305 :     $y=&{$self->y_rule}( $t );
306 : jj 1094 # Points where the function were not defined were not being handled
307 :     # gracefully. They would come as blank y values, which would ultimately
308 :     # trigger errors downstream unless y was undefined.
309 :     if($y eq "") { $y = undef; }
310 : sh002i 1050 if (defined($x) && defined($x_prev) && defined($y) && defined($y_prev) ) {
311 :     $g->lineTo($x, $y, gdBrushed);
312 :     } else {
313 :     $g->moveTo($x, $y) if defined($x) && defined($y);
314 :     }
315 :     $x_prev = $x;
316 :     $y_prev = $y;
317 :     }
318 :     }
319 :    
320 :     sub domain {
321 :     my $self =shift;
322 :     my $tstart = shift;
323 :     my $tstop = shift;
324 :     if (defined($tstart) && defined($tstop) ) {
325 :     $self->tstart($tstart);
326 :     $self->tstop($tstop);
327 :     }
328 : jj 1094 [$self->tstart,$self->tstop];
329 : sh002i 1050 }
330 :    
331 :    
332 :     sub DESTROY {
333 :     # doing nothing about destruction, hope that isn't dangerous
334 :     }
335 :    
336 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9