#! perl # TODO: skip arena # TODO: check for player leaving # implement a 'follow' command # don't follow on damned ground our $MAX_QUEUE = 5; # the # of positions somebody else can lead our %FOLLOW; # $followername => [$follower, $target, [$queue]] our $FOLLOW_HANDLER; sub unfollow($) { my $name = shift; if (my $f = delete $FOLLOW{$name}) { my ($who, $target, undef) = @$f; $who->contr->detach ("follow_aborter"); $target->message ("$name no longer follows you."); $who->message ("You no longer follow " . $target->name . "."); } } cf::player::attachment follow_aborter => on_move => sub { my ($pl, $dir) = @_; unfollow $pl->ob->name; }, on_login => sub { my ($pl, $dir) = @_; $pl->detach ("follow_aborter"); }, ; sub start_follow_handler { $FOLLOW_HANDLER = cf::async_ext { $Coro::current->{desc} = "follow handler"; while () { cf::wait_for_tick; for (values %FOLLOW) { my ($who, $target, $queue) = @$_; $target->active or next; my ($map, $x, $y) = ($target->map, $target->x, $target->y); # add new position to queue, if any push @$queue, [$map, $x, $y] if !@$queue || $map != $queue->[-1][0] || $x != $queue->[-1][1] || $y != $queue->[-1][2]; # try to move to oldest position if (@$queue > $MAX_QUEUE) { $who->message ($target->name . " is too far away - you can't follow anymore!"); unfollow $who->name; } elsif (@$queue) { my ($map, $x, $y) = @{ $queue->[0] }; $map->load; if ( !$map->valid or $map->path !~ /^(\{link\}|\/)/ or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) || $_->type == cf::SHOP_FLOOR), $map->at ($x, $y) ) { $who->message ("You can't follow " . $target->name . " anymore!"); unfollow $who->name; } elsif (!$who->blocked ($map, $x, $y)) { shift @$queue; $who->goto ($map, $x, $y); } } } Coro::schedule unless keys %FOLLOW; } }; } start_follow_handler; cf::register_command follow => sub { my ($who, $args) = @_; my $name = $who->name; if ($args ne "" && $name ne $args) { if (my $other = cf::player::find_active $args) { $other = $other->ob; if ($other->map == $who->map && abs ($other->x - $who->x) <= 1 && abs ($other->y - $who->y) <= 1 ) { $who->message ("Following player '$args', to stop, type: 'follow"); $other->message ("$name is now following your every step..."); $FOLLOW{$name} = [ $who, $other, [[$other->map, $other->x, $other->y]], ]; $who->contr->attach ("follow_aborter"); $FOLLOW_HANDLER->ready; } else { $who->message ("You must stand directly beside '$args' to follow her/him"); delete $FOLLOW{$name}; } } else { $who->message ("Cannot follow '$args': no such player"); delete $FOLLOW{$name}; } } else { $who->message ("follow mode off"); delete $FOLLOW{$name}; } }; sub unregister { my ($pl) = @_; my $name = $pl->ob->name; unfollow $name; while (my ($k, $v) = each %FOLLOW) { unfollow $k if $v->[1]->name eq $name; } } cf::player->attach ( on_death => \&unregister, on_logout => \&unregister, );