home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol024 / blkjack.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  10.9 KB  |  285 lines
  1. 1000 REM  ** CCII BLACKJACK - JAN 3,78 - JESSEN **
  2. 1010 REM ADAPTED TO PC BY PATRICK LEABO--TUSCON
  3. 1015 REM
  4. 1020 SCREEN 0:COLOR 7,0:WIDTH 80:KEY OFF:LOCATE ,,0
  5. 1025 SND = 1:KEY 10,"":ON KEY (10) GOSUB 3800 :KEY (10) ON
  6. 1030 COMMON MENU:RANDOMIZE VAL(RIGHT$(TIME$,2))
  7. 1040 CLS:GOSUB 3440:Z7= RND (1):GOSUB 3250:Y= 1:COLOR 7,0
  8. 1050 LOCATE 7,7:PRINT "WELCOME TO...";:PRINT "BLACKJACK!"
  9. 1060 K= 0:W1= 0:R= RND (1):N= INT (1945* RND (1)+ 1):X= INT (10* RND (1))
  10. 1070 DIM D(52),E(5),V(5),T(5),W(5),T$(34),Q(52)
  11. 1080 FOR A= 1 TO 52:D(A)= 0:NEXT 
  12. 1090 FOR A= 0 TO 39 STEP 13:FOR C= 1 TO 13:Q(A+ C)= C:NEXT C,A
  13. 1100 K= K+ 1:FOR P= 1 TO 5:E(P)= 0:V(P)= 0:T(P)= 0:NEXT :V(3)= 1
  14. 1110 LOCATE 9,2:GOSUB 3580
  15. 1120 LOCATE 23,54:PRINT STRING$(26," ")
  16. 1130 LOCATE 21,54:PRINT STRING$(26," ")
  17. 1140 LOCATE 9,3:PRINT STRING$(50," ")
  18. 1150 LOCATE 21,54:IF W1= 0 THEN GOSUB 3110
  19. 1160 IF W1> 0 THEN GOSUB 3090
  20. 1170 IF W1< 0 THEN GOSUB 3100
  21. 1180 GOSUB 3640:LOCATE 22,55:PRINT"WAGER $                  "
  22. 1190 LOCATE 22,62:LINE INPUT W$:P=1
  23. 1200 IF W$= "END" OR W$="end" THEN END
  24. 1210 W= VAL (W$):LOCATE 1,1
  25. 1220 IF W< = 500 THEN 1240:REM
  26. 1230 LOCATE 23,55:PRINT "HOUSE LIMIT IS $500";:GOSUB 3610:GOTO 1110
  27. 1240 IF W> 0 THEN 1260
  28. 1250 LOCATE 23,58:PRINT "BE SERIOUS";:GOSUB 3220:GOTO 1110
  29. 1260 IF W< 1 THEN 1290
  30. 1270 HP= HP+ 1
  31. 1280 GOTO 1320
  32. 1290 LOCATE 23,58
  33. 1300 PRINT "CHEAPSKATE";
  34. 1310 GOSUB 3610:GOTO 1110
  35. 1320 Q3= W
  36. 1330 IF Q3< 250 THEN 1350
  37. 1340 Q3= INT (Q3/ 10)
  38. 1350 FOR A4= 1 TO Q3:X= RND (1):NEXT :W(2)= W:W(3)= W:GOTO 1380
  39. 1360 TE= 0:NT= 0:LOCATE 9,14:PRINT "*I AM RESHUFFLING*":GOSUB 3220:GOTO 1110
  40. 1370 LOCATE 9,2:PRINT "HOUSE LIMIT IS $500":GOSUB 3610:GOTO 1110
  41. 1380 E(5)= 1:GOSUB 3510:GOSUB 2090:IF E(1)= 0 THEN 1400
  42. 1390 V(4)= 1
  43. 1400 V(5)= 1:E(5)= 2:GOSUB 3510:GOSUB 2090:M= X:P= 3:V(3)= 1
  44. 1410 GOSUB 3510:GOSUB 2090:G= X
  45. 1420 GOSUB 3690
  46. 1430 V(3)= V(3)+ 1
  47. 1440 GOSUB 3510:GOSUB 2090:IF V(2)> 0 THEN 1670
  48. 1450 S= X
  49. 1460 IF V(3)> 2 THEN 1670
  50. 1470 IF T(P)< 21 THEN 1570
  51. 1480 IF E(P)< 2 THEN 1500
  52. 1490 E(P)= E(P)- 1:T(P)= T(P)- 10:GOTO 1570
  53. 1500 LOCATE (Y9+ 2),(X9+ 8):PRINT "*BLACKJACK*"
  54. 1510 LOCATE 9,10:PRINT "I DEALT WRONG AGAIN!"
  55. 1520 E(5)= 2:P= 1:X9= 8:Y9= 3:X= M:GOSUB 2280
  56. 1530 IF V(3)< 5 THEN 1550
  57. 1540 W1= W1+ 2* W:GOTO 1560
  58. 1550 W1= W1+ 1.5* W
  59. 1560 GOTO 3000
  60. 1570 IF V(4)= 0 THEN 1670
  61. 1580 LOCATE 9,15:PRINT SPC( 22);""
  62. 1590 LOCATE 9,15:GOSUB 3640:PRINT "INSURANCE ";:COLOR 31,0:PRINT"?";:COLOR 7,0:GOSUB 3660:PRINT
  63. 1600 LOCATE 9,3:PRINT STRING$(50," ")
  64. 1610 KS$=LEFT$ (I$,1):IF KS$< > "Y" AND KS$<>"y" THEN 1670
  65. 1620 IF T(1)< 21 THEN 1650
  66. 1630 W1= W1+ W:PRINT 
  67. 1640 LOCATE 9,8:PRINT "YOU WIN $";W/ 2;" ON INSURANCE":GOTO 1670
  68. 1650 W1= W1- W/ 2:PRINT 
  69. 1660 LOCATE 9,8:PRINT "YOU LOST $";W/ 2;" ON INSURANCE"
  70. 1670 IF T(1)< 21 THEN 1720
  71. 1680 IF E(1)< 2 THEN 1700
  72. 1690 E(1)= E(1)- 1:T(1)= T(1)- 10:GOTO 1720
  73. 1700 LOCATE 9,22:PRINT "**I HAVE BLACKJACK**"
  74. 1710 X9= 8:Y9= 3:E(5)= 2:P= 1:X= M:GOSUB 2280:P= 3:GOTO 2910
  75. 1720 IF T(P)< = 21 THEN 1780
  76. 1730 IF E(P)> 0 THEN 1770
  77. 1740 LOCATE 9,16:PRINT "**YOU BUST**"
  78. 1750 GOSUB 3560:C1= T(P)- 5* (INT (T(P)/ 5)):IF V(2)= 1 THEN 1990
  79. 1760 GOTO 2690
  80. 1770 E(P)= E(P)- 1:T(P)= T(P)- 10
  81. 1780 IF V(1)= 2 THEN 1750
  82. 1790 IF V(3)> 4 THEN 1810
  83. 1800 GOTO 1820
  84. 1810 IF T(P)< 21 THEN 3230
  85. 1820 LOCATE (Y9+ 2),(X9+ 8):GOSUB 3640:COLOR 31,0:PRINT "PLAY ";:COLOR 7,0:GOSUB 3660
  86. 1830 V(1)= 0
  87. 1840 KS$= LEFT$ (I$,1):IF KS$= "H" OR KS$="h" THEN V(1)= 1:GOTO 1870
  88. 1850 IF KS$= "D" OR KS$="d" THEN V(1)= 2:GOTO 1870
  89. 1860 IF KS$= "S" OR KS$="s" THEN V(1)= 3:GOTO 1870
  90. 1865 IF KS$ <> "0" THEN BEEP :GOTO 1820
  91. 1870 LOCATE (Y9+ 2),(X9+ 8):PRINT "      "
  92. 1880 IF V(1)< 3 THEN 2030
  93. 1890 IF V(2)> 0 THEN 2020
  94. 1900 IF V(3)> 2 THEN 2020
  95. 1910 IF Q(G)= Q(S)THEN 1940
  96. 1920 LOCATE 9,22:PRINT "THAT'S NO PAIR":GOSUB 3610
  97. 1930 LOCATE 9,22:PRINT "                        ":GOTO 1820
  98. 1940 V(2)= 1:IF Q(G)< 1 THEN 1960
  99. 1950 V(1)= 0
  100. 1960 T(3)= 0:T(2)= 0:P= 2:X9= 2:Y9= 19:GOSUB 3550
  101. 1970 X= S:GOSUB 2280:GOSUB 1980:P= 3:W(3)= W:X= G:GOSUB 1980:GOTO 1440
  102. 1980 GOSUB 2230:V(3)= 2:T(P)= C:RETURN 
  103. 1990 P= 2:V(2)= 2:V(3)= 2:IF Q(G)< 1 THEN 2010
  104. 2000 V(1)= 0
  105. 2010 GOTO 1440
  106. 2020 LOCATE 9,22:PRINT "NO SPLITS NOW     ":GOSUB 3610:LOCATE 9,22:PRINT"               ":GOTO 1820
  107. 2030 IF V(1)< 2 THEN 2070
  108. 2040 IF V(3)= 2 THEN 2060
  109. 2050 LOCATE 9,22:PRINT "TOO LATE TO DOUBLE":GOSUB 3610:LOCATE 9,22:PRINT"                      ":GOTO 1820
  110. 2060 W(P)= 2* W(P)
  111. 2070 IF V(1)> 0 THEN 1430
  112. 2080 GOTO 1750
  113. 2090 GOSUB 2120:T(P)= T(P)+ C:IF V(5)= 0 THEN 2110
  114. 2100 V(5)= 0:RETURN 
  115. 2110 GOSUB 2280:RETURN 
  116. 2120 IF R> = 50 THEN 2170
  117. 2130 X= INT (53* RND (Y))
  118. 2140 IF X= 0 THEN 2130
  119. 2150 IF D(X)= 0 THEN 2210
  120. 2160 R= R+ 1:IF R< 50 THEN 2120
  121. 2170 FOR A= 1 TO 52:IF D(A)= K THEN 2190
  122. 2180 D(A)= 0
  123. 2190 NEXT 
  124. 2200 TE= 0:NT= 0:R= 0:LOCATE 9,18:PRINT "*I RESHUFFLED*":GOSUB 3610:LOCATE 9,18:PRINT"                 ":GOTO 2120
  125. 2210 R= 0
  126. 2220 D(X)= K
  127. 2230 IF Q(X)> 1 THEN 2250
  128. 2240 C= 11:E(P)= E(P)+ 1:RETURN 
  129. 2250 IF Q(X)> 10 THEN 2270
  130. 2260 C= Q(X):RETURN 
  131. 2270 C= 10:RETURN 
  132. 2280 GOSUB 2290:RETURN 
  133. 2290 FOR I= 0 TO 34:T$(I)=  " ":NEXT
  134. 2300 IF X> 39 THEN U$=CHR$ (5):GOTO 2340
  135. 2310 IF X> 26 THEN U$= CHR$ (3):GOTO 2340
  136. 2320 IF X> 13 THEN U$= CHR$(4):GOTO 2340
  137. 2330 U$= CHR$ (6)
  138. 2340 COLOR 0,7
  139. 2350 ON Q(X) GOTO 2540,2530,2520,2510,2490,2470,2460,2450,2440,2420,2380,2370
  140. 2360 T$(17)= "K":GOTO 2390
  141. 2370 T$(17)= "Q":GOTO 2390
  142. 2380 T$(17)= "J"
  143. 2390 T$(8)= U$:T$(7)= U$:T$(6)= U$:T$(11)= U$:T$(16)= U$
  144. 2400 T$(21)= U$:T$(26)= U$:T$(27)= U$:T$(28)= U$:T$(23)= U$
  145. 2410 T$(18)= U$:T$(13)= U$:GOTO 2550
  146. 2420 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
  147. 2430 T$(28)= U$:GOTO 2510
  148. 2440 T$(7)= U$:T$(27)= U$:GOTO 2460
  149. 2450 T$(12)= U$:T$(22)= U$:GOTO 2470
  150. 2460 T$(17)= U$
  151. 2470 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
  152. 2480 T$(28)= U$:GOTO 2550
  153. 2490 T$(6)= U$:T$(8)= U$:T$(17)= U$:T$(26)= U$:T$(28)= U$
  154. 2500 GOTO 2550
  155. 2510 T$(11)= U$:T$(13)= U$:T$(21)= U$:T$(23)= U$:GOTO 2550
  156. 2520 T$(7)= U$:T$(17)= U$:T$(27)= U$:GOTO 2550
  157. 2530 T$(12)= U$:T$(22)= U$:GOTO 2550
  158. 2540 T$(17)= U$
  159. 2550 IF Q(X)> 1 AND Q(X)< 11 THEN T$= RIGHT$ (STR$ (Q(X)),1)
  160. 2560 IF Q(X)= 11 THEN T$= "J"
  161. 2570 IF Q(X)= 12 THEN T$= "Q"
  162. 2580 IF Q(X)= 13 THEN T$= "K"
  163. 2590 IF Q(X)= 1 THEN T$= "A"
  164. 2600 IF X> 13 AND X< 40 THEN T$= T$
  165. 2610 IF Q(X)< > 10 GOTO 2640
  166. 2620 T$= LEFT$(U$,1):M$= RIGHT$ (STR$ (0),1):N$= RIGHT$ (STR$ (1),1)
  167. 2630 T$(0)= N$:T$(1)= M$:T$(33)= T$(0):T$(34)= T$(1):GOTO 2650
  168. 2640 T$(0)= T$:T$(34)= T$
  169. 2650 Z9= Y9+ 5:X1= X9:Y1= Y9:REM GOSUB 64000:GOSUB 3000
  170. 2660 NT= NT+ 1:IF Q(X)> 9 THEN TE= TE+ 1
  171. 2670 FOR I= 0 TO 30 STEP 5:LOCATE Z9-I/5,X9+2:FOR J= 0 TO 4:PRINT T$(I+ J);:NEXT J
  172. 2680 NEXT I:COLOR 7,0:RETURN
  173. 2690 P= 3:X= M:X9= 8:Y9= 3:GOSUB 2290
  174. 2700 IF T(3)< 22 THEN 2730
  175. 2710 IF V(2)= 0 THEN 2910
  176. 2720 GOTO 2910
  177. 2730 P= 1
  178. 2740 IF T(1)< 17 THEN 3020
  179. 2750 IF T(1)> 17 THEN 2770
  180. 2760 IF E(1)> 0 THEN 3020
  181. 2770 IF T(1)> 21 THEN 3030
  182. 2780 P= 3
  183. 2790 LOCATE 5,(X9+ 7):PRINT "TOTAL":LOCATE 7,(X9+ 7):PRINT T(1);
  184. 2800 IF T(P)> 21 THEN 2840
  185. 2810 IF T(1)> 21 THEN 2840
  186. 2820 IF T(1)> T(P)THEN 2910
  187. 2830 IF T(1)= T(P)THEN 2980
  188. 2840 W1= W1+ W(P):PRINT :LOCATE 9,2
  189. 2850 FOR J= 1 TO 50:PRINT " ";:NEXT :PRINT :LOCATE 9,12
  190. 2860 IF C1> 3 THEN 3120
  191. 2870 IF C1> 2 THEN 3130
  192. 2880 IF C1> 1 THEN 3140
  193. 2890 IF C1> 0 THEN 3150
  194. 2900 GOTO 3160
  195. 2910 W1= W1- W(P):PRINT :LOCATE 9,2
  196. 2920 FOR J= 1 TO 50:PRINT " ";:NEXT :PRINT :LOCATE 9,12
  197. 2930 IF C1> 3 THEN 3170
  198. 2940 IF C1> 2 THEN 3180
  199. 2950 IF C1> 1 THEN 3190
  200. 2960 IF C1> 0 THEN 3200
  201. 2970 GOTO 3210
  202. 2980 LOCATE 9,24:PRINT "WE PUSH"
  203. 2990 IF V(2)> 0 THEN 3010
  204. 3000 GOSUB 3060:GOSUB 3610:GOTO 1100
  205. 3010 P= 3:V(2)= 0:GOTO 2800
  206. 3020 E(5)= E(5)+ 1:P= 1:GOSUB 3510:GOSUB 2090:GOTO 2730
  207. 3030 IF E(1)= 0 THEN 3050
  208. 3040 E(1)= E(1)- 1:T(1)= T(1)- 10:GOTO 2730
  209. 3050 LOCATE 6,(X9+ 13):PRINT "*I BUST*":GOTO 2780
  210. 3060 LOCATE 9,25:RETURN
  211. 3070 IF W1< 0 THEN 3100
  212. 3080 IF W1= 0 THEN 3110
  213. 3090 PRINT "YOU'RE AHEAD $";W1;:RETURN
  214. 3100 PRINT "YOU'RE BEHIND $";- W1;:RETURN
  215. 3110 PRINT "YOU'RE EVEN           ";:RETURN 
  216. 3120 PRINT "I MUST HAVE DEALT WRONG":GOTO 2990
  217. 3130 PRINT "YOU'RE LUCKY AGAIN":GOTO 2990
  218. 3140 PRINT "YOU MUST HAVE BEEN PEEKING":GOTO 2990
  219. 3150 PRINT "I COULD LOSE MY JOB THIS WAY":GOTO 2990
  220. 3160 PRINT "THE CARDS HAVE TURNED AGAINST ME":GOTO 2990
  221. 3170 PRINT "*THE BOTTOM OF THE DECK STRIKES AGAIN*":GOTO 2990
  222. 3180 PRINT "A VICTORY FOR US GOOD GUYS":GOTO 2990
  223. 3190 PRINT "YOU CAN'T BEAT SKILL":GOTO 2990
  224. 3200 PRINT "YOU CAN'T WIN THEM ALL":GOTO 2990
  225. 3210 PRINT "THANKS!":GOTO 2990
  226. 3220 FOR M9= 1 TO 52:D(M9)= 0:NEXT :R= 0:RETURN 
  227. 3230 LOCATE 9,12:PRINT "*YOU WIN WITH 5 CARDS*":PRINT :GOTO 1520
  228. 3240 REM DRAW INSTRUCTIONS
  229. 3250 COLOR 0,7
  230. 3260 FOR N=2 TO 18:LOCATE N,54:PRINT STRING$(26," "):NEXT
  231. 3270 LOCATE 2,58:PRINT "IBM PC BLACKJACK";
  232. 3280 LOCATE 3,60:PRINT"************"                                               
  233. 3290 LOCATE  4,55:PRINT"FOLLOW ALL BETS WITH"
  234. 3300 LOCATE 5,60:PRINT"RETURN KEY"
  235. 3310 LOCATE 7,55:PRINT"RESPONSES:"
  236. 3320 LOCATE 8,57:PRINT"<CR> = STAND":LOCATE 9,60:PRINT"H = HIT"
  237. 3330 LOCATE 10,60:PRINT"D = DOUBLE DOWN":LOCATE 11,60:PRINT"S = SPLIT PAIR"
  238. 3340 LOCATE 12,58:PRINT"INSURANCE:"
  239. 3350 LOCATE 13,60:PRINT"N = NO":LOCATE 14,60:PRINT"Y = YES"
  240. 3360 LOCATE 15,63:PRINT"RULES:"
  241. 3370 LOCATE 16,54:PRINT"HOUSE LIMIT IS $500.00"
  242. 3380 LOCATE 17,54:PRINT"BLACKJACK PAYS 1.5 TO 1"
  243. 3390 LOCATE 18,54:PRINT;"BET END TO QUIT";:COLOR 7,0
  244. 3400 ME$="HOUSE":FOR YP=1 TO YP+LEN(ME$):LOCATE YP+1,2:PRINT MID$(ME$,YP,1):NEXT
  245. 3410 ME$="PLAYER":FOR YP=1 TO YP+LEN(ME$):LOCATE YP+9,2:PRINT MID$(ME$,YP,1):NEXT
  246. 3420 RETURN
  247. 3430 REM DRAW FIELD
  248. 3440 LOCATE 1,1:PRINT"╒";STRING$(51,"═");"╤";STRING$(26,"═");"╕";
  249. 3450 LOCATE 2,1:FOR N=1 TO 22:PRINT"│"TAB(53);"│";TAB(80);"│";:NEXT
  250. 3460 LOCATE 24,1:PRINT"│";:LOCATE 24,53:PRINT"│";
  251. 3470 LOCATE 25,1:PRINT"╘";STRING$(51,"═");"╧";STRING$(26,"═");
  252. 3480 DEF SEG=&HB000:POKE 3998,190:POKE 3838,179:DEF SEG
  253. 3490 LOCATE 19,53:PRINT"╞══════════════════════════╡"
  254. 3500 LOCATE 1,1:RETURN
  255. 3510 ON P GOTO 3520,3530,3540
  256. 3520 X9= INT (2+ E(5)* 6- 6):Y9= 3:GOTO 3550
  257. 3530 X9= INT (2+ V(3)* 6- 6):Y9= 19:GOTO 3550
  258. 3540 X9= INT (2+ V(3)* 6- 6):Y9= 11
  259. 3550 RETURN 
  260. 3560 LOCATE (Y9+ 0),(X9+ 7):PRINT "TOTAL";
  261. 3570 LOCATE (Y9+ 3),(X9+ 7):PRINT T(P);:RETURN
  262. 3580 FOR N=1 TO 7:LOCATE N+1,3:PRINT STRING$(50," "):NEXT
  263. 3590 FOR N=0 TO 15:LOCATE N+9,3:PRINT STRING$(50," ");:NEXT
  264. 3600 RETURN
  265. 3610 FOR P1= 1 TO 1000:NEXT P1:RETURN
  266. 3620 REM   PLINK
  267. 3630 IF SND = 1 THEN PLAY "L64T200N46":REM PLINK
  268. 3635 RETURN
  269. 3640 REM   PLONK
  270. 3650 IF SND = 1 THEN PLAY "L64T200N70":REM PLONK
  271. 3655 RETURN
  272. 3660 REM   KEYSTROKE
  273. 3670 I$=INKEY$:IF I$=""THEN 3670 ELSE IF I$= CHR$(13) THEN I$= "0":RETURN
  274. 3680 RETURN
  275. 3690 REM   BACK OF CARD
  276. 3700 COLOR 0,7:CB$= "╬╬╬╬╬"
  277. 3710 GOSUB 3620
  278. 3720 X1= 10:Y1= 1:FOR NN= 7 TO 1 STEP - 1
  279. 3730 LOCATE Y1+NN,X1:PRINT CB$:NEXT :COLOR 7,0:RETURN
  280. 3800 REM   toggle sound on or off with F10
  281. 3810 IF SND = 1 THEN SND = 0 ELSE SND=1
  282. 3820 RETURN
  283.  CB$:NEXT :COLOR 7,0:RETURN
  284. 3800 REM   toggle sound on or off with F10
  285. 3810 IF SND = 1 THEN SND =