/*
   Modul   : drawterm.pl
   Purpose : draws a prolog-term
   Author  : Gerhard Röhner
   Version 1.4, from 19.09.2004
   Version 1.5, from 09.09.2006, show variable-names
   Version 1.6, from 16.10.2007, zoom-function
   Version 1.7, from 04.09.2013, font-function for classroom presentation

   Call: draw_term(Term) or draw_term.

   Activation: Save, dont't copy, the file in the library-folder of SWI-Prolog,
   because the filedate has to be up-to-date. Then call ?- make. in SWI-Prolog.
   
   After drawing a term you can:
     1. drag a node with the mouse
     2. refresh the sub-nodes by double-clicking the dragged node

*/

:- module(drawterm,
     [ draw_term/0   % Calls the modul for interactive work
     , draw_term/1   % Calls the modul with the term to be displayed
     ]).
     
:- dynamic term/1.
:- dynamic terms/4.
:- use_module(library(pce)).

draw_term:-
  draw_term(term).

draw_term(Term):-
  % Configuration
  Width = 600.0,
  Height  = 450.0,
  attribute(Term, AttrTerm),
  retractall(term/1),
  asserta(term(AttrTerm)),
  flag(width, _, Width),
  flag(ydistance, _, 30.0),
  flag(node, _, 0),
  flag(fontsize, _, 12),
  retractall(terms(_, _, _, _)),

  % Application window and diagram range
  new(F, frame('Terminterpreter')),
  send(F, append, new(P, picture('Terminterpreter', size(Width, Height)))),
  send(F, append, new(D, dialog)),
  send(D, below, P),
  term_to_atom(Term, Atom),
  send(D, append, new(Edit, text_item('Term', Atom))),
  send(Edit, value_width, 450),
  send(D, append, slider(zoom, 20, 400, 100, message(@prolog, zoom, @arg1, P))),
  send(D, append, button(draw, message(@prolog, draw, P, Edit))),
  send(D, append, button(wider, message(@prolog, wider, P))),
  send(D, append, button(smaller, message(@prolog, smaller, P))),
  send(D, append, button(higher, message(@prolog, higher, P))),
  send(D, append, button(lower, message(@prolog, lower, P))),
  send(D, append, button('font+', message(@prolog, fontplus, P))),
  send(D, append, button('font-', message(@prolog, fontminus, P))),
  send(D, append, button(close, message(F, destroy))),
  send(D, default_button(draw)),
  send(F, open),

  % Call
  draw(P).

% OnClick Draw
draw(P, Edit):-
  get(Edit, selection, Atom),
  atom_to_term(Atom, VarTerm, Variablen),
  replace(VarTerm, Variablen, Term),
  attribute(Term, AttrTerm),
  retractall(term/1),
  asserta(term(AttrTerm)),
  draw(P).

% Zoom-Function
zoom(Zoom, P):-
  flag(width, _, 600 * Zoom/100),
  flag(ydistance, _, max(20, 30 * Zoom/100)),
  draw(P).

% OnClick Wider
wider(P):-
  flag(width, Width, Width*1.2),
  draw(P).

% OnClick Smaller
smaller(P):-
  flag(width, Width, Width/1.2),
  draw(P).

% OnClick Higher
higher(P):-
  flag(ydistance, YDistance, YDistance + 10),
  draw(P).

% OnClick Lower
lower(P):-
  flag(ydistance, YDistance, YDistance),
  (  YDistance > 20
  -> NewYDistance is YDistance - 10
  ;  NewYDistance is YDistance
  ),
  flag(ydistance, YDistance, NewYDistance),
  draw(P).
  
% OnClick Font+
fontplus(P):-
  flag(fontsize, Fontsize, Fontsize + 2),
  higher(P).
  
% OnClick Font-
fontminus(P):-
  flag(fontsize, Fontsize, Fontsize - 2),
  lower(P).
  
% draw/1
draw(P):-
  send(P, clear),
  flag(width, Width, Width),
  term(AttrTerm),
  draw_term(P, 5, 10, Width, -1, AttrTerm).

% draw a node
% draw_node(+Window, +Father, +Description, +X, +Y).
draw_node(Window, Father, Description, X, Y):-
  send(Window, display, new(Son, text(Description))),
  send(Son, center, point(X, Y)),
  flag(fontsize, Fontsize, Fontsize),
  send(Son, font, font(helvetica, normal, Fontsize)),
  send(Son, recogniser, new(move_gesture(left))),
  connect(Father, Son).

% draw an atom-leaf
draw_term(Window, X, Y, Width, Father, Term):-
  atomic(Term), !,
  draw_node(Window, Father, Term, X + Width/2, Y).

% draw a variable-leaf
draw_term(Window, X, Y, Width, Father, Term):-
  var(Term), !,
  term_to_atom(Term, Atom),
  draw_node(Window, Father, Atom, X + Width/2, Y).
  
% draw an attributed structered term
draw_term(Window, X, Y, Width, Father, Term):-
  functor(Term, Name, _Arity),
  calculate_rootposition(Term, Width, X1),
  X2 is X + X1,
  send(Window, display, new(Son, text(Name))),
  send(Son, center, point(X2, Y)),
  send(Son, handle, handle(w/2, h, in)),
  flag(fontsize, Fontsize, Fontsize),
  send(Son, font, font(helvetica, normal, Fontsize)),
  connect(Father, Son),
  flag(node, N, N+1),
  assertz(terms(N, Width, Son, Term)),
  send(Son, recogniser, click_gesture(left, '', double, message(@prolog, refresh, N))),
  send(Son, recogniser, new(move_gesture(left))),
  flag(ydistance, YDistance, YDistance),
  Ya is Y + YDistance,
  Term =.. [Functor, NodeInTerm|Arguments],
  (  Functor = '.'
  -> Node is NodeInTerm
  ;  Node is NodeInTerm - 1
  ),
  draw_terms(Window, X, Ya, Width, Node, Son, Arguments).
  
% draws all arguments of a functor
draw_terms(Window, Xa, Ya, Width, Node, Father, [Term|Termlist]):-
  (is_leaf(Term) -> Number is 1; arg(1, Term, Number)),
  NewWidth is Width*Number/Node,
  draw_term(Window, Xa, Ya, NewWidth, Father, Term),
  Xn is Xa + NewWidth,
  draw_terms(Window, Xn, Ya, Width, Node, Father, Termlist).
draw_terms(_, _, _, _, _, _, []).


% Doubleclick a node to redraw it's subtree
refresh(N):-
  terms(N, Width, Root, Term),
  get(Root, area, A), get(A, x, X), get(A, y, Y),
  get(A, height, H),
  calculate_rootposition(Term, Width, Position),
  Xa is X - Position,
  flag(ydistance, YDistance, YDistance),
  Ya is Y + YDistance + H/2,
  Term =.. [Functor, NodeInTerm|Arguments],
  (Functor = '.' -> NumberNodes is NodeInTerm; NumberNodes is NodeInTerm - 1),
  giveSons(Root, Sons),
  refresh_terms(Xa, Ya, Width, NumberNodes, Root, Arguments, Sons).

% refresh a leaf
refresh_term(X, Y, Width, Node, Term):-
  (atomic(Term); var(Term)), !,
  send(Node, center, point(X + Width/2, Y)).

% refresh an attributed structered term
refresh_term(X, Y, Width, Node, Term):-
  calculate_rootposition(Term, Width, X1),
  X2 is X + X1,
  send(Node, center, point(X2, Y)),
  flag(ydistance, YDistance, YDistance),
  Y2 is Y + YDistance,
  Term =.. [Functor, NodeInTerm|Arguments],
  (Functor = '.' -> NumberNodes is NodeInTerm; NumberNodes is NodeInTerm - 1),
  giveSons(Node, Sons),
  refresh_terms(X, Y2, Width, NumberNodes, Node, Arguments, Sons).

% refreshes all arguments of a functor
refresh_terms(Xa, Ya, Width, NumberNodes, Father, [Term|Termlist], [Son|Sons]):-
  (is_leaf(Term) -> Number is 1; arg(1, Term, Number)),
  NewWidth is Width*Number/NumberNodes,
  refresh_term(Xa, Ya, NewWidth, Son, Term),
  Xn is Xa + NewWidth,
  refresh_terms(Xn, Ya, Width, NumberNodes, Father, Termlist, Sons).
refresh_terms(_, _, _, _, _, [],_).

% calculate_rootposition(+Term, +Width, -Position)
calculate_rootposition(Term, Width, Position):-
  % Lists receive a special treatment
  functor(Term, '.', 3),
  arg(1, Term, TotalNumber),
  arg(2, Term, FirstElement),
  (is_leaf(FirstElement) ->
     Headnumber = 1; arg(1, FirstElement, Headnumber)),
  Position is Width * Headnumber / TotalNumber.
calculate_rootposition(_Term, Width, Position):-
  Position is Width/2.
  
% Provides a term with attributes so that
% every subtree has the number of nodes in it.


attribute(OneTerm, OneTerm):-
  is_leaf(OneTerm).

attribute(OneTerm, OutTerm):-
  OneTerm =.. [Functor|Arguments],
  attribute_liste(Arguments, AttrArguments),
  sum(AttrArguments, Sum),
  % '.' Node by lists are not considered
  (Functor = '.' ->
     Sum1 is Sum; Sum1 is Sum + 1),
  OutTerm =.. [Functor, Sum1|AttrArguments].
attribute_liste([K1|R1], [K2|R2]):-
  attribute(K1, K2),
  attribute_liste(R1, R2).
attribute_liste([], []).

% sums up the attribute values of the sons of an internal node
sum([K|R], Sum):-
  is_leaf(K),
  sum(R, Sum1),
  Sum is Sum1 + 1.
sum([K|R], Sum):-
  sum(R, Sum1),
  arg(1, K, Summand),
  Sum is Sum1 + Summand.
sum([], 0).

is_leaf(Node):-
  (atomic(Node); var(Node)).

% Delete root from the connections
edit_connections(Root, [H|T], T1):-
  get(H, to, To),
  Root == To, !,
  edit_connections(Root, T, T1).
edit_connections(Root, [H|T], [H1|T1]):-
  get(H, to, H1),
  edit_connections(Root, T, T1).
edit_connections(_, [], []).

giveSons(Root, Sons):-
  get(Root, connections, Conn),
  chain_list(Conn, Conn1),
  edit_connections(Root, Conn1, Sons).

% replace variables in term trough variablenames
replace(Term, [], Term).
replace(Term, _, Term):-
  atomic(Term), !.
replace(InTerm, Variables, OutTerm):-
  var(InTerm), !,
  member(OutTerm = Var, Variables),
  InTerm == Var.
replace(InTerm, Variables, OutTerm):-
  InTerm =.. [Functor|InArguments],
  replace_list(InArguments, Variables, OutArguments),
  OutTerm =.. [Functor|OutArguments].
replace_list([K1|R1], Variables, [K2|R2]):-
  replace(K1, Variables, K2),
  replace_list(R1, Variables, R2).
replace_list([], _, []).

:- pce_global(@in_out_link, make_in_out_link).

make_in_out_link(L) :-
  new(L, link(in, out, line(arrows:=none))).

connect(-1, _).
connect(Father, Son):-
  send(Son, handle, handle(w/2, 0, out)),
  send(Father, connect, Son, @in_out_link).

test:-
  draw_term(a(b,c(d+e,5*6),f(g+h(t)), i)).
  
  
