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

Diff of /trunk/pg/lib/WWPlot.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1050 Revision 1079
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
26This module creates a graph object -- a canvas on which to draw functions, labels, and other symbols. 26This module creates a graph object -- a canvas on which to draw functions, labels, and other symbols.
27The graph can be drawn with an axis, with a grid, and/or with an axis with tick marks. 27The graph can be drawn with an axis, with a grid, and/or with an axis with tick marks.
28The position of the axes and the granularity of the grid and tick marks can be specified. 28The 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);
48and 48and
49 $current_xmin = $graph->xmin(); 49 $current_xmin = $graph->xmin();
50 50
51set and read the values. 51set and read the values.
52 52
53=item fn, lb, stamps 53=item fn, lb, stamps
54 54
55These arrays contain references to the functions (fn), the labels (lb) and the stamped images (stamps) such 55These arrays contain references to the functions (fn), the labels (lb) and the stamped images (stamps) such
56as open or closed circles which will drawn when the graph is asked to draw itself. Since each of these 56as open or closed circles which will drawn when the graph is asked to draw itself. Since each of these
66the constructions for labels and stamps are respectively: 66the 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
71while 71while
72 72
73 @functions = $graph->fn(); 73 @functions = $graph->fn();
74 74
75will give a list of the current functions (similary for labels and stamps). 75will give a list of the current functions (similary for labels and stamps).
76 76
77Either of the commands 77Either of the commands
78 78
79 $graph->fn('reset'); 79 $graph->fn('reset');
80 $graph->fn('erase'); 80 $graph->fn('erase');
81 81
82will erase the array containing the functions and similary for the label and stamps arrays. 82will 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
90Respectively read and set the vertical coordinate value in real world coordinates where the 90Respectively read and set the vertical coordinate value in real world coordinates where the
91horizontal axis intersects the vertical one. The same construction reads and sets the coordinate 91horizontal axis intersects the vertical one. The same construction reads and sets the coordinate
92value for the vertical axis. The axis is drawn more darkly than the grids. 92value 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();
109vertical axis. 109vertical axis.
110 110
111=item draw 111=item draw
112 112
113 $image = $graph ->draw(); 113 $image = $graph ->draw();
114 114
115Draws the image of the graph. 115Draws 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
150Moves to the point ($x, $y) (defined in real world coordinates) or draws a line from the 150Moves to the point ($x, $y) (defined in real world coordinates) or draws a line from the
151current position to the specified point ($x, $y) using the color $color. $color is the 151current position to the specified point ($x, $y) using the color $color. $color is the
152name, e.g. 'white', of the color, not an index value or RGB specification. These are 152name, e.g. 'white', of the color, not an index value or RGB specification. These are
153low level call back routines used by the function, label and stamp objects to draw themselves. 153low 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
167BEGIN { 167BEGIN {
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}
171package WWPlot; 171package 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
206sub new { 206sub 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
234sub fn { 234sub 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
247sub fillRegion { 247sub 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}
289sub colors { 289sub 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
343sub ii { 343sub ii {
344 my $self = shift; 344 my $self = shift;
345 my $x = shift; 345 my $x = shift;
351 351
352sub jj { 352sub 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}
410sub v_grid { 410sub 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
417sub draw { 417sub 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
541sub AUTOLOAD { 541sub AUTOLOAD {
555} 555}
556 556
557 557
558sub DESTROY { 558sub 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
562sub save_image { 562sub 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
5691; 5691;

Legend:
Removed from v.1050  
changed lines
  Added in v.1079

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9