Perl

Contributed by Chris Rathman

Shape class (Shape.pm)

package Shape;
@EXPORT = qw(new, getX, getY, setX, setY, moveTo, rMoveTo, draw);

# constructor
sub new {
   my ($class, $newx, $newy) = @_;
   my $self = bless {};
   setX($self, $newx);
   setY($self, $newy);
   return $self;
}

# accessors for x & y coordinates
sub getX {
   my ($self) = @_;
   return $self->{x};
}
sub getY {
   my ($self) = @_;
   return $self->{y};
}
sub setX {
   my ($self, $newx) = @_;
   $self->{x} = $newx;
}
sub setY {
   my ($self, $newy) = @_;
   $self->{y} = $newy;
}

# move the x & y coordinates
sub moveTo {
   my ($self, $newx, $newy) = @_;
   $self->setX($newx);
   $self->setY($newy);
}
sub rMoveTo {
   my ($self, $deltax, $deltay) = @_;
   $self->moveTo($self->getX + $deltax, $self->getY + $deltay);
}

# virtual routine - draw the shape
sub draw {}

Rectangle class (Rectangle.pm)

package Rectangle;
use Shape;
@ISA = qw(Shape);
@EXPORT = qw(new, getWidth, getHeight, setWidth, setHeight, draw);

# constructor
sub new {
   my ($class, $newx, $newy, $newwidth, $newheight) = @_;
   my $self = bless Shape->new($newx, $newy);
   $self->setWidth($newwidth);
   $self->setHeight($newheight);
   return $self;
}

# accessors for the radius
sub getWidth {
   my ($self) = @_;
   return $self->{width};
}
sub getHeight {
   my ($self) = @_;
   return $self->{height};
}
sub setWidth {
   my ($self, $newwidth) = @_;
   $self->{width} = $newwidth;
}
sub setHeight {
   my ($self, $newheight) = @_;
   $self->{height} = $newheight;
}

# draw the rectangle
sub draw {
   my ($self) = @_;
   printf("Drawing a Rectangle at:(%d,%d), width %d, height %d\n",
      $self->getX, $self->getY, $self->getWidth, $self->getHeight);
}

Circle class (Circle.pm)

package Circle;
use Shape;
@ISA = qw(Shape);
@EXPORT = qw(new, getRadius, setRadius, draw);

# constructor
sub new {
   my ($class, $newx, $newy, $newradius) = @_;
   my $self = bless Shape->new($newx, $newy);
   $self->setRadius($newradius);
   return $self;
}

# accessors for the radius
sub getRadius {
   my ($self) = @_;
   return $self->{radius};
}
sub setRadius {
   my ($self, $newradius) = @_;
   $self->{radius} = $newradius;
}

# draw the circle
sub draw {
   my ($self) = @_;
   printf("Drawing a Circle at:(%d,%d), radius %d\n",
      $self->getX, $self->getY, $self->getRadius);
}

Try shapes function (Polymorph.pl)

package main;
use Shape;
use Rectangle;
use Circle;

sub TryMe {
   # set up array to hold the shapes
   my @scribble = (Rectangle->new(10, 20, 5, 6), Circle->new(15, 25, 8));

   # iterate through the lists and handle shapes polymorphically
   foreach my $each (@scribble) {
      $each->draw;
      $each->rMoveTo(100, 100);
      $each->draw;
   }

   # call a rectangle specific instance
   my $arec = Rectangle->new(0, 0, 15, 15);
   $arec->setWidth(30);
   $arec->draw;
}

TryMe;

Output

Drawing a Rectangle at:(10,20), width 5, height 6
Drawing a Rectangle at:(110,120), width 5, height 6
Drawing a Circle at:(15,25), radius 8
Drawing a Circle at:(115,125), radius 8
Drawing a Rectangle at:(0,0), width 30, height 15

Chris Rathman / Chris.Rathman@tx.rr.com