1:- module(mudconsolestart, [http_mud_server/0,
    2			   http_mud_server/1]).    3/* * module * Launch the http interaction, the 'mudconsole'
    4
    5*/
    6:- use_module(logicmoo('mudconsole/mudconsole')).    7:- use_module(library(http/thread_httpd)).    8:- use_module(library(http/http_dispatch)).    9:- use_module(library(http/html_head)).   10:- use_module(swi(library/http/html_write)).   11:- use_module(library(http/html_head)).   12:- use_module(logicmoo(logicmoo_util/logicmoo_util_library)).   13:- use_module(weblog('html_form/autocomplete')).   14:- use_module(library(http/http_path), []).   15
   16% :- mc_start([title('Logicmoo MUD'), allow(_)]).
   17
   18:- html_resource('http://fonts.googleapis.com/css?family=Henny+Penny|Sniglet|Nova+Square', [mime_type(text/css)]).   19:- html_resource(webfonts,
   20		 [ virtual(true),
   21		   requires('http://fonts.googleapis.com/css?family=Henny+Penny|Sniglet|Nova+Square')
   22		 ]).   23
   24:- multifile http:location/3.   25:- dynamic   http:location/3.   26
   27http:location(css, root(css), []).
   28
   29http_mud_server :-
   30	debug(mudconsole, "&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&", []),
   31	debug(mudconsole, "&				       &", []),
   32	debug(mudconsole, "&   MUD CONSOLE (after web console) &", []),
   33	debug(mudconsole, "&				       &", []),
   34	debug(mudconsole, "&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&", []),
   35	http_mud_server([port(3020)]).
   36
   37http_mud_server(Options) :-
   38	http_server(http_dispatch, Options).
   39
   40:- http_handler(mudconsole(game), game_handler, []).   41
   42:- multifile
   43        body//2.   44
   45body(game, Body) -->
   46        html(body([ \html_requires(webfonts),
   47		    \html_requires('/css/mudconsole.css'),
   48		    div(id(top), h1('Logicmoo Game')),
   49                    div(id(content), Body)
   50                  ])).
   51
   52game_handler(_Request) :-
   53	reply_html_page(game,
   54			title('Logicmoo Game'),
   55			\game_page).
   56
   57game_page -->
   58	html([div(class(map_section), [
   59		   \id_div(map),
   60		   \id_div(inventory)
   61		  ]),
   62	    \id_div(output),
   63	    \id_div(error_area),
   64	    \input_area,
   65	    p(class(directions), 'Type into box above')
   66	]).
   67
   68id_div(ID) -->
   69	html([
   70	    div(id(ID), &(nbsp))
   71	]).
   72
   73input_area -->
   74	html([
   75	    div(id(input_area),
   76		input([type(text), id(inarea), value('Type here')]))
   77	])