#!perl

sub find_transport {
   my ($pl) = @_;

   my $ob = $pl->ob;

   (grep $_->type == cf::TRANSPORT, map $_->head, $ob->map->at ($ob->x, $ob->y))[0]
      or do {
         $pl->detach ("transport_player_steer");
         ()
      }
}

cf::attach_to_type cf::TRANSPORT, 0,
   on_apply => sub {
      my ($tr, $ob) = @_;

      return unless $ob->type == cf::PLAYER;

      if ($ob->contr->attached ("transport_player_steer")) {
         $ob->message ("You stop steering the " . $tr->name . ".");
         $ob->contr->detach ("transport_player_steer");
      } else {
         $ob->message ("You now steer the " . $tr->name . ".");
         $ob->contr->attach ("transport_player_steer");
      }

      cf::override;
   },
;

cf::register_player_attachment transport_player_steer =>
   on_move => sub {
      my ($pl, $dir) = @_;

      my $ob = $pl->ob;

      if (my $tr = find_transport $pl) {
         my @ontop;

         for (my $tr = $tr; $tr; $tr = $tr->more) {
           for (my $ob = $tr->above; $ob; $ob = $ob->above) {
             push @ontop, $ob;
           }
         }

         if ($tr->move ($dir, $ob)) {
            # do multiple loops in case some player/item blocks another
            # do not endlessly loop as the server is far too broken, e.g.
            # you can drop floor son top of non-floors etc.
            for (1..50) {
               @ontop or last;
               @ontop = map $_->move ($dir, $_) ? () : $_, @ontop;
            }
         }

         cf::override;
      }
   },
;