File Coverage

lib/Games/Checkers/LocationConversions.pm
Criterion Covered Total %
statement 12 28 42.8
branch 0 6 0.0
condition n/a
subroutine 4 10 40.0
pod 0 6 0.0
total 16 50 32.0


line stmt bran cond sub pod time code
1             # Games::Checkers, Copyright (C) 1996-2012 Mikhael Goikhman, migo@cpan.org
2             #
3             # This program is free software: you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation, either version 3 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16 1     1   4 use strict;
  1         1  
  1         27  
17 1     1   4 use warnings;
  1         1  
  1         393  
18              
19             package Games::Checkers::LocationConversions;
20              
21             sub location_to_arr ($) {
22 0     0 0   my ($loc) = @_;
23 0           return (int($loc % 4) * 2 + int(($loc / 4) % 2) + 1, int($loc / 4) + 1);
24             }
25              
26             sub arr_to_location ($$) {
27 0     0 0   my ($x, $y) = @_;
28 0           return int((($x - 1) % 8) / 2) + ($y - 1) * 4;
29             }
30              
31             sub location_to_str ($) {
32 0     0 0   my ($loc) = @_;
33 0           my @c = location_to_arr($loc);
34 0           return chr(ord('a') + $c[0] - 1) . $c[1];
35             }
36              
37             sub str_to_location ($) {
38 0     0 0   my ($str) = @_;
39 0 0         $str =~ /^(\w)(\d)$/ || die "Invalid board coordinate string ($str)\n";
40 0           return arr_to_location(ord($1) - ord('a') + 1, $2);
41             }
42              
43             sub location_to_num ($) {
44 0     0 0   my ($loc) = @_;
45 0 0         return 32 - $loc if $ENV{ITALIAN_BOARD_NOTATION};
46 0           return (int($loc / 4)) * 4 + 4 - $loc % 4;
47             }
48              
49             sub num_to_location ($) {
50 0     0 0   my ($num) = @_;
51 0 0         return 32 - $num if $ENV{ITALIAN_BOARD_NOTATION};
52 0           return (int(($num - 1) / 4)) * 4 + 3 - ($num - 1) % 4;
53             }
54              
55 1     1   5 use base 'Exporter';
  1         2  
  1         85  
56 1     1   5 use vars qw(@EXPORT);
  1         2  
  1         59  
57             @EXPORT = qw(
58             location_to_arr arr_to_location
59             location_to_str str_to_location
60             location_to_num num_to_location
61             );
62              
63             1;