File Coverage

blib/lib/Helper/Deck.pm
Criterion Covered Total %
statement 80 83 96.3
branch 1 2 50.0
condition 6 15 40.0
subroutine 16 17 94.1
pod 12 12 100.0
total 115 129 89.1


line stmt bran cond sub pod time code
1 1     1   14265 use common::sense;
  1         1  
  1         5  
2              
3             our $VERSION = '1.0';
4              
5             # ABSTRACT: Work with a deck of playing cards in the fashion engineered by Duane O'Brien of I.B.M. developerWorks.
6              
7             package Helper::Deck {
8 1     1   528 use Moose;
  1         289239  
  1         5  
9            
10 1     1   4400 use common::sense;
  1         5  
  1         6  
11            
12 1     1   38 use List::Util qw(shuffle);
  1         1  
  1         64  
13            
14 1     1   3 use feature 'say';
  1         1  
  1         776  
15            
16             sub roll {
17 1     1 1 925 my $self = shift;
18 1         2 my $sides = shift;
19 1         35 return(int( rand( $sides ) + 1));
20             }
21            
22             sub random_nick {
23 2     2 1 574 my $self = shift;
24 2         7 my @nicks = @_;
25            
26 2         15 return((shuffle(@nicks))[-1]);
27             }
28            
29             sub random_name {
30 0     0 1 0 my $self = shift;
31 0         0 my @names = @_;
32            
33 0         0 return((shuffle(@names))[-1]);
34             }
35            
36             sub random_scenario {
37 1     1 1 3 my $self = shift;
38 1         5 my %args = @_;
39            
40 1         2 my @settings = shuffle(@{$args{settings}});
  1         6  
41 1         2 my @objectives = shuffle(@{$args{objectives}});
  1         5  
42 1         3 my @antagonists = shuffle(@{$args{antagonists}});
  1         4  
43 1         2 my @complications = shuffle(@{$args{complications}});
  1         4  
44            
45             return(
46 1         9 'setting' => $settings[-1],
47             'objective' => $objectives[-1],
48             'antagonist' => $antagonists[-1],
49             'complication' => $complications[-1],
50             );
51             }
52            
53             sub build_deck {
54 1     1 1 1329 my $self = shift;
55            
56 1         5 my @suits = (
57             'Spades',
58             'Hearts',
59             'Clubs',
60             'Diamonds',
61             );
62            
63 1         6 my @faces = (
64             'Two',
65             'Three',
66             'Four',
67             'Five',
68             'Six',
69             'Seven',
70             'Eight',
71             'Nine',
72             'Ten',
73             'Jack',
74             'Queen',
75             'King',
76             'Ace',
77             );
78            
79 1         2 my @deck;
80            
81 1         2 foreach my $suit (@suits) {
82 4         6 foreach my $face (@faces) {
83 52         47 push @deck,\%{{'face' => $face, 'suit' => $suit}};
  52         126  
84             }
85             }
86            
87 1         4 return(\@deck);
88             }
89            
90             sub shuffle_deck {
91 1     1 1 589 my $self = shift;
92 1         2 my $deck_ref = shift;
93 1         2 my @deck = @{$deck_ref};
  1         6  
94 1         16 my @shuffled_deck = shuffle(@deck);
95 1         5 return(\@shuffled_deck);
96             }
97            
98             sub top_card {
99 6     6 1 566 my $self = shift;
100 6         4 my $deck_ref = shift;
101 6         7 my $card = pop @{$deck_ref};
  6         10  
102 6         13 return($card);
103             }
104            
105             sub card_to_string {
106 1     1 1 562 my $self = shift;
107 1         2 my $card_ref = shift;
108 1         1 my %card = %{$card_ref};
  1         6  
109            
110 1         55 return($card{face} . ' of ' . $card{suit});
111             }
112            
113             sub draw {
114 1     1 1 1 my $self = shift;
115 1         2 my $deck_ref = shift;
116 1         2 my $max = shift;
117 1         1 my @deck = @{$deck_ref};
  1         6  
118 1         19 my @draw;
119            
120 1         5 foreach my $item (1 .. $max ) {
121 5         10 push(@draw,$self->top_card($deck_ref));
122             }
123            
124 1         6 return(\@draw);
125             }
126            
127             sub calculate_odds {
128 1     1 1 2 my $self = shift;
129 1         2 my $deck = shift;
130 1         2 my $chosen = shift;
131            
132 1         1 my $remaining = scalar @{$deck};
  1         2  
133 1         3 my $odds = 0;
134 1         1 foreach my $card (@{$deck}) {
  1         3  
135 46 50 66     319 $odds++ if (($card->{'face'} eq $chosen->{'face'} && $card->{'suit'} eq $chosen->{'suit'}) || ($card->{'face'} eq '' && $card->{'suit'} eq $chosen->{'suit'}) || ($chosen->{'face'} eq $chosen->{'face'} && $card->{'suit'} eq ''));
      33        
      33        
      33        
      33        
136             }
137            
138 1         8 return($odds . ' in ' . $remaining);
139             }
140            
141             sub build_lc_letter_array {
142 1     1 1 3 my $self = shift;
143 1         13 return('a' .. 'z');
144             }
145            
146             sub build_uc_letter_array {
147 1     1 1 5 my $self = shift;
148 1         10 return('A' .. 'Z');
149             }
150             }
151            
152             1;
153              
154             __END__
155              
156             # MAN3 POD
157              
158             =head1 NAME
159              
160             Helper::Deck - Work with a deck of playing cards in the fashion engineered by Duane O'Brien of I.B.M. developerWorks.
161              
162             =cut
163              
164             =head1 SYNOPSIS
165              
166             use common::sense;
167             use Helper::Deck;
168            
169             my $d1 = Helper::Deck->new;
170             my $roll1 = $d1->roll(6);
171            
172             my $nick1 = $d1->random_nick(('nd', 'jp', 'smoke', 'gehenna'));
173             my $name1 = $d1->random_name(('james doe', 'john doe', 'jason doe', 'justin doe'));
174            
175             my %scene1 = $d1->random_scenario(
176             settings => [ 'the beach', 'the Yaht' ],
177             objectives => [ 'get suntan', 'go swimming' ],
178             antagonists => [ 'gull', 'kid' ],
179             complications => [ 'very thirsty', 'very drunk' ],
180             );
181            
182             print "I'm ", $scene1{'complication'}, " so I will ", $scene1{'objective'}, ".", "\n";
183            
184             my $deck1 = $d1->build_deck;
185             my $deck1 = $d1->shuffle_deck($deck1);
186            
187             my $tc = $d1->top_card($deck1);
188            
189             print $d1->card_to_string($tc), " was drawn.", "\n";
190            
191             my $deal1 = $d1->draw($deck1, 5);
192            
193             print "Player 1 has been given ", $d1->card_to_string($deal1->[0]), "\n";
194             print "Player 2 has been given ", $d1->card_to_string($deal1->[1]), "\n";
195             print "Player 3 has been given ", $d1->card_to_string($deal1->[2]), "\n";
196             print "Player 4 has been given ", $d1->card_to_string($deal1->[3]), "\n";
197             print "The dealer gave himself ", $d1->card_to_string($deal1->[4]), "\n";
198            
199             my $odds = $d1->calculate_odds($deck1, $tc);
200              
201             =cut
202              
203             =head1 INTRODUCTION
204              
205             Work with a deck of playing cards in the fashion engineered by Duane O'Brien of I.B.M. developerWorks.
206              
207             =cut
208              
209             =head1 METHODS
210              
211             =head2 roll
212             usage :
213            
214             Parameters :
215             Let s be the count of sides of the die,
216             Results :
217             Let r be a fair dice roll between 1 and s,
218            
219             my $r = $obj->roll($s);
220              
221             This method provides a simulation of a fair dice roll. The roll method takes a parameter indicating the count of sides of the die. The roll method returns a value, proven to be pseudo-random, as a whole integer value. The result of this method is a number between 1 and the count of sides of the die.
222              
223             =cut
224              
225             =head2 random_nick
226             usage :
227            
228             Parameters :
229             An array of strings containing nicks (or handles / aliases / monikers) to be used as a pool from which to draw,
230             Results :
231             A scalar containing a string which is a random nick (or handle / alias / moniker) drawn from the pool supplied,
232            
233             my $nick1 = $obj->random_nick(('nd', 'jp', 'smoke', 'gehenna')));
234              
235             This method is supplied with an array of strings containing nicks (or handles / aliases / moniker) to be used as a pool from which to draw a random value. This value is a nick (or handle / alias).
236              
237             =cut
238              
239             =head2 random_name
240             usage :
241            
242             Parameters :
243             An array of strings containing names to be used as a pool from which to draw
244             Results :
245             A scalar containg a string which is a random name drawn from the pool supplied
246            
247             my $r = $obj->random_name(('james doe', 'john doe', 'jason doe', 'justin doe'));
248              
249             This method is supplied with an array of strings containing names to be used as a pool from which to draw a random value. This value is a name.
250              
251             =cut
252              
253             =head2 random_scenario
254             usage :
255            
256             Parameters (as a Hash) :
257             Let settings be an array of strings where each string is an illustrative description of a setting,
258             Let objectives be an array of strings where each string is an illustrative description of a objective,
259             Let antagonists be an array of strings where each string is an illustrative description of a antagonist,
260             Let complications be an array of strings where each string is an illustrative description of a complication,
261            
262             Results (as a Hash) :
263             Let setting be a string which is an illustrative description of the setting,
264             Let objective be a string which is an illustrative description of the objective,
265             Let antagonist be a string which is an illustrative description of the antagonist,
266             Let complication be a string which is an illustrative description of the complication,
267            
268             my %scene1 = $d1->random_scenario(
269             settings => [ 'the beach', 'the Yaht' ],
270             objectives => [ 'get suntan', 'go swimming' ],
271             antagonists => [ 'gull', 'kid' ],
272             complications => [ 'very thirsty', 'very drunk' ],
273             );
274              
275             This method is supplied with a hash which contains 4 arrays of strings. The array of strings accessed by the key titled settings contains illustrative descriptions of settings. The array of strings accessed by the key titled objectives contains illustrative descriptions of objective. The array of strings accessed by the key titled antagonists contains illustrative descriptions of antagonists. The array of strings accessed by the key titled settings contains complications descriptions of complications. This method returns a hash containg keys titled setting, objective, antagonist and complication. These resultant strings are used to describe a randomly generated scenario.
276              
277             =cut
278              
279             =head2 build_deck
280             usage :
281            
282             Results :
283             Let r be a reference to an array containing a ordered deck of playing cards where each card is a hash containg keys titled face and suit.
284            
285             my $r = $obj->build_deck;
286              
287             This method is used to build a deck of playing cards. The build_deck method returns a reference to an array containing a ordered deck of playing cards where each card is a hash containg keys titled face and suit.
288              
289             =cut
290              
291             =head2 shuffle_deck
292             usage :
293            
294             Parameters :
295             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
296             Results :
297             Let d1 shuffled,
298            
299             my $r = $obj->shuffle_deck($d1);
300              
301             This method is used to shuffle a deck of playing cards.
302              
303             =cut
304              
305             =head2 top_card
306             usage :
307            
308             Parameters :
309             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
310             Results :
311             Let tc be a reference to the top card drawn from the deck,
312            
313             my $tc = $obj->top_card($d1);
314              
315             This method draws the top card from the deck. The top_card method accepts a refereence to a deck of playing cards. The top_card method draws the top card from the deck then supplies this card as a return value which is a hash containing two strings identified by the keys titled face and suit respectively.
316              
317             =cut
318              
319             =head2 card_to_string
320             usage :
321            
322             Parameters :
323             Let c1 be a reference to a card,
324             Results :
325             Let r be an illustrative description of this card as a string,
326            
327             my $r = $obj->card_to_string($c1);
328              
329             This method accepts a reference to a card, which is a hash containing two values identified by the keys titled face and suit. This method returns an illustrative description of this card as a scalar containing a string of text.
330              
331             =cut
332              
333             =head2 draw
334             usage :
335            
336             Parameters :
337             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
338             Let i be the number of cards to draw,
339             Results :
340             Let r be description of return value,
341            
342             my $r = $obj->draw($d1, $i);
343              
344             This method will collect the number of top cards specified and push them into an array. The draw method returns a reference to an array of cards drawn from the top of the deck.
345              
346             =cut
347              
348             =head2 calculate_odds
349             usage :
350            
351             Parameters :
352             Let d1 be a reference to a deck of playing cards (see the method titled build_deck),
353             Let c1 be a reference to a card illustrative of the selected draw,
354             Results :
355             Let r be description of the odds as a string,
356            
357             my $r = $obj->calculate_odds($d1, $c1);
358              
359             This method returns a description of the odds as a string. The calculate odds method is passed a reference to a deck of playing cards (see the method titled build_deck) as well as the selected card through which odds are calculated. A reference to a card is a reference to a hash containing values to keys titled face and suit. In the case only face is specified, then odds are calculated for this face in all 4 suits. In the case only suit is specified, then odds are calculated for this suit in all 12 faces.
360              
361             =cut
362              
363             =head2 build_lc_letter_array
364             usage :
365            
366             Results :
367             Let r be an array of lower case letters [a - z],
368            
369             my $r = $obj->build_lc_letter_array;
370              
371             The build_lc_letter_array returns an array of lower case letters [a - z].
372              
373             =cut
374              
375             =head2 build_uc_letter_array
376             usage :
377            
378             Results :
379             Let r be an array of upper case letters [A - Z],
380            
381             my $r = $obj->build_uc_letter_array;
382              
383             The build_uc_letter_array returns an array of upper case letters [A - Z].
384              
385             =cut
386              
387             =head1 AUTHOR
388              
389             Jason McVeigh, <jmcveigh@outlook.com>
390              
391             =cut
392              
393             =head1 COPYRIGHT AND LICENSE
394              
395             Copyright 2016 by Jason McVeigh
396              
397             This library is free software; you can redistribute it and/or modify
398             it under the same terms as Perl itself.
399              
400             =cut