ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.322 by root, Fri Jul 27 10:10:51 2007 UTC vs.
Revision 1.330 by elmex, Fri Aug 10 10:35:07 2007 UTC

… …
1370 $self->{deny_save} = 1; 1370 $self->{deny_save} = 1;
1371 1371
1372 $cf::PLAYER{$login} = $self; 1372 $cf::PLAYER{$login} = $self;
1373 1373
1374 $self 1374 $self
1375}
1376
1377=item $player->send_msg ($channel, $msg, $color, [extra...])
1378
1379=cut
1380
1381sub send_msg {
1382 my $ns = shift->ns
1383 or return;
1384 $ns->send_msg (@_);
1375} 1385}
1376 1386
1377=item $pl->quit_character 1387=item $pl->quit_character
1378 1388
1379Nukes the player without looking back. If logged in, the connection will 1389Nukes the player without looking back. If logged in, the connection will
… …
1921 $self->set_darkness_map; 1931 $self->set_darkness_map;
1922 Coro::cede; 1932 Coro::cede;
1923 $self->activate; 1933 $self->activate;
1924 } 1934 }
1925 1935
1936 $self->{last_save} = $cf::RUNTIME;
1937 $self->last_access ($cf::RUNTIME);
1938
1926 $self->in_memory (cf::MAP_IN_MEMORY); 1939 $self->in_memory (cf::MAP_IN_MEMORY);
1927 } 1940 }
1928 1941
1929 $self->post_load; 1942 $self->post_load;
1930} 1943}
… …
2240 $self->message ($msg, $flags); 2253 $self->message ($msg, $flags);
2241 } 2254 }
2242 } 2255 }
2243} 2256}
2244 2257
2258=item $object->send_msg ($channel, $msg, $color, [extra...])
2259
2260=cut
2261
2262sub cf::object::send_msg {
2263 my $pl = shift->contr
2264 or return;
2265 $pl->send_msg (@_);
2266}
2267
2245=item $player_object->may ("access") 2268=item $player_object->may ("access")
2246 2269
2247Returns wether the given player is authorized to access resource "access" 2270Returns wether the given player is authorized to access resource "access"
2248(e.g. "command_wizcast"). 2271(e.g. "command_wizcast").
2249 2272
… …
2512sub cf::client::send_msg { 2535sub cf::client::send_msg {
2513 my ($self, $channel, $msg, $color, @extra) = @_; 2536 my ($self, $channel, $msg, $color, @extra) = @_;
2514 2537
2515 $msg = $self->pl->expand_cfpod ($msg); 2538 $msg = $self->pl->expand_cfpod ($msg);
2516 2539
2517 $color &= ~cf::NDI_UNIQUE; # just in case... 2540 $color &= cf::NDI_CLIENT_MASK; # just in case...
2518 2541
2519 if (ref $channel) { 2542 if (ref $channel) {
2520 # send meta info to client, if not yet sent 2543 # send meta info to client, if not yet sent
2521 unless (exists $self->{channel}{$channel->{id}}) { 2544 unless (exists $self->{channel}{$channel->{id}}) {
2522 $self->{channel}{$channel->{id}} = $channel; 2545 $self->{channel}{$channel->{id}} = $channel;
… …
2527 } 2550 }
2528 2551
2529 return unless @extra || length $msg; 2552 return unless @extra || length $msg;
2530 2553
2531 if ($self->can_msg) { 2554 if ($self->can_msg) {
2555 # default colour, mask it out
2556 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
2557 if $color & cf::NDI_DEF;
2558
2532 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra])); 2559 $self->send_packet ("msg " . $self->{json_coder}->encode (
2560 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]));
2533 } else { 2561 } else {
2534 # replace some tags by gcfclient-compatible ones
2535 for ($msg) {
2536 1 while
2537 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2538 || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2539 || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2540 || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2541 || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2542 }
2543
2544 if ($color >= 0) { 2562 if ($color >= 0) {
2563 # replace some tags by gcfclient-compatible ones
2564 for ($msg) {
2565 1 while
2566 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2567 || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2568 || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2569 || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2570 || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2571 }
2572
2573 $color &= cf::NDI_COLOR_MASK;
2574
2575 utf8::encode $msg;
2576
2545 if (0 && $msg =~ /\[/) { 2577 if (0 && $msg =~ /\[/) {
2546 $self->send_packet ("drawextinfo $color 4 0 $msg") 2578 $self->send_packet ("drawextinfo $color 4 0 $msg")
2547 } else { 2579 } else {
2548 $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g; 2580 $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
2549 $self->send_packet ("drawinfo $color $msg") 2581 $self->send_packet ("drawinfo $color $msg")
… …
2698our $safe = new Safe "safe"; 2730our $safe = new Safe "safe";
2699our $safe_hole = new Safe::Hole; 2731our $safe_hole = new Safe::Hole;
2700 2732
2701$SIG{FPE} = 'IGNORE'; 2733$SIG{FPE} = 'IGNORE';
2702 2734
2703$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); 2735$safe->permit_only (Opcode::opset qw(
2736 :base_core :base_mem :base_orig :base_math
2737 grepstart grepwhile mapstart mapwhile
2738 sort time
2739));
2704 2740
2705# here we export the classes and methods available to script code 2741# here we export the classes and methods available to script code
2706 2742
2707=pod 2743=pod
2708 2744
2709The following functions and methods are available within a safe environment: 2745The following functions and methods are available within a safe environment:
2710 2746
2711 cf::object 2747 cf::object
2712 contr pay_amount pay_player map x y force_find force_add 2748 contr pay_amount pay_player map x y force_find force_add
2713 insert remove 2749 insert remove name archname title slaying race
2714 2750
2715 cf::object::player 2751 cf::object::player
2716 player 2752 player
2717 2753
2718 cf::player 2754 cf::player
… …
2723 2759
2724=cut 2760=cut
2725 2761
2726for ( 2762for (
2727 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 2763 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
2728 insert remove)], 2764 insert remove inv name archname title slaying race)],
2729 ["cf::object::player" => qw(player)], 2765 ["cf::object::player" => qw(player)],
2730 ["cf::player" => qw(peaceful)], 2766 ["cf::player" => qw(peaceful)],
2731 ["cf::map" => qw(trigger)], 2767 ["cf::map" => qw(trigger)],
2732) { 2768) {
2733 no strict 'refs'; 2769 no strict 'refs';
… …
2899 for (0 .. SOUND_CAST_SPELL_0 - 1) { 2935 for (0 .. SOUND_CAST_SPELL_0 - 1) {
2900 my $sound = $soundconf->{compat}[$_] 2936 my $sound = $soundconf->{compat}[$_]
2901 or next; 2937 or next;
2902 2938
2903 my $face = cf::face::find "sound/$sound->[1]"; 2939 my $face = cf::face::find "sound/$sound->[1]";
2904
2905 cf::sound::set $sound->[0] => $face; 2940 cf::sound::set $sound->[0] => $face;
2906 cf::sound::old_sound_index $_, $face; # gcfclient-compat 2941 cf::sound::old_sound_index $_, $face; # gcfclient-compat
2907 } 2942 }
2908 2943
2944 while (my ($k, $v) = each %{$soundconf->{event}}) {
2945 my $face = cf::face::find "sound/$v";
2946 cf::sound::set $k => $face;
2909 #TODO 2947 }
2910 } 2948 }
2911 } 2949 }
2912 2950
2913 1 2951 1
2914} 2952}

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines