Revision: | 1.4 |
Committed: | Fri May 18 19:46:22 2007 UTC (17 years, 2 months ago) by root |
Branch: | MAIN |
CVS Tags: | rel-2_82, rel-2_81, rel-2_80, rel-2_6, rel-2_7, rel-2_4, rel-2_5, rel-2_2, rel-2_3, rel-2_1, rel-2_72, rel-2_73, rel-2_71, rel-2_76, rel-2_77, rel-2_74, rel-2_75, rel-2_54, rel-2_55, rel-2_56, rel-2_79, rel-2_52, rel-2_53, rel-2_32, rel-2_90, rel-2_92, rel-2_93, rel-2_78, rel-2_61, rel-2_43, rel-2_42, rel-2_41 |
Changes since 1.3: | +4 -1 lines |
Log Message: | new speed management: - weapon speed and object speed is now completekly decoupled for players. - both can be used at the same time, or indeepndent, when running or firing. - still only one command per object speed can be issued. |
# | Content |
---|---|
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::object->attach ( |
16 | type => cf::TRANSPORT, |
17 | on_apply => sub { |
18 | my ($tr, $ob) = @_; |
19 | |
20 | return unless $ob->type == cf::PLAYER; |
21 | |
22 | if ($ob->contr->attached ("transport_player_steer")) { |
23 | $ob->message ("You stop steering the " . $tr->name . "."); |
24 | $ob->contr->detach ("transport_player_steer"); |
25 | } else { |
26 | $ob->message ("You now steer the " . $tr->name . "."); |
27 | $ob->contr->attach ("transport_player_steer"); |
28 | } |
29 | |
30 | cf::override; |
31 | }, |
32 | ); |
33 | |
34 | cf::player::attachment transport_player_steer => |
35 | on_move => sub { |
36 | my ($pl, $dir) = @_; |
37 | |
38 | my $ob = $pl->ob; |
39 | |
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 | |
44 | my @ontop; |
45 | |
46 | for (my $tr = $tr; $tr; $tr = $tr->more) { |
47 | for (my $ob = $tr->above; $ob; $ob = $ob->above) { |
48 | push @ontop, $ob; |
49 | } |
50 | } |
51 | |
52 | if ($tr->move ($dir, $ob)) { |
53 | # do multiple loops in case some player/item blocks another |
54 | # do not endlessly loop as the server is far too broken, e.g. |
55 | # you can drop floors on top of non-floors etc. |
56 | for (1..50) { |
57 | @ontop or last; |
58 | @ontop = map $_->move ($dir, $_) ? () : $_, @ontop; |
59 | } |
60 | } |
61 | |
62 | cf::override 1; |
63 | } |
64 | }, |
65 | ; |
66 |