DECLARE SUB dl (a, b)
DECLARE SUB sb (a$, b$)
DECLARE SUB lp (a, b, a$)
DIM stdk(55), stut(55), shdk(55), shut(55)
DIM nm$(15)
OPEN "o", #1, "con"
co$ = LCASE$(COMMAND$)
q = 1
snd = 0
IF co$ <> "" THEN GOSUB setq
GOTO getcolor
bfgc:
CLS
SCREEN 0
WIDTH 80
LOCATE 1, 1, 1
spt$(1) = "wplay /q": spt$(2) = "plany": spt$(3) = "nusound /v:10"
ON ERROR GOTO nocfg
OPEN "i", #2, "poker.cfg"
INPUT #2, sd$
CLOSE #2
gotcfg:
RANDOMIZE TIMER
tit = INT(RND(1) * 2) + 1
IF tit = 1 THEN sb sd$, "title1" ELSE sb sd$, "title2"
FOR gn = 1 TO 14
READ nm$(gn)
NEXT gn
FOR gn = 1 TO 4
READ caty$(gn)
NEXT gn
GOSUB 3160
GOSUB 2360
40 CLS
w$ = "": r = 1: z = 0: cd = 0
LOCATE 1, 20: PRINT " DRAW POKER MACHINE         By Jim Kitchen"
LOCATE 5, 6: PRINT " your cards are"
LOCATE 7, 3: PRINT "#1"
PRINT "  #2"
PRINT "  #3"
PRINT "  #4"
PRINT "  #5"
boc = cash: GOSUB 2620
GOSUB 2860
GOSUB 2470
IF snd = 1 THEN GOTO recard
dl q, 1.2
sb sd$, "shuffle"
FOR deal = 1 TO 5
IF LCASE$(sd$) <> "wplay /q" THEN dl 1, .3
sb sd$, "deal"
NEXT deal
recard:
LOCATE 5, 6: pr$ = " your cards are "
GOSUB prt
FOR cn = 1 TO 5
GOSUB 1190
NEXT cn
IF z = 1 THEN RETURN
LOCATE 18, 2: pr$ = " " + player$
GOSUB prt
LOCATE 14, 2: pr$ = " DRAW YOUR CARDS                    "
i$ = pr$
GOSUB prt
CHC = 0
180 GOSUB gkey
IF g$ = " " THEN 420
IF g$ = "u" THEN GOTO uner
j = VAL(g$)
IF (j < 1 OR j > 5) THEN 180
IF cd = 4 THEN 180
IF shdk(j) = 0 THEN 180
IF cd < 3 THEN GOTO cds
cdok = 0
FOR cdc = 1 TO 5
IF (j <> cdc AND shdk(cdc) = 1) THEN cdok = 1
NEXT cdc
IF cdok = 0 THEN GOTO 180
cds:
LOCATE 22, 2: PRINT #1, " discarding the ";
cn = j
GOSUB 1190
LOCATE j + 6, 6: PRINT "                   "
LOCATE 22, 2: PRINT "                ";
shdk(j) = 0: shut(j) = 0
cd = cd + 1
GOTO 180
420 REM
FOR redeal = 1 TO 5
IF shdk(redeal) = 0 THEN GOSUB recards
NEXT redeal
allcards:
LOCATE 5, 6: pr$ = " your cards are now "
r = 2
GOSUB prt
FOR m = 1 TO 5
IF shdk(m) = 0 THEN shdk(m) = shdk(m + 5)
IF shut(m) = 0 THEN shut(m) = shut(m + 5)
cn = m: GOSUB 1190
NEXT m
IF z = 1 THEN RETURN
f1 = 0: FLU = 0: STA = 0: tow = 0: ROY = 0
FOR b = 2 TO 5
IF shut(1) = shut(b) THEN f1 = f1 + 1
NEXT b
IF f1 = 4 THEN FLU = 1
f1 = 0
FOR b = 2 TO 5
IF shdk(1) = shdk(b) THEN f1 = f1 + 1
NEXT b
IF f1 > 0 THEN 910
f1 = 0
FOR b = 3 TO 5
IF shdk(2) = shdk(b) THEN f1 = f1 + 1
NEXT b
IF f1 > 0 THEN 910
f1 = 0: STA = 0
FOR b = 4 TO 5
IF shdk(3) = shdk(b) THEN f1 = f1 + 1
NEXT b
IF f1 > 0 THEN 910
f1 = 0
IF shdk(4) = shdk(5) THEN f1 = f1 + 1
IF f1 > 0 THEN 910
HCN = 0: LCN = 1
FOR b = 1 TO 5
IF shdk(b) > shdk(HCN) THEN HCN = b
NEXT b
FOR b = 2 TO 5
IF shdk(b) < shdk(LCN) THEN LCN = b
NEXT b
IF shdk(HCN) - shdk(LCN) = 4 THEN STA = 1: GOTO 850
IF shdk(LCN) <> 1 THEN 850
shdk(LCN) = 14
LCN = 1
FOR b = 2 TO 5
IF shdk(b) < shdk(LCN) THEN LCN = b
NEXT b
IF shdk(LCN) = 10 THEN ROY = 1: STA = 1
850 IF (STA = 1 AND FLU = 1 AND ROY = 1) THEN tow = 10: GOTO 1030
IF (STA = 1 AND FLU = 1) THEN tow = 9: GOTO 1030
IF FLU = 1 THEN tow = 8: GOTO 1030
IF (STA = 1 AND ROY = 1) THEN tow = 7: GOTO 1030
IF STA = 1 THEN tow = 6: GOTO 1030
tow = 0: GOTO 1030
910 CC = 0
FOR CH = 1 TO 5
FOR HC = 1 TO 5
IF shdk(CH) = shdk(HC) THEN CC = CC + 1: IF HC <> CH THEN m = shdk(HC)
NEXT HC
NEXT CH
IF CC = 17 THEN tow = 5: GOTO 1030
IF CC = 13 THEN tow = 4: GOTO 1030
IF CC = 11 THEN tow = 3: GOTO 1030
IF CC = 9 THEN tow = 2: GOTO 1030
IF m > 10 THEN tow = 1
IF m = 1 THEN tow = 1
1030 REM DIS TOW
IF tow = 0 THEN w$ = " PAYS NOTHING - LOSS OF BET": cash = cash - bet: GOTO 1130
ON tow GOSUB 3060, 3070, 3080, 3090, 3100, 3110, 3120, 3130, 3140, 3150
cash = cash + ca
1130 GOSUB pw
IF tow = 0 THEN GOSUB lose: GOTO nochip
IF snd = 1 THEN GOTO nochip
dl q, 4.7
FOR xxx = 1 TO ncp
IF LCASE$(sd$) <> "wplay /q" THEN dl 1, .15
sb sd$, "chips"
NEXT xxx
nochip:
cash = INT(cash)
LOCATE 18, 2
PRINT SPC(78);
fr2:
LOCATE 18, 2: PRINT #1, " " + player$ + " you now have $ ";
boc = cash
IF z = 1 THEN GOTO 2642
GOSUB 2642
oop:
LOCATE 22, 2: pr$ = " PRESS C TO CONTINUE or E to exit "
i$ = pr$
GOSUB prt
GOSUB gkey
IF cash < 1 THEN GOTO 5000
IF g$ = "e" THEN 5000
IF g$ = "c" THEN GOTO 40
IF dd = 13 THEN GOTO 40
t = 1
GOTO oop
1190 REM SHOW
IF shdk(cn) = 0 THEN RETURN
LOCATE cn + 6, 6
PRINT #1, nm$(shdk(cn));
PRINT #1, " of ";
PRINT #1, caty$(shut(cn))
RETURN
2360 REM SET ST DECK
PL = 1
FOR SSS = 1 TO 4
FOR SDS = 1 TO 13
stdk(PL) = SDS: stut(PL) = SSS
PL = PL + 1
NEXT SDS
NEXT SSS
RETURN
2470 REM SHUF DECK
FOR cn = 1 TO 10
2490 RANDOMIZE TIMER
PC = INT(RND(1) * 52) + 1
SP(cn) = PC
cl = 1
2550 IF cl = cn THEN 2580
IF SP(cl) = SP(cn) THEN 2490
cl = cl + 1: GOTO 2550
2580 shdk(cn) = stdk(PC)
shut(cn) = stut(PC)
IF cn < 6 THEN oldcard(cn) = shdk(cn)
IF cn < 6 THEN oldsue(cn) = shut(cn)
NEXT cn
RETURN
2620 REM PRINT CASH
2630 LOCATE 18, 2: pr$ = " " + player$ + " You have $ "
GOSUB prt
2640 IF t = 0 THEN GOTO 2645
2642 IF boc < 9.5 THEN PRINT #1, USING "#"; boc: RETURN
IF boc < 99.5 THEN PRINT #1, USING "##"; boc: RETURN
IF boc < 999.5 THEN PRINT #1, USING "###"; boc: RETURN
IF boc < 9999.5 THEN PRINT #1, USING "#,###"; boc: RETURN
IF boc < 99999.5 THEN PRINT #1, USING "##,###"; boc: RETURN
IF boc < 999999.5 THEN PRINT #1, USING "###,###"; boc: RETURN
IF boc < 9999999.5# THEN PRINT #1, USING "#,###,###"; boc: RETURN
IF boc < 99999999.5# THEN PRINT #1, USING "##,###,###"; boc: RETURN
IF boc < 999999999.5# THEN PRINT #1, USING "###,###,###"; boc: RETURN
IF boc < 9999999999.5# THEN PRINT #1, USING "#,###,###,###"; boc: RETURN
IF boc < 99999999999.5# THEN PRINT #1, USING "##,###,###,###"; boc: RETURN
IF boc < 999999999999.5# THEN PRINT #1, USING "###,###,###,###"; boc: RETURN
IF boc < 9999999999999.5# THEN PRINT #1, USING "#,###,###,###,###"; boc: RETURN
IF boc < 99999999999999.5# THEN PRINT #1, USING "##,###,###,###,###"; boc: RETURN
IF boc < 1D+15 THEN PRINT #1, USING "###,###,###,###,###"; boc: RETURN
IF boc < 1D+16 THEN PRINT #1, USING "#,###,###,###,###,###"; boc: RETURN
IF boc < 1D+17 THEN PRINT #1, USING "##,###,###,###,###,###"; boc: RETURN
IF boc < 1D+18 THEN PRINT #1, USING "###,###,###,###,###,###"; boc: RETURN
IF boc < 1D+19 THEN PRINT #1, USING "#,###,###,###,###,###,###"; boc: RETURN
IF boc < 1D+20 THEN PRINT #1, USING "##,###,###,###,###,###,###"; boc: RETURN
PRINT #1, USING "###,###,###,###,###,###,###,###"; boc: RETURN
2645 REM
IF boc < 9.5 THEN PRINT USING "#"; boc: RETURN
IF boc < 99.5 THEN PRINT USING "##"; boc: RETURN
IF boc < 999.5 THEN PRINT USING "###"; boc: RETURN
IF boc < 9999.5 THEN PRINT USING "#,###"; boc: RETURN
IF boc < 99999.5 THEN PRINT USING "##,###"; boc: RETURN
IF boc < 999999.5 THEN PRINT USING "###,###"; boc: RETURN
IF boc < 9999999.5# THEN PRINT USING "#,###,###"; boc: RETURN
IF boc < 99999999.5# THEN PRINT USING "##,###,###"; boc: RETURN
IF boc < 999999999.5# THEN PRINT USING "###,###,###"; boc: RETURN
IF boc < 9999999999.5# THEN PRINT USING "#,###,###,###"; boc: RETURN
IF boc < 99999999999.5# THEN PRINT USING "##,###,###,###"; boc: RETURN
IF boc < 999999999999.5# THEN PRINT USING "###,###,###,###"; boc: RETURN
IF boc < 9999999999999.5# THEN PRINT USING "#,###,###,###,###"; boc: RETURN
IF boc < 99999999999999.5# THEN PRINT USING "##,###,###,###,###"; boc: RETURN
IF boc < 1D+15 THEN PRINT USING "###,###,###,###,###"; boc: RETURN
IF boc < 1D+16 THEN PRINT USING "#,###,###,###,###,###"; boc: RETURN
IF boc < 1D+17 THEN PRINT USING "##,###,###,###,###,###"; boc: RETURN
IF boc < 1D+18 THEN PRINT USING "###,###,###,###,###,###"; boc: RETURN
IF boc < 1D+19 THEN PRINT USING "#,###,###,###,###,###,###"; boc: RETURN
IF boc < 1D+20 THEN PRINT USING "##,###,###,###,###,###,###"; boc: RETURN
PRINT USING "###,###,###,###,###,###,###,###"; boc: RETURN
2860 REM GET BET
LOCATE 20, 2: pr$ = " Enter your bet $ "
GOSUB prt
LOCATE 20, 20: INPUT bt$
IF bt$ = "" THEN 2910
ABT$ = bt$
2910 IF RIGHT$(ABT$, 1) <> "%" THEN 2950
IF INT(VAL(ABT$)) > 100 THEN 3040
IF INT(VAL(ABT$)) < 1 THEN 3040
bet = INT(VAL(ABT$) * cash) / 100: GOTO 2990
2950 BCT = VAL(ABT$)
IF BCT > cash THEN 3040
IF BCT < 0 THEN 3040
bet = VAL(ABT$)
2990 FOR CBL = 2 TO LEN(ABT$) + 21
LOCATE 20, CBL: PRINT " "
NEXT CBL
boc = bet: LOCATE 20, 2: pr$ = " Bet = $ "
IF (reb = 0 AND snd = 0) THEN sb sd$, "chips"
GOSUB prt
GOTO 2640
3040 BEEP: LOCATE 20, 2: PRINT "                                     "
BEEP: GOTO 2860
3060 w$ = " A Pair of Jacks or better Pays 1 to 1 ": ca = bet: ncp = 1: RETURN
3070 w$ = " Two Pair Pays 2 to 1": ca = bet * 2: ncp = 2: RETURN
3080 w$ = " Three of a kind Pays 3 to 1": ca = bet * 3: ncp = 3: RETURN
3090 w$ = " A Full House Pays 13 to 1": ca = bet * 13: ncp = 13: RETURN
3100 w$ = " Four of a kind Pays 21 to 1": ca = bet * 21: ncp = 21: RETURN
3110 w$ = " A Straight Pays 5 to 1": ca = bet * 5: ncp = 5: RETURN
3120 w$ = " A Royal Straight Pays 7 to 1": ca = bet * 7: ncp = 7: RETURN
3130 w$ = " A Flush Pays 11 to 1": ca = bet * 11: ncp = 11: RETURN
3140 w$ = " A Straight Flush Pays 75 to 1": ca = bet * 75: ncp = 75: RETURN
3150 w$ = " A Royal Straight Flush Pays 125 to 1": ca = bet * 125: ncp = 125: RETURN
3160 REM START
CLS
SCREEN 0
WIDTH 80
repoke:
LOCATE 1, 20: PRINT #1, " DRAW POKER MACHINE          By Jim Kitchen"
LOCATE 3, 2, 1: PRINT #1, " Would you like instructions ( y or n ) ";
GOSUB gkey
IF g$ = "n" THEN GOTO 3370
IF dd = 59 THEN GOTO repoke
IF dd = 27 THEN GOTO sy
reins:
LOCATE 5, 1: PRINT #1, " To bet Enter the dollar amount or Enter a % after a value to bet that percent"
PRINT #1, " of your cash or press Enter to bet the same percent or amount as your last bet"
LOCATE 8, 1: PRINT #1, " Press the number of the card that you want to discard "
PRINT #1, " The u key will unerase all of the cards."
PRINT #1, "   Pressing the Space Bar will draw the new cards "
LOCATE 12, 2: PRINT #1, " You will need a pair of jacks or better to win "
LOCATE 14, 1: PRINT #1, "* Note for useres of screen readers.  The letter t will toggle the speaking"
PRINT #1, "  of some of the repeated information.  Also the F1 through F10 keys will"
PRINT #1, "  respeak the information that is on the screen."
lp 18, 1, " The s key will toggle the playing of the sound files off and on"
lp 20, 1, " Are you ready to play Y or N"
GOSUB gkey
LOCATE 20, 1
PRINT SPC(78);
IF g$ = "y" THEN GOTO 3370
IF dd = 13 THEN GOTO 3370
IF dd = 27 THEN GOTO sy
FOR cl = 2 TO 22
LOCATE cl, 1
PRINT SPC(78);
NEXT cl
dl 1, .5
GOTO reins
3370 LOCATE 20, 2: PRINT #1, " Please enter your name "
LOCATE 20, 26: LINE INPUT player$
LOCATE 22, 2: PRINT #1, " O K and how much money did you bring to lose $ "
LOCATE 22, 50: LINE INPUT ca$
cash = VAL(ca$)
sc = cash
t = 1
IF snd = 0 THEN sb sd$, "chips"
RETURN
5000 CLS
LOCATE 1, 20: PRINT #1, " DRAW POKER MACHINE          By Jim Kitchen"
LOCATE 3, 2: PRINT #1, " Thank you for playing " + player$
IF cash > sc THEN 5050
yom = sc - cash
IF yom > (sc - 1) THEN yom = sc
yom = INT(yom)
p$ = " You can send ay check for the " + STR$(yom) + " dollars that you just lost to Jim Kitchen"
LOCATE 5, 2: PRINT #1, p$
GOTO 5100
5050 yom = INT(cash - sc)
p$ = " You will receive ay check for the " + STR$(yom) + " dollars that you just won"
LOCATE 5, 2: PRINT #1, p$
5100 LOCATE 22, 11, 1: PRINT #1, " Press Any Key to Exit ";
r = 3
GOSUB gkey
IF dd = 59 THEN GOTO 5000
IF tit = 1 THEN sb sd$, "title2" ELSE sb sd$, "title1"
sy:
CLS
SYSTEM
eorn:
lp 24, 1, " Press e to exit s to shell to dos or any other key to return to the game"
DO: LOOP UNTIL INKEY$ = ""
DO
g$ = INKEY$
LOOP UNTIL g$ <> ""
LOCATE 24, 1
PRINT SPC(78);
g$ = LCASE$(g$)
dd = ASC(RIGHT$(g$, 1))
IF dd = 59 THEN GOTO eorn
IF g$ = "e" THEN GOTO 5000
IF g$ = "s" THEN GOTO shellpro
GOTO pi
shellpro:
kps$ = CURDIR$
CLS
PRINT #1, " O K shelling to dos"
PRINT #1, " "
SHELL "command /k prompt=Type exit to return to the poker game.$_$p$g"
FOR rep = 333 TO 666 STEP 111
SOUND rep, 2
NEXT rep
rdr$ = LEFT$(kps$, 2)
SHELL rdr$
ps = LEN(kps$)
rcd$ = "cd" + RIGHT$(kps$, (ps - 2))
SHELL rcd$
gcl = 1
CLS
lp 1, 20, " DRAW POKER MACHINE          By Jim Kitchen"
LOCATE 5, 6: PRINT " your cards are"
LOCATE 7, 3: PRINT "#1"
PRINT "  #2"
PRINT "  #3"
PRINT "  #4"
PRINT "  #5"
IF r = 1 THEN z = 1: GOSUB recard
IF r = 2 THEN z = 1: GOSUB allcards
GOTO pi
lose:
IF snd = 1 THEN RETURN
dl q, 4.3
sb sd$, "losechip"
RETURN
recards:
IF snd = 1 THEN RETURN
IF LCASE$(sd$) <> "wplay /q" THEN dl 1, .3
sb sd$, "deal"
RETURN
getcolor:
ON ERROR GOTO noco
x = SCREEN(1, 1, 1)
dfc = (x AND 128) \ 8 + (x AND 15)
dbc = (x AND 112) \ 16
COLOR dfc, dbc
renoco:
ON ERROR GOTO 0
GOTO bfgc
noco:
RESUME renoco
setq:
j = INSTR(co$, "/d")
IF j = 0 THEN RETURN
k = LEN(co$)
k = k - (j + 1)
q = VAL(RIGHT$(co$, k))
q = q / 100
RETURN

nocfg:
RESUME nc0
nc0:
ON ERROR GOTO 0
nc1:
lp 8, 1, " Please press the number of the sound player program to try"
lp 10, 1, " 1 = wplay"
lp 11, 1, " 2 = plany"
lp 12, 1, " 3 = nusound"
beg = 1
GOSUB gkey
IF dd = 27 THEN GOTO sy
beg = 0
g = VAL(g$)
IF (g < 1 OR g > 3) THEN GOTO nc1
sd$ = spt$(g)
nc2:
sb sd$, "aha"
sb sd$, "shuffle"
lp 15, 1, " Press y to use this sound player"
lp 16, 1, " or if you didn't hear anything then press n to try a different player"
beg = 1
GOSUB gkey
beg = 0
IF (dd > 58 AND dd < 64) THEN GOTO nc2
IF g$ <> "y" THEN GOTO nc1
OPEN "o", #2, "poker.cfg"
PRINT #2, sd$
CLOSE #2
GOTO gotcfg
pw:
IF w$ = "" THEN RETURN
LOCATE 14, 2
PRINT #1, w$
RETURN
uner:
FOR vl = 1 TO 5
shdk(vl) = oldcard(vl)
shut(vl) = oldsue(vl)
NEXT vl
cd = 0
GOTO recard
pi:
IF MID$(i$, 2, 1) = "P" THEN LOCATE 22, 2 ELSE LOCATE 14, 2
PRINT #1, i$
GOTO gkey
prt:
IF t = 1 THEN PRINT #1, pr$;
IF t = 0 THEN PRINT pr$;
RETURN
bkey:
z = 0
t = ot
gkey:
DO: LOOP UNTIL INKEY$ = ""
DO
g$ = INKEY$
LOOP UNTIL g$ <> ""
dd = ASC(RIGHT$(g$, 1))
IF dd = 27 THEN GOTO eorn
IF r = 3 THEN RETURN
g$ = LCASE$(g$)
IF r = 0 THEN RETURN
IF g$ = "t" THEN GOTO tog
IF g$ = "s" THEN GOTO sot
IF (dd > 58 AND dd < 64) THEN cn = dd - 58: GOSUB 1190: GOTO gkey
IF dd = 64 THEN GOTO pi
IF dd = 65 THEN GOSUB pw: GOTO gkey
ot = t
t = 1
IF (dd = 66 AND r = 1) THEN boc = cash: GOSUB 2620: GOTO bkey
IF (dd = 66 AND r = 2) THEN z = 1: GOSUB fr2: GOTO bkey
IF dd = 67 THEN reb = 1: GOSUB 2990: reb = 0: GOTO bkey
IF (dd = 68 AND r = 1) THEN z = 1: GOSUB recard: GOTO bkey
IF (dd = 68 AND r = 2) THEN z = 1: GOSUB allcards: GOTO bkey
t = ot
RETURN
tog:
LOCATE 25, 2: PRINT #1, " speech toggled please continue ";
IF t = 1 THEN t = 0 ELSE t = 1
LOCATE 25, 2: PRINT "                                ";
GOTO gkey
sot:
lp 25, 1, " Sound toggled please continue"
IF snd = 1 THEN snd = 0 ELSE snd = 1
lp 25, 1, "                                    "
GOTO gkey
DATA Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten
DATA Jack,Queen,King,Ace,Harts,Diamonds,Spades,Clubs

SUB dl (a, b)
zz = a * b
st = TIMER
DO
LOOP UNTIL TIMER > st + zz
END SUB

SUB lp (a, b, a$)
LOCATE a, b
PRINT #1, a$;
END SUB

SUB sb (a$, b$)
SHELL a$ + " " + b$ + ".wav > nul"
END SUB

