1/* Author: Jan Wielemaker 2 E-mail: J.Wielemaker@cs.vu.nl 3 WWW: http://www.swi-prolog.org 4 Copyright (C): 2012, VU University Amsterdam 5 6 This program is free software; you can redistribute it and/or 7 modify it under the terms of the GNU General Public License 8 as published by the Free Software Foundation; either version 2 9 of the License, or (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public 17 License along with this library; if not, write to the Free 18 Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 19 MA 02110-1301 USA 20 21 As a special exception, if you link this library with other files, 22 compiled with a Free Software compiler, to produce an executable, this 23 library does not by itself cause the resulting executable to be covered 24 by the GNU General Public License. This exception does not however 25 invalidate any other reasons why the executable file might be covered by 26 the GNU General Public License. 27 28 This file was altered by Anne Ogborn to make the logicmoo mud 29 console. 30 31 Note -this was an experiment. Decided it wouldn't work well for our 32 uses, but wanted to leave the code around. 33 34*/ 35 36:- module(mudconsole, 37 [ mc_start/0, 38 mc_start/1, % +Options 39 40 mc_format/2, % +Format, +Args 41 mc_format/3, % +WCId, +Format, +Args 42 mc_format/4, % +WCId, +Format, +Args, +Options 43 mc_html/1, % :HTML 44 mc_html/2, % +WCId, :HTML 45 mc_html/3, % +WCId, :HTML, +Options 46 mc_ask/2, % -Bindings, +Question 47 mc_ask/4, % +InputId, -Bindings, +Question, +Options 48 49 mc_output_area//1, % +Options 50 mc_form_area//1, % +Options 51 mc_error_area//0 52 ]). 53 54/* * module * Use a browser as HTML console 55 56The library(mudconsole) allows for writing classical query/reply 57programs that use a web-browser for I/O. In the typical user scenarion, 58the application calls mc_start/0 to open a browser. Next, it calls one 59of mc_format/2,3,4 or mc_html/1,2 to send output to the browser and or 60calls mc_ask/2,4 to request data from the user. 61 62The home-page can be customized by defining a handler for =mc_home=. See 63mc_home/1 for the default page. 64 65Here is an example run: 66 67 == 68 ?- [library(mudconsole)]. 69 ?- mc_start. % opens browser 70 ?- mc_format('Hello ~w', [world]). 71 ?- mc_html(p(['Hello ', b(world)])). 72 ?- mc_ask([age(Age)], [p('How old are you'), input([name(age)])]). 73 Age = 24. % type 24 <enter> 74 == 75 76*/ 77 78:- use_module(library(http/thread_httpd)). 79:- use_module(library(http/http_dispatch)). 80:- use_module(library(http/http_path), []). 81:- use_module(library(http/http_server_files), []). 82:- use_module(library(http/http_parameters)). 83:- use_module(library(http/html_head)). 84:- use_module(swi(library/http/html_write)). 85:- use_module(library(option)). 86 87% :- style_check(-atom). 88 89:- multifile http:location/3. 90:- dynamic http:location/3. 91 92httplocation(mudconsole, root(mudconsole), []). 93 94:- multifile user:file_search_path/2. 95:- dynamic user:file_search_path/2. 96 97user:file_search_path(js, './http/web/js'). 98user:file_search_path(css, './http/web/css'). 99 100:- http_handler(mudconsole('mc_home'), mc_home, [priority(-10)]). 101:- http_handler(mudconsole('mc_message'), mc_message, []). 102:- http_handler(mudconsole('mc_reply'), mc_reply, []). 103 104:- html_resource(jquery, 105 [ virtual(true), 106 requires(js('jquery-1.7.1.js')) 107 ]). 108:- html_resource(js('jquery.form.js'), 109 [ requires(jquery) 110 ]). 111:- html_resource(js('mudconsole.js'), 112 [ requires(jquery), 113 requires(js('jquery.form.js')) 114 ]). 115:- html_resource(mudconsole, 116 [ virtual(true), 117 requires(js('mudconsole.js')) 118 ]). 119 120:- html_meta 121 mc_html(html), 122 mc_html(+, html), 123 mc_html(+, html, +). 124 125 126 /******************************* 127 * SIMPLE SERVER * 128 *******************************/ 129 130:- dynamic 131 mc_option/1. 132 133mc_option(Option, Default) :- 134 Option =.. [Name,Value], 135 GenOption =.. [Name,Gen], 136 ( mc_option(GenOption) 137 -> Value = Gen 138 ; Value = Default 139 ).
h1 header
The user can customize the output page by defining an HTTP
handler with the id mc_home (see http_handler/3). The
predicate mc_home/1 provides the simple default page.
157mc_start :- 158 mc_start([]). 159 160mc_start(Options) :- 161 retractall(mc_option(_)), 162 forall(member(Option, Options), assertz(mc_option(Option))), 163 mc_server(Port), 164 mc_browser(Port). 165 166mc_server(Port) :- 167 http_server_property(Port, goal(_)), !. 168mc_server(Port) :- 169 mc_option(port(Port), _), 170 http_server(http_dispatch, [port(Port)]). 171 172mc_browser(Port) :- 173 http_link_to_id(mc_home, [], Home), 174 fmt(atom(URL), 'http://localhost:~w~w', [Port, Home]), 175 www_open_url(URL).
181mc_home(Request) :- 182 mc_allowed(Request), 183 mc_option(title(Title), 'SWI-Prolog mudconsole'), 184 reply_html_page(title(Title), 185 [ \html_requires(css('mudconsole.css')), 186 h1(Title), 187 \mc_error_area, 188 \mc_output_area([]), 189 \mc_form_area([]) 190 ]). 191 192 193mc_allowed(Request) :- 194 memberchk(peer(Peer), Request), 195 debug(wc(authorise), 'Peer = ~q', [Peer]), 196 mc_option(allow(Allow), ip(127,0,0,_)), 197 Peer = Allow. 198 199 200 /******************************* 201 * LIBRARY * 202 *******************************/
div element. Multiple output areas can be
created, each with their own id. The default id is
mc_output.
210mc_output_area(Options) -->
211 { option(id(Id), Options, mc_output)
212 },
213 html_requires(mudconsole),
214 html([ div(id(Id), [])
215 ]).X-Timeout: true in the header.224mc_message(_Request) :- 225 ( thread_get_message(mc_queue, 226 message(QueueId, Message, Options), 227 [timeout(30)]) 228 -> reply_message(QueueId, Message, Options) 229 ; fmt('X-Timeout: true~n', []), 230 fmt('Content-type: text/plain~n~n'), 231 fmt('timeout~n') 232 ). 233 234reply_message(Id, fmt(Format, Args), Options) :- 235 fmt('X-Id: ~w~n', [Id]), 236 maplist(x_header, Options), 237 fmt('Content-type: text/plain\n\n'), 238 fmt(Format, Args). 239reply_message(Id, html(HTML), Options) :- 240 fmt('X-Id: ~w~n', [Id]), 241 maplist(x_header, Options), 242 fmt('Content-type: text/html\n\n'), 243 phrase(html(HTML), Tokens), 244 print_html(Tokens). 245 246x_header(clear(Bool)) :- 247 fmt('X-Clear: ~w~n', [Bool]).
?- mc_format('Hello ~w', [world]).
Options:
true, clear the output area before adding the new
content.269mc_format(Format, Args) :- 270 mc_format(mc_output, Format, Args). 271 272mc_format(WCId, Format, Args) :- 273 mc_format(WCId, Format, Args, []). 274 275mc_format(WCId, Format, Args, Options) :- 276 thread_send_message( 277 mc_queue, 278 message(WCId, fmt(Format, Args), Options)).
?- mc_write([p(['Hello ', b(world)])]).
Options:
true, clear the output area before adding the new
content.297mc_html(HTML) :- 298 mc_html(mc_output, HTML). 299 300mc_html(WCId, HTML) :- 301 mc_html(WCId, HTML, []). 302 303mc_html(WCId, HTML, Options) :- 304 thread_send_message( 305 mc_queue, 306 message(WCId, html(HTML), Options)). 307 308 309 /******************************* 310 * ERRORS * 311 *******************************/
ic_error.318mc_error_area --> 319 mc_output_area([id(mc_error)]). 320 321 322 /******************************* 323 * INPUT * 324 *******************************/
div holding a form with ID
mc_form. A form-area is used with mc_ask/3 and mc_ask/4.331mc_form_area(Options) --> 332 { option(id(Id), Options, mc_form), 333 http_link_to_id(mc_reply, [], HREF) 334 }, 335 html_requires(mudconsole), 336 form_script(Id), 337 html([ div(class(form), 338 [ form([id(Id), action(HREF)], []) 339 ]), 340 div(id(preview), []) 341 ]). 342 343form_script(Id) --> 344 html(script(type('text/javascript'), 345 \[ '$("#~w").ajaxForm({\n\c 346 target: "#preview",\n\c 347 success: function(respText, statusText, xhr, el) {\n\c 348 $("#~w").addClass("inactive");\n\c 349 $("#~w input").prop("disabled", true);\n\c 350 },\n\c 351 error: function(xhr, textStatus, errorThrown) {\n\c 352 $("#preview").empty();\n\c 353 $("#preview").addClass("error");\n\c 354 $("#preview").append(xhr.responseText);\n\c 355 }\n\c 356 });'-[Id, Id, Id] 357 ])).
form element. Each Name in the
Result list must be covered by an equally named input element in
the form.
?- mc_ask([ age(Age)
],
[ p('How old are you?'),
input([name(age)])
]).
Age = 24.
381:- dynamic 382 form_result/2. % Id, Result 383 384mc_ask(Result, Question) :- 385 mc_ask(mc_form, Result, Question, []). 386mc_ask(InputId, Result, Question, _Options) :- 387 Id is random(1<<63), 388 ( is_list(Question) 389 -> QuestionList = Question 390 ; QuestionList = [Question] 391 ), 392 asserta(form_result(Id, Result)), 393 mc_html(InputId, 394 [ input([type(hidden), name(id), value(Id)]) 395 | QuestionList 396 ], 397 [ clear(true) 398 ]), 399 thread_get_message(reply_queue, Id-Result).
406mc_reply(Request) :- 407 http_parameters(Request, 408 [ id(Id, [integer]) 409 ], 410 [ form_data(Form) 411 ]), 412 form_result(Id, Result), 413 bind_form(Result, Form), 414 thread_send_message(reply_queue, Id-Result), 415 fmt('Content-type: text/plain\n\n'), 416 fmt('Thank you\n'). 417 418bind_form([], _). 419bind_form([H|T], Form) :- 420 ( H =.. [Name,Value|Options] 421 -> memberchk(Name=Raw, Form), 422 http_convert_parameter(Options, Name, Raw, Value) 423 ; true 424 ), 425 bind_form(T, Form). 426 427 428 /******************************* 429 * RESOURCES * 430 *******************************/ 431 432:- initialization ( 433 catch(message_queue_create(mc_queue), 434 error(permission_error(_,_,_),_), 435 true), 436 catch(message_queue_create(reply_queue), 437 error(permission_error(_,_,_),_), 438 true) 439 ).