Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 149 lines (122 sloc) 4.16 KB
#!perl
use v5.20.0;
use warnings;
use Getopt::Long::Descriptive;
my ($opt, $usage) = describe_options(
'%c %o',
[ 'debug|D', 'show debugging output' ],
[ 'width|w=i', 'width of cells', { default => 3 } ],
[ 'height|h=i', 'height of cells', { default => 1 } ],
);
use utf8;
binmode *STDOUT, ':encoding(UTF-8)';
# 1 A maze file, in the first and stupidest form, is a sequence of lines.
# 8•2 Every line is a sequence of numbers.
# 4 Every number is a 4-bit number. *On* sides are linked.
#
# Here are some (-w 3 -h 1) depictions of mazes as described by the numbers
# shown in their cells:
#
# ┌───┬───┬───┐ ╶───────┬───┐
# │ 0 │ 0 │ 0 │ 10 12 │ 0 │
# ├───┼───┼───┤ ┌───┐ ├───┤
# │ 0 │ 0 │ 0 │ │ 0 │ 5 │ 0 │
# ├───┼───┼───┤ ├───┤ └───┤
# │ 0 │ 0 │ 0 │ │ 0 │ 3 12 │
# └───┴───┴───┘ └───┴───╴ ╵
use constant {
NORTH => 1,
EAST => 2,
SOUTH => 4,
WEST => 8,
};
my @lines = <>;
chomp @lines;
my $grid = [ map {; [ split /\s+/, $_ ] } @lines ];
die "bogus input\n" if grep {; grep {; /[^0-9]/ } @$_ } @$grid;
my $max_x = $grid->[0]->$#*;
my $max_y = $grid->$#*;
die "not all rows of uniform length\n" if grep {; $#$_ != $max_x } @$grid;
for my $y (0 .. $max_y) {
for my $x (0 .. $max_x) {
my $cell = $grid->[$y][$x];
my $south = $y < $max_y ? $grid->[$y+1][$x] : undef;
my $east = $x < $max_x ? $grid->[$y][$x+1] : undef;
die "inconsistent vertical linkage at ($x, $y) ($cell v $south)"
if $south && ($cell & SOUTH xor $south & NORTH);
die "inconsistent horizontal linkage at ($x, $y) ($cell v $east)"
if $east && ($cell & EAST xor $east & WEST );
}
}
my %WALL = (
0 | 0 | 0 | 0 ,=> ' ',
0 | 0 | 0 | WEST ,=> '',
0 | 0 | SOUTH | 0 ,=> '',
0 | 0 | SOUTH | WEST ,=> '',
0 | EAST | 0 | 0 ,=> '',
0 | EAST | 0 | WEST ,=> '',
0 | EAST | SOUTH | 0 ,=> '',
0 | EAST | SOUTH | WEST ,=> '',
NORTH | 0 | 0 | 0 ,=> '',
NORTH | 0 | 0 | WEST ,=> '',
NORTH | 0 | SOUTH | 0 ,=> '',
NORTH | 0 | SOUTH | WEST ,=> '',
NORTH | EAST | 0 | 0 ,=> '',
NORTH | EAST | 0 | WEST ,=> '',
NORTH | EAST | SOUTH | 0 ,=> '',
NORTH | EAST | SOUTH | WEST ,=> '',
);
sub wall {
my ($n, $e, $s, $w) = @_;
return $WALL{ ($n ? NORTH : 0)
| ($e ? EAST : 0)
| ($s ? SOUTH : 0)
| ($w ? WEST : 0) } || '+';
}
sub get_at {
my ($x, $y) = @_;
return undef if $x < 0 or $y < 0;
return undef if $x > $max_x or $y > $max_y;
return $grid->[$y][$x];
}
my @output;
for my $y (0 .. $max_y+1) {
my $row = q{};
my $filler;
for my $x (0 .. $max_x+1) {
my $ne = get_at($x , $y - 1);
my $se = get_at($x , $y );
my $sw = get_at($x - 1, $y );
my $nw = get_at($x - 1, $y - 1);
my $n = (defined $ne && ! ($ne & WEST ))
|| (defined $nw && ! ($nw & EAST ));
my $e = (defined $se && ! ($se & NORTH))
|| (defined $ne && ! ($ne & SOUTH));
my $s = (defined $se && ! ($se & WEST ))
|| (defined $sw && ! ($sw & EAST ));
my $w = (defined $sw && ! ($sw & NORTH))
|| (defined $nw && ! ($nw & SOUTH));
if ($opt->debug) {
printf "(%u, %u) -> NE:%2s SE:%2s SW:%2s NW:%2s -> (%s %s %s %s) -> %s\n",
$x, $y,
(map {; $_ // '--' } ($ne, $se, $sw, $nw)),
(map {; $_ ? 1 : 0 } ($n, $e, $s, $w)),
wall($n, $e, $s, $w);
}
$row .= wall($n, $e, $s, $w);
if ($x > $max_x) {
# The rightmost wall is just the right joiner.
$filler .= wall($s, 0, $s, 0);
} else {
# Every wall but the last gets post-wall spacing.
$row .= ($e ? wall(0,1,0,1) : ' ') x $opt->width;
$filler .= wall($s, 0, $s, 0);
$filler .= ' ' x $opt->width;
}
}
push @output, $row;
if ($y <= $max_y) {
push @output, ($filler) x $opt->height;
}
}
say for @output;
You can’t perform that action at this time.