Post by GuppyB on Aug 5, 2005 22:06:33 GMT -5
Just got back from vacation in Vegas and I couldn't resist. Everything seems to be working OK, haven't been able to determine if it correctly detects 4 of kind, straight flush or royal flush but it should work (of course I didn't see any of those in Vegas either ).
Enjoy....G
Enjoy....G
' ASCII Video Poker Demo
' by GuppyB
dim card$(53)
const shuffletimes = 500
dim temp$,random1,random2
dim i,j,k
dim hand$(6), held(6), drawn(6)
dim cardlocX,cardlocY
cardlocY = 5
dim startcard
dim suit$(5)(4)
dim dealt
dim bankroll,bet,payout,jacksor,pairs,threes,fours,win$, checknumber(14), checksuit(4), straight
dim key$
ResizeText (51,30) : TextMode(TEXT_BUFFERED)
bankroll = 500: bet = 1
Gosub SetSuit : Gosub ShuffleCards
while true
for k=0 to 4
cardlocX = (k * 10) + 1
Gosub DrawCardOutline
if dealt = 0 then Gosub DrawCardDown
else
if not drawn(k+1) then Gosub DrawCardUp : endif
endif
Gosub CheckWin
Gosub DrawTopText
DrawText()
next
key$ = inkey$()
Gosub CheckKeys
WaitTimer(200)
wend
ShuffleCards:
carddata:
data 2,3,4,5,6,7,8,9,0,J,Q,K,A
reset carddata
for i = 1 to 13
read temp$
card$(i) = temp$ + "1"
card$(i + 13) = temp$ + "2"
card$(i + 26) = temp$ + "3"
card$(i + 39) = temp$ + "4"
next
for i = 1 to shuffletimes
random1 = (Rnd() % 52) + 1
random2 = (Rnd() % 52) + 1
temp$ = card$(random1)
card$(random1) = card$(random2)
card$(random2) = temp$
next
for i = 1 to 5 : held(i) = false : drawn(i) = false: next
startcard = 1 : dealt = 0
return
DrawCardOutline:
for i = 1 to 7
Locate cardLocX + i,cardLocY - 1: print chr$(151)
Locate cardLocX + i,cardLocY + 10:print chr$(151)
next
for i = 1 to 8
Locate cardLocX,cardLocY + i: print "|"
Locate cardLocX + 8,cardLocY + i:print "|"
next
Locate cardLocX,cardLocY: print "/" : Locate cardLocX + 8,cardLocY: print "\"
Locate cardLocX,cardLocY + 9:print "\" : Locate cardLocX + 8, cardLocY + 9: print "/"
return
DrawCardDown:
for i = 1 to 7
for j = 0 to 9
Locate cardLocX + i,cardLocY + j: print "X"
next
next
return
DealCards:
for i = 1 to 5
if not held(i) then hand$(i) = card$(startcard): startcard = startcard + 1 : drawn(i) = false : endif
next
dealt = dealt + 1
if dealt = 1 then bankroll = bankroll - bet : endif
return
DrawCardUp:
for i = 1 to 7
for j = 0 to 9
Locate cardLocX + i,cardLocY + j: print " "
next
next
temp$ = left$(hand$(k+1),1)
if temp$ = "0" then temp$ = "10":endif
Locate cardLocX + 1, cardLocY: print temp$
locate (CardLocX + 8)-len(temp$), cardLocY + 9:print temp$
temp$ = right$(hand$(k+1),1)
for i = 0 to 3
locate cardLocX + 1, cardLocY + 3 + i: print suit$(val(temp$))(i)
next
drawn(k+1) = true
return
SetSuit:
SuitData:
data " ^ "," / \ "," (_._) "," : "
data " ^ "," / \ "," \ / "," V "
data " _ "," _(_)_ ","(_)+(_)"," : "
data " _ _ "," ( v ) "," \ / "," v "
Reset Suitdata
for i = 1 to 4
for j = 0 to 3
read suit$(i)(j)
next
next
return
DrawTopText:
locate 17,1:print "4GL Video Poker"
locate 38,28: print "Cash: $" + bankroll
locate 1,28: print "Bet: " + bet
locate 21,28: print "Win: " + payout
locate 1,21 : print "INSTRUCTIONS:"
locate 1,22: print "press 'd' to Deal"
locate 1,23: print "press 'b' to increase bet"
locate 1,24: print "press '1' to '5' to hold cards"
locate 17,17 : print win$
locate cardLocX + 2, 3
if held(k+1) then print "hold"
else
print " "
endif
return
CheckKeys:
if key$ = "b" and dealt = 0 then bet = bet + 1: if bet = 6 then bet = 1 : endif : endif
if key$ = "d" then
Gosub DealCards
if dealt = 3 then bankroll = bankroll + (payout * bet) : Gosub ShuffleCards :endif
endif
if dealt = 1 then
if key$ = "1" then held(1) = not held(1) : endif
if key$ = "2" then held(2) = not held(2) : endif
if key$ = "3" then held(3) = not held(3) : endif
if key$ = "4" then held(4) = not held(4) : endif
if key$ = "5" then held(5) = not held(5) : endif
endif
key$ = " "
return
CheckWin:
for i = 1 to 13 : checknumber(i) = 0 : next : for i = 1 to 4 : checksuit(i) = 0 : next : win$ = " "
pairs = 0 : straight = 0 : threes = 0 : payout = 0
if dealt = 0 then return : endif
for i = 1 to 5
if left$(hand$(i),1) = "0" then checknumber(9) = checknumber(9) + 1
elseif left$(hand$(i),1) = "J" then checknumber(10) = checknumber(10) + 1
elseif left$(hand$(i),1) = "Q" then checknumber(11) = checknumber(11) + 1
elseif left$(hand$(i),1) = "K" then checknumber(12) = checknumber(12) + 1
elseif left$(hand$(i),1) = "A" then checknumber(13) = checknumber(13) + 1
elseif val(left$(hand$(i),1)) > 1 then checknumber(val(left$(hand$(i),1)) - 1) = checknumber(val(left$(hand$(i),1)) - 1) + 1
endif
checksuit(val(right$(hand$(i),1))) = checksuit(val(right$(hand$(i),1))) + 1
next
for i = 1 to 13
if i > 9 and checknumber(i) > 1 then payout = 1:win$ = "Jacks or Better " : endif
if checknumber(i) > 1 then pairs = pairs + 1 : endif
if checknumber(i) > 2 then threes = 1:payout = 3:win$ = "Three of a kind " : endif
if checknumber(i) > 3 then payout = 25:win$ = "Four of a kind " : endif
if checknumber(i) = 1 then straight = straight + 1 : endif
if i = 4 and straight = 4 and checknumber(13)=1 then straight = 5: endif
if straight = 5 then payout = 4 : win$ = "Straight " : endif
if straight < 5 and checknumber(i) = 0 then straight = 0 : endif
next
if pairs > 1 then payout = 2: win$ = "Two Pairs " : endif
if pairs > 1 and threes = 1 then payout = 9: win$ = "Full House " : endif
for i = 1 to 4
if checksuit(i) = 5 then payout = 6:win$ = "Flush ":endif
if checksuit(i) = 5 and straight = 5 then payout = 250 : win$ = "Straight Flush ":endif
if checksuit(i) = 5 and straight = 5 and checknumber(12) = 1 and checknumber(13) = 1 then payout = 500: win$ = "Royal Flush " : endif
next
if bankroll = 0 then bankroll = 500 : endif
Return