03-03-2025, 02:05 PM
Ok, I think I fixed number two. I put a 5 second sleep on the message, then cleared the line completely.
Code: (Select All)
'by John R. Duchek
'Last worked on: 2025-0303
' Chr$(6) =spades, Chr$(5) =clubs, Chr$(3) =hearts, Chr$(4) =diamonds
'known errors ------------------------
'working
'--------------------------------------
declare sub oddssheet()
declare sub directions_poker()
declare SUB poker_intro ()
declare SUB poker()
declare sub deckbuild()
declare sub choosecard()
declare sub shell_sort()
declare sub winner()
declare sub shell_sort()
declare sub check_hand()
declare sub TextSize()
declare Sub screen_setup
'dim shared are global variables.
Dim Shared As Integer bucks, payoff, bet_num, houselimit, i, card_kept
Dim Shared As Integer card(4, 14), choice(5), t
Dim Shared As Integer num_swap(5), suit_swap(5), rank_suit(5), rank_num(5)
Dim Shared As Single v1, v2, v3, v4, v5, v6
Dim Shared As String pseudo, house, dealer, coin, hand_suit(5), hand_num(5), num_rank
Dim Shared As String s, n
screen_setup
payoff = 0: bet_num = 1
file_load
'----------------------------------------------------------------------------------
Randomize Timer
'======================Program Start =================================
poker_intro
poker
'======================Program End ===================================
Sub poker ()
Cls
startit:
Color Yellow, SkyBlue
Locate 1, 1: Print String$(40, " ")
Locate 2, 1: Print String$(40, " ")
Locate 3, 1: Print String$(40, " ")
Locate 4, 1: Print String$(40, " ")
'-----bet setup--------------------------------------------------------------------------
Locate 1, 1: Print pseudo$ + ", You have " + Str$(bucks) + " " + coin$ + " in your account."
Locate 2, 1: Print "After first run, hit <enter> to keep the same bet."
bet$ = ""
Locate 3, 1: Input "Enter your bet or 'Q' to quit: "; bet$
' Locate 3, 43: Print " "
If bet$ = "" Then
bet$ = Str$(bet_num)
Locate 4, 1: Print "Current Bet: "; bet$
Else Locate 4, 1: Print "Current Bet: "; bet$
End If
If UCase$(bet$) = "Q" Then
Cls
End
End If
bet_num = Val(bet$)
If bet_num <= 0 Then GoTo startit
Locate 3, 1: If bet_num > bucks Then Print "I don't give loans, "; pseudo$: Print: GoTo startit
If houselimit > 0 And bet_num > houselimit Then
Locate 4, 1: Print "Sorry, the house limit for this game is " + Str$(houselimit) + " " + coin$
Sleep 5
Locate 4, 1: Print String$(60, " ")
GoTo startit
End If
bucks = bucks - bet_num
'-------------------------------------------------------------------------------------------
oddssheet 'was betupdate
deckbuild
For i = 1 To 5 'choose 5 cards
choosecard
Next
'--------------------------------------------------------------------------------------------
For i = 1 To 5
'changed from suit name
If hand_suit(i) = Chr$(3) Or hand_suit(i) = Chr$(4) Then
Color Red
End If
If hand_suit(i) = Chr$(5) Or hand_suit(i) = Chr$(6) Then
Color Black
End If
Locate 16 + i, 1: Print String$(40, " ")
Locate 16 + i, 1: Print i, hand_num(i); " "; hand_suit(i)
Next
Color Yellow
check_hand
For i = 1 To 5: choice(i) = 0: Next 'clear last hand
L400:
Locate 25, 1: Color Yellow: Print pseudo$;: Input ", Card numbers to keep (12345<CR>): "; keep_card$
Locate 25, 1: Print String$(60, " ")
'---------------------------------------------
For i = 16 To 21
Locate i, 1: Print String$(35, " ");
Next
' Locate 21, 1: Print String$(34, " ");
Locate 23, 1: Print String$(55, " ");
For i = 1 To 5: choice(i) = 1: Next
If (keep_card$) = Chr$(13) Then
For i = 1 To 5: choice(i) = 0: Next
GoTo L540
End If
For i = 1 To Len(keep_card$)
card_kept = Val(Mid$(keep_card$, i, 1))
choice(card_kept) = 0
Next
L540:
For i = 1 To 5
If choice(i) <> 0 Then choosecard
num_rank$ = Mid$(hand_num(i), 5, 8)
If hand_suit(i) = Chr$(3) Or hand_suit(i) = Chr$(4) Then
Color Red
End If
If hand_suit(i) = Chr$(5) Or hand_suit(i) = Chr$(6) Then
Color Black
End If
Locate 16 + i, 1: Print String$(40, " ")
Locate 16 + i, 1: Print i, hand_num(i); " "; hand_suit(i)
Next
' number_of_kind
Color Yellow
check_hand 'just added after changes
winner
' Input "Enter to continue: "; answer$
If answer$ = "q" Then End
GoTo startit
End Sub
Sub deckbuild ()
For i = 1 To 13
card(1, i) = i
card(2, i) = i
card(3, i) = i
card(4, i) = i
Next
End Sub
Sub choosecard ()
ccard:
suit = Int(Rnd * 4 + 1)
rank = Int(Rnd * 13 + 1)
If card(suit, rank) <> 0 Then GoTo suit_name Else GoTo ccard
suit_name:
card(suit, rank) = 0 'card cannot be picked twice
If suit = 1 Then s = Chr$(6) 'spades
If suit = 2 Then s = Chr$(5) 'clubs
If suit = 3 Then s = Chr$(3) 'hearts
If suit = 4 Then s = Chr$(4) 'diamonds
hand_suit(i) = s: rank_suit(i) = suit
n = " " + Str$(rank): n = Right$(n, 5)
If rank = 1 Then n = " ACE": rank = 14
If rank = 11 Then n = " JACK"
If rank = 12 Then n = "QUEEN"
If rank = 13 Then n = " KING"
choice(i) = 0: hand_num(i) = n: rank_num(i) = rank
'print hand_suit(i) +" "+ hand_num(i)
End Sub
Sub winner ()
'WINNER
'Color White
payoff = 0
Locate 23, 1: Print String$(40, " ")
' Locate 24, 1: Print t
Select Case t
Case 10
Locate 23, 1: Print "Royal Flush"
payoff = 250 * bet_num
Case 9
Locate 23, 1: Print "Straight Flush"
payoff = 100 * bet_num
Case 8
Locate 23, 1: Print "Straight"
payoff = 4 * bet_num
Case 7
Locate 23, 1: Print "Flush"
payoff = 6 * bet_num
Case 6
Locate 23, 1: Print "Four of a Kind"
payoff = 25 * bet_num
Case 4
Locate 23, 1: Print "Full House"
payoff = 9 * bet_num
Case 3
Locate 23, 1: Print "3 of a kind"
payoff = 3 * bet_num
Case 2
Locate 23, 1: Print "Two Pair"
payoff = 2 * bet_num
Case 1
If num_rank$ = " ACE" Or num_rank$ = " KING" Or num_rank$ = "QUEEN" Or num_rank$ = " JACK" Then
Locate 23, 1: Print "A GOOD PAIR = "; num_rank$; "s"
payoff = bet_num
GoTo endsel
End If
Locate 23, 1: Print "Pair too low = "; num_rank$; "s"
Case Else
If t < 1 Then Locate 23, 1: Print "NOTHING."
endsel:
End Select
bucks = bucks + payoff
If bucks <= 0 Then Locate 23, 1: Print "Heh, Heh, I've BROKEN You."
End Sub
Sub shell_sort ()
'SHELL SORT OF V( )
For i = 1 To 5: num_swap(i) = rank_num(i): suit_swap(i) = rank_suit(i): Next
v1 = 5
v2 = v1
L1130:
v2 = Int(v2 / 2)
If v2 = 0 Then GoTo endit
v3 = 1: v4 = v1 - v2
L1160:
v5 = v3
L1170:
v6 = v5 + v2
If rank_num(v5) <= rank_num(v6) Then GoTo L1230
Swap rank_num(v5), rank_num(v6)
Swap rank_suit(v5), rank_suit(v6)
v5 = v5 - v2
If v5 < 1 Then GoTo L1230
GoTo L1170
L1230:
v3 = v3 + 1
If v3 > v4 Then GoTo L1130
GoTo L1160
endit:
End Sub
Sub check_hand ()
Locate 23, 1: Print String$(40, " ")
'-----added pairs???
' L890:
t = 0: num_rank$ = ""
'pairs, 3 of a kind, 4 of a kind t=1,t=2,t=3
For i = 1 To 4: For j = (i + 1) To 5
If hand_num(i) = hand_num(j) Then
num_rank$ = hand_num(j)
t = t + 1
End If
Next: Next
'Locate 24, 1: Print t
'-----end add
'FLUSHES ok
For i = 1 To 5
If rank_suit(i) <> rank_suit(1) Then GoTo straights
Next
t = 7
straights:
shell_sort
If rank_num(1) = 2 And rank_num(2) = 3 And rank_num(3) = 4 And rank_num(4) = 5 And rank_num(5) = 14 Then GoTo L1050
For i = 1 To 4
If rank_num(i + 1) <> (1 + rank_num(i)) Then GoTo L1080
Next
L1050:
If t = 7 And rank_num(1) = 10 Then t = 10
If t = 7 Then t = 9
If t = 0 Then t = 8
L1080:
For i = 1 To 5
rank_num(i) = num_swap(i)
rank_suit(i) = suit_swap(i)
' Print rank_num(i), rank_suit(i)
Next
'---------------------------------------------------------------------------
'print check results
' L1470:
'Color bwhite
On (t + 1) GOTO nothing, pair, two_pair, three_of_a_kind, full_house, NA, four_of_a_kind, flush, straight, straight_flush, royal_flush
nothing:
Color Yellow
Locate 23, 1: Print " Hmmm....possibilities ! "
GoTo End_check
pair:
If num_rank$ = " ACE" Or num_rank$ = " KING" Or num_rank$ = "QUEEN" Or num_rank$ = " JACK" Then
Locate 23, 1: Print " A Good Pair = "; num_rank$; "s"
Else Locate 23, 1: Print " Pair too low = "; num_rank$; "s"
End If
GoTo End_check
two_pair:
Locate 23, 1: Print " Two Pair ! ": GoTo End_check
three_of_a_kind:
Locate 23, 1: Print " Three of a Kind ! ": GoTo End_check
full_house:
Locate 23, 1: Print " Full House ! ": GoTo End_check
NA:
GoTo End_check
four_of_a_kind:
Locate 23, 1: Print " Four of a Kind ! ": GoTo End_check
flush:
Locate 23, 1: Print " Flush ! ": GoTo End_check
straight:
Locate 23, 1: Print " Straight ! ": GoTo End_check
straight_flush:
Locate 23, 1: Print " Straight Flush ! ": GoTo End_check
royal_flush:
Locate 23, 1: Print " ROYAL FLUSH ! ": GoTo End_check
End_check:
End Sub
Sub file_load ()
Open "./startup.txt" For Input As #1
Input #1, coin$
Input #1, house$
Input #1, pseudo$
Input #1, dealer$
Input #1, bucks, houselimit
Close #1
End Sub
Sub TextSize (TextWidth&, TextHeight&)
TextWidth& = _PrintWidth("W") 'measure width of one font or text character
TextHeight& = _FontHeight 'can measure normal text block heights also
End Sub
Sub directions_poker
Cls
' Color bwhite, skyblue
Print " Five Card Draw"
Print
Print "The computer will deal 5 cards. Your winning combinations are"
Print "listed and computer will check your hand for you and find any "
Print "winners."
Print: Print "Choose cards to KEEP by entering 1234 and/or 5 then press RETURN"
Print "DO NOT put commas or spaces between the numbers. Cards you"
Print "choose will be kept, the others replaced. Once you press RETURN,"
Print "the computer will check your hand and indicate your holdings."
Print: Print "Your current number of " + coin + " will be displayed at the"
Print "start of the hand."
Print: Print "A new deck is used for each hand."
Print: Print "GOOD LUCK ! "
Print: Print "NOTE: Casino name, user name, monetary unit, Dealer,"
Print "starting money, and maximum bet can be changed with a"
Print "text editor in the file 'startup.txt'"
Do
Loop Until InKey$ <> ""
Cls
poker
End Sub
Sub poker_intro ()
'Screen 12
Color Black, SkyBlue
' Color White, skyblue
Cls
Color Red
Locate 1, 1:
Print " " + Chr$(3) + " " + Chr$(4) + " ";
Color Black
' Color bwhite
Print " F I V E C A R D D R A W ";
Print " " + Chr$(5) + " " + Chr$(6)
Locate 3, 1: Print house + " wishes you luck !"
Locate 4, 1: Print dealer + " welcomes you to the poker table..."
' Color bwhite
Locate 5, 1: Print pseudo + ", Would you like Directions? (y/n): ";
Input answer$
If UCase$(answer$) = "Y" Then
Cls
directions_poker
Else
Cls
poker
End If
'end if
End Sub
Sub oddssheet ()
For i = 4 To 15
Locate i, 1: Print String$(52, " ")
Next
Color Yellow
Locate 1, 1: Print pseudo$ + ", You have " + Str$(bucks) + " " + coin$ + " in your account."
Locate 4, 1: Print "Current Bet: "; bet_num
Locate 5, 1: Print "Last Payoff: "; payoff
Color Black
Locate 7, 1: Print "1 PR (JACKS OR BETTER).....", bet_num
Locate 8, 1: Print "2 PR.......................", 2 * bet_num
Locate 9, 1: Print "3 OF A KIND................", 3 * bet_num
Locate 10, 1: Print "STRAIGHT...................", 4 * bet_num
Locate 11, 1: Print "FLUSH......................", 6 * bet_num
Locate 12, 1: Print "FULL HOUSE.................", 9 * bet_num
Locate 13, 1: Print "4 OF A KIND................", 25 * bet_num
Locate 14, 1: Print "STRAIGHT FLUSH.............", 100 * bet_num
Locate 15, 1: Print "ROYAL FLUSH................", 250 * bet_num
End Sub
Sub screen_setup
'-----screen set up---------------------------------------------------------------
_Title "Five Card Draw Poker"
handle& = _NewImage(800, 600, 32)
Screen handle&
$Color:32
Color Gold, SkyBlue
TTfont$ = "courbd"
height& = 20
fnt& = _LoadFont("./" + TTfont$ + ".ttf", height&, style$ + ", BOLD")
_Font fnt&
TextSize wide&, high& 'get the font or current screen mode's text block pixel size
'----------------------------------------------------------------------------------
End Sub
