home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1988
/
11
/
greglaz.asc
< prev
next >
Wrap
Text File
|
1988-10-21
|
14KB
|
495 lines
_PROLOG/V: PROLOG IN THE SMALLTALK ENVIRONMENT_
by
Gregory L. Lazarev
[LISTING ONE]
/* blocks transfer program */
/* generic */
go( Start, Goal) :- path( Start, Goal, [Start]), !.
path( Goal, Goal, Hist) :- printpath( Hist).
path( State, Goal, Hist) :- move( State, Interm),
not( member( Interm, Hist) ),
path( Interm, Goal, [Interm|Hist]).
member( X, [X|_]).
member( X, [_|T]) :- member( X, T).
printpath( []).
printpath( [H|T] ) :- printpath( T), write( H), nl.
/* problem specific */
blocks1 :- go( [on(a,b), on(b,t), on(c,t)], [on(a,b), on(b,c), on(c,t)] ).
blocks2 :- go( [on(a,t), on(b,t), on(c,a)], [on(a,b), on(b,c), on(c,t)] ).
blocks3 :- go( [on(a,b), on(b,t), on(c,t),on(d,a)], [on(a,d), on(b,c), on(c,t),
on(d,b)] ).
move( State1, State2) :- member( on( X,Y), State1),
clear( X, State1),
not( table( Y)),
subst( on( X, Y), State1, on( X, t), State2).
move( State1, State2) :- member( on( X,Y), State1),
clear( X, State1),
member( on( Z, _), State1), X \= Z,
clear( Z, State1),
subst( on( X, Y), State1, on( X, Z), State2).
clear( X, State) :- not( member( on( _, X), State)).
subst( _, [], _, []).
subst( X, [X|L], A, [A|M]) :- !, subst( X, L, A, M).
subst( X, [Y|L], A, [Y|M]) :- subst( X, L, A, M).
table( t).
[LISTING TWO]
Prolog variableSubclass: #Blocks
instanceVariableNames:
'position animator number between replyStream selectedChoice '
classVariableNames: ''
poolDictionaries: ''
Blocks class methods
Blocks methods
add: block1 onBl:block2
"add one block to the top of the other"
| ordColl index col size|
index := 1.
col := 0.
[index <= number
and: [col = 0] ]
whileTrue: [
( (position at: index) includes: block2 )
ifTrue: [ col := index].
index := index + 1].
ordColl := position at: col.
ordColl add: block1.
size := ordColl size.
position at: col
put: ordColl.
animator tell: block1
place: ( (between * col) - (between * (2/3) ) ) @
( (RectPict extent y - 5) - ( 60 * size * Aspect) truncated )
add: block onTbl: col
"(re)initialize column: add the first block to it"
| ordColl |
ordColl := position at: col.
ordColl add: block.
position at: col
put: ordColl.
animator tell: block
place: ( (between * col) - (between * (2/3) ) ) @
( (RectPict extent y - 5) - ( 60 * Aspect) truncated)
assign: size
"assign a variable number"
number := size
choice: aSymbol
"Private - Change to the selected choice type."
selectedChoice := aSymbol. " #blocks1, #blocks2 or #blocks3"
self
changed: #input;
changed: #reply;
changed: #graph:
choices
"Private - Answer an Array of choices"
^#( blocks1 blocks2 blocks3 )
doBlocks
"Actual call to Prolog"
CursorManager execute change.
selectedChoice == #blocks1
ifTrue: [self :? blocks1() ].
selectedChoice == #blocks2
ifTrue: [self :? blocks2() ].
selectedChoice == #blocks3
ifTrue: [self :? blocks3() ].
CursorManager normal change
doBlocksMenu
"Menu do\help"
^Menu
labels: 'do\help' withCrs
lines: #()
selectors: #(doBlocks help)
finish
Menu message: 'The solution is found'
graph: aRect
" initialize graph pane, assign global variables"
| aForm |
aForm := Form
width: aRect width
height: aRect height.
aForm displayAt: aRect origin. "background"
RectPict := aRect. "global vars"
White := ( Form
width: 60 height: ( 60 * Aspect) truncated ).
^aForm
help
"Provide help message"
selectedChoice == #blocks1
ifTrue: [replyStream nextPutAll:
'EXPLANATION: This is an animation of the 3 blocks problem'; cr ].
selectedChoice == #blocks2
ifTrue: [replyStream nextPutAll:
'EXPLANATION: This is an animation of the 3 blocks problem'; cr ].
selectedChoice == #blocks3
ifTrue: [replyStream nextPutAll:
'EXPLANATION: This is an animation of the 4 blocks problem'; cr ]
initAnimation
" initialize Animation"
| blockImages |
blockImages :=
Array with: White.
animator := Animation new
initialize: RectPict.
animator add: blockImages
name: 'Black'
color: #black.
animator add: blockImages
name: 'LightGray'
color: #lightGray.
animator add: blockImages
name: 'Gray'
color:#gray.
selectedChoice == #blocks3
ifTrue: [ animator add: blockImages
name: 'DarkGray'
color: #darkGray].
" set speed, shift, background"
animator
setBackground;
speed: 8;
shiftRate: 10
initialize1
"initialize Blocks"
| pen|
" draw bottom"
pen := Pen new.
pen defaultNib: 3 @ 2.
pen
place: (RectPict origin x + 5) @ (RectPict corner y - 5);
goto: (RectPict corner x - 5) @ (RectPict corner y - 5).
" assign between variable"
between := RectPict width // number.
"initialize animation and position"
self
initAnimation;
initPosition
initPosition
"Set the receiver's initial position"
position := Array new: number.
1 to: number do: [:index|
position at: index
put: OrderedCollection new]
input
"Private - Answer an input text for
the selected choice (blocks1, blocks2 or blocks3)."
| text1 text2 text3 text|
text1 := 'FROM: A on B, B on Table, C on Table
TO : A on B, B on C, C on Table
( COLORS: A- Black, B- LightGray, C- Gray)'.
text2 := 'FROM: A on Table, B on Table, C on A
TO : A on B, B on C, C on Table
( COLORS: A- Black, B- LightGray, C- Gray)'.
text3 := 'FROM: A on B, B on Table, C on Table, D on A
TO : A on D, B on C, C on Table, D on B
( COLORS: A- Black, B- LightGray, C- Gray, D- DarkGray)'.
selectedChoice == #blocks1
ifTrue: [text := text1].
selectedChoice == #blocks2
ifTrue: [text := text2].
selectedChoice == #blocks3
ifTrue: [text := text3].
^text
openOn
"Create a window on Blocks.
Define the type, behavior and relative
size of each pane and schedule the window."
| topPane replyPane|
topPane := TopPane new label: 'B L O C K S'.
topPane addSubpane:
(ListPane new
model: self;
name: #choices;
change: #choice:;
selection: 1;
framingRatio: ( 0 @ 0 extent: 1/4 @ (1/6) ) ).
selectedChoice := #blocks1.
topPane addSubpane:
(TextPane new
model: self;
name: #input;
menu: #doBlocksMenu;
framingRatio: ( 1/4 @ 0 extent: 3/4 @ (1/6) ) ).
topPane addSubpane:
(replyPane := TextPane new
model: self;
name: #reply;
framingRatio: ( 0 @ (1/6) extent: 1 @ (1/6) ) ).
topPane addSubpane:
(GraphPane new
model: self;
name: #graph:;
framingRatio: ( 0 @ (1/3) extent: 1 @ (2/3) ) ).
topPane reframe:
(Display boundingBox insetBy: 10@10).
replyStream := replyPane dispatcher.
topPane dispatcher openWindow scheduleWindow
remove: block
"remove block (from the data structure only)"
| ordColl index col|
index := 1.
col := 0.
[index <= number
and: [col = 0] ]
whileTrue: [
( (position at: index) includes: block )
ifTrue: [ col := index].
index := index + 1].
ordColl := position at: col.
ordColl removeLast.
position at: col
put: ordColl
reply
" Initiate reply pane with an empty String."
^ String new
[LISTING THREE]
Blocks variableSubclass: #BlocksPro
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
BlocksPro class methods
BlocksPro methods
"add on the Table"
addDraw( x) :-
name( x, name1), col( x, col1),
is( _, self add: name1 value onTbl: col1 value).
"add on the Block"
addDraw( x, z) :-
name(x, name1), name( z, name2),
is( _, self add: name1 value onBl: name2 value).
"arrange0 - the first part of arrange"
arrange0( len, _, _, accum, accum) :-
length( accum, accumLen),
eq( len, accumLen).
arrange0( len, master, prev, accum, ordered) :-
nextStep( master, prev, [], nextPrev),
append( nextPrev, accum, nextAccum),
arrange0( len, master, nextPrev, nextAccum, ordered).
"arrange1 - the second step of arrange"
arrange1( master, [#t], arrMaster, arrMaster).
arrange1( master, [h|t], interm, arrMaster) :-
member( on(h,x), master),
arrange1( master, t, [on(h,x)| interm], arrMaster).
"arrange ,i.e. [on(a,b),on(b,t),on(c,t),on(d,a)] -->
--> [d,a,b,c,t] --> [on(c,t), on(b,t), on(a,b), on(d,a)] "
arrange( master, arrMaster) :-
length( master, len0),
is( len, len0 value + 1),
arrange0( len, master, [#t], [#t], ordered),
arrange1( master, ordered, [], arrMaster),
!.
"blocks1"
blocks1():- go( [on(#a,#b), on(#b,#t), on(#c,#t)], [on(#a,#b),
on(#b,#c), on(#c,#t)] ).
"blocks2"
blocks2():- go( [on(#a,#t), on(#b,#t), on(#c,#a)], [on(#a,#b),
on(#b,#c), on(#c,#t)] ).
"blocks3"
blocks3():- go( [on(#a,#b), on(#b,#t), on(#c,#t), on(#d,#a)],
[on(#a,#d), on(#b,#c), on(#c,#t), on(#d,#b)] ).
"clear"
clear( x, state) :- not( member( on( _, x), state) ).
"column"
col( #a, 1).
col( #b, 2).
col( #c, 3).
col( #d, 4).
"go"
go( start, goal) :- init( start),
path( start, goal, [start]),
is( _, self finish),
!.
"initialize"
init( start) :- length( start, startSize),
is( _, self assign: startSize value),
is( _, self initialize1 ),
arrange( start, arrStart),
initDraw( arrStart),
is( _, Menu message: 'Press button to start'),
!.
"initial drawing"
initDraw( []).
initDraw( [on(x,#t)|tail]) :- addDraw( x),
initDraw( tail).
initDraw( [on(x,z)|tail]) :- addDraw( x,z),
initDraw( tail).
"move"
move(state1,state2,x,y,#t) :- member( on( x, y), state1),
clear( x, state1),
not( table( y) ),
subst( on( x, y), state1, on( x, #t), state2).
move(state1,state2,x,y,z) :- member( on( x, y), state1),
clear( x, state1),
member( on( z, _), state1), ne( x, z),
clear( z, state1),
subst( on( x, y), state1, on( x, z), state2).
"draw Block --> Table"
moveDraw( x, _, #t) :-
name( x, name1), col( x, col1),
is( _, self remove: name1 value),
is( _, self add: name1 value onTbl: col1 value).
"draw Table --> Block; Block --> Block"
moveDraw( x, _, z) :-
ne( z, #t),
name(x, name1), name( z, name2),
is( _, self remove: name1 value),
is( _, self add: name1 value onBl: name2 value).
"draw In and Out"
moveDrawInOut( block, placeFrom, placeTo) :-
moveDraw( block, placeFrom, placeTo).
moveDrawInOut( block, placeFrom, placeTo) :-
moveDraw( block, placeTo, placeFrom),
fail(). " reverse back"
"name"
name( #a, 'Black').
name( #b, 'LightGray').
name( #c, 'Gray').
name( #d, 'DarkGray').
"nextStep - called from arrange0"
nextStep( _, [], nextPrev, nextPrev).
nextStep( master, [h|t], current, nextPrev) :-
findall( x, member( on( x,h), master), interm),
append( interm, current, current1),
nextStep( master, t, current1, nextPrev).
"path"
path( goal, goal, hist) :- is( _, self changed: #reply),
printpath( hist).
path( state, goal, hist) :- move(state, interm, block, placeFrom, placeTo),
not( member( interm, hist) ),
moveDrawInOut( block, placeFrom, placeTo),
path( interm, goal, [interm| hist] ).
"printpath1"
printpath1( [h]) :- is( _, replyStream nextPutAll:
(h value printString) ).
printpath1( [h| t] ) :- is( _, replyStream nextPutAll:
( (h value printString), ', ' ) ),
printpath1( t).
"printpath - print list in the reverse order"
printpath( []).
printpath( [h| t] ) :- printpath( t),
is( _, replyStream nextPutAll: '['),
printpath1( h),
is( _, replyStream nextPutAll: ']'),
is( _, replyStream cr).
"substitute"
subst( _, [], _, []).
subst( x, [x| l], a, [a| m]) :- !,
subst( x, l, a, m).
subst( x, [y| l], a, [y| m]) :- subst( x, l, a, m).
"table"
table( #t).