ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/transports.ext
Revision: 1.3
Committed: Sat Feb 3 21:41:06 2007 UTC (17 years, 3 months ago) by root
Branch: MAIN
CVS Tags: rel-2_0
Changes since 1.2: +1 -1 lines
Log Message:
re-enabled 50000x50000 worldmap

File Contents

# 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     my @ontop;
42    
43     for (my $tr = $tr; $tr; $tr = $tr->more) {
44     for (my $ob = $tr->above; $ob; $ob = $ob->above) {
45     push @ontop, $ob;
46     }
47     }
48    
49     if ($tr->move ($dir, $ob)) {
50     # do multiple loops in case some player/item blocks another
51     # do not endlessly loop as the server is far too broken, e.g.
52 root 1.3 # you can drop floors on top of non-floors etc.
53 root 1.1 for (1..50) {
54     @ontop or last;
55     @ontop = map $_->move ($dir, $_) ? () : $_, @ontop;
56     }
57     }
58    
59     cf::override;
60     }
61     },
62     ;
63