Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Boulder tracking for Sokoban
This change attempts to distinguish genuine boulders and mimics,
to be able to tell where it is in terms of solving Sokoban.
  • Loading branch information
Alex Smith committed Aug 5, 2009
1 parent 3476725 commit 48af723
Show file tree
Hide file tree
Showing 3 changed files with 45 additions and 3 deletions.
20 changes: 18 additions & 2 deletions lib/TAEB/Action/Move.pm
Expand Up @@ -10,14 +10,14 @@ has path => (
provided => 1,
);

has [qw/hit_obscured_monster hit_immobile_boulder/] => (
has [qw/hit_obscured_monster hit_immobile_boulder pushing/] => (
is => 'rw',
isa => 'Bool',
default => 0,
);

# if the first movement is < or >, then just use the Ascend or Descend actions
# if the first movement would move us into a monster, rest instead
# if the first movement moves us into a boulder, record the fact
around new => sub {
my $orig = shift;
my $class = shift;
Expand All @@ -42,6 +42,10 @@ around new => sub {
$action = 'Descend';
}

if (TAEB->current_tile->at_direction($start)->has_boulder) {
$args{pushing} = 1;
}

if ($action) {
return "TAEB::Action::$action"->new(%args);
}
Expand Down Expand Up @@ -75,6 +79,18 @@ sub done {
if ($walked) {
TAEB->send_message('walked');

if ($self->pushing) {
# If we pushed a boulder, then if it's still there, it
# must be genuine.
TAEB->current_tile->known_genuine_boulder(0);
my $beyond =
TAEB->current_level->at_safe(
TAEB->x * 2 - $self->starting_tile->x,
TAEB->y * 2 - $self->starting_tile->y);
$beyond->known_genuine_boulder(1)
if $beyond && $beyond->has_boulder;
}

# the rest applies only if we haven't moved
return;
}
Expand Down
20 changes: 19 additions & 1 deletion lib/TAEB/Spoilers/Sokoban.pm
Expand Up @@ -399,6 +399,15 @@ sub first_solvable_sokoban_level {
});
}

sub probably_has_genuine_boulder {
my $self = shift;
my $tile = shift;
return 0 unless $tile->has_boulder;
return 1 if $tile->type eq 'obscured';
return 1 if $tile->known_genuine_boulder;
return 0; # probably a mimic
}

sub next_sokoban_step {
my $self = shift;
my $level = shift;
Expand Down Expand Up @@ -463,7 +472,7 @@ sub next_sokoban_step {

$level->each_tile(sub {
my $t = shift;
if ($t->has_boulder) {
if ($self->probably_has_genuine_boulder($t)) {
my $y = $t->y - $top;
my $x = $t->x - $left;
my $char = $map->[$y]->[$x];
Expand Down Expand Up @@ -612,6 +621,15 @@ argument is a string giving the variant, which can be added to avoid
recalculating the variant if it's already known; if omitted, the
variant will be calculated by looking ath the level map.
=head2 probably_has_genuine_boulder Tile -> Bool
Returns true if the tile appears to have a boulder on, and it probably
is a genuine boulder, rather than a mimic pretending. To be precise,
this returns true if we've pushed a boulder onto the square and
haven't pushed it off again, or if the tile is obscured and appears to
have a boulder; this handles all cases but that of a mimic visible
when we arrive on the level, and a search should detect that.
=head2 next_sokoban_step Level [Pathable] -> Maybe Tile
Return the tile that we need to head to next to solve the Sokoban
Expand Down
8 changes: 8 additions & 0 deletions lib/TAEB/World/Tile.pm
Expand Up @@ -84,6 +84,14 @@ has nondiggable => (
default => 0,
);

# Is there an object on this square that's known to be a boulder,
# rather than a mimic just pretending?
has known_genuine_boulder => (
is => 'rw',
isa => 'Bool',
default => 0,
);

has engraving => (
is => 'rw',
isa => 'Str',
Expand Down

0 comments on commit 48af723

Please sign in to comment.