1:- module(irc_client_dispatch, [
    2	send_msg/2,
    3	send_msg/3,
    4	send_msg/4
    5]).    6
    7
    8:- use_module(irc_client_info).    9:- use_module(irc_client_operator).

Message dispatching

This is a switchboard for routing message types to the correct message templates. Once the message template and respective substitution list is unified with the type, the process is consummated by dispatching the message through the stream.

To be done
- Implement more message types */
   22%--------------------------------------------------------------------------------%
   23% Command Routing
   24%--------------------------------------------------------------------------------%
 send_msg(+Id, +Type) is semidet
Send a Type of message from connection Id.
   30send_msg(Me, Type) :-
   31	cmd(Type, Msg),
   32	get_irc_stream(Me, Stream),
   33	cmd_params(Type, 0),
   34	!, % green, no further matches
   35	write(Stream, Msg),
   36	flush_output(Stream).
   37
   38% This clause will deal with deal with message types that are possibly
   39% timer-independent
   40send_msg(Me, Type) :-
   41	cmd(Type, Msg),
   42	get_irc_stream(Me, Stream),
   43	connection(Me, Nick, Pass, Chans, HostName, ServerName, RealName),
   44	(	Type = pass,
   45		format(Stream, Msg, [Pass])
   46	;	Type = user,
   47		format(Stream, Msg, [Nick, HostName, ServerName, RealName])
   48	;	Type = nick,
   49		format(Stream, Msg, [Nick])
   50	;	Type = join,
   51		maplist(format(Stream, Msg), Chans)
   52	),
   53	flush_output(Stream).
 send_msg(+Id, +Type, +Param) is semidet
Send a Type of message with attention to some Param from connection Id.
   59send_msg(Me, Type, Param) :-
   60	cmd(Type, Msg),
   61	cmd_params(Type, 1), !, % green, no further matches
   62	get_irc_stream(Me, Stream),
   63	format(Stream, Msg, [Param]),
   64	flush_output(Stream).
 send_msg(+Id, +Type, +Str, +Target) is semidet
Send a Type of message with attention to Str directed at a Target from connection Id.
   71send_msg(Me, Type, Str, Target) :-
   72	cmd(Type, Msg),
   73	cmd_params(Type, 2),
   74	\+member(Type, [kick, invite]), !, % green, no further matches
   75	get_irc_stream(Me, Stream),
   76	format(Stream, Msg, [Target, Str]),
   77	flush_output(Stream).
   78
   79% Send a message of Type with respect to Chan, to the Target.
   80send_msg(Me, Type, Chan, Target) :-
   81	cmd(Type, Msg),
   82	get_irc_stream(Me, Stream),
   83	(	Type = kick,
   84		format(Stream, Msg, [Chan, Target])
   85	;	Type = invite,
   86		format(Stream, Msg, [Target, Chan])
   87	),
   88	!,
   89	flush_output(Stream).
   90
   91cmd_params(Type, N) :-
   92	cmd(Type, Template),
   93	split_string(Template, "~", "\r~n", [_|Params]),
   94	length(Params, N)