… | |
… | |
1345 | |
1345 | |
1346 | push @paths, cf::map::normalise "~$pl/$_"; |
1346 | push @paths, cf::map::normalise "~$pl/$_"; |
1347 | } |
1347 | } |
1348 | |
1348 | |
1349 | \@paths |
1349 | \@paths |
|
|
1350 | } |
|
|
1351 | |
|
|
1352 | =item $protocol_xml = $player->expand_cfpod ($crossfire_pod) |
|
|
1353 | |
|
|
1354 | Expand crossfire pod fragments into protocol xml. |
|
|
1355 | |
|
|
1356 | =cut |
|
|
1357 | |
|
|
1358 | sub expand_cfpod { |
|
|
1359 | ((my $self), (local $_)) = @_; |
|
|
1360 | |
|
|
1361 | # escape & and < |
|
|
1362 | s/&/&/g; |
|
|
1363 | s/(?<![BIUGH])</</g; |
|
|
1364 | |
|
|
1365 | # this is buggy, it needs to properly take care of nested <'s |
|
|
1366 | |
|
|
1367 | 1 while |
|
|
1368 | # replace B<>, I<>, U<> etc. |
|
|
1369 | s/B<([^\>]*)>/<b>$1<\/b>/ |
|
|
1370 | || s/I<([^\>]*)>/<i>$1<\/i>/ |
|
|
1371 | || s/U<([^\>]*)>/<u>$1<\/u>/ |
|
|
1372 | # replace G<male|female> tags |
|
|
1373 | || s{G<([^>|]*)\|([^>]*)>}{ |
|
|
1374 | $self->gender ? $2 : $1 |
|
|
1375 | }ge |
|
|
1376 | # replace H<hint text> |
|
|
1377 | || s/H<([^\>]*)>/<fg name="lightblue">[$1]<\/fg>/g; |
|
|
1378 | |
|
|
1379 | # create single paragraphs (very hackish) |
|
|
1380 | s/(?<=\S)\n(?=\w)/ /g; |
|
|
1381 | |
|
|
1382 | $_ |
1350 | } |
1383 | } |
1351 | |
1384 | |
1352 | =item $player->ext_reply ($msgid, %msg) |
1385 | =item $player->ext_reply ($msgid, %msg) |
1353 | |
1386 | |
1354 | Sends an ext reply to the player. |
1387 | Sends an ext reply to the player. |
… | |
… | |
2052 | my $pl = $self->contr; |
2085 | my $pl = $self->contr; |
2053 | |
2086 | |
2054 | if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) { |
2087 | if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) { |
2055 | my $diag = $pl->{npc_dialog}; |
2088 | my $diag = $pl->{npc_dialog}; |
2056 | $diag->{pl}->ext_reply ( |
2089 | $diag->{pl}->ext_reply ( |
2057 | $diag->{id}, msgtype => "reply", msg => $msg, add_topics => [] |
2090 | $diag->{id}, |
|
|
2091 | msgtype => "reply", |
|
|
2092 | msg => $diag->{pl}->expand_cfpod ($msg), |
|
|
2093 | add_topics => [] |
2058 | ); |
2094 | ); |
2059 | |
2095 | |
2060 | } else { |
2096 | } else { |
2061 | $msg = $npc->name . " says: $msg" if $npc; |
2097 | $msg = $npc->name . " says: $msg" if $npc; |
2062 | $self->message ($msg, $flags); |
2098 | $self->message ($msg, $flags); |
… | |
… | |
2311 | sub cf::client::send_drawinfo { |
2347 | sub cf::client::send_drawinfo { |
2312 | my ($self, $text, $flags) = @_; |
2348 | my ($self, $text, $flags) = @_; |
2313 | |
2349 | |
2314 | utf8::encode $text; |
2350 | utf8::encode $text; |
2315 | $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); |
2351 | $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); |
|
|
2352 | } |
|
|
2353 | |
|
|
2354 | =item $client->send_msg ($color, $type, $msg, [extra...]) |
|
|
2355 | |
|
|
2356 | Send a drawinfo or msg packet to the client, formatting the msg for the |
|
|
2357 | client if neccessary. C<$type> should be a string identifying the type of |
|
|
2358 | the message, with C<log> being the default. If C<$color> is negative, suppress |
|
|
2359 | the message unless the client supports the msg packet. |
|
|
2360 | |
|
|
2361 | =cut |
|
|
2362 | |
|
|
2363 | sub cf::client::send_msg { |
|
|
2364 | my ($self, $color, $type, $msg, @extra) = @_; |
|
|
2365 | |
|
|
2366 | $msg = $self->pl->expand_cfpod ($msg); |
|
|
2367 | |
|
|
2368 | if ($self->can_msg) { |
|
|
2369 | $self->send_packet ("msg " . cf::to_json [$color, $type, $msg, @extra]); |
|
|
2370 | } else { |
|
|
2371 | # replace some tags by gcfclient-compatible ones |
|
|
2372 | for ($msg) { |
|
|
2373 | 1 while |
|
|
2374 | s/<b>([^<]*)<\/b>/[b]${1}[\/b]/ |
|
|
2375 | || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/ |
|
|
2376 | || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/ |
|
|
2377 | || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/ |
|
|
2378 | || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${1}[\/color]/; |
|
|
2379 | } |
|
|
2380 | |
|
|
2381 | if ($color >= 0) { |
|
|
2382 | if ($msg =~ /\[/) { |
|
|
2383 | $self->send_packet ("drawextinfo $color 4 0 $msg") |
|
|
2384 | } else { |
|
|
2385 | $self->send_packet ("drawinfo $color $msg") |
|
|
2386 | } |
|
|
2387 | } |
|
|
2388 | } |
2316 | } |
2389 | } |
2317 | |
2390 | |
2318 | =item $client->ext_event ($type, %msg) |
2391 | =item $client->ext_event ($type, %msg) |
2319 | |
2392 | |
2320 | Sends an exti event to the client. |
2393 | Sends an exti event to the client. |