Parent Directory
| 
Revision Log
Updating VectorField.pm so that it works without AUTOLOAD
1 2 3 # Fun.pm 4 # methods: 5 # new Fun($rule,$graphRef) 6 # If $rule is a subroutine then a function object is created, 7 # with default data. If the graphRef is present the function is 8 # installed into the 9 # 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 # 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 # public access methods: 27 # 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 be inserted into a graph object defined by WWPlot. 53 54 The following functions are provided: 55 56 57 58 =head2 new (non-parametric version) 59 60 =over 4 61 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 The Fun object will draw the graph associated with this subroutine. 66 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 The function is also placed into the printing queue of the graph object pointed to by graph_reference and the 72 domain of the function object is set to the domain of the graph. 73 74 =back 75 76 =head2 new (parametric version) 77 78 =over 4 79 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 the x and y outputs in terms of the input t. 84 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 All of the properties are set using the construction $new_value = $fn->property($new_value) 95 and read using $current_value = $fn->property() 96 97 =over 4 98 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 The color used to draw the function is specified by a word such as 'orange' or 'yellow'. 107 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 =item rule 131 132 This defines a non-parametric function. 133 134 $fn->rule(sub {my $x =shift; $x**2;} ) 135 136 is equivalent to 137 138 $fn->x_rule(sub {my $x = shift; $x;}); 139 $fn->y_rule(sub {my $x = shift; $x**2;); 140 141 $fn->rule() returns the reference to the y_rule. 142 143 =item domain 144 145 $array_ref = $fn->domain(-1,1) sets tstart to -1 and tstop to 1 and 146 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 =over 4 160 161 =item $graph_ref->{colors} 162 163 a hash containing the defined colors 164 165 =item $graph_ref ->im 166 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 =back 183 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 #use "WWPlot.pm"; 195 #Because of the way problem modules are loaded 'use' is disabled. 196 197 @Fun::ISA = qw(WWPlot); 198 # import gdBrushed from GD. It unclear why, but a good many global methods haven't been imported. 199 sub gdBrushed { 200 &GD::gdBrushed(); 201 } 202 203 my $GRAPH_REFERENCE = "WWPlot"; 204 my $FUNCTION_REFERENCE = "Fun"; 205 206 my %fields =( 207 tstart => -1, # (tstart,$tstop) constitutes the domain 208 tstop => 1, 209 steps => 50, 210 color => 'blue', 211 x_rule => \&identity, 212 y_rule => \&identity, 213 weight => 2, # line thickness 214 ); 215 216 217 sub new { 218 my $class = shift; 219 # my ($rule,$graphRef) = @_; 220 221 my $self = { 222 # _permitted => \%fields, 223 %fields, 224 }; 225 226 bless $self, $class; 227 $self -> _initialize(@_); 228 return $self; 229 } 230 231 sub identity { # the identity function 232 shift; 233 } 234 sub rule { # non-parametric functions are defined using rule; use x_rule and y_rule to define parametric functions 235 my $self = shift; 236 my $rule = shift; 237 my $out; 238 if ( defined($rule) ){ 239 $self->x_rule (\&identity); 240 $self->y_rule($rule); 241 $out = $self->y_rule; 242 } else { 243 $out = $self->y_rule 244 } 245 $out; 246 } 247 248 sub _initialize { 249 my $self = shift; 250 my ($xrule,$yrule, $rule,$graphRef); 251 my @input = @_; 252 if (ref($input[$#input]) eq $GRAPH_REFERENCE ) { 253 $graphRef = pop @input; # get the last argument if it refers to a graph. 254 $graphRef->fn($self); # Install this function in the graph. 255 } 256 257 if ( @input == 1 ) { # only one argument left -- this is a non parametric function 258 $rule = $input[0]; 259 if ( ref($rule) eq $FUNCTION_REFERENCE ) { # clone another function 260 my $k; 261 foreach $k (keys %fields) { 262 $self->{$k} = $rule->{$k}; 263 } 264 } else { 265 $self->rule($rule); 266 if (ref($graphRef) eq $GRAPH_REFERENCE) { # use graph to initialize domain 267 $self->domain($graphRef->xmin,$graphRef->xmax); 268 } 269 } 270 } elsif (@input == 2 ) { # two arguments -- parametric functions 271 $self->x_rule($input[0]); 272 $self->y_rule($input[1]); 273 274 } else { 275 die "Fun.pm:_initialize: Can't call function with more than two arguments"; 276 } 277 278 } 279 280 sub draw { 281 my $self = shift; # this function 282 my $g = shift; # the graph containing the function. 283 my $color; # get color scheme from graph 284 if ( defined( $g->{'colors'}{$self->color} ) ) { 285 $color = $g->{'colors'}{$self->color}; 286 } else { 287 $color = $g->{'colors'}{'default_color'}; # what you do if the color isn't there 288 } 289 my $brush = new GD::Image($self->weight,$self->weight); 290 my $brush_color = $brush->colorAllocate($g->im->rgb($color)); # transfer color 291 $g->im->setBrush($brush); 292 my $stepsize = ( $self->tstop - $self->tstart )/$self->steps; 293 294 my ($t,$x,$i,$y); 295 my $x_prev = undef; 296 my $y_prev = undef; 297 foreach $i (0..$self->steps) { 298 $t=$stepsize*$i + $self->tstart; 299 $x=&{$self->x_rule}( $t );; 300 $y=&{$self->y_rule}( $t ); 301 # Points where the function were not defined were not being handled 302 # gracefully. They would come as blank y values, which would ultimately 303 # trigger errors downstream unless y was undefined. 304 if(defined($y) and $y eq "") { $y = undef; } 305 if (defined($x) && defined($x_prev) && defined($y) && defined($y_prev) ) { 306 $g->lineTo($x, $y, gdBrushed); 307 } else { 308 $g->moveTo($x, $y) if defined($x) && defined($y); 309 } 310 $x_prev = $x; 311 $y_prev = $y; 312 } 313 } 314 315 sub domain { 316 my $self =shift; 317 my $tstart = shift; 318 my $tstop = shift; 319 if (defined($tstart) && defined($tstop) ) { 320 $self->tstart($tstart); 321 $self->tstop($tstop); 322 } 323 [$self->tstart,$self->tstop]; 324 } 325 326 ########################## 327 # Access methods 328 ########################## 329 sub tstart { 330 my $self = shift; 331 my $type = ref($self) || die "$self is not an object"; 332 unless (exists $self->{tstart} ) { 333 die "Can't find tstart field in object of class $type"; 334 } 335 336 if (@_) { 337 return $self->{tstart} = shift; 338 } else { 339 return $self->{tstart} 340 } 341 } 342 343 sub tstop { 344 my $self = shift; 345 my $type = ref($self) || die "$self is not an object"; 346 unless (exists $self->{tstop} ) { 347 die "Can't find tstop field in object of class $type"; 348 } 349 350 if (@_) { 351 return $self->{tstop} = shift; 352 } else { 353 return $self->{tstop} 354 } 355 } 356 sub steps { 357 my $self = shift; 358 my $type = ref($self) || die "$self is not an object"; 359 unless (exists $self->{steps} ) { 360 die "Can't find steps field in object of class $type"; 361 } 362 363 if (@_) { 364 return $self->{steps} = shift; 365 } else { 366 return $self->{steps} 367 } 368 } 369 sub color { 370 my $self = shift; 371 my $type = ref($self) || die "$self is not an object"; 372 unless (exists $self->{color} ) { 373 die "Can't find color field in object of class $type"; 374 } 375 376 if (@_) { 377 return $self->{color} = shift; 378 } else { 379 return $self->{color} 380 } 381 } 382 sub x_rule { 383 my $self = shift; 384 my $type = ref($self) || die "$self is not an object"; 385 unless (exists $self->{x_rule} ) { 386 die "Can't find x_rule field in object of class $type"; 387 } 388 389 if (@_) { 390 return $self->{x_rule} = shift; 391 } else { 392 return $self->{x_rule} 393 } 394 } 395 sub y_rule { 396 my $self = shift; 397 my $type = ref($self) || die "$self is not an object"; 398 unless (exists $self->{y_rule} ) { 399 die "Can't find y_rule field in object of class $type"; 400 } 401 402 if (@_) { 403 return $self->{y_rule} = shift; 404 } else { 405 return $self->{y_rule} 406 } 407 } 408 409 sub weight { 410 my $self = shift; 411 my $type = ref($self) || die "$self is not an object"; 412 unless (exists $self->{weight} ) { 413 die "Can't find weight field in object of class $type"; 414 } 415 416 if (@_) { 417 return $self->{weight} = shift; 418 } else { 419 return $self->{weight} 420 } 421 } 422 423 sub DESTROY { 424 # doing nothing about destruction, hope that isn't dangerous 425 } 426 427 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |