Parent Directory
| 
Revision Log
Revision 2274 - (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 : | sh002i | 2274 | die "Fun.pm:_initialize: Can't call function with more than two arguments"; |
| 281 : | sh002i | 1050 | } |
| 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 : | jj | 1333 | if(defined($y) and $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 |