| Revision: | 1.4 |
| Committed: | Fri May 18 19:46:22 2007 UTC (17 years 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. |
| # | User | Rev | Content |
|---|---|---|---|
| 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 | root | 1.2 | cf::object->attach ( |
| 16 | type => cf::TRANSPORT, | ||
| 17 | root | 1.1 | 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 | root | 1.2 | ); |
| 33 | root | 1.1 | |
| 34 | root | 1.2 | cf::player::attachment transport_player_steer => |
| 35 | root | 1.1 | on_move => sub { |
| 36 | my ($pl, $dir) = @_; | ||
| 37 | |||
| 38 | my $ob = $pl->ob; | ||
| 39 | |||
| 40 | if (my $tr = find_transport $pl) { | ||
| 41 | root | 1.4 | return cf::override 0 unless $ob->speed_left >= 0; |
| 42 | $ob->speed_left ($ob->speed_left - 1); | ||
| 43 | |||
| 44 | root | 1.1 | 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 | root | 1.3 | # you can drop floors on top of non-floors etc. |
| 56 | root | 1.1 | for (1..50) { |
| 57 | @ontop or last; | ||
| 58 | @ontop = map $_->move ($dir, $_) ? () : $_, @ontop; | ||
| 59 | } | ||
| 60 | } | ||
| 61 | |||
| 62 | root | 1.4 | cf::override 1; |
| 63 | root | 1.1 | } |
| 64 | }, | ||
| 65 | ; | ||
| 66 |