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.314 by root, Mon Jul 23 16:53:15 2007 UTC vs.
Revision 1.322 by root, Fri Jul 27 10:10:51 2007 UTC

… …
322 }; 322 };
323 $TICK_WATCHER->stop; 323 $TICK_WATCHER->stop;
324 $guard 324 $guard
325} 325}
326 326
327=item cf::get_slot $time[, $priority] 327=item cf::get_slot $time[, $priority[, $name]]
328 328
329Allocate $time seconds of blocking CPU time at priority C<$priority>: 329Allocate $time seconds of blocking CPU time at priority C<$priority>:
330This call blocks and returns only when you have at least C<$time> seconds 330This call blocks and returns only when you have at least C<$time> seconds
331of cpu time till the next tick. The slot is only valid till the next cede. 331of cpu time till the next tick. The slot is only valid till the next cede.
332
333The optional C<$name> can be used to identify the job to run. It might be
334used for statistical purposes and should identify the same time-class.
332 335
333Useful for short background jobs. 336Useful for short background jobs.
334 337
335=cut 338=cut
336 339
… …
363 Coro::schedule; 366 Coro::schedule;
364 } 367 }
365 } 368 }
366}; 369};
367 370
368sub get_slot($;$) { 371sub get_slot($;$$) {
369 my ($time, $pri) = @_; 372 my ($time, $pri, $name) = @_;
370 373
374 $time = $TICK * .6 if $time > $TICK * .6;
375 my $sig = new Coro::Signal;
376
371 push @SLOT_QUEUE, [$time, $pri, my $sig = new Coro::Signal]; 377 push @SLOT_QUEUE, [$time, $pri, $sig, $name];
372 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE; 378 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
373 $SLOT_QUEUE->ready; 379 $SLOT_QUEUE->ready;
374 $sig->wait; 380 $sig->wait;
375} 381}
376 382
… …
1175 my ($pl, $buf) = @_; 1181 my ($pl, $buf) = @_;
1176 1182
1177 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) }; 1183 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1178 1184
1179 if (ref $msg) { 1185 if (ref $msg) {
1186 my ($type, $reply, @payload) =
1187 "ARRAY" eq ref $msg
1188 ? @$msg
1189 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
1190
1180 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 1191 if (my $cb = $EXTCMD{$type}) {
1181 if (my %reply = $cb->($pl, $msg)) { 1192 my @reply = $cb->($pl, @payload);
1193
1182 $pl->ext_reply ($msg->{msgid}, %reply); 1194 $pl->ext_reply ($reply, @reply)
1183 } 1195 if $reply;
1184 } 1196 }
1185 } else { 1197 } else {
1186 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1198 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1187 } 1199 }
1188 1200
… …
1511sub hintmode { 1523sub hintmode {
1512 $_[0]{hintmode} = $_[1] if @_ > 1; 1524 $_[0]{hintmode} = $_[1] if @_ > 1;
1513 $_[0]{hintmode} 1525 $_[0]{hintmode}
1514} 1526}
1515 1527
1516=item $player->ext_reply ($msgid, %msg) 1528=item $player->ext_reply ($msgid, @msg)
1517 1529
1518Sends an ext reply to the player. 1530Sends an ext reply to the player.
1519 1531
1520=cut 1532=cut
1521 1533
1522sub ext_reply($$%) { 1534sub ext_reply($$@) {
1523 my ($self, $id, %msg) = @_; 1535 my ($self, $id, @msg) = @_;
1524 1536
1525 $msg{msgid} = $id; 1537 if ($self->ns->extcmd == 2) {
1538 $self->send ("ext " . $self->ns->{json_coder}->encode (["reply-$id", @msg]));
1539 } elsif ($self->ns->extcmd == 1) {
1540 #TODO: version 1, remove
1541 unshift @msg, msgtype => "reply", msgid => $id;
1526 $self->send ("ext " . $self->ns->{json_coder}->encode (\%msg)); 1542 $self->send ("ext " . $self->ns->{json_coder}->encode ({@msg}));
1543 }
1527} 1544}
1528 1545
1529=item $player->ext_event ($type, %msg) 1546=item $player->ext_msg ($type, @msg)
1530 1547
1531Sends an ext event to the client. 1548Sends an ext event to the client.
1532 1549
1533=cut 1550=cut
1534 1551
1535sub ext_event($$%) { 1552sub ext_msg($$@) {
1536 my ($self, $type, %msg) = @_; 1553 my ($self, $type, @msg) = @_;
1537 1554
1538 $self->ns->ext_event ($type, %msg); 1555 $self->ns->ext_msg ($type, @msg);
1539} 1556}
1540 1557
1541=head3 cf::region 1558=head3 cf::region
1542 1559
1543=over 4 1560=over 4
… …
2213 2230
2214 } else { 2231 } else {
2215 my $pl = $self->contr; 2232 my $pl = $self->contr;
2216 2233
2217 if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) { 2234 if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) {
2218 my $diag = $pl->{npc_dialog}; 2235 my $dialog = $pl->{npc_dialog};
2219 $diag->{pl}->ext_reply ( 2236 $dialog->{pl}->ext_msg ($dialog->{id}, update => msg => $dialog->{pl}->expand_cfpod ($msg));
2220 $diag->{id},
2221 msgtype => "reply",
2222 msg => $diag->{pl}->expand_cfpod ($msg),
2223 add_topics => []
2224 );
2225 2237
2226 } else { 2238 } else {
2227 $msg = $npc->name . " says: $msg" if $npc; 2239 $msg = $npc->name . " says: $msg" if $npc;
2228 $self->message ($msg, $flags); 2240 $self->message ($msg, $flags);
2229 } 2241 }
… …
2506 2518
2507 if (ref $channel) { 2519 if (ref $channel) {
2508 # send meta info to client, if not yet sent 2520 # send meta info to client, if not yet sent
2509 unless (exists $self->{channel}{$channel->{id}}) { 2521 unless (exists $self->{channel}{$channel->{id}}) {
2510 $self->{channel}{$channel->{id}} = $channel; 2522 $self->{channel}{$channel->{id}} = $channel;
2511 $self->ext_event (channel_info => %$channel); 2523 $self->ext_msg (channel_info => $channel);
2512 } 2524 }
2513 2525
2514 $channel = $channel->{id}; 2526 $channel = $channel->{id};
2515 } 2527 }
2516 2528
… …
2538 } 2550 }
2539 } 2551 }
2540 } 2552 }
2541} 2553}
2542 2554
2543=item $client->ext_event ($type, %msg) 2555=item $client->ext_msg ($type, @msg)
2544 2556
2545Sends an ext event to the client. 2557Sends an ext event to the client.
2546 2558
2547=cut 2559=cut
2548 2560
2549sub cf::client::ext_event($$%) { 2561sub cf::client::ext_msg($$@) {
2550 my ($self, $type, %msg) = @_; 2562 my ($self, $type, @msg) = @_;
2551 2563
2552 return unless $self->extcmd; 2564 my $extcmd = $self->extcmd;
2553 2565
2566 if ($extcmd == 2) {
2567 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
2568 } elsif ($extcmd == 1) { # TODO: remove
2554 $msg{msgtype} = "event_$type"; 2569 push @msg, msgtype => "event_$type";
2555 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg)); 2570 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2571 }
2556} 2572}
2557 2573
2558=item $success = $client->query ($flags, "text", \&cb) 2574=item $success = $client->query ($flags, "text", \&cb)
2559 2575
2560Queues a query to the client, calling the given callback with 2576Queues a query to the client, calling the given callback with
… …
2615 my ($ns, $buf) = @_; 2631 my ($ns, $buf) = @_;
2616 2632
2617 my $msg = eval { $ns->{json_coder}->decode ($buf) }; 2633 my $msg = eval { $ns->{json_coder}->decode ($buf) };
2618 2634
2619 if (ref $msg) { 2635 if (ref $msg) {
2636 my ($type, $reply, @payload) =
2637 "ARRAY" eq ref $msg
2638 ? @$msg
2639 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
2640
2620 if (my $cb = $EXTICMD{$msg->{msgtype}}) { 2641 if (my $cb = $EXTICMD{$type}) {
2621 if (my %reply = $cb->($ns, $msg)) { 2642 my @reply = $cb->($ns, @payload);
2622 $reply{msgid} = $msg->{msgid}; 2643
2623 $ns->send ("ext " . $ns->{json_coder}->encode (\%reply)); 2644 $ns->ext_reply ($reply, @reply)
2624 } 2645 if $reply;
2625 } 2646 }
2626 } else { 2647 } else {
2627 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 2648 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
2628 } 2649 }
2629 2650
… …
2844 # TODO: for gcfclient pleasure, we should give resources 2865 # TODO: for gcfclient pleasure, we should give resources
2845 # that gcfclient doesn't grok a >10000 face index. 2866 # that gcfclient doesn't grok a >10000 face index.
2846 my $res = $facedata->{resource}; 2867 my $res = $facedata->{resource};
2847 my $enc = JSON::XS->new->utf8->canonical; 2868 my $enc = JSON::XS->new->utf8->canonical;
2848 2869
2870 my $soundconf = delete $res->{"res/sound.conf"};
2871
2849 while (my ($name, $info) = each %$res) { 2872 while (my ($name, $info) = each %$res) {
2850 my $meta = $enc->encode ({ 2873 my $meta = $enc->encode ({
2851 name => $name, 2874 name => $name,
2852 type => $info->{type}, 2875 %{ $info->{meta} || {} },
2853 copyright => $info->{copyright}, #TODO#
2854 }); 2876 });
2855 2877
2856 my $idx = (cf::face::find $name) || cf::face::alloc $name; 2878 my $idx = (cf::face::find $name) || cf::face::alloc $name;
2857 2879
2858 if ($name =~ /\.jpg$/) { 2880 if ($info->{type} & 1) {
2859 cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};#d# temp hack 2881 # prepend meta info
2860 cf::face::set_data $idx, 1, $info->{data}, $info->{chksum};#d# temp hack 2882
2861 } else {
2862 my $data = pack "(w/a*)*", $meta, $info->{data}; 2883 my $data = pack "(w/a*)*", $meta, $info->{data};
2863 my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata 2884 my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
2864 2885
2865 cf::face::set_type $idx, 1;
2866 cf::face::set_data $idx, 0, $data, $chk; 2886 cf::face::set_data $idx, 0, $data, $chk;
2887 } else {
2888 cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};
2867 } 2889 }
2868 2890
2891 cf::face::set_type $idx, $info->{type};
2892
2869 cf::cede_to_tick; 2893 cf::cede_to_tick;
2870 } 2894 }
2895
2896 if ($soundconf) {
2897 $soundconf = $enc->decode (delete $soundconf->{data});
2898
2899 for (0 .. SOUND_CAST_SPELL_0 - 1) {
2900 my $sound = $soundconf->{compat}[$_]
2901 or next;
2902
2903 my $face = cf::face::find "sound/$sound->[1]";
2904
2905 cf::sound::set $sound->[0] => $face;
2906 cf::sound::old_sound_index $_, $face; # gcfclient-compat
2907 }
2908
2909 #TODO
2910 }
2871 } 2911 }
2872 2912
2873 1 2913 1
2874} 2914}
2915
2916register_exticmd fx_want => sub {
2917 my ($ns, $want) = @_;
2918
2919 while (my ($k, $v) = each %$want) {
2920 $ns->fx_want ($k, $v);
2921 }
2922};
2875 2923
2876sub reload_regions { 2924sub reload_regions {
2877 load_resource_file "$MAPDIR/regions" 2925 load_resource_file "$MAPDIR/regions"
2878 or die "unable to load regions file\n"; 2926 or die "unable to load regions file\n";
2879 2927

Diff Legend

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