1:- module(user_page, []).    2/* * module * The web page the user interacts with
    3
    4*/
    5:- multifile(style/1).    6:- dynamic(style/1).    7
    8:- dynamic   user:file_search_path/2.    9:- multifile user:file_search_path/2.   10
   11:- use_module(library(http/thread_httpd)).   12:- use_module(library(http/http_dispatch)).   13:- use_module(library(http/http_path), []).   14:- use_module(library(http/http_server_files), []).   15:- use_module(library(http/http_parameters)).   16:- use_module(library(http/html_head)).   17:- use_module(swi(library/http/html_write)).   18:- use_module(library(option)).   19:- use_module(library(http/http_session)).   20:- use_module(library(http/http_wrapper)).   21:- if_file_exists(use_module(weblog(html_form/ajaxify))).   22
   23wire_in_weblog :-
   24  assertz(user:file_search_path(css, weblog('static/css'))),
   25  assertz(user:file_search_path(js, weblog('static/js'))),
   26  assertz(user:file_search_path(icons, weblog('static/icons'))).
   27
   28:- wire_in_weblog.   29
   30:- multifile http:location/3.   31:- dynamic   http:location/3.   32
   33% all URI locations to do with play are under some subtree.
   34% this means we can separate, for example, having apache forward via
   35% a rewrite rule only a subdomain to /mud and below.
   36%
   37http:location(mud, root(mud), []).
   38
   39:- multifile user:file_search_path/2.   40:- dynamic   user:file_search_path/2.   41
   42% these are static assets that belong to a specific MUD Game
   43user:file_search_path(js, O) :- expand_file_search_path(game('web/js'),O).
   44user:file_search_path(css, O):- expand_file_search_path(game('web/css'),O).
   45user:file_search_path(icons, O):- expand_file_search_path(game('web/icons'),O).
   46user:file_search_path(mud_code, O):- expand_file_search_path(game('web/prolog'),O).
   47
   48% Someday these will be set up per-MUD
   49% these are static assets that belong to a specific MUD Server
   50user:file_search_path(js, '../src_assets/web/js').
   51user:file_search_path(css, '../src_assets/web/css').
   52user:file_search_path(icons, '../src_assets/web/icons').
   53user:file_search_path(mud_code, '../src_assets/web/prolog').
   54
   55% These should remain. They are static assets served by the core
   56% server (eg. the javascript to make the page go, the fallback css, etc)
   57user:file_search_path(js, '../src_webui/http/web/js').
   58user:file_search_path(css, '../src_webui/http/web/css').
   59user:file_search_path(icons, '../src_webui/http/web/icons').
   60
   61
   62%
   63%  SECURITY - potential security hole.
   64%
   65:- if_file_exists(use_module(mud_code(mud_specific), [style/1])).   66:- if_file_exists(use_module(logicmoo(model/substance))).   67
   68% The game page where players spend most of their time
   69:- http_handler(mud(.), mud_page, [id(mud), priority(10)]).   70
   71:- html_resource(jquery,
   72		 [ virtual(true),
   73		   requires(js('jquery-1.7.1.js'))
   74		 ]).   75:- html_resource(js('jquery.form.js'),
   76		 [ requires(jquery)
   77		 ]).   78:- html_resource(js('mud.js'),
   79		 [ requires(jquery),
   80		   requires(js('jquery.form.js'))
   81		 ]).   82:- html_resource(mud,
   83		 [ virtual(true),
   84		   requires(js('mud.js'))
   85		 ]).   86
   87mud_page(_Request) :-
   88	actual_style(Style),
   89	reply_html_page(
   90	    Style,
   91	    [link([
   92		 rel('shortcut icon'),
   93		 type('image/x-icon'),
   94		 href('/icons/favicon.ico')])],
   95	    [
   96	     \map_section,
   97	     \description_section,
   98	     \stats_section,
   99	     \player_prompt,
  100	     \input_section
  101	    ]).
  102
  103actual_style(Style) :- style(name(Style)),!.
  104actual_style(logicmoo).
  105
  106:- multifile head/4, body/4.  107
  108% fallback style
  109head(logicmoo, Head) -->
  110	html(head([
  111		 title('LogicMOO'),
  112		 Head
  113	     ])).
  114body(logicmoo, Body) -->
  115	html(body([
  116		 h1('LogicMOO MUD'),
  117		 div(id(content), Body)
  118	     ])).
 map_section(?A:list, ?B:list) is det
generate the map
  123map_section -->
  124	{
  125	    \+ style(map),
  126	    !
  127        },
  128	[].
  129map_section -->
  130	{
  131	   http_current_player(P),
  132           substance(map_origin(OX, OY)),
  133           substance(map_size(X, Y))
  134        },
  135	html(div(id(map), table(\map_row(P, OX, OY, X, Y)))).
  136
  137map_row(_, _, _, 0, _) --> !, [].
  138map_row(_, _, _, _, 0) --> !, [].
  139map_row(P, OX, OY, X, Y) -->
  140	{
  141           NOY is OY + 1,
  142           NY is Y - 1
  143        },
  144	html(tr(\map_cell(P, OY, OX, 0, X))),
  145	map_row(P, OX, NOY, X , NY).
  146
  147map_cell(_, _, _, X, X) --> [].
  148map_cell(P, AbsY, OX, CurX, X) -->
  149	{
  150            CurX \= X,
  151	    NewX is CurX + 1,
  152            AbsX is OX + CurX,
  153            get_map_contents(P, AbsX, AbsY, Contents)
  154        },
  155	html(td(Contents)),
  156	map_cell(P, AbsY, OX, NewX, X).
  157
  158get_map_contents(P, AbsX, AbsY, Contents) :-
  159        substance(cell(P, AbsX, AbsY, SemanticContent)),
  160	det_style(map_display(SemanticContent, Contents)).
  161get_map_contents(_, _, _, Contents) :-
  162	det_style(map_display(blank, Contents)).
  163
  164det_style(map_display(Semantics, Contents)) :-
  165	style(map_display(Semantics, Contents)).
  166det_style(map_display(_, [div(class(blank), [&(nbsp)])])).
 http_current_player(-P:player) is det
binds to the current player always succeeds, will make a player if need be
  173http_current_player(P) :-
  174	http_open_session(_, [renew(false)]),
  175	http_player_from_session(P).
  176
  177http_player_from_session(P) :-
  178	http_session_data(player(P)), !.
  179http_player_from_session(P) :-
  180	http_current_request(Request),
  181	(   member(search(Opts), Request) ; Opts = []),
  182	substance(need_new_player(Opts, P)).
  183
  184description_section -->
  185	html(p('someday this will be the description')).
  186stats_section -->
  187	html(p('someday this will be the stats')).
  188player_prompt -->
  189	html(p('someday this will be the player prompt')).
  190input_section -->
  191	html(form([input([type(text), id(nl), name(nl)], [])])).
  192
  193:- listen(http_session(end(SessionID, _Peer)),
  194          byebye_player(SessionID)).  195
  196byebye_player(SessionID) :-
  197	http_current_session(SessionID, player(P)),
  198	substance(player_split(P))