File Coverage

blib/lib/Helper/Deck.pm
Criterion Covered Total %
statement 76 79 96.2
branch 1 2 50.0
condition 6 15 40.0
subroutine 14 15 93.3
pod 10 10 100.0
total 107 121 88.4


line stmt bran cond sub pod time code
1 1     1   13547 use common::sense;
  1         2  
  1         5  
2              
3             our $VERSION = '1.05';
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   534 use Moose;
  1         303121  
  1         6  
9            
10 1     1   4647 use common::sense;
  1         5  
  1         8  
11            
12 1     1   41 use List::Util qw(shuffle);
  1         1  
  1         69  
13            
14 1     1   4 use feature 'say';
  1         1  
  1         772  
15            
16             sub roll {
17 1     1 1 908 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 367 my $self = shift;
24 2         6 my @nicks = @_;
25            
26 2         11 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 2 my $self = shift;
38 1         4 my %args = @_;
39            
40 1         2 my @settings = shuffle(@{$args{settings}});
  1         4  
41 1         2 my @objectives = shuffle(@{$args{objectives}});
  1         3  
42 1         1 my @antagonists = shuffle(@{$args{antagonists}});
  1         3  
43 1         1 my @complications = shuffle(@{$args{complications}});
  1         3  
44            
45             return(
46 1         7 '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 886 my $self = shift;
55            
56 1         4 my @suits = (
57             'Spades',
58             'Hearts',
59             'Clubs',
60             'Diamonds',
61             );
62            
63 1         4 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         4 foreach my $face (@faces) {
83 52         33 push @deck,\%{{'face' => $face, 'suit' => $suit}};
  52         78  
84             }
85             }
86            
87 1         3 return(\@deck);
88             }
89            
90             sub shuffle_deck {
91 1     1 1 416 my $self = shift;
92 1         2 my $deck_ref = shift;
93 1         1 my @deck = @{$deck_ref};
  1         8  
94 1         7 my @shuffled_deck = shuffle(@deck);
95 1         3 return(\@shuffled_deck);
96             }
97            
98             sub top_card {
99 6     6 1 367 my $self = shift;
100 6         3 my $deck_ref = shift;
101 6         6 my $card = pop @{$deck_ref};
  6         3  
102 6         8 return($card);
103             }
104            
105             sub card_to_string {
106 1     1 1 355 my $self = shift;
107 1         2 my $card_ref = shift;
108 1         1 my %card = %{$card_ref};
  1         3  
109            
110 1         8 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         1 my $max = shift;
117 1         2 my @deck = @{$deck_ref};
  1         12  
118 1         12 my @draw;
119            
120 1         3 foreach my $item (1 .. $max ) {
121 5         7 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         1 my $deck = shift;
130 1         2 my $chosen = shift;
131            
132 1         2 my $remaining = scalar @{$deck};
  1         2  
133 1         2 my $odds = 0;
134 1         1 foreach my $card (@{$deck}) {
  1         2  
135 46 50 66     232 $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         23 return($odds . ' in ' . $remaining);
139             }
140            
141             }
142            
143             1;
144              
145             __END__
146              
147             # MAN3 POD
148              
149             =head1 NAME
150              
151             Helper::Deck - Work with a deck of playing cards in the fashion engineered by Duane O'Brien of I.B.M. developerWorks.
152              
153             =cut
154              
155             =head1 SYNOPSIS
156              
157             use common::sense;
158             use Helper::Deck;
159            
160             my $d1 = Helper::Deck->new;
161             my $roll1 = $d1->roll(6);
162            
163             my $nick1 = $d1->random_nick(('nd', 'jp', 'smoke', 'gehenna'));
164             my $name1 = $d1->random_name(('james doe', 'john doe', 'jason doe', 'justin doe'));
165            
166             my %scene1 = $d1->random_scenario(
167             settings => [ 'the beach', 'the Yaht' ],
168             objectives => [ 'get suntan', 'go swimming' ],
169             antagonists => [ 'gull', 'kid' ],
170             complications => [ 'very thirsty', 'very drunk' ],
171             );
172            
173             print "I'm ", $scene1{'complication'}, " so I will ", $scene1{'objective'}, ".", "\n";
174            
175             my $deck1 = $d1->build_deck;
176             my $deck1 = $d1->shuffle_deck($deck1);
177            
178             my $tc = $d1->top_card($deck1);
179            
180             print $d1->card_to_string($tc), " was drawn.", "\n";
181            
182             my $deal1 = $d1->draw($deck1, 5);
183            
184             print "Player 1 has been given ", $d1->card_to_string($deal1->[0]), "\n";
185             print "Player 2 has been given ", $d1->card_to_string($deal1->[1]), "\n";
186             print "Player 3 has been given ", $d1->card_to_string($deal1->[2]), "\n";
187             print "Player 4 has been given ", $d1->card_to_string($deal1->[3]), "\n";
188             print "The dealer gave himself ", $d1->card_to_string($deal1->[4]), "\n";
189            
190             my $odds = $d1->calculate_odds($deck1, $tc);
191              
192             =cut
193              
194             =head1 INTRODUCTION
195              
196             Work with a deck of playing cards in the fashion engineered by Duane O'Brien of I.B.M. developerWorks.
197              
198             =cut
199              
200             =head1 METHODS
201              
202             =head2 roll
203             usage :
204            
205             Parameters :
206             Let s be the count of sides of the die,
207             Results :
208             Let r be a fair dice roll between 1 and s,
209            
210             my $r = $obj->roll($s);
211              
212             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.
213              
214             =cut
215              
216             =head2 random_nick
217             usage :
218            
219             Parameters :
220             An array of strings containing nicks (or handles / aliases / monikers) to be used as a pool from which to draw,
221             Results :
222             A scalar containing a string which is a random nick (or handle / alias / moniker) drawn from the pool supplied,
223            
224             my $nick1 = $obj->random_nick(('nd', 'jp', 'smoke', 'gehenna')));
225              
226             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 / moniker).
227              
228             =cut
229              
230             =head2 random_name
231             usage :
232            
233             Parameters :
234             An array of strings containing names to be used as a pool from which to draw
235             Results :
236             A scalar containg a string which is a random name drawn from the pool supplied
237            
238             my $r = $obj->random_name(('james doe', 'john doe', 'jason doe', 'justin doe'));
239              
240             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.
241              
242             =cut
243              
244             =head2 random_scenario
245             usage :
246            
247             Parameters (as a Hash) :
248             Let settings be an array of strings where each string is an illustrative description of a setting,
249             Let objectives be an array of strings where each string is an illustrative description of a objective,
250             Let antagonists be an array of strings where each string is an illustrative description of a antagonist,
251             Let complications be an array of strings where each string is an illustrative description of a complication,
252            
253             Results (as a Hash) :
254             Let setting be a string which is an illustrative description of the setting,
255             Let objective be a string which is an illustrative description of the objective,
256             Let antagonist be a string which is an illustrative description of the antagonist,
257             Let complication be a string which is an illustrative description of the complication,
258            
259             my %scene1 = $d1->random_scenario(
260             settings => [ 'the beach', 'the Yaht' ],
261             objectives => [ 'get suntan', 'go swimming' ],
262             antagonists => [ 'gull', 'kid' ],
263             complications => [ 'very thirsty', 'very drunk' ],
264             );
265              
266             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.
267              
268             =cut
269              
270             =head2 build_deck
271             usage :
272            
273             Results :
274             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.
275            
276             my $r = $obj->build_deck;
277              
278             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.
279              
280             =cut
281              
282             =head2 shuffle_deck
283             usage :
284            
285             Parameters :
286             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
287             Results :
288             Let r be a reference to d1 once shuffled,
289            
290             my $r = $obj->shuffle_deck($d1);
291              
292             This method is used to shuffle a deck of playing cards.
293              
294             =cut
295              
296             =head2 top_card
297             usage :
298            
299             Parameters :
300             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
301             Results :
302             Let tc be a reference to the top card drawn from the deck,
303            
304             my $tc = $obj->top_card($d1);
305              
306             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.
307              
308             =cut
309              
310             =head2 card_to_string
311             usage :
312            
313             Parameters :
314             Let c1 be a reference to a card,
315             Results :
316             Let r be an illustrative description of this card as a string,
317            
318             my $r = $obj->card_to_string($c1);
319              
320             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.
321              
322             =cut
323              
324             =head2 draw
325             usage :
326            
327             Parameters :
328             Let d1 be a reference to a deck of playing cards (see method titled build_deck),
329             Let i be the number of cards to draw,
330             Results :
331             Let r be description of return value,
332            
333             my $r = $obj->draw($d1, $i);
334              
335             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.
336              
337             =cut
338              
339             =head2 calculate_odds
340             usage :
341            
342             Parameters :
343             Let d1 be a reference to a deck of playing cards (see the method titled build_deck),
344             Let c1 be a reference to a card illustrative of the selected draw,
345             Results :
346             Let r be description of the odds as a string,
347            
348             my $r = $obj->calculate_odds($d1, $c1);
349              
350             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.
351              
352             =cut
353              
354             =head1 AUTHOR
355              
356             Jason McVeigh, <jmcveigh@outlook.com>
357              
358             =cut
359              
360             =head1 COPYRIGHT AND LICENSE
361              
362             Copyright 2016 by Jason McVeigh
363              
364             This library is free software; you can redistribute it and/or modify
365             it under the same terms as Perl itself.
366              
367             =cut