| 1 | #!/usr/math/bin/perl -w |
1 | |
| 2 | # this module holds the graph. Several functions |
2 | # this module holds the graph. Several functions |
| 3 | # and labels may be plotted on |
3 | # and labels may be plotted on |
| 4 | # the graph. |
4 | # the graph. |
| 5 | |
5 | |
| 6 | # constructor new WWPlot(300,400) constructs an image of width 300 by height 400 pixels |
6 | # constructor new WWPlot(300,400) constructs an image of width 300 by height 400 pixels |
| 7 | # plot->imageName gives the image's name |
7 | # plot->imageName gives the image's name |
| … | |
… | |
| 14 | =head1 SYNPOSIS |
14 | =head1 SYNPOSIS |
| 15 | |
15 | |
| 16 | use Global; |
16 | use Global; |
| 17 | use Carp; |
17 | use Carp; |
| 18 | use GD; |
18 | use GD; |
| 19 | |
19 | |
| 20 | $graph = new WWPlot(400,400); # creates a graph 400 pixels by 400 pixels |
20 | $graph = new WWPlot(400,400); # creates a graph 400 pixels by 400 pixels |
| 21 | $graph->fn($fun1, $fun2); # installs functions $fun1 and $fun2 in $graph |
21 | $graph->fn($fun1, $fun2); # installs functions $fun1 and $fun2 in $graph |
| 22 | $image_binary = $graph->draw(); # creates the gif/png image of the functions installed in the graph |
22 | $image_binary = $graph->draw(); # creates the gif/png image of the functions installed in the graph |
| 23 | |
23 | |
| 24 | =head1 DESCRIPTION |
24 | =head1 DESCRIPTION |
| 25 | |
25 | |
| 26 | This module creates a graph object -- a canvas on which to draw functions, labels, and other symbols. |
26 | This module creates a graph object -- a canvas on which to draw functions, labels, and other symbols. |
| 27 | The graph can be drawn with an axis, with a grid, and/or with an axis with tick marks. |
27 | The graph can be drawn with an axis, with a grid, and/or with an axis with tick marks. |
| 28 | The position of the axes and the granularity of the grid and tick marks can be specified. |
28 | The position of the axes and the granularity of the grid and tick marks can be specified. |
| 29 | |
29 | |
| 30 | =head2 new |
30 | =head2 new |
| 31 | |
31 | |
| 32 | $graph = new WWPlot(400,400); |
32 | $graph = new WWPlot(400,400); |
| … | |
… | |
| 46 | |
46 | |
| 47 | $new_xmin = $graph->xmin($new_xmin); |
47 | $new_xmin = $graph->xmin($new_xmin); |
| 48 | and |
48 | and |
| 49 | $current_xmin = $graph->xmin(); |
49 | $current_xmin = $graph->xmin(); |
| 50 | |
50 | |
| 51 | set and read the values. |
51 | set and read the values. |
| 52 | |
52 | |
| 53 | =item fn, lb, stamps |
53 | =item fn, lb, stamps |
| 54 | |
54 | |
| 55 | These arrays contain references to the functions (fn), the labels (lb) and the stamped images (stamps) such |
55 | These arrays contain references to the functions (fn), the labels (lb) and the stamped images (stamps) such |
| 56 | as open or closed circles which will drawn when the graph is asked to draw itself. Since each of these |
56 | as open or closed circles which will drawn when the graph is asked to draw itself. Since each of these |
| … | |
… | |
| 66 | the constructions for labels and stamps are respectively: |
66 | the constructions for labels and stamps are respectively: |
| 67 | |
67 | |
| 68 | @labels = $graph->lb($new_label); |
68 | @labels = $graph->lb($new_label); |
| 69 | @stamps = $graph->stamps($new_stamp); |
69 | @stamps = $graph->stamps($new_stamp); |
| 70 | |
70 | |
| 71 | while |
71 | while |
| 72 | |
72 | |
| 73 | @functions = $graph->fn(); |
73 | @functions = $graph->fn(); |
| 74 | |
74 | |
| 75 | will give a list of the current functions (similary for labels and stamps). |
75 | will give a list of the current functions (similary for labels and stamps). |
| 76 | |
76 | |
| 77 | Either of the commands |
77 | Either of the commands |
| 78 | |
78 | |
| 79 | $graph->fn('reset'); |
79 | $graph->fn('reset'); |
| 80 | $graph->fn('erase'); |
80 | $graph->fn('erase'); |
| 81 | |
81 | |
| 82 | will erase the array containing the functions and similary for the label and stamps arrays. |
82 | will erase the array containing the functions and similary for the label and stamps arrays. |
| 83 | |
83 | |
| 84 | |
84 | |
| 85 | =item h_axis, v_axis |
85 | =item h_axis, v_axis |
| 86 | |
86 | |
| 87 | $h_axis_coordinate = $graph -> h_axis(); |
87 | $h_axis_coordinate = $graph -> h_axis(); |
| 88 | $new_axis = $grpah -> h_axis($new_axis); |
88 | $new_axis = $grpah -> h_axis($new_axis); |
| 89 | |
89 | |
| 90 | Respectively read and set the vertical coordinate value in real world coordinates where the |
90 | Respectively read and set the vertical coordinate value in real world coordinates where the |
| 91 | horizontal axis intersects the vertical one. The same construction reads and sets the coordinate |
91 | horizontal axis intersects the vertical one. The same construction reads and sets the coordinate |
| 92 | value for the vertical axis. The axis is drawn more darkly than the grids. |
92 | value for the vertical axis. The axis is drawn more darkly than the grids. |
| 93 | |
93 | |
| 94 | =item h_ticks, v_ticks |
94 | =item h_ticks, v_ticks |
| 95 | |
95 | |
| 96 | @h_ticks = $graph -> h_ticks(); |
96 | @h_ticks = $graph -> h_ticks(); |
| … | |
… | |
| 109 | vertical axis. |
109 | vertical axis. |
| 110 | |
110 | |
| 111 | =item draw |
111 | =item draw |
| 112 | |
112 | |
| 113 | $image = $graph ->draw(); |
113 | $image = $graph ->draw(); |
| 114 | |
114 | |
| 115 | Draws the image of the graph. |
115 | Draws the image of the graph. |
| 116 | |
116 | |
| 117 | =item size |
117 | =item size |
| 118 | |
118 | |
| 119 | ($horizontal_pixels, $vertical_pixels) = $graph ->size(); |
119 | ($horizontal_pixels, $vertical_pixels) = $graph ->size(); |
| … | |
… | |
| 147 | $graph->moveTo($x,$y); |
147 | $graph->moveTo($x,$y); |
| 148 | $graph->lineTo($x,$y,$color); |
148 | $graph->lineTo($x,$y,$color); |
| 149 | |
149 | |
| 150 | Moves to the point ($x, $y) (defined in real world coordinates) or draws a line from the |
150 | Moves to the point ($x, $y) (defined in real world coordinates) or draws a line from the |
| 151 | current position to the specified point ($x, $y) using the color $color. $color is the |
151 | current position to the specified point ($x, $y) using the color $color. $color is the |
| 152 | name, e.g. 'white', of the color, not an index value or RGB specification. These are |
152 | name, e.g. 'white', of the color, not an index value or RGB specification. These are |
| 153 | low level call back routines used by the function, label and stamp objects to draw themselves. |
153 | low level call back routines used by the function, label and stamp objects to draw themselves. |
| 154 | |
154 | |
| 155 | |
155 | |
| 156 | =item ii, jj |
156 | =item ii, jj |
| 157 | |
157 | |
| … | |
… | |
| 164 | |
164 | |
| 165 | =cut |
165 | =cut |
| 166 | |
166 | |
| 167 | BEGIN { |
167 | BEGIN { |
| 168 | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. |
168 | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. |
| 169 | |
169 | |
| 170 | } |
170 | } |
| 171 | package WWPlot; |
171 | package WWPlot; |
| 172 | |
172 | |
| 173 | |
173 | |
| 174 | #use Exporter; |
174 | #use Exporter; |
| … | |
… | |
| 196 | xmin => -1, |
196 | xmin => -1, |
| 197 | xmax => 1, |
197 | xmax => 1, |
| 198 | ymin => -1, |
198 | ymin => -1, |
| 199 | ymax => 1, |
199 | ymax => 1, |
| 200 | imageName => undef, |
200 | imageName => undef, |
| 201 | position => undef, #used internally in the draw routine lineTo |
201 | position => undef, #used internally in the draw routine lineTo |
| 202 | ); |
202 | ); |
| 203 | |
203 | |
| 204 | |
204 | |
| 205 | |
205 | |
| 206 | sub new { |
206 | sub new { |
| … | |
… | |
| 219 | vticks => [], |
219 | vticks => [], |
| 220 | hgrid => [], |
220 | hgrid => [], |
| 221 | vgrid => [], |
221 | vgrid => [], |
| 222 | haxis => [], |
222 | haxis => [], |
| 223 | vaxis => [], |
223 | vaxis => [], |
| 224 | |
224 | |
| 225 | |
225 | |
| 226 | }; |
226 | }; |
| 227 | |
227 | |
| 228 | bless $self, $class; |
228 | bless $self, $class; |
| 229 | $self -> _initialize; |
229 | $self -> _initialize; |
| 230 | return $self; |
230 | return $self; |
| 231 | } |
231 | } |
| 232 | |
232 | |
| 233 | # access methods for function list, label list and image |
233 | # access methods for function list, label list and image |
| 234 | sub fn { |
234 | sub fn { |
| 235 | my $self = shift; |
235 | my $self = shift; |
| 236 | |
236 | |
| 237 | if (@_ == 0) { |
237 | if (@_ == 0) { |
| 238 | # do nothing if input is empty |
238 | # do nothing if input is empty |
| 239 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
239 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
| 240 | $self->{fn} = []; |
240 | $self->{fn} = []; |
| 241 | } else { |
241 | } else { |
| … | |
… | |
| 244 | @{$self->{fn}}; |
244 | @{$self->{fn}}; |
| 245 | } |
245 | } |
| 246 | # access methods for fillRegion list, label list and image |
246 | # access methods for fillRegion list, label list and image |
| 247 | sub fillRegion { |
247 | sub fillRegion { |
| 248 | my $self = shift; |
248 | my $self = shift; |
| 249 | |
249 | |
| 250 | if (@_ == 0) { |
250 | if (@_ == 0) { |
| 251 | # do nothing if input is empty |
251 | # do nothing if input is empty |
| 252 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
252 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
| 253 | $self->{fillRegion} = []; |
253 | $self->{fillRegion} = []; |
| 254 | } else { |
254 | } else { |
| … | |
… | |
| 281 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
281 | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { |
| 282 | $self->{stamps} = []; |
282 | $self->{stamps} = []; |
| 283 | } else { |
283 | } else { |
| 284 | push(@{$self->{stamps}},@_) if @_; |
284 | push(@{$self->{stamps}},@_) if @_; |
| 285 | } |
285 | } |
| 286 | |
286 | |
| 287 | @{$self->{stamps}}; |
287 | @{$self->{stamps}}; |
| 288 | } |
288 | } |
| 289 | sub colors { |
289 | sub colors { |
| 290 | my $self = shift; |
290 | my $self = shift; |
| 291 | $self -> {colors} ; |
291 | $self -> {colors} ; |
| … | |
… | |
| 321 | # allocate some colors |
321 | # allocate some colors |
| 322 | $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255); |
322 | $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255); |
| 323 | $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0); |
323 | $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0); |
| 324 | $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255); |
324 | $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255); |
| 325 | $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0); |
325 | $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0); |
| 326 | $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0); |
326 | $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0); |
| 327 | $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0); |
327 | $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0); |
| 328 | $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255); |
328 | $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255); |
| 329 | $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0); |
329 | $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0); |
| 330 | $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0); |
330 | $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0); |
| 331 | $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180); |
331 | $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180); |
| … | |
… | |
| 335 | } |
335 | } |
| 336 | |
336 | |
| 337 | # reference shapes |
337 | # reference shapes |
| 338 | # closed circle |
338 | # closed circle |
| 339 | # open circle |
339 | # open circle |
| 340 | |
340 | |
| 341 | # The translation subroutines. |
341 | # The translation subroutines. |
| 342 | |
342 | |
| 343 | sub ii { |
343 | sub ii { |
| 344 | my $self = shift; |
344 | my $self = shift; |
| 345 | my $x = shift; |
345 | my $x = shift; |
| … | |
… | |
| 351 | |
351 | |
| 352 | sub jj { |
352 | sub jj { |
| 353 | my $self = shift; |
353 | my $self = shift; |
| 354 | my $y = shift; |
354 | my $y = shift; |
| 355 | return undef unless defined($y); |
355 | return undef unless defined($y); |
| 356 | my $ymax = $self->ymax; |
356 | my $ymax = $self->ymax; |
| 357 | my $ymin = $self->ymin; |
357 | my $ymin = $self->ymin; |
| 358 | #print "ymax=$ymax y=$y ymin=$ymin size=",${$self->size}[1],"<BR><BR><BR><BR>"; |
358 | #print "ymax=$ymax y=$y ymin=$ymin size=",${$self->size}[1],"<BR><BR><BR><BR>"; |
| 359 | int( ($ymax - $y)*${$self->size}[1]/($ymax-$ymin) ); |
359 | int( ($ymax - $y)*${$self->size}[1]/($ymax-$ymin) ); |
| 360 | } |
360 | } |
| 361 | |
361 | |
| … | |
… | |
| 409 | } |
409 | } |
| 410 | sub v_grid { |
410 | sub v_grid { |
| 411 | my $self = shift; |
411 | my $self = shift; |
| 412 | push(@{$self->{vgrid}},@_ ); #color, grid x values |
412 | push(@{$self->{vgrid}},@_ ); #color, grid x values |
| 413 | } |
413 | } |
| 414 | |
414 | |
| 415 | |
415 | |
| 416 | |
416 | |
| 417 | sub draw { |
417 | sub draw { |
| 418 | my $self = shift; |
418 | my $self = shift; |
| 419 | my $im =$self->{'im'}; |
419 | my $im =$self->{'im'}; |
| 420 | my @size = @{$self->size}; |
420 | my @size = @{$self->size}; |
| 421 | my %colors =%{$self->colors}; |
421 | my %colors =%{$self->colors}; |
| 422 | |
422 | |
| 423 | # make the background transparent and interlaced |
423 | # make the background transparent and interlaced |
| 424 | # $im->transparent($colors{'white'}); |
424 | # $im->transparent($colors{'white'}); |
| 425 | $im->interlaced('true'); |
425 | $im->interlaced('true'); |
| 426 | |
426 | |
| 427 | # Put a black frame around the picture |
427 | # Put a black frame around the picture |
| 428 | $im->rectangle(0,0,$size[0]-1,$size[1]-1,$colors{'black'}); |
428 | $im->rectangle(0,0,$size[0]-1,$size[1]-1,$colors{'black'}); |
| 429 | |
429 | |
| 430 | # draw functions |
430 | # draw functions |
| 431 | |
431 | |
| 432 | foreach my $f ($self->fn) { |
432 | foreach my $f ($self->fn) { |
| 433 | #$self->draw_function($f); |
433 | #$self->draw_function($f); |
| 434 | $f->draw($self); # the graph is passed to the function so that the label can call back as needed. |
434 | $f->draw($self); # the graph is passed to the function so that the label can call back as needed. |
| 435 | } |
435 | } |
| 436 | # and fill the regions |
436 | # and fill the regions |
| 437 | foreach my $r ($self->fillRegion) { |
437 | foreach my $r ($self->fillRegion) { |
| 438 | my ($x,$y,$color_name) = @{$r}; |
438 | my ($x,$y,$color_name) = @{$r}; |
| 439 | my $color = ${$self->colors}{$color_name}; |
439 | my $color = ${$self->colors}{$color_name}; |
| 440 | $self->im->fill($self->ii($x),$self->jj($y),$color); |
440 | $self->im->fill($self->ii($x),$self->jj($y),$color); |
| 441 | } |
441 | } |
| 442 | |
442 | |
| 443 | #draw hticks |
443 | #draw hticks |
| 444 | my $tk; |
444 | my $tk; |
| 445 | my @ticks = @{$self->{hticks}}; |
445 | my @ticks = @{$self->{hticks}}; |
| 446 | if (@ticks) { |
446 | if (@ticks) { |
| 447 | my $nudge = shift(@ticks); |
447 | my $nudge = shift(@ticks); |
| 448 | my $j = $self->jj(shift(@ticks)); |
448 | my $j = $self->jj(shift(@ticks)); |
| 449 | my $tk_clr= $self->{'colors'}{shift(@ticks)}; |
449 | my $tk_clr= $self->{'colors'}{shift(@ticks)}; |
| 450 | |
450 | |
| 451 | foreach $tk (@ticks) { |
451 | foreach $tk (@ticks) { |
| 452 | $tk = $self->ii($tk); |
452 | $tk = $self->ii($tk); |
| 453 | # print "tk=$tk\n"; |
453 | # print "tk=$tk\n"; |
| 454 | $self->im->line($tk,$j+int($nudge),$tk,$j-int($nudge),$tk_clr); |
454 | $self->im->line($tk,$j+int($nudge),$tk,$j-int($nudge),$tk_clr); |
| 455 | } |
455 | } |
| … | |
… | |
| 458 | @ticks = @{$self->{vticks}}; |
458 | @ticks = @{$self->{vticks}}; |
| 459 | if (@ticks) { |
459 | if (@ticks) { |
| 460 | my $nudge = shift(@ticks); |
460 | my $nudge = shift(@ticks); |
| 461 | my $i = $self->ii(shift(@ticks)); |
461 | my $i = $self->ii(shift(@ticks)); |
| 462 | my $tk_clr= $self->{'colors'}{shift(@ticks)}; |
462 | my $tk_clr= $self->{'colors'}{shift(@ticks)}; |
| 463 | |
463 | |
| 464 | foreach $tk (@ticks) { |
464 | foreach $tk (@ticks) { |
| 465 | $tk = $self->jj($tk); |
465 | $tk = $self->jj($tk); |
| 466 | # print "tk=$tk\n"; |
466 | # print "tk=$tk\n"; |
| 467 | $self->im->line($i+int($nudge),$tk,$i-int($nudge),$tk,$tk_clr); |
467 | $self->im->line($i+int($nudge),$tk,$i-int($nudge),$tk,$tk_clr); |
| 468 | } |
468 | } |
| 469 | } |
469 | } |
| 470 | #draw vgrid |
470 | #draw vgrid |
| 471 | |
471 | |
| 472 | my @grid = @{$self->{vgrid}}; |
472 | my @grid = @{$self->{vgrid}}; |
| 473 | if (@grid) { |
473 | if (@grid) { |
| 474 | my $x_value; |
474 | my $x_value; |
| 475 | my $grid_clr= $self->{'colors'}{shift(@grid)}; |
475 | my $grid_clr= $self->{'colors'}{shift(@grid)}; |
| 476 | |
476 | |
| 477 | foreach $x_value (@grid) { |
477 | foreach $x_value (@grid) { |
| 478 | $x_value = $self->ii($x_value); # scale |
478 | $x_value = $self->ii($x_value); # scale |
| 479 | #print "grid_line=$grid_line\n"; |
479 | #print "grid_line=$grid_line\n"; |
| 480 | $self->im->dashedLine($x_value,0,$x_value,$self->{'size'}[1],$grid_clr); |
480 | $self->im->dashedLine($x_value,0,$x_value,$self->{'size'}[1],$grid_clr); |
| 481 | } |
481 | } |
| … | |
… | |
| 507 | $self->moveTo($self->xmin,$y); |
507 | $self->moveTo($self->xmin,$y); |
| 508 | $self->lineTo($self->xmax,$y,$color); |
508 | $self->lineTo($self->xmax,$y,$color); |
| 509 | #print "draw haxis", @{$self->{haxis}},"\n"; |
509 | #print "draw haxis", @{$self->{haxis}},"\n"; |
| 510 | } |
510 | } |
| 511 | # draw functions again |
511 | # draw functions again |
| 512 | |
512 | |
| 513 | foreach my $f ($self->fn) { |
513 | foreach my $f ($self->fn) { |
| 514 | #$self->draw_function($f); |
514 | #$self->draw_function($f); |
| 515 | $f->draw($self); # the graph is passed to the function so that the label can call back as needed. |
515 | $f->draw($self); # the graph is passed to the function so that the label can call back as needed. |
| 516 | } |
516 | } |
| 517 | |
517 | |
| 518 | |
518 | |
| 519 | #draw labels |
519 | #draw labels |
| 520 | my $lb; |
520 | my $lb; |
| 521 | foreach $lb ($self->lb) { |
521 | foreach $lb ($self->lb) { |
| 522 | $lb->draw($self); # the graph is passed to the label so that the label can call back as needed. |
522 | $lb->draw($self); # the graph is passed to the label so that the label can call back as needed. |
| … | |
… | |
| 531 | $out = $im->png; |
531 | $out = $im->png; |
| 532 | } else { |
532 | } else { |
| 533 | $out = $im->gif; |
533 | $out = $im->gif; |
| 534 | } |
534 | } |
| 535 | $out; |
535 | $out; |
| 536 | |
536 | |
| 537 | } |
537 | } |
| 538 | |
538 | |
| 539 | |
539 | |
| 540 | |
540 | |
| 541 | sub AUTOLOAD { |
541 | sub AUTOLOAD { |
| … | |
… | |
| 555 | } |
555 | } |
| 556 | |
556 | |
| 557 | |
557 | |
| 558 | sub DESTROY { |
558 | sub DESTROY { |
| 559 | # doing nothing about destruction, hope that isn't dangerous |
559 | # doing nothing about destruction, hope that isn't dangerous |
| 560 | } |
560 | } |
| 561 | |
561 | |
| 562 | sub save_image { |
562 | sub save_image { |
| 563 | my $self = shift; |
563 | my $self = shift; |
| 564 | warn "The method save_image is no longer supported. Use insertGraph(\$graph)"; |
564 | warn "The method save_image is no longer supported. Use insertGraph(\$graph)"; |
| 565 | "The method save_image is no longer supported. Use insertGraph(\$graph)"; |
565 | "The method save_image is no longer supported. Use insertGraph(\$graph)"; |
| 566 | } |
566 | } |
| 567 | |
567 | |
| 568 | |
568 | |
| 569 | 1; |
569 | 1; |
Parent Directory
| 
Revision Log
| 
Patch