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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1050 - (download) (as text) (annotate)
Fri Jun 6 21:39:42 2003 UTC (16 years, 8 months ago) by sh002i
File size: 14742 byte(s)
moved PG modules and macro files from webwork-modperl to pg
-sam

    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