Modula-3

INTERFACE Shape;
   TYPE
      T <: Public;
      Public = ROOT OBJECT
         METHODS
            draw();
            moveTo(newx: INTEGER; newy: INTEGER);
            rMoveTo(deltax: INTEGER; deltay: INTEGER);
            getX(): INTEGER;
            getY(): INTEGER;
      END;
END Shape.

MODULE Shape;

   REVEAL
      T = Public BRANDED OBJECT
         x: INTEGER;
         y: INTEGER;
         METHODS
            setX(newx: INTEGER) := SetX;
            setY(newy: INTEGER) := SetY;
         OVERRIDES
            moveTo := MoveTo;
            rMoveTo := RMoveTo;
            getX := GetX;
            getY := GetY;
      END;

   (* accessors for x & y *)
   PROCEDURE GetX(self: T): INTEGER =
   BEGIN
      RETURN self.x;
   END GetX;

   PROCEDURE GetY(self: T): INTEGER =
   BEGIN
      RETURN self.y;
   END GetY;

   PROCEDURE SetX(self: T; newx: INTEGER) =
   BEGIN
      self.x := newx;
   END SetX;

   PROCEDURE SetY(self: T; newy: INTEGER) =
   BEGIN
      self.y := newy;
   END SetY;

   (* move the shape position *)
   PROCEDURE MoveTo(self: T; newx: INTEGER; newy: INTEGER) =
   BEGIN
      self.setX(newx);
      self.setY(newy);
   END MoveTo;

   PROCEDURE RMoveTo(self: T; deltax: INTEGER; deltay: INTEGER) =
   BEGIN
      self.moveTo(self.getX() + deltax, self.getY() + deltay);
   END RMoveTo;

BEGIN
END Shape.

INTERFACE Rectangle;
   IMPORT Shape;
   TYPE
      T <: Public;
      Public = Shape.T OBJECT
         METHODS
            init(x: INTEGER; y: INTEGER; width: INTEGER; height: INTEGER): T;
            getWidth(): INTEGER;
            getHeight(): INTEGER;
            setWidth(newwidth: INTEGER);
            setHeight(newheight: INTEGER);
      END;
END Rectangle.

MODULE Rectangle;
   IMPORT IO;
   IMPORT Fmt;

   REVEAL
      T = Public BRANDED OBJECT
         width: INTEGER;
         height: INTEGER;
         OVERRIDES
            init := Init;
            getWidth := GetWidth;
            getHeight := GetHeight;
            setWidth := SetWidth;
            setHeight := SetHeight;
            draw := Draw;
      END;

   (* Initialize the attributes of the object *)
   PROCEDURE Init(self: T; x: INTEGER; y: INTEGER;
      width: INTEGER; height: INTEGER): T =
   BEGIN
      self.moveTo(x, y);
      self.setWidth(width);
      self.setHeight(height);
      RETURN self;
   END Init;

   (* accessors for width & height *)
   PROCEDURE GetWidth(self: T): INTEGER =
   BEGIN
      RETURN self.width;
   END GetWidth;

   PROCEDURE GetHeight(self: T): INTEGER =
   BEGIN
      RETURN self.height;
   END GetHeight;

   PROCEDURE SetWidth(self: T; newwidth: INTEGER) =
   BEGIN
      self.width := newwidth;
   END SetWidth;

   PROCEDURE SetHeight(self: T; newheight: INTEGER) =
   BEGIN
      self.height := newheight;
   END SetHeight;

   (* draw the rectangle *)
   PROCEDURE Draw(self: T) =
   BEGIN
      IO.Put("Drawing a Rectangle at:(" &
         Fmt.Int(self.getX()) &  "," &
         Fmt.Int(self.getY()) & "), width " &
         Fmt.Int(self.getWidth()) & ", height " &
         Fmt.Int(self.getHeight()) & "\n");
   END Draw;

BEGIN
END Rectangle.

INTERFACE Circle;
   IMPORT Shape;
   TYPE
      T <: Public;
      Public = Shape.T OBJECT
         METHODS
            init(x: INTEGER; y: INTEGER; radius: INTEGER): T;
            getRadius(): INTEGER;
            setRadius(newradius: INTEGER);
      END;
END Circle.

MODULE Circle;
   IMPORT IO;
   IMPORT Fmt;

   REVEAL
      T = Public BRANDED OBJECT
         radius: INTEGER;
         OVERRIDES
            init := Init;
            getRadius := GetRadius;
            setRadius := SetRadius;
            draw := Draw;
      END;

   (* Initialize the attributes of the object *)
   PROCEDURE Init(self: T; x: INTEGER; y: INTEGER;
      radius: INTEGER): T =
   BEGIN
      self.moveTo(x, y);
      self.setRadius(radius);
      RETURN self;
   END Init;

   (* accessors for radius *)
   PROCEDURE GetRadius(self: T): INTEGER =
   BEGIN
      RETURN self.radius;
   END GetRadius;

   PROCEDURE SetRadius(self: T; newradius: INTEGER) =
   BEGIN
      self.radius := newradius;
   END SetRadius;

   (* draw the circle *)
   PROCEDURE Draw(self: T) =
   BEGIN
      IO.Put("Drawing a Circle at:(" &
         Fmt.Int(self.getX()) & "," &
         Fmt.Int(self.getY()) & "), radius " &
         Fmt.Int(self.getRadius()) & "\n");
   END Draw;

BEGIN
END Circle.

MODULE Main EXPORTS Main;
   IMPORT Shape;
   IMPORT Rectangle;
   IMPORT Circle;

VAR
   scribble: ARRAY[1..2] OF Shape.T;
   rect : Rectangle.T;

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

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

   (* access a rectangle specific function *)
   rect := NEW(Rectangle.T).init(0, 0, 15, 15);
   rect.setWidth(30);
   rect.draw();
END Main.

% Makefile for Modula-3 Shape polymorphism program
import("libm3")
module("Shape")
module("Rectangle")
module("Circle")
implementation(Main)
program(Main)

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