'BJ.BAS
'by Justin Rosenberg
'
'taken from The QBasic Page at http://qbasic.com
DECLARE SUB hit ()
DECLARE SUB ext ()
DECLARE SUB stik ()
DECLARE SUB CHOICES ()
DECLARE SUB intro ()
DECLARE SUB makedeck ()
DECLARE SUB first3 ()
DECLARE SUB backgrnd ()
DECLARE SUB ASSIGN ()
' Game
' Black Jack
' Programming by Justin Rosenberg
RANDOMIZE TIMER
you = 0
deal = 0
push = 0
intro
makedeck
start:
backgrnd
first3
x = 1
y = 300
a = 45
b = 330
control = 0
again:
SLOW = SLOW + 1: IF SLOW / 50 = INT(SLOW / 50) THEN C = RND * 15
LINE (x, y)-(a, b), C, B
key$ = INKEY$
IF key$ = CHR$(0) + "M" THEN x = x + 60: a = a + 60
IF key$ = CHR$(0) + "K" THEN x = x - 60: a = a - 60
IF x > 151 THEN x = x - 60: a = a - 60
IF x < 1 THEN x = x + 60: a = a + 60
IF key$ = CHR$(13) THEN GOTO sort
LINE (1, 300)-(45, 330), 4, B
LINE (61, 300)-(105, 330), 4, B
LINE (121, 300)-(165, 330), 4, B
IF control = 1 THEN GOTO endy
GOTO again
sort:
IF x = 1 THEN hit
IF x = 61 THEN stik
IF x = 121 THEN ext
GOTO again
endy:
GOTO start
SUB ASSIGN
SHARED CHOICE, card$, card
card = 0
IF CHOICE <= 36 THEN card = VAL(card$): GOTO finish
IF card$ = "J " OR card$ = "Q " OR card$ = "K " THEN card = 10: GOTO finish
IF card$ = " J" OR card$ = " Q" OR card$ = " K" THEN card = 10: GOTO finish
IF card$ = "J" OR card$ = "Q" OR card$ = "K" THEN card = 10: GOTO finish
card = 11
finish:
END SUB
SUB backgrnd
SHARED uX, dx
CLS
SCREEN 9
' Drawing background graphics
CIRCLE (320, 10), 425, 6
PAINT (320, 1), 6
CIRCLE (320, 1), 425, 0
CIRCLE (320, 10), 425, 0
CIRCLE (320, 10), 425.8, 4
PAINT (360, 349), 4
LINE (120, 25)-(520, 250), 2, BF
' Drawing boxes where the cards will go
LINE (125, 30)-(195, 125), 15, BF
LINE (125, 150)-(195, 245), 15, BF
LINE (205, 30)-(275, 125), 1, BF
FOR y = 30 TO 125 STEP 5
LINE (205, y)-(275, y), 14
NEXT y
FOR x = 205 TO 275 STEP 5
LINE (x, 30)-(x, 125), 0
NEXT x
LINE (205, 150)-(275, 245), 15, BF
LINE (285, 30)-(355, 125), 1, B
LINE (285, 150)-(355, 245), 1, B
LINE (365, 30)-(435, 125), 1, B
LINE (365, 150)-(435, 245), 1, B
LINE (445, 30)-(515, 125), 1, B
LINE (445, 150)-(515, 245), 1, B
dx = 125
uX = 205
' Labeling areas
COLOR 1
LOCATE 1, 1
PRINT "Spider Casino"
LOCATE 2, 1
PRINT "Dealer hits "
LOCATE 3, 1
PRINT "on 16 and less"
LOCATE 23, 2
PRINT "HIT"
LOCATE 23, 9
PRINT "STICK"
LOCATE 23, 17
PRINT "EXIT"
LOCATE 23, 63
PRINT "YOUR HAND ="
LOCATE 1, 62
PRINT "DEALER'S HAND="
END SUB
SUB ext
SHARED you, dealer, push, control, utot, dtot, card5
IF card5 = 1 THEN LOCATE 20, 20: PRINT "You got 5 cards without going over. You win": card5 = 0
LOCATE 21, 27
PRINT "Press the enter to continue"
enter:
IF INKEY$ <> CHR$(13) THEN GOTO enter
LOCATE 10, 1
PRINT "Wins"; you
PRINT "Loses"; dealer
PRINT "Ties"; push
PRINT "Winning"
PRINT "Percentage ";
IF you = 0 THEN PRINT 0 ELSE PRINT INT(you / (you + dealer + push) * 100);
LOCATE 20, 2
PRINT "Play"
LOCATE 21, 2
PRINT "Again?"
LOCATE 23, 2
PRINT "YES"
LOCATE 23, 9
PRINT "NO "
LOCATE 23, 17
PRINT " "
x = 1
y = 300
a = 45
b = 330
SLOW = 0
REM Covers up white space around text
LINE (121, 300)-(165, 330), 4, BF
LINE (80, 290)-(104, 325), 4, BF
trap:
SLOW = SLOW + 1: IF SLOW / 50 = INT(SLOW / 50) THEN C = RND * 15
LINE (x, y)-(a, b), C, B
key$ = INKEY$
IF key$ = CHR$(0) + "M" THEN x = x + 60: a = a + 60
IF key$ = CHR$(0) + "K" THEN x = x - 60: a = a - 60
IF x > 120 THEN x = x - 60: a = a - 60
IF x < 1 THEN x = x + 60: a = a + 60
IF key$ = CHR$(13) THEN GOTO endtrap
LINE (1, 300)-(45, 330), 4, B
LINE (61, 300)-(105, 330), 4, B
GOTO trap
endtrap:
IF x = 1 THEN control = 1: GOTO ENDIT
IF x = 61 THEN GOTO Gameover:
ENDIT:
utot = 0
dtot = 0
GOTO endend:
Gameover:
SCREEN 0, 0, 0
x = 1
y = 1
a = 1
b = 23
times = 1
WHILE INKEY$ = "" AND times < 333
times = times + 1
LOCATE y, x
PRINT " "
IF x = 71 THEN controlx$ = "left"
IF x = 1 THEN controlx$ = "right"
IF y = 1 THEN controly$ = "down"
IF y = 23 THEN controly$ = "up"
IF controlx$ = "left" THEN x = x - 2
IF controlx$ = "right" THEN x = x + 2
IF controly$ = "down" THEN y = y + 1
IF controly$ = "up" THEN y = y - 1
LOCATE b, a
PRINT " "
IF a = 61 THEN controla$ = "left"
IF a = 1 THEN controla$ = "right"
IF b = 1 THEN controlb$ = "down"
IF b = 23 THEN controlb$ = "up"
IF controla$ = "left" THEN a = a - 1
IF controla$ = "right" THEN a = a + 1
IF controlb$ = "down" THEN b = b + 1
IF controlb$ = "up" THEN b = b - 1
IF (y = b AND x > a AND x < a + 19) OR (b = y AND a > x AND a < x + 9) THEN GOTO collision
RETURN.back:
LOCATE y, x
COLOR RND * 10
PRINT "Game Over"
LOCATE b, a
COLOR RND * 10
PRINT "Thanks for playing!"
FOR stall = 1 TO 1900
NEXT stall
WEND
SYSTEM
collision:
IF controly$ = "down" THEN controly$ = "up" ELSE controly$ = "down"
IF controlb$ = "down" THEN controlb$ = "up" ELSE controlb$ = "down"
GOTO RETURN.back
endend:
END SUB
SUB first3
SHARED card, CHOICE, card$, utot, dtot, uX, ul1, ul2, dl1, dl2, dx, you
' Dealing fist 3 cards
over:
CLOSE
OPEN "Deck.dat" FOR RANDOM AS #1 LEN = 4
FIELD #1, 3 AS card$, 1 AS SUIT$
Q = 1
WHILE Q <> 0
TRYAGAIN:
CHOICE = INT(RND * 52) + 1
IF CHOICE < 1 OR CHOICE > 52 THEN GOTO TRYAGAIN
GET #1, CHOICE
IF VAL(card$) <> 1 THEN Q = 0: ASSIGN: GOTO oto1
qq = 0
FOR x = 1 TO 52
GET #1, x
IF VAL(card$) <> 1 THEN qq = 1
NEXT x
IF qq = 0 THEN LOCATE 20, 30: PRINT "Deck reshuffled.": makedeck: GOTO over
oto1:
WEND
CHOICE1 = CHOICE
CARD1$ = card$
CARD1 = card
SUIT1$ = SUIT$
LSET card$ = STR$(1)
PUT #1, CHOICE
Q = 1
WHILE Q <> 0
TRYAGAIN1:
CHOICE = INT(RND * 52) + 1
IF CHOICE < 1 OR CHOICE > 52 THEN GOTO TRYAGAIN1
GET #1, CHOICE
IF VAL(card$) <> 1 THEN Q = 0: ASSIGN: GOTO oto2:
qq = 0
FOR x = 1 TO 52
GET #1, x
IF VAL(card$) <> 1 THEN qq = 1
NEXT x
IF qq = 0 THEN LOCATE 20, 30: PRINT "Deck reshuffled.": makedeck: GOTO over
oto2:
WEND
card2$ = card$
card2 = card
SUIT2$ = SUIT$
LSET card$ = STR$(1)
PUT #1, CHOICE
Q = 1
WHILE Q <> 0
TRYAGAIN2:
CHOICE = INT(RND * 52) + 1
IF CHOICE < 1 OR CHOICE > 52 THEN GOTO TRYAGAIN2
GET #1, CHOICE
IF VAL(card$) <> 1 THEN Q = 0: ASSIGN: GOTO oto3
qq = 0
FOR x = 1 TO 52
GET #1, x
IF VAL(card$) <> 1 THEN qq = 1
NEXT x
IF qq = 0 THEN LOCATE 20, 30: PRINT "Deck reshuffled.": makedeck: GOTO over
oto3:
WEND
card3$ = card$
card3 = card
SUIT3$ = SUIT$
LSET card$ = STR$(1)
PUT #1, CHOICE
CLOSE
' Displaying cards
LOCATE 4, 21
IF SUIT1$ = "S" OR SUIT1$ = "C" THEN COLOR 8, 63
IF SUIT1$ = "D" OR SUIT1$ = "H" THEN COLOR 4, 63
IF SUIT1$ = "S" THEN chr = 6
IF SUIT1$ = "H" THEN chr = 3
IF SUIT1$ = "D" THEN chr = 4
IF SUIT1$ = "C" THEN chr = 5
PRINT CARD1$; CHR$(chr)
dl1 = 21
dl2 = 17
LOCATE 9, 17
IF SUIT1$ = "S" OR SUIT1$ = "C" THEN COLOR 8, 63
IF SUIT1$ = "D" OR SUIT1$ = "H" THEN COLOR 4, 63
IF SUIT1$ = "S" THEN chr = 6
IF SUIT1$ = "H" THEN chr = 3
IF SUIT1$ = "D" THEN chr = 4
IF SUIT1$ = "C" THEN chr = 5
PRINT CARD1$; CHR$(chr)
LOCATE 17, 17
IF SUIT2$ = "S" OR SUIT2$ = "C" THEN COLOR 8, 63
IF SUIT2$ = "D" OR SUIT2$ = "H" THEN COLOR 4, 63
IF SUIT2$ = "S" THEN chr = 6
IF SUIT2$ = "H" THEN chr = 3
IF SUIT2$ = "D" THEN chr = 4
IF SUIT2$ = "C" THEN chr = 5
PRINT card2$; CHR$(chr)
LOCATE 12, 21
IF SUIT2$ = "S" OR SUIT2$ = "C" THEN COLOR 8, 63
IF SUIT2$ = "D" OR SUIT2$ = "H" THEN COLOR 4, 63
IF SUIT2$ = "S" THEN chr = 6
IF SUIT2$ = "H" THEN chr = 3
IF SUIT2$ = "D" THEN chr = 4
IF SUIT2$ = "C" THEN chr = 5
PRINT card2$; CHR$(chr)
LOCATE 12, 31
IF SUIT3$ = "S" OR SUIT3$ = "C" THEN COLOR 8, 63
IF SUIT3$ = "D" OR SUIT3$ = "H" THEN COLOR 4, 63
IF SUIT3$ = "S" THEN chr = 6
IF SUIT3$ = "H" THEN chr = 3
IF SUIT3$ = "D" THEN chr = 4
IF SUIT3$ = "C" THEN chr = 5
PRINT card3$; CHR$(chr)
LOCATE 17, 27
IF SUIT3$ = "S" OR SUIT3$ = "C" THEN COLOR 8, 63
IF SUIT3$ = "D" OR SUIT3$ = "H" THEN COLOR 4, 63
IF SUIT3$ = "S" THEN chr = 6
IF SUIT3$ = "H" THEN chr = 3
IF SUIT3$ = "D" THEN chr = 4
IF SUIT3$ = "C" THEN chr = 5
PRINT card3$; CHR$(chr)
ul1 = 31
ul2 = 27
' adding cards
dtot = CARD1
utot = card2 + card3
COLOR 1
LOCATE 1, 76
PRINT dtot
LOCATE 23, 74
PRINT utot
IF utot = 21 THEN LOCATE 20, 30: PRINT "Black Jack. You win": you = you + 1: ext: backgrnd: GOTO over
IF utot = 22 THEN utot = 12
END SUB
SUB hit
SHARED utot, dtot, CHOICE, card, card$, uX, dx, ul1, ul2, dl1, dl2, you, dealer, push, control2, card5
over2:
CLOSE
OPEN "Deck.dat" FOR RANDOM AS #1 LEN = 4
FIELD #1, 3 AS card$, 1 AS SUIT$
Q = 1
WHILE Q <> 0
TRYAGAINhit:
CHOICE = INT(RND * 100) + 1
IF CHOICE < 1 OR CHOICE > 52 THEN GOTO TRYAGAINhit
GET #1, CHOICE
IF VAL(card$) <> 1 THEN Q = 0: ASSIGN: GOTO oto4
qq = 0
FOR x = 1 TO 52
GET #1, x
IF VAL(card$) <> 1 THEN qq = 1
NEXT x
IF qq = 0 THEN LOCATE 20, 30: PRINT "Deck reshuffled.": makedeck: GOTO over2
oto4:
WEND
cardd$ = card$
LSET card$ = STR$(1)
PUT #1, CHOICE
COLOR 1
utot = utot + card
LOCATE 23, 74
PRINT utot
uX = uX + 80
LINE (uX, 150)-(uX + 70, 245), 15, BF
ul1 = ul1 + 10
ul2 = ul2 + 10
LOCATE 12, ul1
IF SUIT$ = "S" OR SUIT$ = "C" THEN COLOR 8, 63
IF SUIT$ = "D" OR SUIT$ = "H" THEN COLOR 4, 63
IF SUIT$ = "S" THEN chr = 6
IF SUIT$ = "H" THEN chr = 3
IF SUIT$ = "D" THEN chr = 4
IF SUIT$ = "C" THEN chr = 5
PRINT cardd$; CHR$(chr)
LOCATE 17, ul2
IF SUIT$ = "S" OR SUIT$ = "C" THEN COLOR 8, 63
IF SUIT$ = "D" OR SUIT$ = "H" THEN COLOR 4, 63
IF SUIT$ = "S" THEN chr = 6
IF SUIT$ = "H" THEN chr = 3
IF SUIT$ = "D" THEN chr = 4
IF SUIT$ = "C" THEN chr = 5
PRINT cardd$; CHR$(chr)
IF utot > 21 THEN LOCATE 20, 30: PRINT "You Busted. Dealer wins": dealer = dealer + 1: ext
IF utot = 21 THEN LOCATE 20, 30: PRINT "You win": you = you + 1: ext
IF uX = 445 AND utot < 21 THEN card5 = 1: you = you + 1: backgrnd: ext
CLOSE
END SUB
SUB intro
' Intro to Black Jack Game
' By: Justin Rosenberg
' This is the intro to Black Jack
CLS
COLOR 2
' CIRCLES
SCREEN 12
RANDOMIZE TIMER
SCREEN 9
FOR Q = 1 TO 5
FOR E = 0 TO 1 STEP .01
C = RND * 15
x = RND * 600
y = RND * 400
FOR R = 10 TO 100 STEP 10
CIRCLE (x, y), R, C, , , E
IF INKEY$ <> "" THEN GOTO skippy
NEXT R
NEXT E
C = INT(RND * 15)
IF C = 0 THEN C = 1
COLOR C
LOCATE 13, 35
PRINT "BLACK JACK"
LOCATE 23, 65
PRINT "SPIDER SOFTWARE"
FOR PAUSE = 1 TO 5000
NEXT PAUSE
NEXT Q
skippy:
COLOR 2
CLS
SCREEN 9
COLOR 3
PRINT "SPIDER SOFTWARE PRESENTS BLACK JACK."
PRINT "PROGRAMMED BY JUSTIN ROSENBERG."
PRINT "ANY SUGESTIONS SHOULD BE SENT TO JPROSE@UIT.NET"
PRINT "INSTRUCTIONS"
PRINT "THE GAME IS PLAYED LIKE REGULAR BLACK JACK EXCEPT FOR A FEW EXCEPTIONS."
PRINT "-----------------------------------------------------------------------"
PRINT "1.> ACES ARE 11 UNLESS YOU ARE DEALT 2 ACES."
PRINT "2.> DEALER HITS ON 16 OR LESS."
PRINT "3.> USE LEFT AND RIGHT ARROW KEYS TO SELECT ACTION."
PRINT "4.> ACTIONS ARE AS FOLLOWS HIT,STICK,AND EXIT."
PRINT "5.> ONLY ONE DECK IS USED."
PRINT "6.> YOU WILL NOT BE TOLD WHEN THAT DECK IS SHUFFLED."
PRINT "7.> THE DECK WILL NOT BE SHUFFLED TILL IT IS OUT OF CARDS."
PRINT "8.> HAVE FUN."
PRINT "Press the enter to continue."
enter1:
IF INKEY$ <> CHR$(13) THEN GOTO enter1
END SUB
SUB makedeck
' Creating Deck
CLOSE
OPEN "Deck.dat" FOR RANDOM AS #1 LEN = 4
FIELD #1, 3 AS card$, 1 AS SUIT$
location = 0
FOR x = 2 TO 10
location = location + 1
crd$ = STR$(x)
LSET card$ = crd$
LSET SUIT$ = "C"
PUT #1, location
NEXT x
FOR x = 2 TO 10
location = location + 1
crd$ = STR$(x)
LSET card$ = crd$
LSET SUIT$ = "D"
PUT #1, location
NEXT x
FOR x = 2 TO 10
location = location + 1
crd$ = STR$(x)
LSET card$ = crd$
LSET SUIT$ = "H"
PUT #1, location
NEXT x
FOR x = 2 TO 10
location = location + 1
crd$ = STR$(x)
LSET card$ = crd$
LSET SUIT$ = "S"
PUT #1, location
NEXT x
FOR x = 1 TO 4
crd$ = "J"
LSET card$ = crd$
IF x = 1 THEN LSET SUIT$ = "C"
IF x = 2 THEN LSET SUIT$ = "D"
IF x = 3 THEN LSET SUIT$ = "H"
IF x = 4 THEN LSET SUIT$ = "S"
location = location + 1
PUT #1, location
NEXT x
FOR x = 1 TO 4
crd$ = "Q"
IF x = 1 THEN LSET SUIT$ = "C"
IF x = 2 THEN LSET SUIT$ = "D"
IF x = 3 THEN LSET SUIT$ = "H"
IF x = 4 THEN LSET SUIT$ = "S"
LSET card$ = crd$
location = location + 1
PUT #1, location
NEXT x
FOR x = 1 TO 4
crd$ = "K"
LSET card$ = crd$
IF x = 1 THEN LSET SUIT$ = "C"
IF x = 2 THEN LSET SUIT$ = "D"
IF x = 3 THEN LSET SUIT$ = "H"
IF x = 4 THEN LSET SUIT$ = "S"
location = location + 1
PUT #1, location
NEXT x
FOR x = 1 TO 4
crd$ = "A"
LSET card$ = crd$
IF x = 1 THEN LSET SUIT$ = "C"
IF x = 2 THEN LSET SUIT$ = "D"
IF x = 3 THEN LSET SUIT$ = "H"
IF x = 4 THEN LSET SUIT$ = "S:"
location = location + 1
PUT #1, location
NEXT x
CLOSE
END SUB
SUB stik
SHARED dtot, utot, dl1, dl2, dx, card, card$, you, push, dealer, control, CHOICE, card5
' Dealer recives his cards
WHILE dtot < 17
over1:
CLOSE
OPEN "Deck.dat" FOR RANDOM AS #1 LEN = 4
FIELD #1, 3 AS card$, 1 AS SUIT$
Q = 1
WHILE Q <> 0
TRYAGAINstik:
CHOICE = INT(RND * 52) + 1
IF CHOICE < 1 OR CHOICE > 52 THEN GOTO TRYAGAINstik
GET #1, CHOICE
IF VAL(card$) <> 1 THEN Q = 0: ASSIGN: GOTO oto5
qq = 0
FOR x = 1 TO 52
GET #1, x
IF VAL(card$) <> 1 THEN qq = 1
NEXT x
IF qq = 0 THEN LOCATE 20, 30: PRINT "Deck reshuffled.": makedeck: GOTO over1
oto5:
WEND
cardd$ = card$
LSET card$ = STR$(1)
PUT #1, CHOICE
dtot = dtot + card
COLOR 1
LOCATE 1, 75
PRINT dtot
dx = dx + 80
LINE (dx, 30)-(dx + 70, 125), 15, BF
dl1 = dl1 + 10
dl2 = dl2 + 10
LOCATE 4, dl1
IF SUIT$ = "S" OR SUIT$ = "C" THEN COLOR 8, 63
IF SUIT$ = "D" OR SUIT$ = "H" THEN COLOR 4, 63
IF SUIT$ = "S" THEN chr = 6
IF SUIT$ = "H" THEN chr = 3
IF SUIT$ = "D" THEN chr = 4
IF SUIT$ = "C" THEN chr = 5
PRINT cardd$; CHR$(chr)
LOCATE 9, dl2
IF SUIT$ = "S" OR SUIT$ = "C" THEN COLOR 8, 63
IF SUIT$ = "D" OR SUIT$ = "H" THEN COLOR 4, 63
IF SUIT$ = "S" THEN chr = 6
IF SUIT$ = "H" THEN chr = 3
IF SUIT$ = "D" THEN chr = 4
IF SUIT$ = "C" THEN chr = 5
PRINT cardd$; CHR$(chr)
IF dtot = 21 THEN LOCATE 20, 30: PRINT "Dealer wins.": dealer = dealer + 1: ext
IF dtot > 21 THEN LOCATE 20, 30: PRINT "Dealer busts. You win": you = you + 1: ext
IF dx = 445 AND dtot < 21 THEN card5 = 1: dealer = dealer + 1: ext
IF control = 1 THEN GOTO indY
WEND
IF utot = dtot THEN LOCATE 20, 30: PRINT "Push.": push = push + 1: GOTO skip
IF utot > dtot THEN LOCATE 20, 30: PRINT "You Win.": you = you + 1 ELSE LOCATE 20, 30: PRINT "Dealer Wins.": dealer = dealer + 1
skip:
ext
indY:
END SUB
|
