DECLARE SUB PrintCards (H() AS ANY)
DECLARE SUB CheckPairsWin ()
DECLARE SUB CountPairs ()
DECLARE FUNCTION CountEqual! (H() AS ANY)
DECLARE FUNCTION EvaluatePokerHand! (H() AS ANY)
DECLARE SUB GiveCards (hand() AS ANY)
DECLARE SUB GiveTwoPokerHands ()
DECLARE SUB GetRandomPermutation (P() AS INTEGER)
DECLARE SUB Comment (T$)
DECLARE SUB InitializeDeck ()
DECLARE SUB shuffleDeck ()
DECLARE FUNCTION Requestednumber! ()
'declarations

TYPE cards
suit AS INTEGER
value AS INTEGER
Face AS STRING * 10
END TYPE
DIM SHARED Deck(52) AS cards
InitializeDeck

Comment "First -lets see two sample hands"
GiveTwoPokerHands
Comment "Now evaluate How often a player get a pair "
CountPairs

Comment "check How often pairs win"

CheckPairsWin

END

SUB CheckPairsWin
'How often a given pair wins?
Comment "CheckpairsWin SUB is not operational"
END SUB

SUB Comment (T$)
'print comments while program executes
BEEP
COLOR 2, 0
cs = CSRLIN
ps = POS(1)
PRINT "Comment: ";
PRINT T$
PRINT "Press any key to continue..."
WHILE INKEY$ = ""
WEND
cs2 = CSRLIN
COLOR 7, 0
LOCATE cs, ps
FOR j = cs TO cs2
PRINT SPACE$(80)
NEXT j
LOCATE cs, ps
END SUB

FUNCTION CountEqual (H() AS cards)
'count how many cards are equal
'*** count how many of five numbers are the same value
'*** return one of them in first position
max = 0
FOR j = 1 TO 5
    ck = 0
    FOR k = 1 TO 5
        IF H(k).value = H(j).value THEN ck = ck + 1
    NEXT k
    IF ck > max THEN max = ck: SWAP H(j), H(1)
NEXT j
'assign value to function
CountEqual = max

END FUNCTION

SUB CountPairs
'simulate many card sets to see how often get pairs
SimSize = 5000
FOR j = 1 TO SimSize
IF (j MOD 100) = 0 THEN PRINT ".";
REDIM H(5) AS cards
shuffleDeck
GiveCards H()
IF EvaluatePokerHand(H()) = 2 THEN NumPairs = NumPairs + 1

NEXT j
PRINT "Pairs seem to occur in proportion "; USING "#.####"; NumPairs / SimSize


END SUB

FUNCTION EvaluatePokerHand (H() AS cards)
' assign numerical values to various poker hands
'pair = value of pair
'nothing else implemented
NumEq = CountEqual(H())
SELECT CASE NumEq
        CASE IS < 2
                'should Check4Straight
                EvaluatePokerHand = 0
        CASE 2 'have at least one pair
                'should check4TwoPairs
                EvaluatePokerHand = H(1).value
        CASE 3
                'check4Pair
                EvaluatePokerHand = 100 + H(1).value
        CASE 4
                EvaluatePokerHand = 200 + H(1).value
                CASE ELSE
END SELECT
END FUNCTION

SUB GetRandomPermutation (P() AS INTEGER)
'P(j) is the position of #j in random permutation
n = UBOUND(P)
REDIM P(n) AS INTEGER
'initialize entries
FOR j = 1 TO n
P(j) = j
NEXT j

nx = n
FOR j = 1 TO n
'take a card at random and put it away
x = INT(RND(1) * nx + 1)
SWAP P(x), P(nx)
nx = nx - 1
NEXT j
END SUB

SUB GiveCards (hand() AS cards)
'give next n cards
'communication:
n = UBOUND(hand)
STATIC GivenOut
IF n = 0 THEN
GivenOut = 0
ELSE
GivenOut = GivenOut + n
END IF
IF n + GivenOut > 52 THEN
'Comment "Sorry, don't have that many cards. Will reshuffle"
GivenOut = 0
shuffleDeck
END IF

        FOR j = GivenOut + 1 TO GivenOut + n
               hand(j - GivenOut) = Deck(j)
        NEXT j

END SUB

SUB GiveTwoPokerHands
'Prints two Poker hands
DIM H(5) AS cards
shuffleDeck
FOR T = 1 TO 2
        CALL GiveCards(H())
        PrintCards H()
NEXT T
END SUB

SUB InitializeDeck
'Intialize the deck of cards
'prepare screen
CLS
DIM Face$(4)
Face$(1) = "Clubs"
Face$(2) = "Spades"
Face$(3) = "Diamonds"
Face$(4) = "Hearts"
FOR j = 1 TO 52
        Deck(j).suit = (j MOD 4) + 1
        Deck(j).value = (j MOD 13) + 1
        Deck(j).Face = Face$(Deck(j).suit)
NEXT j

END SUB

SUB PrintCards (H() AS cards)
n = UBOUND(H)
DIM Face$(4)
Face$(1) = "Clubs"
Face$(2) = "Spades"
Face$(3) = "Diamonds"
Face$(4) = "Hearts"
DIM Name$(13)
Name$(1) = "Ace of "
FOR j = 2 TO 10
Name$(j) = STR$(j) + " of "
NEXT j
Name$(11) = "Jack of "
Name$(12) = "Queen of "
Name$(13) = "King of "
n = UBOUND(H)
FOR j = 1 TO n
PRINT Name$(H(j).value) + Face$(H(j).suit);
NEXT j
PRINT

END SUB

FUNCTION Requestednumber
        'ask user how many cards they want
PRINT "Enter the number of cards you want and hit return."
INPUT n
        Requestednumber = n
IF n > 52 THEN BEEP: PRINT "Don't have that many": EXIT FUNCTION
IF n < 0 THEN BEEP: PRINT "Are you joking?": EXIT FUNCTION
END FUNCTION

SUB shuffleDeck
'Shuffle the deck of cards
n = UBOUND(Deck)
ns = n
FOR j = 1 TO n
'take a card at random and put it away
k = INT(RND(1) * ns + 1)
SWAP Deck(k), Deck(ns)
ns = ns - 1
NEXT j
END SUB