1/* Part of SWI-Prolog odf-sheet pack
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org/pack/list?p=odf-sheet
6
7 Copyright (c) 2012-2014, VU University of Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions are
12 met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in the
19 documentation and/or other materials provided with the distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
24 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32*/
33
34:- module(webui,
35 [ server/1, % ?Port
36 show/1, % +Data
37 show/2, % +Data, +Options
38 clear/0
39 ]).
40:- use_module(library(http/thread_httpd)). 41:- use_module(library(webconsole)). 42:- use_module(library(http/http_dispatch)). 43:- use_module(library(http/html_head)). 44:- use_module(library(http/html_write)). 45:- use_module(data). 46:- use_module(sheet). 47:- use_module(recognise). 48
49:- meta_predicate
50 show(:),
51 show(:, +).
60:- http_handler(root(.), home, []). 61:- http_handler(root('webui.css'), http_reply_file('webui.css', []), []). 62
63server(Port) :-
64 http_server(http_dispatch, [port(Port)]).
65
66
67home(_Request) :-
68 reply_html_page(title('Spreadsheet analyzer'),
69 [ \html_requires(root('webui.css')),
70 h1('Spreadsheet analyzer'),
71 \wc_error_area,
72 \wc_output_area([id(log)]),
73 \wc_form_area([id(form)])
74 ]).
75
76show(Data) :-
77 show(Data, []).
78
79show(M:Data, Options) :-
80 wc_html(log, \webshow(Data, M), Options).
81
82clear :-
83 wc_html(log, '', [clear(true)]).
84
85webshow(Data, M) -->
86 html(h4('Showing ~p'-[Data])),
87 web_portray(Data, M).
88
89web_portray(Var, _) -->
90 { var(Var) }, !,
91 html(p('Unbound variable')).
92web_portray(cell_range(Sheet, SX,SY, EX,EY), M) -->
93 { integer(SX), integer(SY), integer(EX), integer(EY) }, !,
94 html(table(class(spreadsheet),
95 [ tr([td([])|\column_headers(SX,EX)])
96 | \table_rows(Sheet, SX,SY, EX,EY, M)
97 ])).
98web_portray(cell(Sheet,X,Y), M) -->
99 web_portray(cell_range(Sheet, X,Y, X,Y), M).
100web_portray(table(_Id,_Type,_DS,_Headers,Union), M) -->
101 web_portray(Union, M).
102web_portray(sheet(Sheet), M) -->
103 { sheet_bb(M:Sheet, DS) }, !,
104 web_portray(DS, M).
105web_portray(List, M) -->
106 { is_list(List), !,
107 length(List, Len)
108 },
109 html(h2('List of ~D objects'-[Len])),
110 web_portray_list(List, M).
111web_portray(Block, M) -->
112 { atom(Block),
113 current_predicate(M:block/3),
114 M:block(Block, _Type, DS)
115 },
116 html(h2('Block ~p'-[Block])),
117 web_portray(DS, M).
118web_portray(_, _) -->
119 html(p('No rules to portray')).
120
121web_portray_list([], _) --> "".
122web_portray_list([H|T], M) -->
123 webshow(H, M), !,
124 web_portray_list(T, M).
130column_headers(SX,EX) -->
131 { SX =< EX,
132 column_name(SX, Name),
133 X2 is SX+1
134 },
135 html(th(class(colname), Name)),
136 column_headers(X2, EX).
137column_headers(_, _) --> [].
142table_rows(Sheet, SX,SY, EX,EY, M) -->
143 { SY =< EY, !,
144 Y2 is SY+1
145 },
146 html(tr([ th(class(rowname),SY)
147 | \table_row(Sheet, SY, SX, EX, M)
148 ])),
149 table_rows(Sheet, SX,Y2, EX,EY, M).
150table_rows(_, _,_, _,_, _) --> [].
151
152table_row(Sheet, Y, SX,EX, M) -->
153 { SX =< EX, !,
154 X2 is SX+1
155 },
156 table_cell(Sheet, SX,Y, M),
157 table_row(Sheet, Y, X2,EX, M).
158table_row(_, _, _,_, _) --> [].
162table_cell(Sheet, SX, SY, M) -->
163 { ( cell_type(Sheet, SX,SY, Type)
164 -> true
165 ; Type = empty
166 ),
167 findall(A, cell_class_attr(Sheet,SX,SY,Type,A, M), Classes),
168 ( Classes == []
169 -> Attrs = []
170 ; Attrs = [class(Classes)]
171 )
172 },
173 table_cell(Type, Sheet, SX, SY, Attrs, M).
174
175cell_class_attr(_, _, _, Type, Type, _).
176cell_class_attr(Sheet, X, Y, _, Class, M) :-
177 ( cell_property(M:Sheet, X, Y, objects(_ObjId1,_ObjId2))
178 -> Class = intables
179 ; cell_property(M:Sheet, X, Y, block(ObjId)),
180 ( M:object_property(ObjId, color(C))
181 -> color_class(C, Class)
182 ; Class = intable
183 )
184 ).
185cell_class_attr(Sheet, X, Y, _, derived, M) :-
186 cell_formula(M:Sheet, X, Y, _).
187
188color_class(1, c1).
189color_class(2, c2).
190color_class(3, c3).
191color_class(4, c4).
196table_cell(percentage, Sheet, SX, SY, Attrs, M) -->
197 { cell_value(M:Sheet, SX,SY, Value),
198 Val is Value*100
199 }, !,
200 html(td(Attrs, ['~3f%'-[Val]])).
201table_cell(float, Sheet, SX, SY, Attrs, M) -->
202 { cell_value(M:Sheet, SX,SY, Value),
203 number(Value),
204 ndigits(Value, 5, V2)
205 }, !,
206 html(td(Attrs, [V2])).
207table_cell(_, Sheet, SX, SY, Attrs, M) -->
208 { cell_value(M:Sheet, SX,SY, Value)
209 }, !,
210 ( { atomic(Value) }
211 -> html(td(Attrs, Value))
212 ; html(td(Attrs, '~q'-[Value]))
213 ).
214table_cell(_, _, _, _, Attrs, _) -->
215 html(td(Attrs, [])).
216
217ndigits(F0, _, F) :-
218 F0 =:= 0, !,
219 F = F0.
220ndigits(F0, N, F) :-
221 Times is 10**max(1,N-round(log10(abs(F0)))),
222 F is round(F0*Times)/Times
Show analysis results
This module shows analysis results in a web browser. The typical use case is to show a datasource (rectangular area) as an HTML table. */