view release on metacpan or  search on metacpan

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

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()) {
        if ($ani->[SPECIES] == HERO) {
            # Ultima IV does this. too annoying?
            $Violent_Sleep_Of_Reason = 1;
            log_message('Slow progress!');
        }
        return ($cost >> 1) + 2 + irand(4);
    } else {
        return 2 + irand(4);
    }
}

{
    my $energy = '00';

    sub sb_update_energy {
        $energy = sprintf "%02d", $Animates[HERO][STASH][ECOST];
    }

    sub show_status_bar {
        print at_row(STATUS_ROW),
          sprintf('Level %02d t', $Level), $energy, TERM_NORM,
          display_hitpoints(), display_cellobjs(), display_shieldup();
    }
}

sub score {
    my ($won) = @_;
    my $score = loot_value() + ($won ? 10000 : 0) + 10 * int exp $Level_Max;
    return "Score: $score in $Turn_Count turns (v$VERSION:$Seed)";
}

sub update_gameover {
    state $count = 0;