1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        jan@swi.psy.uva.nl
5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6    Copyright (c)  2000-2014, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(html_hierarchy,
36          [ html_hierarchy/6,           % +Root, :GenChild, :GenLabel
37            html_hierarchy_image/2,     % +Path, -Image
38            pageYOffset/2               % +Cookie, -Y
39          ]).
40:- use_module(library(pce)).
41:- use_module(library(http/html_write)).
42
43:- meta_predicate
44    html_hierarchy(+, :, :, +, -, +).
45
46html_hierarchy(Root, GenChild, GenLabel, Cookie) -->
47    { strip_module(GenChild, M1, T1),
48      strip_module(GenLabel, M2, T2)
49    },
50    script,
51    hierarchy(Root, M1:T1, M2:T2, Cookie, 0, []).
52
53hierarchy(Root, GenChild, GenLabel, Cookie, 0, _) -->
54    !,
55    { findall(Child, gen_child(GenChild, Root, Child), Subs)
56    },
57    html([ \gen_label(GenLabel, Root),
58           br([])
59         | \subclasses(Subs, GenChild, GenLabel, Cookie, 1, [])
60         ]).
61hierarchy(Root, GenChild, GenLabel, Cookie, Level, Lines) -->
62    { findall(Child, gen_child(GenChild, Root, Child), Subs),
63      (   Subs == []
64      ->  Pre = n
65      ;   (   expanded(Root, Cookie)
66          ->  Pre = m,
67              java_collapse(Root, ExpCol)
68          ;   Pre = p,
69              java_expand(Root, ExpCol)
70          )
71      ),
72      atomic_list_concat([Pre, Level|Lines], :, Place),
73      atomic_list_concat(['/images/hierarchy/', Place], ImgSrc),
74      SubLevel is Level + 1
75    },
76    (   {Pre==n}
77    ->  html([ img([ src(ImgSrc), alt(''), align(top) ], []),
78               \gen_label(GenLabel, Root),
79               br([])
80             ])
81    ;   {Pre==m}
82    ->  html([ a([href(ExpCol)],
83                 img([ src(ImgSrc),
84                       alt(''),
85                       align(top),
86                       border(0)
87                     ])),
88               \gen_label(GenLabel, Root),
89               br([])
90             | \subclasses(Subs, GenChild, GenLabel, Cookie, SubLevel, Lines)
91             ])
92    ;   html([ a([href(ExpCol)],
93                 img([ src(ImgSrc),
94                       alt(''),
95                       align(top),
96                       border(0)
97                     ])),
98               \gen_label(GenLabel, Root),
99               br([])
100             ])
101    ).
102
103
104script -->                              % tagged window.location.pathname
105    html(script(
106'function pageY()
107{ if ( navigator.appName == "Microsoft Internet Explorer" )
108    return document.body.scrollTop;
109  else
110    return window.pageYOffset;
111}
112
113function getCookie(name)
114{ var cookie = " " + document.cookie;
115  var search = " " + name + "=";
116  var setStr = null;
117  var offset = 0;
118  var end = 0;
119  if (cookie.length > 0)
120  { offset = cookie.indexOf(search);
121    if (offset != -1)
122    { offset += search.length;
123      end = cookie.indexOf(";", offset)
124      if (end == -1)
125      { end = cookie.length;
126      }
127      setStr = cookie.substring(offset, end);
128    }
129  }
130  return(setStr);
131}
132
133function setCookie(name, value)
134{ document.cookie = name + "=" + value;
135}
136
137function expand(name)
138{ var e = getCookie("expand");
139
140  if ( e )
141  { e += name + "&";
142  } else
143  { e = "&" + name + "&";
144  }
145
146  setCookie("expand", e);
147  setCookie("y", pageY());
148  window.location.reload();
149}
150
151function collapse(name)
152{ var e = getCookie("expand");
153
154  if ( e )
155  { var a = e.split("&");
156    var r = new String("&");
157
158    for(var i=0; i < a.length; i++)
159    { if ( a[i] != name && a[i] != "" )
160      { r += a[i] + "&";
161      }
162    }
163
164    setCookie("expand", r);
165  }
166
167  setCookie("y", pageY());
168  window.location.reload();
169}
170
171function expandall()
172{ setCookie("expand", "all");
173  setCookie("y", pageY());
174  window.location.reload();
175}
176')).
177
178
179%!  pageYOffset(+Cookie, -Y)
180%
181%   Return the current page Y-offset from the cookie.  This value may
182%   be used in the onLoad handler of the page-body.
183
184pageYOffset(Cookie, Y) :-
185    new(Re, regex('y=([0-9]+)')),
186    send(Re, search, Cookie),
187    get(Re, register_value, Cookie, 1, int, Y).
188pageYOffset(_, 0).
189
190
191:- dynamic
192    ccode/2.
193
194class_code(Class, Code) :-
195    ccode(Class, Code),
196    !.
197class_code(Class, Code) :-
198    flag(ccode, Code, Code+1),
199    assert(ccode(Class, Code)).
200
201
202expanded(_, Cookie) :-
203    send(regex('expand=all'), search, Cookie),
204    !.
205expanded(Class, Cookie) :-
206    class_code(Class, Code),
207    atomic_list_concat([&, Code, &], Pattern),
208    sub_atom(Cookie, _, _, _, Pattern),
209    !.
210
211java_expand(Class, Code) :-
212    class_code(Class, CCode),
213    sformat(Code, 'javascript:expand(\'~w\')', CCode).
214java_collapse(Class, Code) :-
215    class_code(Class, CCode),
216    sformat(Code, 'javascript:collapse(\'~w\')', CCode).
217
218
219subclasses([], _, _, _, _, _) -->
220    [].
221subclasses([H], GenChild, GenLabel, Cookie, Level, Lines) -->
222    !,
223    hierarchy(H, GenChild, GenLabel, Cookie, Level, Lines).
224subclasses([H|T], GenChild, GenLabel, Cookie, Level, Lines) -->
225    hierarchy(H, GenChild, GenLabel, Cookie, Level, [Level|Lines]),
226    subclasses(T, GenChild, GenLabel, Cookie, Level, Lines).
227
228
229                 /*******************************
230                 *          GENERATORS          *
231                 *******************************/
232
233gen_child(GenChildren, Root, Child) :-
234    call(GenChildren, Root, Child).
235
236gen_label(G, Class, A, B) :-
237    call(G, Class, A, B).
238
239
240                 /*******************************
241                 *            IMAGES            *
242                 *******************************/
243
244html_hierarchy_image(Path, Img) :-
245    atom_concat('/images/hierarchy/', IName, Path),
246    !,
247    term_to_atom(Type:X, IName),
248    (   X = N:VLines
249    ->  true
250    ;   N = X,
251        VLines = []
252    ),
253    Left is (N-1)*20 + 10,
254    H = 18,
255    H2 is H//2,
256    new(P, path(points := chain(point(Left, 0),
257                                point(Left, H2),
258                                point(N*20, H2)))),
259    new(Img, pixmap(@nil, width := N*20, height := H)),
260    vlines(VLines, Img, H),
261    send(Img, draw_in, P),
262    (   Type == m
263    ->  get(class(tree), class_variable, expanded_image, CV),
264        get(CV, value, ExpImg),
265        send(Img, draw_in, bitmap(ExpImg), point(Left-4, 5))
266    ;   Type == p
267    ->  get(class(tree), class_variable, collapsed_image, CV),
268        get(CV, value, ExpImg),
269        send(Img, draw_in, bitmap(ExpImg), point(Left-4, 5))
270    ;   true
271    ).
272
273vlines([], _, _) :- !.
274vlines(N:T, Img, H) :-
275    !,
276    X is (N-1)*20+10,
277    send(Img, draw_in, line(X, 0, X, H)),
278    vlines(T, Img, H).
279vlines(N, Img, H) :-
280    X is (N-1)*20+10,
281    send(Img, draw_in, line(X, 0, X, H)).
282
283level(A0-B, Level, [B|A]) :-
284    !,
285    level(A0, Level, A).
286level(B, B, []).
287
288
289
290
291
292
293