Contributed by Chris Rathman
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 {} |
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); } |
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); } |
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; |
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 |