Perl implementation of 'drunken bishop' (OpenSSL hash visualization algorithm)

hashviz.pl

#!/usr/bin/perl
# Perl implementation of 'drunken bishop' (OpenSSL hash visualization algorithm)
# Copyright © 2013 PE Volodymyr Shymanskyy. All rights reserved.
# License: GNU GPL v2 (http://www.gnu.org/licenses/gpl-2.0.txt)
=pod
Bishop Peter finds himself in the middle of an ambient atrium. There
are walls on all four sides and apparently there is no exit. The floor is
paved with square tiles, strictly alternating between black and white. His
head heavily aching - probably from too much wine he had before - he
starts wandering around randomly. Well, to be exact, he only makes
diagonal steps - just like a bishop on a chess board. When he hits a
wall, he moves to the side, which takes him from the black tiles to the
white tiles (or vice versa). And after each move, he places a coin on
the floor, to remember that he has been there before. After 64 steps,
just when no coins are left, Peter suddenly wakes up. What a strange dream!
=cut
use strict;
use warnings;

my $hash = $ARGV[0];
my ($h, $w) = (9, 17);
my $qty = $w * $h;

my %steps = (    # hex digit => two steps
	0 => [0, 0], 1 => [1, 0], 2 => [2, 0], 3 => [3, 0],
	4 => [0, 1], 5 => [1, 1], 6 => [2, 1], 7 => [3, 1],
	8 => [0, 2], 9 => [1, 2], a => [2, 2], b => [3, 2],
	c => [0, 3], d => [1, 3], e => [2, 3], f => [3, 3],
);

my %guide = (	# cell type => step => offset on field
	M => { 0 => -$w-1, 1 => -$w+1, 2 =>  $w-1, 3 => $w+1 },
	T => { 0 => -1   , 1 =>  1   , 2 =>  $w-1, 3 => $w+1 },
	B => { 0 => -$w-1, 1 => -$w+1, 2 => -1   , 3 => 1    },
	L => { 0 => -$w  , 1 => -$w+1, 2 =>  $w  , 3 => $w+1 },
	R => { 0 => -$w-1, 1 => -$w  , 2 =>  $w-1, 3 => $w   },
	a => { 0 =>  0   , 1 =>  1   , 2 =>  $w  , 3 => $w+1 },
	b => { 0 => -1   , 1 =>  0   , 2 =>  $w-1, 3 => $w   },
	c => { 0 => -$w  , 1 => -$w+1, 2 =>  0   , 3 => 1    },
	d => { 0 => -$w-1, 1 => -$w  , 2 => -1   , 3 => 0    },
);

sub get_steps { # get an array of steps for specified hash
	my ($hash) = @_;
	$hash =~ s/(.)(.)/$2$1/sg; # swap hex digits ;)
	my @res;
	push @res, @{$steps{$_}} foreach map { lc } split('', $hash);
	return @res;
}

sub cell_type {
	my $n = shift;
	my ($x, $y) = ($n % $w, int $n / $w);
	if ($x == $w-1) { return ($y == 0) ? 'b' : (($y == $h-1) ? 'd' : 'R'); }
	elsif ($x == 0) { return ($y == 0) ? 'a' : (($y == $h-1) ? 'c' : 'L'); }
	else		{ return ($y == 0) ? 'T' : (($y == $h-1) ? 'B' : 'M'); }
}

sub splpr {
	print "+", '-' x $w, "+\n";
	foreach my $l (0 .. $h-1) {
		print "|", join('', @_[$l*$w .. ($l+1)*$w-1]), "|\n";
	}
	print "+", '-' x $w, "+\n";
}

# traverse
my $start = int $qty / 2;
my $pos = $start;
my @state = (0) x $qty;
foreach my $step (get_steps $hash) {
	$state[$pos]++; # visit cell
	$pos += $guide{cell_type($pos)}{$step}; # move to next cell
}
# mark start and finish
$state[$start] = -2;
$state[$pos] = -1;
# print result
my @symb = split '', ' .o+=*BOX@%&#/^SE';
splpr(map { $symb[$_] } @state);