laukee@minster.UUCP (03/25/87)
After Vijay Saraswat's timely observation on the lack of interesting programs
in this group I dug this thing up.
The basic idea came from a colleague's thought that it would be useful to be
able to show the progress of instantiations in a goal.
To be really useful there needs to be some means of "unshowing" the partial
groundings, so that the display is always consistent with a snapshot of the
state of the system.
Really this program is only an experiment on that concept. It has *lots* of
rough edges and *lots* of nasty constructs... However, it does provide an
interesting way of "watching" Prolog at work.
A much reduced "turtle graphics" environment is presented. (Basically you can
tell the turtle to turn 90 deg. clockwise or anticlockwise, and to move forward
X steps.)
The "interesting" feature is that backtracking over these primitives results in
them being undone.
For example, I have defined anysq(X) to be four sets of 'forward X steps, turn'.
If I try to satisfy 'anysq(4), fail.' then all the possible solutions to:
'anysq(4).', where 'forward (drawing) X' and 'backward (erasing) X' satisfy the
goal 'forward X', and 'turn clockwise' and 'turn anticlockwise' satisfy 'turn'
are drawn.
I wrote the program for C-Prolog 1.5, but it wouldn't require much effort
to move it to other Prologs.
It *is* terminal specific - I use a Microcolour m2200 in ANSII mode (basically
vt100 plus colour) - but again, if your terminal has ANSII features, it won't be
a problem to hack it straight.
One thing may be worth thinking about:
When a line is undrawn it is sometimes helpful to leave a record of it. I cope
with this by switching the undo colour from black to white. This is ok on
a colour terminal where the lines themselves are other than white, but it would
be a bit confusing in monochrome... maybe half-intensity or something?
The program is slower than it really needs to be. Previously the undo would
act like paint stripper, cutting right down to the black of the background.
This version paints in layers, undoing strips off a layer. (Great if you've
got a lot of colours.) For a 5-fold speed increase take out the layers.
N.b. Unless you have a really clever terminal you can expect strange occurences
when the turtle escapes from the screen.
When you 'teach' the turtle remember that the clauses are added at the
top (so that new tricks can have old names) i.e., enter clauses in reverse
order.
Use: Cut at the line
Name the program "turtle"
Enter Prolog and consult turtle (it will "autoboot")
================================CUT=HERE====================================
%
% Copyright (c) 1987 by David Lau-Kee, Univ. of York.
%
% Permission is granted to use or modify this code provided this notice is
% included in all complete or partial copies.
%
redo :- system("${EDITOR-'/bin/vi'} turtle"),reconsult(turtle).
rec :- reconsult(turtle).
%%%%%
% Terminal specific code - for m2200 (basically ANSII plus colour).
%%%%%
clr :- write('[H[2J'). % Clear the screen and home cursor.
clrline :- write('[2K'). % Clear current line - don't move cursor.
moveto(X,Y) :- write('['),write(X),write(';'),write(Y),write('H').
% Move cursor to line X, col. Y.
restore :- write('8'), !. % Restore cursor previously saved cursor
% attributes.
save :- write('7'), !. % Save cursor attributes.
white :- write('[37m'). % Foreground white.
black :- write('[30m'). % Foreground black.
cup :- write('[A'). % Cursor motions, up, down, right, left.
cdn :- write('[B').
crt :- write('[C').
clt :- write('[D').
colour(0) :- write('[31m'). % Foreground red
colour(1) :- write('[32m'). % ,, yellow
colour(2) :- write('[33m'). % ,, green
colour(3) :- write('[34m'). % ,, blue
colour(7) :- black. % Default for undone lines is black.
scrollon :- % Set the scrolling region to lines 1 to 22.
write('[37m[1;22r'), moveto(23,1),
write('-------------------------------------------------------------------------------').
scrolloff :- % Reset standard scrolling region.
write('[1;24r').
horiz :- write('-'). % Draw a horizontal mark.
vertical :- write('|'). % Draw a vertical mark.
%%%%%
%%%%%
% Turtle : The turns - clockwise and anticlockwise.
% The tc2 are backtrack failures.
%%%%%
turn(c) :- tc1(c).
turn(c) :- tc2(c).
turn(a) :- tc1(a).
turn(a) :- tc2(a).
%%%%%
tc1(c) :-
direction(O),
Tmp is O + 1, New is Tmp mod 4,
restore,
indicate(New),!.
tc2(c) :-
direction(O),
Tmp is O + 3, New is Tmp mod 4,
restore,
indicate(New),!,fail.
tc1(a):-
direction(O),
Tmp is O + 3, New is Tmp mod 4,
restore,
indicate(New),!.
tc2(a) :-
direction(O),
Tmp is O + 1, New is Tmp mod 4,
restore,
indicate(New),!, fail.
indicate(0) :-
write('^'),clt, setdir(0), !.
indicate(1) :-
write('>'),clt, setdir(1), !.
indicate(2) :-
write('v'),clt, setdir(2), !.
indicate(3) :- !,
write('<'),clt, setdir(3), !.
%%%%%
% turtle : The lines - may only move forward (i.e., in direction(D)).
% The doline2 supplies the failing backtrack.
%%%%%
forward(N) :- doline1(N).
forward(N) :- doline2(N).
%%%%%
doline1(N) :-
restore, drline(N),
rest,!.
doline2(N) :-
restore,drawline(N),
rest,!, fail.
rest :- direction(N), indicate(N), save,!.
calc(X,Y,0,N,X,Ynew) :- Ynew is Y + N.
calc(X,Y,1,N,Xnew,Y) :- Xnew is X + N.
calc(X,Y,2,N,X,Ynew) :- Ynew is Y - N.
calc(X,Y,3,N,Xnew,Y) :- Xnew is X - N.
drline(0) :- !.
drline(X) :-
direction(D),
do(D),
Y is X - 1,!,
drline(Y).
drawline(0) :- !.
drawline(X) :-
direction(O), Tmp is O + 2, D is Tmp mod 4,
undo(D),
Y is X - 1, !,
drawline(Y).
do(0) :-
pos(X,Y),Ynew is Y + 1,setpos(X,Ynew),
asserta(layer(X,Ynew,0)),!,draw(0,0).
do(1) :-
pos(X,Y),Xnew is X + 1,setpos(Xnew,Y),
asserta(layer(Xnew,Y,1)),!,draw(1,1).
do(2) :-
pos(X,Y),Ynew is Y - 1,setpos(X,Ynew),
asserta(layer(X,Ynew,2)),!,draw(2,2).
do(3) :-
pos(X,Y),Xnew is X - 1,setpos(Xnew,Y),
asserta(layer(Xnew,Y,3)),!,draw(3,3).
undo(0) :-
pos(X,Y),Ynew is Y + 1,setpos(X,Ynew),
retract(layer(X,Y,_)),!,undraw(0,X,Y).
undo(1) :-
pos(X,Y),Xnew is X + 1,setpos(Xnew,Y),
retract(layer(X,Y,_)),!,undraw(1,X,Y).
undo(2) :-
pos(X,Y),Ynew is Y - 1,setpos(X,Ynew),
retract(layer(X,Y,_)),!,undraw(2,X,Y).
undo(3) :-
pos(X,Y),Xnew is X - 1,setpos(Xnew,Y),
retract(layer(X,Y,_)),!,undraw(3,X,Y).
draw(0,C) :- colour(C),vertical,cup,clt.
draw(1,C) :- colour(C),horiz.
draw(2,C) :- colour(C),vertical,cdn,clt.
draw(3,C) :- colour(C),horiz, clt,clt.
undraw(0,X,Y) :- layer(X,Y,D),!,
colour(D),line(D),cup,clt.
undraw(1,X,Y) :- layer(X,Y,D),!,
colour(D),line(D).
undraw(2,X,Y) :- layer(X,Y,D),!,
colour(D),line(D),cdn,clt.
undraw(3,X,Y) :- layer(X,Y,D),!,
colour(D),line(D),clt,clt.
undraw(N,X,Y) :- !,draw(N,7).
line(0) :- vertical.
line(1) :- horiz.
line(2) :- vertical.
line(3) :- horiz.
%%%%%
% Examples : some undoable examples
%%%%%
fractal(0) :-
!.
fractal(N) :-
forward(N),turn(X),
Next is N - 1,fractal(Next).
realsq(N) :-
pos(X,Y), direction(D),!,
anysq(N),
pos(X,Y), direction(D).
anysq(X) :-
forward(X), turn(A),
forward(X), turn(B),
forward(X), turn(C),
forward(X), turn(D).
antisq(X) :-
forward(X), turn(a),
forward(X), turn(a),
forward(X), turn(a),
forward(X), turn(a).
square(X) :-
forward(X), turn(c),
forward(X), turn(c),
forward(X), turn(c),
forward(X), turn(c).
allsq(0) :- !.
allsq(X) :-
Next is X - 1,
allsq(Next),
square(X).
demo1:-
square(3),square(5),fail.
demo1.
demo2:-
anysq(5),fail.
demo2.
demo3:-
realsq(5),qfail.
demo3.
demo4:-
fractal(5), fail.
demo4.
demo:-
clean, cmdline,write('noshow, square(3), square(5), fail.'),
noshow, demo1,
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('show, square(3), square(5), fail.'),
show, demo1,
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('noshow, anysq(5), fail.'),
noshow, demo2,
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('show, realsq(5), qfail.'),
show, demo3,
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('fractal(6).'),
fractal(6),
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('noshow, fractal(5), fail.'),
noshow, demo4,
cmdline, write('(more) press <return>'),
get0(X),
clean, cmdline,write('show, fractal(5), fail.'),
show, demo4,
cmdline, write('press <return> to continue'),
get0(X),
clean.
%%%%%
%%%%%
% Terminal : The following clauses comprise the terminal handler
% and the turtle "driver".
%%%%%
clean :- clr, retractall(layer(_,_,_)), scrollon,restore,centre,initstat.
tidy :- scrolloff, clr.
setpos(X,Y) :-
retractall(pos(_,_)),
asserta(pos(X,Y)),
status.
setdir(D) :-
retractall(direction(_)),
asserta(direction(D)),
status.
status :-
save,
direction(D), pos(X,Y),
white, moveto(1,12),write('('),
write(X),write(','),write(Y),write('). '),
moveto(1,42),write(D),write('.'),
restore.
initstat :-
save,
white,
moveto(1,1),clrline,moveto(1,1),
write('Position : '),moveto(1,30),write('Direction : '),
restore,
status.
show :- asserta((colour(7) :- white,!)).
noshow :- asserta((colour(7) :- black,!)).
centre :-
direction(D),
moveto(12,40),setpos(0,0), save,
indicate(D).
cmdline :-
moveto(24,1), clrline,
moveto(24,1), white, write('$ '),!.
run :-
scrollon,
setdir(0), centre, initstat, readeval,
scrolloff.
turtle(Outfile) :-
tell(Outfile),
turtle,
told(Outfile).
turtle :-
asserta(pos(0,0)),asserta(direction(0)),
clr,run.
%%%%%
%%%%%
% Interpreter : The Pogo readeval loop
%%%%%
retractall(X) :- retract(X), fail.
retractall(X) :- retract((X :- Y)), fail.
retractall(_).
flush :-
get0(X),
not(X = 10),
flush.
flush.
qfail :-
save, cmdline,
write('Ok? y/n <return> '),
get(X), flush,
restore, ok(X).
ok(121) :- !.
ok(_) :- fail.
process(go) :- clr, clean, readeval.
process(X) :- asserta(X), dofun(teach).
dofun(end) :-
write('Ok, program ending'),
nl.
dofun(teach) :-!,
clrline,
write('Clause: '),read(X),!,process(X).
dofun(X) :-
X,!,
readeval.
dofun(_) :-
readeval.
readeval :-
cmdline,
read(F),
dofun(F).
%%%%%
help :-
tidy,
write(' Help'),
nl,nl,
write('end. : End the session and exit Prolog.'),nl,
write('redo. : Make changes to the program file, then reconsult it.'), nl,
write('rec. : Reconsult the program file.'),nl,
write('clr. : Clear the screen.'),nl,
write('clean. : Clean up the drawing area.'),nl,
write('tidy. : Clear the screen and turn off the drawing area.'),nl,
write('teach. : Prepare to assert Prolog clauses (n.b. these are asserted at'),nl,
write(' the head of the clause-base). Type "go" to continue the '),nl,
write(' session.'),nl,
write('qfail. : Query fail. Asks user whether or not to fail.'),nl,
write('demo. : A demonstration of a busy turtle.'),nl,nl,nl,
write('Type "clean." to clean up the drawing area.').
:- clr, write(' This is the Prolog turtle program.'),
nl,
nl, write('The turtle knows how to: turn(c) [clockwise]'),
nl, write(' turn(a) [anticlockwise]'),
nl, write(' and forward(X) [move forward X places].'),
nl,nl,
write('You can teach it how to do more complicated things by combining these'),
nl, write('primitive actions... For example, it already knows how to square(X), and'),
nl, write('fractal(X).'),
nl,nl,
write('For more interesting effects you can try inserting fails into your drawings.'),
nl, write('If a forward(X) clause fails then a second clause is attempted. This'),
nl, write('second clause has the effect of undoing the marks made by the first clause.'),
nl, write('A similar undoing effect takes place for turn(a) and turn(c).'),
nl,nl,
write('If you use qfail instead of fail then you will be prompted as to whether or not'),
nl, write('that particular clause really should fail. For example, try realsq(4),qfail'),
nl, write('realsq(4) will try to draw a square of size 4, the qfail will prompt for'),
nl, write('acceptability. If you answer "n" then the program will try to resatisfy'),
nl, write('realsq(4).'),
nl.
?- read(Continue).
[return].
:- clr, write('For now the undone lines will be drawn in black. You can change this by'),
nl, write('teaching the program otherwise (or simply type "show." or "noshow." for'),
nl, write('white or black undone lines).'),
nl, nl,
write('If you type "help" in response to the $ prompt information on other useful'),
nl, write('clauses will be given.'),
nl, write('If you type "end" in response to the $ prompt you will leave Prolog'),
moveto(23,40),
write('Dave Lau-Kee, February 1987'),
moveto(15,1).
?- read(Continue).
[return].
:- turtle, halt.