REM **************************************************************************
REM 5-Hand Poker Slots and Evaluator - Copyright Pecos Pete of QB Forum 2006.
REM Works with QBasic 1.x or QuickBasic versions 4.5-7.1.
REM Requires /l switch to be loaded with QuickBasic. /l Not needed for QBasic.
REM **************************************************************************
REM Left Click or Drag Mouse with Left Button Depressed to HOLD Cards.
REM Right Click or Drag Mouse with Right Button Depressed to Remove HOLD.
REM Left/Right Click to Place/Remove Bet.
REM Left Click Deal to Draw when Ready.
REM Run Program FULL SCREEN for Correct Color and Pseudo-Mouse Function.
REM Change MouseOpt% = 0 to MouseOpt% = 1 to disable the PseudoMouse.
DECLARE SUB DrawCards ()
DECLARE SUB Evaluate ()
DECLARE SUB Display ()
DECLARE SUB Sort ()
DECLARE SUB Shuffle ()
DECLARE SUB Deal ()
DECLARE SUB MDriver (Ex%, b$)
DECLARE SUB MDriverCA (Ex%, b$)
DECLARE SUB Getkey (b$)
DECLARE SUB Border ()
DECLARE SUB PinStripe ()
DECLARE SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DECLARE SUB PayOff ()
DECLARE SUB BankDisplay ()
RANDOMIZE TIMER
OPTION BASE 1
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
END TYPE
DIM SHARED Mouse$, Game$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX%, CY%
DIM SHARED CARD(52) AS INTEGER, Player(5, 5) AS INTEGER, CardCnt AS INTEGER, Hold(5, 5) AS INTEGER
DIM SHARED Hand(5) AS INTEGER
DIM SHARED Playerx$(5, 5), Delt$, box AS INTEGER, QB AS LONG, MouseOpt AS INTEGER
DIM SHARED xx1 AS INTEGER, yy1 AS INTEGER, xspc AS INTEGER, yspc AS INTEGER, Bank AS INTEGER
DIM SHARED Bet(5) AS INTEGER, HighPair(5) AS INTEGER
xx1 = 8: yy1 = 28: xspc = 2: yspc = 5
Game$ = "Slots": REM Game choices "Evaluate" and "Slots"
Bank = 100
QB = VAL("&"): REM Get version of QB for mouse.
IF QB = 203 THEN QB = 4.5 ELSE QB = 1.1
MouseOpt% = 0: REM 0=custom mouse Cursor. 1=System mouse Cursor
SCREEN 0, 0, 1, 0
PALETTE 7, 63: REM Lettering
PALETTE 13, 0: REM Lettering
PALETTE 12, 36: REM Red Cards
PALETTE 1, 16: REM Dark Green Dealer
PALETTE 2, 10: REM Inner Green felt
PALETTE 5, 32: REM Table Border Dark Redwood
PALETTE 3, 16: REM Outer Dark Green
DO
SCREEN 0, 0, 1, 0
IF NextRound% = 0 THEN
COLOR 7, 3: CLS
COLOR 15, 3
LOCATE 11, 33, 1, 7, 0: PRINT "Pecos Pete Poker"
LOCATE 13, 29: COLOR 12, 7: PRINT "K"; CHR$(4); : COLOR 7, 3
PRINT " Click Mouse to Begin!"
LOCATE 24, 4: PRINT "[E] Evaluate Only";
LOCATE 24, 65: PRINT "[Esc] to Quit";
CALL PinStripe
PCOPY 1, 0: SCREEN 0, 0, 0, 0
Delt$ = "Options"
CALL Getkey(b$)
IF UCASE$(b$) = "E" THEN Game$ = "Evaluate"
Delt$ = ""
SCREEN 0, 0, 1, 0
COLOR 0, 2
CLS
CALL Border
ELSE
VIEW PRINT xx1 TO xx1 + (5 + 2) * xspc: COLOR 0, 2: CLS 2: VIEW PRINT: CALL Border
END IF
CALL Shuffle
Delt$ = "Shuffled"
IF Game$ = "Slots" THEN Delt$ = "PlaceBet"
CALL Display
CALL Getkey(b$)
Delt$ = ""
CALL Deal
CALL Sort
CALL Evaluate
DO
IF Delt$ = "Delt" THEN
CALL Evaluate
EXIT DO
ELSE
CALL DrawCards
END IF
LOOP
CALL Getkey(b$)
ERASE CARD
ERASE Player
ERASE Playerx$
ERASE Hand
ERASE Hold
ERASE Bet
ERASE HighPair
CardCnt = 0: Delt$ = ""
IF b$ = CHR$(27) THEN RUN
NextRound% = 1
LOOP
Rank:
DATA "Pair","Two Pair","Three of a Kind","Straight","Flush","Full House","Four of a Kind","Straight Flush"
PaySlots:
DATA 1,2,3,4,6,9,25,50,800
MouseData:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
SUB BankDisplay
COLOR 0, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 7: PRINT SPACE$(10);
LOCATE xx1 + 5 * xspc + 2, yy1: PRINT "Bank $" + LTRIM$(STR$(Bank));
END SUB
SUB Border
COLOR 0, 3
LOCATE 4, 1
FOR i = 4 TO 22
PRINT SPACE$(7); : LOCATE , 74: PRINT SPACE$(7);
NEXT
LOCATE 1, 1
PRINT SPACE$(240);
LOCATE 23, 1: PRINT SPACE$(160);
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 2, 3: COLOR 7, 3: PRINT "Pecos Pete Poker"
LOCATE 24, 66: PRINT "[Esc] to Exit";
COLOR 0, 2
END SUB
SUB Deal
FOR i = 1 TO 5
FOR j = 1 TO 5
CardCnt = CardCnt + 1
Player(i, j) = CARD((i - 1) * 5 + j)
NEXT j, i
END SUB
SUB Display
SCREEN 0, 0, 1, 0
VIEW PRINT xx1 TO xx1 + 5 * xspc: COLOR 0, 2: CLS 2: VIEW PRINT
CALL Border
box = 1: CALL PinStripe
LOCATE xx1 - 2, yy1 - 15
COLOR 0, 2
PRINT SPACE$(58); : LOCATE xx1 - 2, yy1 - 15
SELECT CASE Delt$
CASE "": PRINT "Use mouse to mark cards to HOLD:"
CASE "PlaceBet": PRINT "Click " + CHR$(34); "?"; CHR$(34); " to Bet or [*] Bet-Max. Jacks or Better to Win!"
CASE "Shuffled": PRINT "Press Deal to show cards:"
CASE "Delt": PRINT "Payoff Results:"
END SELECT
LOCATE xx1
FOR i = 1 TO 5
FOR j = 1 TO 5
Tempx$ = LTRIM$(STR$(Player(i, j) MOD 13 + 1))
SELECT CASE Player(i, j) MOD 13 + 1
CASE 11: Tempx$ = "J"
CASE 12: Tempx$ = "Q"
CASE 13: Tempx$ = "K"
CASE 1: Tempx$ = "A"
END SELECT
Playerx$(i, j) = Tempx$ + CHR$(Player(i, j) MOD 4 + 3)
NEXT
COLOR 0, 2
SELECT CASE Game$
CASE "Evaluate": LOCATE , yy1 - 12: PRINT "Player"; i;
CASE "Slots"
LOCATE , yy1 - 13
IF Delt$ = "" THEN
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 0, 2: PRINT LTRIM$(STR$(Bet(i))); : COLOR 0, 2: PRINT "]";
ELSE
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 3, 2: PRINT "?"; : COLOR 0, 2: PRINT "]";
END IF
END SELECT
FOR H% = 1 TO 5
LOCATE , yy1 + (H% - 1) * yspc
IF INSTR(Playerx$(i, H%), CHR$(6)) <> 0 OR INSTR(Playerx$(i, H%), CHR$(5)) <> 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
IF Delt$ = "Shuffled" OR Delt$ = "PlaceBet" THEN
COLOR 5: PRINT CHR$(176); CHR$(176);
ELSE
PRINT Playerx$(i, H%);
END IF
NEXT H%
RESTORE Rank
COLOR 0, 2
FOR j = 1 TO Hand(i): READ Rank$: NEXT
IF Hand(i) = 8 AND Player(i, 1) = 0 THEN Rank$ = "Royal Flush": Hand(i) = 9
IF Rank$ <> "" THEN LOCATE , yy1 + yspc * 6 - yspc + 1: PRINT Rank$; : Rank$ = ""
FOR k% = 1 TO xspc: PRINT : NEXT
NEXT
COLOR 7, 1
IF Game$ = "Slots" THEN
LOCATE xx1 + 5 * xspc, yy1 - 12
SELECT CASE Delt$
CASE "Delt": PRINT " Play ";
CASE "PlaceBet": PRINT " Show ";
CASE ELSE: PRINT " Deal ";
END SELECT
CALL BankDisplay
ELSE
LOCATE xx1 + 5 * xspc, yy1 - 12: PRINT " Deal ";
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
IF Delt$ = "Delt" AND Game$ = "Slots" THEN CALL PayOff
COLOR 0, 2
END SUB
SUB DrawCards
CALL Getkey(b$)
IF b$ = CHR$(27) THEN EXIT SUB
IF b$ = "Deal" THEN
FOR j = 1 TO 5
FOR i = 1 TO 5
IF Hold(j, i) = 0 THEN
CardCnt = CardCnt + 1
Player(j, i) = CARD(CardCnt)
END IF
NEXT i, j
Delt$ = "Delt"
SCREEN 0, 0, 1, 0
CALL Sort
END IF
END SUB
SUB Evaluate
REM Evaluate Straight
REDIM TieBreaker$(5)
FOR j = 1 TO 5
Hand(j) = -1
FOR i = 1 TO 5 - 1
x1 = Player(j, i) MOD 13 + 1
x2 = Player(j, i + 1) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
IF x2 = 1 THEN x2 = 14
IF x1 <> x2 + 1 THEN Flag = 1: EXIT FOR
NEXT
IF Flag = 1 THEN Flag = 0 ELSE Hand1$ = "Straight"
REM Evaluate Flush
FOR i = 1 TO 5 - 1
IF Player(j, i) MOD 4 <> Player(j, i + 1) MOD 4 THEN Flag = 1: EXIT FOR
NEXT
IF Flag = 1 THEN Flag = 0 ELSE Hand2$ = "Flush"
IF Hand1$ = "Straight" THEN Hand(j) = 4
IF Hand2$ = "Flush" THEN Hand(j) = 5
IF Hand1$ = "Straight" AND Hand2$ = "Flush" THEN Hand(j) = 8
Hand1$ = "": Hand2$ = ""
REDIM pair(14)
IF Hand(j) < 0 THEN
REM Evaluate Pairs
FOR i = 1 TO 5
x1 = Player(j, i) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
pair(x1) = pair(x1) + 1
NEXT
END IF
FOR k = 1 TO 5
x% = Player(j, k) MOD 13 + 1
IF x% = 1 THEN x% = 14
IF x% < 10 THEN x$ = "0" + LTRIM$(STR$(x%)) ELSE x$ = LTRIM$(STR$(x%))
xtot$ = xtot$ + x$
NEXT k
TieBreaker$(j) = xtot$: xtot$ = ""
FOR i = 2 TO 14
IF pair(i) > 1 THEN
SELECT CASE pair(i)
CASE 2
IF Hand(j) = 1 THEN Hand(j) = 2 ELSE IF Hand(j) = 3 THEN Hand(j) = 6 ELSE Hand(j) = 1
CASE 3
IF Hand(j) = 2 THEN Hand(j) = 6 ELSE IF Hand(j) = 1 THEN Hand(j) = 6 ELSE Hand(j) = 3
CASE 4
Hand(j) = 7
END SELECT
END IF
NEXT
SELECT CASE Hand(j)
CASE 1
REM Two of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 2
REM Two Pair
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 3
REM Three of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 4
REM Straight
CASE 5
REM Flush
CASE 6
REM Full House
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 7
REM Four of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) <> 0 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 8
REM Straight Flush or Royal Flush
HighPair(j) = Player(j, 1)
END SELECT
NEXT j
IF Delt$ = "Delt" THEN
GOSUB WinHand
CALL Display
COLOR 0, 2
LOCATE xx1 - 2, yy1 - 15: PRINT SPACE$(35);
LOCATE xx1 - 2, yy1 - 15: PRINT "Thanks for Playing!"
IF Delt$ <> "GameOver" THEN LOCATE xx1 + (5) * xspc, yy1 - 3: PRINT "<--Click to Play Again.";
IF Game$ = "Evaluate" THEN LOCATE xx1 + (5 + 1) * xspc, yy1 - 15: PRINT "Winner - Player"; Win$
ELSE
CALL Display
END IF
EXIT SUB
GetHighPair:
HighPair(j) = i: IF HighPair(j) = 1 THEN HighPair(j) = 14
RETURN
WinHand:
REDIM Win!(5): Top# = 0
FOR i = 1 TO 5
IF Hand(i) < 1 THEN Hand(i) = 0
Win!(i) = (Hand(i) * 15! + HighPair(i))
IF Win!(i) <> 0 THEN TieBreaker$(i) = LTRIM$(STR$(Win!(i))) + TieBreaker$(i)
NEXT
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) > Top# THEN Top# = VAL(TieBreaker$(i))
NEXT
REM Check for ties.
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) = Top# THEN Win$ = Win$ + LTRIM$(STR$(i)) + ", "
NEXT
Win$ = " " + MID$(Win$, 1, LEN(Win$) - 2)
IF LEN(Win$) > 2 THEN Win$ = "s " + Win$
RETURN
END SUB
SUB Getkey (b$)
Ex% = 1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
DO
Ex% = 2
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
IF Delt$ = "GameOver" THEN IF b$ <> CHR$(27) THEN b$ = ""
IF b$ <> "" THEN EXIT DO
LOOP
IF b$ = CHR$(27) THEN
IF box = 0 THEN COLOR 7, 0: CLS : SYSTEM ELSE RUN
END IF
Ex% = -1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
END SUB
SUB MDriver (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
Registers.AX = 0: GOSUB CallInt: MouseAct% = 1
Registers.DX% = 116: Registers.CX% = 316: Registers.AX = 4: GOSUB CallInt
END IF
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Bank >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Bank = Bank + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL BankDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
Registers.AX% = 3: GOSUB CallInt: DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1
Registers.AX% = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal"
DO: GOSUB MouseDelay: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Bank > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL BankDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Bank = Bank + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL BankDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
EXIT SUB
CallInt:
REM !!!!!! If your program bombs out here, you either have QBasic 1.x or you
REM forgot to load QB4.5 or PDS with the /l library.
REM For QB4.5 and PDS, start QB from dos command line as: C:/> QB /l
REM For QBasic 1.x, place a REM in front of the CALL INTERRUPT statement,
REM below and RUN the program again. It will use the alternate mouse routine.
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
MouseLocate:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = Registers.DX%
CX% = Registers.CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay:
REGISTER.AX% = 3: GOSUB CallInt
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB MDriverCA (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF MouseAct% = 0 THEN
Mouse$ = SPACE$(57)
RESTORE MouseData
FOR i% = 1 TO 57
READ a$
H$ = CHR$(VAL("&H" + a$))
MID$(Mouse$, i%, 1) = H$
NEXT i%
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
AX% = 0: GOSUB CallAbs: MouseAct% = 1
DX% = 116: CX% = 316: AX% = 4: GOSUB CallAbs
END IF
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Bank >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Bank = Bank + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL BankDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
AX% = 3: GOSUB CallAbs: DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal": DO: GOSUB MouseDelay2: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Bank > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL BankDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay2
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Bank = Bank + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL BankDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
MouseLocate2:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = DX%
CX% = CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay2:
AX% = 3: GOSUB CallAbs
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay2:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB PayOff
REDIM Payment%(5)
FOR i% = 1 TO 5
RESTORE PaySlots
FOR j% = 1 TO Hand(i%)
READ Payment%
NEXT j%
IF Payment% = 1 THEN IF HighPair(i%) < 11 THEN Payment% = 0: REM Lower than Jacks or Better.
Payment%(i%) = Payment%
Payment% = 0
NEXT i%
COLOR 0, 2
LOCATE xx1 + 2
FOR i% = 1 TO 5
LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10: PRINT SPACE$(10); : LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10
SELECT CASE Bet(i%)
CASE 0: PRINT " No Bet. ";
CASE ELSE
Total% = Payment%(i%) * Bet(i%)
TotalAll% = TotalAll% + Total%
PRINT " "; LTRIM$(STR$(Bet(i%))); "*"; LTRIM$(STR$(Payment%(i%))); "="; LTRIM$(STR$(Total%))
END SELECT
NEXT
IF TotalAll% > 0 THEN Bank = Bank + TotalAll%: CALL BankDisplay
IF Bank = 0 AND Delt$ = "Delt" THEN
SOUND 100, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 12
PRINT "Game Over. Press Esc to Exit."; : Delt$ = "GameOver"
END IF
END SUB
SUB PinStripe
COLOR 7, 3
LOCATE 1, 1: PRINT CHR$(218); STRING$(78, 196) + CHR$(191)
FOR k = 2 TO 24
LOCATE k, 1: PRINT CHR$(179); " "; : LOCATE k, 79: PRINT " "; CHR$(179);
NEXT k
LOCATE 25, 1
PRINT CHR$(192); STRING$(78, 196); CHR$(217);
IF box = 1 THEN
COLOR 6, 5
LOCATE 4, 8: PRINT CHR$(218); STRING$(64, 196) + CHR$(191)
FOR k = 5 TO 21
LOCATE k, 8: PRINT CHR$(179); " "; : LOCATE k, 72: PRINT " "; CHR$(179)
NEXT k
LOCATE , 8: PRINT CHR$(192); STRING$(64, 196); CHR$(217);
END IF
END SUB
SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM Makes Pseudo-Mouse Cursor
IF oldx% <> x% OR oldy% <> y% OR oldx% = 0 OR pmc% = 2 THEN
IF oldx% = 0 AND pmc% <> 1 THEN
oldx% = x%: oldy% = y%: oldcolor% = SCREEN(x%, y%, 1)
ReplaceChr$ = CHR$(SCREEN(oldx%, oldy%))
LOCATE x%, y%: COLOR oldcolor% MOD 16, 4: PRINT ReplaceChr$; : pmc% = 1
ELSE
REM Get Old Character and Color
IF oldx% <> 0 THEN LOCATE oldx%, oldy%: COLOR oldcolor% MOD 16, oldcolor% \ 16: PRINT CHR$(SCREEN(oldx%, oldy%));
IF pmc% = 1 THEN
REM Get color at next point.
oldcolor% = SCREEN(x%, y%, 1)
REM Get character at next point.
ReplaceChr$ = CHR$(SCREEN(x%, y%))
REM Cursor highlight in white.
COLOR 7, 4: LOCATE x%, y%: PRINT ReplaceChr$;
oldx% = x%: oldy% = y%
ELSE
REM Hide Mouse
oldx% = 0: oldy% = 0: oldcolor% = 0
END IF
END IF
LOCATE x%, y%
COLOR 7, 0
END IF
END SUB
SUB Shuffle
REM SIMPLE SHUFFLE
y = 1
FOR i = 1 TO 52
x% = (RND * 51) + 1
IF CARD(x%) = 0 THEN CARD(x%) = i ELSE i = i - 1
NEXT
END SUB
SUB Sort
FOR H = 1 TO 5
FOR j = 1 TO 5
FOR i = 1 TO 5 - 1
REM Redefine Ace Value before SWAP.
x1 = Player(H, i) MOD 13 + 1
x2 = Player(H, i + 1) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
IF x2 = 1 THEN x2 = 14
IF x1 < x2 THEN SWAP Player(H, i), Player(H, i + 1)
NEXT i, j, H
Thanks Bob. Draft #2 - Two lnes added to include Ace low straights.
January 4 2007, 11:43 AM
REM **************************************************************************
REM 5-Hand Poker Slots and Evaluator - Copyright Pecos Pete of QB Forum 2006.
REM Works with QBasic 1.x or QuickBasic versions 4.5-7.1.
REM Requires /l switch to be loaded with QuickBasic. /l Not needed for QBasic.
REM **************************************************************************
REM Left Click or Drag Mouse with Left Button Depressed to HOLD Cards.
REM Right Click or Drag Mouse with Right Button Depressed to Remove HOLD.
REM Left/Right Click to Place/Remove Bet.
REM Left Click Deal to Draw when Ready.
REM Run Program FULL SCREEN for Correct Color and Pseudo-Mouse Function.
REM Change MouseOpt% = 0 to MouseOpt% = 1 to disable the PseudoMouse.
DECLARE SUB DrawCards ()
DECLARE SUB Evaluate ()
DECLARE SUB Display ()
DECLARE SUB Sort ()
DECLARE SUB Shuffle ()
DECLARE SUB Deal ()
DECLARE SUB MDriver (Ex%, b$)
DECLARE SUB MDriverCA (Ex%, b$)
DECLARE SUB Getkey (b$)
DECLARE SUB Border ()
DECLARE SUB PinStripe ()
DECLARE SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DECLARE SUB PayOff ()
DECLARE SUB BankDisplay ()
RANDOMIZE TIMER
OPTION BASE 1
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
END TYPE
DIM SHARED Mouse$, Game$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX%, CY%
DIM SHARED CARD(52) AS INTEGER, Player(5, 5) AS INTEGER, CardCnt AS INTEGER, Hold(5, 5) AS INTEGER
DIM SHARED Hand(5) AS INTEGER
DIM SHARED Playerx$(5, 5), Delt$, box AS INTEGER, QB AS LONG, MouseOpt AS INTEGER
DIM SHARED xx1 AS INTEGER, yy1 AS INTEGER, xspc AS INTEGER, yspc AS INTEGER, Bank AS INTEGER
DIM SHARED Bet(5) AS INTEGER, HighPair(5) AS INTEGER
xx1 = 8: yy1 = 28: xspc = 2: yspc = 5
Game$ = "Slots": REM Game choices "Evaluate" and "Slots"
Bank = 100
QB = VAL("&"): REM Get version of QB for mouse.
IF QB = 203 THEN QB = 4.5 ELSE QB = 1.1
MouseOpt% = 0: REM 0=custom mouse Cursor. 1=System mouse Cursor
SCREEN 0, 0, 1, 0
PALETTE 7, 63: REM Lettering
PALETTE 13, 0: REM Lettering
PALETTE 12, 36: REM Red Cards
PALETTE 1, 16: REM Dark Green Dealer
PALETTE 2, 10: REM Inner Green felt
PALETTE 5, 32: REM Table Border Dark Redwood
PALETTE 3, 16: REM Outer Dark Green
DO
SCREEN 0, 0, 1, 0
IF NextRound% = 0 THEN
COLOR 7, 3: CLS
COLOR 15, 3
LOCATE 11, 33, 1, 7, 0: PRINT "Pecos Pete Poker"
LOCATE 13, 29: COLOR 12, 7: PRINT "K"; CHR$(4); : COLOR 7, 3
PRINT " Click Mouse to Begin!"
LOCATE 24, 4: PRINT "[E] Evaluate Only";
LOCATE 24, 65: PRINT "[Esc] to Quit";
CALL PinStripe
PCOPY 1, 0: SCREEN 0, 0, 0, 0
Delt$ = "Options"
CALL Getkey(b$)
IF UCASE$(b$) = "E" THEN Game$ = "Evaluate"
Delt$ = ""
SCREEN 0, 0, 1, 0
COLOR 0, 2
CLS
CALL Border
ELSE
VIEW PRINT xx1 TO xx1 + (5 + 2) * xspc: COLOR 0, 2: CLS 2: VIEW PRINT: CALL Border
END IF
CALL Shuffle
Delt$ = "Shuffled"
IF Game$ = "Slots" THEN Delt$ = "PlaceBet"
CALL Display
CALL Getkey(b$)
Delt$ = ""
CALL Deal
CALL Sort
CALL Evaluate
DO
IF Delt$ = "Delt" THEN
CALL Evaluate
EXIT DO
ELSE
CALL DrawCards
END IF
LOOP
CALL Getkey(b$)
ERASE CARD
ERASE Player
ERASE Playerx$
ERASE Hand
ERASE Hold
ERASE Bet
ERASE HighPair
CardCnt = 0: Delt$ = ""
IF b$ = CHR$(27) THEN RUN
NextRound% = 1
LOOP
Rank:
DATA "Pair","Two Pair","Three of a Kind","Straight","Flush","Full House","Four of a Kind","Straight Flush"
PaySlots:
DATA 1,2,3,4,6,9,25,50,800
MouseData:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
SUB BankDisplay
COLOR 0, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 7: PRINT SPACE$(10);
LOCATE xx1 + 5 * xspc + 2, yy1: PRINT "Bank $" + LTRIM$(STR$(Bank));
END SUB
SUB Border
COLOR 0, 3
LOCATE 4, 1
FOR i = 4 TO 22
PRINT SPACE$(7); : LOCATE , 74: PRINT SPACE$(7);
NEXT
LOCATE 1, 1
PRINT SPACE$(240);
LOCATE 23, 1: PRINT SPACE$(160);
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 2, 3: COLOR 7, 3: PRINT "Pecos Pete Poker"
LOCATE 24, 66: PRINT "[Esc] to Exit";
COLOR 0, 2
END SUB
SUB Deal
FOR i = 1 TO 5
FOR j = 1 TO 5
CardCnt = CardCnt + 1
Player(i, j) = CARD((i - 1) * 5 + j)
NEXT j, i
END SUB
SUB Display
SCREEN 0, 0, 1, 0
VIEW PRINT xx1 TO xx1 + 5 * xspc: COLOR 0, 2: CLS 2: VIEW PRINT
CALL Border
box = 1: CALL PinStripe
LOCATE xx1 - 2, yy1 - 15
COLOR 0, 2
PRINT SPACE$(58); : LOCATE xx1 - 2, yy1 - 15
SELECT CASE Delt$
CASE "": PRINT "Use mouse to mark cards to HOLD:"
CASE "PlaceBet": PRINT "Click " + CHR$(34); "?"; CHR$(34); " to Bet or [*] Bet-Max. Jacks or Better to Win!"
CASE "Shuffled": PRINT "Press Deal to show cards:"
CASE "Delt": PRINT "Payoff Results:"
END SELECT
LOCATE xx1
FOR i = 1 TO 5
FOR j = 1 TO 5
Tempx$ = LTRIM$(STR$(Player(i, j) MOD 13 + 1))
SELECT CASE Player(i, j) MOD 13 + 1
CASE 11: Tempx$ = "J"
CASE 12: Tempx$ = "Q"
CASE 13: Tempx$ = "K"
CASE 1: Tempx$ = "A"
END SELECT
Playerx$(i, j) = Tempx$ + CHR$(Player(i, j) MOD 4 + 3)
NEXT
COLOR 0, 2
SELECT CASE Game$
CASE "Evaluate": LOCATE , yy1 - 12: PRINT "Player"; i;
CASE "Slots"
LOCATE , yy1 - 13
IF Delt$ = "" THEN
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 0, 2: PRINT LTRIM$(STR$(Bet(i))); : COLOR 0, 2: PRINT "]";
ELSE
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 3, 2: PRINT "?"; : COLOR 0, 2: PRINT "]";
END IF
END SELECT
FOR H% = 1 TO 5
LOCATE , yy1 + (H% - 1) * yspc
IF INSTR(Playerx$(i, H%), CHR$(6)) <> 0 OR INSTR(Playerx$(i, H%), CHR$(5)) <> 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
IF Delt$ = "Shuffled" OR Delt$ = "PlaceBet" THEN
COLOR 5: PRINT CHR$(176); CHR$(176);
ELSE
PRINT Playerx$(i, H%);
END IF
NEXT H%
RESTORE Rank
COLOR 0, 2
FOR j = 1 TO Hand(i): READ Rank$: NEXT
IF Hand(i) = 8 AND Player(i, 1) = 0 THEN Rank$ = "Royal Flush": Hand(i) = 9
IF Rank$ <> "" THEN LOCATE , yy1 + yspc * 6 - yspc + 1: PRINT Rank$; : Rank$ = ""
FOR k% = 1 TO xspc: PRINT : NEXT
NEXT
COLOR 7, 1
IF Game$ = "Slots" THEN
LOCATE xx1 + 5 * xspc, yy1 - 12
SELECT CASE Delt$
CASE "Delt": PRINT " Play ";
CASE "PlaceBet": PRINT " Show ";
CASE ELSE: PRINT " Deal ";
END SELECT
CALL BankDisplay
ELSE
LOCATE xx1 + 5 * xspc, yy1 - 12: PRINT " Deal ";
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
IF Delt$ = "Delt" AND Game$ = "Slots" THEN CALL PayOff
COLOR 0, 2
END SUB
SUB DrawCards
CALL Getkey(b$)
IF b$ = CHR$(27) THEN EXIT SUB
IF b$ = "Deal" THEN
FOR j = 1 TO 5
FOR i = 1 TO 5
IF Hold(j, i) = 0 THEN
CardCnt = CardCnt + 1
Player(j, i) = CARD(CardCnt)
END IF
NEXT i, j
Delt$ = "Delt"
SCREEN 0, 0, 1, 0
CALL Sort
END IF
END SUB
SUB Evaluate
REM Evaluate Straight
REDIM TieBreaker$(5)
FOR j = 1 TO 5
Hand(j) = -1
FOR i = 1 TO 5 - 1
x1 = Player(j, i) MOD 13 + 1
x2 = Player(j, i + 1) MOD 13 + 1
x1alt = 0
IF x1 = 1 THEN x1 = 14: x1alt = 1
IF x2 = 1 THEN x2 = 14: REM Not Involved in a Straight
IF x1 <> x2 + 1 THEN
IF x1alt = 1 AND x2 = 5 THEN ELSE Flag = 1: EXIT FOR
END IF
NEXT
IF Flag = 1 THEN Flag = 0 ELSE Hand1$ = "Straight"
REM Evaluate Flush
FOR i = 1 TO 5 - 1
IF Player(j, i) MOD 4 <> Player(j, i + 1) MOD 4 THEN Flag = 1: EXIT FOR
NEXT
IF Flag = 1 THEN Flag = 0 ELSE Hand2$ = "Flush"
IF Hand1$ = "Straight" THEN Hand(j) = 4
IF Hand2$ = "Flush" THEN Hand(j) = 5
IF Hand1$ = "Straight" AND Hand2$ = "Flush" THEN Hand(j) = 8
Hand1$ = "": Hand2$ = ""
REDIM pair(14)
IF Hand(j) < 0 THEN
REM Evaluate Pairs
FOR i = 1 TO 5
x1 = Player(j, i) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
pair(x1) = pair(x1) + 1
NEXT
END IF
FOR k = 1 TO 5
x% = Player(j, k) MOD 13 + 1
IF x% = 1 THEN x% = 14
IF Hand(j) = 4 AND x% = 14 AND Player(j, 2) MOD 13 + 1 = 5 THEN x% = 1: REM Ace Low Straight
IF x% < 10 THEN x$ = "0" + LTRIM$(STR$(x%)) ELSE x$ = LTRIM$(STR$(x%))
xtot$ = xtot$ + x$
NEXT k
TieBreaker$(j) = xtot$: xtot$ = ""
FOR i = 2 TO 14
IF pair(i) > 1 THEN
SELECT CASE pair(i)
CASE 2
IF Hand(j) = 1 THEN Hand(j) = 2 ELSE IF Hand(j) = 3 THEN Hand(j) = 6 ELSE Hand(j) = 1
CASE 3
IF Hand(j) = 2 THEN Hand(j) = 6 ELSE IF Hand(j) = 1 THEN Hand(j) = 6 ELSE Hand(j) = 3
CASE 4
Hand(j) = 7
END SELECT
END IF
NEXT
SELECT CASE Hand(j)
CASE 1
REM Two of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 2
REM Two Pair
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 3
REM Three of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 4
REM Straight
CASE 5
REM Flush
CASE 6
REM Full House
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 7
REM Four of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) <> 0 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 8
REM Straight Flush or Royal Flush
HighPair(j) = Player(j, 1)
END SELECT
NEXT j
IF Delt$ = "Delt" THEN
GOSUB WinHand
CALL Display
COLOR 0, 2
LOCATE xx1 - 2, yy1 - 15: PRINT SPACE$(35);
LOCATE xx1 - 2, yy1 - 15: PRINT "Thanks for Playing!"
IF Delt$ <> "GameOver" THEN LOCATE xx1 + (5) * xspc, yy1 - 3: PRINT "<--Click to Play Again.";
IF Game$ = "Evaluate" THEN LOCATE xx1 + (5 + 1) * xspc, yy1 - 15: PRINT "Winner - Player"; Win$
ELSE
CALL Display
END IF
EXIT SUB
GetHighPair:
HighPair(j) = i: IF HighPair(j) = 1 THEN HighPair(j) = 14
RETURN
WinHand:
REDIM Win!(5): Top# = 0
FOR i = 1 TO 5
IF Hand(i) < 1 THEN Hand(i) = 0
Win!(i) = (Hand(i) * 15! + HighPair(i))
IF Win!(i) <> 0 THEN TieBreaker$(i) = LTRIM$(STR$(Win!(i))) + TieBreaker$(i)
NEXT
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) > Top# THEN Top# = VAL(TieBreaker$(i))
NEXT
REM Check for ties.
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) = Top# THEN Win$ = Win$ + LTRIM$(STR$(i)) + ", "
NEXT
Win$ = " " + MID$(Win$, 1, LEN(Win$) - 2)
IF LEN(Win$) > 2 THEN Win$ = "s " + Win$
RETURN
END SUB
SUB Getkey (b$)
Ex% = 1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
DO
Ex% = 2
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
IF Delt$ = "GameOver" THEN IF b$ <> CHR$(27) THEN b$ = ""
IF b$ <> "" THEN EXIT DO
LOOP
IF b$ = CHR$(27) THEN
IF box = 0 THEN COLOR 7, 0: CLS : SYSTEM ELSE RUN
END IF
Ex% = -1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
END SUB
SUB MDriver (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
Registers.AX = 0: GOSUB CallInt: MouseAct% = 1
Registers.DX% = 116: Registers.CX% = 316: Registers.AX = 4: GOSUB CallInt
END IF
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Bank >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Bank = Bank + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL BankDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
Registers.AX% = 3: GOSUB CallInt: DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1
Registers.AX% = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal"
DO: GOSUB MouseDelay: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Bank > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL BankDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Bank = Bank + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL BankDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
EXIT SUB
CallInt:
REM !!!!!! If your program bombs out here, you either have QBasic 1.x or you
REM forgot to load QB4.5 or PDS with the /l library.
REM For QB4.5 and PDS, start QB from dos command line as: C:/> QB /l
REM For QBasic 1.x, place a REM in front of the CALL INTERRUPT statement,
REM below and RUN the program again. It will use the alternate mouse routine.
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
MouseLocate:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = Registers.DX%
CX% = Registers.CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay:
REGISTER.AX% = 3: GOSUB CallInt
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB MDriverCA (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF MouseAct% = 0 THEN
Mouse$ = SPACE$(57)
RESTORE MouseData
FOR i% = 1 TO 57
READ a$
H$ = CHR$(VAL("&H" + a$))
MID$(Mouse$, i%, 1) = H$
NEXT i%
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
AX% = 0: GOSUB CallAbs: MouseAct% = 1
DX% = 116: CX% = 316: AX% = 4: GOSUB CallAbs
END IF
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Bank >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Bank = Bank + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL BankDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
AX% = 3: GOSUB CallAbs: DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal": DO: GOSUB MouseDelay2: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Bank > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Bank = Bank - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL BankDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay2
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Bank = Bank + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL BankDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
MouseLocate2:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = DX%
CX% = CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay2:
AX% = 3: GOSUB CallAbs
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay2:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB PayOff
REDIM Payment%(5)
FOR i% = 1 TO 5
RESTORE PaySlots
FOR j% = 1 TO Hand(i%)
READ Payment%
NEXT j%
IF Payment% = 1 THEN IF HighPair(i%) < 11 THEN Payment% = 0: REM Lower than Jacks or Better.
Payment%(i%) = Payment%
Payment% = 0
NEXT i%
COLOR 0, 2
LOCATE xx1 + 2
FOR i% = 1 TO 5
LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10: PRINT SPACE$(10); : LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10
SELECT CASE Bet(i%)
CASE 0: PRINT " No Bet. ";
CASE ELSE
Total% = Payment%(i%) * Bet(i%)
TotalAll% = TotalAll% + Total%
PRINT " "; LTRIM$(STR$(Bet(i%))); "*"; LTRIM$(STR$(Payment%(i%))); "="; LTRIM$(STR$(Total%))
END SELECT
NEXT
IF TotalAll% > 0 THEN Bank = Bank + TotalAll%: CALL BankDisplay
IF Bank = 0 AND Delt$ = "Delt" THEN
SOUND 100, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 12
PRINT "Game Over. Press Esc to Exit."; : Delt$ = "GameOver"
END IF
END SUB
SUB PinStripe
COLOR 7, 3
LOCATE 1, 1: PRINT CHR$(218); STRING$(78, 196) + CHR$(191)
FOR k = 2 TO 24
LOCATE k, 1: PRINT CHR$(179); " "; : LOCATE k, 79: PRINT " "; CHR$(179);
NEXT k
LOCATE 25, 1
PRINT CHR$(192); STRING$(78, 196); CHR$(217);
IF box = 1 THEN
COLOR 6, 5
LOCATE 4, 8: PRINT CHR$(218); STRING$(64, 196) + CHR$(191)
FOR k = 5 TO 21
LOCATE k, 8: PRINT CHR$(179); " "; : LOCATE k, 72: PRINT " "; CHR$(179)
NEXT k
LOCATE , 8: PRINT CHR$(192); STRING$(64, 196); CHR$(217);
END IF
END SUB
SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM Makes Pseudo-Mouse Cursor
IF oldx% <> x% OR oldy% <> y% OR oldx% = 0 OR pmc% = 2 THEN
IF oldx% = 0 AND pmc% <> 1 THEN
oldx% = x%: oldy% = y%: oldcolor% = SCREEN(x%, y%, 1)
ReplaceChr$ = CHR$(SCREEN(oldx%, oldy%))
LOCATE x%, y%: COLOR oldcolor% MOD 16, 4: PRINT ReplaceChr$; : pmc% = 1
ELSE
REM Get Old Character and Color
IF oldx% <> 0 THEN LOCATE oldx%, oldy%: COLOR oldcolor% MOD 16, oldcolor% \ 16: PRINT CHR$(SCREEN(oldx%, oldy%));
IF pmc% = 1 THEN
REM Get color at next point.
oldcolor% = SCREEN(x%, y%, 1)
REM Get character at next point.
ReplaceChr$ = CHR$(SCREEN(x%, y%))
REM Cursor highlight in white.
COLOR 7, 4: LOCATE x%, y%: PRINT ReplaceChr$;
oldx% = x%: oldy% = y%
ELSE
REM Hide Mouse
oldx% = 0: oldy% = 0: oldcolor% = 0
END IF
END IF
LOCATE x%, y%
COLOR 7, 0
END IF
END SUB
SUB Shuffle
REM SIMPLE SHUFFLE
y = 1
FOR i = 1 TO 52
x% = (RND * 51) + 1
IF CARD(x%) = 0 THEN CARD(x%) = i ELSE i = i - 1
NEXT
END SUB
SUB Sort
FOR H = 1 TO 5
FOR j = 1 TO 5
FOR i = 1 TO 5 - 1
REM Redefine Ace Value before SWAP.
x1 = Player(H, i) MOD 13 + 1
x2 = Player(H, i + 1) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
IF x2 = 1 THEN x2 = 14
IF x1 < x2 THEN SWAP Player(H, i), Player(H, i + 1)
NEXT i, j, H
Draft #3 - More Mac Friendly? - Also Modified Low Straight + Added Low Straight Flush.
January 5 2007, 12:35 PM
I forgot to do a low straight flush in the previous draft but that lead me to a better way to display the low straights...with the ace at the end instead of in front!
OK Mac, just for you I changed the word Bank to Credits. Credits are what you have to play with. Each time you bet, your Credits go down as they become part of the wager. Now, which player are you? ALL of them. Think of the screen as 5 Las Vegas poker slot machines and you can play 1, 2 or all 5 machines at once. After you bet, click to show cards. Select the cards to hold, remember, you need jacks or better to win. Did you know to select a bunch of cards you can just hold down the mouse button and drag it across the cards? That's a time saver. OK, you have the cards highlighted you want to hold, now deal. The program will calculate the results and add any winnings back to your Credits.
The game could use a few flashy visual and sound effects in the future.
REM **************************************************************************
REM 5-Hand Poker Slots and Evaluator - Copyright Pecos Pete of QB Forum 2006.
REM Works with QBasic 1.x or QuickBasic versions 4.5-7.1.
REM Requires /l switch to be loaded with QuickBasic. /l Not needed for QBasic.
REM **************************************************************************
REM Left Click or Drag Mouse with Left Button Depressed to HOLD Cards.
REM Right Click or Drag Mouse with Right Button Depressed to Remove HOLD.
REM Left/Right Click to Place/Remove Bet.
REM Left Click Deal to Draw when Ready.
REM Run Program FULL SCREEN for Correct Color and Pseudo-Mouse Function.
REM Change MouseOpt% = 0 to MouseOpt% = 1 to disable the PseudoMouse.
DECLARE SUB DrawCards ()
DECLARE SUB Evaluate ()
DECLARE SUB Display ()
DECLARE SUB Sort ()
DECLARE SUB Shuffle ()
DECLARE SUB Deal ()
DECLARE SUB MDriver (Ex%, b$)
DECLARE SUB MDriverCA (Ex%, b$)
DECLARE SUB Getkey (b$)
DECLARE SUB Border ()
DECLARE SUB PinStripe ()
DECLARE SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DECLARE SUB PayOff ()
DECLARE SUB CreditsDisplay ()
RANDOMIZE TIMER
OPTION BASE 1
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
END TYPE
DIM SHARED Mouse$, Game$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX%, CY%
DIM SHARED CARD(52) AS INTEGER, Player(5, 5) AS INTEGER, CardCnt AS INTEGER, Hold(5, 5) AS INTEGER
DIM SHARED Hand(5) AS INTEGER
DIM SHARED Playerx$(5, 5), Delt$, box AS INTEGER, QB AS LONG, MouseOpt AS INTEGER
DIM SHARED xx1 AS INTEGER, yy1 AS INTEGER, xspc AS INTEGER, yspc AS INTEGER, Credits AS INTEGER
DIM SHARED Bet(5) AS INTEGER, HighPair(5) AS INTEGER
xx1 = 8: yy1 = 28: xspc = 2: yspc = 5
Game$ = "Slots": REM Game choices "Evaluate" and "Slots"
Credits = 100
QB = VAL("&"): REM Get version of QB for mouse.
IF QB = 203 THEN QB = 4.5 ELSE QB = 1.1
MouseOpt% = 0: REM 0=custom mouse Cursor. 1=System mouse Cursor
SCREEN 0, 0, 1, 0
PALETTE 7, 63: REM Lettering
PALETTE 13, 0: REM Lettering
PALETTE 12, 36: REM Red Cards
PALETTE 1, 16: REM Dark Green Dealer
PALETTE 2, 10: REM Inner Green felt
PALETTE 5, 32: REM Table Border Dark Redwood
PALETTE 3, 16: REM Outer Dark Green
DO
SCREEN 0, 0, 1, 0
IF NextRound% = 0 THEN
COLOR 7, 3: CLS
COLOR 15, 3
LOCATE 11, 33, 1, 7, 0: PRINT "Pecos Pete Poker"
LOCATE 13, 29: COLOR 12, 7: PRINT "K"; CHR$(4); : COLOR 7, 3
PRINT " Click Mouse to Begin!"
LOCATE 24, 4: PRINT "[E] Evaluate Only";
LOCATE 24, 65: PRINT "[Esc] to Quit";
CALL PinStripe
PCOPY 1, 0: SCREEN 0, 0, 0, 0
Delt$ = "Options"
CALL Getkey(b$)
IF UCASE$(b$) = "E" THEN Game$ = "Evaluate"
Delt$ = ""
SCREEN 0, 0, 1, 0
COLOR 0, 2
CLS
CALL Border
ELSE
VIEW PRINT xx1 TO xx1 + (5 + 2) * xspc: COLOR 0, 2: CLS 2: VIEW PRINT: CALL Border
END IF
CALL Shuffle
Delt$ = "Shuffled"
IF Game$ = "Slots" THEN Delt$ = "PlaceBet"
CALL Display
CALL Getkey(b$)
Delt$ = ""
CALL Deal
CALL Sort
CALL Evaluate
DO
IF Delt$ = "Delt" THEN
CALL Evaluate
EXIT DO
ELSE
CALL DrawCards
END IF
LOOP
CALL Getkey(b$)
ERASE CARD
ERASE Player
ERASE Playerx$
ERASE Hand
ERASE Hold
ERASE Bet
ERASE HighPair
CardCnt = 0: Delt$ = ""
IF b$ = CHR$(27) THEN RUN
NextRound% = 1
LOOP
Rank:
DATA "Pair","Two Pair","Three of a Kind","Straight","Flush","Full House","Four of a Kind","Straight Flush"
PaySlots:
DATA 1,2,3,4,6,9,25,50,800
MouseData:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
SUB Border
COLOR 0, 3
LOCATE 4, 1
FOR i = 4 TO 22
PRINT SPACE$(7); : LOCATE , 74: PRINT SPACE$(7);
NEXT
LOCATE 1, 1
PRINT SPACE$(240);
LOCATE 23, 1: PRINT SPACE$(160);
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 2, 3: COLOR 7, 3: PRINT "Pecos Pete Poker"
LOCATE 24, 66: PRINT "[Esc] to Exit";
COLOR 0, 2
END SUB
SUB CreditsDisplay
COLOR 0, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 7: PRINT SPACE$(10);
LOCATE xx1 + 5 * xspc + 2, yy1: PRINT "Credits $" + LTRIM$(STR$(Credits));
END SUB
SUB Deal
FOR i = 1 TO 5
FOR j = 1 TO 5
CardCnt = CardCnt + 1
Player(i, j) = CARD((i - 1) * 5 + j)
NEXT j, i
END SUB
SUB Display
SCREEN 0, 0, 1, 0
VIEW PRINT xx1 TO xx1 + 5 * xspc: COLOR 0, 2: CLS 2: VIEW PRINT
CALL Border
box = 1: CALL PinStripe
LOCATE xx1 - 2, yy1 - 15
COLOR 0, 2
PRINT SPACE$(58); : LOCATE xx1 - 2, yy1 - 15
SELECT CASE Delt$
CASE "": PRINT "Use mouse to mark cards to HOLD:"
CASE "PlaceBet": PRINT "Click " + CHR$(34); "?"; CHR$(34); " to Bet or ["; : COLOR 7, 2: PRINT "*"; : COLOR 0, 2: PRINT "] Bet Max. Jacks or Better to Win!"
CASE "Shuffled": PRINT "Press Deal to show cards:"
CASE "Delt": PRINT "Payoff Results:"
END SELECT
LOCATE xx1
FOR i = 1 TO 5
FOR j = 1 TO 5
Tempx$ = LTRIM$(STR$(Player(i, j) MOD 13 + 1))
SELECT CASE Player(i, j) MOD 13 + 1
CASE 11: Tempx$ = "J"
CASE 12: Tempx$ = "Q"
CASE 13: Tempx$ = "K"
CASE 1: Tempx$ = "A"
END SELECT
Playerx$(i, j) = Tempx$ + CHR$(Player(i, j) MOD 4 + 3)
NEXT
COLOR 0, 2
SELECT CASE Game$
CASE "Evaluate": LOCATE , yy1 - 12: PRINT "Player"; i;
CASE "Slots"
LOCATE , yy1 - 13
IF Delt$ = "" THEN
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 0, 2: PRINT LTRIM$(STR$(Bet(i))); : COLOR 0, 2: PRINT "]";
ELSE
PRINT "#"; LTRIM$(STR$(i)); " Bet ["; : COLOR 3, 2: PRINT "?"; : COLOR 0, 2: PRINT "]";
END IF
END SELECT
FOR h% = 1 TO 5
LOCATE , yy1 + (h% - 1) * yspc
IF INSTR(Playerx$(i, h%), CHR$(6)) <> 0 OR INSTR(Playerx$(i, h%), CHR$(5)) <> 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
IF Delt$ = "Shuffled" OR Delt$ = "PlaceBet" THEN
COLOR 5: PRINT CHR$(176); CHR$(176);
ELSE
PRINT Playerx$(i, h%);
END IF
NEXT h%
RESTORE Rank
COLOR 0, 2
FOR j = 1 TO Hand(i): READ Rank$: NEXT
IF Hand(i) = 8 AND Player(i, 1) = 0 THEN Rank$ = "Royal Flush": Hand(i) = 9
IF Rank$ <> "" THEN LOCATE , yy1 + yspc * 6 - yspc + 1: PRINT Rank$; : Rank$ = ""
FOR k% = 1 TO xspc: PRINT : NEXT
NEXT
COLOR 7, 1
IF Game$ = "Slots" THEN
LOCATE xx1 + 5 * xspc, yy1 - 12
SELECT CASE Delt$
CASE "Delt": PRINT " Play ";
CASE "PlaceBet": PRINT " Show "; : COLOR 0, 2: PRINT " <--Bet 1 to 5 Slots and Click to Begin.";
CASE ELSE: PRINT " Deal "; : COLOR 0, 2: PRINT " <--Select Cards to Hold and Click to Deal.";
END SELECT
CALL CreditsDisplay
ELSE
LOCATE xx1 + 5 * xspc, yy1 - 12: PRINT " Deal ";
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
IF Delt$ = "Delt" AND Game$ = "Slots" THEN CALL PayOff
COLOR 0, 2
END SUB
SUB DrawCards
CALL Getkey(b$)
IF b$ = CHR$(27) THEN EXIT SUB
IF b$ = "Deal" THEN
FOR j = 1 TO 5
FOR i = 1 TO 5
IF Hold(j, i) = 0 THEN
CardCnt = CardCnt + 1
Player(j, i) = CARD(CardCnt)
END IF
NEXT i, j
Delt$ = "Delt"
SCREEN 0, 0, 1, 0
CALL Sort
END IF
END SUB
SUB Evaluate
REM Evaluate Straight
REDIM TieBreaker$(5)
FOR j = 1 TO 5
Hand(j) = -1: : x2alt = 0
FOR i = 1 TO 5 - 1
x1 = Player(j, i) MOD 13 + 1
x2 = Player(j, i + 1) MOD 13 + 1
x1alt = 0
IF x1 = 1 THEN x1 = 14: x1alt = 1
IF x2 = 1 THEN x2 = 14: REM Not Involved in a Straight
IF x1 <> x2 + 1 THEN
IF x1alt = 1 AND x2 = 5 THEN x2alt = -1 ELSE Flag = 1: EXIT FOR
END IF
NEXT
IF Flag = 1 THEN
Flag = 0
ELSE
Hand1$ = "Straight"
IF x2alt = -1 THEN
REM Swap high to low
x1alt = Player(j, 1)
FOR k = 1 TO 5 - 1
SWAP Player(j, k), Player(j, k + 1)
NEXT
Player(j, 5) = x1alt
END IF
END IF
REM Evaluate Flush
FOR i = 1 TO 5 - 1
IF Player(j, i) MOD 4 <> Player(j, i + 1) MOD 4 THEN Flag = 1: EXIT FOR
NEXT
IF Flag = 1 THEN Flag = 0 ELSE Hand2$ = "Flush"
IF Hand1$ = "Straight" THEN Hand(j) = 4
IF Hand2$ = "Flush" THEN Hand(j) = 5
IF Hand1$ = "Straight" AND Hand2$ = "Flush" THEN Hand(j) = 8
Hand1$ = "": Hand2$ = ""
REDIM pair(14)
IF Hand(j) < 0 THEN
REM Evaluate Pairs
FOR i = 1 TO 5
x1 = Player(j, i) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
pair(x1) = pair(x1) + 1
NEXT
END IF
FOR k = 1 TO 5
x% = Player(j, k) MOD 13 + 1
IF x% = 1 THEN x% = 14
IF Hand(j) MOD 4 = 0 AND k = 5 AND x% = 14 THEN x% = 1: REM Ace Low Straight
IF x% < 10 THEN x$ = "0" + LTRIM$(STR$(x%)) ELSE x$ = LTRIM$(STR$(x%))
xtot$ = xtot$ + x$
NEXT k
TieBreaker$(j) = xtot$: xtot$ = ""
FOR i = 2 TO 14
IF pair(i) > 1 THEN
SELECT CASE pair(i)
CASE 2
IF Hand(j) = 1 THEN Hand(j) = 2 ELSE IF Hand(j) = 3 THEN Hand(j) = 6 ELSE Hand(j) = 1
CASE 3
IF Hand(j) = 2 THEN Hand(j) = 6 ELSE IF Hand(j) = 1 THEN Hand(j) = 6 ELSE Hand(j) = 3
CASE 4
Hand(j) = 7
END SELECT
END IF
NEXT
SELECT CASE Hand(j)
CASE 1
REM Two of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 2
REM Two Pair
FOR i = 14 TO 2 STEP -1
IF pair(i) = 2 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 3
REM Three of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 4
REM Straight
CASE 5
REM Flush
CASE 6
REM Full House
FOR i = 14 TO 2 STEP -1
IF pair(i) = 3 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 7
REM Four of a Kind
FOR i = 14 TO 2 STEP -1
IF pair(i) <> 0 THEN GOSUB GetHighPair: EXIT FOR
NEXT
CASE 8
REM Straight Flush or Royal Flush
HighPair(j) = Player(j, 1)
END SELECT
NEXT j
IF Delt$ = "Delt" THEN
GOSUB WinHand
CALL Display
COLOR 0, 2
LOCATE xx1 - 2, yy1 - 15: PRINT SPACE$(35);
LOCATE xx1 - 2, yy1 - 15: PRINT "Thanks for Playing!"
IF Delt$ <> "GameOver" THEN LOCATE xx1 + (5) * xspc, yy1 - 3: PRINT "<--Click to Play Again.";
IF Game$ = "Evaluate" THEN LOCATE xx1 + (5 + 1) * xspc, yy1 - 15: PRINT "Winner - Player"; Win$
ELSE
CALL Display
END IF
EXIT SUB
GetHighPair:
HighPair(j) = i: IF HighPair(j) = 1 THEN HighPair(j) = 14
RETURN
WinHand:
REDIM Win!(5): Top# = 0
FOR i = 1 TO 5
IF Hand(i) < 1 THEN Hand(i) = 0
Win!(i) = (Hand(i) * 15! + HighPair(i))
IF Win!(i) <> 0 THEN TieBreaker$(i) = LTRIM$(STR$(Win!(i))) + TieBreaker$(i)
NEXT
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) > Top# THEN Top# = VAL(TieBreaker$(i))
NEXT
REM Check for ties.
FOR i = 1 TO 5
IF VAL(TieBreaker$(i)) = Top# THEN Win$ = Win$ + LTRIM$(STR$(i)) + ", "
NEXT
Win$ = " " + MID$(Win$, 1, LEN(Win$) - 2)
IF LEN(Win$) > 2 THEN Win$ = "s " + Win$
RETURN
END SUB
SUB Getkey (b$)
Ex% = 1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
DO
Ex% = 2
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
IF Delt$ = "GameOver" THEN IF b$ <> CHR$(27) THEN b$ = ""
IF b$ <> "" THEN EXIT DO
LOOP
IF b$ = CHR$(27) THEN
IF box = 0 THEN COLOR 7, 0: CLS : SYSTEM ELSE RUN
END IF
Ex% = -1
SELECT CASE QB
CASE 4.5: CALL MDriver(Ex%, b$)
CASE 1.1: CALL MDriverCA(Ex%, b$)
END SELECT
END SUB
SUB MDriver (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
Registers.AX = 0: GOSUB CallInt: MouseAct% = 1
Registers.DX% = 116: Registers.CX% = 316: Registers.AX = 4: GOSUB CallInt
END IF
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
Registers.AX = 3: GOSUB CallInt: GOSUB MouseLocate
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Credits >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Credits = Credits + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Credits = Credits - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL CreditsDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
Registers.AX% = 3: GOSUB CallInt: DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1
Registers.AX% = 2: GOSUB CallInt: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal"
DO: GOSUB MouseDelay: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Credits > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Credits = Credits - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL CreditsDisplay
GOSUB TimerDelay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Credits = Credits + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL CreditsDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
Registers.AX = 2: GOSUB CallInt
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
Registers.AX = 1: GOSUB CallInt
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
EXIT SUB
CallInt:
REM !!!!!! If your program bombs out here, you either have QBasic 1.x or you
REM forgot to load QB4.5 or PDS with the /l library.
REM For QB4.5 and PDS, start QB from dos command line as: C:/> QB /l
REM For QBasic 1.x, place a REM in front of the CALL INTERRUPT statement,
REM below and RUN the program again. It will use the alternate mouse routine.
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
MouseLocate:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = Registers.DX%
CX% = Registers.CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay:
REGISTER.AX% = 3: GOSUB CallInt
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB MDriverCA (Ex%, b$)
STATIC MouseAct%, oldx%, oldy%, oldcolor%, pmc%
IF Ex% = -1 THEN
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF MouseAct% = 0 THEN
Mouse$ = SPACE$(57)
RESTORE MouseData
FOR i% = 1 TO 57
READ a$
h$ = CHR$(VAL("&H" + a$))
MID$(Mouse$, i%, 1) = h$
NEXT i%
END IF
IF Ex% = 1 THEN
pmc% = 1
IF MouseAct% = 0 THEN
IF MouseOpt = 1 THEN PCOPY 0, 2: SCREEN 0, 0, 2, 2: REM Prevents phantom mouse image.
AX% = 0: GOSUB CallAbs: MouseAct% = 1
DX% = 116: CX% = 316: AX% = 4: GOSUB CallAbs
END IF
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
EXIT SUB
END IF
DO
AX% = 3: GOSUB CallAbs: GOSUB MouseLocate2
IF MouseOpt% = 0 THEN CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM MOUSE BUTTONS
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
b$ = INKEY$
IF b$ = CHR$(27) OR UCASE$(b$) = "E" AND Delt$ = "Options" THEN EXIT SUB
IF LB% <> 0 THEN
IF CHR$(SCREEN(x%, y%)) = "*" THEN
REM Bet Max
IF Credits >= 5 * 5 THEN
Repo% = 0
FOR i% = 1 TO 5
Repo% = Repo% + Bet(i%)
NEXT
IF Repo% <> 5 * 5 THEN
IF Repo% <> 0 THEN Credits = Credits + Repo%
SOUND 1000, .25
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Credits = Credits - 5 * 5
COLOR 13, 2
FOR i% = 1 TO 5
Bet(i%) = 5
LOCATE xx1 + i% * xspc - 2, yy1 - 5: PRINT LTRIM$(STR$(Bet(i%)));
NEXT
CALL CreditsDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT DO
END IF
ELSE
SOUND 100, 1
END IF
END IF
IF x% = 24 AND y% >= 66 AND y% <= 70 AND SCREEN(x%, y%) <> 32 THEN
b$ = CHR$(27)
IF MouseOpt = 1 THEN
AX% = 3: GOSUB CallAbs: DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1
AX% = 2: GOSUB CallAbs: EXIT SUB
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%): DO: GOSUB MouseDelay2: LOOP UNTIL Flag% = 1: EXIT SUB
END IF
END IF
IF box = 0 THEN
IF x% = 24 AND y% > 2 AND y% < 6 THEN
b$ = "E"
ELSE
b$ = "run"
END IF
EXIT SUB
END IF
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF x% = xx1 + 5 * xspc THEN
IF SCREEN(x%, y%) <> 0 THEN
b$ = "Deal": DO: GOSUB MouseDelay2: IF Flag% = 1 THEN EXIT DO
LOOP
EXIT SUB
END IF
END IF
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) >= 0 AND Bet((x% - xx1) \ xspc + 1) < 5 THEN
REM Make bet.
IF Credits > 0 THEN
SOUND 1000, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
Credits = Credits - 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) + 1
COLOR 13, 2: LOCATE x%, y%: PRINT LTRIM$(STR$(Bet((x% - xx1) \ xspc + 1))); : LOCATE x%, y%
CALL CreditsDisplay
GOSUB TimerDelay2
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
END IF
ELSE
IF Delt$ = "" THEN
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
IF Player((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) MOD 4 < 2 THEN RecallColor% = 1 ELSE RecallColor% = -1
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = RecallColor%
yalt% = y%
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
COLOR 14, 4
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
GOSUB MouseDelay2
IF Flag% = 1 THEN EXIT DO
END IF
IF RB% <> 0 THEN
IF y% < yy1 OR y% > yy1 + (5 - 1) * yspc + 1 OR x% > xx1 + (5 - 1) * xspc OR x% < xx1 THEN
IF Game$ = "Slots" AND Delt$ = "PlaceBet" THEN
IF y% = yy1 - 5 AND x% >= xx1 AND x% <= xx1 + (5 - 1) * xspc AND x% \ 2 = x% / 2 THEN
IF Bet((x% - xx1) \ xspc + 1) > 0 THEN
REM Make initial $1 bet.
SOUND 300, .15
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
COLOR 0, 2: LOCATE x%, y%: PRINT "?"; : LOCATE x%, y%
Credits = Credits + 1: Bet((x% - xx1) \ xspc + 1) = Bet((x% - xx1) \ xspc + 1) - 1
CALL CreditsDisplay
pmc% = 1: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
END IF
END IF
ELSE
LOCATE x%, y%
IF SCREEN(x%, y%) <> 32 THEN
k% = Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1)
IF k% <> 0 THEN
IF MouseOpt = 1 THEN
AX% = 2: GOSUB CallAbs
ELSE
pmc% = 2: CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
IF k% < 0 THEN COLOR 0, 7 ELSE COLOR 12, 7
Hold((x% - xx1) \ xspc + 1, (y% - yy1) \ yspc + 1) = 0
yalt% = y%
IF SCREEN(x%, y%) <= 6 THEN direction% = -1 ELSE direction% = 1
DO UNTIL SCREEN(x%, yalt%) = 32
IF SCREEN(x%, yalt%) = 48 THEN LOCATE , yalt% - 1: PRINT "1";
PRINT CHR$(SCREEN(x%, yalt%)); : IF direction% = -1 THEN LOCATE , POS(1) - 2
yalt% = POS(1)
LOOP
IF MouseOpt = 1 THEN
AX% = 1: GOSUB CallAbs
ELSE
CALL PseudoMouseCursor(pmc%, x%, y%, oldx%, oldy%, oldcolor%)
END IF
COLOR 0, 2
END IF
END IF
END IF
oldx% = x%: oldy% = y%
END IF
LOOP
MouseLocate2:
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = DX%
CX% = CX%
x% = DX% \ 8 + 1: y% = CX% \ 8 + 1
RETURN
MouseDelay2:
AX% = 3: GOSUB CallAbs
LB% = BX% AND 1
RB% = (BX% AND 2) \ 2
MB% = (BX% AND 4) \ 4
IF LB% = 0 THEN Flag% = 1
RETURN
TimerDelay2:
z1 = TIMER
DO
z2 = TIMER
IF z1 > z2 THEN z1 = z1 - 86400
IF z2 - z1 > .15 THEN EXIT DO
LOOP
RETURN
END SUB
SUB PayOff
REDIM Payment%(5)
FOR i% = 1 TO 5
RESTORE PaySlots
FOR j% = 1 TO Hand(i%)
READ Payment%
NEXT j%
IF Payment% = 1 THEN IF HighPair(i%) < 11 THEN Payment% = 0: REM Lower than Jacks or Better.
Payment%(i%) = Payment%
Payment% = 0
NEXT i%
COLOR 0, 2
LOCATE xx1 + 2
FOR i% = 1 TO 5
LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10: PRINT SPACE$(10); : LOCATE xx1 + ((i% - 1) * xspc), yy1 - 10
SELECT CASE Bet(i%)
CASE 0: PRINT " No Bet. ";
CASE ELSE
Total% = Payment%(i%) * Bet(i%)
TotalAll% = TotalAll% + Total%
PRINT " "; LTRIM$(STR$(Bet(i%))); "*"; LTRIM$(STR$(Payment%(i%))); "="; LTRIM$(STR$(Total%))
END SELECT
NEXT
IF TotalAll% > 0 THEN Credits = Credits + TotalAll%: CALL CreditsDisplay
IF Credits = 0 AND Delt$ = "Delt" THEN
SOUND 100, 2
LOCATE xx1 + 5 * xspc + 2, yy1 + 12
PRINT "Game Over. Press Esc to Exit."; : Delt$ = "GameOver"
END IF
END SUB
SUB PinStripe
COLOR 7, 3
LOCATE 1, 1: PRINT CHR$(218); STRING$(78, 196) + CHR$(191)
FOR k = 2 TO 24
LOCATE k, 1: PRINT CHR$(179); " "; : LOCATE k, 79: PRINT " "; CHR$(179);
NEXT k
LOCATE 25, 1
PRINT CHR$(192); STRING$(78, 196); CHR$(217);
IF box = 1 THEN
COLOR 6, 5
LOCATE 4, 8: PRINT CHR$(218); STRING$(64, 196) + CHR$(191)
FOR k = 5 TO 21
LOCATE k, 8: PRINT CHR$(179); " "; : LOCATE k, 72: PRINT " "; CHR$(179)
NEXT k
LOCATE , 8: PRINT CHR$(192); STRING$(64, 196); CHR$(217);
END IF
END SUB
SUB PseudoMouseCursor (pmc%, x%, y%, oldx%, oldy%, oldcolor%)
REM Makes Pseudo-Mouse Cursor
IF oldx% <> x% OR oldy% <> y% OR oldx% = 0 OR pmc% = 2 THEN
IF oldx% = 0 AND pmc% <> 1 THEN
oldx% = x%: oldy% = y%: oldcolor% = SCREEN(x%, y%, 1)
ReplaceChr$ = CHR$(SCREEN(oldx%, oldy%))
LOCATE x%, y%: COLOR oldcolor% MOD 16, 4: PRINT ReplaceChr$; : pmc% = 1
ELSE
REM Get Old Character and Color
IF oldx% <> 0 THEN LOCATE oldx%, oldy%: COLOR oldcolor% MOD 16, oldcolor% \ 16: PRINT CHR$(SCREEN(oldx%, oldy%));
IF pmc% = 1 THEN
REM Get color at next point.
oldcolor% = SCREEN(x%, y%, 1)
REM Get character at next point.
ReplaceChr$ = CHR$(SCREEN(x%, y%))
REM Cursor highlight in white.
COLOR 7, 4: LOCATE x%, y%: PRINT ReplaceChr$;
oldx% = x%: oldy% = y%
ELSE
REM Hide Mouse
oldx% = 0: oldy% = 0: oldcolor% = 0
END IF
END IF
LOCATE x%, y%
COLOR 7, 0
END IF
END SUB
SUB Shuffle
REM SIMPLE SHUFFLE
y = 1
FOR i = 1 TO 52
x% = (RND * 51) + 1
IF CARD(x%) = 0 THEN CARD(x%) = i ELSE i = i - 1
NEXT
END SUB
SUB Sort
FOR h = 1 TO 5
FOR j = 1 TO 5
FOR i = 1 TO 5 - 1
REM Redefine Ace Value before SWAP.
x1 = Player(h, i) MOD 13 + 1
x2 = Player(h, i + 1) MOD 13 + 1
IF x1 = 1 THEN x1 = 14
IF x2 = 1 THEN x2 = 14
IF x1 < x2 THEN SWAP Player(h, i), Player(h, i + 1)
NEXT i, j, h