| … | |
… | |
| 10 | $pl->detach ("transport_player_steer"); |
10 | $pl->detach ("transport_player_steer"); |
| 11 | () |
11 | () |
| 12 | } |
12 | } |
| 13 | } |
13 | } |
| 14 | |
14 | |
| 15 | cf::attach_to_type cf::TRANSPORT, 0, |
15 | cf::object->attach ( |
|
|
16 | type => cf::TRANSPORT, |
| 16 | on_apply => sub { |
17 | on_apply => sub { |
| 17 | my ($tr, $ob) = @_; |
18 | my ($tr, $ob) = @_; |
| 18 | |
19 | |
| 19 | return unless $ob->type == cf::PLAYER; |
20 | return unless $ob->type == cf::PLAYER; |
| 20 | |
21 | |
| 21 | if ($ob->contr->attached ("transport_player_steer")) { |
22 | if ($ob->contr->attached ("transport_player_steer")) { |
| 22 | $ob->message ("You stop steering the " . $tr->name . "."); |
23 | $ob->message ("You stop steering the " . $tr->name . ".", cf::NDI_ORANGE | cf::NDI_REPLY); |
| 23 | $ob->contr->detach ("transport_player_steer"); |
24 | $ob->contr->detach ("transport_player_steer"); |
| 24 | } else { |
25 | } else { |
| 25 | $ob->message ("You now steer the " . $tr->name . "."); |
26 | $ob->message ("You now steer the " . $tr->name . ".", cf::NDI_ORANGE | cf::NDI_REPLY); |
| 26 | $ob->contr->attach ("transport_player_steer"); |
27 | $ob->contr->attach ("transport_player_steer"); |
| 27 | } |
28 | } |
| 28 | |
29 | |
| 29 | cf::override; |
30 | cf::override; |
| 30 | }, |
31 | }, |
| 31 | ; |
32 | ); |
| 32 | |
33 | |
| 33 | cf::register_player_attachment transport_player_steer => |
34 | cf::player::attachment transport_player_steer => |
| 34 | on_move => sub { |
35 | on_move => sub { |
| 35 | my ($pl, $dir) = @_; |
36 | my ($pl, $dir) = @_; |
| 36 | |
37 | |
| 37 | my $ob = $pl->ob; |
38 | my $ob = $pl->ob; |
| 38 | |
39 | |
| 39 | if (my $tr = find_transport $pl) { |
40 | if (my $tr = find_transport $pl) { |
|
|
41 | return cf::override 0 unless $ob->speed_left >= 0; |
|
|
42 | $ob->speed_left ($ob->speed_left - 1); |
|
|
43 | |
| 40 | my @ontop; |
44 | my @ontop; |
| 41 | |
45 | |
| 42 | for (my $tr = $tr; $tr; $tr = $tr->more) { |
46 | for (my $tr = $tr; $tr; $tr = $tr->more) { |
| 43 | for (my $ob = $tr->above; $ob; $ob = $ob->above) { |
47 | for (my $ob = $tr->above; $ob; $ob = $ob->above) { |
| 44 | push @ontop, $ob; |
48 | push @ontop, $ob; |
| … | |
… | |
| 46 | } |
50 | } |
| 47 | |
51 | |
| 48 | if ($tr->move ($dir, $ob)) { |
52 | if ($tr->move ($dir, $ob)) { |
| 49 | # do multiple loops in case some player/item blocks another |
53 | # do multiple loops in case some player/item blocks another |
| 50 | # do not endlessly loop as the server is far too broken, e.g. |
54 | # do not endlessly loop as the server is far too broken, e.g. |
| 51 | # you can drop floor son top of non-floors etc. |
55 | # you can drop floors on top of non-floors etc. |
| 52 | for (1..50) { |
56 | for (1..50) { |
| 53 | @ontop or last; |
57 | @ontop or last; |
| 54 | @ontop = map $_->move ($dir, $_) ? () : $_, @ontop; |
58 | @ontop = map $_->move ($dir, $_) ? () : $_, @ontop; |
| 55 | } |
59 | } |
| 56 | } |
60 | } |
| 57 | |
61 | |
| 58 | cf::override; |
62 | cf::override 1; |
| 59 | } |
63 | } |
| 60 | }, |
64 | }, |
| 61 | ; |
65 | ; |
| 62 | |
66 | |
