File Coverage

blib/lib/Console/Blackjack.pm
Criterion Covered Total %
statement 23 558 4.1
branch 0 154 0.0
condition 0 75 0.0
subroutine 8 62 12.9
pod 0 54 0.0
total 31 903 3.4


line stmt bran cond sub pod time code
1             package Console::Blackjack;
2              
3 1     1   54921 use v5.20;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         20  
5 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         41  
6 1     1   459 use experimental qw(signatures);
  1         2858  
  1         5  
7              
8 1     1   648 use utf8;
  1         12  
  1         4  
9 1     1   458 use open ':std', ':encoding(UTF-8)';
  1         979  
  1         5  
10 1     1   10644 use Storable qw(dclone);
  1         3155  
  1         91  
11              
12             =head1 NAME
13              
14             Console::Blackjack - A console-based implementation of Blackjack
15              
16             =head1 VERSION
17              
18             Version 0.02
19              
20             =cut
21              
22             our $VERSION = '0.02';
23              
24             =head1 SYNOPSIS
25              
26             This module lets you play Blackjack in your console.
27              
28             console-blackjack.pl
29              
30             =cut
31              
32             =head1 AUTHOR
33              
34             Greg Donald, C<< >>
35              
36             =head1 BUGS
37              
38             Please report any bugs or feature requests at https://github.com/gdonald/console-blackjack-perl/issues.
39              
40             =head1 SUPPORT
41              
42             You can find documentation for this module with the perldoc command.
43              
44             perldoc Console::Blackjack
45              
46             You can also look for information at:
47              
48             =over 4
49              
50             =item * CPAN Ratings
51              
52             L
53              
54             =item * Search CPAN
55              
56             L
57              
58             =back
59              
60             =head1 LICENSE AND COPYRIGHT
61              
62             This software is Copyright (c) 2022 by Greg Donald.
63              
64             This is free software, licensed under:
65              
66             The Artistic License 2.0 (GPL Compatible)
67              
68             =cut
69              
70             use constant {
71 1         5914 SAVE_FILE => 'bj.txt',
72             CARDS_IN_DECK => 52,
73             MAX_DECKS => 8,
74             MAX_PLAYER_HANDS => 7,
75             MIN_BET => 500,
76             MAX_BET => 10000000,
77             HARD => 0,
78             SOFT => 1,
79             WON => 2,
80             LOST => 3,
81             PUSH => 4,
82             PLAYER => 0,
83             DEALER => 1
84 1     1   6 };
  1         2  
85              
86 0     0 0   sub is_ace ($card) {
  0            
  0            
87 0           !$card->{value};
88             }
89              
90 0     0 0   sub is_ten ($card) {
  0            
  0            
91 0           $card->{value} > 8;
92             }
93              
94 0     0 0   sub hand_value ( $hand, $method, $owner ) {
  0            
  0            
  0            
  0            
95 0           my $total = 0;
96              
97 0           for my $i ( 0 .. scalar( @{ $hand->{cards} } ) - 1 ) {
  0            
98 0 0 0       next if $owner == DEALER && $i == 1 && $hand->{hide_down_card};
      0        
99              
100 0           my $tmp_v = @{ $hand->{cards} }[$i]->{value} + 1;
  0            
101 0 0         my $v = $tmp_v > 9 ? 10 : $tmp_v;
102              
103 0 0 0       $v = 11 if $method eq SOFT && $v == 1 && $total < 11;
      0        
104 0           $total += $v;
105             }
106              
107 0 0 0       return hand_value( $hand, HARD, $owner ) if $method eq SOFT && $total > 21;
108              
109 0           $total;
110             }
111              
112 0     0 0   sub player_is_busted ($player_hand) {
  0            
  0            
113 0 0         hand_value( $player_hand, SOFT, PLAYER ) > 21 ? 1 : 0;
114             }
115              
116 0     0 0   sub is_blackjack ($cards) {
  0            
  0            
117 0 0         return 0 if scalar( @{$cards} ) != 2;
  0            
118 0 0 0       return 1 if is_ace( @$cards[0] ) && is_ten( @$cards[1] );
119              
120 0 0 0       is_ace( @$cards[1] ) && is_ten( @$cards[0] ) ? 1 : 0;
121             }
122              
123 0     0 0   sub player_can_hit ($player_hand) {
  0            
  0            
124             ( $player_hand->{played}
125             || $player_hand->{stood}
126             || 21 == hand_value( $player_hand, HARD, PLAYER )
127             || is_blackjack( $player_hand->{cards} )
128 0 0 0       || player_is_busted($player_hand) ) ? 0 : 1;
129             }
130              
131 0     0 0   sub player_can_stand ($player_hand) {
  0            
  0            
132             ( $player_hand->{stood}
133             || player_is_busted($player_hand)
134 0 0 0       || is_blackjack( $player_hand->{cards} ) ) ? 0 : 1;
135             }
136              
137 0     0 0   sub all_bets ($game) {
  0            
  0            
138 0           my $bets = 0;
139              
140 0           for ( @{ $game->{player_hands} } ) {
  0            
141 0           $bets += $_->{bet};
142             }
143              
144 0           $bets;
145             }
146              
147 0     0 0   sub shuffle ($shoe) {
  0            
  0            
148 0           for ( my $i = @{ ${$shoe} } ; --$i ; ) {
  0            
  0            
149 0           my $j = int rand( $i + 1 );
150 0           @{ ${$shoe} }[ $i, $j ] = @{ ${$shoe} }[ $j, $i ];
  0            
  0            
  0            
  0            
151             }
152             }
153              
154 0     0 0   sub new_shoe ( $game, $values ) {
  0            
  0            
  0            
155 0           my $total_cards = $game->{num_decks} * CARDS_IN_DECK;
156              
157 0           $game->{shoe} = [];
158              
159 0           while ( scalar( @{ $game->{shoe} } ) < $total_cards ) {
  0            
160 0           for ( my $suit = 0 ; $suit < 4 ; ++$suit ) {
161 0 0         last if scalar( @{ $game->{shoe} } ) >= $total_cards;
  0            
162              
163 0           for ( @{$values} ) {
  0            
164 0           my %c = ( suit => $suit, value => $_ );
165 0           push @{ $game->{shoe} }, \%c;
  0            
166             }
167             }
168             }
169              
170 0           shuffle( \$game->{shoe} );
171             }
172              
173 0     0 0   sub new_regular ($game) {
  0            
  0            
174 0           new_shoe( $game, [ 0 .. 12 ] );
175             }
176              
177 0     0 0   sub new_aces ($game) {
  0            
  0            
178 0           new_shoe( $game, [0] );
179             }
180              
181 0     0 0   sub new_jacks ($game) {
  0            
  0            
182 0           new_shoe( $game, [10] );
183             }
184              
185 0     0 0   sub new_aces_jacks ($game) {
  0            
  0            
186 0           new_shoe( $game, [ 0, 10 ] );
187             }
188              
189 0     0 0   sub new_sevens ($game) {
  0            
  0            
190 0           new_shoe( $game, [6] );
191             }
192              
193 0     0 0   sub new_eights ($game) {
  0            
  0            
194 0           new_shoe( $game, [7] );
195             }
196              
197 0     0 0   sub need_to_shuffle ($game) {
  0            
  0            
198 0           my $num_cards = $game->{num_decks} * CARDS_IN_DECK;
199 0           my $current_card = $num_cards - scalar( @{ $game->{shoe} } );
  0            
200 0           my $used = ( $current_card / $num_cards ) * 100.0;
201              
202 0           for ( my $x = 0 ; $x < MAX_DECKS ; ++$x ) {
203 0           my $spec = $game->{shuffle_specs}[$x];
204 0 0 0       return 1 if ( $game->{num_decks} == @$spec[1] && $used > @$spec[0] );
205             }
206              
207 0           0;
208             }
209              
210 0     0 0   sub deal_card ( $shoe, $cards ) {
  0            
  0            
  0            
211 0           my $card = pop( @{$shoe} );
  0            
212 0           push @{$cards}, $card;
  0            
213             }
214              
215 0     0 0   sub dealer_upcard_is_ace ($dealer_hand) {
  0            
  0            
216 0           is_ace( $dealer_hand->{cards}[0] );
217             }
218              
219             sub clear {
220 0     0 0   system('export TERM=linux; clear');
221             }
222              
223 0     0 0   sub card_face ( $game, $value, $suit ) {
  0            
  0            
  0            
  0            
224 0 0         return $game->{faces2}[$value][$suit] if ( $game->{face_type} == 2 );
225              
226 0           $game->{faces}[$value][$suit];
227             }
228              
229 0     0 0   sub draw_dealer_hand ($game) {
  0            
  0            
230 0           my $dealer_hand = $game->{dealer_hand};
231              
232 0           print(' ');
233              
234 0           for ( my $i = 0 ; $i < scalar( @{ $dealer_hand->{cards} } ) ; ++$i ) {
  0            
235 0 0 0       if ( $i == 1 && $dealer_hand->{hide_down_card} ) {
236 0           printf( '%s ', card_face( $game, 13, 0 ) );
237             }
238             else {
239 0           my $card = $dealer_hand->{cards}[$i];
240 0           printf( '%s ', card_face( $game, $card->{value}, $card->{suit} ) );
241             }
242             }
243              
244 0           printf( ' ⇒ %u', hand_value( $dealer_hand, SOFT, DEALER ) );
245             }
246              
247 0     0 0   sub draw_player_hand ( $game, $index ) {
  0            
  0            
  0            
248 0           my $player_hand = $game->{player_hands}[$index];
249              
250 0           print(' ');
251              
252 0           for ( my $i = 0 ; $i < scalar( @{ $player_hand->{cards} } ) ; ++$i ) {
  0            
253 0           my $card = $player_hand->{cards}[$i];
254 0           printf( '%s ', card_face( $game, $card->{value}, $card->{suit} ) );
255             }
256              
257 0           printf( ' ⇒ %u ', hand_value( $player_hand, SOFT, PLAYER ) );
258              
259 0 0         if ( $player_hand->{status} == LOST ) {
    0          
260 0           print('-');
261             }
262             elsif ( $player_hand->{status} == WON ) {
263 0           print('+');
264             }
265              
266 0           printf( '$%.2f', $player_hand->{bet} / 100.0 );
267             print(' ⇐')
268 0 0 0       if ( !$player_hand->{played} && $index == $game->{current_player_hand} );
269 0           print(' ');
270              
271 0 0         if ( $player_hand->{status} == LOST ) {
    0          
    0          
272 0 0         print( player_is_busted($player_hand) ? 'Busted!' : 'Lose!' );
273             }
274             elsif ( $player_hand->{status} == WON ) {
275 0 0         print( is_blackjack( $player_hand->{cards} ) ? 'Blackjack!' : 'Won!' );
276             }
277             elsif ( $player_hand->{status} == PUSH ) {
278 0           print('Push');
279             }
280              
281 0           print("\n\n");
282             }
283              
284 0     0 0   sub draw_hands ($game) {
  0            
  0            
285 0           clear();
286 0           print("\n Dealer: \n");
287 0           draw_dealer_hand($game);
288 0           printf( "\n\n Player \$%.2f:\n", $game->{money} / 100.0 );
289              
290 0           for ( my $x = 0 ; $x < scalar( @{ $game->{player_hands} } ) ; $x++ ) {
  0            
291 0           draw_player_hand( $game, $x );
292             }
293             }
294              
295 0     0 0   sub read_one_char ($matcher) {
  0            
  0            
296 0 0         open( TTY, "+
297 0           system 'stty raw -echo min 1 time 1';
298              
299 0           my $c;
300 0           while (1) {
301 0           $c = getc(TTY);
302 0 0         last if $c =~ $matcher;
303             }
304              
305 0           system 'stty sane';
306 0           $c;
307             }
308              
309 0     0 0   sub need_to_play_dealer_hand ($game) {
  0            
  0            
310 0           for ( my $x = 0 ; $x < scalar( @{ $game->{player_hands} } ) ; ++$x ) {
  0            
311 0           my $player_hand = $game->{player_hands}[$x];
312             return 1
313             if !(player_is_busted($player_hand)
314 0 0 0       || is_blackjack( $player_hand->{cards} ) );
315             }
316              
317 0           0;
318             }
319              
320 0     0 0   sub play_dealer_hand ($game) {
  0            
  0            
321 0           my $dealer_hand = $game->{dealer_hand};
322             $dealer_hand->{hide_down_card} = 0
323 0 0         if ( is_blackjack( $dealer_hand->{cards} ) );
324              
325 0 0         if ( !need_to_play_dealer_hand($game) ) {
326 0           pay_hands($game);
327 0           return;
328             }
329              
330 0           $dealer_hand->{hide_down_card} = 0;
331              
332 0           my $soft_count = hand_value( $dealer_hand, SOFT, DEALER );
333 0           my $hard_count = hand_value( $dealer_hand, HARD, DEALER );
334              
335 0   0       while ( $soft_count < 18 && $hard_count < 17 ) {
336 0           deal_card( $game->{shoe}, $dealer_hand->{cards} );
337 0           $soft_count = hand_value( $dealer_hand, SOFT, DEALER );
338 0           $hard_count = hand_value( $dealer_hand, HARD, DEALER );
339             }
340              
341 0           pay_hands($game);
342             }
343              
344 0     0 0   sub no_insurance ($game) {
  0            
  0            
345 0 0         if ( is_blackjack( $game->{dealer_hand}->{cards} ) ) {
346 0           $game->{dealer_hand}->{hide_down_card} = 0;
347              
348 0           pay_hands($game);
349 0           draw_hands($game);
350 0           bet_options($game);
351 0           return;
352             }
353              
354 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
355              
356 0 0         if ( player_is_done( $game, $player_hand ) ) {
357 0           play_dealer_hand($game);
358 0           draw_hands($game);
359 0           bet_options($game);
360 0           return;
361             }
362              
363 0           draw_hands($game);
364 0           player_get_action($game);
365             }
366              
367 0     0 0   sub insure_hand ($game) {
  0            
  0            
368 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
369              
370 0           $player_hand->{bet} /= 2;
371 0           $player_hand->{played} = 1;
372 0           $player_hand->{payed} = 1;
373 0           $player_hand->{status} = LOST;
374 0           $game->{money} -= $player_hand->{bet};
375              
376 0           draw_hands($game);
377 0           bet_options($game);
378             }
379              
380 0     0 0   sub player_is_done ( $game, $player_hand ) {
  0            
  0            
  0            
381 0 0 0       if ( $player_hand->{played}
      0        
      0        
      0        
      0        
382             || $player_hand->{stood}
383             || is_blackjack( $player_hand->{cards} )
384             || player_is_busted($player_hand)
385             || 21 == hand_value( $player_hand, SOFT, PLAYER )
386             || 21 == hand_value( $player_hand, HARD, PLAYER ) )
387             {
388              
389 0           $player_hand->{played} = 1;
390              
391 0 0 0       if ( !$player_hand->{payed} && player_is_busted($player_hand) ) {
392 0           $player_hand->{payed} = 1;
393 0           $player_hand->{status} = LOST;
394 0           $game->{money} -= $player_hand->{bet};
395             }
396              
397 0           return 1;
398             }
399              
400 0           0;
401             }
402              
403 0     0 0   sub normalize_bet ($game) {
  0            
  0            
404 0 0         $game->{current_bet} = MIN_BET if $game->{current_bet} < MIN_BET;
405 0 0         $game->{current_bet} = MAX_BET if $game->{current_bet} > MAX_BET;
406              
407             $game->{current_bet} = $game->{money}
408 0 0         if $game->{current_bet} > $game->{money};
409             }
410              
411 0     0 0   sub dealer_is_busted ($dealer_hand) {
  0            
  0            
412 0 0         hand_value( $dealer_hand, SOFT, DEALER ) > 21 ? 1 : 0;
413             }
414              
415 0     0 0   sub pay_hands ($game) {
  0            
  0            
416 0           my $dealer_hand = $game->{dealer_hand};
417 0           my $dhv = hand_value( $dealer_hand, SOFT, DEALER );
418 0           my $dhb = dealer_is_busted($dealer_hand);
419              
420 0           for ( my $x = 0 ; $x < scalar( @{ $game->{player_hands} } ) ; ++$x ) {
  0            
421 0           my $player_hand = $game->{player_hands}[$x];
422              
423 0 0         next if ( $player_hand->{payed} );
424 0           $player_hand->{payed} = 1;
425              
426 0           my $phv = hand_value( $player_hand, SOFT, PLAYER );
427              
428 0 0 0       if ( $dhb || $phv > $dhv ) {
    0          
429             $player_hand->{bet} *= 1.5
430 0 0         if ( is_blackjack( $player_hand->{cards} ) );
431 0           $game->{money} += $player_hand->{bet};
432 0           $player_hand->{status} = WON;
433             }
434             elsif ( $phv < $dhv ) {
435 0           $game->{money} -= $player_hand->{bet};
436 0           $player_hand->{status} = LOST;
437             }
438             else {
439 0           $player_hand->{status} = PUSH;
440             }
441             }
442              
443 0           normalize_bet($game);
444 0           save_game($game);
445             }
446              
447 0     0 0   sub get_new_bet ($game) {
  0            
  0            
448 0           clear();
449 0           draw_hands($game);
450              
451             printf( ' Current Bet: $%u Enter New Bet: $',
452 0           ( $game->{current_bet} / 100 ) );
453              
454 0           my $tmp = ;
455 0           chomp $tmp;
456              
457 0           $game->{current_bet} = $tmp * 100;
458 0           normalize_bet($game);
459 0           deal_new_hand($game);
460             }
461              
462 0     0 0   sub get_new_num_decks ($game) {
  0            
  0            
463 0           clear();
464 0           draw_hands($game);
465              
466             printf( ' Number Of Decks: %u Enter New Number Of Decks (1-8): ',
467 0           ( $game->{num_decks} ) );
468              
469 0           my $tmp = ;
470              
471 0 0         $tmp = 1 if ( $tmp < 1 );
472 0 0         $tmp = 8 if ( $tmp > 8 );
473 0           $game->{num_decks} = $tmp;
474              
475 0           game_options($game);
476             }
477              
478 0     0 0   sub get_new_deck_type ($game) {
  0            
  0            
479 0           clear();
480 0           draw_hands($game);
481 0           print(
482             " (1) Regular (2) Aces (3) Jacks (4) Aces & Jacks (5) Sevens (6) Eights\n"
483             );
484              
485 0           my $c = read_one_char(qr/[1-6]/);
486 0           $game->{deck_type} = $c;
487 0           $game->{deck_types}->{ $game->{deck_type} }->($game);
488              
489 0           save_game($game);
490 0           draw_hands($game);
491 0           bet_options($game);
492             }
493              
494 0     0 0   sub get_new_face_type ($game) {
  0            
  0            
495 0           clear();
496 0           draw_hands($game);
497 0           print(" (1) A♠ (2) 🂡\n");
498              
499 0           my $c = read_one_char(qr/[1-2]/);
500 0           $game->{face_type} = $c;
501              
502 0           save_game($game);
503 0           draw_hands($game);
504 0           bet_options($game);
505             }
506              
507 0     0 0   sub game_options ($game) {
  0            
  0            
508 0           clear();
509 0           draw_hands($game);
510 0           print(" (N) Number of Decks (T) Deck Type (F) Face Type (B) Back\n");
511              
512 0           my $c = read_one_char(qr/[ntfb]/);
513              
514 0 0         if ( $c eq 'n' ) {
    0          
    0          
    0          
515 0           get_new_num_decks($game);
516             }
517             elsif ( $c eq 't' ) {
518 0           get_new_deck_type($game);
519             }
520             elsif ( $c eq 'f' ) {
521 0           get_new_face_type($game);
522             }
523             elsif ( $c eq 'b' ) {
524 0           clear();
525 0           draw_hands($game);
526 0           bet_options($game);
527             }
528             }
529              
530 0     0 0   sub bet_options ($game) {
  0            
  0            
531 0           print(" (D) Deal Hand (B) Change Bet (O) Options (Q) Quit\n");
532              
533 0           my $c = read_one_char(qr/[dboq]/);
534              
535 0 0         return if $c eq 'd';
536              
537 0 0         if ( $c eq 'b' ) {
    0          
    0          
538 0           get_new_bet($game);
539             }
540             elsif ( $c eq 'o' ) {
541 0           game_options($game);
542             }
543             elsif ( $c eq 'q' ) {
544 0           $game->{quitting} = 1;
545 0           clear();
546             }
547             }
548              
549 0     0 0   sub player_can_split ($game) {
  0            
  0            
550 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
551              
552             return 0
553             if ( $player_hand->{stood}
554 0 0 0       || scalar( @{ $game->{player_hands} } ) >= MAX_PLAYER_HANDS );
  0            
555 0 0         return 0 if ( $game->{money} < all_bets($game) + $player_hand->{bet} );
556              
557 0           my $cards = $player_hand->{cards};
558 0 0 0       @$cards == 2 && @$cards[0]->{value} == @$cards[1]->{value} ? 1 : 0;
559             }
560              
561 0     0 0   sub player_can_dbl ($game) {
  0            
  0            
562 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
563              
564 0 0         return 0 if ( $game->{money} < all_bets($game) + $player_hand->{bet} );
565              
566             $player_hand->{stood}
567             || scalar( @{ $player_hand->{cards} } ) != 2
568             || player_is_busted($player_hand)
569 0 0 0       || is_blackjack( $player_hand->{cards} ) ? 0 : 1;
570             }
571              
572 0     0 0   sub process ($game) {
  0            
  0            
573 0 0         if ( more_hands_to_play($game) ) {
574 0           play_more_hands($game);
575 0           return;
576             }
577              
578 0           play_dealer_hand($game);
579 0           draw_hands($game);
580 0           bet_options($game);
581             }
582              
583 0     0 0   sub more_hands_to_play ($game) {
  0            
  0            
584 0           $game->{current_player_hand} < scalar( @{ $game->{player_hands} } ) - 1;
  0            
585             }
586              
587 0     0 0   sub play_more_hands ($game) {
  0            
  0            
588             my $player_hand =
589 0           $game->{player_hands}[ ++( $game->{current_player_hand} ) ];
590 0           deal_card( $game->{shoe}, $player_hand->{cards} );
591              
592 0 0         if ( player_is_done( $game, $player_hand ) ) {
593 0           process($game);
594 0           return;
595             }
596              
597 0           draw_hands($game);
598 0           player_get_action($game);
599             }
600              
601 0     0 0   sub player_hit ($game) {
  0            
  0            
602 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
603 0           deal_card( $game->{shoe}, $player_hand->{cards} );
604              
605 0 0         if ( player_is_done( $game, $player_hand ) ) {
606 0           process($game);
607 0           return;
608             }
609              
610 0           draw_hands($game);
611 0           player_get_action($game);
612             }
613              
614 0     0 0   sub player_stand ($game) {
  0            
  0            
615 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
616              
617 0           $player_hand->{stood} = 1;
618 0           $player_hand->{played} = 1;
619              
620 0 0         if ( more_hands_to_play($game) ) {
621 0           play_more_hands($game);
622 0           return;
623             }
624              
625 0           play_dealer_hand($game);
626 0           draw_hands($game);
627 0           bet_options($game);
628             }
629              
630 0     0 0   sub player_split ($game) {
  0            
  0            
631 0 0         if ( !player_can_split($game) ) {
632 0           draw_hands($game);
633 0           player_get_action($game);
634 0           return;
635             }
636              
637             my %new_hand = (
638             cards => [],
639             bet => $game->{current_bet},
640 0           stood => 0,
641             played => 0,
642             payed => 0,
643             status => 0
644             );
645 0           my $hand_count = scalar( @{ $game->{player_hands} } );
  0            
646              
647 0           $game->{player_hands}[$hand_count] = \%new_hand;
648              
649 0           while ( $hand_count > $game->{current_player_hand} ) {
650 0           my $ph = dclone( $game->{player_hands}[ $hand_count - 1 ] );
651 0           $game->{player_hands}[$hand_count] = $ph;
652 0           --$hand_count;
653             }
654              
655 0           my $this_hand = $game->{player_hands}[ $game->{current_player_hand} ];
656 0           my $split_hand = $game->{player_hands}[ $game->{current_player_hand} + 1 ];
657              
658 0           $split_hand->{cards} = [ dclone( $this_hand->{cards}[1] ) ];
659 0           $this_hand->{cards} = [ dclone( $this_hand->{cards}[0] ) ];
660              
661 0           deal_card( $game->{shoe}, $this_hand->{cards} );
662              
663 0 0         if ( player_is_done( $game, $this_hand ) ) {
664 0           process($game);
665 0           return;
666             }
667              
668 0           draw_hands($game);
669 0           player_get_action($game);
670             }
671              
672 0     0 0   sub player_dbl ($game) {
  0            
  0            
673 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
674              
675 0           deal_card( $game->{shoe}, $player_hand->{cards} );
676 0           $player_hand->{played} = 1;
677 0           $player_hand->{bet} *= 2;
678              
679 0 0         process($game) if ( player_is_done( $game, $player_hand ) );
680             }
681              
682 0     0 0   sub player_get_action ($game) {
  0            
  0            
683 0           my $player_hand = $game->{player_hands}[ $game->{current_player_hand} ];
684 0           print(' ');
685              
686 0 0         if ( player_can_hit($player_hand) ) { print('(H) Hit '); }
  0            
687 0 0         if ( player_can_stand($player_hand) ) { print('(S) Stand '); }
  0            
688 0 0         if ( player_can_split($game) ) { print('(P) Split '); }
  0            
689 0 0         if ( player_can_dbl($game) ) { print('(D) Double '); }
  0            
690              
691 0           print("\n");
692              
693 0           my $c = read_one_char(qr/[hspd]/);
694              
695 0 0         if ( $c eq 'h' ) {
    0          
    0          
    0          
696 0           player_hit($game);
697             }
698             elsif ( $c eq 's' ) {
699 0           player_stand($game);
700             }
701             elsif ( $c eq 'p' ) {
702 0           player_split($game);
703             }
704             elsif ( $c eq 'd' ) {
705 0           player_dbl($game);
706             }
707             }
708              
709 0     0 0   sub ask_insurance ($game) {
  0            
  0            
710 0           print(" Insurance? (Y) Yes (N) No\n");
711              
712 0           my $c = read_one_char(qr/[yn]/);
713              
714 0 0         if ( $c eq 'y' ) {
    0          
715 0           insure_hand($game);
716             }
717             elsif ( $c eq 'n' ) {
718 0           no_insurance($game);
719             }
720             }
721              
722 0     0 0   sub deal_new_hand ($game) {
  0            
  0            
723 0 0         $game->{deck_types}->{ $game->{deck_type} }->($game)
724             if ( need_to_shuffle($game) );
725              
726             my %player_hand = (
727             cards => [],
728             bet => $game->{current_bet},
729 0           stood => 0,
730             played => 0,
731             payed => 0,
732             status => 0
733             );
734 0           my %dealer_hand = ( cards => [], hide_down_card => 1 );
735              
736 0           deal_card( $game->{shoe}, ( \%player_hand )->{cards} );
737 0           deal_card( $game->{shoe}, ( \%dealer_hand )->{cards} );
738 0           deal_card( $game->{shoe}, ( \%player_hand )->{cards} );
739 0           deal_card( $game->{shoe}, ( \%dealer_hand )->{cards} );
740              
741 0           $game->{player_hands} = [ \%player_hand ];
742 0           $game->{current_player_hand} = 0;
743 0           $game->{dealer_hand} = \%dealer_hand;
744              
745 0           draw_hands($game);
746              
747 0 0 0       if ( dealer_upcard_is_ace( \%dealer_hand )
748             && !is_blackjack( ( \%player_hand )->{cards} ) )
749             {
750 0           draw_hands($game);
751 0           ask_insurance($game);
752 0           return;
753             }
754              
755 0 0         if ( player_is_done( $game, \%player_hand ) ) {
756 0           $dealer_hand{hide_down_card} = 0;
757 0           pay_hands($game);
758 0           draw_hands($game);
759 0           bet_options($game);
760 0           return;
761             }
762              
763 0           draw_hands($game);
764 0           player_get_action($game);
765 0           save_game($game);
766             }
767              
768 0     0 0   sub save_game ($game) {
  0            
  0            
769 0 0         open( my $fh, '>:encoding(UTF-8)', SAVE_FILE ) or die $!;
770             printf( $fh "%u\n%u\n%u\n%u\n%u\n",
771             $game->{num_decks}, $game->{money}, $game->{current_bet},
772             $game->{deck_type}, $game->{face_type}
773 0           );
774 0           close($fh);
775             }
776              
777 0     0 0   sub load_game ($game) {
  0            
  0            
778 0 0         if ( open( my $fh, '<:encoding(UTF-8)', SAVE_FILE ) ) {
779 0           my $line = <$fh>;
780 0           chomp $line;
781 0           $game->{num_decks} = int($line);
782              
783 0           $line = <$fh>;
784 0           chomp $line;
785 0           $game->{money} = int($line);
786              
787 0           $line = <$fh>;
788 0           chomp $line;
789 0           $game->{current_bet} = int($line);
790              
791 0           $line = <$fh>;
792 0           chomp $line;
793 0           $game->{deck_type} = int($line);
794              
795 0           $line = <$fh>;
796 0           chomp $line;
797 0           $game->{face_type} = int($line);
798              
799 0           close($fh);
800             }
801             }
802              
803             sub run {
804 0     0 0   my %game = (
805             quitting => 0,
806             shoe => [],
807             dealer_hand => {},
808             player_hands => [],
809             num_decks => 8,
810             deck_type => 1,
811             face_type => 1,
812             money => 10000,
813             current_bet => 500,
814             current_player_hand => 0,
815             shuffle_specs => [
816             [ 95, 8 ], [ 92, 7 ], [ 89, 6 ], [ 86, 5 ],
817             [ 84, 4 ], [ 82, 3 ], [ 81, 2 ], [ 80, 1 ]
818             ],
819             faces => [
820             [ 'A♠', 'A♥', 'A♣', 'A♦' ],
821             [ '2♠', '2♥', '2♣', '2♦' ],
822             [ '3♠', '3♥', '3♣', '3♦' ],
823             [ '4♠', '4♥', '4♣', '4♦' ],
824             [ '5♠', '5♥', '5♣', '5♦' ],
825             [ '6♠', '6♥', '6♣', '6♦' ],
826             [ '7♠', '7♥', '7♣', '7♦' ],
827             [ '8♠', '8♥', '8♣', '8♦' ],
828             [ '9♠', '9♥', '9♣', '9♦' ],
829             [ 'T♠', 'T♥', 'T♣', 'T♦' ],
830             [ 'J♠', 'J♥', 'J♣', 'J♦' ],
831             [ 'Q♠', 'Q♥', 'Q♣', 'Q♦' ],
832             [ 'K♠', 'K♥', 'K♣', 'K♦' ],
833             ['??']
834             ],
835             faces2 => [
836             [ '🂡', '🂱', '🃁', '🃑' ],
837             [ '🂢', '🂲', '🃂', '🃒' ],
838             [ '🂣', '🂳', '🃃', '🃓' ],
839             [ '🂤', '🂴', '🃄', '🃔' ],
840             [ '🂥', '🂵', '🃅', '🃕' ],
841             [ '🂦', '🂶', '🃆', '🃖' ],
842             [ '🂧', '🂷', '🃇', '🃗' ],
843             [ '🂨', '🂸', '🃈', '🃘' ],
844             [ '🂩', '🂹', '🃉', '🃙' ],
845             [ '🂪', '🂺', '🃊', '🃚' ],
846             [ '🂫', '🂻', '🃋', '🃛' ],
847             [ '🂭', '🂽', '🃍', '🃝' ],
848             [ '🂮', '🂾', '🃎', '🃞' ],
849             ['🂠']
850             ],
851             deck_types => {
852             1 => \&new_regular,
853             2 => \&new_aces,
854             3 => \&new_jacks,
855             4 => \&new_aces_jacks,
856             5 => \&new_sevens,
857             6 => \&new_eights
858             }
859             );
860              
861 0           load_game( \%game );
862              
863 0           while (1) {
864 0           deal_new_hand( \%game );
865 0 0         last if $game{quitting};
866             }
867             }
868              
869             1; # End of Console::Blackjack