Contributed by Chris Rathman
% An interpreter for object-oriented programs provided by % Ivan Brakto in 'Prolog, Programming For Artificial Intelligence' % with some minor patches to enable it to run on SWI-Prolog :- op(600, xfy, ::). % send message to object % use '::' operator as syntax for send message Object::Message :- send(Object, Message). % send(Message, Object): find Object's method and execute send(Object, Message) :- get_methods(Object, Methods), % Find Object's methods process(Message, Methods). % Execute corresponding method % get the defined methods for the class get_methods(Object, Methods) :- % Private methods object(Object, Methods). % get the defined methods inherited from the superclass get_methods(Object, Methods) :- % Inherited methods isa(Object, SuperObject), get_methods(SuperObject, Methods). % process the method if it is defined as a fact process(Message, [Message | _]) :- % Use a fact process(Message, [Message | _]). % process the method if it is defined as a rule process(Message, [(Message :- Body) | _]) :- % Use a rule call(Body). process(Message, [_ | Methods]) :- % break the message up process(Message, Methods). |
object(
shape(X, Y), [
(getx(X) :- X is X),
(gety(Y) :- Y is Y),
(moveto(_Shape, _X, _Y) :- fail),
(rmoveto(_Shape, _X, _Y) :- fail),
(draw :- fail)
]
).
|
object(
rectangle(X, Y, Width, Height), [
(getwidth(W) :-
W is Width),
(getheight(H) :-
H is Height),
(setwidth(NewRectangle, NewWidth) :-
NewRectangle = rectangle(X, Y, NewWidth, Height)),
(setheight(NewRectangle, NewHeight) :-
NewRectangle = rectangle(X, Y, Width, NewHeight)),
(moveto(NewRectangle, NewX, NewY) :-
NewRectangle = rectangle(NewX, NewY, Width, Height)),
(rmoveto(NewRectangle, DeltaX, DeltaY) :-
A is X + DeltaX,
B is Y + DeltaY,
NewRectangle = rectangle(A, B, Width, Height)),
(draw :-
write('Drawing a Rectangle at:('),
write(X),
write(','),
write(Y),
write('), width '),
write(Width),
write(', height '),
write(Height),
nl)
]
).
% set rectangle to inherit from shape class
isa(rectangle(X, Y, _WIDTH, _HEIGHT), shape(X, Y)).
|
object(
circle(X, Y, Radius), [
(getradius(R) :-
R is Radius),
(setradius(NewCircle, NewRadius) :-
NewCircle = circle(X, Y, NewRadius)),
(moveto(NewCircle, NewX, NewY) :-
NewCircle = circle(NewX, NewY, Radius)),
(rmoveto(NewCircle, DeltaX, DeltaY) :-
A is X + DeltaX,
B is Y + DeltaY,
NewCircle = circle(A, B, Radius)),
(draw :-
write('Drawing a Circle at:('),
write(X),
write(','),
write(Y),
write('), radius '),
write(Radius),
nl)
]
).
% set circle to inherit from shape class
isa(circle(X, Y, _RADIUS), shape(X, Y)).
|
% iterate through a list and send message
drawloop([]) :- true.
drawloop([Shape|Tail]) :-
Shape::draw,
Shape::rmoveto(ShapeMoved, 100, 100),
ShapeMoved::draw,
drawloop(Tail).
polymorph :-
% create a list containing various shape instances
Scribble = [
rectangle(10, 20, 5, 6),
circle(15, 25, 8)],
% iterate through the list and handle shapes polymorphically
drawloop(Scribble),
% handle rectangle and instance
ARectangle = rectangle(0, 0, 15, 15),
ARectangle::draw,
ARectangle::setwidth(BRectangle, 30),
BRectangle::draw.
|
?- consult('oop.pl').
?- consult('polymorph.pl').
?- 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 15, height 15 Drawing a Rectangle at:(0,0), width 30, height 15 Yes |