Game-PlatformsOfPeril
view release on metacpan or search on metacpan
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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 }
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
# 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,
);
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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;
}
},
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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();
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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];
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
);
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 ) {
lib/Game/PlatformsOfPeril.pm view on Meta::CPAN
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) = @_;
( run in 0.599 second using v1.01-cache-2.11-cpan-e9daa2b36ef )