# this module holds the graph. Several functions # and labels may be plotted on # the graph. # constructor new WWPlot(300,400) constructs an image of width 300 by height 400 pixels # plot->imageName gives the image's name =head1 NAME WWPlot =head1 SYNPOSIS use Global; use Carp; use GD; $graph = new WWPlot(400,400); # creates a graph 400 pixels by 400 pixels $graph->fn($fun1, $fun2); # installs functions $fun1 and $fun2 in $graph $image_binary = $graph->draw(); # creates the gif/png image of the functions installed in the graph =head1 DESCRIPTION This module creates a graph object -- a canvas on which to draw functions, labels, and other symbols. The graph can be drawn with an axis, with a grid, and/or with an axis with tick marks. The position of the axes and the granularity of the grid and tick marks can be specified. =head2 new $graph = new WWPlot(400,400); Creates a graph object 400 pixels by 400 pixels. The size is required. =head2 Methods and properties =over 4 =item xmin, xmax, ymin, ymax These determine the world co-ordinates of the graph. The constructions $new_xmin = $graph->xmin($new_xmin); and $current_xmin = $graph->xmin(); set and read the values. =item fn, lb, stamps These arrays contain references to the functions (fn), the labels (lb) and the stamped images (stamps) such as open or closed circles which will drawn when the graph is asked to draw itself. Since each of these objects is expected to draw itself, there is not a strong difference between the different arrays of objects. The principle difference is the order in which they are drawn. The axis and grids are drawn first, followed by the functions, then the labels, then the stamps. You can add a function with either of the commands @fn = $graph->fn($new_fun_ref1, $new_fun_ref2); @fn = $graph->install($new_fun_ref1, $new_fun_ref2); the constructions for labels and stamps are respectively: @labels = $graph->lb($new_label); @stamps = $graph->stamps($new_stamp); while @functions = $graph->fn(); will give a list of the current functions (similary for labels and stamps). Either of the commands $graph->fn('reset'); $graph->fn('erase'); will erase the array containing the functions and similary for the label and stamps arrays. =item h_axis, v_axis $h_axis_coordinate = $graph -> h_axis(); $new_axis = $grpah -> h_axis($new_axis); Respectively read and set the vertical coordinate value in real world coordinates where the horizontal axis intersects the vertical one. The same construction reads and sets the coordinate value for the vertical axis. The axis is drawn more darkly than the grids. =item h_ticks, v_ticks @h_ticks = $graph -> h_ticks(); @h_ticks = $graph -> h_ticks( $tick1, $tick2, $tick3, $tick4 ); reads and sets the coordinates for the tick marks along the horizontal axis. The values $tick1, etc are the real world coordinate values for each of the tick marks. =item h_grid, v_grid @h_grid = $graph -> h_grid(); @h_grid = $graph -> h_grid( $grid1, $grid2, $grid3, $grid4 ); reads and sets the verical coordinates for the horizontal grid lines. The values $grid1, etc are the real world coordinate values where the horizontal grid meets the vertical axis. =item draw $image = $graph ->draw(); Draws the image of the graph. =item size ($horizontal_pixels, $vertical_pixels) = $graph ->size(); Reads the size of the graph image in pixels. This cannot be reset. It is defined by the new constructor and cannot be changed. =item colors %colors =$graph->colors(); Returns the hash containing the colors known to the graph. The keys are the names of the colors and the values are the color indices used by the graph. =item new_color $graph->new_color('white', 255,255,255); defines a new color named white with red, green and blue densities 255. =item im $GD_image = $graph->im(); Allows access to the GD image object contained in the graph object. You can use this to access methods defined in GD but not supported directly by WWPlot. (See the documentation for GD.) =item moveTo, lineTo $graph->moveTo($x,$y); $graph->lineTo($x,$y,$color); Moves to the point ($x, $y) (defined in real world coordinates) or draws a line from the current position to the specified point ($x, $y) using the color $color. $color is the name, e.g. 'white', of the color, not an index value or RGB specification. These are low level call back routines used by the function, label and stamp objects to draw themselves. =item ii, jj These functions translate from real world to pixel coordinates. $pixels_down_from_top = $graph -> jj($y); =back =cut BEGIN { be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. } package WWPlot; #use Exporter; #use DynaLoader; #use GD; @WWPlot::ISA=undef; $WWPlot::AUTOLOAD = undef; @WWPlot::ISA = qw(GD); if ( $GD::VERSION > '1.20' ) { $WWPlot::use_png = 1; # in version 1.20 and later of GD, gif's are not supported by png files are # This only affects the draw method. } else { $WWPlot::use_png = 0; } my $last_image_number=0; #class variable. Keeps track of how many images have been made. my %fields = ( # initialization only!!! xmin => -1, xmax => 1, ymin => -1, ymax => 1, imageName => undef, position => undef, #used internally in the draw routine lineTo ); sub new { my $class =shift; my @size = @_; # the dimensions in pixels of the image my $self = { im => new GD::Image(@size), '_permitted' => \%fields, %fields, size => [@size], fn => [], fillRegion => [], lb => [], stamps => [], colors => {}, hticks => [], vticks => [], hgrid => [], vgrid => [], haxis => [], vaxis => [], }; bless $self, $class; $self -> _initialize; return $self; } # access methods for function list, label list and image sub fn { my $self = shift; if (@_ == 0) { # do nothing if input is empty } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { $self->{fn} = []; } else { push(@{$self->{fn}},@_) if @_; } @{$self->{fn}}; } # access methods for fillRegion list, label list and image sub fillRegion { my $self = shift; if (@_ == 0) { # do nothing if input is empty } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { $self->{fillRegion} = []; } else { push(@{$self->{fillRegion}},@_) if @_; } @{$self->{fillRegion}}; } sub install { # synonym for installing a function fn(@_); } sub lb { my $self = shift; if (@_ == 0) { # do nothing if input is empty } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { $self->{lb} = []; } else { push(@{$self->{lb}},@_) if @_; } @{$self->{lb}}; } sub stamps { my $self = shift; if (@_ == 0) { # do nothing if input is empty } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { $self->{stamps} = []; } else { push(@{$self->{stamps}},@_) if @_; } @{$self->{stamps}}; } sub colors { my $self = shift; $self -> {colors} ; } sub new_color { my $self = shift; my ($color,$r,$g,$b) = @_; $self->{'colors'}{$color} = $self->im->colorAllocate($r, $g, $b); } sub im { my $self = shift; $self->{im}; } sub gifName { # This is yields backwards compatibility. my $self = shift; $self->imageName(@_); } sub pngName { # It is better to use the method imageName. my $self = shift; $self->imageName(@_); } sub size { my $self = shift; $self ->{size}; } sub _initialize { my $self = shift; $self->{position} = [0,0]; # $self->{width} = $self->{'size'}[0]; # original height and width tags match pixel dimensions # $self->{height} = $self->{'size'}[1]; # of the image # allocate some colors $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255); $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0); $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255); $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0); $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0); $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0); $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255); $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0); $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0); $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180); $self->{'colors'}{'nearwhite'} = $self->im->colorAllocate(254,254,254); # obtain a new imageNumber; $self->{imageNumber} = ++$last_image_number; } # reference shapes # closed circle # open circle # The translation subroutines. sub ii { my $self = shift; my $x = shift; return undef unless defined($x); my $xmax = $self-> xmax ; my $xmin = $self-> xmin ; int( ($x - $xmin)*(@{$self->size}[0]) / ($xmax - $xmin) ); } sub jj { my $self = shift; my $y = shift; return undef unless defined($y); my $ymax = $self->ymax; my $ymin = $self->ymin; #print "ymax=$ymax y=$y ymin=$ymin size=",${$self->size}[1],"



"; int( ($ymax - $y)*${$self->size}[1]/($ymax-$ymin) ); } # The move and draw subroutines. Arguments are in real world coordinates. sub lineTo { my $self = shift; my ($x,$y,$color) = @_; $x=$self->ii($x); $y=$self->jj($y); $color = $self->{'colors'}{$color} if $color=~/[A-Za-z]+/ && defined($self->{'colors'}{$color}) ; # colors referenced by name works here. $color = $self->{'colors'}{'default_color'} unless defined($color); $self->im->line(@{$self->position},$x,$y,$color); #warn "color is $color"; @{$self->position} = ($x,$y); } sub moveTo { my $self = shift; my $x=shift; my $y=shift; $x=$self->ii($x); $y=$self->jj($y); #print "moving to $x,$y
"; @{$self->position} = ( $x,$y ); } sub v_axis { my $self = shift; @{$self->{vaxis}}=@_; # y_value, color } sub h_axis { my $self = shift; @{$self->{haxis}}=@_; # x_value, color } sub h_ticks { my $self = shift; my $nudge =2; push(@{$self->{hticks}},$nudge,@_); # y-value, color, tick x-values. see save_image subroutine } sub v_ticks { my $self = shift; my $nudge =2; push(@{$self->{vticks}},$nudge,@_); # x-value, color, tick y-values. see save_image subroutine } sub h_grid { my $self = shift; push(@{$self->{hgrid}}, @_ ); #color, grid y values } sub v_grid { my $self = shift; push(@{$self->{vgrid}},@_ ); #color, grid x values } sub draw { my $self = shift; my $im =$self->{'im'}; my @size = @{$self->size}; my %colors =%{$self->colors}; # make the background transparent and interlaced # $im->transparent($colors{'white'}); $im->interlaced('true'); # Put a black frame around the picture $im->rectangle(0,0,$size[0]-1,$size[1]-1,$colors{'black'}); # draw functions foreach my $f ($self->fn) { #$self->draw_function($f); $f->draw($self); # the graph is passed to the function so that the label can call back as needed. } # and fill the regions foreach my $r ($self->fillRegion) { my ($x,$y,$color_name) = @{$r}; my $color = ${$self->colors}{$color_name}; $self->im->fill($self->ii($x),$self->jj($y),$color); } #draw hticks my $tk; my @ticks = @{$self->{hticks}}; if (@ticks) { my $nudge = shift(@ticks); my $j = $self->jj(shift(@ticks)); my $tk_clr= $self->{'colors'}{shift(@ticks)}; foreach $tk (@ticks) { $tk = $self->ii($tk); # print "tk=$tk\n"; $self->im->line($tk,$j+int($nudge),$tk,$j-int($nudge),$tk_clr); } } #draw vticks @ticks = @{$self->{vticks}}; if (@ticks) { my $nudge = shift(@ticks); my $i = $self->ii(shift(@ticks)); my $tk_clr= $self->{'colors'}{shift(@ticks)}; foreach $tk (@ticks) { $tk = $self->jj($tk); # print "tk=$tk\n"; $self->im->line($i+int($nudge),$tk,$i-int($nudge),$tk,$tk_clr); } } #draw vgrid my @grid = @{$self->{vgrid}}; if (@grid) { my $x_value; my $grid_clr= $self->{'colors'}{shift(@grid)}; foreach $x_value (@grid) { $x_value = $self->ii($x_value); # scale #print "grid_line=$grid_line\n"; $self->im->dashedLine($x_value,0,$x_value,$self->{'size'}[1],$grid_clr); } } #draw hgrid @grid = @{$self->{hgrid}}; if (@grid) { my $grid_clr= $self->{'colors'}{shift(@grid)}; my $y_value; foreach $y_value (@grid) { $y_value = $self->jj($y_value); #print "y_value=$y_value\n"; #print "width= $self->{width}\n"; $self->im->dashedLine(0,$y_value,$self->{'size'}[0],$y_value,$grid_clr); } } # draw axes if (defined ${$self->{vaxis}}[0]) { my ($x, $color_name) = @{$self->{vaxis}}; my $color = ${$self->colors}{$color_name}; $self->moveTo($x,$self->ymin); $self->lineTo($x,$self->ymax,$color); #print "draw vaxis", @{$self->{vaxis}},"\n"; #$self->im->line(0,0,300,300,$color); } if (defined $self->{haxis}[0]) { my ($y, $color_name) = @{$self->{haxis}}; my $color = ${$self->colors}{$color_name}; $self->moveTo($self->xmin,$y); $self->lineTo($self->xmax,$y,$color); #print "draw haxis", @{$self->{haxis}},"\n"; } # draw functions again foreach my $f ($self->fn) { #$self->draw_function($f); $f->draw($self); # the graph is passed to the function so that the label can call back as needed. } #draw labels my $lb; foreach $lb ($self->lb) { $lb->draw($self); # the graph is passed to the label so that the label can call back as needed. } #draw stamps my $stamp; foreach $stamp ($self->stamps) { $stamp->draw($self); # the graph is passed to the label so that the label can call back as needed. } my $out; if ($WWPlot::use_png) { $out = $im->png; } else { $out = $im->gif; } $out; } sub AUTOLOAD { my $self = shift; my $type = ref($self) || die "$self is not an object"; my $name = $WWPlot::AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion unless (exists $self->{'_permitted'}->{$name} ) { die "Can't find '$name' field in object of class $type"; } if (@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } sub DESTROY { # doing nothing about destruction, hope that isn't dangerous } sub save_image { my $self = shift; warn "The method save_image is no longer supported. Use insertGraph(\$graph)"; "The method save_image is no longer supported. Use insertGraph(\$graph)"; } 1;