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.265 by root, Fri May 11 08:00:00 2007 UTC vs.
Revision 1.268 by root, Tue May 22 10:50:00 2007 UTC

… …
356 Coro::cede or Event::one_event; 356 Coro::cede or Event::one_event;
357 } 357 }
358 358
359 $time = Event::time - $time; 359 $time = Event::time - $time;
360 360
361 LOG llevError | logBacktrace, "long sync job\n" 361 LOG llevError | logBacktrace, Carp::longmess "long sync job"
362 if $time > $TICK * 0.5; 362 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
363 363
364 $tick_start += $time; # do not account sync jobs to server load 364 $tick_start += $time; # do not account sync jobs to server load
365 365
366 wantarray ? @res : $res[0] 366 wantarray ? @res : $res[0]
367 } else { 367 } else {
… …
627 $registry = $CB_TYPE[$object_type] ||= []; 627 $registry = $CB_TYPE[$object_type] ||= [];
628 628
629 } elsif ($type eq "subtype") { 629 } elsif ($type eq "subtype") {
630 defined $object_type or Carp::croak "subtype specified without type"; 630 defined $object_type or Carp::croak "subtype specified without type";
631 my $object_subtype = shift @arg; 631 my $object_subtype = shift @arg;
632 $registry = $CB_TYPE[$object_type + $object_subtype * NUM_SUBTYPES] ||= []; 632 $registry = $CB_TYPE[$object_type + $object_subtype * NUM_TYPES] ||= [];
633 633
634 } elsif ($type eq "package") { 634 } elsif ($type eq "package") {
635 my $pkg = shift @arg; 635 my $pkg = shift @arg;
636 636
637 while (my ($name, $id) = each %cb_id) { 637 while (my ($name, $id) = each %cb_id) {
… …
678 if (ref $_[0]) { 678 if (ref $_[0]) {
679 _object_attach @_; 679 _object_attach @_;
680 } else { 680 } else {
681 _attach shift->_attach_registry, @_; 681 _attach shift->_attach_registry, @_;
682 } 682 }
683 _recalc_want;
683}; 684};
684 685
685# all those should be optimised 686# all those should be optimised
686sub cf::attachable::detach { 687sub cf::attachable::detach {
687 my ($obj, $name) = @_; 688 my ($obj, $name) = @_;
… …
690 delete $obj->{_attachment}{$name}; 691 delete $obj->{_attachment}{$name};
691 reattach ($obj); 692 reattach ($obj);
692 } else { 693 } else {
693 Carp::croak "cannot, currently, detach class attachments"; 694 Carp::croak "cannot, currently, detach class attachments";
694 } 695 }
696 _recalc_want;
695}; 697};
696 698
697sub cf::attachable::attached { 699sub cf::attachable::attached {
698 my ($obj, $name) = @_; 700 my ($obj, $name) = @_;
699 701
… …
1973 })->prio (2); 1975 })->prio (2);
1974 } 1976 }
1975 }, 1977 },
1976); 1978);
1977 1979
1978=item $player_object->goto ($path, $x, $y) 1980=item $player_object->goto ($path, $x, $y[, $check->($map)])
1981
1982Moves the player to the given map-path and coordinates by first freezing
1983her, loading and preparing them map, calling the provided $check callback
1984that has to return the map if sucecssful, and then unfreezes the player on
1985the new (success) or old (failed) map position.
1979 1986
1980=cut 1987=cut
1981 1988
1982sub cf::object::player::goto { 1989sub cf::object::player::goto {
1983 my ($self, $path, $x, $y) = @_; 1990 my ($self, $path, $x, $y, $check) = @_;
1991
1992 #d# #TODO#
1993 if ($check && !ref $check) {
1994 warn Carp::longmess "goto called with non-ref check argument";#d#
1995 undef $check;
1996 }
1984 1997
1985 $self->enter_link; 1998 $self->enter_link;
1986 1999
1987 (async { 2000 (async {
1988 my $map = eval { 2001 my $map = eval {
1989 my $map = cf::map::find $path; 2002 my $map = cf::map::find $path;
2003
2004 if ($map) {
1990 $map = $map->customise_for ($self) if $map; 2005 $map = $map->customise_for ($self);
2006 $map = $check->($map) if $check && $map;
2007 } else {
2008 $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
2009 }
2010
1991 $map 2011 $map
2012 };
2013
2014 if ($@) {
2015 $self->message ("Something went wrong within the server, please report this incident!", cf::NDI_UNIQUE | cf::NDI_RED);
2016 LOG llevError | logBacktrace, Carp::longmess $@;
1992 } or 2017 }
1993 $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1994 2018
1995 $self->leave_link ($map, $x, $y); 2019 $self->leave_link ($map, $x, $y);
1996 })->prio (1); 2020 })->prio (1);
1997} 2021}
1998 2022
… …
2846 my $signal = new Coro::Signal; 2870 my $signal = new Coro::Signal;
2847 push @WAIT_FOR_TICK_BEGIN, $signal; 2871 push @WAIT_FOR_TICK_BEGIN, $signal;
2848 $signal->wait; 2872 $signal->wait;
2849} 2873}
2850 2874
2875 my $min = 1e6;#d#
2876 my $avg = 10;
2851$TICK_WATCHER = Event->timer ( 2877$TICK_WATCHER = Event->timer (
2852 reentrant => 0, 2878 reentrant => 0,
2853 parked => 1, 2879 parked => 1,
2854 prio => 0, 2880 prio => 0,
2855 at => $NEXT_TICK || $TICK, 2881 at => $NEXT_TICK || $TICK,
… …
2862 } 2888 }
2863 2889
2864 $NOW = $tick_start = Event::time; 2890 $NOW = $tick_start = Event::time;
2865 2891
2866 cf::server_tick; # one server iteration 2892 cf::server_tick; # one server iteration
2893
2894 0 && sync_job {#d#
2895 for(1..10) {
2896 my $t = Event::time;
2897 my $map = my $map = new_from_path cf::map "/tmp/x.map"
2898 or die;
2899
2900 $map->width (50);
2901 $map->height (50);
2902 $map->alloc;
2903 $map->_load_objects ("/tmp/x.map", 1);
2904 my $t = Event::time - $t;
2905
2906 #next unless $t < 0.0013;#d#
2907 if ($t < $min) {
2908 $min = $t;
2909 }
2910 $avg = $avg * 0.99 + $t * 0.01;
2911 }
2912 warn "XXXXXXXXXXXXXXXXXX min $min avg $avg\n";#d#
2913 exit 0;
2914 # 2007-05-22 02:33:04.569 min 0.00112509727478027 avg 0.0012259249572477
2915 };
2867 2916
2868 $RUNTIME += $TICK; 2917 $RUNTIME += $TICK;
2869 $NEXT_TICK += $TICK; 2918 $NEXT_TICK += $TICK;
2870 2919
2871 if ($NOW >= $NEXT_RUNTIME_WRITE) { 2920 if ($NOW >= $NEXT_RUNTIME_WRITE) {

Diff Legend

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