Postscript

% Polymorphic shapes example in postscript.
% November 16, 1999 - Scott Anderson
% November 17, 1999 - Scott Anderson: changed to use fewer stack manipulations

% Make a new shape
% Args: origin-x origin-y 
/shape-make
{
        % Create a dictionary to hold the class info
        <<

                % Method dictionary for the class
                /methods
                <<
                        /move-to /shape-move-to
                        /rel-move-to /shape-rel-move-to
                >>

                % Slot dictionary for the class
                /slots
                << >>
        >> dup

        % Make it the active namespace
        begin
                5 1 roll

                % Load the slots with the arguments
                slots
                begin
                        store
                        store
                end
        end
} bind def

% Move a shape to a new origin
% Assumes the shape is the current namespace
% Args: new-x new-y
/shape-move-to
{
        % Load the slots with the arguments
        slots /y 3 -1 roll put
        slots /x 3 -1 roll put
} bind def

% Move a shape relative to current origin
% Assumes the shape is the current namespace
% Args: delta-x delta-y
/shape-rel-move-to
{
        % Get the existing y value
        slots
        begin
                y add /y exch store
                x add /x exch store
        end
} bind def



% Create a new rectangle
% Args: width height origin-x origin-y
/rectangle-make
{
        % Call the shape constructor and store the result
        shape-make dup 


        % Make the new shape the current namespace
        begin
                % Load the method and slot definitions
                methods
                begin
                        /draw /rectangle-draw store
                        /set-width /rectangle-set-width store
                        /set-height /rectangle-set-height store
                end

                5 1 roll
                slots
                begin
                        store
                        store
                end
        end

} bind def

% Set the width of a rectangle
% Args: new-w
/rectangle-set-width
{
        slots /width 3 -1 roll put
} bind def

% Set the height of a rectangle
% Args: new-h
/rectangle-set-height
{
        slots /height 3 -1 roll put
} bind def

% Draw a rectangle
% Args:
/rectangle-draw
{
        slots
        begin
                % Uuuuuugly. You'd think postscript would have better string handling.
                % The numeric->string translation is atrocious.
                (Drawing rectangle at: \() print
                x (      ) cvs print
                (, ) print
                y (      ) cvs print
                (\), width: ) print
                width (      ) cvs print
                (, height: ) print
                height (      ) cvs print
                (\n) print flush
        end
} bind def

% Args: radius origin-x origin-y
/circle-make
{
        % Call the shape constructor and store the result
        shape-make dup

        % Make the new shape the current namespace
        begin
                % Load the method and slot definitions
                methods
                begin
                        /draw /circle-draw store
                        /set-radius /circle-set-radius store
                end
                slots /radius 4 -1 roll put
        end
} bind def

% Set the radius of a circle
% Args: new-r
/circle-set-radius
{
        slots /radius 3 -1 roll put
} bind def

% Draw a circle
% Args:
/circle-draw
{
        slots
        begin
                (Drawing circle at: \() print
                x (     ) cvs print
                (, ) print
                y (     ) cvs print
                (\), radius: ) print
                radius (     ) cvs print
                (\n) print flush
        end
} bind def


% I didn't need this routine in the end, but I
% Left it in here because it is somewhat interesting.
% It will duplicate a class or instance completely.
/dupclass {
        begin
                <<

                        /methods methods << >> copy
                        /slots slots << >> copy
                >> 
        end
} bind def

% Call a method on an object dynamically
% This is the heart of polymorphism in postscript
% Args: method-name object
/call-method
{
        % Make it the current namespace
        begin
                % Load the method dictionary from the object
                methods

                % Make it the current namespace
                begin
                        % Load the method-name from the methods vtable 
                        load

                        % Convert it to executable postscript
                        cvx
                end

                % Execute the method call while still in the namespace
                % Of the object itself
                exec

        end
} bind def



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5
% Main program

% Create a rectangle
/rec1 /width 5 /height 6 /x 10 /y 20 rectangle-make store

% Create a circle
/circ1 8 /x 15 /y 25 circle-make store

% Call the draw and rel-move-to methods polymorphically on the shapes
/draw rec1 call-method
100 100 /rel-move-to rec1 call-method
/draw rec1 call-method

/draw circ1 call-method
100 100 /rel-move-to circ1 call-method
/draw circ1 call-method

% Create another rectangle
/rec2 /width 15 /height 15 /x 0 /y 0 rectangle-make store

% Call a rectangle-specific method
30 /set-width rec2 call-method

% Draw the rectangle
/draw rec2 call-method

quit