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