File Coverage

blib/lib/Compass/Points.pm

Criterion	Covered	Total	%
statement	25	26	96.1
branch	3	4	75.0
condition	5	6	83.3
subroutine	6	6	100.0
pod	1	1	100.0
total	40	43	93.0

package Compass::Points;

use strict;
use warnings;

our $VERSION = "0.02";

our @FIELDS = qw( abbr name );
our @NAMES = (
        [ N	=> "North"		],
        [ NbE	=> "North by east"	],
        [ NNE	=> "North-northeast"	],
        [ NEbN	=> "Northeast by north"	],
        [ NE	=> "Northeast"		],
        [ NEbE	=> "Northeast by east"	],
        [ ENE	=> "East-northeast"	],
        [ EbN	=> "East by north"	],
        [ E	=> "East"		],
        [ EbS	=> "East by south"	],
        [ ESE	=> "East-southeast"	],
        [ SEbE	=> "Southeast by east"	],
        [ SE	=> "Southeast"		],
        [ SEbS	=> "Southeast by south"	],
        [ SSE	=> "South-southeast"	],
        [ SbE	=> "South by east"	],
        [ S	=> "South"		],
        [ SbW	=> "South by west"	],
        [ SSW	=> "South-southwest"	],
        [ SWbS	=> "Southwest by south"	],
        [ SW	=> "Southwest"		],
        [ SWbW	=> "Southwest by west"	],
        [ WSW	=> "West-southwest"	],
        [ WbS	=> "West by south"	],
        [ W	=> "West"		],
        [ WbN	=> "West by north"	],
        [ WNW	=> "West-northwest"	],
        [ NWbW	=> "Northwest by west"	],
        [ NW	=> "Northwest"		],
        [ NWbN	=> "Northwest by north"	],
        [ NNW	=> "North-northwest"	],
        [ NbW	=> "North by west"	],
);
our @GROUP;	# separate groups to assign different degree values
our @INDEX;	# index per group
our @MAP;	# mapping for easy access

for my $n ( 0 .. 3 ) {
	my $slice = 360 / ( 2 ** ( 2 + $n ) );		# 90, 45, 22.5, 11.25
	my $mod = 2 ** ( 3 - $n );			# 8, 4, 2, 1
	my @offs = grep $_ % $mod == 0, 0 .. $#NAMES;	# 0,8,16,24 0,4,8,12,...

	$GROUP[ $n ] = bless( [], __PACKAGE__ );

	for my $m ( 0 .. $#offs ) {
		my @entry = @{ $NAMES[ $offs[ $m ] ] };

		for my $key ( map lc, @entry ) {
			$key =~ s![^a-z]!!g;

			$INDEX[ $n ]{ $key } = \@entry;
		}

		$entry[ 2 ] = $m * $slice;

		$GROUP[ $n ][ $m ] = \@entry;
	}

	$MAP[ $_ ] = $n for @MAP .. $#offs;
}

sub new
{
	my $class = shift;
	my $number = shift || 16;

	$number = @{ $GROUP[ $#GROUP ] }
		if $number > @{ $GROUP[ $#GROUP ] };

	return $GROUP[ $MAP[ $number - 1 ] ];
}

for my $offset ( 0 .. $#FIELDS ) {
	my $deg2sub = "deg2$FIELDS[ $offset ]";
	my $sub2deg = "$FIELDS[ $offset ]2deg";

	no strict qw( refs );

	*$deg2sub = sub {
		my $self = shift;
		my $deg = abs( shift || 0 );

		$deg -= 360 while $deg > 360;

		my $slice = 360 / @$self;
		my $index = ( $deg + $slice / 2 ) / $slice;

		return $self->[ $index ][ $offset ];
	};

	*$sub2deg = sub {
		my $self = shift;
		my $key = lc( shift || "" );
		my $index = $INDEX[ $MAP[ @$self - 1 ] ];

		$key =~ s![^a-z]!!g;

		return exists( $index->{ $key } )
			     ? $index->{ $key }[ 2 ]
		     	     : undef
		;
	};
}

1;

__END__