view release on metacpan or  search on metacpan

lib/Game/PlatformsOfPeril.pm  view on Meta::CPAN

# Game::PlatformsOfPeril - this is a terminal-based game, run the
# `pperil` command that should be installed with this module to begin
#
# some details for the unwary, or brave, regarding the code:
#
# this implementation uses arrays heavily so instead of a more typical
# Player object there is an array with various slots that are used for
# various purposes. these slots are indexed using constant subs, and
# there is some overlap of these slots for animates, items, and terrain.
# the @Animates array (where the player, monsters, and items reside) and
# $LMap (level map, which has every ROW and COL and then an array (LMC)
# for what is in that cell) is where most of the game data resides.
# there can be only one terrain (GROUND), one ITEM, and one animate
# (ANI) per level map cell; any new interactions will need to support
# this. there are also four graphs per level map; these graphs dictate
# what moves are possible for animates (double benefit of providing both
# legal next moves and for pathfinding across the map). gravity pulls
# things down at the beginning of a turn (bottom up), and the player
# always moves first in the turn (low id to high), see the game_loop.
# level maps are ASCII text, and only one thing can be present in a cell
# in the map (with FLOOR being assumed present below any item or
# animate). there are some complications around killing things off; dead
# things must not interact with anything, but may still be looped to
# after their death in the apply_gravity or game_loop UPDATE calls.
# hence the BLACK_SPOT

package Game::PlatformsOfPeril;

our $VERSION = '0.11';

use 5.24.0;
use warnings;
use File::Spec::Functions qw(catfile);
use List::PriorityQueue   ();
use List::Util            qw(first);
use List::UtilsBy 0.06    qw(nsort_by rev_nsort_by);
use Term::ReadKey         qw(GetTerminalSize ReadKey ReadMode);
use Time::HiRes           qw(sleep);
use POSIX                 qw(STDIN_FILENO TCIFLUSH tcflush);

# ANSI or XTerm control sequences
sub at              { "\e[" . $_[1] . ';' . $_[0] . 'H' }
sub at_col          { "\e[" . $_[0] . 'G' }
sub alt_screen ()   { "\e[?1049h" }
sub clear_line ()   { "\e[2K" }
sub clear_right ()  { "\e[K" }
sub clear_screen () { "\e[1;1H\e[2J" }
sub hide_cursor ()  { "\e[?25l" }
sub hide_pointer () { "\e[>3p" }
sub show_cursor ()  { "\e[?25h" }
sub term_norm ()    { "\e[m" }
sub unalt_screen () { "\e[?1049l" }

# WHAT Animates and such can be
sub HERO ()   { 0 }
sub MONST ()  { 1 }
sub BOMB ()   { 2 }
sub GEM ()    { 3 }
sub FLOOR ()  { 4 }
sub WALL ()   { 5 }
sub LADDER () { 6 }
sub STAIR ()  { 7 }
sub STATUE () { 8 }

sub BOMB_COST () { 2 }
sub GEM_VALUE () { 1 }

# for the Level Map Cell (LMC)
sub WHERE ()  { 0 }
sub GROUND () { 1 }
sub ITEM ()   { 2 }
sub ANI ()    { 3 }

sub MOVE_FAILED () { 0 }
sub MOVE_OK ()     { 1 }
sub MOVE_NEWLVL () { 2 }

# for the level map
sub COLS ()         { 23 }
sub ROWS ()         { 23 }
sub MAP_DISP_OFF () { 1 }

# level map is row, col while points are [ col, row ]
sub PROW () { 1 }
sub PCOL () { 0 }

sub MSG_ROW () { 1 }
sub MSG_COL () { 25 }
# these also used to determine the minimum size for the terminal
sub MSG_MAX ()      { 24 }
sub MSG_COLS_MAX () { 70 }

# for Animates (and also some Things for the first few slots)
sub WHAT () { 0 }
sub DISP () { 1 }
# NOTE that GROUND use TYPE to distinguish between different types of
# those (FLOOR, STAIR, STATUE) which makes the graph code simpler as
# that only needs to look at WHAT for whether motion is possible in that
# cell; ANI and ITEM instead use TYPE to tell ANI apart from ITEM
sub TYPE ()       { 2 }
sub STASH ()      { 3 }
sub UPDATE ()     { 4 }
sub LMC ()        { 5 }
sub BLACK_SPOT () { 6 }

sub GEM_STASH ()  { 0 }
sub BOMB_STASH () { 1 }
sub GEM_ODDS ()   { 1 }

sub GEM_ODDS_ADJUST () { 0.05 }

sub START_GEMS ()  { 0 }
sub START_BOMBS () { 1 }

sub GRAPH_NODE ()   { 0 }
sub GRAPH_WEIGHT () { 1 }
sub GRAPH_POINT ()  { 2 }

our %CharMap = (
    'o' => BOMB,
    '.' => FLOOR,
    '*' => GEM,
    '@' => HERO,
    '=' => LADDER,
    'P' => MONST,
    '%' => STAIR,
    '&' => STATUE,
    '#' => WALL,
);

our (
    @Animates, %Explosions, @Graphs, $LMap,  $Monst_Name,
    @RedrawA,  @RedrawB,    $Hero,   $TCols, $TRows
);

our %Examine_Offsets = (
    'h' => [ -1, +0 ],    # left
    'j' => [ +0, +1 ],    # down
    'k' => [ +0, -1 ],    # up
    'l' => [ +1, +0 ],    # right
    'y' => [ -1, -1 ],
    'u' => [ +1, -1 ],
    'b' => [ -1, +1 ],
    'n' => [ +1, +1 ],
);

our $Level = 0;
our $Level_Path;

# plosive practice. these must pluralize properly
our @Menagerie = (
    'Palace Peacock',
    'Peckish Packrat',
    'Peevish Penguin',
    'Piratical Parakeet',
    'Placid Piranha',
    'Pleasant Porcupine',
    'Priggish Python',
    'Prurient Pachyderm',
    'Purposeful Plant',
    # and some not-plosives for reasons lost in the mists of time
    'Gruesome Goose',
    'Sinister Swan',
    'Xenophobic Xarci',
);
$Monst_Name = $Menagerie[ rand @Menagerie ];

our $Redraw_Delay = 0.05;
our $Rotate_Delay = 0.20;
our $Rotation     = 0;

our @Scientists = qw(Eigen Maxwell Newton);
our $Scientist  = $Scientists[ rand @Scientists ];

our $Seed;

our @Styles =
  qw(Abstract Art-Deco Brutalist Egyptian Greek Impressionist Post-Modern Roman Romantic);
our $Style = $Styles[ rand @Styles ];

our %Things = (
    BOMB,   [ BOMB,   "\e[31mo\e[0m",   ITEM ],
    FLOOR,  [ FLOOR,  "\e[33m.\e[0m",   FLOOR ],
    GEM,    [ GEM,    "\e[32m*\e[0m",   ITEM ],
    LADDER, [ LADDER, "\e[37m=\e[0m",   LADDER ],
    STAIR,  [ FLOOR,  "\e[37m%\e[0m",   STAIR ],
    STATUE, [ FLOOR,  "\e[1;33m&\e[0m", STATUE ],
    WALL,   [ WALL,   "\e[35m#\e[0m",   WALL ],
);

our %Descriptions = (
    BOMB,   'Bomb. Avoid.',
    FLOOR,  'Empty cell.',
    GEM,    'A gem. Get these.',
    HERO,   'The much suffering hero.',
    LADDER, 'A ladder.',
    MONST,  $Monst_Name . '. Wants to kill you.',
    STAIR,  'A way out of this mess.',
    STATUE, 'Empty cell with decorative statue.',
    WALL,   'A wall.',
);

$Animates[HERO]->@[ WHAT, DISP, TYPE, STASH, UPDATE ] = (
    HERO, "\e[1;33m\@\e[0m", ANI, [ START_GEMS, START_BOMBS ],
    \&update_hero
);

our %Interact_With = (
    HERO,    # the target of the mover
    sub {
        my ( $mover, $target ) = @_;
        game_over_monster() if $mover->[WHAT] == MONST;
        game_over_bomb()    if $mover->[WHAT] == BOMB;
        grab_gem( $target, $mover );
    },
    MONST,
    sub {
        my ( $mover, $target ) = @_;
        game_over_monster() if $mover->[WHAT] == HERO;
        if ( $mover->[WHAT] == BOMB ) {
            my @cells = map { kill_animate( $_, 1 ); $_->[LMC][WHERE] } $mover,
              $target;
            redraw_ref( \@cells );
            $Explosions{ join ',', $target->[LMC][WHERE]->@* } = $target;
        } elsif ( $mover->[WHAT] == GEM ) {
            grab_gem( $target, $mover );
        }
    },
    BOMB,
    sub {
        my ( $mover, $target ) = @_;
        game_over_bomb() if $mover->[WHAT] == HERO;
        if ( $mover->[WHAT] == MONST ) {
            my @cells = map { kill_animate( $_, 1 ); $_->[LMC][WHERE] } $mover,
              $target;
            redraw_ref( \@cells );
            $Explosions{ join ',', $target->[LMC][WHERE]->@* } = $target;
        }
    },
    GEM,
    sub {
        my ( $mover, $target ) = @_;
        if ( $mover->[TYPE] == ANI ) {
            relocate( $mover, $target->[LMC][WHERE] );
            grab_gem( $mover, $target );
        }
    },
);

our %Key_Commands = (
    'h' => move_player( -1, +0 ),    # left
    'j' => move_player( +0, +1 ),    # down
    'k' => move_player( +0, -1 ),    # up
    'l' => move_player( +1, +0 ),    # right
    '.' => \&move_nop,               # rest
    ' ' => \&move_nop,               # also rest
    'v' =>
      sub { post_message( 'Version ' . $VERSION ); return MOVE_FAILED },
    'x' => \&move_examine,
    '<' => sub {
        post_message( $Scientist . q{'s magic wonder left boot, activate!} );
        rotate_left();
        print draw_level();
        sleep($Rotate_Delay);
        return MOVE_OK;
    },
    '>' => sub {
        post_message( $Scientist . q{'s magic wonder right boot, activate!} );
        rotate_right();
        print draw_level();
        sleep($Rotate_Delay);
        return MOVE_OK;
    },
    '?' => sub {
        post_help();
        return MOVE_FAILED;
    },
    # for debugging, probably shouldn't be included as it shows exactly
    # where the monsters are trying to move to which may or may not be
    # where the player is
    'T' => sub {
        local $" = ',';
        post_message("T $Hero->@* R $Rotation");
        return MOVE_FAILED;
    },
    '@' => sub {
        local $" = ',';
        post_message("\@ $Animates[HERO][LMC][WHERE]->@* R $Rotation");
        return MOVE_FAILED;
    },
    '$' => sub {
        post_message( 'You have '
              . $Animates[HERO][STASH][BOMB_STASH]
              . ' bombs and '
              . $Animates[HERO][STASH][GEM_STASH]
              . ' gems.' );
        return MOVE_FAILED;
    },
    # by way of history '%' is what rogue (version 3.6) uses for stairs,
    # except the '>' (or very rarely '<') keys are used to interact with
    # that symbol
    '%' => sub {
        if ( $Animates[HERO][LMC][GROUND][TYPE] == STAIR ) {
            load_level();
            print clear_screen(), draw_level();
            post_message( 'Level '
                  . $Level
                  . ' (You have '
                  . $Animates[HERO][STASH][BOMB_STASH]
                  . ' bombs and '
                  . $Animates[HERO][STASH][GEM_STASH]
                  . ' gems.)' );
            return MOVE_NEWLVL;
        } else {
            post_message('There are no stairs here?');
            return MOVE_FAILED;
        }
    },
    'B' => sub {
        my $lmc = $Animates[HERO][LMC];
        return MOVE_FAILED, 'You have no bombs (make them from gems).'
          if $Animates[HERO][STASH][BOMB_STASH] < 1;
        return MOVE_FAILED, 'There is already an item in this cell.'
          if defined $lmc->[ITEM];
        $Animates[HERO][STASH][BOMB_STASH]--;
        make_item( $lmc->[WHERE], BOMB, 0 );
        return MOVE_OK;
    },
    'M' => sub {
        return MOVE_FAILED, 'You need more gems.'
          if $Animates[HERO][STASH][GEM_STASH] < BOMB_COST;
        $Animates[HERO][STASH][GEM_STASH] -= BOMB_COST;
        post_message(
            'You now have ' . ++$Animates[HERO][STASH][BOMB_STASH] . ' bombs' );
        return MOVE_OK;
    },
    'Q'    => sub { game_over('Be seeing you...') },
    'q'    => sub { game_over('Be seeing you...') },
    "\003" => sub {                                    # <C-c>
        post_message('Enough with these silly interruptions!');
        return MOVE_FAILED;
    },
    "\014" => sub {                                    # <C-l>
        redraw_level();
        return MOVE_FAILED;
    },
    "\032" => sub {                                    # <C-z>
        post_message('You hear a strange noise in the background.');
        return MOVE_FAILED;
    },
    "\033" => sub {
        post_message('You cannot escape quite so easily.');
        return MOVE_FAILED;
    },
);

sub apply_gravity {
    for my $ent ( rev_nsort_by { $_->[LMC][WHERE][PROW] } @Animates ) {
        next if $ent->[BLACK_SPOT];
        my $here = $ent->[LMC][WHERE];
        next
          if $here->[PROW] == ROWS - 1
          or (  $ent->[TYPE] == ANI
            and $LMap->[ $here->[PROW] ][ $here->[PCOL] ][GROUND][WHAT] ==
            LADDER )
          or $LMap->[ $here->[PROW] + 1 ][ $here->[PCOL] ][GROUND][WHAT] ==
          WALL;
        my $dest = [ $here->[PCOL], $here->[PROW] + 1 ];
        relocate( $ent, $dest ) unless interact( $ent, $dest );
        if ( $ent->[WHAT] == HERO ) {
            if ( $ent->[LMC][GROUND][WHAT] == LADDER ) {
                post_message('You fall, but grab onto a ladder.');
            } else {
                post_message('You fall!');
            }
        }
    }
    maybe_boom_today();
}

sub bad_terminal {
    ( $TCols, $TRows ) = ( GetTerminalSize(*STDOUT) )[ 0, 1 ];
    return (
             not defined $TCols
          or $TCols < MSG_COLS_MAX
          or $TRows < MSG_MAX
    );
}

sub bail_out {
    restore_term();
    print "\n", at_col(0), clear_line;
    warn $_[0] if @_;
    game_over("Suddenly, the platforms collapse about you.");

lib/Game/PlatformsOfPeril.pm  view on Meta::CPAN

                    and $LMap->[ $x + 1 ][ $c + 1 ][GROUND][WHAT] == WALL )
            )
        ) {
            graph_udlink( $g, $c + 1, $x, $c, $x, $weight,     [ $c, $x ] );
            graph_udlink( $g, $c,     $x, $c, $r, $weight - 1, [ $c, $r ] );
        }
    }
}

sub graph_udlink {
    my ( $g, $c1, $r1, $c2, $r2, $weight, $point ) = @_;
    my $from = $c1 . ',' . $r1;
    my $to   = $c2 . ',' . $r2;
    push $g->{$from}->@*, [ $to, $weight, $point ];
}

sub interact {
    my ( $mover, $dest ) = @_;
    for my $i ( ANI, ITEM ) {
        my $target = $LMap->[ $dest->[PROW] ][ $dest->[PCOL] ][$i];
        if ( defined $target ) {
            # this code is assumed to take care of everything and be the
            # final say on the interaction
            $Interact_With{ $target->[WHAT] }->( $mover, $target );
            return 1;
        }
    }
    return 0;
}

sub kill_animate {
    my ( $ent, $no_draw ) = @_;
    push @RedrawA, $ent->[LMC][WHERE] unless defined $no_draw;
    $ent->[BLACK_SPOT] = 1;
    # NOTE this only works for TYPE of ANI or ITEM, may need to rethink
    # how STATUE and STAIRS are handled if there are GROUND checks on
    # TYPE as those abuse the TYPE field for other things (see %Things)
    undef $ent->[LMC][ $ent->[TYPE] ];
}

sub load_level {
    my $file = catfile( $Level_Path, 'level' . $Level++ );
    game_over( 'You have completed all the levels.', 0 ) unless -e $file;

    open( my $fh, '<', $file ) or game_over("Failed to open '$file': $!");

    splice @Animates, 1;
    undef $Animates[HERO][LMC];
    $LMap = [];

    my $rownum = 0;
    while ( my $line = readline $fh ) {
        chomp $line;
        game_over("Wrong number of columns at $file:$.")
          if length $line != COLS;
        my $colnum = 0;
        for my $v ( split //, $line ) {
            my $c = $CharMap{$v} // game_over("Unknown character $v at $file:$.");
            my $point = [ $colnum++, $rownum ];    # PCOL, PROW (x, y)
            if ( exists $Things{$c} ) {
                if ( $c eq BOMB ) {
                    push $LMap->[$rownum]->@*, [ $point, $Things{ FLOOR, } ];
                    make_item( $point, BOMB, 0 );
                } elsif ( $c eq GEM ) {
                    push $LMap->[$rownum]->@*, [ $point, $Things{ FLOOR, } ];
                    make_item( $point, GEM, GEM_VALUE );
                } else {
                    push $LMap->[$rownum]->@*, [ $point, $Things{$c} ];
                }
            } else {
                if ( $c eq HERO ) {
                    game_over("Player placed twice in $file")
                      if defined $Animates[HERO][LMC];
                    push $LMap->[$rownum]->@*,
                      [ $point, $Things{ FLOOR, }, undef, $Animates[HERO] ];
                    $Animates[HERO][LMC] = $LMap->[$rownum][-1];
                    $Hero = $point;
                } elsif ( $c eq MONST ) {
                    push $LMap->[$rownum]->@*, [ $point, $Things{ FLOOR, } ];
                    make_monster($point);
                } else {
                    game_over("Unknown object '$v' at $file:$.");
                }
            }
        }
        last if ++$rownum == ROWS;
    }
    game_over("Too few rows in $file") if $rownum < ROWS;
    game_over("No player in $file") unless defined $Animates[HERO][LMC];

    $Rotation = 0;
    for my $rot ( 1 .. 4 ) {
        $Graphs[$Rotation] = graph_setup();
        rotate_left();
    }
}

sub make_item {
    my ( $point, $thingy, $stash, $update ) = @_;
    my $item;
    $item->@[ WHAT, DISP, TYPE, STASH, UPDATE, LMC ] = (
        $Things{$thingy}->@*,
        $stash, $update, $LMap->[ $point->[PROW] ][ $point->[PCOL] ]
    );
    push @Animates, $item;
    $LMap->[ $point->[PROW] ][ $point->[PCOL] ][ITEM] = $item;
}

sub make_monster {
    my ($point) = @_;
    my $monst;
    my $ch = substr $Monst_Name, 0, 1;
    # STASH replicates that of the HERO for simpler GEM handling code
    # though the BOMB_STASH is instead used for GEM_ODDS
    $monst->@[ WHAT, DISP, TYPE, STASH, UPDATE, LMC ] = (
        MONST, "\e[1;33m$ch\e[0m", ANI, [ 0, 0.0 ],
        \&update_monst, $LMap->[ $point->[PROW] ][ $point->[PCOL] ]
    );
    push @Animates, $monst;
    $LMap->[ $point->[PROW] ][ $point->[PCOL] ][ANI] = $monst;
}

sub maybe_boom_today {
    if ( keys %Explosions ) {
        explode($_) for values %Explosions;
        %Explosions = ();
    }
}

sub move_animate {
    my ( $ent, $cols, $rows ) = @_;
    my $lmc = $ent->[LMC];

    my $from = $lmc->[WHERE][PCOL] . ',' . $lmc->[WHERE][PROW];
    my $to =
        ( $lmc->[WHERE][PCOL] + $cols ) . ','
      . ( $lmc->[WHERE][PROW] + $rows );

    return MOVE_FAILED
      unless first { $_->[GRAPH_NODE] eq $to }
      $Graphs[$Rotation]{$from}->@*;

    my $dest =
      [ $lmc->[WHERE][PCOL] + $cols, $lmc->[WHERE][PROW] + $rows ];

    relocate( $ent, $dest ) unless interact( $ent, $dest );
    return MOVE_OK;
}

# so the player can see if there is a ladder under something; this is an
# important consideration on some levels
sub move_examine {
    my $key;
    my $row = $Animates[HERO][LMC][WHERE][PROW];
    my $col = $Animates[HERO][LMC][WHERE][PCOL];
    print at( MSG_COL, MSG_ROW + $_ ), clear_right for 1 .. MSG_MAX;
    print at( MSG_COL, MSG_ROW ), clear_right,
      'Move cursor to view a cell. Esc exits', show_cursor;
    while (1) {
        print at( MSG_COL, MSG_ROW + $_ ), clear_right for 3 .. 5;
        my $disp_row = 2;
        for my $i ( ANI, ITEM ) {
            my $x = $LMap->[$row][$col][$i];
            if ( defined $x ) {
                print at( MSG_COL, MSG_ROW + $disp_row++ ), clear_right, $x->[DISP],
                  ' - ', $Descriptions{ $x->[WHAT] };
            }
        }
        my $g = $LMap->[$row][$col][GROUND];
        print at( MSG_COL, MSG_ROW + $disp_row ), clear_right, $g->[DISP],
          ' - ', $Descriptions{ $g->[TYPE] },
          at( MAP_DISP_OFF + $col, MAP_DISP_OFF + $row );
        $key = ReadKey(0);
        last if $key eq "\033";
        my $distance = 1;
        if ( ord $key < 97 ) {    # SHIFT moves faster
            $key      = lc $key;
            $distance = 5;
        }
        my $dir = $Examine_Offsets{$key} // next;
        $row = between( 0, ROWS - 1, $row + $dir->[PROW] * $distance );
        $col = between( 0, COLS - 1, $col + $dir->[PCOL] * $distance );
    }
    print hide_cursor;
    show_messages();
    return MOVE_FAILED;
}

sub move_nop { return MOVE_OK }

sub move_player {
    my ( $cols, $rows ) = @_;
    sub { move_animate( $Animates[HERO], $cols, $rows ) }
}

sub post_help {
    my $ch = substr $Monst_Name, 0, 1;
    post_message('');
    post_message( ' '
          . $Animates[HERO][DISP]
          . ' - You   '
          . $ch . ' - a '
          . $Monst_Name );
    post_message( ' '
          . $Things{ STATUE, }[DISP]
          . ' - a large granite statue done in the' );
    post_message( '     ' . $Style . ' style' );
    post_message( ' '
          . $Things{ BOMB, }[DISP]
          . ' - Bomb  '
          . $Things{ GEM, }[DISP]
          . ' - Gem (get these)' );
    post_message('');
    post_message(' h j k l - move');
    post_message(' < >     - activate left or right boot');
    post_message(' B       - drop a Bomb');
    post_message(
        ' M       - make a Bomb (consumes ' . BOMB_COST . ' Gems)' );
    post_message( ' %       - when on '
          . $Things{ STAIR, }[DISP]
          . ' goes to the next level' );
    post_message(' . space - pass a turn (handy when falling)');
    post_message('');
    post_message(' Q q     - quit the game (no save)');
    post_message(' $       - display Bomb and Gem counts');
    post_message(' ?       - post these help messages');
    post_message('');
    post_message( 'You have '
          . $Animates[HERO][STASH][BOMB_STASH]
          . ' bombs and '
          . $Animates[HERO][STASH][GEM_STASH]
          . ' gems.' );
}

{
    my @log;

    sub post_message {
        my ($msg) = @_;
        while ( @log >= MSG_MAX ) { shift @log }
        push @log, $msg;
        show_messages();
    }
    sub clear_messages { @log = () }

    sub show_messages {
        for my $i ( 0 .. $#log ) {
            print at( MSG_COL, MSG_ROW + $i ), clear_right, $log[$i];
        }
    }
}

# fsvo properly... damnit Jim I'm a sysadmin not a linguist
sub properly_plural {
    my ($name) = @_;
    $name =~ s/oo/ee/ ? $name : $name . 's';
}

sub redraw_level { print clear_screen, draw_level; show_messages() }

sub redraw_movers {
    redraw_ref( \@RedrawA );
    sleep($Redraw_Delay);
    redraw_ref( \@RedrawB );
    maybe_boom_today();
    @RedrawA = ();
    @RedrawB = ();
}

sub redraw_ref {
  CELL: for my $point ( $_[0]->@* ) {
        for my $i ( ANI, ITEM ) {
            my $ent = $LMap->[ $point->[PROW] ][ $point->[PCOL] ][$i];
            if ( defined $ent and !$ent->[BLACK_SPOT] ) {
                print at( map { MAP_DISP_OFF + $_ } $point->@* ), $ent->[DISP];
                next CELL;
            }
        }
        print at( map { MAP_DISP_OFF + $_ } $point->@* ),
          $LMap->[ $point->[PROW] ][ $point->[PCOL] ][GROUND][DISP];
    }
}

sub relocate {
    my ( $ent, $dest ) = @_;
    my $src = $ent->[LMC][WHERE];
    push @RedrawA, $src;
    push @RedrawB, $dest;
    my $lmc = $LMap->[ $dest->[PROW] ][ $dest->[PCOL] ];