File Coverage

blib/lib/Game/Cribbage.pm
Criterion Covered Total %
statement 109 358 30.4
branch 30 108 27.7
condition 9 33 27.2
subroutine 16 30 53.3
pod 28 28 100.0
total 192 557 34.4


line stmt bran cond sub pod time code
1             package Game::Cribbage;
2              
3             our $VERSION = "0.13";
4              
5 2     2   170050 use Object::Proto::Sugar -types;
  2         23896  
  2         8  
6 2     2   2518 use Game::Cribbage::Board;
  2         21  
  2         109  
7              
8             has board => (
9             is => 'rw',
10             isa => Object
11             );
12              
13             has [qw/dealer crib_set/] => (
14             is => 'rw',
15             isa => Bool,
16             default => 0
17             );
18              
19             has starter_card => (
20             is => 'rw'
21             );
22              
23             sub start {
24 0     0 1 0 my ($self, %params) = @_;
25              
26 0         0 $self->clear_screen;
27              
28 0         0 $self->print_header("Welcome to terminal Cribbage");
29              
30 0         0 $self->print_footer("Insert name: ");
31              
32 0         0 my $name = ;
33              
34 0         0 chomp($name);
35              
36 0         0 my $board = Game::Cribbage::Board->new();
37              
38 0         0 $board->add_player(name => 'Bot');
39 0         0 $board->add_player(name => $name);
40              
41 0         0 $board->start_game();
42              
43 0         0 $self->board($board);
44              
45 0         0 $self->init_game();
46             }
47              
48             sub init_game {
49 0     0 1 0 my ($self) = @_;
50              
51 0         0 $self->clear_screen;
52              
53 0         0 $self->reset_cursor();
54              
55 0         0 $self->split_cards();
56              
57 0         0 $self->init_draw();
58             }
59              
60             sub init_draw {
61 0     0 1 0 my ($self, $switch) = @_;
62              
63 0         0 $self->crib_set(0);
64 0         0 $self->starter_card(undef);
65 0 0       0 $self->dealer(!$self->dealer) if $switch;
66              
67 0         0 my $winner;
68 0 0       0 if ($self->board->score->player1->{current} > 120) {
    0          
69 0         0 $winner = 'player1';
70             } elsif ($self->board->score->player2->{current} > 120) {
71 0         0 $winner = 'player2';
72             }
73 0 0       0 return $self->winner($winner) if $winner;
74              
75 0         0 $self->draw_cards();
76              
77 0         0 $self->discard_cards();
78              
79 0         0 $self->starter();
80              
81 0         0 while (!$winner) {
82 0         0 $self->clear_screen();
83              
84 0         0 $self->print_header(q|It is your turn to play a card, type go if you're unable to play.|);
85              
86 0         0 my $ok = eval { $self->play_hand(); };
  0         0  
87              
88 0 0       0 unless ($@) {
89 0 0       0 if ($self->board->score->player1->{current} > 120) {
    0          
90 0         0 $winner = 'player1';
91 0         0 next;
92             } elsif ($self->board->score->player2->{current} > 120) {
93 0         0 $winner = 'player2';
94 0         0 next;
95             }
96              
97              
98 0         0 my $hands = $self->board->get_hands;
99 0 0       0 unless (grep { !$_->used } @{$hands->player2->cards}, @{$hands->player1->cards}) {
  0         0  
  0         0  
  0         0  
100 0         0 eval {
101 0         0 $self->end_hands();
102             };
103 0         0 return $self->init_draw(1);
104             }
105              
106 0 0       0 if ($self->board->no_player_can_play) {
107 0         0 eval { $self->board->next_play(); };
  0         0  
108             }
109             }
110             }
111 0         0 $self->winner($winner);
112             }
113              
114             sub end_hands {
115 0     0 1 0 my ($self) = @_;
116              
117 0         0 $self->board->end_play();
118            
119 0         0 my $hands = $self->board->get_hands;
120              
121 0         0 $self->board->end_hands();
122              
123 0         0 $self->crib_set(0);
124              
125 0         0 $self->clear_screen();
126              
127 0         0 my $last = $self->board->last_round_hands();
128 0         0 my $player1_score = $last->player1->score->total_score;
129 0         0 my $player2_score = $last->player2->score->total_score;
130 0 0       0 my $crib_player = $self->dealer ? $self->board->players->[-1]->name : 'Bot';
131 0 0       0 my $player = $self->dealer ? 'player2' : 'player1';
132 0         0 my $crib_score = $last->$player->crib_score->total_score;
133              
134 0         0 $self->print_header(sprintf "Bot scored: %s - %s scored: %s - %s crib scored: %s",
135             $player1_score,
136             $self->board->players->[-1]->name,
137             $player2_score,
138             $crib_player,
139             $crib_score
140             );
141              
142 0         0 $self->draw_scores();
143              
144 0         0 $self->render_player_cards($hands->player1->cards, 3, 20, 1);
145              
146 0         0 $crib_player = $hands->crib_player;
147 0         0 $self->render_player_cards($hands->$crib_player->crib, 15, 20, 1);
148              
149 0         0 $self->render_player_cards($hands->player2->cards, 26, 20, 1);
150              
151 0         0 $self->print_footer(q|Press enter to continue|);
152              
153            
154 0         0 }
155              
156             sub play_hand {
157 0     0 1 0 my ($self) = @_;
158              
159 0         0 my $hands = $self->board->get_hands;
160 0 0       0 if ($self->board->next_to_play->player eq 'player1') {
161 0         0 my $card = $self->board->best_run_play('player1');
162 0 0 0     0 if ($card->can('go') && $card->go) {
163 0         0 $self->board->cannot_play('player1');
164 0         0 $self->draw_go(6, 2);
165             } else {
166 0         0 $self->board->play_card('player1', $card);
167 0 0       0 if ($self->board->current_play_score == 31) {
168 0         0 $self->board->next_play();
169 0         0 return;
170             }
171              
172 0 0       0 if ($self->board->score->player1->{current} > 120) {
173 0         0 return;
174             }
175             }
176             }
177              
178 0 0       0 if ($self->board->player_cannot_play('player2')) {
179 0 0       0 if (!$self->board->player_cannot_play('player1')) {
180 0         0 $self->board->set_next_to_play('player1');
181             }
182 0         0 return;
183             }
184              
185 0         0 $_[0]->draw_scores();
186              
187 0         0 $self->render_opponent_cards(scalar grep { !$_->used } @{$hands->player1->cards});
  0         0  
  0         0  
188              
189 0         0 $self->render_run_play();
190              
191 0         0 $self->render_player_cards($hands->player2->cards, 26, 20);
192              
193 0         0 $self->print_footer(q|Pick a card: |);
194              
195 0         0 my $number = ;
196              
197 0         0 chomp($number);
198              
199 0 0       0 if ($number =~ m/go/i) {
200 0         0 my @can = $self->board->cannot_play('player2');
201 0 0 0     0 if (scalar @can && ref $can[0]) {
202 0         0 return;
203             }
204 0         0 $self->draw_go(30);
205 0         0 return;
206             }
207              
208 0 0       0 if ($number eq 'b') {
209 0         0 my $card = $self->board->best_run_play('player2');
210 0 0 0     0 if ($card->can('go') && $card->go) {
211 0         0 $self->board->cannot_play('player2');
212 0         0 $self->draw_go(6, 2);
213             } else {
214 0         0 $self->board->play_card('player2', $card);
215 0 0       0 if ($self->board->current_play_score == 31) {
216 0         0 $self->board->next_play();
217             }
218             }
219 0         0 return;
220             }
221            
222 0 0 0     0 if ($number !~ m/^\d+$/ || $number > scalar @{$hands->player2->cards}) {
  0         0  
223 0         0 return;
224             }
225              
226 0         0 my $card = $self->board->get_card('player2', $number - 1);
227 0         0 $self->board->play_card('player2', $card);
228              
229 0 0       0 if ($self->board->current_play_score == 31) {
230 0         0 $self->board->next_play();
231             }
232              
233 0         0 return 1;
234             }
235              
236             sub split_cards {
237 0     0 1 0 my ($self) = @_;
238              
239 0         0 $self->print_header(q|Split cards lowest goes first|);
240              
241 0         0 $self->show_face_down_split(52);
242            
243 0         0 $self->print_footer(q|Pick a number: |);
244              
245 0         0 my $number = ;
246            
247 0 0 0     0 if ($number !~ m/^\d+$/ || $number > 52) {
248 0         0 $self->clear_screen();
249 0         0 $self->split_cards();
250 0         0 return;
251             }
252              
253 0         0 my $low = $self->board->deck->get($number - 1);
254              
255 0         0 my $rand = int(rand(52));
256            
257 0         0 while ($number == $rand) {
258 0         0 $rand = int(rand(52));
259             }
260              
261 0         0 my $bot = $self->board->deck->get($rand - 1);
262              
263 0         0 $self->clear_screen();
264              
265 0 0       0 my $dealer = $low->value < $bot->value ? 1 : 0;
266              
267 0 0       0 $self->print_header(q|Low cards picked, | . ($dealer ? "you are the dealer" : "they are the dealer"));
268              
269 0         0 $self->render_card($bot, 2, 45);
270              
271 0         0 $self->render_card($low, 27, 45);
272              
273 0 0       0 $self->board->set_crib_player($dealer ? 'player2' : 'player1');
274              
275 0         0 $self->print_footer(q|Press enter to continue|);
276              
277 0         0 $self->dealer($dealer);
278              
279            
280 0         0 }
281              
282             sub draw_cards {
283 1     1 1 9 my ($self) = @_;
284              
285 1         4 $self->board->draw_hands();
286             }
287              
288             sub discard_cards {
289 0     0 1 0 my ($self) = @_;
290            
291 0         0 $self->clear_screen();
292              
293 0         0 $self->print_header(q|Discard two cards to the crib, seperate the indexes with a space.|);
294              
295 0         0 my $hands = $self->board->get_hands;
296              
297 0         0 $self->render_opponent_cards(6);
298              
299 0         0 $self->render_player_cards($hands->player2->cards, 26, 5);
300              
301 0         0 $self->print_footer(q|Discard cards: |);
302              
303 0         0 my $cards_index = ;
304              
305 0         0 chomp($cards_index);
306            
307 0         0 my @cards;
308 0 0       0 if ($cards_index =~ m/b/i) {
309 0         0 my @worst = $self->board->identify_worst_cards('player2');
310 0         0 @cards = @{$worst[0]};
  0         0  
311             } else {
312             @cards = map {
313 0         0 $self->board->get_card('player2', $_ - 1);
314 0 0       0 } grep { $_ =~ m/^\d+$/ && $_ <= 6 } split " ", $cards_index;
  0         0  
315             }
316              
317 0 0       0 unless (scalar @cards == 2) {
318 0         0 $self->discard_cards();
319 0         0 return;
320             }
321              
322 0         0 $self->board->crib_player_cards('player2', \@cards);
323              
324 0         0 my @bot = $self->board->identify_worst_cards('player1');
325              
326 0         0 $self->board->crib_player_cards('player1', $bot[0]);
327              
328 0         0 $self->crib_set(1);
329             }
330              
331             sub starter {
332 0     0 1 0 my ($self) = @_;
333              
334 0         0 $self->clear_screen();
335              
336 0         0 my $count = scalar @{$self->board->deck->deck};
  0         0  
337 0 0       0 if ($self->dealer) {
338 0         0 my $card = $self->board->deck->get(int(rand(39)));
339 0         0 $self->starter_card($card);
340 0         0 $self->board->add_starter_card('player1', $card);
341 0         0 return;
342             }
343              
344 0         0 $self->print_header(q|Split deck for starter card.|);
345            
346 0         0 $self->show_face_down_split(40, 13);
347              
348 0         0 $self->print_footer(q|Split deck: |);
349              
350 0         0 my $number = ;
351            
352 0         0 chomp($number);
353            
354 0 0 0     0 if ($number !~ m/^\d+$/ || $number > 52) {
355 0         0 $self->clear_screen();
356 0         0 $self->starter();
357 0         0 return;
358             }
359              
360 0         0 my $card = $self->board->deck->get($number);
361 0         0 $self->starter_card($card);
362 0         0 my $scored = $self->board->add_starter_card('player2', $card);
363 0         0 return;
364             }
365              
366             sub render_card {
367 23     23 1 147 my ($self, $card, $row, $col) = @_;
368              
369 23         35 $self->set_cursor_vertical($row);
370 23         39 $self->set_cursor_horizontal($col);
371 23 100       75 my $color = $card->suit =~ m/H|D/ ? 91 : 90;
372            
373 23         43 my %suits = (
374             H => '♥',
375             D => '♦',
376             C => '♣',
377             S => '♠'
378             );
379              
380             my @card = (
381             "┌─────────┐",
382             sprintf("│%s. . . .│", $card->symbol =~ m/10/ ? $card->symbol : $card->symbol . " "),
383             "│. . . . .│",
384             "│. . . . .│",
385 23 100       139 sprintf("│. . %s . .│", $suits{$card->suit}),
    100          
386             "│. . . . .│",
387             "│. . . . .│",
388             sprintf("│. . . .%s│", $card->symbol =~ m/10/ ? $card->symbol : " " . $card->symbol),
389             "└─────────┘"
390             );
391              
392 23         59 for (@card) {
393 207         266 $self->say($_, 1, 0, $color);
394 207         206 $self->set_cursor_horizontal($col);
395             }
396             }
397              
398              
399             sub render_opponent_cards {
400 2     2 1 278 my ($self, $num) = @_;
401              
402 2 100       5 return unless $num;
403              
404 1         3 $self->set_cursor_vertical(2);
405 1         36 $self->set_cursor_horizontal((100 - ($num * 4)) / 2);
406              
407 1         3 my $string = "┌──" x ($num - 1);
408 1         3 $self->say($string);
409 1         2 $self->say("┌─────────┐", 1, 1);
410 1         3 $self->set_cursor_horizontal((100 - ($num * 4)) / 2);
411 1         3 for (0..6) {
412 7         9 $string = "│. " x ($num - 1);
413 7         11 $self->say($string);
414 7         10 $self->say("│. . . . .│", 1, 1);
415 7         9 $self->set_cursor_horizontal((100 - ($num * 4)) / 2);
416             }
417 1         3 $string = "└──" x ($num - 1);
418 1         2 $self->say($string);
419 1         2 $self->say("└─────────┘", 1, 1);
420             }
421              
422             sub render_player_cards {
423 2     2 1 22 my ($self, $cards, $top, $left, $all) = @_;
424 2         2 my $i = 1;
425 2         3 for (@{$cards}) {
  2         3  
426 6 100 100     35 if (!$all && $_->used) {
427 1         2 $i++;
428 1         2 next;
429             }
430 5         6 $left += 11;
431 5         9 $self->set_cursor_vertical($top);
432 5         9 $self->set_cursor_horizontal($left + 5);
433 5         9 $self->say($i++);
434 5         8 $self->render_card($_, $top + 1, $left);
435             }
436             }
437              
438             sub render_run_play {
439 2     2 1 29 my ($self) = @_;
440              
441 2         8 my $cards = $self->board->current_play->cards;
442              
443 2 100       2 return unless (scalar @{$cards});
  2         10  
444              
445 1         1 my $left = 25;
446 1         2 for (@{$cards}) {
  1         2  
447 1         4 $self->render_card($_->card, 15, $left);
448 1         2 $left += 10;
449             }
450             }
451              
452              
453             sub show_face_down_split {
454 0     0 1 0 my ($self, $num, $vertical) = @_;
455              
456 0   0     0 $self->set_cursor_vertical($vertical || 10);
457              
458 0         0 my $width = ($num / 2) - 1;
459              
460 0         0 for my $it (0 .. 1) {
461 0         0 my $string = "┌──" x $width;
462 0         0 $self->say($string);
463 0         0 $self->say("┌─────────┐", 1, 1);
464 0         0 $string = "";
465 0         0 for (1 .. $width) {
466 0 0       0 my $v = $it ? 26 + $_ : $_;
467 0 0 0     0 $string .= sprintf("│%s", (!$it && $_ < 10 ? "$v " : $v));
468             }
469 0         0 $self->say($string);
470 0 0       0 $self->say(sprintf("│%s. . . .│", $it ? ($width + 1) * 2 : $width + 1), 1, 1);
471 0         0 for (0..4) {
472 0         0 $string = "│. " x $width;
473 0         0 $self->say($string);
474 0         0 $self->say("│. . . . .│", 1, 1);
475             }
476 0         0 $string = "│. " x $width;
477 0         0 $self->say($string);
478 0 0       0 $self->say(sprintf("│. . . .%s│", $it ? ($width + 1) * 2 : $width + 1), 1, 1);
479 0         0 my $string = "└──" x $width;
480 0         0 $self->say($string);
481 0         0 $self->say("└─────────┘", 1, 1);
482             }
483             }
484              
485             sub draw_background {
486 0     0 1 0 for (0 .. 35) {
487 0         0 print "\e[102;1m";
488 0         0 print pack("A100", " ");
489 0         0 print "\n";
490 0         0 print "\e[0";
491             }
492 0         0 $_[0]->draw_dealer();
493             #$_[0]->draw_scores();
494 0         0 $_[0]->draw_crib();
495 0         0 $_[0]->draw_starter();
496 0         0 $_[0]->reset_cursor();
497             }
498              
499             sub draw_starter {
500 2     2 1 211 my ($self) = @_;
501              
502 2 100       9 return unless $self->starter_card;
503              
504 1         6 $self->render_card($self->starter_card, 15, 2);
505             }
506              
507              
508             sub draw_crib {
509 3     3 1 270 my ($self) = shift;
510 3         7 my $dealer = $self->dealer;
511 3 50       5 return unless defined $dealer;
512 3 100       8 return unless $self->crib_set;
513 2         6 my @card = (
514             "┌─────────┐",
515             "│. . . . .│",
516             "│. . . . .│",
517             "│. . . . .│",
518             "│. . . . .│",
519             "│. . . . .│",
520             "│. . . . .│",
521             "│. . . . .│",
522             "└─────────┘"
523             );
524              
525 2 100       4 if ($dealer) {
526 1         2 $self->set_cursor_vertical(27);
527             } else {
528 1         3 $self->set_cursor_vertical(3);
529             }
530              
531 2         3 for (@card) {
532 18         23 $self->set_cursor_horizontal(10);
533 18         20 $self->say($_, 1, 0);
534             }
535             }
536              
537             sub draw_go {
538 1     1 1 205 my ($self, $top, $left) = @_;
539 1         3 my $message = ' GO ';
540 1         3 $self->set_cursor_vertical($top);
541 1         3 $self->say($message, 0, 0, 31, 40);
542             }
543              
544              
545             sub draw_dealer {
546 3     3 1 661 my ($self) = @_;
547            
548 3         7 my $dealer = $self->dealer;
549              
550 3 50       6 return unless defined $dealer;
551 3         3 my $message = ' Dealer ';
552 3 100       6 if ($dealer) {
553 1         4 $self->set_cursor_vertical(34);
554 1         2 $self->say($message, 0, 0, 31, 40);
555             } else {
556 2         5 $self->set_cursor_vertical(3);
557 2         5 $self->say($message, 0, 0, 31, 40);
558             }
559             }
560              
561             sub draw_scores {
562 3     3 1 283 my ($self) = @_;
563 3         4 my $message;
564 3 100       9 return unless $self->board;
565 2 100 66     10 if ($self->board && $self->board->current_play_score) {
566 1         28 $message = pack("A2", $self->board->current_play_score);
567 1         3 $self->set_cursor_vertical(14);
568 1         2 $self->set_cursor_horizontal(49);
569 1         2 $self->say($message, 0, 0, 31, 40);
570             }
571 2         10 $message = ' Score: ' . $self->board->score->player2->{current} . ' ';
572 2         3 $self->set_cursor_vertical(34);
573 2         4 $self->set_cursor_horizontal(100 - (length($message) + 1));
574 2         5 $self->say($message, 0, 0, 31, 40);
575 2         3 $message = ' Score: ' . $self->board->score->player1->{current} . ' ';
576 2         3 $self->set_cursor_vertical(3);
577 2         5 $self->set_cursor_horizontal(100 - (length($message) + 1));
578 2         3 $self->say($message, 0, 0, 31, 40);
579             }
580              
581             sub winner {
582 0     0 1 0 print "\e[0m\e[2J\e[0;1H";
583 0         0 for (0 .. 35) {
584 0         0 print "\e[102;1m";
585 0         0 print pack("A100", " ");
586 0         0 print "\n";
587 0         0 print "\e[0";
588             }
589 0         0 $_[0]->set_cursor_vertical(17);
590 0         0 my $player = $_[0]->board->players->[1];
591 0 0       0 $_[0]->say($_[1] eq 'player2'
592             ? sprintf(q|Congratualations %s, you won the game!|, $player->name)
593             : sprintf(q|Unlucky %s, you lost this time!|, $player->name)
594             );
595            
596 0         0 }
597              
598              
599             sub clear_screen {
600 0     0 1 0 print "\e[0m\e[2J\e[0;1H";
601 0         0 $_[0]->draw_background();
602             }
603              
604             sub reset_cursor {
605 1     1 1 531 print "\e[;2H";
606             }
607              
608             sub set_cursor_vertical {
609 41     41 1 286 print "\e[$_[1];2H";
610             }
611              
612             sub set_cursor_horizontal {
613 278     278 1 604 print "\e[$_[1]G";
614             }
615              
616             sub say {
617 259     259 1 728 my ($self, $msg, $nl, $indent, $color, $back) = @_;
618 259   100     351 $color ||= 90;
619 259   100     528 $back ||= 102;
620 259         293 print "\e[$color;1;1m\e[$back;1m";
621 259         229 print $msg;
622 259 100       297 print "\n" if $nl;
623 259 100       366 $self->set_cursor_horizontal(2) if $indent;
624 259         224 print "\e[0";
625 259         245 1;
626             }
627              
628             sub print_header {
629 0     0 1   my ($self, $message) = @_;
630 0           $self->set_cursor_vertical(0);
631 0           $self->set_cursor_horizontal(0);
632 0           print "\e[40;1m";
633 0           print pack("A100", " ");
634 0           $self->set_cursor_horizontal(2);
635 0           $self->say($message, 0, 0, 31, 40);
636             }
637              
638             sub print_footer {
639 0     0 1   my ($self, $message) = @_;
640 0           $self->set_cursor_vertical(36);
641 0           $self->set_cursor_horizontal(0);
642 0           print "\e[40;1m";
643 0           print pack("A100", " ");
644 0           $self->set_cursor_horizontal(2);
645 0           $self->say($message, 0, 0, 31, 40);
646 0           $self->set_cursor_horizontal(length($message) + 2);
647             }
648              
649              
650             1;
651              
652             __END__