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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 1050 #!/usr/math/bin/perl -w
2 :     # this module holds the graph. Several functions
3 :     # and labels may be plotted on
4 :     # the graph.
5 :    
6 :     # constructor new WWPlot(300,400) constructs an image of width 300 by height 400 pixels
7 :     # plot->imageName gives the image's name
8 :    
9 :    
10 :     =head1 NAME
11 :    
12 :     WWPlot
13 :    
14 :     =head1 SYNPOSIS
15 :    
16 :     use Global;
17 :     use Carp;
18 :     use GD;
19 :    
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
22 :     $image_binary = $graph->draw(); # creates the gif/png image of the functions installed in the graph
23 :    
24 :     =head1 DESCRIPTION
25 :    
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.
28 :     The position of the axes and the granularity of the grid and tick marks can be specified.
29 :    
30 :     =head2 new
31 :    
32 :     $graph = new WWPlot(400,400);
33 :    
34 :     Creates a graph object 400 pixels by 400 pixels. The size is required.
35 :    
36 :    
37 :    
38 :    
39 :     =head2 Methods and properties
40 :    
41 :     =over 4
42 :    
43 :     =item xmin, xmax, ymin, ymax
44 :    
45 :     These determine the world co-ordinates of the graph. The constructions
46 :    
47 :     $new_xmin = $graph->xmin($new_xmin);
48 :     and
49 :     $current_xmin = $graph->xmin();
50 :    
51 :     set and read the values.
52 :    
53 :     =item fn, lb, stamps
54 :    
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
57 :     objects is expected to draw itself, there is not a strong difference between the different arrays of objects.
58 :     The principle difference is the order in which they are drawn. The axis and grids are drawn first, followed
59 :     by the functions, then the labels, then the stamps.
60 :    
61 :     You can add a function with either of the commands
62 :    
63 :     @fn = $graph->fn($new_fun_ref1, $new_fun_ref2);
64 :     @fn = $graph->install($new_fun_ref1, $new_fun_ref2);
65 :    
66 :     the constructions for labels and stamps are respectively:
67 :    
68 :     @labels = $graph->lb($new_label);
69 :     @stamps = $graph->stamps($new_stamp);
70 :    
71 :     while
72 :    
73 :     @functions = $graph->fn();
74 :    
75 :     will give a list of the current functions (similary for labels and stamps).
76 :    
77 :     Either of the commands
78 :    
79 :     $graph->fn('reset');
80 :     $graph->fn('erase');
81 :    
82 :     will erase the array containing the functions and similary for the label and stamps arrays.
83 :    
84 :    
85 :     =item h_axis, v_axis
86 :    
87 :     $h_axis_coordinate = $graph -> h_axis();
88 :     $new_axis = $grpah -> h_axis($new_axis);
89 :    
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
92 :     value for the vertical axis. The axis is drawn more darkly than the grids.
93 :    
94 :     =item h_ticks, v_ticks
95 :    
96 :     @h_ticks = $graph -> h_ticks();
97 :     @h_ticks = $graph -> h_ticks( $tick1, $tick2, $tick3, $tick4 );
98 :    
99 :     reads and sets the coordinates for the tick marks along the horizontal axis. The values
100 :     $tick1, etc are the real world coordinate values for each of the tick marks.
101 :    
102 :     =item h_grid, v_grid
103 :    
104 :     @h_grid = $graph -> h_grid();
105 :     @h_grid = $graph -> h_grid( $grid1, $grid2, $grid3, $grid4 );
106 :    
107 :     reads and sets the verical coordinates for the horizontal grid lines. The values
108 :     $grid1, etc are the real world coordinate values where the horizontal grid meets the
109 :     vertical axis.
110 :    
111 :     =item draw
112 :    
113 :     $image = $graph ->draw();
114 :    
115 :     Draws the image of the graph.
116 :    
117 :     =item size
118 :    
119 :     ($horizontal_pixels, $vertical_pixels) = $graph ->size();
120 :    
121 :     Reads the size of the graph image in pixels. This cannot be reset. It is defined by
122 :     the new constructor and cannot be changed.
123 :    
124 :     =item colors
125 :    
126 :     %colors =$graph->colors();
127 :    
128 :     Returns the hash containing the colors known to the graph. The keys are the names of the
129 :     colors and the values are the color indices used by the graph.
130 :    
131 :     =item new_color
132 :    
133 :     $graph->new_color('white', 255,255,255);
134 :    
135 :     defines a new color named white with red, green and blue densities 255.
136 :    
137 :     =item im
138 :    
139 :     $GD_image = $graph->im();
140 :    
141 :     Allows access to the GD image object contained in the graph object. You can use this
142 :     to access methods defined in GD but not supported directly by WWPlot. (See the documentation
143 :     for GD.)
144 :    
145 :     =item moveTo, lineTo
146 :    
147 :     $graph->moveTo($x,$y);
148 :     $graph->lineTo($x,$y,$color);
149 :    
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
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.
154 :    
155 :    
156 :     =item ii, jj
157 :    
158 :     These functions translate from real world to pixel coordinates.
159 :    
160 :     $pixels_down_from_top = $graph -> jj($y);
161 :    
162 :    
163 :     =back
164 :    
165 :     =cut
166 :    
167 :     BEGIN {
168 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
169 :    
170 :     }
171 :     package WWPlot;
172 :    
173 :    
174 :     #use Exporter;
175 :     #use DynaLoader;
176 :     #use GD;
177 :    
178 :     @WWPlot::ISA=undef;
179 :     $WWPlot::AUTOLOAD = undef;
180 :    
181 :     @WWPlot::ISA = qw(GD);
182 :    
183 :    
184 :     if ( $GD::VERSION > '1.20' ) {
185 :     $WWPlot::use_png = 1; # in version 1.20 and later of GD, gif's are not supported by png files are
186 :     # This only affects the draw method.
187 :     } else {
188 :     $WWPlot::use_png = 0;
189 :     }
190 :    
191 :     my $last_image_number=0; #class variable. Keeps track of how many images have been made.
192 :    
193 :    
194 :    
195 :     my %fields = ( # initialization only!!!
196 :     xmin => -1,
197 :     xmax => 1,
198 :     ymin => -1,
199 :     ymax => 1,
200 :     imageName => undef,
201 :     position => undef, #used internally in the draw routine lineTo
202 :     );
203 :    
204 :    
205 :    
206 :     sub new {
207 :     my $class =shift;
208 :     my @size = @_; # the dimensions in pixels of the image
209 :     my $self = { im => new GD::Image(@size),
210 :     '_permitted' => \%fields,
211 :     %fields,
212 :     size => [@size],
213 :     fn => [],
214 :     fillRegion => [],
215 :     lb => [],
216 :     stamps => [],
217 :     colors => {},
218 :     hticks => [],
219 :     vticks => [],
220 :     hgrid => [],
221 :     vgrid => [],
222 :     haxis => [],
223 :     vaxis => [],
224 :    
225 :    
226 :     };
227 :    
228 :     bless $self, $class;
229 :     $self -> _initialize;
230 :     return $self;
231 :     }
232 :    
233 :     # access methods for function list, label list and image
234 :     sub fn {
235 :     my $self = shift;
236 :    
237 :     if (@_ == 0) {
238 :     # do nothing if input is empty
239 :     } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
240 :     $self->{fn} = [];
241 :     } else {
242 :     push(@{$self->{fn}},@_) if @_;
243 :     }
244 :     @{$self->{fn}};
245 :     }
246 :     # access methods for fillRegion list, label list and image
247 :     sub fillRegion {
248 :     my $self = shift;
249 :    
250 :     if (@_ == 0) {
251 :     # do nothing if input is empty
252 :     } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
253 :     $self->{fillRegion} = [];
254 :     } else {
255 :     push(@{$self->{fillRegion}},@_) if @_;
256 :     }
257 :     @{$self->{fillRegion}};
258 :     }
259 :    
260 :     sub install { # synonym for installing a function
261 :     fn(@_);
262 :     }
263 :    
264 :     sub lb {
265 :     my $self = shift;
266 :     if (@_ == 0) {
267 :     # do nothing if input is empty
268 :     } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
269 :     $self->{lb} = [];
270 :     } else {
271 :     push(@{$self->{lb}},@_) if @_;
272 :     }
273 :    
274 :     @{$self->{lb}};
275 :     }
276 :    
277 :     sub stamps {
278 :     my $self = shift;
279 :     if (@_ == 0) {
280 :     # do nothing if input is empty
281 :     } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
282 :     $self->{stamps} = [];
283 :     } else {
284 :     push(@{$self->{stamps}},@_) if @_;
285 :     }
286 :    
287 :     @{$self->{stamps}};
288 :     }
289 :     sub colors {
290 :     my $self = shift;
291 :     $self -> {colors} ;
292 :     }
293 :    
294 :     sub new_color {
295 :     my $self = shift;
296 :     my ($color,$r,$g,$b) = @_;
297 :     $self->{'colors'}{$color} = $self->im->colorAllocate($r, $g, $b);
298 :     }
299 :     sub im {
300 :     my $self = shift;
301 :     $self->{im};
302 :     }
303 :     sub gifName { # This is yields backwards compatibility.
304 :     my $self = shift;
305 :     $self->imageName(@_);
306 :     }
307 :     sub pngName { # It is better to use the method imageName.
308 :     my $self = shift;
309 :     $self->imageName(@_);
310 :     }
311 :     sub size {
312 :     my $self = shift;
313 :     $self ->{size};
314 :     }
315 :    
316 :     sub _initialize {
317 :     my $self = shift;
318 :     $self->{position} = [0,0];
319 :     # $self->{width} = $self->{'size'}[0]; # original height and width tags match pixel dimensions
320 :     # $self->{height} = $self->{'size'}[1]; # of the image
321 :     # allocate some colors
322 :     $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255);
323 :     $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0);
324 :     $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255);
325 :     $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0);
326 :     $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0);
327 :     $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0);
328 :     $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255);
329 :     $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0);
330 :     $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0);
331 :     $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180);
332 :     $self->{'colors'}{'nearwhite'} = $self->im->colorAllocate(254,254,254);
333 :     # obtain a new imageNumber;
334 :     $self->{imageNumber} = ++$last_image_number;
335 :     }
336 :    
337 :     # reference shapes
338 :     # closed circle
339 :     # open circle
340 :    
341 :     # The translation subroutines.
342 :    
343 :     sub ii {
344 :     my $self = shift;
345 :     my $x = shift;
346 :     return undef unless defined($x);
347 :     my $xmax = $self-> xmax ;
348 :     my $xmin = $self-> xmin ;
349 :     int( ($x - $xmin)*(@{$self->size}[0]) / ($xmax - $xmin) );
350 :     }
351 :    
352 :     sub jj {
353 :     my $self = shift;
354 :     my $y = shift;
355 :     return undef unless defined($y);
356 :     my $ymax = $self->ymax;
357 :     my $ymin = $self->ymin;
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) );
360 :     }
361 :    
362 :     # The move and draw subroutines. Arguments are in real world coordinates.
363 :    
364 :     sub lineTo {
365 :     my $self = shift;
366 :     my ($x,$y,$color) = @_;
367 :     $x=$self->ii($x);
368 :     $y=$self->jj($y);
369 :     $color = $self->{'colors'}{$color} if $color=~/[A-Za-z]+/ && defined($self->{'colors'}{$color}) ; # colors referenced by name works here.
370 :     $color = $self->{'colors'}{'default_color'} unless defined($color);
371 :     $self->im->line(@{$self->position},$x,$y,$color);
372 :     #warn "color is $color";
373 :     @{$self->position} = ($x,$y);
374 :     }
375 :    
376 :     sub moveTo {
377 :     my $self = shift;
378 :     my $x=shift;
379 :     my $y=shift;
380 :     $x=$self->ii($x);
381 :     $y=$self->jj($y);
382 :     #print "moving to $x,$y<BR>";
383 :     @{$self->position} = ( $x,$y );
384 :     }
385 :    
386 :     sub v_axis {
387 :     my $self = shift;
388 :     @{$self->{vaxis}}=@_; # y_value, color
389 :     }
390 :     sub h_axis {
391 :     my $self = shift;
392 :     @{$self->{haxis}}=@_; # x_value, color
393 :     }
394 :     sub h_ticks {
395 :     my $self = shift;
396 :     my $nudge =2;
397 :     push(@{$self->{hticks}},$nudge,@_); # y-value, color, tick x-values. see save_image subroutine
398 :    
399 :     }
400 :     sub v_ticks {
401 :     my $self = shift;
402 :     my $nudge =2;
403 :     push(@{$self->{vticks}},$nudge,@_); # x-value, color, tick y-values. see save_image subroutine
404 :    
405 :     }
406 :     sub h_grid {
407 :     my $self = shift;
408 :     push(@{$self->{hgrid}}, @_ ); #color, grid y values
409 :     }
410 :     sub v_grid {
411 :     my $self = shift;
412 :     push(@{$self->{vgrid}},@_ ); #color, grid x values
413 :     }
414 :    
415 :    
416 :    
417 :     sub draw {
418 :     my $self = shift;
419 :     my $im =$self->{'im'};
420 :     my @size = @{$self->size};
421 :     my %colors =%{$self->colors};
422 :    
423 :     # make the background transparent and interlaced
424 :     # $im->transparent($colors{'white'});
425 :     $im->interlaced('true');
426 :    
427 :     # Put a black frame around the picture
428 :     $im->rectangle(0,0,$size[0]-1,$size[1]-1,$colors{'black'});
429 :    
430 :     # draw functions
431 :    
432 :     foreach my $f ($self->fn) {
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.
435 :     }
436 :     # and fill the regions
437 :     foreach my $r ($self->fillRegion) {
438 :     my ($x,$y,$color_name) = @{$r};
439 :     my $color = ${$self->colors}{$color_name};
440 :     $self->im->fill($self->ii($x),$self->jj($y),$color);
441 :     }
442 :    
443 :     #draw hticks
444 :     my $tk;
445 :     my @ticks = @{$self->{hticks}};
446 :     if (@ticks) {
447 :     my $nudge = shift(@ticks);
448 :     my $j = $self->jj(shift(@ticks));
449 :     my $tk_clr= $self->{'colors'}{shift(@ticks)};
450 :    
451 :     foreach $tk (@ticks) {
452 :     $tk = $self->ii($tk);
453 :     # print "tk=$tk\n";
454 :     $self->im->line($tk,$j+int($nudge),$tk,$j-int($nudge),$tk_clr);
455 :     }
456 :     }
457 :     #draw vticks
458 :     @ticks = @{$self->{vticks}};
459 :     if (@ticks) {
460 :     my $nudge = shift(@ticks);
461 :     my $i = $self->ii(shift(@ticks));
462 :     my $tk_clr= $self->{'colors'}{shift(@ticks)};
463 :    
464 :     foreach $tk (@ticks) {
465 :     $tk = $self->jj($tk);
466 :     # print "tk=$tk\n";
467 :     $self->im->line($i+int($nudge),$tk,$i-int($nudge),$tk,$tk_clr);
468 :     }
469 :     }
470 :     #draw vgrid
471 :    
472 :     my @grid = @{$self->{vgrid}};
473 :     if (@grid) {
474 :     my $x_value;
475 :     my $grid_clr= $self->{'colors'}{shift(@grid)};
476 :    
477 :     foreach $x_value (@grid) {
478 :     $x_value = $self->ii($x_value); # scale
479 :     #print "grid_line=$grid_line\n";
480 :     $self->im->dashedLine($x_value,0,$x_value,$self->{'size'}[1],$grid_clr);
481 :     }
482 :     }
483 :     #draw hgrid
484 :     @grid = @{$self->{hgrid}};
485 :     if (@grid) {
486 :     my $grid_clr= $self->{'colors'}{shift(@grid)};
487 :     my $y_value;
488 :     foreach $y_value (@grid) {
489 :     $y_value = $self->jj($y_value);
490 :     #print "y_value=$y_value\n";
491 :     #print "width= $self->{width}\n";
492 :     $self->im->dashedLine(0,$y_value,$self->{'size'}[0],$y_value,$grid_clr);
493 :     }
494 :     }
495 :     # draw axes
496 :     if (defined ${$self->{vaxis}}[0]) {
497 :     my ($x, $color_name) = @{$self->{vaxis}};
498 :     my $color = ${$self->colors}{$color_name};
499 :     $self->moveTo($x,$self->ymin);
500 :     $self->lineTo($x,$self->ymax,$color);
501 :     #print "draw vaxis", @{$self->{vaxis}},"\n";
502 :     #$self->im->line(0,0,300,300,$color);
503 :     }
504 :     if (defined $self->{haxis}[0]) {
505 :     my ($y, $color_name) = @{$self->{haxis}};
506 :     my $color = ${$self->colors}{$color_name};
507 :     $self->moveTo($self->xmin,$y);
508 :     $self->lineTo($self->xmax,$y,$color);
509 :     #print "draw haxis", @{$self->{haxis}},"\n";
510 :     }
511 :     # draw functions again
512 :    
513 :     foreach my $f ($self->fn) {
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.
516 :     }
517 :    
518 :    
519 :     #draw labels
520 :     my $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.
523 :     }
524 :     #draw stamps
525 :     my $stamp;
526 :     foreach $stamp ($self->stamps) {
527 :     $stamp->draw($self); # the graph is passed to the label so that the label can call back as needed.
528 :     }
529 :     my $out;
530 :     if ($WWPlot::use_png) {
531 :     $out = $im->png;
532 :     } else {
533 :     $out = $im->gif;
534 :     }
535 :     $out;
536 :    
537 :     }
538 :    
539 :    
540 :    
541 :     sub AUTOLOAD {
542 :     my $self = shift;
543 :     my $type = ref($self) || die "$self is not an object";
544 :     my $name = $WWPlot::AUTOLOAD;
545 :     $name =~ s/.*://; # strip fully-qualified portion
546 :     unless (exists $self->{'_permitted'}->{$name} ) {
547 :     die "Can't find '$name' field in object of class $type";
548 :     }
549 :     if (@_) {
550 :     return $self->{$name} = shift;
551 :     } else {
552 :     return $self->{$name};
553 :     }
554 :    
555 :     }
556 :    
557 :    
558 :     sub DESTROY {
559 :     # doing nothing about destruction, hope that isn't dangerous
560 :     }
561 :    
562 :     sub save_image {
563 :     my $self = shift;
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)";
566 :     }
567 :    
568 :    
569 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9