home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol024 / cribbage.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  30.6 KB  |  968 lines
  1. 1 REM  20 SEPT 79  W/ SOUND/SCROLL/STROBE KEYBOARD
  2. 150 CLEAR ,&H8000:WIDTH 80
  3. 155 KEY 10,"":ON KEY (10) GOSUB 43000:KEY (10) ON
  4. 160 COLOR 7,0:CLS:SND=1:LOCATE ,,0
  5. 170 DEF FN A(X)= INT (X* RND (1))
  6. 175 DEF SEG = &HF00:BLOAD "CRIBBAGE.BLD",0
  7. 185 SCROLL%=0:MENU%= 2:COMMON MENU%
  8. 190 Y1=2:X1=2
  9. 195 GOSUB 60200:KEY OFF
  10. 197 GOSUB 42000
  11. 200 LOCATE 1,31:PRINT "C R I B B A G E":LOCATE 7,5
  12. 205 DIM P1(15),HH(4):FOR N= 1 TO 15:READ P1(N):NEXT
  13. 210 DATA 60,37,39,41,42,44,46,48,49,51,53,54,56,58,60
  14. 220 PRINT "+++   STANDBY - OPENING NEW DECK OF CARDS   +++"
  15. 230 PRINT CHR$(11):GOSUB 60300:RANDOMIZE VAL(RIGHT$(TIME$,2))
  16. 235 FOR VA= 2 TO 13:GOSUB 60000:NEXT :VA= 1:GOSUB 60000
  17. 240 DIM D(52,4),I(52),W(5,4),M(6,4),T$(34),H(8,4)
  18. 250 DIM Y(6,4),C(4,4),V(15,7),Q(11,6),R(4,5),S(4),J(52)
  19. 500 REM      SET DECK
  20. 530 DATA 1,2,3,4,5,6,0,1,2,3,5,4,6,0,1,2,3,6,4,5,0,1,2,4,5,3,6,0
  21. 540 DATA 1,2,4,6,3,5,0,1,2,5,6,3,4,0,1,3,4,5,2,6,0,1,3,4,6,2,5,0
  22. 550 DATA 1,3,5,6,2,4,0,1,4,5,6,2,3,0,2,3,4,5,1,6,0,2,3,4,6,1,5,0
  23. 560 DATA 2,3,5,6,1,4,0,2,4,5,6,1,3,0,3,4,5,6,1,2,0
  24. 570 RESTORE 530
  25. 580 FOR I= 1 TO 15:FOR J= 1 TO 7:READ V(I,J):NEXT J:NEXT I
  26. 600 REM    DATA FOR FOUR CARD RUN W/ PAIRS Q(I,J)
  27. 620 DATA 1,1,1,2,3,9,1,1,2,2,3,12,1,1,2,3,3,12
  28. 630 DATA 1,1,2,3,4,8,1,2,2,2,3,9,1,2,2,3,3,12
  29. 640 DATA 1,2,2,3,4,8,1,2,3,3,3,9,1,2,3,3,4,8
  30. 650 DATA 1,2,3,4,4,8,1,2,3,4,5,5
  31. 670 REM     DATA FOR THREE CARD RUN W/ PAIRS R(I,J)
  32. 690 DATA 1,1,2,3,6,1,2,2,3,6,1,2,3,3,6,1,2,3,4,4
  33. 710 REM     DATA FOR THREE CARD RUN S(I)
  34. 730 DATA 1,2,3,3
  35. 750 REM     PRESET
  36. 770 SC= 0:SP= 0:BS= 0:WP= 0:YC= 0:MC= 0:BH= 0
  37. 780 GP= 0:M= 0:C= 0:GC= 0:P= 0
  38. 790 GOTO 1030
  39. 1000 GOTO 150
  40. 1005 REM
  41. 1010 REM  SHUFFLE//CUT CARDS
  42. 1020 REM 
  43. 1030 LOCATE 10,5:GOSUB 60300
  44. 1040 PRINT "+++   STANDBY   +++   SHUFFLING THE CARDS   +++";
  45. 1050 PRINT CHR$(11):GOSUB 14500:GOSUB 17000
  46. 1060 LOCATE 12,8:GOSUB 60300
  47. 1070 INPUT "PLEASE CUT FOR THE DEAL (1-50)  ";I:GOSUB 60300
  48. 1075 IF I< 1 THEN GOSUB 17000:GOTO 6000
  49. 1080 IF I= INT (I)AND I> 0 AND I< 51 THEN 1120
  50. 1090 GOSUB 17800
  51. 1100 PRINT "BE SERIOUS NOW - THERE ARE 52 CARDS";
  52. 1110 GOTO 1060
  53. 1120 I1= I:VA= D(I,4):ST= D(I,3):GOSUB 22200
  54. 1130 GOSUB 17200
  55. 1140 LOCATE Y1-1,X1:PRINT "YOURS";
  56. 1150 J= FN A(52- I1)+ I1
  57. 1160 IF J= 0 THEN J= FN A(52)+ 1
  58. 1170 IF J= I1 THEN 1150
  59. 1180 J1= J:VA= D(J,4):ST= D(J,3):GOSUB 22300
  60. 1190 GOSUB 17200:I= I1:J= J1
  61. 1200 LOCATE Y1-1,X1:PRINT "MINE";
  62. 1205 FOR TD=1 TO 1500:NEXT
  63. 1210 IF D(I,4)< D(J,4) THEN M= 1:GOTO 1250
  64. 1220 IF D(J,4)< D(I,4) THEN M= 0:GOTO 1250
  65. 1230 GOSUB 17000:PRINT "YOU SURE ARE LUCKY - CUT AGAIN";
  66. 1240 GOTO 1060
  67. 1250 LOCATE 7,5:PRINT STRING$(48," ");:LOCATE 10,5:PRINT STRING$(48," "):GOSUB 23000
  68. 1260 GOSUB 17000:ON M+ 1 GOTO 2050,2000
  69. 2000 REM 
  70. 2010 REM  START PLAY
  71. 2020 REM 
  72. 2030 GOSUB 17800
  73. 2040 PRINT "YOU ARE DEALING";:GOTO 2070
  74. 2050 GOSUB 17800
  75. 2060 PRINT "I AM DEALING";
  76. 2070 M= 1- M:YY= 1- M
  77. 2080 FOR I= 1 TO 6:K= 2* I- YY:L= 2* I- M
  78. 2090 FOR J= 1 TO 4
  79. 2100 M(I,J)= D(K,J):REM   COMPUTERS HAND
  80. 2110 Y(I,J)= D(L,J):REM   PLAYERS   HAND
  81. 2120 NEXT J
  82. 2130 M(I,0)= 0:Y(I,0)= 0
  83. 2140 NEXT I
  84. 2150 FOR B= 1 TO 6:ON M+ 1 GOTO 2160,2190
  85. 2160 ON B GOSUB 22000,22100,22200,22300,22400,22500
  86. 2170 ST= M(B,3):VA= M(B,4):CN= Y1:GOSUB 22600:REM GOSUB 17200FORCARD
  87. 2180 ON M+ 1 GOTO 2190,2230
  88. 2190 ST= Y(B,3):VA= Y(B,4)
  89. 2200 ON B GOSUB 20000,20100,20200,20300,20400,20500
  90. 2210 GOSUB 17200:LOCATE 9,X1+ 2:PRINT CHR$(B+48);
  91. 2220 ON M+ 1 GOTO 2230,2160
  92. 2230 NEXT B
  93. 2500 REM  
  94. 2510 REM  GET THE UP CARD
  95. 2520 REM 
  96. 2530 UP= FN A(38)+ 8:V= 1
  97. 2540 FOR I= 1 TO 6
  98. 2550 IF Y(I,1)= D(UP,1) THEN V= 0
  99. 2560 IF M(I,1)= D(UP,1) THEN V= 0
  100. 2570 NEXT I:IF V= 0 THEN 2530
  101. 2580 FOR I= 1 TO 4:W(5,I)= D(UP,I):NEXT I
  102. 3000 REM 
  103. 3010 REM  COMPUTER EVALUATE HAND
  104. 3020 REM 
  105. 3030 REM GOSUB 17000
  106. 3040 LOCATE 13,3:PRINT "STANDBY - I TAKE A WHILE TO SORT & DISCARD";
  107. 3045 TIME$="00:00:00"
  108. 3050 WP= 0:FOR CN= 1 TO 15:VA= CN:GOSUB 60000
  109. 3070 I1= V(CN,1):I2= V(CN,2):I3= V(CN,3):I4= V(CN,4)
  110. 3110 C= 0:GOSUB 30000:V(CN,7)= P:IF P> WP THEN WP= P
  111. 3120 NEXT CN:P= 0
  112. 3125 LOCATE 13,3:PRINT STRING$(43," ");:LOCATE 14,9:PRINT STRING$(20," ");
  113. 3130 REM 
  114. 3140 REM  FIND ALL HANDS W/ MAX SCORE IN WP
  115. 3150 REM 
  116. 3160 J= 0:FOR I= 1 TO 15:IF V(I,7)< > WP THEN 3180
  117. 3170 J= J+ 1:I(J)= I
  118. 3180 NEXT I:IF J> 1 THEN 3260
  119. 3190 REM  
  120. 3200 REM  THIS IS BEST HAND
  121. 3210 REM 
  122. 3220 BC= I(1):GOTO 4000
  123. 3230 REM 
  124. 3240 REM  NO SINGLE BEST HAND - SEARCH FOR KEY CARDS
  125. 3250 REM 
  126. 3260 BH= 5:ZZ= 1:GOTO 3350
  127. 3270 BH= 8:ZZ= 2:GOTO 3350
  128. 3280 BH= 7:ZZ= 3:GOTO 3350
  129. 3290 BH= 11:ZZ= 4:GOTO 3350
  130. 3300 BH= 1:ZZ= 5:GOTO 3350
  131. 3310 REM 
  132. 3320 REM  RANDOMLY CHOOSE A HAND IF CMPTR REACHES HERE
  133. 3330 REM 
  134. 3340 BC= FN A(J)+ 1:I(BC)= BC:GOTO 4000
  135. 3350 REM 
  136. 3360 REM  BEST HAND WILL BE WHICHEVER HAS THE MOST OF CARD BH
  137. 3370 REM 
  138. 3380 WP= 0:FOR I= 1 TO 15:J(I)= 0:NEXT I
  139. 3390 FOR I= 1 TO J:FOR K= 1 TO 4:L= V(I(I),K)
  140. 3400 IF M(L,4)= BH THEN J(I)= J(I)+ 1
  141. 3410 NEXT K:IF J(I)> WP THEN WP= J(I)
  142. 3420 NEXT I
  143. 3430 K= 0:FOR I= 1 TO J:IF J(I)= WP THEN K= K+ 1:BC= I(I)
  144. 3440 NEXT I:IF K= 1 THEN 4000
  145. 3450 ON ZZ GOTO 3270,3280,3290,3300,3310
  146. 4000 REM  
  147. 4001 REM  PLAYER//COMPUTER DISCARDS
  148. 4002 REM  
  149. 4010 GOSUB 17000
  150. 4030 GOSUB 22700:GOSUB 22700
  151. 4040 GOSUB 17000:FOR B= 1 TO 2:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT B:GOSUB 60300
  152. 4050 I1= V(BC,5):I2= V(BC,6)
  153. 4060 GOSUB 17800:PRINT "YOUR DISCARDS PLEASE  ";:LOCATE ,,1
  154. 4070 GOSUB 40000:I3=ASC(KB$):GOSUB 60300:PRINT CHR$ (I3)+ "  ";:GOSUB 40000:I4=ASC(KB$):GOSUB 60300:PRINT CHR$ (I4);:LOCATE ,,0
  155. 4075 IF I3= 45 OR I4= 45 THEN 6000
  156. 4080 I3= I3- 48:I4= I4- 48
  157. 4090 IF I3< 1 OR I4< 1 THEN 4130
  158. 4100 IF I3< > INT (I3) OR I4< > INT (I4) THEN 4130
  159. 4110 IF I3= I4 THEN 4130
  160. 4120 IF I3< 7 AND I4< 7 THEN :GOTO 4200
  161. 4130 GOSUB 17800:PRINT "TRY A NUMBER FROM 1 TO 6";:GOTO 4060
  162. 4200 REM  
  163. 4210 REM  SET THE CRIB
  164. 4220 REM 
  165. 4230 FOR J= 1 TO 4:C(1,J)= M(I1,J):C(2,J)= M(I2,J):C(3,J)= Y(I3,J):C(4,J)= Y(I4,J):NEXT J
  166. 4240 M(I1,0)= 1:M(I2,0)= 1:Y(I3,0)= 1:Y(I4,0)= 1
  167. 4400 REM  
  168. 4410 REM  REPACK PLAYERS HAND//SORT ASCENDING
  169. 4420 REM 
  170. 4430 FOR K= 1 TO 4
  171. 4440 IF Y(K,0)= 0 THEN 4470
  172. 4450 FOR J= K+ 1 TO 6:FOR I= 0 TO 4:Y(J- 1,I)= Y(J,I):NEXT I:NEXT J
  173. 4460 Y(6,0)= 1:GOTO 4440
  174. 4470 NEXT K:Y(5,0)= 1
  175. 4480 V= 1:FOR I= 1 TO 3:IF Y(I,4)< = Y(I+ 1,4) THEN 4500
  176. 4490 FOR J= 0 TO 4:Y(0,J)= Y(I,J):Y(I,J)= Y(I+ 1,J):Y(I+ 1,J)= Y(0,J):NEXT J:V= 0
  177. 4500 NEXT I:IF V= 0 THEN 4480
  178. 4700 REM  
  179. 4710 REM  REDRAW CARDS
  180. 4720 REM 
  181. 4725 LOCATE 9,30:PRINT"           ";
  182. 4730 GOSUB 20500:FOR B= 1 TO 9:LOCATE Y1+ H1- 1,X1:PRINT SPC( W1);:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT B
  183. 4740 GOSUB 20400:FOR B= 1 TO 9:LOCATE Y1+ H1- 1,X1:PRINT SPC( W1);:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT B
  184. 4750 FOR B= 1 TO 4:ST= Y(B,3):VA= Y(B,4)
  185. 4760 ON B GOSUB 20000,20100,20200,20300:GOSUB 17200
  186. 4770 LOCATE 9,X1+ 2:PRINT CHR$(B+48):NEXT B:I3= 5:I4= 6
  187. 4780 REM  
  188. 4790 REM  GET UP CARD
  189. 4800 REM 
  190. 4810 VA= D(UP,4):ST= D(UP,3):GOSUB 20600:GOSUB 17200
  191. 4820 LOCATE 9,49:PRINT "UP CARD";
  192. 4830 FOR I= 1 TO 4:W(5,I)= D(UP,I):NEXT I
  193. 4840 IF W(5,4)< > 11 THEN 5000
  194. 4850 GOSUB 17000:IF M= 0 THEN 4890
  195. 4860 PRINT "2 POINTS FOR ME";:SC= SC+ 2:GOSUB 15500
  196. 4870 IF SC> 120 THEN 5500
  197. 4880 GOTO 5000
  198. 4890 PRINT "2 POINTS FOR YOU";:SP= SP+ 2:GOSUB 15500
  199. 4900 IF SP> 120 THEN 5500
  200. 5000 REM  
  201. 5010 REM  PLAY CONTROL
  202. 5020 REM 
  203. 5030 GOSUB 7000:LOCATE 6,35:PRINT SPC( 13);:LOCATE 7,35:PRINT SPC( 13);
  204. 5035 IF CP= 45 THEN 6000
  205. 5040 IF SC> 120 OR SP> 120 THEN 5500
  206. 5050 FOR B= 1 TO 4:VA= Y(B,4):ST= Y(B,3):ON B GOSUB 20000,20100,20200,20300
  207. 5060 GOSUB 17200:NEXT B
  208. 5070 GOSUB 17000:IF M= 0 THEN 5090
  209. 5080 PRINT "YOU SCORE FIRST";:XI= 1:GOTO 5100
  210. 5090 PRINT "I SCORE FIRST";:XI= 2
  211. 5100 GOSUB 10000
  212. 5110 IF SC> 120 OR SP> 120 THEN 5500
  213. 5120 GOSUB 23000
  214. 5130 GOSUB 17000:PRINT "++STANDBY++ SHUFFLING THE CARDS";
  215. 5140 GOSUB 14500:GOTO 1260
  216. 5500 REM  
  217. 5510 REM  SELECT WINNER//END
  218. 5520 REM 
  219. 5530 GOSUB 17800:IF SC< 121 THEN 5550
  220. 5540 GOSUB 17000:PRINT "+++   I WIN   +++";:GOTO 5570
  221. 5550 IF SP< 121 THEN 5570
  222. 5560 GOSUB 17000:PRINT "+++   YOU WIN   +++";
  223. 5570 GOSUB 17000:PRINT "I HAVE  "SC" POINTS";
  224. 5580 GOSUB 17000:PRINT "YOU HAVE"SP" POINTS";
  225. 5590 IF SC> 120 THEN SC= 121
  226. 5600 IF SP> 120 THEN SP= 121
  227. 5610 IF SC- SP< = 60 THEN 5630
  228. 5620 GOSUB 17800:PRINT "HA - HA - A DOUBLE SKUNK";:GOTO 5690
  229. 5630 IF SC- SP< = 30 THEN 5650
  230. 5640 GOSUB 17800:PRINT "HA - HA - I SKUNKED YOU";:GOTO 5690
  231. 5650 IF SP- SC< = 60 THEN 5670
  232. 5660 GOSUB 17800:PRINT "OOOOPS - I GOT DOUBLE SKUNKED";:GOTO 5690
  233. 5670 IF SP- SC< = 30 THEN 5690
  234. 5680 GOSUB 17800:PRINT "HMMMMM - I GOT SKUNKED";
  235. 5690 '
  236. 6000 REM  
  237. 6010 REM  PLAY AGAIN?
  238. 6020 REM 
  239. 6030 GOSUB 17800:CALL SCROLL%(SCR%,POS1%,POS2%)
  240. 6040 PRINT "WOUï∞ïvï&H768Bï3ïv
  241.  
  242. ïè°░═3ïv
  243.  
  244. ïè°░═3ïv
  245.  
  246. ïè°░═3ïv
  247.  
  248. ïè°░═3ïv
  249.  
  250. ïè°░═3ïv
  251.  
  252. ïè°░═3ïv
  253.  
  254. ïè°░═3ïv
  255.  
  256. ïè°░═3ïv
  257.  
  258. ïè°░═3ïv
  259.  
  260. ïè°░═3ïv
  261.  
  262. ïè°░═3ïv
  263.  
  264. ïè°░═3ïv
  265.  
  266. ïè°░═3ïv
  267.  
  268. ïè°░═3ïv
  269.  
  270. ïè°░═3ïv
  271.  
  272. ïè°░═3ïv
  273.  
  274. ïè°░═3ïv
  275.  
  276. ïè°░═3ïv
  277.  
  278. ïè°░═3ïv
  279.  
  280. ïè°░═3ïv
  281.  
  282. ïè°░═",T
  283. 6050 GOSUB 40000:K= ASC(KB$):GOSUB 60300:IF K= 78 OR K= 89 THEN PRINT CHR$(K);
  284. 6060 IF K= 89 THEN CLS:RUN 1000
  285. 6070 IF K< > 78 THEN 6050
  286. 6090 LOCATE ,,0:CLS:LOCATE 16,18
  287. 6100 PRINT "G O O D  B Y E";
  288. 6110 KEY (10) OFF
  289. 6120 END
  290. 7000 REM  
  291. 7010 REM  PLAY THE HAND
  292. 7020 REM 
  293. 7030 GOSUB 15000
  294. 7040 YC= 0:MC= 0:C= 0:BS= 0:GC= 0:GP= 0
  295. 7050 IF M= 0 THEN 7830
  296. 7060 GOSUB 17000:PRINT "YOUR PLAY  ";:LOCATE ,,1
  297. 7070 GOSUB 40000:CP= ASC(KB$):GOSUB 60300:C$= CHR$ (CP):IF CP= 71 OR CP = 13 THEN C$= "GO":CP=71
  298. 7075 IF CP= 45 THEN RETURN :REM  ASK IF END
  299. 7080 PRINT C$;
  300. 7090 IF CP= 71 AND BS< 22 AND MC< 4 THEN 7120
  301. 7100 IF CP= 71 THEN 7700
  302. 7110 CP= CP- 48:IF CP> 0 AND CP< 7 THEN 7130
  303. 7120 GOSUB 17800:PRINT "INVALID PLAY - TRY AGAIN";:GOTO 7060
  304. 7130 IF CP> 4 THEN 7530
  305. 7140 IF Y(CP,0)= 1 THEN 7540
  306. 7150 IF BS+ Y(CP,2)> 31 THEN 7550
  307. 7160 BS= BS+ Y(CP,2):YC= YC+ 1:C= C+ 1:GOSUB 15100
  308. 7300 REM  
  309. 7310 REM  CHECK FOR 15/31 &  PAIRS
  310. 7320 REM 
  311. 7330 WS= BS:GOSUB 15300
  312. 7400 REM 
  313. 7410 REM  CHECK FOR RUNS//MOVE CARD
  314. 7420 REM 
  315. 7430 GOSUB 16000:P= P+ PT:VA= Y(CP,4):ST= Y(CP,3)
  316. 7435 GOSUB 17100
  317. 7440 ON C GOSUB 21000,21100,21200,21300,21400,21500,21600,21700
  318. 7450 GOSUB 17200
  319. 7460 LOCATE 6,35:PRINT "SUM    ="BS"  ";:REM
  320. 7470 LOCATE 7,35:PRINT "POINTS ="P"  ";
  321. 7480 SP= SP+ P:IF P> 0 THEN GOSUB 15500
  322. 7490 IF SP> 120 THEN RETURN 
  323. 7500 IF BS< > 31 THEN 7700
  324. 7510 GP= 0:C= 0:BS= 0:GC= 0
  325. 7520 GOSUB 17700:GOTO 7700
  326. 7530 GOSUB 17800:PRINT "YOU DISCARDED THAT CARD EARLIER";:GOTO 7060
  327. 7540 GOSUB 17800:PRINT "YOU ALREADY PLAYED THIS CARD";:GOTO 7060
  328. 7550 GOSUB 17800:PRINT "WHOOPS - THAT IS MORE THAN 31";:GOTO 7060
  329. 7700 REM  
  330. 7710 REM  CHECK GO STATUS FROM PLAYER
  331. 7720 REM 
  332. 7730 IF C$= "GO"AND GC= 1 THEN 8880
  333. 7740 IF C$= "GO" THEN GP= 1:C$= ""
  334. 7750 IF YC> 3 THEN GP= 1
  335. 7760 IF GC= 0 THEN 7830
  336. 7770 IF GP= 0 AND GC= 1 THEN 7060
  337. 7780 GOTO 8880
  338. 7800 REM  
  339. 7810 REM  COMPUTERS PLAY
  340. 7820 REM 
  341. 7830 IF YC+ MC> 7 THEN 8880
  342. 7840 IF GC= 1 THEN 8800
  343. 7850 K= 0:WP= 0:WC= C
  344. 7860 FOR I= 0 TO 37:I(I)= 0:NEXT I
  345. 7870 K= K+ 1:IF K> 6 THEN 8210
  346. 7880 CC= V(BC,K)
  347. 7890 IF M(CC,0)= 1 THEN 7870
  348. 7900 WS= BS+ M(CC,2)
  349. 7910 IF WS> 31 THEN 7870
  350. 7920 IF M+ C= 1 AND M(CC,4)= 5 THEN 7870
  351. 7930 I(K+ 30)= CC
  352. 8000 REM  
  353. 8010 REM  CHECK FOR 15/31 & PAIRS
  354. 8020 REM 
  355. 8030 C= WC+ 1:P= 0:GOSUB 15200:GOSUB 15300
  356. 8100 REM  
  357. 8110 REM  CHECK FOR RUNS
  358. 8120 REM 
  359. 8130 GOSUB 16000:P= P+ PT:IF P> WP THEN WP= P
  360. 8140 I(K)= WP
  361. 8150 FOR L= 0 TO 8
  362. 8160 IF H(L,0)< > 2 THEN 8190
  363. 8170 H(L,0)= 0:H(L,1)= 0:H(L,2)= 0:H(L,3)= 0:H(L,4)= 0
  364. 8180 L= 8
  365. 8190 NEXT L
  366. 8200 GOTO 7870
  367. 8210 WP= 0
  368. 8220 FOR K= 1 TO 6
  369. 8230 IF WP< I(K) THEN WP= I(K):CC= I(K+ 30)
  370. 8240 NEXT K
  371. 8250 IF CC= 0 THEN 8530
  372. 8260 IF M(CC,0)= 1 THEN 8530
  373. 8270 BS= BS+ M(CC,2)
  374. 8280 C= WC+ 1:GOSUB 15200:GOTO 8620
  375. 8290 GOSUB 17000:PRINT "GO";:GC= 1
  376. 8300 C= WC:WP= 0:IF GP= 0 THEN 7060
  377. 8410 GOTO 8800
  378. 8500 REM  
  379. 8510 REM  GET CARD NO POINT VALUE
  380. 8520 REM 
  381. 8530 K= 0:WP= 0
  382. 8540 K= K+ 1:IF K> 6 THEN C= WC:GOTO 8290
  383. 8550 IF M(K,0)= 1 THEN 8540
  384. 8560 WS= BS+ M(CC,2)
  385. 8570 IF WS> 31 THEN 8540
  386. 8580 CC= K:C= WC+ 1
  387. 8590 GOSUB 15200:GOSUB 15300:GOSUB 16000:WP= WP+ P+ PT
  388. 8600 WS= BS+ M(CC,2):IF WS> 31 THEN 8290
  389. 8610 BS= WS
  390. 8620 MC= MC+ 1:M(CC,0)= 1
  391. 8630 VA= M(CC,4):ST= M(CC,3)
  392. 8635 GOSUB 22700
  393. 8640 ON C GOSUB 21000,21100,21200,21300,21400,21500,21600,21700
  394. 8650 GOSUB 17200
  395. 8660 LOCATE 6,35:PRINT "SUM    ="BS"  ":REM
  396. 8670 LOCATE 7,35:PRINT "POINTS ="WP"  "
  397. 8680 SC= SC+ WP:GOSUB 15500
  398. 8690 IF SC> 120 THEN RETURN 
  399. 8700 IF BS< > 31 THEN 8800
  400. 8710 GP= 0:GC= 0:C= 0:BS= 0
  401. 8720 GOSUB 17700
  402. 8800 REM  
  403. 8810 REM  CHECK GO STATUS FROM COMPUTER
  404. 8820 REM 
  405. 8830 IF GP AND GC= 1 THEN 8940
  406. 8840 IF MC> 3 THEN GC= 1
  407. 8850 IF GP= 0 THEN 7060
  408. 8860 IF GC= 0 AND GP= 1 THEN 7830
  409. 8870 GOTO 8940
  410. 8880 GOSUB 9200
  411. 8890 IF SP> 120 THEN RETURN 
  412. 8900 IF YC+ MC> 7 THEN RETURN 
  413. 8910 IF MC> 3 THEN GC= 1
  414. 8920 IF YC> 3 THEN GP= 1
  415. 8930 ON GC+ 1 GOTO 7830,7060
  416. 8940 GOSUB 9400
  417. 8950 IF SC> 120 THEN RETURN 
  418. 8960 IF MC+ YC> 7 THEN RETURN 
  419. 8970 IF YC> 3 THEN GP= 1
  420. 8980 IF MC> 3 THEN GC= 1
  421. 8990 ON GP+ 1 GOTO 7060,7830
  422. 9200 REM  
  423. 9210 REM  PLAYERS LAST CARD
  424. 9220 REM 
  425. 9230 GOSUB 17000
  426. 9240 ON FN A(3)+ 1 GOTO 9250,9260,9270
  427. 9250 PRINT "YOU CAN HAVE 1 POINT FOR LAST CARD";:GOTO 9280
  428. 9260 PRINT "I'LL GIVE YOU 1 POINT FOR LAST CARD";:GOTO 9280
  429. 9270 PRINT "YOU GET 1 POINT FOR LAST CARD";
  430. 9280 SP= SP+ 1:GOSUB 15500:GOSUB 15000
  431. 9290 GP= 0:C= 0:GC= 0:BS= 0:GOSUB 17700:RETURN
  432. 9400 REM  
  433. 9410 REM  COMPUTERS LAST CARD
  434. 9420 REM 
  435. 9430 GOSUB 17000
  436. 9440 ON FN A(3)+ 1 GOTO 9450,9460,9470
  437. 9450 PRINT "I'LL TAKE 1 POINT FOR LAST CARD";:GOTO 9480
  438. 9460 PRINT "1 POINT FOR ME FOR LAST CARD";:GOTO 9480
  439. 9470 PRINT "I GET 1 POINT FOR LAST CARD";
  440. 9480 SC= SC+ 1:GOSUB 15500:GOSUB 15000
  441. 9490 GP= 0:C= 0:GC= 0:BS= 0:GOSUB 17700:RETURN
  442. 10000 REM  
  443. 10010 REM  SCORE THE HANDS//PLAYER AND COMPUTER
  444. 10020 REM 
  445. 10050 IF XI< > 1 THEN 10250
  446. 10060 K= 1:FOR I= 1 TO 6
  447. 10070 IF I= I3 THEN 10100
  448. 10080 IF I= I4 THEN 10100
  449. 10090 FOR J= 1 TO 4:W(K,J)= Y(I,J):NEXT J:K= K+ 1
  450. 10100 NEXT I
  451. 10110 FOR J= 1 TO 4:W(5,J)= D(UP,J):NEXT J
  452. 10120 C= 0:GOSUB 11000
  453. 10130 GOSUB 17000
  454. 10140 GOSUB 17800:PRINT "HOW MANY POINTS DO YOU HAVE?  ";:INPUT;WP:GOSUB 60300
  455. 10150 WP= INT (ABS (WP)):IF WP= 19 THEN WP= 0
  456. 10160 D= P- WP:IF D= > 0 THEN 10190
  457. 10170 GOSUB 17800:PRINT "YOU DON'T HAVE "WP;"POINTS THERE!";
  458. 10180 GOTO 10140
  459. 10190 SP= SP+ WP:GOSUB 15500:IF SP> 120 THEN RETURN
  460. 10200 IF D= 0 THEN 10240
  461. 10210 SC= SC+ D:GOSUB 15500:GOSUB 17800
  462. 10220 PRINT "MUGGINS FOR"D"POINTS - THANKS";
  463. 10230 IF SC> 120 THEN RETURN 
  464. 10240 ON XI GOTO 10250,10340,10470
  465. 10250 FOR K= 1 TO 4:L= V(BC,K):FOR J= 1 TO 4:W(K,J)= M(L,J):NEXT J:NEXT K
  466. 10260 GOSUB 17000:PRINT "MY CARDS ARE :";
  467. 10270 FOR K= 1 TO 4:VA= W(K,4):ST= W(K,3)
  468. 10280 ON K GOSUB 21000,21100,21200,21300
  469. 10290 GOSUB 17200:NEXT K
  470. 10300 FOR J= 1 TO 4:W(5,J)= D(UP,J):NEXT J
  471. 10310 C= 0:GOSUB 11000:SC= SC+ P:GOSUB 15500:IF SC> 120 THEN RETURN 
  472. 10320 GOSUB 17000:PRINT "I HAVE "P" POINTS IN MY HAND";
  473. 10330 ON XI GOTO 10340,10060
  474. 10340 GOSUB 17000:PRINT "THE CRIB CARDS ARE :";
  475. 10350 FOR K= 1 TO 4:VA= C(K,4):ST= C(K,3)
  476. 10360 ON K GOSUB 22000,22100,22200,22300
  477. 10370 GOSUB 17200:NEXT K
  478. 10380 FOR I= 1 TO 4:FOR J= 1 TO 4:W(I,J)= C(I,J):NEXT J:NEXT I
  479. 10390 C= 1
  480. 10400 FOR J= 1 TO 4:W(5,J)= D(UP,J):NEXT J
  481. 10410 GOSUB 11000
  482. 10420 ON XI GOTO 10430,10460
  483. 10430 GOSUB 17000:PRINT "I HAVE "P" POINTS IN THE CRIB";
  484. 10440 SC= SC+ P:GOSUB 15500:IF SC> 120 THEN RETURN
  485. 10450 GOTO 10470
  486. 10460 XI= 3:GOTO 10130
  487. 10470 GOSUB 17000:PRINT "I HAVE A TOTAL SCORE OF"SC"POINTS";
  488. 10480 GOSUB 17800:PRINT "YOUR TOTAL SCORE IS"SP"POINTS";
  489. 10490 GOSUB 60300:RETURN
  490. 11000 REM  
  491. 11010 REM  SCORE 5 CARD HAND PLAYER//COMPUTER//CRIB
  492. 11020 REM 
  493. 11030 REM  CHECK FOR JACK SAME SUIT AS UP CARD
  494. 11040 REM  EXCEPT FOR CRIB
  495. 11050 REM 
  496. 11060 P= 0:IF C= 1 THEN 11100
  497. 11070 FOR I= 1 TO 4
  498. 11080 IF W(I,4)= 11 AND W(I,3)= W(5,3) THEN P= P+ 1
  499. 11090 NEXT I
  500. 11100 REM 
  501. 11110 REM  CHECK FOR 4 OR 5 CARD FLUSH
  502. 11120 REM 
  503. 11130 FOR I= 1 TO 3
  504. 11140 IF W(I,3)< > W(I+ 1,3) THEN 11240
  505. 11150 NEXT I
  506. 11160 REM 
  507. 11170 REM  CRIB SCORES ONLY FOR 5 CARD FLUSH
  508. 11180 REM 
  509. 11190 IF C< > 0 THEN 11220
  510. 11200 P= P+ 4:IF W(4,3)< > W(5,3) THEN 11240
  511. 11210 P= P+ 1:GOTO 11240
  512. 11220 IF W(4,3)< > W(5,3) THEN 11240
  513. 11230 P= P+ 5
  514. 11240 REM 
  515. 11250 REM  CHECK FOR 2 CARD SUMS OF 15
  516. 11260 REM 
  517. 11270 FOR I= 1 TO 4:FOR J= I+ 1 TO 5
  518. 11280 IF W(I,2)+ W(J,2)= 15 THEN P= P+ 2
  519. 11290 NEXT J:NEXT I
  520. 11300 REM 
  521. 11310 REM  CHECK FOR 3 CARD SUMS OF 15
  522. 11320 REM 
  523. 11330 FOR I= 1 TO 3:FOR J= I+ 1 TO 4:FOR K= J+ 1 TO 5
  524. 11340 IF W(I,2)+ W(J,2)+ W(K,2)= 15 THEN P= P+ 2
  525. 11350 NEXT K:NEXT J:NEXT I
  526. 11360 REM 
  527. 11370 REM  CHECK FOR 4 CARD SUMS OF 15
  528. 11380 REM 
  529. 11390 FOR I= 1 TO 2:FOR J= I+ 1 TO 3:FOR K= J+ 1 TO 4:FOR L= K+ 1 TO 5
  530. 11400 IF W(I,2)+ W(J,2)+ W(K,2)+ W(L,2)= 15 THEN P= P+ 2
  531. 11410 NEXT L:NEXT K:NEXT J:NEXT I
  532. 11420 REM 
  533. 11430 REM  CHECK FOR 5 CARD SUM OF 15
  534. 11440 REM 
  535. 11450 S= 0:FOR I= 1 TO 5:S= S+ W(I,2):NEXT I
  536. 11460 IF S= 15 THEN P= P+ 2
  537. 11470 REM 
  538. 11480 REM  CHECK FOR PAIRS//3 AND 4 A KIND
  539. 11490 REM 
  540. 11500 FOR I= 1 TO 4:FOR J= I+ 1 TO 5
  541. 11510 IF W(I,4)= W(J,4) THEN P= P+ 2
  542. 11520 NEXT J:NEXT I
  543. 11530 REM 
  544. 11540 REM  SORT CARDS INTO ASCENDING SEQUENCE
  545. 11550 REM 
  546. 11560 V= 1:FOR I= 1 TO 4
  547. 11570 IF W(I,4)< = W(I+ 1,4) THEN 11610
  548. 11580 FOR J= 0 TO 4
  549. 11590 W(0,J)= W(I,J):W(I,J)= W(I+ 1,J):W(I+ 1,J)= W(0,J)
  550. 11600 NEXT J:V= 0
  551. 11610 NEXT I:IF V= 0 THEN 11560
  552. 11620 REM 
  553. 11630 REM  CHECK//SCORE FOR 5 CARD RUN
  554. 11640 REM 
  555. 11650 GOSUB 14000:D= W(1,4)- Q(1,1)
  556. 11660 FOR I= 1 TO 11:FOR J= 1 TO 5:Q(I,J)= Q(I,J)+ D:NEXT J:NEXT I
  557. 11670 PT= 0:FOR I= 1 TO 11:V= 1:FOR J= 1 TO 5
  558. 11680 IF W(J,4)< > Q(I,J) THEN J= 5:V= 0
  559. 11690 NEXT J:IF V= 1 THEN PT= PT+ Q(I,6)
  560. 11700 NEXT I:P= P+ PT:IF PT> 0 THEN RETURN 
  561. 11710 REM 
  562. 11720 REM  CHECK//SCORE FOR 4 CARD RUN
  563. 11730 REM 
  564. 11740 PT= 0:FOR L= 1 TO 2:GOSUB 14060:D= W(L,4)- R(1,1)
  565. 11750 FOR I= 1 TO 4:FOR J= 1 TO 4:R(I,J)= R(I,J)+ D:NEXT J:NEXT I
  566. 11760 FOR I= 1 TO 4:V= 1:FOR K= 1 TO 4:IF W(K+ L- 1,4)< > R(I,K) THEN K= 4:V= 0
  567. 11770 NEXT K:IF V= 1 THEN PT= PT+ R(I,5)
  568. 11780 NEXT I:NEXT L:P= P+ PT:IF PT> 0 THEN RETURN 
  569. 11790 REM 
  570. 11800 REM  CHECK//SCORE FOR 3 CARD RUN
  571. 11810 REM 
  572. 11820 PT= 0:FOR L= 1 TO 3:GOSUB 14120:D= W(L,4)- S(1)
  573. 11830 FOR I= 1 TO 3:S(I)= S(I)+ D:NEXT I
  574. 11840 V= 1:FOR I= 1 TO 3:IF W(L+ I- 1,4)< > S(I) THEN I= 3:V= 0
  575. 11850 NEXT I:IF V= 1 THEN PT= PT+ S(4)
  576. 11860 NEXT L:P= P+ PT:RETURN 
  577. 14000 REM  
  578. 14010 REM  READ Q(I,J)
  579. 14020 REM 
  580. 14030 RESTORE 620
  581. 14040 FOR I= 1 TO 11:FOR J= 1 TO 6:READ Q(I,J):NEXT J:NEXT I
  582. 14050 RETURN 
  583. 14060 REM 
  584. 14070 REM  READ R(I,J)
  585. 14080 REM 
  586. 14090 RESTORE 690
  587. 14100 FOR I= 1 TO 4:FOR J= 1 TO 5:READ R(I,J):NEXT J:NEXT I
  588. 14110 RETURN 
  589. 14120 REM 
  590. 14130 REM  READ S(I)
  591. 14140 REM 
  592. 14150 RESTORE 730
  593. 14160 FOR I= 1 TO 4:READ S(I):NEXT I
  594. 14170 RETURN 
  595. 14500 REM  
  596. 14510 REM  SHUFFLE DECK
  597. 14520 REM 
  598. 14530 FOR I= 1 TO 52:I(I)= 0:NEXT I
  599. 14540 FOR I= 1 TO 52
  600. 14550 J= FN A(52)+ 1:IF I(J)= 1 THEN 14550
  601. 14555 LOCATE 14,2+ J:PRINT "*";
  602. 14560 D(I,1)= J:D(I,3)= INT ((J- 1)/ 13)+ 1
  603. 14565 ON D(I,3) GOTO 14570,14572,14574,14576
  604. 14570 D(I,4)= J:D(I,2)= D(I,4):GOTO 14580
  605. 14572 D(I,4)= J- 13:D(I,2)= D(I,4):GOTO 14580
  606. 14574 D(I,4)= J- 26:D(I,2)= D(I,4):GOTO 14580
  607. 14576 D(I,4)= J- 39:D(I,2)= D(I,4):GOTO 14580
  608. 14580 IF D(I,2)> 10 THEN D(I,2)= 10
  609. 14590 D(I,0)= 0:I(J)= 1:NEXT I
  610. 14600 FOR I= 1 TO 15:V(I,7)= 0:NEXT I
  611. 14605 LOCATE 14,2:PRINT STRING$(54," ");
  612. 14610 RETURN 
  613. 15000 REM  
  614. 15010 REM  CLEAR PLAYING MATRIX
  615. 15020 REM 
  616. 15030 FOR I= 0 TO 8:FOR J= 0 TO 4:H(I,J)= 0:NEXT J:NEXT I
  617. 15040 RETURN 
  618. 15100 REM  
  619. 15110 REM  PLAYERS CARD INTO PLAYING FIELD
  620. 15120 REM 
  621. 15130 FOR J= 1 TO 4:H(C,J)= Y(CP,J):NEXT J:Y(CP,0)= 1
  622. 15140 RETURN 
  623. 15200 REM  
  624. 15210 REM  COMPUTERS CARD INTO PLAYING FIELD
  625. 15220 REM 
  626. 15230 FOR J= 1 TO 4:H(C,J)= M(CC,J):NEXT J
  627. 15240 RETURN 
  628. 15300 REM  
  629. 15310 REM  CHECK FOR 15/31 & PAIRS
  630. 15320 REM 
  631. 15330 P= 0
  632. 15340 IF C< 2 THEN RETURN 
  633. 15350 IF H(C,4)= H(C- 1,4) THEN P= P+ 2
  634. 15360 IF P< 2 OR C< 3 THEN 15400
  635. 15370 IF H(C,4)= H(C- 2,4) THEN P= P+ 4
  636. 15380 IF P< 6 OR C< 4 THEN 15400
  637. 15390 IF H(C,4)= H(C- 3,4) THEN P= P+ 6
  638. 15400 IF WS= 15 THEN P= P+ 2
  639. 15410 IF WS= 31 THEN P= P+ 2
  640. 15420 RETURN 
  641. 15500 REM  
  642. 15510 REM  PLOT SCORE
  643. 15520 REM 
  644. 15530 LOCATE 4,61:PRINT "YOU HAVE";SP;
  645. 15535 SCOR=SP:XS=60:YS=5:GOSUB 15700
  646. 15540 LOCATE 7,62:PRINT "PC HAS ";SC;
  647. 15545 SCOR=SC:XS=60:YS=6:GOSUB 15700
  648. 15550 RETURN
  649. 15700 LOCATE YS,XS:IF SCOR>30 THEN PRINT"▄▄▄"; ELSE GOTO 15800
  650. 15710 XS=XS+4:LOCATE YS,XS:IF SCOR>60 THEN PRINT"▄▄▄"; ELSE GOTO 15800
  651. 15720 XS=XS+4:LOCATE YS,XS:IF SCOR>90 THEN PRINT"▄▄▄"; ELSE GOTO 15800
  652. 15730 XS=XS+4:LOCATE YS,XS:IF SCOR>120 THEN PRINT"▄▄▄"; ELSE GOTO 15800
  653. 15800 PRINT STRING$((SCOR/30-INT(SCOR/30))*3,"▄");:
  654. 15810 IF (SCOR/10 -INT(SCOR/10)*10 >4) THEN PRINT"▌";
  655. 15820 RETURN
  656. 15950 RETURN
  657. 16000 REM  
  658. 16010 REM  MID/END PAIR CHECK FOR RUNS
  659. 16020 REM 
  660. 16030 PT= 0
  661. 16040 IF C< 3 THEN RETURN 
  662. 16050 IF H(C,4)= H(C- 1,4) THEN RETURN
  663. 16060 IF H(C,4)= H(C- 2,4) THEN RETURN
  664. 16070 IF H(C- 1,4)= H(C- 2,4) THEN RETURN
  665. 16080 REM 
  666. 16090 REM  LOW END SET
  667. 16100 REM 
  668. 16110 L= 1:FOR J= C TO 2 STEP - 1:FOR K= J- 1 TO 1 STEP - 1
  669. 16120 IF H(J,4)= H(K,4)AND K> L THEN L= K
  670. 16130 NEXT K:NEXT J
  671. 16140 REM 
  672. 16150 REM  CHECK RUNS
  673. 16160 REM 
  674. 16170 IF C- L< 2 THEN RETURN 
  675. 16180 LO= 99:HI= 0:SUM= 0
  676. 16190 FOR K= L TO C
  677. 16200 IF H(K,4)< LO THEN LO= H(K,4)
  678. 16210 IF H(K,4)> HI THEN HI= H(K,4)
  679. 16220 SUM= SUM+ H(K,4)
  680. 16230 NEXT K
  681. 16240 REM 
  682. 16250 REM  SCORE RUNS
  683. 16260 REM 
  684. 16270 MID= (LO+ HI)/ 2
  685. 16280 CK= (C- L+ 1)* MID
  686. 16290 IF CK= SUM THEN PT= C- L+ 1
  687. 16300 IF PT< 3 THEN PT= 0
  688. 16310 IF (HI- LO+ 1)/ (C- L+ 1)< > 1 THEN PT= 0
  689. 16320 IF PT= 0 THEN L= L+ 1:GOTO 16170
  690. 16330 RETURN 
  691. 17000 REM 
  692. 17010 REM  SCROLL CONTROL FOR PRINT STATEMENTS
  693. 17020 REM 
  694. 17030 SCR%=6*256+7
  695. 17035 X1=44:Y1=19:W1=33:H1=5:GOSUB 64000
  696. 17050 GOSUB 17800
  697. 17060 RETURN
  698. 17100 REM 
  699. 17110 REM  ERASE PLAYED CARD - PLAYER FIELD
  700. 17120 REM 
  701. 17130 ON CP GOSUB 20000,20100,20200,20300,20400,20500
  702. 17140 LOCATE Y1+ H1- 1,X1:PRINT SPC( W1)
  703. 17145 GOSUB 64000
  704. 17150 FOR XX= 2 TO 9:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT XX:GOSUB 60100:RETURN
  705. 17200 REM 
  706. 17210 REM  CARD GRAPHICS
  707. 17220 REM 
  708. 17230 FOR I= 0 TO 34:T$(I)= " ":NEXT :REM 
  709. 17240 IF ST= 3 THEN U$= CHR$(5):GOTO 17280:REM
  710. 17250 IF ST= 4 THEN U$= CHR$(3):GOTO 17280:REM
  711. 17260 IF ST= 2 THEN U$= CHR$(4):GOTO 17280:REM
  712. 17270 IF ST= 1 THEN U$= CHR$(6):REM
  713. 17280 REM PLOT 6,56
  714. 17290 ON VA GOTO 17480,17470,17460,17450,17430,17410,17400,17390,17380,17360,17320,17310
  715. 17300 T$(17)= "K":GOTO 17330
  716. 17310 T$(17)= "Q":GOTO 17330
  717. 17320 T$(17)= "J"
  718. 17330 T$(8)= U$:T$(7)= U$:T$(6)= U$:T$(11)= U$:T$(16)= U$
  719. 17340 T$(21)= U$:T$(26)= U$:T$(27)= U$:T$(28)= U$:T$(23)= U$
  720. 17350 T$(18)= U$:T$(13)= U$:GOTO 17490
  721. 17360 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
  722. 17370 T$(28)= U$:GOTO 17450
  723. 17380 T$(7)= U$:T$(27)= U$:GOTO 17400
  724. 17390 T$(12)= U$:T$(22)= U$:GOTO 17410
  725. 17400 T$(17)= U$
  726. 17410 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
  727. 17420 T$(28)= U$:GOTO 17490
  728. 17430 T$(6)= U$:T$(8)= U$:T$(17)= U$:T$(26)= U$:T$(28)= U$
  729. 17440 GOTO 17490
  730. 17450 T$(11)= U$:T$(13)= U$:T$(21)= U$:T$(23)= U$:GOTO 17490
  731. 17460 T$(7)= U$:T$(17)= U$:T$(27)= U$:GOTO 17490
  732. 17470 T$(12)= U$:T$(22)= U$:GOTO 17490
  733. 17480 T$(17)= U$
  734. 17490 IF VA> 1 AND VA< 11 THEN T$= RIGHT$ (STR$ (VA),1)
  735. 17500 IF VA= 11 THEN T$= "J"
  736. 17510 IF VA= 12 THEN T$= "Q"
  737. 17520 IF VA= 13 THEN T$= "K"
  738. 17530 IF VA= 1 THEN T$= "A"
  739. 17540 IF ST= 2 OR ST= 4 THEN T$= ""+ T$:REM 
  740. 17550 IF VA< > 10 THEN 17580
  741. 17560 T$= LEFT$ (U$,2):M$= "0":N$= "1":IF ST= 2 OR ST= 4 THEN T$= ""+ T$:REM 
  742. 17570 T$(0)= "1":T$(1)= "0":T$(33)= "1":T$(34)= "0":GOTO 17590
  743. 17580 T$(0)= T$:T$(34)= T$
  744. 17590 CN= Y1+ H1- 1
  745. 17595 COLOR 0,7
  746. 17600 FOR I= 0 TO 30 STEP 5:CALL SCROLL%(SCR%,POS1%,POS2%):LOCATE CN+1,X1:FOR J= 0 TO 4:PRINT T$(I+ J);:NEXT
  747. 17610 NEXT I
  748. 17615 COLOR 7,0
  749. 17630 GOSUB 60000:RETURN
  750. 17700 REM 
  751. 17710 REM  ERASE CARDS - BOARD FIELD
  752. 17720 REM 
  753. 17730 FOR B= 1 TO 8
  754. 17735 DEF SEG =0:IF ((PEEK(&H410) AND &H30)<> &H30) THEN DEF SEG = &HB800 ELSE DEF SEG = &HB000:REM CHECK WHICH DISPLAY
  755. 17740 ON B GOSUB 21000,21100,21200,21300,21400,21500,21600,21700
  756. 17745 IF PEEK (1428 + B*14)= 32 THEN 17770
  757. 17750 LOCATE Y1+ H1- 2,X1:PRINT SPC( W1+1);
  758. 17755 DEF SEG =&HF00
  759. 17760 FOR XX= 1 TO 7:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT XX:GOSUB 60100
  760. 17770 NEXT B:DEF SEG=&HF00:RETURN
  761. 17800 REM 
  762. 17810 REM  CALL AND PLOT
  763. 17820 REM 
  764. 17830 CALL SCROLL%(SCR%,POS1%,POS2%):GOSUB 60300:LOCATE Y1+ H1,X1:RETURN
  765. 20000 REM  
  766. 20001 REM  PLAYER CARD 1
  767. 20002 REM 
  768. 20010 X1= 2:Y1= 2:W1= 5:H1= 6:GOSUB 64000
  769. 20020 RETURN 
  770. 20100 REM  
  771. 20101 REM  PLAYER CARD 2
  772. 20102 REM  
  773. 20110 X1= 9:Y1= 2:W1= 5:H1= 6:GOSUB 64000
  774. 20120 RETURN 
  775. 20200 REM  
  776. 20201 REM  PLAYER CARD 3
  777. 20202 REM  
  778. 20210 X1= 16:Y1= 2:W1= 5:H1= 6:GOSUB 64000
  779. 20220 RETURN 
  780. 20300 REM  
  781. 20301 REM  PLAYER CARD 4
  782. 20302 REM  
  783. 20310 X1= 23:Y1= 2:W1= 5:H1= 6:GOSUB 64000
  784. 20320 RETURN 
  785. 20400 REM  
  786. 20401 REM  PLAYER CARD 5
  787. 20402 REM  
  788. 20410 X1= 30:Y1= 2:W1= 5:H1= 6:GOSUB 64000
  789. 20420 RETURN 
  790. 20500 REM  
  791. 20501 REM  PLAYER CARD 6
  792. 20502 REM  
  793. 20510 X1= 37:Y1= 2:W1= 4:H1= 6:GOSUB 64000
  794. 20520 RETURN 
  795. 20600 REM  
  796. 20601 REM  UP CARD
  797. 20602 REM  
  798. 20610 X1= 50:Y1= 2:W1= 4:H1= 6:GOSUB 64000
  799. 20620 RETURN 
  800. 21000 REM  
  801. 21001 REM  COMPUTER CARD 1//BOARD CARD 1
  802. 21002 REM  
  803. 21010 X1= 2:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  804. 21020 RETURN 
  805. 21100 REM  
  806. 21101 REM  COMPUTER CARD 2//BOARD CARD 2
  807. 21102 REM  
  808. 21110 X1= 9:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  809. 21120 RETURN 
  810. 21200 REM  
  811. 21201 REM  COMPUTER CARD 3//BOARD CARD 3
  812. 21202 REM  
  813. 21210 X1= 16:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  814. 21220 RETURN 
  815. 21300 REM  
  816. 21301 REM  COMPUTER CARD 4//BOARD CARD 4
  817. 21302 REM  
  818. 21310 X1= 23:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  819. 21320 RETURN 
  820. 21400 REM  
  821. 21401 REM  COMPUTER CARD 5//BOARD CARD 5
  822. 21402 REM  
  823. 21410 X1= 30:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  824. 21420 RETURN 
  825. 21500 REM  
  826. 21501 REM  COMPUTER CARD 6//BOARD CARD 6
  827. 21502 REM  
  828. 21510 X1= 37:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  829. 21520 RETURN 
  830. 21600 REM  
  831. 21601 REM  BOARD CARD 7
  832. 21602 REM  
  833. 21610 X1= 44:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  834. 21620 RETURN 
  835. 21700 REM  
  836. 21701 REM  BOARD CARD 8
  837. 21702 REM  
  838. 21710 X1= 51:Y1= 10:W1= 4:H1= 6:GOSUB 64000
  839. 21720 RETURN 
  840. 22000 REM  
  841. 22001 REM  COMPUTER CARD 1//CRIB CARD 1
  842. 22002 REM  
  843. 22010 X1= 2:Y1= 18:W1= 4:H1= 6:GOSUB 64000
  844. 22020 RETURN 
  845. 22100 REM  
  846. 22101 REM  COMPUTER CARD 2//CRIB CARD 2
  847. 22102 REM  
  848. 22110 X1= 9:Y1= 18:W1= 4:H1= 6:GOSUB 64000
  849. 22120 RETURN 
  850. 22200 REM  
  851. 22201 REM  COMPUTER CARD 3//CRIB CARD 3
  852. 22202 REM  
  853. 22210 X1= 16:Y1= 18:W1= 5:H1= 6:GOSUB 64000
  854. 22220 RETURN 
  855. 22300 REM  
  856. 22301 REM  COMPUTER CARD 4//CRIB CARD 4
  857. 22302 REM  
  858. 22310 X1= 23:Y1= 18:W1= 4:H1= 6:GOSUB 64000
  859. 22320 RETURN 
  860. 22400 REM  
  861. 22401 REM  COMPUTER CARD 5
  862. 22402 REM  
  863. 22410 X1= 30:Y1= 18:W1= 4:H1= 6:GOSUB 64000
  864. 22420 RETURN 
  865. 22500 REM  
  866. 22501 REM  COMPUTER CARD 6
  867. 22502 REM  
  868. 22510 X1= 37:Y1= 18:W1= 4:H1= 6:GOSUB 64000
  869. 22520 RETURN 
  870. 22600 REM
  871. 22601 REM  DRAW BACK OF COMPUTER CARD
  872. 22602 REM  
  873. 22610 COLOR 0,7:FOR B1= 1 TO 7:LOCATE Y1+ H1-0,X1
  874. 22620 CALL SCROLL%(SCR%,POS1%,POS2%)
  875. 22630 PRINT "XXXXX";
  876. 22640 NEXT B1
  877. 22670 COLOR 7,0:GOSUB 60300:RETURN
  878. 22700 REM 
  879. 22701 REM  ERASE PLAYED CARD - COMPUTER FIELD
  880. 22702 REM 
  881. 22710 B= FN A(6)+ 1:DEF SEG =0:IF ((PEEK(&H410) AND &H30)<> &H30) THEN DEF SEG = &HB800 ELSE DEF SEG = &HB000:REM CHECK WHICH DISPLAY
  882. 22715 IF PEEK(2874+B*14) = 32 THEN GOTO 22710 ELSE DEF SEG = &HF00
  883. 22720 ON B GOSUB 22000,22100,22200,22300,22400,22500
  884. 22730 LOCATE Y1+ H1- 0,X1:PRINT SPC( W1+1);
  885. 22740 FOR B= 1 TO 7:CALL SCROLL%(SCR%,POS1%,POS2%):NEXT B:GOSUB 60100
  886. 22750 RETURN
  887. 23000 REM 
  888. 23001 REM  SCREEN ERASE
  889. 23002 REM  
  890. 23005 POKE 21,0:X1= 41:Y1= 2:W1= 14:H1= 14:GOSUB 64000
  891. 23007 CALL SCROLL%(SCR%,POS1%,POS2%)
  892. 23010 X1= 2:Y1= 2:W1= 39:H1= 22:GOSUB 64000
  893. 23020 CALL SCROLL%(SCR%,POS1%,POS2%):GOSUB 60300
  894. 23030 POKE 21,1:RETURN
  895. 30000 REM  FOUR CARD SCORER
  896. 30010 P= 0:
  897. 30040 REM  GET THE FOUR CARDS
  898. 30050 HH(1)= M(I1,4):HH(2)= M(I2,4):HH(3)= M(I3,4):HH(4)= M(I4,4)
  899. 30055 REM  CHECK FOR FLUSH
  900. 30060 IF M(I1,3)= M(I2,3) THEN IF M(I2,3)= M(I3,3) THEN IF M(I3,3)= M(I4,3) THEN P= P+ 4
  901. 30070 LOCATE 14,9:PRINT "CHECK NUMBER "CN;
  902. 30100 REM  SORT FOUR CARDS
  903. 30110 FOR X= 1 TO 3:FOR Y= X+ 1 TO 4
  904. 30120 IF HH(X)> HH(Y) THEN TE= HH(X):HH(X)= HH(Y):HH(Y)= TE
  905. 30130 NEXT Y,X
  906. 30200 REM  CHECK FOR PAIRS
  907. 30210 FOR X= 1 TO 3:FOR Y= X+ 1 TO 4
  908. 30220 IF HH(X)= HH(Y) THEN P= P+ 2
  909. 30230 NEXT Y,X
  910. 30300 REM  CHECK FOR RUN
  911. 30310 IF HH(1)+ 1= HH(2)OR HH(2)+ 1= HH(3)OR HH(3)+ 1= HH(4) THEN 30330
  912. 30320 GOTO 30400
  913. 30330 IF HH(1)+ 1= HH(2) THEN IF HH(2)+ 1= HH(3) THEN IF HH(3)+ 1= HH(4) THEN P= P+ 4:GOTO 30400
  914. 30340 FOR X= 1 TO 2:FOR Y= X+ 1 TO 3:FOR Z= Y+ 1 TO 4
  915. 30350 IF HH(X)+ 1= HH(Y) THEN IF HH(Y)+ 1= HH(Z) THEN P= P+ 3
  916. 30360 NEXT Z,Y,X
  917. 30400 REM  CLIP AT 10
  918. 30410 FOR X= 1 TO 4:IF HH(X)> 10 THEN HH(X)= 10
  919. 30420 NEXT X
  920. 30500 REM  CHECK FOR 15'S
  921. 30510 SA= HH(1)+ HH(2)+ HH(3)+ HH(4):IF SA< 15 OR SA> 35 THEN 30600
  922. 30520 IF SA= 15 THEN P= P+ 2:GOTO 30600
  923. 30530 FOR X= 1 TO 2:FOR Y= X+ 1 TO 3:FOR Z= Y+ 1 TO 4
  924. 30540 IF HH(X)+ HH(Y)+ HH(Z)= 15 THEN P= P+ 2
  925. 30550 NEXT Z,Y,X
  926. 30560 FOR X= 1 TO 3:FOR Y= X+ 1 TO 4
  927. 30570 IF HH(X)+ HH(Y)= 15 THEN P= P+ 2
  928. 30580 NEXT Y,X
  929. 30600 RETURN 
  930. 40000 '
  931. 40001 ' KEY INPUT ROUTINE
  932. 40010 LOCATE ,,1:KB$="":WHILE KB$="":KB$=INKEY$:WEND:IF KB$=CHR$(27) THEN CHAIN "MENU",1000
  933. 40020 LOCATE ,,0:RETURN
  934. 40100 CHAIN "MENU",1000
  935. 42000 REM DRAW TABLE
  936. 42001 '
  937. 42010 LOCATE 1,1:PRINT"╒═════════════════════════════════════════════════════════════════════════════╕";
  938. 42020 FOR N=2 TO 24:LOCATE N,1:PRINT"│";:NEXT
  939. 42030 FOR N=2 TO 24:LOCATE N,79:PRINT"│";:NEXT
  940. 42040 LOCATE 25,1:PRINT"╘═════════════════════════════════════════════════════════════════════════════╛";
  941. 42050 LOCATE 17,43:PRINT"╒═══════════════════════════════════╡";
  942. 42060 FOR N=18 TO 24:LOCATE N,43:PRINT"│";:NEXT
  943. 42070 LOCATE 25,43:PRINT"╧";
  944. 42075 LOCATE 1,57:PRINT"╤";:LOCATE 17,57:PRINT"╧";
  945. 42080 FOR N=2 TO 16:LOCATE N,57:PRINT"│";:NEXT
  946. 42085 LOCATE 9,57:PRINT"╞═════════════════════╡";
  947. 42090 COLOR 0,7:LOCATE 2,63:PRINT"GAME SCORE";
  948. 42095 LOCATE 10,62:PRINT"PLAY COMMANDS";
  949. 42100 LOCATE 18,48:PRINT" M E S S A G E   B O A R D ";:COLOR 7,0
  950. 42110 LOCATE 12,58:PRINT"    G=GO   <cr>=GO";
  951. 42120 LOCATE 13,58:PRINT" <esc>=QUIT  121 WINS";
  952. 42130 LOCATE 14,58:PRINT"   F10=Sound on/off";
  953. 42140 LOCATE 15,58:PRINT"    Patrick Leabo";
  954. 42150 LOCATE 16,58:PRINT"      Tucson,Az";
  955. 42999 RETURN
  956. 43000 REM
  957. 43010 REM TOGGLE SOUND
  958. 43020 REM
  959. 43030 IF SND = 1 THEN SND = 0 ELSE SND = 1
  960. 43040 RETURN
  961. 59999 REM 
  962. 60000 REM  SCALE SOUND
  963. 60005 REM 
  964. 60010 IF SND=1 THEN PLAY "L16T120MNN=P1(VA);"
  965. 60020 RETURN
  966. 60097 REM 
  967. 60098 REM  BLEEP SOUND
  968. 60099 REM 
  969. 60100 IF SND =1 THEN PLAY "L64T200N70"
  970. 60110 RETURN
  971. 60197 REM 
  972. 60198 REM  WHISTLE SOUND
  973. 60199 REM 
  974. 60200 IF SND=1 THEN PLAY"T255MLL64O5CC#DD#EFF#GG#AA#BMN"
  975. 60210 RETURN
  976. 60297 '
  977. 60298 'CLICK
  978. 60299 '
  979. 60300 IF SND =1 THEN PLAY"L64T200N46"
  980. 60310 RETURN
  981. 60997 REM 
  982. 64000 REM 
  983. 64010 REM  SCROLLING SUBROUTINE
  984. 64020 REM 
  985. 64030 POS1%=256*(Y1-1)+X1-1:POS2%=256*(Y1+H1-1)+X1+W1:RETURN
  986. 7 REM 
  987. 64000 REM 
  988. 64010 REM  SCROLLING SUBROUTINE
  989. 6402