File Coverage

blib/lib/Games/ABC_Path/Generator/RiddleObj.pm
Criterion Covered Total %
statement 64 68 94.1
branch 20 22 90.9
condition n/a
subroutine 15 16 93.7
pod 4 4 100.0
total 103 110 93.6


line stmt bran cond sub pod time code
1             package Games::ABC_Path::Generator::RiddleObj;
2             $Games::ABC_Path::Generator::RiddleObj::VERSION = '0.6.0';
3 2     2   42 use 5.006;
  2         7  
4              
5 2     2   11 use strict;
  2         4  
  2         50  
6 2     2   43 use warnings;
  2         6  
  2         73  
7              
8 2     2   10 use Carp;
  2         4  
  2         150  
9              
10 2     2   14 use integer;
  2         4  
  2         11  
11              
12 2     2   62 use parent 'Games::ABC_Path::Solver::Base';
  2         5  
  2         11  
13              
14 2     2   133 use Games::ABC_Path::Solver::Constants;
  2         5  
  2         1870  
15              
16              
17             sub _solution
18             {
19 2     2   5 my $self = shift;
20              
21 2 100       8 if (@_)
22             {
23 1         13 $self->{_solution} = shift;
24             }
25              
26 2         7 return $self->{_solution};
27             }
28              
29             sub _clues
30             {
31 7     7   20 my $self = shift;
32              
33 7 100       22 if (@_)
34             {
35 1         3 $self->{_clues} = shift;
36             }
37              
38 7         20 return $self->{_clues};
39             }
40              
41             sub _A_pos
42             {
43 5     5   21 my $self = shift;
44              
45 5 100       13 if (@_)
46             {
47 1         2 $self->{_A_pos} = shift;
48             }
49              
50 5         16 return $self->{_A_pos};
51             }
52              
53             sub _init
54             {
55 1     1   40 my $self = shift;
56 1         2 my $args = shift;
57              
58 1         5 $self->_solution( $args->{solution} );
59 1         5 $self->_clues( $args->{clues} );
60 1         3 $self->_A_pos( $args->{A_pos} );
61              
62 1         3 return;
63             }
64              
65              
66             sub get_letters_of_clue
67             {
68 4     4 1 12 my ( $self, $args ) = @_;
69              
70             my $get_index = sub {
71 2     2   4 my $i = $args->{index};
72              
73 2 50       14 if ( $i !~ m{\A[01234]\z} )
74             {
75 0         0 Carp::confess('index must be in the range 0-4');
76             }
77              
78 2         6 return $i;
79 4         19 };
80              
81 4         9 my $clue_idx;
82 4         9 my $type = $args->{type};
83              
84 4 100       19 if ( $type eq 'col' )
    100          
    100          
    50          
85             {
86 1         5 $clue_idx = 2 + $LEN + $get_index->();
87             }
88             elsif ( $type eq 'row' )
89             {
90 1         3 $clue_idx = 2 + $get_index->();
91             }
92             elsif ( $type eq 'diag' )
93             {
94 1         3 $clue_idx = 0;
95             }
96             elsif ( $type eq 'antidiag' )
97             {
98 1         3 $clue_idx = 1;
99             }
100             else
101             {
102 0         0 Carp::confess("Unknown type $type.");
103             }
104              
105 4         8 return [ map { $letters[ $_ - 1 ] } @{ $self->_clues->[$clue_idx] } ];
  8         47  
  4         9  
106             }
107              
108              
109             sub get_riddle_v1_string
110             {
111 2     2 1 549 my ($self) = @_;
112              
113 2         9 my $s = ( ( ' ' x 7 ) . "\n" ) x 7;
114              
115 2         7 substr( $s, ( $self->_A_pos->y + 1 ) * 8 + $self->_A_pos->x + 1, 1 ) = 'A';
116              
117 2         18 my $clues = $self->_clues();
118 2         8 foreach my $clue_idx ( 0 .. $NUM_CLUES - 1 )
119             {
120 24 100       79 my @pos =
    100          
    100          
121             ( $clue_idx == 0 ) ? ( [ 0, 0 ], [ 6, 6 ] )
122             : ( $clue_idx == 1 ) ? ( [ 0, 6 ], [ 6, 0 ] )
123             : ( $clue_idx < ( 2 + 5 ) )
124             ? ( [ 1 + $clue_idx - (2), 0 ], [ 1 + $clue_idx - (2), 6 ] )
125             : (
126             [ 0, 1 + $clue_idx - ( 2 + 5 ) ],
127             [ 6, 1 + $clue_idx - ( 2 + 5 ) ]
128             );
129              
130 24         46 foreach my $i ( 0 .. 1 )
131             {
132 48         114 substr( $s, $pos[$i][0] * 8 + $pos[$i][1], 1 ) =
133             $letters[ $clues->[$clue_idx]->[$i] - 1 ];
134             }
135             }
136              
137 2         11 return $s;
138             }
139              
140              
141             sub get_final_layout
142             {
143 1     1 1 4 my ($self) = @_;
144              
145 1         5 return $self->_solution;
146             }
147              
148              
149             sub get_final_layout_as_string
150             {
151 0     0 1   my ( $self, $args ) = @_;
152              
153 0           return $self->_solution->as_string($args);
154             }
155              
156              
157             1; # End of Games::ABC_Path::Generator
158              
159             __END__