Parent Directory
| 
Revision Log
dev-1-7-01
1 #!/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 |