/*******************************************************/
/*            Syntax tree formatter program            */
/*   for text-based (non-graphics) display of trees    */
/*                                                     */
/*  Based on SAX parser treeprint.pl by Yasuharu Den   */
/*                                                     */
/*    Graham Wilcock (graham@ccl.umist.ac.uk) 97/10    */
/*******************************************************/

:- module(print_tree, [print_tree/1]).

:- use_module(library(lists), [is_list/1,member/2,append/3,reverse/2]).

print_tree(Tree) :-
	format_tree(Tree, Prep),
	treeprint(Prep).

format_tree([],[]).
format_tree([H1|T1], [H2|T2]) :-
	is_list(H1), !,
	format_tree(H1,H2),
	format_tree(T1,T2).
format_tree([Word],[[Word]]) :- !.
format_tree([H1|T1], [H2|T2]) :-
	user:format_tree_node(H1,H2), !,          % User-defined.
	format_tree(T1,T2).
format_tree([H1|T1], [H2|T2]) :-
	functor(H1,H2,_),
	format_tree(T1,T2).

% treeprint.pl
%
% Version 1.12 (24 Sep 1992) Yasuharu Den
% Version 1.0  (03 Jun 1992) Yasuharu Den

% A new tool for printing virtical trees.
%
% The data structure of <Tree>:
%
%   <Tree> ::= [<Node>|<Children>]
%   <Children> ::= a list of <Tree>'s
%   <Node> ::= a ground term
%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% User Parameters
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   treeprint_flag(+Flag, -Old)
%
treeprint_flag(Flag, Old) :- treeprint_flag(Flag, Old, Old).

%   treeprint_flag(+Flag, -Old, ?New)
%
treeprint_flag(print_mode, Old, New) :- !,
	treeprint_flag_value(Old, New, [flat,non_flat]),
	retract('$print_mode'(Old)),
	asserta('$print_mode'(New)), !.
treeprint_flag(balancing, Old, New) :- !,
	treeprint_flag_value(Old, New, [on,off]),
	retract('$balancing'(Old)),
	asserta('$balancing'(New)), !.
treeprint_flag(internode_sep, Old, New) :- !,
	treeprint_flag_value(Old, New, integer),
	retract('$internode_sep'(Old)),
	asserta('$internode_sep'(New)), !.
treeprint_flag(vline_char, Old, New) :- !,
	treeprint_flag_value(Old, New, character),
	retract('$vline_char'(Old)),
	asserta('$vline_char'(New)), !.
treeprint_flag(hline_char, Old, New) :-
	treeprint_flag_value(Old, New, character),
	retract('$hline_char'(Old)),
	asserta('$hline_char'(New)), !.
treeprint_flag(corner_char, Old, New) :-
	treeprint_flag_value(Old, New, character),
	retract('$corner_char'(Old)),
	asserta('$corner_char'(New)), !.

%   treeprint_flag_value(+Old, +New, -Type)
%
treeprint_flag_value(Old, New, _) :- var(New), !,
	Old == New.
treeprint_flag_value(_, New, Type) :- treeprint_flag_value(Type, New).

treeprint_flag_value(integer, X) :- !, integer(X).
treeprint_flag_value(character, X) :- !, X = [C], integer(C).
treeprint_flag_value([X|_], X) :- !.
treeprint_flag_value([_|Rest], X) :- treeprint_flag_value(Rest, X).

%   Default Values
%
:- dynamic '$print_mode'/1,
	   '$balancing'/1,
	   '$internode_sep'/1,
	   '$vline_char'/1,
	   '$hline_char'/1,
	   '$corner_char'/1.

'$print_mode'(flat).
'$balancing'(off).
'$internode_sep'(1).
'$vline_char'("|").
'$hline_char'("-").
'$corner_char'("+").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Miscellaneous
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   min(+X, +Y, -Min)
%
min(X, Y, X) :- X =< Y, !.
min(_, Y, Y).

%   max(+X, +Y, -Max)
%
max(X, Y, X) :- X >= Y, !.
max(_, Y, Y).

%   middle(+X, +Y, -Middle)
%
middle(X, Y, Z) :- Z is (X + Y + 1) // 2.

%   make_list(+N, +Element, -List, ?Tail)
%
make_list(0, _, List, List) :- !.
make_list(N, Element, [Element|Rest], Tail) :-
	N1 is N - 1,
	make_list(N1, Element, Rest, Tail).

%   list_depth(+List, -Depth)
%
list_depth(List, Depth) :- List = [_|_], !,
	list_depth(List, 0, MaxElementDepth),
	Depth is MaxElementDepth + 1.
list_depth(_, 0).

list_depth([], Depth, Depth) :- !.
list_depth([Element|Rest], Depth, Depth1) :-
	list_depth(Element, ElementDepth),
	max(Depth, ElementDepth, Depth0),
	list_depth(Rest, Depth0, Depth1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Top Level
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   treeprint(+Tree)
%
treeprint(Tree) :-
	current_output(Stream),
	treeprint(Stream, Tree), !.

%   treeprint(+Stream, +Tree)
%
treeprint(Stream, Tree) :-
	list_depth(Tree, Depth),
	augment_tree(Tree, 1, Depth, Tree1),
	normalize_tree(Tree1, Tree2),
	write_tree(Stream, Tree2), !.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Augment Tree
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Converts a tree into an augmented tree.
%
% The data structure of <Augmented Tree>:
%
%   <Augmented Tree> ::= t(<Node>,<XVal>,<Bounds>,<Augmented Children>)
%   <Augmented Children> ::= a list of <Augmented Tree>'s
%   <Bounds> ::= a list of <Bound>'s
%   <Bound> ::= (<LVal>,<RVal>)
%   <LVal> ::= an integer
%   <RVal> ::= an integer
%   <XVal> ::= an integer
%   <Node> ::= a ground term
%

%   augment_tree(+Tree, +Level, +Depth, -AugmentedTree)
%
augment_tree([Node], Level, Depth, t(Node,0,Bounds,[])) :- !,
	atom_bounds(Node, 0, Bound),
	( treeprint_flag(print_mode, flat) -> N is Depth - Level ; N = 0 ),
	make_list(N, (0,0), Bounds, [Bound]).
augment_tree([Node|Children], Level, Depth,
	        t(Node,XVal,[Bound|Bounds],Children1)) :-
	build_children(Children, Level, Depth, Children1, Bounds),
	build_xval(Children1, XVal),
	atom_bounds(Node, XVal, Bound).

map_augment_tree([], _, _, []) :- !.
map_augment_tree([Tree|Rest], Level, Depth, [Tree1|Rest1]) :-
	augment_tree(Tree, Level, Depth, Tree1),
	map_augment_tree(Rest, Level, Depth, Rest1).

%   atom_bounds(+Node, +XVal, -Bound)
%
atom_bounds(Node, XVal, (LVal,RVal)) :-
	term_width(Node, Width),
	LVal is XVal - Width // 2,
	RVal is XVal + (Width - 1) // 2, !.

%   build_xval(+ArgumentedChildren, -XVal)
%
build_xval(Children, XVal) :-
	build_xval1(Children, LeftmostXVal, RightmostXVal),
	middle(LeftmostXVal, RightmostXVal, XVal), !.

build_xval1([t(_,XVal,_,_)], XVal, XVal) :- !.
build_xval1([t(_,LeftmostXVal,_,_)|Rest], LeftmostXVal, RightmostXVal) :-
	build_xval2(Rest, RightmostXVal).

build_xval2([t(_,RightmostXVal,_,_)], RightmostXVal) :- !.
build_xval2([_|Rest], RightmostXVal) :-
	build_xval2(Rest, RightmostXVal).

%   build_children(+Children, +Level, +Depth,
%                  -AugmentedChildren, -ChildBounds)
%
build_children(Children, Level, Depth, Children2, Bounds) :-
	Level1 is Level + 1,
	map_augment_tree(Children, Level1, Depth, Children0),
	move_around_tree(Children0, Children1, Bounds),
	(
	    treeprint_flag(print_mode, non_flat),
	    treeprint_flag(balancing, on) ->
	    Below is Depth - Level1,
	    balancing_tree(Below, Children1, Children2)
	;
	    Children2 = Children1
	), !.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Move Around Tree
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   move_around_tree(+AugmentedTree, -AdjustedTree, -ChildBounds)
%
move_around_tree([Left|Rest], Tree1, Bounds) :-
	treeprint_flag(internode_sep, Sep),
	move_around_tree1(Rest, Left, Sep, Tree1, [], Bounds), !.

move_around_tree1([], Left, _, [Left], Bounds, Bounds1) :- !,
	Left = t(_,_,LBounds,_),
	merge_bounds(Bounds, LBounds, Bounds1).
move_around_tree1([Right|Rest], Left, Sep, [Left|Tree1], Bounds, Bounds1) :-
	Left = t(_,_,LBounds,_),
        merge_bounds(Bounds, LBounds, Bounds0),
	move_tree(Right, Bounds0, Sep, Right1),
	move_around_tree1(Rest, Right1, Sep, Tree1, Bounds0, Bounds1).

%   move_tree(+Tree, +SetBounds, +InternodeSep, -Tree1)
%
move_tree(Tree, RBounds, Sep, Tree1) :-
	Tree = t(_,_,LBounds,_),
	outer_distance(LBounds, RBounds, 0, Distance),
	Distance1 is Distance + Sep,
	adjust_values(Tree, Distance1, Tree1), !.

%   outer_distance(+LeftBounds, +RightBounds, +Distance, -Distance1)
%
outer_distance([], _, Distance, Distance) :- !.
outer_distance(_, [], Distance, Distance) :- !.
outer_distance([(LVal,_)|LRest], [(_,RVal)|RRest], Distance, Distance1) :-
	Dist is RVal - LVal + 1,
	max(Distance, Dist, Distance0),
	outer_distance(LRest, RRest, Distance0, Distance1).

%   merge_bounds(+LeftBounds, +RightBounds, -Bounds)
%
merge_bounds([], RBounds, RBounds) :- !.
merge_bounds(LBounds, [], LBounds) :- !.
merge_bounds([(LVal,_)|LRest], [(_,RVal)|RRest], [(LVal,RVal)|Bounds]) :-
	merge_bounds(LRest, RRest, Bounds).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Balancing Tree
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   balancing_tree(+BelowDepth, +AdjustedTree, -BalancedTree)
%
balancing_tree(0, Tree, Tree) :- !.
balancing_tree(Below, Tree, Tree1) :-
	balancing(Tree, Below, Tree0),
	Below1 is Below - 1,
	balancing_tree(Below1, Tree0, Tree1).

%   balancing(+AdjustedTree, +BelowDepth, -BalancedTree)
%
balancing([], _, []) :- !.
balancing([Left|Rest], Below, [Left|Tree1]) :-
	Left = t(_,_,LBounds,_),
	length(LBounds, D),
	D - 1 < Below, !,
	balancing(Rest, Below, Tree1).
balancing([Left|Rest], Below, Tree1) :-
	balancing(Rest, Left, [], Below, Tree1).

balancing([], Left, ToMove, _, [Left|ToMove1]) :- !,
	reverse(ToMove, ToMove1).
balancing([Right|Rest], Left, ToMove, Below, Tree1) :-
	Right = t(_,_,RBounds,_),
	length(RBounds, D),
	D - 1 < Below, !,
	balancing(Rest, Left, [Right|ToMove], Below, Tree1).
balancing([Right|Rest], Left, [], Below, [Left|Tree1]) :- !,
	balancing(Rest, Right, [], Below, Tree1).
balancing([Right|Rest], Left, ToMove, Below, [Left|Tree1]) :-
	Left = t(_,_,LBounds,_),
	Right = t(_,_,RBounds,_),
	reverse(ToMove, ToMove1),
	move_children(ToMove1, LBounds, RBounds, Moved),
	append(Moved, Tree0, Tree1),
	balancing(Rest, Right, [], Below, Tree0).

%   move_children(+Children, +LSetBounds, +RSetBounds, -Children1)
%
move_children(Children, LBounds, RBounds, Children1) :-
	build_bounds(Children, [], Bounds),
	inner_distance(LBounds, Bounds, 33554431, LDistance),
	inner_distance(Bounds, RBounds, 33554431, RDistance),
	Distance is (RDistance + 1 - LDistance) // 2,
	adjust_children(Children, Distance, Children1), !.

%   inner_distance(+LeftBounds, +RightBounds, +Distance, -Distance1)
%
inner_distance([], _, Distance, Distance) :- !.
inner_distance(_, [], Distance, Distance) :- !.
inner_distance([(_,RVal)|LRest], [(LVal,_)|RRest], Distance, Distance1) :-
	Dist is LVal - RVal - 1,
	min(Distance, Dist, Distance0),
	inner_distance(LRest, RRest, Distance0, Distance1).

%   build_bounds(+Children, +LBounds, -Bounds)
%
build_bounds([], Bounds, Bounds) :- !.
build_bounds([t(_,_,RBounds,_)|Rest], LBounds, Bounds) :-
	merge_bounds(LBounds, RBounds, Bounds0),
	build_bounds(Rest, Bounds0, Bounds).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Adjust Values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%   adjust_values(+Tree, +Distance, -Tree1)
%
adjust_values(t(Node,XVal,Bounds,Children), Distance,
	        t(Node,XVal1,Bounds1,Children1)) :-
        adjust_xval(XVal, Distance, XVal1),
	adjust_bounds(Bounds, Distance, Bounds1),
	adjust_children(Children, Distance, Children1), !.

%   adjust_xval(+XVal, +Distance, -XVal1)
%
adjust_xval(XVal, Distance, XVal1) :-
	XVal1 is XVal + Distance, !.

%   adjust_bounds(+Bounds, +Distance, -Bounds1)
%
adjust_bounds([], _, []) :- !.
adjust_bounds([(LVal,RVal)|Rest], Distance, [(LVal1,RVal1)|Bounds1]) :-
	LVal1 is LVal + Distance,
	RVal1 is RVal + Distance,
	adjust_bounds(Rest, Distance, Bounds1).

%   adjust_children(+Children, +Distance, -Children1)
%
adjust_children([], _, []) :- !.
adjust_children([Tree|Rest], Distance, [Tree1|Children1]) :-
	adjust_values(Tree, Distance, Tree1),
	adjust_children(Rest, Distance, Children1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Normalize Tree
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Converts an augmented tree into a normalized tree.
%
% The data structure of <Normalized Tree>:
%
%   <Normalized Tree> ::= [<Node Data>,<Branch Data>|<Normalized Tree>]
%                       | [<Node Data>|<Tail>]
%   <Node Data> ::= [<Node Datum>|<Node Data>]
%                 | [<VBranch Datum>|<Node Data>] | <Tail>
%   <Branch Data> ::= [<HBranch Datum>|<Branch Data>] | <Tail>
%   <Node Datum> ::= n(<Node>,<LVal>,<RVal>)
%   <VBranch Datum> :=  v(<LVal>,<RVal>)
%   <HBranch Datum> ::= h(<LVal>,<RVal>)
%   <LVal> ::= an integer
%   <RVal> ::= an integer
%   <Node> ::= a ground term
%   <Tail> ::= a variable
%

%   normalize_tree(+AugmentedTree, -NormalizedTree)
%
normalize_tree(Tree, Tree1) :-
	left_offset(Tree, Offset),
	Offset1 is 1 - Offset,
	normalize([Tree], yes, Offset1, Tree1, _), !.

%   normalize(+Children, +Flag, +Offset, +NormalizedTree, -NormalizedTree1)
%
normalize([], _, _, Tree, Tree) :- !.
normalize([t(Node,_,[(LVal,RVal)],[])|Rest], _, Offset,
	        [[n(Node,LVal1,RVal1)|NodeData]|Tree], Tree1) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
	LVal2 is RVal1 + 1,
	normalize1(Rest, LVal2, Offset, [NodeData|Tree], Tree1).
normalize([t(Node,XVal,[(LVal,RVal)|Bounds],[])], yes, Offset,
                [[v(LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree],
		[NodeData,BranchData|Tree0]) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),
	normalize([t(Node,XVal,Bounds,[])], no, Offset, Tree, Tree0).
normalize([t(Node,XVal,[(LVal,RVal)|Bounds],[])|Rest], yes, Offset,
                [[c(LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree], Tree1) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),
	LVal2 is RVal1 + 1,
	normalize([t(Node,XVal,Bounds,[])], no, Offset, Tree, Tree0),
	normalize1(Rest, LVal2, Offset, [NodeData,BranchData|Tree0], Tree1).
normalize([t(Node,XVal,[(LVal,RVal)|Bounds],[])|Rest], no, Offset,
                [[v(LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree], Tree1) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),
	LVal2 is RVal1 + 1,
	normalize([t(Node,XVal,Bounds,[])], no, Offset, Tree, Tree0),
	normalize1(Rest, LVal2, Offset, [NodeData,BranchData|Tree0], Tree1).
normalize([t(Node,XVal,[(LVal,RVal)|_],Children)|Rest], _, Offset,
                [[n(Node,LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree], Tree1) :-
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),	
	LVal2 is RVal1 + 1,
	normalize(Children, yes, Offset, Tree, Tree0),
	normalize1(Rest, LVal2, Offset, [NodeData,BranchData|Tree0], Tree1).

normalize1([], _, _, Tree, Tree) :- !.
normalize1([t(Node,_,[(LVal,RVal)],[])|Rest], LVal0, Offset,
	        [[h(LVal0,RVal0),n(Node,LVal1,RVal1)|NodeData]|Tree],
		Tree1) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
	RVal0 is LVal1 - 1,
	LVal2 is RVal1 + 1,
	normalize1(Rest, LVal2, Offset, [NodeData|Tree], Tree1).
normalize1([t(Node,XVal,[(LVal,RVal)|Bounds],[])|Rest], LVal0, Offset,
                [[h(LVal0,RVal0),c(LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree], Tree1) :- !,
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),
	RVal0 is LVal1 - 1,
	LVal2 is RVal1 + 1,	
	normalize([t(Node,XVal,Bounds,[])], no, Offset, Tree, Tree0),
	normalize1(Rest, LVal2, Offset, [NodeData,BranchData|Tree0], Tree1).
normalize1([t(Node,XVal,[(LVal,RVal)|_],Children)|Rest], LVal0, Offset,
                [[h(LVal0,RVal0),n(Node,LVal1,RVal1)|NodeData],
		 [v(XVal1,XVal1)|BranchData]|Tree], Tree1) :-
        adjust_xval(LVal, Offset, LVal1),
        adjust_xval(RVal, Offset, RVal1),
        adjust_xval(XVal, Offset, XVal1),
	RVal0 is LVal1 - 1,
	LVal2 is RVal1 + 1,	
	normalize(Children, yes, Offset, Tree, Tree0),
	normalize1(Rest, LVal2, Offset, [NodeData,BranchData|Tree0], Tree1).

%   left_offset(+AugmentedTree, -Offset)
%
left_offset(t(_,_,Bounds,_), Offset) :-
	left_offset(Bounds, 33554431, Offset).

left_offset([], Offset, Offset) :- !.
left_offset([(LVal,_)|Rest], Offset, Offset1) :-
	min(Offset, LVal, Offset0),
	left_offset(Rest, Offset0, Offset1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Write Tree
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Displays a tree.
%

%   write_tree(+Stream, +NormalizedTree)
%
write_tree(Stream, Tree) :-
	treeprint_flag(vline_char, VLineChar),
	treeprint_flag(hline_char, HLineChar),
	treeprint_flag(corner_char, CornerChar),
	map_write_line(Tree, Stream, VLineChar, HLineChar, CornerChar), !.

%   write_line(+Tree, +CurrentPos, +Stream,
%              +VLineChar, +HLineChar, +CornerChar)
%
write_line([], _, _, _, _, _) :- !.
write_line([n(Node,LVal,RVal)|Rest], Pos, Stream,
	        VLineChar, HLineChar, CornerChar) :- !,
	Skip is LVal - Pos - 1,
	tab(Stream, Skip),
	write_node(Node, Stream),
	write_line(Rest, RVal, Stream, VLineChar, HLineChar, CornerChar).
write_line([v(LVal,RVal)|Rest], Pos, Stream,
	        VLineChar, HLineChar, CornerChar) :- !,
	Skip is LVal - Pos - 1,
	tab(Stream, Skip),
	loop_put(LVal, RVal, Stream, VLineChar),
	write_line(Rest, RVal, Stream, VLineChar, HLineChar, CornerChar).
write_line([h(LVal,RVal)|Rest], Pos, Stream,
	        VLineChar, HLineChar, CornerChar) :- !,
	Skip is LVal - Pos - 1,
	tab(Stream, Skip),
	loop_put(LVal, RVal, Stream, HLineChar),
	write_line(Rest, RVal, Stream, VLineChar, HLineChar, CornerChar).
write_line([c(LVal,RVal)|Rest], Pos, Stream,
	        VLineChar, HLineChar, CornerChar) :-
	Skip is LVal - Pos - 1,
	tab(Stream, Skip),
	loop_put(LVal, RVal, Stream, CornerChar),
	write_line(Rest, RVal, Stream, VLineChar, HLineChar, CornerChar).

map_write_line([], _, _, _, _) :- !.
map_write_line([Line|Rest], Stream, VLineChar, HLineChar, CornerChar) :-
	write_line(Line, 0, Stream, VLineChar, HLineChar, CornerChar),
	nl(Stream),
	map_write_line(Rest, Stream, VLineChar, HLineChar, CornerChar).

loop_put(M, N, _, _) :- M > N, !.
loop_put(M, N, Stream, Char) :-
	put(Stream, Char),
	M1 is M + 1,
	loop_put(M1, N, Stream, Char).

%   write_node(+Node, +Stream)
%
write_node(X, Stream) :- write(Stream, X).

% term_width.pl (19 Aug 1992) Yasuharu Den
% from write.pl

%   term_width(+Term, -Width)
%
term_width(Term, Width) :- term_width(Term, 1200, 0, '(', 2'100, _, Width).

term_width(Term, _, _, _, _, 2'000, _) :- var(Term), !, fail.
term_width('$VAR'(N), _, _, _, Ci, Co, Width) :- !,
	term_width_VAR(N, Ci, Co, Width).
term_width(Atom, _, PrePrio, Lpar, _, 2'100, Width) :-
	atom(Atom),
	current_prefixop(Atom, P, _),
	P =< PrePrio, !,
	name_width(Lpar, LparWidth),
	term_width_atom(Atom, 2'100, _, AtomWidth),
	% +1 for 0')
	Width is LparWidth + AtomWidth + 1.
term_width(Atom, _, _, _, Ci, Co, Width) :- atom(Atom), !,
	term_width_atom(Atom, Ci, Co, Width).
term_width(N, _, _, _, Ci, 2'000, Width) :- number(N), !,
	(   N < 0 -> maybe_space_width(Ci, 2'010, SpaceWidth)
	;   maybe_space_width(Ci, 2'000, SpaceWidth)
	),
	name_width(N, NWidth),
	Width is SpaceWidth + NWidth.
term_width({Term}, _, _, _, _, 2'100, Width) :- !,
	term_width(Term, 1200, 0, '(', 2'100, _, TermWidth),
	% +2 for 0'{ and 0'}
	Width is TermWidth + 2.
term_width([Head|Tail], _, _, _, _, 2'100, Width) :- !,
	term_width(Head, 999, 0, '(', 2'100, _, HeadWidth),
	term_width_tail(Tail, TailWidth),
	% +1 for 0'[
	Width is HeadWidth + TailWidth + 1.
term_width((A,B), Prio, _, Lpar, Ci, Co, Width) :- !,
	%  This clause stops writeq quoting commas.
	maybe_paren_width(1000, Prio, Lpar, Lpar1, Ci, C1, LparWidth),
	term_width(A, 999, 0, Lpar1, C1, _, AWidth),
	term_width(B, 1000, 1000, '(', 2'100, C2, BWidth),
	maybe_paren_width(1000, Prio, C2, Co, RparWidth),
	% +1 for 0',
	Width is LparWidth + AWidth + BWidth + RparWidth + 1.
term_width(Term, Prio, PrePrio, Lpar, Ci, Co, Width) :-
	functor(Term, F, N),
	term_width(N, F, Term, Prio, PrePrio, Lpar, Ci, Co, Width).

term_width(1, F, Term, Prio, _, Lpar, Ci, Co, Width) :-
        current_postfixop(F, P, O), !,
	( current_infixop(F, _, _, _) -> O1 = 1200 ; O1 = O ),
	maybe_paren_width(O1, Prio, Lpar, Lpar1, Ci, C1, LparWidth),
	arg(1, Term, A),
	term_width(A, P, 1200, Lpar1, C1, C2, AWidth),
	term_width_atom(F, C2, C3, FWidth),
	maybe_paren_width(O1, Prio, C3, Co, RparWidth),
	Width is LparWidth + AWidth + FWidth + RparWidth.
term_width(1, F, Term, Prio, PrePrio, Lpar, Ci, Co, Width) :-
        F \== -,
        current_prefixop(F, O, P), !,
	( PrePrio = 1200 -> O1 is P+1 ; O1 = O ),% for "fy X yf" etc. cases
	maybe_paren_width(O1, Prio, Lpar, _, Ci, C1, LparWidth),
	term_width_atom(F, C1, C2, FWidth),
	arg(1, Term, A),
	term_width(A, P, P, ' (', C2, C3, AWidth),
	maybe_paren_width(O1, Prio, C3, Co, RparWidth),
	Width is LparWidth + FWidth + AWidth + RparWidth.
term_width(2, F, Term, Prio, PrePrio, Lpar, Ci, Co, Width) :-
        current_infixop(F, P, O, Q), !,
	( PrePrio = 1200 -> O1 is Q+1 ; O1 = O ),% for "U xfy X yf" etc. cases
	maybe_paren_width(O1, Prio, Lpar, Lpar1, Ci, C1, LparWidth),
	arg(1, Term, A),
	term_width(A, P, 1200, Lpar1, C1, C2, AWidth),
	term_width_atom(F, C2, C3, FWidth),
	arg(2, Term, B),
	term_width(B, Q, Q, '(', C3, C4, BWidth),
	maybe_paren_width(O1, Prio, C4, Co, RparWidth),
	Width is LparWidth + AWidth + FWidth + BWidth + RparWidth.
term_width(N, F, Term, _, _, _, Ci, 2'100, Width) :-
	term_width_atom(F, Ci, _, FWidth),
	term_width_args(0, N, Term, ArgsWidth),
	Width is FWidth + ArgsWidth.

term_width_VAR(N, Ci, 2'000, Width) :-
	integer(N), N >= 0, !,
	maybe_space_width(Ci, 2'000, SpaceWidth),
	(   N >= 26 -> Rest is N//26, name_width(Rest, RWidth)
	;   RWidth = 0
        ),
	% +1 for the capital letter.
	Width is SpaceWidth + RWidth + 1.
term_width_VAR(Atom, Ci, Co, Width) :-
	atom(Atom), !,
	atom_mode(Atom, Co),
	maybe_space_width(Ci, Co, SpaceWidth),
	name_width(Atom, AtomWidth),
	Width is SpaceWidth + AtomWidth.
term_width_VAR(X, Ci, 2'100, Width) :-
	term_width_atom('$VAR', Ci, _, VARWidth),
	term_width_args(0, 1, '$VAR'(X), ArgsWidth),
	Width is VARWidth + ArgsWidth.

term_width_atom(Atom, Ci, Co, Width) :-
	atom_mode(Atom, Co),
	maybe_space_width(Ci, Co, SpaceWidth),
	name_width(Atom, AtomWidth),
	Width is SpaceWidth + AtomWidth.

term_width_args(N, N, _, Width) :- !,
	% +1 for 0')
	Width is 1.
term_width_args(I, N, Term, Width) :-
	term_width_args(I, IWidth),
	J is I+1,
	arg(J, Term, A),
	term_width(A, 999, 0, '(', 2'100, _, AWidth),
	term_width_args(J, N, Term, JWidth),
	Width is IWidth + AWidth + JWidth.

term_width_args(0, Width) :- !,
	% +1 for 0'(
	Width is 1.
term_width_args(_, Width) :-
	% +1 for 0',
	Width is 1.

term_width_tail(Var, _) :- var(Var), !, fail.
term_width_tail([], Width) :- !,
	% +1 for 0']
	Width is 1.
term_width_tail([Head|Tail], Width) :- !,
	term_width(Head, 999, 0, '(', 2'100, _, HeadWidth),
	term_width_tail(Tail, TailWidth),
	% +1 for 0',
	Width is HeadWidth + TailWidth + 1.
term_width_tail(Other, Width) :- %  |junk]
	term_width(Other, 999, 0, '(', 2'100, _, OtherWidth),
	% +2 for 0'| and 0']
	Width is OtherWidth + 2.

%   maybe_paren_width(+P, +Prio, +Chari, -Charo, +Ci, +Co, -Width)
%
maybe_paren_width(P, Prio, Lpar, '(', _, 2'100, Width) :- P > Prio, !,
	name_width(Lpar, Width).
maybe_paren_width(_, _, Lpar, Lpar, C, C, 0).

maybe_paren_width(P, Prio, _, 2'100, Width) :- P > Prio, !,
	% +1 for 0')
	Width is 1.
maybe_paren_width(_, _, C, C, 0).

%   maybe_space_width(+LeftContext, +TypeOfToken, -Width)
%
maybe_space_width(Ci, Co, Width) :-
	Ci\/Co < 2'100, Ci#Co < 2'010, !,
	% +1 for 0' 
        Width is 1.
maybe_space_width(_, _, 0).

%   name_width(+Token, -Width)
%
name_width(Token, Width) :-
	name(Token, Name),
	length(Name, Width).

current_prefixop(Op, Less, Prec) :-
	current_op(Less, Ass, Op),
	op_ass(Ass, 0, Less, Prec, pre).

current_infixop(Op, Left, Prec, Right) :-
	current_op(Prec, Ass, Op),
	op_ass(Ass, Left, Prec, Right, in).

current_postfixop(Op, Prec, Less) :-
	current_op(Less, Ass, Op),
	op_ass(Ass, Prec, Less, 0, post).

op_ass(fy, 0, Prec, Prec, pre).
op_ass(fx, 0, Prec, Less, pre) :- Less is Prec-1.
op_ass(yfx, Prec, Prec, Less, in) :- Less is Prec-1.
op_ass(xfy, Less, Prec, Prec, in) :- Less is Prec-1.
op_ass(xfx, Less, Prec, Less, in) :- Less is Prec-1.
op_ass(yf, Prec, Prec, 0, post).
op_ass(xf, Less, Prec, 0, post) :- Less is Prec-1.

atom_mode(Atom, C) :-	name(Atom, Name), atom_mode1(Name, C), !.

atom_mode1(Name, C) :- alpha(Name), !, C = 2'000.
atom_mode1(Name, C) :- other(Name), !, C = 2'010.
atom_mode1(_, 2'001).

alpha([C|Rest]) :- C >= 0'a, C =< 0'z, !, alphabet(Rest).

alphabet([]) :- !.
alphabet([C|Rest]) :- C >= 0'A, C =< 0'Z, !, alphabet(Rest).
alphabet([C|Rest]) :- C >= 0'a, C =< 0'z, !, alphabet(Rest).
alphabet([C|Rest]) :- C >= 0'0, C =< 0'9, !, alphabet(Rest).
alphabet([C|Rest]) :- C = 0'_, !, alphabet(Rest).

other([0';]) :- !.
other([0'!]) :- !.
other(Name) :- symbol(Name).

symbol([]) :- !.
symbol([C|Rest]) :- member(C, "+-*/\^<>=`~:.?@#$&"), !, symbol(Rest).