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.602 by root, Sun Nov 11 18:21:21 2012 UTC vs.
Revision 1.612 by root, Wed Nov 21 12:47:09 2012 UTC

… …
573Allocate $time seconds of blocking CPU time at priority C<$priority> 573Allocate $time seconds of blocking CPU time at priority C<$priority>
574(default: 0): This call blocks and returns only when you have at least 574(default: 0): This call blocks and returns only when you have at least
575C<$time> seconds of cpu time till the next tick. The slot is only valid 575C<$time> seconds of cpu time till the next tick. The slot is only valid
576till the next cede. 576till the next cede.
577 577
578Background jobs should use a priority les than zero, interactive jobs 578Background jobs should use a priority less than zero, interactive jobs
579should use 100 or more. 579should use 100 or more.
580 580
581The optional C<$name> can be used to identify the job to run. It might be 581The optional C<$name> can be used to identify the job to run. It might be
582used for statistical purposes and should identify the same time-class. 582used for statistical purposes and should identify the same time-class.
583 583
… …
596 my $signal = new Coro::Signal; 596 my $signal = new Coro::Signal;
597 my $busy; 597 my $busy;
598 598
599 while () { 599 while () {
600 next_job: 600 next_job:
601
602 Coro::cede;
601 603
602 my $avail = cf::till_tick; 604 my $avail = cf::till_tick;
603 605
604 for (0 .. $#SLOT_QUEUE) { 606 for (0 .. $#SLOT_QUEUE) {
605 if ($SLOT_QUEUE[$_][0] <= $avail) { 607 if ($SLOT_QUEUE[$_][0] <= $avail) {
606 $busy = 0; 608 $busy = 0;
607 my $job = splice @SLOT_QUEUE, $_, 1, (); 609 my $job = splice @SLOT_QUEUE, $_, 1, ();
608 $job->[2]->send; 610 $job->[2]->send;
609 Coro::cede;
610 goto next_job; 611 goto next_job;
611 } else { 612 } else {
612 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY; 613 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
613 } 614 }
614 } 615 }
615 616
616 if (@SLOT_QUEUE) { 617 if (@SLOT_QUEUE) {
617 # we do not use wait_for_tick() as it returns immediately when tick is inactive 618 wait_for_tick;
618 $WAIT_FOR_TICK->wait;
619 } else { 619 } else {
620 $busy = 0; 620 $busy = 0;
621 Coro::schedule; 621 Coro::schedule;
622 } 622 }
623 } 623 }
… …
738 reset_signals; 738 reset_signals;
739} 739}
740 740
741sub fork_call(&@) { 741sub fork_call(&@) {
742 my ($cb, @args) = @_; 742 my ($cb, @args) = @_;
743
744 # we seemingly have to make a local copy of the whole thing,
745 # otherwise perl prematurely frees the stuff :/
746 # TODO: investigate and fix (likely this will be rather laborious)
747 743
748 my @res = Coro::Util::fork_eval { 744 my @res = Coro::Util::fork_eval {
749 cf::post_fork; 745 cf::post_fork;
750 &$cb 746 &$cb
751 } @args; 747 } @args;
… …
3046 3042
3047=head3 cf::client 3043=head3 cf::client
3048 3044
3049=over 4 3045=over 4
3050 3046
3051=item $client->send_drawinfo ($text, $flags)
3052
3053Sends a drawinfo packet to the client. Circumvents output buffering so
3054should not be used under normal circumstances.
3055
3056=cut
3057
3058sub cf::client::send_drawinfo {
3059 my ($self, $text, $flags) = @_;
3060
3061 utf8::encode $text;
3062 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
3063}
3064
3065=item $client->send_big_packet ($pkt) 3047=item $client->send_big_packet ($pkt)
3066 3048
3067Like C<send_packet>, but tries to compress large packets, and fragments 3049Like C<send_packet>, but tries to compress large packets, and fragments
3068them as required. 3050them as required.
3069 3051
… …
3087 $self->send_packet ($pkt); 3069 $self->send_packet ($pkt);
3088} 3070}
3089 3071
3090=item $client->send_msg ($channel, $msg, $color, [extra...]) 3072=item $client->send_msg ($channel, $msg, $color, [extra...])
3091 3073
3092Send a drawinfo or msg packet to the client, formatting the msg for the 3074Send a msg packet to the client, formatting the msg for the client if
3093client if neccessary. C<$type> should be a string identifying the type of 3075necessary. C<$type> should be a string identifying the type of the
3094the message, with C<log> being the default. If C<$color> is negative, suppress 3076message, with C<log> being the default. If C<$color> is negative, suppress
3095the message unless the client supports the msg packet. 3077the message unless the client supports the msg packet.
3096 3078
3097=cut 3079=cut
3098 3080
3099# non-persistent channels (usually the info channel) 3081# non-persistent channels (usually the info channel)
… …
3204 id => "death", 3186 id => "death",
3205 title => "Death", 3187 title => "Death",
3206 reply => undef, 3188 reply => undef,
3207 tooltip => "Reason for and more info about your most recent death", 3189 tooltip => "Reason for and more info about your most recent death",
3208 }, 3190 },
3191 "c/fatal" => {
3192 id => "fatal",
3193 title => "Fatal Error",
3194 reply => undef,
3195 tooltip => "Reason for the server disconnect",
3196 },
3209 "c/say" => $SAY_CHANNEL, 3197 "c/say" => $SAY_CHANNEL,
3210 "c/chat" => $CHAT_CHANNEL, 3198 "c/chat" => $CHAT_CHANNEL,
3211); 3199);
3212 3200
3213sub cf::client::send_msg { 3201sub cf::client::send_msg {
… …
3286 3274
3287 $self->send_packet ($self->{query_queue}[0][0]) 3275 $self->send_packet ($self->{query_queue}[0][0])
3288 if @{ $self->{query_queue} } == 1; 3276 if @{ $self->{query_queue} } == 1;
3289 3277
3290 1 3278 1
3279}
3280
3281=item $client->update_command_faces
3282
3283=cut
3284
3285our %COMMAND_FACE;
3286
3287sub cf::client::update_command_faces {
3288 my ($self) = @_;
3289
3290 my @faces = grep $_,
3291 $COMMAND_FACE{standard},
3292 $COMMAND_FACE{emote},
3293 $COMMAND_FACE{skill},
3294 $self->pl->ob->flag (cf::FLAG_WIZ) ? $COMMAND_FACE{dm} : (),
3295 ;
3296
3297 $self->send_face ($_)
3298 for @faces;
3299 $self->flush_fx;
3300
3301 $self->ext_msg (command_list => @faces);
3302}
3303
3304=item cf::client::set_command_face $type, $commands
3305
3306=cut
3307
3308sub cf::client::set_command_face {
3309 my ($type, $list) = @_;
3310
3311 my $idx = &cf::face::set ( #d# ugly forward reference
3312 "command_list/$type" => cf::FT_RSRC,
3313 JSON::XS->new->utf8->encode ([ sort @$list ])
3314 );
3315
3316 $COMMAND_FACE{$type} = $idx;
3291} 3317}
3292 3318
3293cf::client->attach ( 3319cf::client->attach (
3294 on_connect => sub { 3320 on_connect => sub {
3295 my ($ns) = @_; 3321 my ($ns) = @_;
… …
3536 my ($name, $type, $data) = @_; 3562 my ($name, $type, $data) = @_;
3537 3563
3538 my $idx = cf::face::find $name; 3564 my $idx = cf::face::find $name;
3539 3565
3540 if ($idx) { 3566 if ($idx) {
3541 delete $HASH{cf::face::get_chksum $idx}; 3567 delete $HASH{cf::face::get_csum $idx};
3542 } else { 3568 } else {
3543 $idx = cf::face::alloc $name; 3569 $idx = cf::face::alloc $name;
3544 } 3570 }
3545 3571
3546 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data; 3572 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data;
… …
3761 cf::face::set 3787 cf::face::set
3762 "res/spell_paths" => FT_RSRC, 3788 "res/spell_paths" => FT_RSRC,
3763 JSON::XS->new->utf8->canonical->encode ( 3789 JSON::XS->new->utf8->canonical->encode (
3764 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1] 3790 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
3765 ); 3791 );
3792
3793 # command completion
3794 my @commands;
3795
3796 for (0..cf::arch::skillvec_size - 1) {
3797 my $skill = cf::arch::skillvec $_;
3798 my $name = $skill->name;
3799 my $flags = cf::skill_flags $skill->subtype;
3800
3801 push @commands, "ready_skill $name" if $flags & (SF_COMBAT | SF_RANGED | SF_GRACE);
3802 push @commands, "use_skill $name" if $flags & (SF_USE | SF_AUTARK | SF_GRACE);
3803 }
3804
3805 cf::client::set_command_face skill => \@commands;
3766} 3806}
3767 3807
3768sub reload_treasures { 3808sub reload_treasures {
3769 load_resource_file "$DATADIR/treasures" 3809 load_resource_file "$DATADIR/treasures"
3770 or die "unable to load treasurelists\n"; 3810 or die "unable to load treasurelists\n";

Diff Legend

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