View of /trunk/webwork/system/courseScripts/Circle.pm

    1 #!/usr/math/bin/perl -w
    2 
    3 =head1 NAME
    4 
    5   Circle
    6 
    7 =head1 SYNPOSIS
    8 
    9     use Carp;
   10   use GD;
   11   use WWPlot;
   12   use Fun;
   13 
   14 
   15 =head1 DESCRIPTION
   16 
   17 This module defines a circle which can be inserted as a stamp in a graph (WWPlot) object.
   18 
   19 =head2 Command:
   20 
   21   $circle_object = new Circle( $center_pos_x, $center_pos_y, $radius, $border_color, $fill_color);
   22 
   23 
   24 =head2 Examples:
   25 
   26   Here is the code used to define the subroutines open_circle
   27   and closed_circle in PGgraphmacros.pl
   28 
   29     sub open_circle {
   30         my ($cx,$cy,$color) = @_;
   31       new Circle ($cx, $cy, 4,$color,'nearwhite');
   32     }
   33 
   34     sub closed_circle {
   35         my ($cx,$cy, $color) = @_;
   36         $color = 'black' unless defined $color;
   37       new Circle ($cx, $cy, 4,$color, $color);
   38     }
   39 
   40   $circle_object2 = closed_circle( $x_position, $y_position, $color );
   41 
   42   @circle_objects = $graph -> stamps($circle_object2);
   43   # puts a filled dot at ($x_position, $y_position) on the graph -- using real world coordinates.
   44 
   45 =cut
   46 
   47 
   48 BEGIN {
   49   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
   50 }
   51 
   52 package Circle;
   53 
   54 
   55 
   56 #use WWPlot;
   57 #Because of the way problem modules are loaded 'use' is disabled.
   58 
   59 #use strict;
   60 #use vars qw($AUTOLOAD  @ISA);
   61 @Circle::ISA = qw(WWPlot);
   62 
   63 my %fields =(
   64     colors      =>  {},
   65     border_color  =>   0,
   66     fill_color    =>   1,
   67     radius      =>   8,
   68 );
   69 
   70 
   71 sub new {
   72   my $class       = shift;
   73   my $cx        = shift;
   74   my $cy        = shift;
   75   my $radius      = shift;    # radius is in pixels, others are in real world coordinates
   76   my $border_color  = shift;
   77   my $fill_color    = shift;
   78   $radius =4 unless defined $radius;
   79   $border_color   =   'black' unless defined($border_color);
   80   $fill_color     = 'black' unless defined($fill_color);
   81 
   82   my $self = { im     =>  new GD::Image(2*$radius, 2*$radius),
   83 
   84          cx     =>  $cx,
   85          cy     =>  $cy,
   86          radius   =>  $radius,
   87          border_color =>  $border_color,
   88          fill_color   =>  $fill_color,
   89 
   90   };
   91 
   92   bless $self, $class;
   93   $self ->  _initialize_colors;
   94   if (defined($self->{'colors'}{$border_color} ) ) {
   95     $self->{'border_color'} = $self->{'colors'}{$border_color};
   96   } else {
   97     $self->{'border_color'} = 'default_color';
   98   }
   99   if (defined($self->{'colors'}{$fill_color} ) ) {
  100     $self->{'fill_color'} = $self->{'colors'}{$fill_color};
  101   } else {
  102     $self->{'fill_color'} = 'nearwhite';
  103   }
  104     $self->im->transparent($self->{'colors'}{'background_color'});
  105     $self->im->arc($radius,$radius,2*$radius,2*$radius,0,360,$self->{'border_color'} );
  106     $self->im->fill($radius,$radius,$self->{'fill_color'});
  107   return $self;
  108 }
  109 
  110 sub _initialize_colors {
  111   my $self      = shift;
  112     # allocate some colors
  113     $self->{'colors'}{'background_color'}   =   $self->im->colorAllocate(255,255,255);
  114       $self->{'colors'}{'default_color'}  =   $self->im->colorAllocate(0,0,0);
  115     $self->{'colors'}{'white'}  =   $self->im->colorAllocate(255,255,255);
  116       $self->{'colors'}{'black'}  =   $self->im->colorAllocate(0,0,0);
  117       $self->{'colors'}{'red'}  =   $self->im->colorAllocate(255,0,0);
  118       $self->{'colors'}{'green'}  =   $self->im->colorAllocate(0,255,0);
  119       $self->{'colors'}{'blue'}   =   $self->im->colorAllocate(0,0,255);
  120       $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0);
  121       $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0);
  122       $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180);
  123       $self->{'colors'}{'nearwhite'}  = $self->im->colorAllocate(254,254,254);
  124 
  125 }
  126 
  127 sub size {
  128   my $s = shift;
  129   (2*$s->{radius}, 2*$s->{radius});
  130 }
  131 sub height{
  132   my $s = shift;
  133   2*$s->{radius};
  134 }
  135 sub width {
  136   my $s = shift;
  137   2*$s->{radius};
  138 }
  139 sub radius {
  140   my $s = shift;
  141   $s->{radius};
  142 }
  143 sub x {
  144   my $s = shift;
  145   $s->{cx};
  146 }
  147 sub y {
  148   my $s = shift;
  149   $s->{cy};
  150 }
  151 sub image {
  152   my $s = shift;
  153   $s->{im};
  154 }
  155 
  156 sub draw{
  157   my $self = shift;
  158   my $g = shift;   # the enclosing graph object
  159   my $x = $self->x;
  160   my $y = $self->y;
  161   my $image = $self->image;
  162   my $height = $self->height;
  163   my $width = $self->width;
  164   $g->im->copy($image,
  165           ($g->ii($x)) - int($width/2),
  166           ($g->jj($y)) - int($height/2),
  167           0,  0,   $width,   $height);
  168 }
  169 sub DESTROY {
  170   # doing nothing about destruction, hope that isn't dangerous
  171 }
  172 
  173 1;