File Coverage

blib/lib/Games/Bowling/Scorecard/AsASCII.pm
Criterion Covered Total %
statement 42 42 100.0
branch 38 38 100.0
condition 10 10 100.0
subroutine 6 6 100.0
pod 1 1 100.0
total 97 97 100.0


line stmt bran cond sub pod time code
1 1     1   1085 use v5.24.0;
  1         4  
2 1     1   6 use warnings;
  1         2  
  1         46  
3             package Games::Bowling::Scorecard::AsASCII 0.106;
4             # ABSTRACT: format a bowling scorecard as ASCII text
5              
6             #pod =head1 SYNOPSIS
7             #pod
8             #pod use Games::Bowling::Scorecard;
9             #pod
10             #pod my $card = Games::Bowling::Scorecard->new;
11             #pod
12             #pod $card->record(6,1); # slow start
13             #pod $card->record(7,2); # getting better
14             #pod $card->record(10); # strike!
15             #pod $card->record(9,1); # picked up a spare
16             #pod $card->record(10) for 1 .. 3; # turkey!
17             #pod $card->record(0,0); # clearly distracted by something
18             #pod $card->record(8,2); # amazingly picked up 7-10 split
19             #pod $card->record(10, 9, 1); # pick up a bonus spare
20             #pod
21             #pod print Games::Bowling::Scorecard::AsText->card_as_text($card);
22             #pod
23             #pod The above outputs:
24             #pod
25             #pod +-----+-----+-----+-----+-----+-----+-----+-----+-----+-------+
26             #pod | 6 1 | 7 2 | X | 9 / | X | X | X | - - | 8 / | X 9 / |
27             #pod | 7 | 16 | 36 | 56 | 86 | 106 | 116 | 116 | 136 | 156 |
28             #pod
29             #pod =head1 WARNING
30             #pod
31             #pod This module's interface is almost certain to change, whenever the author gets
32             #pod around to it.
33             #pod
34             #pod =head1 DESCRIPTION
35             #pod
36             #pod So, you've written a bowling record-keeper and now you want to print out
37             #pod scorecards to your dynamic Gopher site. Games::Bowling::Scorecard has taken
38             #pod care of the scoring, but now you need to worry about all those slashes and
39             #pod dashes and X's
40             #pod
41             #pod =method card_as_text
42             #pod
43             #pod my $text = Games::Bowling::Scorecard::AsText->card_as_text($card);
44             #pod
45             #pod Given a scorecard, this method returns a three-line text version of the card,
46             #pod using standard notation. A total is kept only through the last non-pending
47             #pod frame.
48             #pod
49             #pod =cut
50              
51 1     1   5 use Carp ();
  1         2  
  1         540  
52              
53             sub card_as_text {
54 4     4 1 39 my ($self, $card) = @_;
55              
56 4         7 my $hdr = '+-----+-----+-----+-----+-----+-----+-----+-----+-----+-------+';
57 4         7 my $balls = '';
58 4         7 my $scores = '';
59              
60 4         8 my @frames = $card->frames;
61 4         12 INDEX: for my $i (0 .. 8) {
62 36         90 my $frame = $frames[ $i ];
63 36 100       71 unless ($frame) {
64 5         11 $_ .= '| ' for $balls, $scores;
65 5         10 next INDEX;
66             }
67              
68 31         69 $balls .= sprintf '| %s ', $self->_two_balls($frame->balls);
69              
70 31         86 my $score = $card->score_through($i + 1);
71 31 100       89 $scores .= defined $score
72             ? sprintf '| %3u ', $score
73             : '| ';
74             }
75              
76 4         9 TENTH: for (1) {
77 4         6 my $frame = $frames[ 9 ];
78              
79 4 100       17 unless ($frame) {
80 1         4 $_ .= '| |' for $balls, $scores;
81 1         2 last TENTH;
82             }
83              
84 3         8 $balls .= sprintf '| %s |', $self->_three_balls($frame->balls);
85              
86 3         17 my $score = $card->score_through(10);
87              
88 3 100       11 $scores .= defined $score
89             ? sprintf '| %3u |', $score
90             : '| |';
91             }
92              
93 4         31 return "$hdr\n"
94             . "$balls\n"
95             . "$scores\n";
96             }
97              
98             sub _two_balls {
99 54     54   5310 my ($self, $b1, $b2) = @_;
100              
101 54 100       113 return ' ' unless defined $b1;
102              
103 53 100 100     363 sprintf '%s %s',
    100 100        
    100          
    100          
104             $b1 == 10 ? 'X' : $b1 || '-',
105             $b1 == 10 ? ' ' : defined $b2 ? $b1 + $b2 == 10 ? '/' : $b2 || '-' : ' ';
106             }
107              
108             sub _three_balls {
109 22     22   9711 my ($self, $b1, $b2, $b3) = @_;
110              
111 22 100       62 return ' ' unless defined $b1;
112              
113 21 100       61 if ($b1 == 10) {
    100          
    100          
114 12 100       32 return 'X ' unless defined $b2;
115              
116 10 100 100     52 return sprintf 'X X %s', defined $b3 ? $b3 == 10 ? 'X' : $b3 || '-' : ' '
    100          
    100          
117             if $b2 == 10;
118              
119 6         16 return sprintf 'X %s', $self->_two_balls($b2, $b3);
120             } elsif (not defined $b2) {
121 2   100     17 return sprintf '%s ', $b1 || '-';
122             } elsif ($b1 + $b2 == 10) {
123 4 100 100     25 return sprintf '%s %s',
    100          
124             $self->_two_balls($b1, $b2),
125             defined $b3 ? $b3 == 10 ? 'X' : $b3 || '-' : ' ';
126             } else {
127 3         16 return sprintf '%s ', $self->_two_balls($b1, $b2);
128             }
129             }
130              
131             300;
132              
133             __END__