1:-module(chatscript, [talk/4,
    2		      start_conversation/3,
    3		      set_chatscript_address/1]).

Connection to chatscript server

http://chatscript.sourceforge.net/

author
- Anne Ogborn
version
- 1.0.6 /
license
- mit
   12:- multifile license:license/3.   13
   14license:license(mit, lgpl,
   15                [ comment('MIT License'),
   16                  url('http://opensource.org/licenses/MIT')
   17                ]).
   18:- license(mit).   19
   20:- use_module(library(http/http_client)).   21:- use_module(library(http/http_open)).   22:- use_module(library(http/http_header)).   23
   24:- dynamic server_address/1.
 set_chatscript_address(+Address:term) is det
Set the address of the chatscript server
Arguments:
Address- a term of form domain:port
   32set_chatscript_address(Address) :-
   33	retractall(server_address(_)),
   34	asserta(server_address(Address)).
 talk(+User:atom, +Bot:atom, +Message:atom, -Reply:string) is semidet
Send a volley to the server. You must call start_conversation before calling this, for each user
Arguments:
User- User name
Bot- name of the bot. The default bot is ''
Message- user's input to the bot. No nl. Must not be the null string
Reply- bots response
   47talk(User, Bot, Message, Reply) :-
   48	Message \= '',
   49	talk_(User, Bot, Message, Reply).
   50
   51talk_(User, Bot, Message, Reply) :-
   52	format(string(S), '~w\x00~w\x00\~w\x00', [User, Bot, Message]),
   53	server_address(Address),
   54	setup_call_cleanup(
   55	    (	tcp_connect(Address, StreamPair, []),
   56		stream_pair(StreamPair, Read, Write)),
   57	    (	write(Write, S),
   58		flush_output(Write),
   59		read_stream_to_codes(Read, Codes1),
   60		delete(Codes1, 0, Codes2),  % they insert nuls
   61		delete(Codes2, 0xFF, Codes3),
   62		delete(Codes3, 0xFE, Codes4),
   63		string_codes(Reply, Codes4)),
   64	    close(StreamPair)).
 start_conversation(+User:atom, +Bot:atom, -Reply:string) is det
Call this for each user to initiate a conversation. This makes a set of user variables for the user and gets the initial response. ChatScript requires calling this prior to calling talk/4 with a new user.
Arguments:
User- Username
Bot- Bot name
Reply- The utterance the bot will start the conversation with
   78start_conversation(User, Bot, Reply) :-
   79	talk_(User, Bot, '', Reply)