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.300 by root, Tue Jul 10 06:44:29 2007 UTC vs.
Revision 1.312 by root, Sat Jul 21 18:01:26 2007 UTC

… …
29use Fcntl; 29use Fcntl;
30use YAML::Syck (); 30use YAML::Syck ();
31use IO::AIO 2.32 (); 31use IO::AIO 2.32 ();
32use Time::HiRes; 32use Time::HiRes;
33use Compress::LZF; 33use Compress::LZF;
34use Digest::MD5 ();
34 35
35# configure various modules to our taste 36# configure various modules to our taste
36# 37#
37$Storable::canonical = 1; # reduce rsync transfers 38$Storable::canonical = 1; # reduce rsync transfers
38Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 39Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
… …
165=item cf::wait_for_tick, cf::wait_for_tick_begin 166=item cf::wait_for_tick, cf::wait_for_tick_begin
166 167
167These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 168These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
168returns directly I<after> the tick processing (and consequently, can only wake one process 169returns directly I<after> the tick processing (and consequently, can only wake one process
169per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 170per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
171
172=item @cf::INVOKE_RESULTS
173
174This array contains the results of the last C<invoke ()> call. When
175C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
176that call.
170 177
171=back 178=back
172 179
173=cut 180=cut
174 181
… …
865 "; 872 ";
866 die if $@; 873 die if $@;
867} 874}
868 875
869our $override; 876our $override;
870our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals? 877our @INVOKE_RESULTS = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
871 878
872sub override { 879sub override {
873 $override = 1; 880 $override = 1;
874 @invoke_results = (); 881 @INVOKE_RESULTS = (@_);
875} 882}
876 883
877sub do_invoke { 884sub do_invoke {
878 my $event = shift; 885 my $event = shift;
879 my $callbacks = shift; 886 my $callbacks = shift;
880 887
881 @invoke_results = (); 888 @INVOKE_RESULTS = ();
882 889
883 local $override; 890 local $override;
884 891
885 for (@$callbacks) { 892 for (@$callbacks) {
886 eval { &{$_->[1]} }; 893 eval { &{$_->[1]} };
… …
903 910
904Generate an object-specific event with the given arguments. 911Generate an object-specific event with the given arguments.
905 912
906This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be 913This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
907removed in future versions), and there is no public API to access override 914removed in future versions), and there is no public API to access override
908results (if you must, access C<@cf::invoke_results> directly). 915results (if you must, access C<@cf::INVOKE_RESULTS> directly).
909 916
910=back 917=back
911 918
912=cut 919=cut
913 920
914############################################################################# 921#############################################################################
915# object support 922# object support
923#
924
925sub _can_merge {
926 my ($ob1, $ob2) = @_;
927
928 local $Storable::canonical = 1;
929 my $fob1 = Storable::freeze $ob1;
930 my $fob2 = Storable::freeze $ob2;
931
932 $fob1 eq $fob2
933}
916 934
917sub reattach { 935sub reattach {
918 # basically do the same as instantiate, without calling instantiate 936 # basically do the same as instantiate, without calling instantiate
919 my ($obj) = @_; 937 my ($obj) = @_;
920 938
… …
1435 s/\s+\n/\n/g; # ws line-ends 1453 s/\s+\n/\n/g; # ws line-ends
1436 s/\n\n+/\n/g; # double lines 1454 s/\n\n+/\n/g; # double lines
1437 s/^\n+//; # beginning lines 1455 s/^\n+//; # beginning lines
1438 s/\n+$//; # ending lines 1456 s/\n+$//; # ending lines
1439 1457
1440 warn $_;#d#
1441 $_ 1458 $_
1442} 1459}
1443 1460
1444sub hintmode { 1461sub hintmode {
1445 $_[0]{hintmode} = $_[1] if @_ > 1; 1462 $_[0]{hintmode} = $_[1] if @_ > 1;
… …
1489 my ($path) = @_; 1506 my ($path) = @_;
1490 1507
1491 my ($match, $specificity); 1508 my ($match, $specificity);
1492 1509
1493 for my $region (list) { 1510 for my $region (list) {
1494 if ($region->match && $path =~ $region->match) { 1511 if ($region->{match} && $path =~ $region->{match}) {
1495 ($match, $specificity) = ($region, $region->specificity) 1512 ($match, $specificity) = ($region, $region->specificity)
1496 if $region->specificity > $specificity; 1513 if $region->specificity > $specificity;
1497 } 1514 }
1498 } 1515 }
1499 1516
… …
1619 $self->init; # pass $1 etc. 1636 $self->init; # pass $1 etc.
1620 return $self; 1637 return $self;
1621 } 1638 }
1622 } 1639 }
1623 1640
1624 Carp::carp "unable to resolve path '$path' (base '$base')."; 1641 Carp::cluck "unable to resolve path '$path' (base '$base').";
1625 () 1642 ()
1626} 1643}
1627 1644
1628sub init { 1645sub init {
1629 my ($self) = @_; 1646 my ($self) = @_;
… …
1907 1924
1908 undef $MAP_PREFETCH{$path}; 1925 undef $MAP_PREFETCH{$path};
1909 $MAP_PREFETCHER ||= cf::async { 1926 $MAP_PREFETCHER ||= cf::async {
1910 while (%MAP_PREFETCH) { 1927 while (%MAP_PREFETCH) {
1911 for my $path (keys %MAP_PREFETCH) { 1928 for my $path (keys %MAP_PREFETCH) {
1912 my $map = find $path 1929 if (my $map = find $path) {
1913 or next;
1914 $map->load; 1930 $map->load;
1931 }
1915 1932
1916 delete $MAP_PREFETCH{$path}; 1933 delete $MAP_PREFETCH{$path};
1917 } 1934 }
1918 } 1935 }
1919 undef $MAP_PREFETCHER; 1936 undef $MAP_PREFETCHER;
… …
2256 2273
2257 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2274 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2258 $self->enter_map ($map, $x, $y); 2275 $self->enter_map ($map, $x, $y);
2259} 2276}
2260 2277
2261=item $player_object->goto ($path, $x, $y[, $check->($map)]) 2278=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2262 2279
2263Moves the player to the given map-path and coordinates by first freezing 2280Moves the player to the given map-path and coordinates by first freezing
2264her, loading and preparing them map, calling the provided $check callback 2281her, loading and preparing them map, calling the provided $check callback
2265that has to return the map if sucecssful, and then unfreezes the player on 2282that has to return the map if sucecssful, and then unfreezes the player on
2266the new (success) or old (failed) map position. 2283the new (success) or old (failed) map position. In either case, $done will
2284be called at the end of this process.
2267 2285
2268=cut 2286=cut
2269 2287
2270our $GOTOGEN; 2288our $GOTOGEN;
2271 2289
2272sub cf::object::player::goto { 2290sub cf::object::player::goto {
2273 my ($self, $path, $x, $y, $check) = @_; 2291 my ($self, $path, $x, $y, $check, $done) = @_;
2274 2292
2275 # do generation counting so two concurrent goto's will be executed in-order 2293 # do generation counting so two concurrent goto's will be executed in-order
2276 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2294 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2277 2295
2278 $self->enter_link; 2296 $self->enter_link;
… …
2298 2316
2299 if ($gen == $self->{_goto_generation}) { 2317 if ($gen == $self->{_goto_generation}) {
2300 delete $self->{_goto_generation}; 2318 delete $self->{_goto_generation};
2301 $self->leave_link ($map, $x, $y); 2319 $self->leave_link ($map, $x, $y);
2302 } 2320 }
2321
2322 $done->() if $done;
2303 })->prio (1); 2323 })->prio (1);
2304} 2324}
2305 2325
2306=item $player_object->enter_exit ($exit_object) 2326=item $player_object->enter_exit ($exit_object)
2307 2327
… …
2416 2436
2417 utf8::encode $text; 2437 utf8::encode $text;
2418 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2438 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2419} 2439}
2420 2440
2421=item $client->send_msg ($color, $type, $msg, [extra...]) 2441=item $client->send_msg ($channel, $msg, $color, [extra...])
2422 2442
2423Send a drawinfo or msg packet to the client, formatting the msg for the 2443Send a drawinfo or msg packet to the client, formatting the msg for the
2424client if neccessary. C<$type> should be a string identifying the type of 2444client if neccessary. C<$type> should be a string identifying the type of
2425the message, with C<log> being the default. If C<$color> is negative, suppress 2445the message, with C<log> being the default. If C<$color> is negative, suppress
2426the message unless the client supports the msg packet. 2446the message unless the client supports the msg packet.
2427 2447
2428=cut 2448=cut
2429 2449
2430sub cf::client::send_msg { 2450sub cf::client::send_msg {
2431 my ($self, $color, $type, $msg, @extra) = @_; 2451 my ($self, $channel, $msg, $color, @extra) = @_;
2432 2452
2433 $msg = $self->pl->expand_cfpod ($msg); 2453 $msg = $self->pl->expand_cfpod ($msg);
2434 2454
2435 return unless @extra || length $msg; 2455 return unless @extra || length $msg;
2436 2456
2457 $color &= ~cf::NDI_UNIQUE; # just in case...
2458
2459 if (ref $channel) {
2460 # send meta info to client, if not yet sent
2461 unless (exists $self->{channel}{$channel->{id}}) {
2462 $self->{channel}{$channel->{id}} = $channel;
2463 $self->ext_event (channel_info => %$channel);
2464 }
2465
2466 $channel = $channel->{id};
2467 }
2468
2437 if ($self->can_msg) { 2469 if ($self->can_msg) {
2438 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra])); 2470 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra]));
2439 } else { 2471 } else {
2440 # replace some tags by gcfclient-compatible ones 2472 # replace some tags by gcfclient-compatible ones
2441 for ($msg) { 2473 for ($msg) {
2442 1 while 2474 1 while
2443 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/ 2475 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
… …
2464 2496
2465=cut 2497=cut
2466 2498
2467sub cf::client::ext_event($$%) { 2499sub cf::client::ext_event($$%) {
2468 my ($self, $type, %msg) = @_; 2500 my ($self, $type, %msg) = @_;
2501
2502 return unless $self->extcmd;
2469 2503
2470 $msg{msgtype} = "event_$type"; 2504 $msg{msgtype} = "event_$type";
2471 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg)); 2505 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2472} 2506}
2473 2507
… …
2720 { 2754 {
2721 my $faces = $facedata->{faceinfo}; 2755 my $faces = $facedata->{faceinfo};
2722 2756
2723 while (my ($face, $info) = each %$faces) { 2757 while (my ($face, $info) = each %$faces) {
2724 my $idx = (cf::face::find $face) || cf::face::alloc $face; 2758 my $idx = (cf::face::find $face) || cf::face::alloc $face;
2725 cf::face::set $idx, $info->{visibility}, $info->{magicmap}; 2759 cf::face::set_visibility $idx, $info->{visibility};
2760 cf::face::set_magicmap $idx, $info->{magicmap};
2726 cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32}; 2761 cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2727 cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64}; 2762 cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2728 Coro::cede; 2763
2764 cf::cede_to_tick;
2729 } 2765 }
2730 2766
2731 while (my ($face, $info) = each %$faces) { 2767 while (my ($face, $info) = each %$faces) {
2732 next unless $info->{smooth}; 2768 next unless $info->{smooth};
2733 my $idx = cf::face::find $face 2769 my $idx = cf::face::find $face
2734 or next; 2770 or next;
2735 if (my $smooth = cf::face::find $info->{smooth}) { 2771 if (my $smooth = cf::face::find $info->{smooth}) {
2772 cf::face::set_smooth $idx, $smooth;
2736 cf::face::set_smooth $idx, $smooth, $info->{smoothlevel}; 2773 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2737 } else { 2774 } else {
2738 warn "smooth face '$info->{smooth}' not found for face '$face'"; 2775 warn "smooth face '$info->{smooth}' not found for face '$face'";
2739 } 2776 }
2740 Coro::cede; 2777
2778 cf::cede_to_tick;
2741 } 2779 }
2742 } 2780 }
2743 2781
2744 { 2782 {
2745 my $anims = $facedata->{animinfo}; 2783 my $anims = $facedata->{animinfo};
2746 2784
2747 while (my ($anim, $info) = each %$anims) { 2785 while (my ($anim, $info) = each %$anims) {
2748 cf::anim::set $anim, $info->{frames}, $info->{facings}; 2786 cf::anim::set $anim, $info->{frames}, $info->{facings};
2749 Coro::cede; 2787 cf::cede_to_tick;
2750 } 2788 }
2751 2789
2752 cf::anim::invalidate_all; # d'oh 2790 cf::anim::invalidate_all; # d'oh
2791 }
2792
2793 {
2794 # TODO: for gcfclient pleasure, we should give resources
2795 # that gcfclient doesn't grok a >10000 face index.
2796 my $res = $facedata->{resource};
2797 my $enc = JSON::XS->new->utf8->canonical;
2798
2799 while (my ($name, $info) = each %$res) {
2800 my $meta = $enc->encode ({
2801 name => $name,
2802 type => $info->{type},
2803 copyright => $info->{copyright}, #TODO#
2804 });
2805
2806 my $idx = (cf::face::find $name) || cf::face::alloc $name;
2807
2808 if ($name =~ /\.jpg$/) {
2809 cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};#d# temp hack
2810 cf::face::set_data $idx, 1, $info->{data}, $info->{chksum};#d# temp hack
2811 } else {
2812 my $data = pack "(w/a*)*", $meta, $info->{data};
2813 my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
2814
2815 cf::face::set_type $idx, 1;
2816 cf::face::set_data $idx, 0, $data, $chk;
2817 }
2818
2819 cf::cede_to_tick;
2820 }
2753 } 2821 }
2754 2822
2755 1 2823 1
2756} 2824}
2757 2825
2758sub reload_regions { 2826sub reload_regions {
2759 load_resource_file "$MAPDIR/regions" 2827 load_resource_file "$MAPDIR/regions"
2760 or die "unable to load regions file\n"; 2828 or die "unable to load regions file\n";
2829
2830 for (cf::region::list) {
2831 $_->{match} = qr/$_->{match}/
2832 if exists $_->{match};
2833 }
2761} 2834}
2762 2835
2763sub reload_facedata { 2836sub reload_facedata {
2764 load_facedata "$DATADIR/facedata" 2837 load_facedata "$DATADIR/facedata"
2765 or die "unable to load facedata\n"; 2838 or die "unable to load facedata\n";

Diff Legend

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