
Blocks variableSubclass: #BlocksPro
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: '' !

!BlocksPro class logicMethods !

example1
" BlocksPro example1 "
BlocksPro new openOn! !


!BlocksPro logicMethods !

"add on the Block"
addDraw(x,z) :- name( x,name1), name(z, name2),
        is(_,self add: name1 value onBlock: name2 value).
    "add on the Table"
addDraw(x) :- name( x,name1), col( x, col1),
        is(_,self add: name1 value onTable: col1 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 part 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),
   !!.!

" problem specific "
blocks1() :- go( [on(#a,#b), on(#b,#t), on(#c,#t)],
                 [on(#a,#b), on(#b,#c), on(#c,#t)]).!

" problem specific "
blocks2() :- go( [on(#a,#t), on(#b,#t), on(#c,#a)],[on(#a,#b), on(#b,#c), on(#c,#t)]).!

" problem specific "
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( x,state) :- not( member( on(_,x), state)).!

"column locations"
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 onTable: col1 value).
"draw block --> block"
moveDraw( x,_,z) :-
    ne(z,#t),
    name(x, name1), name(z,name2),
    is(_ , self remove: name1 value),
    is(_ , self add: name1 value onBlock: 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( #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 called from printpath"
printpath1([h]) :- is(_,replyStream nextPutAll:
                (h value printString) ).
printpath1( [h|t]) :-  is(_,replyStream nextPutAll:
                ((h value printString),',') ),
                printpath1(t).!

"printpath print list in 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( #t).! !
