Parent Directory
| 
Revision Log
WWPlot: slightly better choice of dash-length and spacing for dashing option on lines and arrows.
1 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, arrowTo 146 147 $graph->moveTo($x,$y); 148 $graph->lineTo($x,$y,$color); 149 $graph->lineTo($x,$y,$color,$thickness); 150 $graph->lineTo($x,$y,$color,$thickness,'dashed'); 151 $graph->arrowTo($x,$y,$color); 152 $graph->arrowTo($x,$y,$color,$thickness); 153 $graph->arrowTo($x,$y,$color,$thickness,'dashed'); 154 155 Moves to the point ($x, $y) (defined in real world coordinates) or draws a line or arrow 156 from the current position to the specified point ($x, $y) using the color $color. $color 157 is the name, e.g. 'white', of the color, not an index value or RGB specification. 158 $thickness gives the thickness of the line or arrow to draw. If 'dashed' is specified, 159 the line or arrow is rendered with a dashed line. These are low level call 160 back routines used by the function, label and stamp objects to draw themselves. 161 162 =item ii, jj 163 164 These functions translate from real world to pixel coordinates. 165 166 $pixels_down_from_top = $graph -> jj($y); 167 168 169 =back 170 171 =cut 172 173 BEGIN { 174 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. 175 176 } 177 package WWPlot; 178 179 180 #use Exporter; 181 #use DynaLoader; 182 #use GD; 183 184 @WWPlot::ISA=undef; 185 $WWPlot::AUTOLOAD = undef; 186 187 @WWPlot::ISA = qw(GD); 188 189 190 if ( $GD::VERSION > '1.20' ) { 191 $WWPlot::use_png = 1; # in version 1.20 and later of GD, gif's are not supported by png files are 192 # This only affects the draw method. 193 } else { 194 $WWPlot::use_png = 0; 195 } 196 197 my $last_image_number=0; #class variable. Keeps track of how many images have been made. 198 199 200 201 my %fields = ( # initialization only!!! 202 xmin => -1, 203 xmax => 1, 204 ymin => -1, 205 ymax => 1, 206 imageName => undef, 207 position => undef, #used internally in the draw routine lineTo 208 ); 209 210 211 212 sub new { 213 my $class =shift; 214 my @size = @_; # the dimensions in pixels of the image 215 my $self = { im => new GD::Image(@size), 216 '_permitted' => \%fields, 217 %fields, 218 size => [@size], 219 fn => [], 220 fillRegion => [], 221 lb => [], 222 stamps => [], 223 colors => {}, 224 hticks => [], 225 vticks => [], 226 hgrid => [], 227 vgrid => [], 228 haxis => [], 229 vaxis => [], 230 231 232 }; 233 234 bless $self, $class; 235 $self -> _initialize; 236 return $self; 237 } 238 239 # access methods for function list, label list and image 240 sub fn { 241 my $self = shift; 242 243 if (@_ == 0) { 244 # do nothing if input is empty 245 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 246 $self->{fn} = []; 247 } else { 248 push(@{$self->{fn}},@_) if @_; 249 } 250 @{$self->{fn}}; 251 } 252 # access methods for fillRegion list, label list and image 253 sub fillRegion { 254 my $self = shift; 255 256 if (@_ == 0) { 257 # do nothing if input is empty 258 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 259 $self->{fillRegion} = []; 260 } else { 261 push(@{$self->{fillRegion}},@_) if @_; 262 } 263 @{$self->{fillRegion}}; 264 } 265 266 sub install { # synonym for installing a function 267 fn(@_); 268 } 269 270 sub lb { 271 my $self = shift; 272 if (@_ == 0) { 273 # do nothing if input is empty 274 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 275 $self->{lb} = []; 276 } else { 277 push(@{$self->{lb}},@_) if @_; 278 } 279 280 @{$self->{lb}}; 281 } 282 283 sub stamps { 284 my $self = shift; 285 if (@_ == 0) { 286 # do nothing if input is empty 287 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 288 $self->{stamps} = []; 289 } else { 290 push(@{$self->{stamps}},@_) if @_; 291 } 292 293 @{$self->{stamps}}; 294 } 295 sub colors { 296 my $self = shift; 297 $self -> {colors} ; 298 } 299 300 sub new_color { 301 my $self = shift; 302 my ($color,$r,$g,$b) = @_; 303 $self->{'colors'}{$color} = $self->im->colorAllocate($r, $g, $b); 304 } 305 sub im { 306 my $self = shift; 307 $self->{im}; 308 } 309 sub gifName { # This is yields backwards compatibility. 310 my $self = shift; 311 $self->imageName(@_); 312 } 313 sub pngName { # It is better to use the method imageName. 314 my $self = shift; 315 $self->imageName(@_); 316 } 317 sub size { 318 my $self = shift; 319 $self ->{size}; 320 } 321 322 sub _initialize { 323 my $self = shift; 324 $self->{position} = [0,0]; 325 # $self->{width} = $self->{'size'}[0]; # original height and width tags match pixel dimensions 326 # $self->{height} = $self->{'size'}[1]; # of the image 327 # allocate some colors 328 $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255); 329 $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0); 330 $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255); 331 $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0); 332 $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0); 333 $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0); 334 $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255); 335 $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0); 336 $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0); 337 $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180); 338 $self->{'colors'}{'nearwhite'} = $self->im->colorAllocate(254,254,254); 339 # obtain a new imageNumber; 340 $self->{imageNumber} = ++$last_image_number; 341 } 342 343 # reference shapes 344 # closed circle 345 # open circle 346 347 # The translation subroutines. 348 349 sub ii { 350 my $self = shift; 351 my $x = shift; 352 return undef unless defined($x); 353 my $xmax = $self-> xmax ; 354 my $xmin = $self-> xmin ; 355 int( ($x - $xmin)*(@{$self->size}[0]) / ($xmax - $xmin) ); 356 } 357 358 sub jj { 359 my $self = shift; 360 my $y = shift; 361 return undef unless defined($y); 362 my $ymax = $self->ymax; 363 my $ymin = $self->ymin; 364 #print "ymax=$ymax y=$y ymin=$ymin size=",${$self->size}[1],"<BR><BR><BR><BR>"; 365 int( ($ymax - $y)*${$self->size}[1]/($ymax-$ymin) ); 366 } 367 368 # The move and draw subroutines. Arguments are in real world coordinates. 369 370 sub lineTo { 371 my $self = shift; 372 my ($x,$y,$color, $w, $d) = @_; 373 $w = 1 if ! defined( $w ); 374 $d = 0 if ! defined( $d ); ## draw a dashed line? 375 376 $x=$self->ii($x); 377 $y=$self->jj($y); 378 $color = $self->{'colors'}{$color} if $color=~/[A-Za-z]+/ && defined($self->{'colors'}{$color}) ; # colors referenced by name works here. 379 $color = $self->{'colors'}{'default_color'} unless defined($color); 380 381 $self->im->setThickness( $w ); 382 if ( $d ) { 383 my @dashing = ( $color )x(4*$w*$w); 384 my @spacing = ( GD::gdTransparent )x(3*$w*$w); 385 $self->im->setStyle( @dashing, @spacing ); 386 $self->im->line(@{$self->position},$x,$y,GD::gdStyled); 387 } else { 388 $self->im->line(@{$self->position},$x,$y,$color); 389 } 390 $self->im->setThickness( 1 ); 391 #warn "color is $color"; 392 @{$self->position} = ($x,$y); 393 } 394 395 sub moveTo { 396 my $self = shift; 397 my $x=shift; 398 my $y=shift; 399 $x=$self->ii($x); 400 $y=$self->jj($y); 401 #print "moving to $x,$y<BR>"; 402 @{$self->position} = ( $x,$y ); 403 } 404 405 sub arrowTo { 406 my $self = shift; 407 my ( $x1, $y1, $color, $w, $d ) = @_; 408 $w = 1 if ! defined( $w ); 409 $d = 0 if ! defined( $d ); 410 my $width = ( $w == 1 ) ? 2 : $w; 411 412 $x1 = $self->ii($x1); 413 $y1 = $self->jj($y1); 414 $color = $self->{'colors'}{$color} if $color=~/[A-Za-z]+/ && defined($self->{'colors'}{$color}) ; 415 $color = $self->{'colors'}{'default_color'} unless defined($color); 416 417 ## set thickness 418 $self->im->setThickness($w); 419 420 my ($x0, $y0) = @{$self->position}; 421 my $dx = $x1 - $x0; 422 my $dy = $y1 - $y0; 423 my $len = sqrt($dx*$dx + $dy*$dy); 424 my $ux = $dx/$len; ## a unit vector in the direction of the arrow 425 my $uy = $dy/$len; 426 my $px = -1*$uy; ## a unit vector perpendicular 427 my $py = $ux; 428 my $hbx = $x1 - 5*$width*$ux; ## the base of the arrowhead 429 my $hby = $y1 - 5*$width*$uy; 430 my $head = new GD::Polygon; 431 $head->addPt($x1,$y1); 432 $head->addPt($hbx + 2*$width*$px, $hby + 2*$width*$py); 433 $head->addPt($hbx - 2*$width*$px, $hby - 2*$width*$py); 434 $self->im->filledPolygon( $head, $color ); 435 if ( $d ) { 436 my @dashing = ( $color )x(4*$w*$w); 437 my @spacing = ( GD::gdTransparent )x(3*$w*$w); 438 $self->im->setStyle( @dashing, @spacing ); 439 $self->im->line( $x0,$y0,$x1,$y1,GD::gdStyled); 440 } else { 441 $self->im->line( $x0,$y0,$x1,$y1,$color ); 442 } 443 444 @{$self->position} = ( $x1, $y1 ); 445 446 ## reset thickness 447 $self->im->setThickness(1); 448 } 449 450 451 sub v_axis { 452 my $self = shift; 453 @{$self->{vaxis}}=@_; # y_value, color 454 } 455 sub h_axis { 456 my $self = shift; 457 @{$self->{haxis}}=@_; # x_value, color 458 } 459 sub h_ticks { 460 my $self = shift; 461 my $nudge =2; 462 push(@{$self->{hticks}},$nudge,@_); # y-value, color, tick x-values. see save_image subroutine 463 464 } 465 sub v_ticks { 466 my $self = shift; 467 my $nudge =2; 468 push(@{$self->{vticks}},$nudge,@_); # x-value, color, tick y-values. see save_image subroutine 469 470 } 471 sub h_grid { 472 my $self = shift; 473 push(@{$self->{hgrid}}, @_ ); #color, grid y values 474 } 475 sub v_grid { 476 my $self = shift; 477 push(@{$self->{vgrid}},@_ ); #color, grid x values 478 } 479 480 481 482 sub draw { 483 my $self = shift; 484 my $im =$self->{'im'}; 485 my @size = @{$self->size}; 486 my %colors =%{$self->colors}; 487 488 # make the background transparent and interlaced 489 # $im->transparent($colors{'white'}); 490 $im->interlaced('true'); 491 492 # Put a black frame around the picture 493 $im->rectangle(0,0,$size[0]-1,$size[1]-1,$colors{'black'}); 494 495 # draw functions 496 497 foreach my $f ($self->fn) { 498 #$self->draw_function($f); 499 $f->draw($self); # the graph is passed to the function so that the label can call back as needed. 500 } 501 # and fill the regions 502 foreach my $r ($self->fillRegion) { 503 my ($x,$y,$color_name) = @{$r}; 504 my $color = ${$self->colors}{$color_name}; 505 $self->im->fill($self->ii($x),$self->jj($y),$color); 506 } 507 508 #draw hticks 509 my $tk; 510 my @ticks = @{$self->{hticks}}; 511 if (@ticks) { 512 my $nudge = shift(@ticks); 513 my $j = $self->jj(shift(@ticks)); 514 my $tk_clr= $self->{'colors'}{shift(@ticks)}; 515 516 foreach $tk (@ticks) { 517 $tk = $self->ii($tk); 518 # print "tk=$tk\n"; 519 $self->im->line($tk,$j+int($nudge),$tk,$j-int($nudge),$tk_clr); 520 } 521 } 522 #draw vticks 523 @ticks = @{$self->{vticks}}; 524 if (@ticks) { 525 my $nudge = shift(@ticks); 526 my $i = $self->ii(shift(@ticks)); 527 my $tk_clr= $self->{'colors'}{shift(@ticks)}; 528 529 foreach $tk (@ticks) { 530 $tk = $self->jj($tk); 531 # print "tk=$tk\n"; 532 $self->im->line($i+int($nudge),$tk,$i-int($nudge),$tk,$tk_clr); 533 } 534 } 535 #draw vgrid 536 537 my @grid = @{$self->{vgrid}}; 538 if (@grid) { 539 my $x_value; 540 my $grid_clr= $self->{'colors'}{shift(@grid)}; 541 542 foreach $x_value (@grid) { 543 $x_value = $self->ii($x_value); # scale 544 #print "grid_line=$grid_line\n"; 545 $self->im->dashedLine($x_value,0,$x_value,$self->{'size'}[1],$grid_clr); 546 } 547 } 548 #draw hgrid 549 @grid = @{$self->{hgrid}}; 550 if (@grid) { 551 my $grid_clr= $self->{'colors'}{shift(@grid)}; 552 my $y_value; 553 foreach $y_value (@grid) { 554 $y_value = $self->jj($y_value); 555 #print "y_value=$y_value\n"; 556 #print "width= $self->{width}\n"; 557 $self->im->dashedLine(0,$y_value,$self->{'size'}[0],$y_value,$grid_clr); 558 } 559 } 560 # draw axes 561 if (defined ${$self->{vaxis}}[0]) { 562 my ($x, $color_name) = @{$self->{vaxis}}; 563 my $color = ${$self->colors}{$color_name}; 564 $self->moveTo($x,$self->ymin); 565 $self->lineTo($x,$self->ymax,$color); 566 #print "draw vaxis", @{$self->{vaxis}},"\n"; 567 #$self->im->line(0,0,300,300,$color); 568 } 569 if (defined $self->{haxis}[0]) { 570 my ($y, $color_name) = @{$self->{haxis}}; 571 my $color = ${$self->colors}{$color_name}; 572 $self->moveTo($self->xmin,$y); 573 $self->lineTo($self->xmax,$y,$color); 574 #print "draw haxis", @{$self->{haxis}},"\n"; 575 } 576 # draw functions again 577 578 foreach my $f ($self->fn) { 579 #$self->draw_function($f); 580 $f->draw($self); # the graph is passed to the function so that the label can call back as needed. 581 } 582 583 584 #draw labels 585 my $lb; 586 foreach $lb ($self->lb) { 587 $lb->draw($self); # the graph is passed to the label so that the label can call back as needed. 588 } 589 #draw stamps 590 my $stamp; 591 foreach $stamp ($self->stamps) { 592 $stamp->draw($self); # the graph is passed to the label so that the label can call back as needed. 593 } 594 my $out; 595 if ($WWPlot::use_png) { 596 $out = $im->png; 597 } else { 598 $out = $im->gif; 599 } 600 $out; 601 602 } 603 604 605 606 sub AUTOLOAD { 607 my $self = shift; 608 my $type = ref($self) || die "$self is not an object"; 609 my $name = $WWPlot::AUTOLOAD; 610 $name =~ s/.*://; # strip fully-qualified portion 611 unless (exists $self->{'_permitted'}->{$name} ) { 612 die "Can't find '$name' field in object of class $type"; 613 } 614 if (@_) { 615 return $self->{$name} = shift; 616 } else { 617 return $self->{$name}; 618 } 619 620 } 621 622 623 sub DESTROY { 624 # doing nothing about destruction, hope that isn't dangerous 625 } 626 627 sub save_image { 628 my $self = shift; 629 warn "The method save_image is no longer supported. Use insertGraph(\$graph)"; 630 "The method save_image is no longer supported. Use insertGraph(\$graph)"; 631 } 632 633 634 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |