… | |
… | |
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. |
… | |
… | |
2045 | |
2078 | |
2046 | $flags = cf::NDI_BROWN | cf::NDI_UNIQUE unless @_ >= 4; |
2079 | $flags = cf::NDI_BROWN | cf::NDI_UNIQUE unless @_ >= 4; |
2047 | |
2080 | |
2048 | if ($self->{record_replies}) { |
2081 | if ($self->{record_replies}) { |
2049 | push @{ $self->{record_replies} }, [$npc, $msg, $flags]; |
2082 | push @{ $self->{record_replies} }, [$npc, $msg, $flags]; |
|
|
2083 | |
2050 | } else { |
2084 | } else { |
|
|
2085 | my $pl = $self->contr; |
|
|
2086 | |
|
|
2087 | if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) { |
|
|
2088 | my $diag = $pl->{npc_dialog}; |
|
|
2089 | $diag->{pl}->ext_reply ( |
|
|
2090 | $diag->{id}, |
|
|
2091 | msgtype => "reply", |
|
|
2092 | msg => $diag->{pl}->expand_cfpod ($msg), |
|
|
2093 | add_topics => [] |
|
|
2094 | ); |
|
|
2095 | |
|
|
2096 | } else { |
2051 | $msg = $npc->name . " says: $msg" if $npc; |
2097 | $msg = $npc->name . " says: $msg" if $npc; |
2052 | $self->message ($msg, $flags); |
2098 | $self->message ($msg, $flags); |
|
|
2099 | } |
2053 | } |
2100 | } |
2054 | } |
2101 | } |
2055 | |
2102 | |
2056 | =item $player_object->may ("access") |
2103 | =item $player_object->may ("access") |
2057 | |
2104 | |
… | |
… | |
2300 | sub cf::client::send_drawinfo { |
2347 | sub cf::client::send_drawinfo { |
2301 | my ($self, $text, $flags) = @_; |
2348 | my ($self, $text, $flags) = @_; |
2302 | |
2349 | |
2303 | utf8::encode $text; |
2350 | utf8::encode $text; |
2304 | $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]${2}[\/color]/; |
|
|
2379 | } |
|
|
2380 | |
|
|
2381 | if ($color >= 0) { |
|
|
2382 | if (0 && $msg =~ /\[/) { |
|
|
2383 | $self->send_packet ("drawextinfo $color 4 0 $msg") |
|
|
2384 | } else { |
|
|
2385 | s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g; |
|
|
2386 | $self->send_packet ("drawinfo $color $msg") |
|
|
2387 | } |
|
|
2388 | } |
|
|
2389 | } |
2305 | } |
2390 | } |
2306 | |
2391 | |
2307 | =item $client->ext_event ($type, %msg) |
2392 | =item $client->ext_event ($type, %msg) |
2308 | |
2393 | |
2309 | Sends an exti event to the client. |
2394 | Sends an exti event to the client. |