| … | |
… | |
| 5 | |
5 | |
| 6 | # implement a 'follow' command |
6 | # implement a 'follow' command |
| 7 | # don't follow on damned ground |
7 | # don't follow on damned ground |
| 8 | |
8 | |
| 9 | our $MAX_QUEUE = 5; # the # of positions somebody else can lead |
9 | our $MAX_QUEUE = 5; # the # of positions somebody else can lead |
| 10 | our %follow; # $followername => [$follower, $target, [$queue]] |
10 | our %FOLLOW; # $followername => [$follower, $target, [$queue]] |
|
|
11 | our $FOLLOW_HANDLER; |
| 11 | |
12 | |
| 12 | sub unfollow($) { |
13 | sub unfollow($) { |
| 13 | my $name = shift; |
14 | my $name = shift; |
| 14 | |
15 | |
| 15 | if (my $f = delete $follow{$name}) { |
16 | if (my $f = delete $FOLLOW{$name}) { |
| 16 | my ($who, $target, undef) = @$f; |
17 | my ($who, $target, undef) = @$f; |
| 17 | $who->contr->detach ("follow_aborter"); |
18 | $who->contr->detach ("follow_aborter"); |
| 18 | $target->message ("$name no longer follows you."); |
19 | $target->message ("$name no longer follows you."); |
| 19 | $who->message ("You no longer follow " . $target->name . "."); |
20 | $who->message ("You no longer follow " . $target->name . "."); |
| 20 | } |
21 | } |
| … | |
… | |
| 29 | my ($pl, $dir) = @_; |
30 | my ($pl, $dir) = @_; |
| 30 | $pl->detach ("follow_aborter"); |
31 | $pl->detach ("follow_aborter"); |
| 31 | }, |
32 | }, |
| 32 | ; |
33 | ; |
| 33 | |
34 | |
| 34 | our $CORO = cf::async { |
35 | sub start_follow_handler { |
|
|
36 | $FOLLOW_HANDLER = cf::async_ext { |
| 35 | $Coro::current->{desc} = "follow handler"; |
37 | $Coro::current->{desc} = "follow handler"; |
| 36 | |
38 | |
| 37 | while () { |
39 | while () { |
| 38 | cf::wait_for_tick; |
40 | cf::wait_for_tick; |
| 39 | |
41 | |
| 40 | for (values %follow) { |
42 | for (values %FOLLOW) { |
| 41 | my ($who, $target, $queue) = @$_; |
43 | my ($who, $target, $queue) = @$_; |
| 42 | |
44 | |
| 43 | my ($map, $x, $y) = ($target->map, $target->x, $target->y); |
45 | my ($map, $x, $y) = ($target->map, $target->x, $target->y); |
| 44 | |
46 | |
| 45 | # add new position to queue, if any |
47 | # add new position to queue, if any |
| 46 | push @$queue, [$map, $x, $y] |
48 | push @$queue, [$map, $x, $y] |
| 47 | if $map != $queue->[-1][0] |
49 | if $map != $queue->[-1][0] |
| 48 | || $x != $queue->[-1][1] |
50 | || $x != $queue->[-1][1] |
| 49 | || $y != $queue->[-1][2]; |
51 | || $y != $queue->[-1][2]; |
| 50 | |
52 | |
| 51 | # try to move to oldest position |
53 | # try to move to oldest position |
| 52 | if (@$queue > $MAX_QUEUE) { |
54 | if (@$queue > $MAX_QUEUE) { |
| 53 | $who->message ($target->name . " is too far away - you can't follow anymore!"); |
55 | $who->message ($target->name . " is too far away - you can't follow anymore!"); |
| 54 | unfollow $target->name; |
56 | unfollow $target->name; |
| 55 | } else { |
57 | } else { |
| 56 | my ($map, $x, $y) = @{ $queue->[0] }; |
58 | my ($map, $x, $y) = @{ $queue->[0] }; |
| 57 | |
59 | |
| 58 | $map->load; |
60 | $map->load; |
| 59 | |
61 | |
| 60 | if ( |
62 | if ( |
| 61 | !$map->valid |
63 | !$map->valid |
| 62 | or $map->path !~ /^(\{link\}|\/)/ |
64 | or $map->path !~ /^(\{link\}|\/)/ |
| 63 | or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) || $_->type == cf::SHOP_FLOOR), |
65 | or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) || $_->type == cf::SHOP_FLOOR), |
| 64 | $map->at ($x, $y)) |
66 | $map->at ($x, $y) |
| 65 | ) { |
67 | ) { |
| 66 | $who->message ("You can't follow " . $target->name . " anymore!"); |
68 | $who->message ("You can't follow " . $target->name . " anymore!"); |
| 67 | unfollow $who->name; |
69 | unfollow $who->name; |
| 68 | } elsif (!$who->blocked ($map, $x, $y)) { |
70 | } elsif (!$who->blocked ($map, $x, $y)) { |
| 69 | shift @$queue; |
71 | shift @$queue; |
| 70 | $who->goto ($map, $x, $y); |
72 | $who->goto ($map, $x, $y); |
|
|
73 | } |
| 71 | } |
74 | } |
| 72 | } |
75 | } |
|
|
76 | |
|
|
77 | Coro::schedule unless keys %FOLLOW; |
| 73 | } |
78 | } |
|
|
79 | }; |
|
|
80 | } |
| 74 | |
81 | |
| 75 | Coro::schedule unless keys %follow; |
82 | start_follow_handler; |
| 76 | } |
|
|
| 77 | }; |
|
|
| 78 | |
83 | |
| 79 | cf::register_command follow => sub { |
84 | cf::register_command follow => sub { |
| 80 | my ($who, $args) = @_; |
85 | my ($who, $args) = @_; |
| 81 | |
86 | |
| 82 | my $name = $who->name; |
87 | my $name = $who->name; |
| … | |
… | |
| 89 | && abs ($other->x - $who->x) <= 1 |
94 | && abs ($other->x - $who->x) <= 1 |
| 90 | && abs ($other->y - $who->y) <= 1 |
95 | && abs ($other->y - $who->y) <= 1 |
| 91 | ) { |
96 | ) { |
| 92 | $who->message ("Following player '$args', to stop, type: 'follow"); |
97 | $who->message ("Following player '$args', to stop, type: 'follow"); |
| 93 | $other->message ("$name is now following your every step..."); |
98 | $other->message ("$name is now following your every step..."); |
| 94 | $follow{$name} = [ |
99 | $FOLLOW{$name} = [ |
| 95 | $who, |
100 | $who, |
| 96 | $other, |
101 | $other, |
| 97 | [[$other->map, $other->x, $other->y]], |
102 | [[$other->map, $other->x, $other->y]], |
| 98 | ]; |
103 | ]; |
| 99 | $who->contr->attach ("follow_aborter"); |
104 | $who->contr->attach ("follow_aborter"); |
| 100 | $CORO->ready; |
105 | $FOLLOW_HANDLER->ready; |
| 101 | } else { |
106 | } else { |
| 102 | $who->message ("You must stand directly beside '$args' to follow her/him"); |
107 | $who->message ("You must stand directly beside '$args' to follow her/him"); |
| 103 | delete $follow{$name}; |
108 | delete $FOLLOW{$name}; |
| 104 | } |
109 | } |
| 105 | } else { |
110 | } else { |
| 106 | $who->message ("Cannot follow '$args': no such player"); |
111 | $who->message ("Cannot follow '$args': no such player"); |
| 107 | delete $follow{$name}; |
112 | delete $FOLLOW{$name}; |
| 108 | } |
113 | } |
| 109 | } else { |
114 | } else { |
| 110 | $who->message ("follow mode off"); |
115 | $who->message ("follow mode off"); |
| 111 | delete $follow{$name}; |
116 | delete $FOLLOW{$name}; |
| 112 | } |
117 | } |
| 113 | }; |
118 | }; |
| 114 | |
119 | |
| 115 | sub unregister { |
120 | sub unregister { |
| 116 | my ($pl) = @_; |
121 | my ($pl) = @_; |
| 117 | |
122 | |
| 118 | my $name = $pl->ob->name; |
123 | my $name = $pl->ob->name; |
| 119 | |
124 | |
| 120 | unfollow $name; |
125 | unfollow $name; |
| 121 | |
126 | |
| 122 | while (my ($k, $v) = each %follow) { |
127 | while (my ($k, $v) = each %FOLLOW) { |
| 123 | unfollow $k |
128 | unfollow $k |
| 124 | if $v->[1]->name eq $name; |
129 | if $v->[1]->name eq $name; |
| 125 | } |
130 | } |
| 126 | } |
131 | } |
| 127 | |
132 | |
