Component Pascal

MODULE Shape;

   TYPE
      Shape* = POINTER TO ShapeDesc;
      ShapeDesc* = ABSTRACT RECORD
         x: INTEGER;
         y: INTEGER;
      END;

   (* accessors for x & y *)
   PROCEDURE (self: Shape)getX*(): INTEGER, NEW;
   BEGIN
      RETURN self.x;
   END getX;

   PROCEDURE (self: Shape)getY*(): INTEGER, NEW;
   BEGIN
      RETURN self.y;
   END getY;

   PROCEDURE (self: Shape)setX(newx: INTEGER), NEW;
   BEGIN
      self.x := newx;
   END setX;

   PROCEDURE (self: Shape)setY(newy: INTEGER), NEW;
   BEGIN
      self.y := newy;
   END setY;

   (* move the shape position *)
   PROCEDURE (self: Shape)moveTo*(newx: INTEGER; newy: INTEGER), NEW;
   BEGIN
      self^.setX(newx);
      self^.setY(newy);
   END moveTo;

   PROCEDURE (self: Shape)rMoveTo*(deltax: INTEGER; deltay: INTEGER), NEW;
   BEGIN
      self^.moveTo(self^.getX() + deltax, self^.getY() + deltay);
   END rMoveTo;

   (* abstract draw method *)
   PROCEDURE (self: Shape)draw*(), NEW, ABSTRACT;

END Shape.

MODULE Rectangle;
   IMPORT Shape, Out;

   TYPE
      Rectangle* = POINTER TO RectangleDesc;
      RectangleDesc* = RECORD(Shape.ShapeDesc)
         width: INTEGER;
         height: INTEGER;
      END;

   (* accessors for width & height *)
   PROCEDURE (self: Rectangle)getWidth*(): INTEGER, NEW;
   BEGIN
      RETURN self.width;
   END getWidth;

   PROCEDURE (self: Rectangle)getHeight*(): INTEGER, NEW;
   BEGIN
      RETURN self.height;
   END getHeight;

   PROCEDURE (self: Rectangle)setWidth*(newwidth: INTEGER), NEW;
   BEGIN
      self.width := newwidth;
   END setWidth;

   PROCEDURE (self: Rectangle)setHeight*(newheight: INTEGER), NEW;
   BEGIN
      self.height := newheight;
   END setHeight;

   (* allocate and initialize a new object instance *)
   PROCEDURE Make*(x: INTEGER; y: INTEGER;
      width: INTEGER; height: INTEGER): Rectangle;
   VAR self: Rectangle;
   BEGIN
      NEW(self);
      self^.moveTo(x, y);
      self^.setWidth(width);
      self^.setHeight(height);
      RETURN self;
   END Make;

   (* draw the rectangle *)
   PROCEDURE (self: Rectangle)draw*();
   BEGIN
      Out.String("Drawing a Rectangle at:(");
      Out.Int(self^.getX(), 1);
      Out.String(",");
      Out.Int(self^.getY(), 1);
      Out.String("), width ");
      Out.Int(self^.getWidth(), 1);
      Out.String(", height ");
      Out.Int(self^.getHeight(), 1);
      Out.Ln;
   END draw;

END Rectangle.

MODULE Circle;
   IMPORT Shape, Out;

   TYPE
      Circle* = POINTER TO CircleDesc;
      CircleDesc* = RECORD(Shape.ShapeDesc)
         radius: INTEGER;
      END;

   (* accessors for radius *)
   PROCEDURE (self: Circle)getRadius*(): INTEGER, NEW;
   BEGIN
      RETURN self.radius;
   END getRadius;

   PROCEDURE (self: Circle)setRadius*(newradius: INTEGER), NEW;
   BEGIN
      self.radius := newradius;
   END setRadius;

   (* allocate and initialize a new object instance *)
   PROCEDURE Make*(x: INTEGER; y: INTEGER; radius: INTEGER): Circle;
   VAR self: Circle;
   BEGIN
      NEW(self);
      self^.moveTo(x, y);
      self^.setRadius(radius);
      RETURN self;
   END Make;

   (* draw the circle *)
   PROCEDURE (self: Circle)draw*();
   BEGIN
      Out.String("Drawing a Circle at:(");
      Out.Int(self^.getX(), 1);
      Out.String(",");
      Out.Int(self^.getY(), 1);
      Out.String("), radius ");
      Out.Int(self^.getRadius(), 1);
      Out.Ln;
   END draw;

END Circle.

MODULE Polymorph;
   IMPORT Shape, Circle, Rectangle;

   PROCEDURE Do*;

   VAR
      i: INTEGER;
      rect: Rectangle.Rectangle;
      circ: Circle.Circle;
      scribble: ARRAY 2 OF Shape.Shape;

   BEGIN
      (* set up some shape instances *)
      scribble[0] := Rectangle.Make(10, 20, 5, 6);
      scribble[1] := Circle.Make(15, 25, 8);

      (* iterate through some shapes and handle polymorphically *)
      FOR i := 0 TO 1 DO
         scribble[i]^.draw();
         scribble[i]^.rMoveTo(100, 100);
         scribble[i]^.draw();
      END;

      (* access a rectangle specific function *)
      NEW(rect);
      rect := Rectangle.Make(0, 0, 15, 15);
      rect^.setWidth(30);
      rect^.draw();
   END Do;

END Polymorph.

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