1 |
root |
1.1 |
#!perl |
2 |
|
|
|
3 |
|
|
sub find_transport { |
4 |
|
|
my ($pl) = @_; |
5 |
|
|
|
6 |
|
|
my $ob = $pl->ob; |
7 |
|
|
|
8 |
|
|
(grep $_->type == cf::TRANSPORT, map $_->head, $ob->map->at ($ob->x, $ob->y))[0] |
9 |
|
|
or do { |
10 |
|
|
$pl->detach ("transport_player_steer"); |
11 |
|
|
() |
12 |
|
|
} |
13 |
|
|
} |
14 |
|
|
|
15 |
|
|
cf::attach_to_type cf::TRANSPORT, 0, |
16 |
|
|
on_apply => sub { |
17 |
|
|
my ($tr, $ob) = @_; |
18 |
|
|
|
19 |
|
|
return unless $ob->type == cf::PLAYER; |
20 |
|
|
|
21 |
|
|
if ($ob->contr->attached ("transport_player_steer")) { |
22 |
|
|
$ob->message ("You stop steering the " . $tr->name . "."); |
23 |
|
|
$ob->contr->detach ("transport_player_steer"); |
24 |
|
|
} else { |
25 |
|
|
$ob->message ("You now steer the " . $tr->name . "."); |
26 |
|
|
$ob->contr->attach ("transport_player_steer"); |
27 |
|
|
} |
28 |
|
|
|
29 |
|
|
cf::override; |
30 |
|
|
}, |
31 |
|
|
; |
32 |
|
|
|
33 |
|
|
cf::register_player_attachment transport_player_steer => |
34 |
|
|
on_move => sub { |
35 |
|
|
my ($pl, $dir) = @_; |
36 |
|
|
|
37 |
|
|
my $ob = $pl->ob; |
38 |
|
|
|
39 |
|
|
if (my $tr = find_transport $pl) { |
40 |
|
|
my @ontop; |
41 |
|
|
|
42 |
|
|
for (my $tr = $tr; $tr; $tr = $tr->more) { |
43 |
|
|
for (my $ob = $tr->above; $ob; $ob = $ob->above) { |
44 |
|
|
push @ontop, $ob; |
45 |
|
|
} |
46 |
|
|
} |
47 |
|
|
|
48 |
|
|
if ($tr->move ($dir, $ob)) { |
49 |
|
|
# do multiple loops in case some player/item blocks another |
50 |
|
|
while (@ontop) { |
51 |
|
|
@ontop = map $_->move ($dir, $_) ? () : $_, @ontop; |
52 |
|
|
} |
53 |
|
|
} |
54 |
|
|
|
55 |
|
|
cf::override; |
56 |
|
|
} |
57 |
|
|
}, |
58 |
|
|
; |
59 |
|
|
|