Game-PlatformsOfPeril

 view release on metacpan or  search on metacpan

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

            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

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

        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();
}

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

        ( $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;

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

            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] ];
    $lmc->[ $ent->[TYPE] ] = $ent;
    undef $LMap->[ $src->[PROW] ][ $src->[PCOL] ][ $ent->[TYPE] ];
    $ent->[LMC] = $lmc;
}

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

    # head-running...)
    if (    $mrow != ROWS - 1
        and $ent->[LMC][GROUND][WHAT] == FLOOR
        and $LMap->[ $mrow + 1 ][$mcol][GROUND][WHAT] != WALL ) {
        return;
    }

    my $dest = find_hero( $ent, $mcol, $mrow );
    return unless defined $dest;

    relocate( $ent, $dest ) unless interact( $ent, $dest );

    if ( $ent->[STASH][GEM_STASH] > 0
        and !defined $ent->[LMC][ITEM] ) {
        if ( rand() < $ent->[STASH][GEM_ODDS] ) {
            post_message( 'The ' . $Monst_Name . ' drops a gem!' );
            $ent->[STASH][GEM_STASH]--;
            make_item( $ent->[LMC][WHERE], GEM, GEM_VALUE );
            $ent->[STASH][GEM_ODDS] = 0.0 - GEM_ODDS_ADJUST;
        }
        $ent->[STASH][GEM_ODDS] += GEM_ODDS_ADJUST;