Post by David Drake on Nov 16, 2021 11:41:22 GMT -5
Proposed for the Rosetta Code task at this link: www.rosettacode.org/wiki/Poker_hand_analyser
'Poker hand analyser
[start]
dim hand(10,2)
'Get card values
print "Enter five card values (1...10, j, q, or k and c, d, h, or s; examples 1c=ace of clubs, 6d=six of diamonds, jh=jack of hearts, ks=king of spades)"
for num = 1 to 5
call subGetCard num
next num
'Sort hand and display hand
sort hand(),1,5,1 'Sorts the array from smallest to largest values - important step in the analysis
'Print out the hand that was entered
print""
print "The hand you entered is:"
for a = 1 to 5
if hand(a,1)<10 then print " ";hand(a,1);
if hand(a,1)=10 then print hand(a,1);
if hand(a,1)=11 then print " J";
if hand(a,1)=12 then print " Q";
if hand(a,1)=13 then print " K";
if hand(a,2)=1 then print "-C ";
if hand(a,2)=2 then print "-D ";
if hand(a,2)=3 then print "-H ";
if hand(a,2)=4 then print "-S ";
next a
'Analyze hand for scoring
'Search for four-of-a-kind - if four subsequent n,1 values are identical
for a = 1 to 2
if hand(a,1)=hand(a+1,1) and hand(a+1,1)=hand(a+2,1) and hand(a+3,1)=hand(a+2,1) then
fourKindCount=fourKindCount+1
end if
next a
'Search for three-of-a-kind - if three subsequent n,1 values are identical
if ( hand(1,1)=hand(2,1) and hand(2,1)=hand(3,1)) or _
( hand(2,1)=hand(3,1) and hand(3,1)=hand(4,1)) or _
(hand(3,1)=hand(4,1) and hand(4,1)=hand(5,1)) then
threeKindCount=threeKindCount+1
end if
'Search for pairs - if subsequent n,1 value equals current n,1 value
if hand(1,1)=hand(2,1) then pairCount=pairCount+1
if hand(2,1)=hand(3,1) then pairCount=pairCount+1
if hand(3,1)=hand(4,1) then pairCount=pairCount+1
if hand(4,1)=hand(5,1) then pairCount=pairCount+1
'Search for full house - if there is 3OAK and one three sequential pairs but not 4OAK
if threeKindCount=1 and pairCount=3 and fourKindCount=0 then
fullHouseCount=fullHouseCount+1
end if
'Search for straight (5 cards) - if the difference between eash subsequent n,1 value is 1
if (hand(2,1)-hand(1,1))=1 and _
(hand(3,1)-hand(2,1))=1 and _
(hand(4,1)-hand(3,1))=1 and _
(hand(5,1)-hand(4,1))=1 then
straightCount=straightCount+1
end if
'Search for a flush - if all n,2 values are identical
if hand(1,2)=hand(2,2) and _
hand(2,2)=hand(3,2) and _
hand(3,2)=hand(4,2) and _
hand(4,2)=hand(5,2) then
flushCount=1
end if
'Print out results of analysis
print ""
print "---------------------------"
print "RESULTS"
print "---------------------------"
print "High card is "; 'because ALL hands have at least one high card
'if it is an ace
if hand(1,1)=1 then
print "ACE";
if hand(1,2)=1 then print "-C ";
if hand(1,2)=2 then print "-D ";
if hand(1,2)=3 then print "-H ";
if hand(1,2)=4 then print "-S ";
else
'if not an ace
if hand(5,1)<10 then print " ";hand(5,1);
if hand(5,1)=10 then print hand(5,1);
if hand(5,1)=11 then print " J";
if hand(5,1)=12 then print " Q";
if hand(5,1)=13 then print " K";
if hand(5,2)=1 then print "-C ";
if hand(5,2)=2 then print "-D ";
if hand(5,2)=3 then print "-H ";
if hand(5,2)=4 then print "-S ";
end if
'Determine the final analysis based on combinations of factors
if pairCount=1 and fullHouseCount=0 then print "and you have one pair."
if pairCount=2 and threeKindCount=0 and fourKindCount=0 then print "and you have two pairs."
if threeKindCount>0 and fourKindCount=0 and fullHouseCount=0 then print "and you have three-of-a-kind."
if fourKindCount>0 then print "and you have four-of-a-kind."
if fullHouseCount=1 then print "and you have a full house."
if straightCount>0 and flushCount=0 then print "and you have a five-card straight."
if flushCount>0 and straightCount=0 then print "and you have a flush."
if straightCount>0 and flushCount>0 then print "and you have an amazing STRAIGHT FLUSH."
end
'Input card value
sub subGetCard num
'num=card number
[cv]
print "Enter card ";num;" value: ";:input a$
a$=upper$(a$) 'capitalize the input string
suit=0:cardValue=0:v$="":s$="" 'clear all variables
if len(a$)=2 then v$=left$(a$,1) else v$=left$(a$,2)'assign left character to v$ (value);if the string length in three, then it contains "10" so assign left two characters
s$=right$(a$,1)'assign the right character to s$ (suit)
if v$<>"J" and v$<>"Q" and v$<>"K" then 'if it isn't a face card then assign numberical value=value of string
cardValue=val(v$)
else 'it is a face card, so assign value accordingly
if v$="J" then cardValue=11
if v$="Q" then cardValue=12
if v$="K" then cardValue=13
end if
'now assign numberical values to suit
if s$="C" then suit=1
if s$="D" then suit=2
if s$="H" then suit=3
if s$="S" then suit=4
'Check for value error
if cardValue<=0 or cardValue>=14 or suit<=0 then print "Card value input error": goto [cv]
for a = 1 to 5 'check for duplicate entry
if cardValue=hand(a,1) and suit=hand(a,2) then
print "error - duplicate card"
goto [cv]
end if
next a
'place card value and suit into the array
hand(num,1)=cardValue
hand(num,2)=suit
'Now print out what was entered (just as feedback)
print "You entered ";
if hand(num,1)<10 then print " ";hand(num,1);
if hand(num,1)=10 then print hand(num,1);
if hand(num,1)=11 then print " J";
if hand(num,1)=12 then print " Q";
if hand(num,1)=13 then print " K";
if hand(num,2)=1 then print "-C ";
if hand(num,2)=2 then print "-D ";
if hand(num,2)=3 then print "-H ";
if hand(num,2)=4 then print "-S ";
print
end sub