The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 


  << Previous Topic | Next Topic >>Return to Index  

Cardpick game for QB64 bug check.

January 28 2008 at 2:21 PM
roy  (no login)

DIM i, k AS INTEGER
DIM deck(1 TO 52) AS INTEGER
REM Using INTEGER speeds up your program

RANDOMIZE TIMER
REM This makes RND start at a different number each time.

REM Seed the array
FOR i = 1 TO 52
deck(i) = i
NEXT

REM Shuffle the deck 10 times
FOR i = 1 TO 10
FOR k = 1 TO 52
s = INT(RND * 52) + 1
SWAP deck(s), deck(k)
NEXT k
NEXT i

tot = 416: REM total value of cards with Ace = 14
numbLeft = 52: REM cards left in pack

COLOR 0, 2

REM Play game, Select and print high or low from top of deck
FOR i = 1 TO 52
CLS
LOCATE 2, 6
PRINT "Card number"; i; "is"
LOCATE 4, 16

SELECT CASE deck(i)
REM This is one way of dealing with choices

CASE 2 TO 13: COLOR 4
IF deck(i) = 13 THEN
PRINT "K "; CHR$(3)
ELSEIF deck(i) = 12 THEN PRINT "Q "; CHR$(3)
ELSEIF deck(i) = 11 THEN PRINT "J "; CHR$(3)
ELSE PRINT deck(i); CHR$(3)
END IF

CASE 15 TO 26: COLOR 0: deck(i) = deck(i) - 13
IF deck(i) = 13 THEN
PRINT "K "; CHR$(5)
ELSEIF deck(i) = 12 THEN PRINT "Q "; CHR$(5)
ELSEIF deck(i) = 11 THEN PRINT "J "; CHR$(5)
ELSE PRINT deck(i); CHR$(5)
END IF


CASE 28 TO 39: COLOR 4: deck(i) = deck(i) - 26
IF deck(i) = 13 THEN
PRINT "K "; CHR$(4)
ELSEIF deck(i) = 12 THEN PRINT "Q "; CHR$(4)
ELSEIF deck(i) = 11 THEN PRINT "J "; CHR$(4)
ELSE PRINT deck(i); CHR$(4)
END IF

CASE 41 TO 52: COLOR 0: deck(i) = deck(i) - 39
IF deck(i) = 13 THEN
PRINT "K "; CHR$(6)
ELSEIF deck(i) = 12 THEN PRINT "Q "; CHR$(6)
ELSEIF deck(i) = 11 THEN PRINT "J "; CHR$(6)
ELSE PRINT deck(i); CHR$(6)
END IF

REM Making Ace high and printing A instead of 1
CASE 1: COLOR 4: PRINT "A "; CHR$(3): deck(i) = 14
CASE 14: COLOR 0: PRINT "A "; CHR$(5): deck(i) = 14
CASE 27: COLOR 4: PRINT "A "; CHR$(4): deck(i) = 14
CASE 40: COLOR 0: PRINT "A "; CHR$(6): deck(i) = 14

END SELECT
COLOR 0
PRINT
IF orig > 0 THEN
IF orig > deck(i) THEN PRINT "Next card was lower": sel$ = "L"
IF orig < deck(i) THEN PRINT "Next card was higher": sel$ = "H"
IF orig = deck(i) THEN PRINT "Next card was the same"; sel$ = "S"

IF sel$ = fred$ THEN fred = fred + 1 ELSE fred = fred - 1
IF sel$ = comp$ THEN bert = bert + 1 ELSE bert = bert - 1
IF sel$ = select$ THEN you = you + 1 ELSE you = you - 1
IF sel$ = alec$ THEN alec = alec + 1 ELSE alec = alec - 1
END IF
PRINT
PRINT "Your score is"; TAB(25); you
PRINT "Random Bert's score is"; TAB(25); bert
PRINT "Average Fred's score is"; TAB(25); fred
PRINT "Smart Alec's score is"; TAB(25); alec

REM Average Fred's choice
tot = tot - deck(i)
ave = tot / numbLeft
IF deck(i) > ave THEN
fred$ = "L"
ELSE fred$ = "H"
END IF

REM Random Bert's choice
sel = INT(RND * 2) + 1
IF sel = 1 THEN comp$ = "L" ELSE comp$ = "H"

REM Smart Alec's choice, he works out what cards are left.
sum = 0
FOR k = i TO 52
IF deck(k) = 1 OR deck(k) = 14 OR deck(k) = 27 OR deck(k) = 40 THEN
sum = sum + 1
ELSE
j = deck(k)
SELECT CASE deck(k)
CASE 15 TO 26: j = j - 13
CASE 28 TO 39: j = j - 26
CASE 41 TO 52: j = j - 39
END SELECT
END IF
IF deck(i) > j THEN
sum = sum - 1
ELSE sum = sum + 1
END IF
NEXT
IF sum > 0 THEN alec$ = "H" ELSE alec$ = "L"

IF i = 52 THEN
PRINT
PRINT "Game over push Esc to exit."
DO: esc$ = INKEY$: LOOP UNTIL esc$ = CHR$(27)
SYSTEM
END IF

COLOR 0
LOCATE 12, 4
PRINT
PRINT "Select high or low for next card h/l"
DO: hl$ = INKEY$: LOOP WHILE hl$ = ""
select$ = UCASE$(hl$)
IF select$ = CHR$(72) OR select$ = CHR$(76) THEN
choiceH = deck(i): choiceL = 0
PRINT
ELSE PRINT "Invalid selection, computer will pick "; comp$: select$ = comp$
END IF
PRINT
PRINT "Your choice was", select$
PRINT "Average Fred chose", fred$
PRINT "Random Bert chose", comp$
PRINT "Smart Alec chose", alec$
orig = deck(i)
SLEEP 3
hl$ = ""
NEXT


 

 Respond to this message   
Current Topic - Cardpick game for QB64 bug check.
  << Previous Topic | Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums