19
20:- dynamic(adv:wants_quit/4). 21:- dynamic(adv:console_info/7). 22:- dynamic(adv:console_tokens/2). 23
24:- use_module(library(socket)). 25
26adv_server(Port) :-
27 dbug(adv_server(Port)),
28 tcp_socket(ServerSocket),
29 tcp_setopt(ServerSocket, reuseaddr),
30 tcp_bind(ServerSocket, Port),
31 tcp_listen(ServerSocket, 5),
32 atom_concat('mu_', Port, Alias),
33 thread_create(adv_server_loop(Port, ServerSocket), _,
34 [ alias(Alias)
35 ]).
36
37peer_alias(Prefix,Peer, Host, Alias):-
38 (tcp_host_to_address(Host, Peer);Host=Peer),
39 format(string(S),'~w@~w_',[Host,Prefix]),
40 gensym(S,Alias),!.
41
42adv_server_loop(Prefix, ServerSocket) :-
43 tcp_accept(ServerSocket, Slave, Peer),
44 tcp_open_socket(Slave, InStream, OutStream),
45 46 set_stream(InStream, close_on_exec(true)),
47 set_stream(OutStream, close_on_exec(true)),
48 set_stream(InStream, close_on_abort(true)),
49 set_stream(OutStream, close_on_abort(true)),
50 peer_alias(Prefix, Peer, Host, Alias),
51 ignore(catch(thread_create(
52 adv_serve_client(InStream, OutStream, Host, Peer, Alias),
53 _,
54 [ alias(Alias)
55 ]),
56 error(permission_error(create, thread, Alias), _),
57 fail)),
58 !,
59 adv_server_loop(Prefix, ServerSocket).
60
61setup_IO_props(InStream, _OutStream):-
62 set_stream(InStream, tty(true)),
63 64 65 current_prolog_flag(encoding, Enc),
66 set_stream(user_input, encoding(Enc)),
67 68 set_stream(user_output, encoding(Enc)),
69 70 set_stream(user_input, newline(detect)),
71 set_stream(user_output, newline(dos)),
72 set_stream(user_input, eof_action(eof_code)),!.
73
74adv_serve_client(InStream, OutStream, Host, Peer, Alias) :-
75 !,
76 thread_self(Id),
77
78 set_prolog_IO(InStream, OutStream, OutStream),
79 set_stream(user_error, newline(dos)),
80
81 setup_IO_props(InStream, OutStream),
82
83 set_stream(user_input, close_on_exec(false)),
84 set_stream(user_input, close_on_abort(false)),
85 set_stream(user_output, close_on_exec(false)),
86 set_stream(user_output, close_on_abort(false)),
87
88 format(OutStream,
89 'Welcome to the SWI-Prolog Adventure Server!~n~q~n~n',
90 [adv_serve_client(Id,Alias,InStream,OutStream, Host, Peer)]), !,
91 call_cleanup(srv_catch(adventure_client_process(Id,Alias,InStream,OutStream, Host, Peer)),
92 adventure_client_cleanp(Id,Alias,InStream,OutStream)).
100
109
110srv_catch(Goal):- catch(once(call(call,Goal)),E,((notrace(dbug(error_srv_catch(E,Goal))),!,fail))).
111ignore_srv_catch(Goal):- ignore(srv_catch(Goal)).
112
113adventure_client_cleanp(Id,Alias,InStream,OutStream):-
114 srv_catch((adv:console_info(Id,Alias,InStream,OutStream, Host, Peer, Agent) ->
115 ((assertz(adv:agent_discon(Agent)),
116 dbug((adv:agent_discon(Agent))),
117 stream_property(Err,file_no(2)),
118 set_stream(Err,alias(Agent)),
119 dbug(adventure_client_cleanp_agent(Id,Alias,InStream,OutStream, Host, Peer, Agent)))) ;
120 dbug(failed_adventure_client_cleanp(Id,Alias,InStream,OutStream)))),
121 retractall(adv:console_info(Id,Alias,InStream,OutStream, Host, Peer, Agent)),
122 ignore_srv_catch(close(InStream)),
123 ignore_srv_catch(close(OutStream)),
124 ignore_srv_catch(thread_detach(Id)).
125
126
127:- dynamic(adv:peer_character/2). 128:- dynamic(adv:peer_agent/2). 129:- dynamic(adv:agent_character/2). 130:- dynamic(adv:agent_discon/1). 131
132guess_previous_agent_0(_, Peer, Agent):- adv:peer_agent(Peer, Agent),!.
133guess_previous_agent_0(Host, _, Agent):- adv:peer_agent(Host, Agent),!.
134
135guess_previous_agent(Host, Peer, Agent):- guess_previous_agent_0(Host, Peer, Agent),
136 \+ adv:console_info(_Id,_Alias,_InStream,_OutStream, _Host, _Peer, Agent).
137
138guess_previous_agent(_Host, _Peer, Agent):- gensym('telnet~',Agent).
139
140prompt_for_agent(Id,Alias,InStream,OutStream, Host, Peer, Agent,Name):-
141 guess_previous_agent(Host, Peer, Agent),
142 ignore(adv:agent_character(Agent,Name)),
143 ignore(adv:peer_character(Peer,Name)),
144 ignore(adv:peer_character(Host,Name)),
145 (var(Name) -> format(OutStream, 'Enter your name [or leave bank for "~w"]: ', [Agent]), read_line_to_string(InStream,Name) ; true),
146 asserta_if_new(adv:agent_character(Agent,Name)),
147 asserta_if_new(adv:peer_character(Peer,Name)),
148 asserta_if_new(adv:peer_character(Host,Name)),
149 asserta_if_new(adv:peer_agent(Peer,Agent)),
150 asserta_if_new(adv:peer_agent(Host,Agent)),
151 set_stream(user_output,alias(Agent)),
152 asserta(adv:console_info(Id,Alias,InStream,OutStream, Host, Peer, Agent)),
153 assertz(adv:agent_conn(Agent,Name,Alias,adventure_client_process(Id,Alias,InStream,OutStream, Host, Peer))),!.
154
155welcome_adv_tnet(OutStream):-
156 format(OutStream, '==============================================~n', []),
157 format(OutStream, 'Welcome to Marty\'s Prolog Adventure Prototype~n', []),
158 format(OutStream, '==============================================~n', []),
159 !.
160
161adventure_client_process(Id,Alias,InStream,OutStream, Host, Peer):-
162 prompt_for_agent(Id,Alias,InStream,OutStream, Host, Peer, Agent,_Name),
163 retractall(adv:wants_quit(_,Alias,_,_)),
164 retractall(adv:wants_quit(Id,_,_,_)),
165 retractall(adv:wants_quit(_,_,InStream,_)),
166 welcome_adv_tnet(OutStream),
167 redraw_prompt(Agent),
168 repeat,
169 srv_catch(adv_tlnet_readloop(Id,Alias)),
170 adv:wants_quit(Id,Alias,_InStream,_OutStream),!.
171
172
173tflush(OutStream):- ignore_srv_catch((flush_output(OutStream), ttyflush)).
174
175adv_tlnet_readloop(Id,Alias):- adv:wants_quit(Id,Alias,_InStream,_OutStream),!.
176
177adv_tlnet_readloop(Id,Alias):-
178 adv:console_info(Id,Alias,_InStream,_OutStream,__Host,_Peer, Agent),
179 adv:console_tokens(Agent, _Words),sleep(0.1),!.
180
181adv_tlnet_readloop(Id,Alias):-
182 srv_catch(adv:console_info(Id,Alias,InStream,OutStream, Host, Peer, Agent)),
183 tflush(OutStream),
184 185 current_input(In), 186 wait_for_input([In,InStream,user_input],Found,0.5),
187 Found\==[],
188 189 readtokens(user_input,[],Words),
190 dmust(adv_tlnet_words(Id,Alias,InStream,OutStream, Host, Peer, Agent, Words)).
191
192
193adv_tlnet_words(_Id,_Alias,_InStream,_OutStream, _Host, _Peer, _Agent, [prolog]):- !, prolog.
194adv_tlnet_words(_Id,_Alias,_InStream,_OutStream, _Host, _Peer, _Agent, ['You'|_]):- !, trace,prolog.
195
196adv_tlnet_words(Id,Alias,InStream,OutStream, Host, Peer, Agent, [quit]):-
197 nop(adv_tlnet_words(Id,Alias,InStream,OutStream, Host, Peer, Agent)),
198 asserta(adv:wants_quit(Id,Alias,InStream,OutStream)).
199
200adv_tlnet_words(Id,Alias,InStream,OutStream, Host, Peer, Agent, Words0):-
201 nop(adv_tlnet_words(Id,Alias,InStream,OutStream, Host, Peer, Agent, Words0)),
202 (Words0==[]->Words=[wait];Words=Words0),
203 nop((dbug('~NTelent: ~q~n', [adv:console_tokens(Agent, Words)]))),
204 assertz(adv:console_tokens(Agent, Words)),
205 nop((format(OutStream, '~NYou: ~q~n', [adv:console_tokens(Agent, Words)]))),
206 !