ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/transports.ext
Revision: 1.4
Committed: Fri Dec 15 19:11:47 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# 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::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 # do not endlessly loop as the server is far too broken, e.g.
51 # you can drop floor son top of non-floors etc.
52 for (1..50) {
53 @ontop or last;
54 @ontop = map $_->move ($dir, $_) ? () : $_, @ontop;
55 }
56 }
57
58 cf::override;
59 }
60 },
61 ;
62