#!/usr/bin/perl -w
=head1 radius.pl
=head2 Usage:
radius.pl hex radius
=head2 Description:
Provides a list of hexes of each radius from hex of given radii.
This is performed by finding all hexes one hex away from the current
radius and removing any duplicates or hexes already in a lower radius.
=head2 Method:
1. Set the hexes for radius 0 to the specified hex.
2. Set the list of previously seen hexes to the specified hex.
3. For each radius from 1 to the requested radius:
a. For each hex in previous find hexes 1 hex away
b. If the hex is new, add it to the list of hexes for this radius and add it to the list of previously seen hexes.
=cut
use strict;
use warnings;
use utf8;
use Carp;
package main;
=head2 Functions:
formathex: shorthand to expand (x,y) to a 4 digit number xxyy
=cut
sub formathex {
my ( $x, $y ) = @_;
return sprintf( '%02d', $x ) . sprintf( '%02d', $y );
}
# *****************************************************************
# Read command line arguements
# *****************************************************************
if ( @ARGV < 2 ) { Carp::croak "Usage: radius.pl hex radius"; }
my $hex = shift @ARGV;
my $radius = shift @ARGV;
# *****************************************************************
# Main
# *****************************************************************
my @hexes = ();
$hexes[0] = [$hex];
my %previous = ( $hex => 1 );
for ( 1 .. $radius ) {
$hexes[$_] = [];
foreach my $currenthex ( @{ $hexes[ $_ - 1 ] } ) {
my ( $x, $y ) = ( 0, 0 );
if ( length $currenthex == 4 ) {
$x = substr( $currenthex, 0, 2 );
$y = substr( $currenthex, 2, 2 );
}
else {
( $x, $y ) = ( $currenthex =~ (/(\d+)\D(\d+)/) );
}
my @evenoffsets =
( [ 0, -1 ], [ 0, 1 ], [ -1, 0 ], [ 1, 0 ], [ 1, 1 ], [ -1, 1 ], );
my @oddoffsets =
( [ 0, -1 ], [ 0, 1 ], [ -1, -1 ], [ 1, -1 ], [ 1, 0 ], [ -1, 0 ], );
my @offsets = ();
if ( $x % 2 ) {
@offsets = @oddoffsets;
}
else {
@offsets = @evenoffsets;
}
foreach my $offsetpair (@offsets) {
my ( $xoff, $yoff ) = @{$offsetpair};
my $newhex = formathex( $x + $xoff, $y + $yoff );
if ( !exists( $previous{$newhex} ) ) {
push @{ $hexes[$_] }, $newhex;
$previous{$newhex} = 1;
}
}
@{ $hexes[$_] } = sort @{ $hexes[$_] };
}
}
# Print the tables of hexes and radii
for ( 0 .. $radius ) {
print "Radius: $_: Count: ", $#{ $hexes[$_] } + 1, ": @{$hexes[$_]}\n";
}
print "Radius $radius contains:\n";
my @sorted = sort keys %previous;
print "@sorted\n";
