% draws compound terms as trees
%
% maketree(term)!
%
% Tony Grech

maketree(Tree):-
	retractall(tlist(_)),
	retractall(params(_)),
	makelist(Tree,Tlist),
	assert(tlist(Tlist)),
	fail.
maketree(_):-
	retract(tlist(Tlist)),
	findparams(Tlist,1,1,Params),
	assert(params(Params)),
	fail.
maketree(_):-
	retract(params(Params)),
	insort(Params,Sorted),
	prettywrite(Sorted),!.

makelist(R,[R,RL,Rwidth,0,[]]):-
	atomic(R),!,
	getlength(R, RL),
	Rwidth is RL + 1.

makelist(Tree,[Root,Rlength,Rwidth,Kidswidth,Kids]):-
	Tree =.. [Root | Args],
	make(Args,Kids,Kidswidth),
	getlength(Root,Rlength),
	(Rlength+1 > Kidswidth -> Rwidth is Rlength+1 | Rwidth is Kidswidth).

make([H | T],[Root,Rlength,Rwidth,Kidswidth,Kids | Brothers],Width):-
	makelist(H,[Root,Rlength,Rwidth,Kidswidth,Kids]),
	make(T,Brothers,Brwidth),
	Width is Rwidth + Brwidth.
make([],[],0).

getlength(Atom, Atomlen):-
	atom(Atom),!,
	strlen(Atom, Atomlen).
getlength(Int, Length):-
	concat([Int], Atom),
	strlen(Atom, Length).

findparams([Root,Length,_,_,[]],Lwall,Level,[Root(P1,Lwall,P3),Level]):-!,
	P1 is Lwall + Length/2,
	P3 is Lwall + Length.

findparams([Root,Length,Width,Kidswidth,Kids],Lwall,Level,[Root(P1,P2,P3,P4,P5),Level | Nodelist]):-
	Nextlev is Level + 1,
	(Width > Kidswidth -> Kidwall is Lwall+(Width-Kidswidth+1)/2 
			     |Kidwall is Lwall),
	find(Kids,Kidwall,Nextlev,Nodelist,P4,P5),
	P1 is (P4 + P5)/2 ,
	getP11(Lwall, Length, Width, P1, P11),
	P2 is P11- Length/2,
	P3 is P2 + Length.

getP11(Lwall, Length, _, P1, P11) :-
	P1 <   Lwall + Length/2,!,
	P11 is Lwall + Length/2.
getP11(Lwall, Length, Width, P1, P1) :-
	P1 <=  Lwall + Width - (Length-1)/2,!.
getP11(Lwall, Length, Width, P1, P11) :-
	P11 is Lwall + Width - (Length+1)/2 -1.

find([Root,Length,Width,Kidswidth,Kids],Lwall,Level,[Node | Nodelist],P5,P5):-!,
	findparams([Root,Length,Width,Kidswidth,Kids],Lwall,Level,[Node | Nodelist]),
	arg(1,Node,P5).

find([Root,Length,Width,Kidswidth,Kids | Brothers],Lwall,Level,[H1 | Nodelist],P4,P5):-
	findparams([Root,Length,Width,Kidswidth,Kids],Lwall,Level,[H1 | T1]),
	arg(1,H1,P4),
	Newlwall is Lwall + Width,
	find(Brothers,Newlwall,Level,L2,_,P5),
	append(T1,L2,Nodelist).

append([X | L1],L2,[X | L3])	:- append(L1,L2,L3).
append([],L,L).

insort([X,XLevel | L],Sorted):-
	insort(L,N),
	insertx(X,XLevel,N,Sorted).
insort([],[]).

insertx(X,XLevel,[H,HLevel | T1],[H,HLevel | T2]):-
	XLevel > HLevel ,!,
	insertx(X,XLevel,T1,T2).
insertx(X,XLevel,L,[X,XLevel | L]).

	% outbars1 , outputs all bars for that level
	% and segregates that level

outbars1([Node1,N1Level,Node2,N2Level | Nodelist],Pos,[Node1],[Node2,N2Level | Nodelist]):-
	N2Level > N1Level,!,
	arg(1,Node1,Newpos),
	tab(Newpos - Pos),
	prin("|").
outbars1([Node,_ | Nodelist],Pos,[Node | L1],L2) :-
	arg(1,Node,Newpos),
	tab(Newpos - Pos),
	prin("|"),
	Newerpos is Newpos + 1,
	outbars1(Nodelist,Newerpos,L1,L2).
outbars1([],_,[],[]).

outwords([Node | Nodelist],Pos):-
	arg(0, Node, Root), 
	arg(2, Node, P2),
	arg(3, Node, P3),
	tab(P2 - Pos),
	prin(Root),
	outwords(Nodelist,P3).
outwords([],_).

outrest([_(P1,_,_,P4,P5) | Nodelist],Pos):- !,
	tab(P4 - Pos),
	connect_child(P1,P4,P5),
	Newpos is P5 + 1,
	outrest(Nodelist,Newpos).
outrest([_ | Nodelist],Pos):- outrest(Nodelist,Pos).	% no children
outrest([],_).

connect_child(_,P4,P4):- !,prin(|).			% one child
connect_child(P1,P4,P5):-				% more than one child
	nputs('_', P1 - P4),
	putc('|'),
	nputs('_', P5 - P1).

prettywrite([]).
prettywrite(Levels):-
	outbars1(Levels,1,L,Otherlevels),nl,
	outwords(L,1),nl,
	outrest(L,1),nl,
	prettywrite(Otherlevels).
