File Coverage

script/war.pl
Criterion Covered Total %
statement 60 70 85.7
branch 12 18 66.6
condition 0 3 0.0
subroutine 4 4 100.0
pod n/a
total 76 95 80.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             # war.pl - watch two computer players play war
4             #
5             # Copyright 1999 Amir Karger (karger@post.harvard.edu)
6             #
7             # This program is free software; you can redistribute it and/or modify it
8             # under the same terms as Perl itself.
9              
10 1     1   6 use strict;
  1         2  
  1         42  
11 1     1   901 use Games::Cards;
  1         3  
  1         19842  
12              
13             # Global variables for war
14 1         2 my $Cards_Per_Hand = 26;
15             # It would require just a bit of tinkering to make this game for 3 or more
16             # players. But why bother?
17 1         2 my $Number_Of_Players = 2;
18 1         2 my $Max_Turns = 500;
19 1         3 my $Long = 0; # set to 1 to print out more per turn
20 1         2 my $Interactive = 0; # wait for (useless) user input after every turn?
21              
22             # card values
23 1         13 my $valueref = {
24             "Ace" => 14,
25             2 => 2,
26             3 => 3,
27             4 => 4,
28             5 => 5,
29             6 => 6,
30             7 => 7,
31             8 => 8,
32             9 => 9,
33             10 => 10,
34             "Jack" => 11,
35             "Queen" => 12,
36             "King" => 13,
37             };
38              
39 1         37 srand(); # no seed nec. for perl > 5.004
40              
41             ######################################################################
42             # SETUP THE GAME
43             # Main variables
44 1         2 my $War; # the game
45             my $Deck; # the deck we're using in the game
46 0         0 my @Hands; # the players' hands
47 0         0 my @Table; # what the players put on the table
48              
49             # initialize the game. Suits are default; card values aren't
50 1         24 print "Welcome to war!\n";
51 1 50       3 print "On each turn, hit RETURN to continue, CTRL-D to end\n\n" if $Interactive;
52 1         11 $War = new Games::Cards::Game {"cards_in_suit" => $valueref};
53              
54             # Create and shuffle the deck
55 1         3 print "Creating new deck.\n";
56 1         6 $Deck = new Games::Cards::Deck ($War, "Deck");
57 1         3 print "Shuffling the deck.\n";
58 1         11 $Deck->shuffle;
59              
60             # Deal out the hands
61 1         3 foreach my $i (1 .. $Number_Of_Players) {
62 2         7 print "Dealing hand $i\n";
63 2         9 my $hand = new Games::Cards::Queue ($War, "Player $i");
64 2         11 $Deck->give_cards($hand, $Cards_Per_Hand);
65 2         6 push @Hands, $hand;
66             }
67              
68             # Create CardSets for the cards each player puts on the table
69 1         4 foreach my $i (1 .. $Number_Of_Players) {
70 2         15 my $table_hand = new Games::Cards::Stack ($War, "Player $i showing");
71 2         6 push @Table, $table_hand;
72             }
73              
74             ######################################################################
75             # Now play
76 1         2 my @other = (1,0); # the other player
77 1         3 my $turns = 0;
78              
79 1         3 while (++$turns < $Max_Turns) {
80             # print "Turn $turns: ",
81             # map ({" " . $_->name ." has " . $_->size . " cards."} @Hands), "\n";
82            
83 154 50       270 if ($Long) {
84 0         0 foreach (@Hands) { print $_->print("short"); }
  0         0  
85             } else {
86 154         179 my $i = 1;
87 154         242 foreach (@Hands) { print $i++ x $_->size, " " }
  308         1153  
88 154         424 print "\n";
89             }
90 154         169 my $compare = 0;
91 154         284 while (!$compare) {
92             # Each player puts a card on the table
93 161         314 foreach (0 .. $#Hands) {
94 322 50       1090 $Hands[$_]->give_cards($Table[$_], 1) || &win($other[$_], $turns);
95             }
96 161 50       348 if ($Long) {foreach (@Table) { print $_->print("short"); }}
  0         0  
  0         0  
97 161         309 $compare = compare_last($Table[0], $Table[1]);
98              
99 161 100       496 if (! $compare) {
100             # war
101 8         15 print "WAR!\n";
102 8         17 foreach (0 .. $#Hands) {
103 15 100       55 $Hands[$_]->give_cards($Table[$_], 3) ||
104             &win($other[$_], $turns);
105             }
106             }
107             } # end while !compare
108              
109             # Who won? Compare > 0 means player 1 won
110             # Winner gets the card (or cards if there was a war)
111 153 100       252 my $winner = ($compare > 0 ? 1 : 0);
112 153         188 my $loser = $other[$winner];
113 153 50       239 print $Hands[$winner]->{"name"}, " wins.\n" if $Long;
114 153         447 $Table[$winner]->give_cards($Hands[$winner], "all");
115 153         442 $Table[$loser]->give_cards($Hands[$winner], "all");
116              
117             # Make the game "interactive"
118 153 50 0     506 or do {print "Good. I'm bored too.\n"; exit;} if $Interactive;
  0         0  
  0         0  
119             } #end while (loop over turns)
120              
121 0         0 print "Too many turns. I give up.\n";
122 0         0 exit;
123              
124             ######################################################################
125             sub compare_last {
126             # compare last card in two card sets
127             # return positive value if second set wins, 0 for equality
128 161     161   205 my ($set1, $set2) = (shift, shift);
129 161         388 my $card1 = $set1->top_card;
130 161         396 my $card2 = $set2->top_card;
131              
132 161         414 return $card2->value - $card1->value;
133             }
134              
135             sub win {
136             # player arg0 wins!
137 1     1   3 my ($winner, $turns) = (shift, shift);
138 1         5 print $Hands[$winner]->{"name"}, " wins after $turns turns!\n";
139 1           exit;
140             }