Game-Xomb

 view release on metacpan or  search on metacpan

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

                last CMD if $use eq "\033" or $use eq 'q';
                my $i = ord($use) - 65;
                if ($i < $loot->@*) {
                    use_item($loot, $i, $Animates[HERO][STASH]) and print display_shieldup();
                    last CMD;
                }
            }
        }
    }
    print HIDE_CURSOR;
    log_dim();
    refresh_board();
    return MOVE_FAILED, 0;
}

# only the player can move in this game so this is not as generic as it
# should be
sub move_animate {
    my ($ani, $cols, $rows, $cost) = @_;
    my $lmc  = $ani->[LMC];
    my $dcol = $lmc->[WHERE][PCOL] + $cols;
    my $drow = $lmc->[WHERE][PROW] + $rows;
    if (   $dcol < 0
        or $dcol >= MAP_COLS
        or $drow < 0
        or $drow >= MAP_ROWS) {
        undef $Sticky;
        return MOVE_FAILED, 0, '0001';
    }
    if (defined $Sticky) {
        if (@Visible_Monst or abort_run($lmc->[WHERE]->@[ PCOL, PROW ], $dcol, $drow)) {
            undef $Sticky;
            return MOVE_FAILED, 0, '0065';
        }
    }
    # Bump combat, as is traditional
    my $target = $LMap[$drow][$dcol][ANIMAL];
    if (defined $target) {
        if (irand(100) < 90) {
            apply_damage($target, 'attackby', $ani);
        } else {
            pkc_log_code('0302');
        }
        $cost += rubble_delay($ani, $cost) if $lmc->[MINERAL][SPECIES] == RUBBLE;
        apply_passives($ani, $cost, 0);
        return MOVE_OKAY, $cost;
    }
    $target = $LMap[$drow][$dcol][MINERAL];
    return MOVE_FAILED, 0, '0002' if $target->[SPECIES] == WALL;
    # NOTE the rubble delay is applied *before* they can move out of
    # that acid pond that they are in:
    #   "Yes, we really hate players, damn their guts."
    #     -- Dungeon Crawl Stone Soup, cloud.cc
    $cost += rubble_delay($ani, $cost) if $target->[SPECIES] == RUBBLE;
    if ($target->[SPECIES] == HOLE) {
        return MOVE_FAILED, 0
          if nope_regarding('Falling may cause damage', undef,
            'You decide against it.');
        apply_passives($ani, $cost >> 1, 0);
        log_message('You plunge down into the crevasse.');
        relocate($ani, $dcol, $drow);
        pkc_log_code('0099');
        # KLUGE fake the source of damage as from the floor
        my $src;
        $src->[SPECIES] = FLOOR;
        apply_damage($ani, 'falling', $src);
        return MOVE_LVLDOWN, $cost;
    } else {
        apply_passives($ani, $cost >> 1, 0);
        relocate($ani, $dcol, $drow);
        apply_passives($ani, $cost >> 1, 1);
        return MOVE_OKAY, $cost;
    }
}

sub move_drop {
    return MOVE_FAILED, 0, '0104'
      if defined $Animates[HERO][LMC][VEGGIE];
    return MOVE_FAILED, 0, '0112'
      unless $Animates[HERO][STASH][LOOT]->@*;
    @_ = ('d', 'drop item L)abel or Esc to exit');
    goto &manage_inventory;
}

sub move_equip {
    return MOVE_FAILED, 0, '0112'
      unless $Animates[HERO][STASH][LOOT]->@*;
    @_ = ('E', 'Equip item L)abel or Esc to exit');
    goto &manage_inventory;
}

sub move_examine {
    my ($command) = @_;
    my ($col,  $row)  = $Animates[HERO][LMC][WHERE]->@[ PCOL, PROW ];
    my ($pcol, $prow) = ($col, $row);
    print AT_MSG_ROW, CLEAR_RIGHT, SHOW_CURSOR,
      "-- move cursor, SHIFT moves faster. TAB for monsters. Esc to exit --";
    my $monst = 0;
    while (1) {
        my $loc = $col . ',' . $row;
        my $s   = '[' . $loc . '] ';
        if (exists $Visible_Cell{$loc}) {
            for my $i (ANIMAL, VEGGIE) {
                my $x = $LMap[$row][$col][$i];
                $s .= $x->[DISPLAY] . ' ' . $Descript{ $x->[SPECIES] } . ' '
                  if defined $x;
            }
            my $g = $LMap[$row][$col][MINERAL];
            if (defined $g) {
                if ($g->[SPECIES] == HOLE) {
                    $s .= $Descript{ $g->[SPECIES] };
                } else {
                    $s .= $g->[DISPLAY] . ' ' . $Descript{ $g->[SPECIES] };
                }
            }
        } else {
            $s .= '-- negative return on FOV scanner query --';
        }
        print at_row(STATUS_ROW), CLEAR_RIGHT, $s, at(map { MAP_DOFF + $_ } $col, $row);
        # this would need to be a bit more complicated to support numpad
        my $key = $command // $RKFN->(
            {   "\033" => 1,
                'q'    => 1,
                "\011" => 1,
                'h'    => 1,
                'j'    => 1,
                'k'    => 1,
                'l'    => 1,
                'y'    => 1,
                'u'    => 1,

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

                $Visible_Cell{$loc} = [ $col, $row ];
                for my $i (ANIMAL, VEGGIE) {
                    if (defined $LMap[$row][$col][$i]) {
                        push $byrow{$row}->@*, [ $col, $LMap[$row][$col][$i][DISPLAY] ];
                        return 0;
                    }
                }
                push $byrow{$row}->@*, [ $col, $cell->[DISPLAY] ];
                return 0;
            },
            $cx,
            $cy,
            $cx + $ep->[0],
            $cy + $ep->[1]
        );
    }

    my $s = '';
    for my $r (0 .. MAP_ROWS - 1) {
        $s .= at_row(MAP_DOFF + $r) . CLEAR_RIGHT;
    }
    for my $r (nsort_by { $byrow{$_} } keys %byrow) {
        $s .= at_row(MAP_DOFF + $r);
        for my $ref (nsort_by { $_->[0] } $byrow{$r}->@*) {
            $s .= at_col(MAP_DOFF + $ref->[0]) . $ref->[1];
        }
    }

    # ensure @ is shown as FOV should not touch that cell
    print $FOV =
      $s . at(map { MAP_DOFF + $_ } $cx, $cy) . $LMap[$cy][$cx][ANIMAL][DISPLAY];
}

sub reduce {
    my ($lmc) = @_;
    if (exists $Visible_Cell{ join ',', $lmc->[WHERE]->@[ PCOL, PROW ] }) {
        log_message('A '
              . $Descript{ $lmc->[MINERAL][SPECIES] }
              . ' explodes in a shower of fragments!');
    }
    # rubble reification
    $lmc->[MINERAL] = [ $lmc->[MINERAL]->@* ];
    $lmc->[MINERAL]->@[ SPECIES, DISPLAY ] =
      $Thingy{ RUBBLE, }->@[ SPECIES, DISPLAY ];
}

sub refresh_board {
    print CLEAR_SCREEN;
    raycast_fov(0);
    show_top_message();
    show_status_bar();
}

# similar to tu'a in Lojban
sub reify {
    my ($lmc, $update) = @_;
    $lmc->[MINERAL] = [ $lmc->[MINERAL]->@* ];
    $lmc->[MINERAL][UPDATE] = $update if defined $update;
}

sub relocate {
    my ($ani, $col, $row) = @_;
    my $lmc = $ani->[LMC];

    my $src = $lmc->[WHERE];

    my $dest_lmc = $LMap[$row][$col];
    $dest_lmc->[ANIMAL] = $ani;
    undef $LMap[ $src->[PROW] ][ $src->[PCOL] ][ANIMAL];

    $ani->[LMC] = $dest_lmc;

    my $cell = $lmc->[VEGGIE] // $lmc->[MINERAL];
    print at(map { MAP_DOFF + $_ } $src->@[ PCOL, PROW ]), $cell->[DISPLAY],
      at(map { MAP_DOFF + $_ } $col, $row),
      $ani->[DISPLAY];
}

sub replay {
    my ($expect) = @_;
    my $key;
    sleep($Replay_Delay);
    local $/ = \1;
    while (1) {
        my $esc = ReadKey(-1);
        if (defined $esc and $esc eq "\033") {
            $RKFN = \&Game::Xomb::getkey;
            goto &Game::Xomb::getkey;
        }
        $key = readline $Replay_FH;
        if (defined $key) {
            last if exists $expect->{$key};
        } else {
            # KLUGE avoid busy-wait on "tail" of an active savegame
            sleep(0.2);
        }
    }
    print $Save_FH $key if defined $Save_FH;
    return $key;
}

sub report_position {
    log_message('Transponder reports ['
          . join(',', $Animates[HERO][LMC][WHERE]->@[ PCOL, PROW ])
          . ']');
    return MOVE_FAILED, 0;
}

sub report_version {
    log_message('Xomb v' . $VERSION . ' seed ' . $Seed . ' turn ' . $Turn_Count);
    return MOVE_FAILED, 0;
}

sub restore_term {
    ReadMode 'restore';
    print TERM_NORM, SHOW_CURSOR, UNALT_SCREEN;
}

sub rubble_delay {
    my ($ani, $cost) = @_;
    if (coinflip()) {

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

Apply acid damage because the player is in a pool of acid.

=item B<passive_msg_maker>

Returns a subroutine that issues a message when a cell is entered into.
The cell should probably be made unique with B<reify> first as otherwise
all floor tiles of that type will share the same update routine.

=item B<pathable> I<col> I<row> I<points ...>

Ensures that a path exists between the given coordinates and the given
list of points; used by B<generate_map> to ensure that the player can
reach all the gates and gems.

=item B<pick>

Picks a random item from the given array reference. Uses the JSF random
number generator (see C<src/jsf.c>).

=item B<pkc_clear>

Clears the PKC error code from the status bar.

=item B<pkc_log_code>

Prints a PKC error code in the status bar.

=item B<place_floortype>

Used by B<generate_map> to place floor tiles somewhat randomly (brown
noise) around the level map, as controlled by C<@Level_Features> counts.

=item B<place_monster>

Creates and places a monster onto the level map, and that the monster
has not been placed above a hole or in acid.

=item B<plasma_annihilator>

Displays and applies splash damage from Fungi attacks.

=item B<raycast_fov>

Calculates the FOV for the player and updates various related variables
such as what monsters are visible.

=item B<reduce>

Reduces a map cell floor tile to C<RUBBLE>. Some monsters can
destroy walls.

=item B<refresh_board>

Redraw the level map, status bar, and previous message if any.

=item B<reify>

Marks a particular level map item (C<MINERAL>, typically) as unique,
usually so that a B<passive_msg_maker> can be applied to it.

=item B<relocate>

Handles moving the player from one level map cell to another.

=item B<replay>

Replays commands from a save game file. See also C<$RKFN>.

=item B<report_position>

Logs a message showing where the player is on the level map.

=item B<report_version>

Logs a message with the game version, seed, and current turn number.

=item B<restore_term>

Gets the terminal out of raw mode and more back to normal.

=item B<roll> I<times> I<sides>

Dice rolling, so C<3d6> would be C<roll(3,6)>. Uses the JSF random
number generator (see C<src/jsf.c>).

=item B<rubble_delay>

Slow the player down when they move in (or into, or out of) rubble.

=item B<sb_update_energy>

Update the energy cost of the last move.

=item B<score>

Returns a string with the game score in it.

=item B<show_messages>

Show all the recent messages in the message log.

=item B<show_status_bar>

Prints the status bar at the bottom of the screen.

=item B<show_top_message>

Prints the most recent log message at the top of the screen.

=item B<update_fungi>

C<UPDATE> function for fungi.

=item B<update_gameover>

Custom C<UPDATE> function for when the player is dead.

=item B<update_ghast>

C<UPDATE> function for ghast.



( run in 0.365 second using v1.01-cache-2.11-cpan-71847e10f99 )