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.32 by root, Tue Aug 15 18:07:25 2006 UTC vs.
Revision 1.34 by root, Thu Aug 24 13:13:49 2006 UTC

… …
385}; 385};
386 386
387############################################################################# 387#############################################################################
388# load/save perl data associated with player->ob objects 388# load/save perl data associated with player->ob objects
389 389
390sub all_objects(@) {
391 @_, map all_objects ($_->inv), @_
392}
393
390*on_player_load = sub { 394*on_player_load = sub {
391 my ($ob, $path) = @_; 395 my ($ob, $path) = @_;
392 396
393 for my $o ($ob, $ob->inv) { 397 for my $o (all_objects $ob) {
394 if (my $value = $o->get_ob_key_value ("_perl_data")) { 398 if (my $value = $o->get_ob_key_value ("_perl_data")) {
395 $o->set_ob_key_value ("_perl_data"); 399 $o->set_ob_key_value ("_perl_data");
396 400
397 %$o = %{ Storable::thaw pack "H*", $value }; 401 %$o = %{ Storable::thaw pack "H*", $value };
398 } 402 }
… …
401 405
402*on_player_save = sub { 406*on_player_save = sub {
403 my ($ob, $path) = @_; 407 my ($ob, $path) = @_;
404 408
405 $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_) 409 $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_)
406 for grep %$_, $ob, $ob->inv; 410 for grep %$_, all_objects $ob;
407}; 411};
408 412
409############################################################################# 413#############################################################################
410# core extensions - in perl 414# core extensions - in perl
411
412my $delta_timer = Event->timer (
413 parked => 1,
414 prio => Event::PRIO_HIGH,
415 cb => sub { Event::unloop (undef) },
416);
417
418sub sleep_delta($) {
419 $delta_timer->at (Event::time + $_[0]);
420 $delta_timer->start;
421 Event::loop;
422}
423 415
424=item cf::player::exists $login 416=item cf::player::exists $login
425 417
426Returns true when the given account exists. 418Returns true when the given account exists.
427 419
… …
523 no strict 'refs'; 515 no strict 'refs';
524 *{"ext::$fun"} = $safe_hole->wrap ($cb); 516 *{"ext::$fun"} = $safe_hole->wrap ($cb);
525} 517}
526 518
527############################################################################# 519#############################################################################
520# the server's main()
521
522sub run {
523 my $tick = MAX_TIME * 1e-6;
524 my $next = Event::time;
525 my $timer = Event->timer (at => $next, cb => sub {
526 cf::server_tick; # one server iteration
527
528 $next += $tick;
529 my $NOW = Event::time;
530
531 # if we are delayd by > 0.25 second, skip ticks
532 $next = $NOW if $NOW >= $next + .25;
533
534 $_[0]->w->at ($next);
535 $_[0]->w->start;
536 });
537
538 Event::loop;
539}
540
541#############################################################################
528# initialisation 542# initialisation
529 543
530register "<global>", __PACKAGE__; 544register "<global>", __PACKAGE__;
531 545
532unshift @INC, $LIBDIR; 546unshift @INC, $LIBDIR;

Diff Legend

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