html/irc_chess.pl
1 #
2 #Irssi script to complement chess backend server
3 #
4 use Irssi;
5 use Irssi::Irc;
6 use IO::Socket;
7 use vars qw($VERSION %IRSSI);
8
9 $VERSION="0.1";
10 %IRSSI =
11 (
12 authors => "kodgehopper (kodgehopper\@netscape.net)",
13 contact => "kodgehopper\@netscape.net",
14 name => "IRC-Chess",
15 description => "Chess server for IRC. Allows for multiple 2-player games to be played simultaneously",
16 license => "GNU GPL",
17 url => "none as yet",
18 );
19
20 sub processColors
21 {
22 $_=$_[0];
23
24 #replace foreground/background colors
25 my @fgbg;
26 my $numFgBg=(@fgbg=/(<B\w+?><b\w+?>)/g);
27
28 for (my $j=0; $j < $numFgBg; $j++)
29 {
30 my $t=$fgbg[$j];
31 my ($background, $foreground)=($t=~/(<B\w+?>)(<b\w+?>)/);
32 my $orig=$background.$foreground;
33
34 $foreground=~s/<bBLACK>/\\cc1/g;
35 $foreground=~s/<bWHITE>/\\cc0/g;
36
37 $background=~s/<BBLUE>/,2/g;
38 $background=~s/<BYELLOW>/,7/g;
39
40 my $result=$foreground.$background;
41
42 s/$orig/$result/;
43
44 }
45
46 #replace background-only colors
47 s/<BBLUE>/\\cc0,2/g;
48 s/<BYELLOW>/\\cc0,7/g;
49
50 #replace rest of colors
51 s/<NORMAL>/\\co/g;
52
53 return $_;
54 }#processColors
55
56 #
57 #message formats:
58 #1. simple format:
59 #[username]Message
60 #
61 #2. complex format:
62 #[user1]msg1<:=:>[user2]msg2<:=:>commonMessage
63 #
64 sub processMsgFromServer
65 {
66 ($server, $msg, $nick)=@_;
67 $delimiter="<:=:>";
68 $_=$msg;
69
70 #determine the type of message from the number of delimiters
71 $numDelims=(@list=/$delimiter/g);
72
73 if ($numDelims==0)
74 {
75 #simple message
76 my ($username, $message)=/^\s*\[(.+?)\](.*?)$/;
77
78 $message=processColors($message);
79
80 #send message to player
81 $server->command("eval msg $nick $message");
82 }
83 else
84 {
85 #complex message
86 my ($user1, $msg1, $user2, $msg2, $commonMessage)=/^\s*\[(.+?)\](.*?)$delimiter\[(.+?)\](.*?)$delimiter(.*)$/s;
87
88 #split message into seperate lines
89 my @commonMessageList=split(/\n/, $commonMessage);
90
91 #send common message to both users
92 Irssi::print("Sending common message to both users");
93 my $numStrings;
94 my @list;
95
96 #print out blank lines since the string was split on newlines so
97 #now they're lost. an extra space == blank line
98 $server->command("eval msg $user1 \\co");
99 $server->command("eval msg $user2 \\co");
100
101 my $commonListSize=@commonMessageList;
102 for (my $j=0; $j<$commonListSize; $j++)
103 {
104 $commonMessageList[$j]=processColors($commonMessageList[$j]);
105
106 $server->command("eval msg $user1 $commonMessageList[$j]");
107 $server->command("eval msg $user2 $commonMessageList[$j]");
108 }
109 $server->command("eval msg $user1 \\co");
110 $server->command("eval msg $user2 \\co");
111
112 #send messages for each user
113 my @msg1List=split(/\n/, $msg1);
114 my $msg1ListSize=@msg1List;
115
116 for ($j=0; $j<$msg1ListSize; $j++)
117 {
118 $server->command("eval msg $user1 \\cb$msg1List[$j]\\co");
119 }
120
121 my @msg2List=split(/\n/, $msg2);
122 my $msg2ListSize=@msg2List;
123
124 for ($j=0; $j<$msg2ListSize; $j++)
125 {
126 $server->command("eval msg $user2 \\cb$msg2List[$j]\\co");
127 }
128 } #else
129 }#processOutput
130
131 #
132 #process a message received from the user.
133 #this will be something like "game start k"
134 #this will have to be changed to something like
135 #"game start k k1", where k1 is the user.
136 #if the format of the message is not correct,
137 #return INVALID. format checking is minimal.
138 #basically, if the first word is "game", then
139 #slap on the nickname and send it to the server.
140 #
141
142 sub processMsgFromClient
143 {
144 ($server, $msg, $nick)=@_;
145
146 #Irssi::print("msg from client:\n$msg\n");
147 $msg=lc($msg);
148
149 if ($msg=~/^game\b/)
150 {
151 $msg = $msg." $nick";
152 return $msg;
153 }
154 else
155 {
156 Irssi::print("sending: msg $nick Error: Invalid Message");
157 $server->command("msg $nick Error: Invalid Message");
158 return "INVALID";
159 }
160 }#processMsgFromClient
161
162 #
163 #private messages received from other users eg. if they want to
164 #register a new game
165 sub sig_processPvt
166 {
167 my($server, $msg, $nick, $address)=@_;
168
169 $msgToSend=processMsgFromClient($server, $msg, $nick);
170
171 if ($msgToSend !~ /^INVALID$/)
172 {
173 Irssi::print("Sending message now");
174 send(SOCKET,$msgToSend,0);
175 Irssi::print("Waiting for message from server\n");
176 recv(SOCKET,$buffer,32678,0); #read a max of 32k.
177 processMsgFromServer($server, $buffer, $nick);
178 }
179 }#sig_processPvt
180
181 #
182 #function to terminate game. it basically just closes
183 #the connection to the server
184 #
185 sub cmd_endGame
186 {
187 shutdown(SOCKET,2);
188 close(SOCKET);
189 Irssi::print("Game ended. Socket shut down");
190 $gameRunning=0;
191 }#cmd_endGame
192
193 BEGIN
194 {
195 $PORT=1234;
196
197 Irssi::print("connecting to server\n");
198 $tcpProtocolNumber = getprotobyname('tcp') || 6;
199
200 socket(SOCKET, PF_INET(), SOCK_STREAM(), $tcpProtocolNumber)
201 or die("socket: $!");
202
203 $internetPackedAddress = pack('S na4 x8', AF_INET(), $PORT, 127.0.0.1);
204 connect(SOCKET, $internetPackedAddress) or die("connect: $!");
205
206 Irssi::print("Game is now running");
207 $gameRunning=1;
208 }
209
210
211 Irssi::signal_add("message private","sig_processPvt");
212 Irssi::command_bind("end_game", "cmd_endGame");