Game-PlatformsOfPeril
view release on metacpan or search on metacpan
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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();
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
. $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.");
}
sub between {
my ( $min, $max, $value ) = @_;
if ( $value < $min ) {
$value = $min;
} elsif ( $value > $max ) {
$value = $max;
}
return $value;
}
sub draw_level {
my $s = '';
for my $rownum ( 0 .. ROWS - 1 ) {
$s .= at( MAP_DISP_OFF, MAP_DISP_OFF + $rownum );
for my $lmc ( $LMap->[$rownum]->@* ) {
if ( defined $lmc->[ANI] ) {
$s .= $lmc->[ANI][DISP];
} elsif ( defined $lmc->[ITEM] ) {
$s .= $lmc->[ITEM][DISP];
} else {
$s .= $lmc->[GROUND][DISP];
}
}
}
$s .= at( 1, ROWS + 1 ) . $Things{ WALL, }[DISP] x COLS;
return $s;
}
sub explode {
my ($something) = @_;
my $lmc = $something->[LMC];
my $pos = $lmc->[WHERE];
my @colors = ( "\e[31m", "\e[33m" );
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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' );
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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] ];
$lmc->[ $ent->[TYPE] ] = $ent;
undef $LMap->[ $src->[PROW] ][ $src->[PCOL] ][ $ent->[TYPE] ];
$ent->[LMC] = $lmc;
}
sub restore_term {
ReadMode 'restore';
print term_norm, show_cursor, unalt_screen;
}
sub rotate_left {
my $lm;
for my $r ( 0 .. ROWS - 1 ) {
for my $c ( 0 .. COLS - 1 ) {
my $newr = COLS - 1 - $c;
$lm->[$newr][$r] = $LMap->[$r][$c];
$lm->[$newr][$r][WHERE] = [ $r, $newr ];
}
}
$LMap = $lm;
$Rotation = ( $Rotation + 1 ) % 4;
}
sub rotate_right {
my $lm;
for my $r ( 0 .. ROWS - 1 ) {
for my $c ( 0 .. COLS - 1 ) {
my $newc = ROWS - 1 - $r;
$lm->[$c][$newc] = $LMap->[$r][$c];
$lm->[$c][$newc][WHERE] = [ $newc, $c ];
}
}
$LMap = $lm;
$Rotation = ( $Rotation - 1 ) % 4;
}
sub track_hero {
$Hero = $Animates[HERO][LMC][WHERE];
# route monsters to where the player will fall to as otherwise they
# tend to freeze or head in the wrong direction
my $row = $Hero->[PROW];
my $col = $Hero->[PCOL];
return
if $row == ROWS - 1
or $LMap->[$row][$col][GROUND][WHAT] == LADDER;
my $goal = $row;
for my $r ( $row + 1 .. ROWS - 1 ) {
last if $LMap->[$r][$col][GROUND][WHAT] == WALL;
if ($LMap->[$r][$col][GROUND][WHAT] == LADDER
or ( $r < ROWS - 2
and $LMap->[$r][$col][GROUND][WHAT] == FLOOR
and $LMap->[ $r + 1 ][$col][GROUND][WHAT] == WALL )
or ( $r == ROWS - 1
and $LMap->[$r][$col][GROUND][WHAT] == FLOOR )
) {
$goal = $r;
last;
}
}
$Hero = [ $col, $goal ];
}
sub update_hero {
my ( $key, $ret );
tcflush( STDIN_FILENO, TCIFLUSH );
while (1) {
while (1) {
$key = ReadKey(0);
last if exists $Key_Commands{$key};
#post_message(sprintf "Illegal command \\%03o", ord $key);
}
$ret = $Key_Commands{$key}->();
last if $ret != MOVE_FAILED;
}
return $ret;
}
sub update_monst {
my ($ent) = @_;
my $mcol = $ent->[LMC][WHERE][PCOL];
my $mrow = $ent->[LMC][WHERE][PROW];
# prevent monster move where only gravity should apply
# NOTE one may have the clever idea that monsters can run across the
# heads of other monsters though that would require changes to how
# the graph is setup to permit such moves, and additional checks to
# see if something to tread upon is available (and then to let the
# hero do that (like in Lode Runner) or to prevent them from such
# 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;
}
}
1;
__END__
=head1 NAME
Game::PlatformsOfPeril - the platforms of peril
=head1 SYNOPSIS
Platforms of Peril is a terminal-based game. Assuming App::cpanminus
(and possibly also local::lib) is installed and setup, in a suitable
terminal (possibly one with a square font such as White Rabbit and a
black background) install and run the game via:
cpanm Game::PlatformsOfPeril
pperil
Help text should be printed when the game starts. Use the C<?> key in
game to show the help text again.
=head1 DESCRIPTION
You are the only spawn (son, daughter, etc.) of a Xorbian Ranger and as
such are duty bound not to peruse pointless background material such as
this. You have long hair, green eyes, and start the game with a bomb,
and need to collect gems all the while avoiding the enemies. The enemies
have been blessed with pretty much bog standard A* pathfinding yet do
know a thing or two about gravity. Gems can be made into bombs (the
details as to how are not entirely clear) and bombs in turn will explode
on contact with things that move. You also have two magic boots, one on
each foot. These do something when activated.
P.S. Do not drop a bomb while falling, as it will fall with you and
then explode.
P.P.S. You can make bombs while falling. This is perhaps a more
productive use of that time than mashing space or the C<.> key.
=head2 Customizing the Game
C<pperil> accepts a number of options that do not do very much:
Usage: pperil [--err=file] [--level=N] [--prefix=path] [--seed=N]
--err - send STDERR to this file if not already redirected
--level - level integer to start on
--prefix - path to the levels directory (containing the files
( run in 1.445 second using v1.01-cache-2.11-cpan-71847e10f99 )