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