home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / FUNNELS / EUCHRE.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  22.3 KB  |  596 lines
  1. 100  REM  **********  "EUCHRE.BAS"  **********
  2. 210  CLEAR,,2000
  3. 220  KEY OFF
  4. 230  COLOR 7,0
  5. 240  DEFINT A-Y
  6. 250  DIM SUIT(5,3)
  7. 260  DIM DECK(24,1)
  8. 270  DIM ZSHUFFLE(24)
  9. 280  DIM CTAB$(16)
  10. 290  DIM CDPLAYED(3,16)
  11. 315  DEF FNINCM(V7)=(V7 MOD 4)+1
  12. 320  DEF FNCP(V8)=((V8-1)*5)+ROUND
  13. 325  DEF FNLAST(V9)=((V9+2)MOD 4)+1
  14. 330  DEF FNBOW(V10)=(V10-(2*(V10 MOD 2))+5)MOD 4
  15. 345  DATA 7, 36, 13, 56, 18, 36, 13, 14
  16. 350  FOR I=1 TO 4
  17. 355  READ Y(I),X(I)
  18. 360  NEXT I
  19. 370  SP$=STRING$(10," ")
  20. 385  PART(1)=3:PART(2)=4:PART(3)=1:PART(4)=2
  21. 400  DATA 9, 10, J, Q, K, A, J, J
  22. 405  FOR I=9 TO 16
  23. 410  READ CTAB$(I)
  24. 415  NEXT I
  25. 420  CTAB$(8)=CHR$(255)
  26. 1020  CLS
  27. 1025  LOCATE 5,20:PRINT"***********   COMPUTER  EUCHRE   ***********"
  28. 1030  PRINT
  29. 1035  DEF SEG=0:X=PEEK(&H417)AND &H40:IF X=0 THEN POKE &H417,PEEK(&H417)OR &H40:
  30. 1040  PRINT"ENTER RETURN TO HAVE THE COMPUTER PLAY"
  31. 1045  FOR I=1 TO 4
  32. 1050  PRINT:PRINT"ENTER THE NAME OF PLAYER #";I;"                    ";
  33. 1055  INPUT NM$(I)
  34. 1065  IF LEN(NM$(I))>10 THEN BEEP:PRINT"PLEASE LIMIT NAME TO 10 CHARACTERS":GOTO 1050
  35. 1070  IF NM$(I)=""THEN NM$(I)=CHR$(16)+"PLAYER"+STR$(I)
  36. 1075  NEXT I
  37. 1085  PRINT:INPUT"ENTER THE NUMBER OF THE DEALER ( 0 TO 4 )        ";DN
  38. 1090  IF DN=0 THEN GOSUB 5685:RANDOMIZE RSEED:DN=1+INT(RND*4)
  39. 1095  IF DN<1 OR DN>4 THEN:BEEP:PRINT"FOLLOW DIRECTIONS!":GOTO 1085 ELSE DN=INT(DN)
  40. 1100  '
  41. 1105  PRINT:INPUT"DO YOU WISH TO PLAY WITH OPEN HANDS  ( Y OR N )  ";OH$
  42. 1110  IF OH$=""THEN OH$="N"
  43. 1115  OH$=LEFT$(OH$,1):IF OH$<>"Y"AND OH$<>"N"THEN:BEEP:PRINT"PLEASE FOLLOW DIRECTIONS!":GOTO 1105
  44. 1125  SOLIT=0:FOR I=1 TO 4:IF LEFT$(NM$(I),1)<>CHR$(16)THEN SOLIT=SOLIT+1
  45. 1130  NEXT I
  46. 1135  IF SOLIT<>1 THEN SOLIT=0
  47. 1145  CLS
  48. 1150  COLOR 23,0
  49. 1155  LOCATE 11,33
  50. 1160  PRINT"SHUFFLING . . ."
  51. 1165  COLOR 7,0
  52. 1195  GOSUB 5685
  53. 1200  RANDOMIZE RSEED
  54. 1215  FOR I=1 TO 24:DECK(I,0)=((I-1)MOD 6)+9:DECK(I,1)=(I-1)\ 6:ZSHUFFLE(I)=RND:NEXT
  55. 1230  FOR I=1 TO 23:FOR J=I+1 TO 24
  56. 1235  IF ZSHUFFLE(I)>ZSHUFFLE(J)THEN SWAP ZSHUFFLE(I),ZSHUFFLE(J):SWAP DECK(I,0),DECK(J,0):SWAP DECK(I,1),DECK(J,1)
  57. 1240  NEXT J:NEXT I
  58. 1265  FOR I=1 TO 15:DUMY$=INKEY$:NEXT I
  59. 1270  IF OH$="Y"OR SOLIT=1 THEN 2025
  60. 1280  FOR N=1 TO 4
  61. 1285  COLOR 7,0
  62. 1290  IF LEFT$(NM$(N),1)=CHR$(16)THEN 1340
  63. 1295  CLS:PRINT"HERE IS YOUR HAND ";NM$(N):BEEP
  64. 1300  PRINT"MAKE SURE NO ONE IS LOOKING AND ENTER RETURN TO SEE YOUR HAND"
  65. 1305  PRINT
  66. 1310  INPUT DUMY$
  67. 1315  FOR I=1 TO 5
  68. 1320  PRINT CTAB$(DECK(5*(N-1)+I,0));" OF ";CHR$(3+DECK(5*(N-1)+I,1))
  69. 1325  NEXT I
  70. 1330  PRINT:PRINT:PRINT"HIT RETURN WHEN YOU HAVE SEEN AND RECORDED YOUR CARDS"
  71. 1335  INPUT DUMY$
  72. 1340  NEXT N
  73. 2025  CLS
  74. 2030  COLOR 1,0
  75. 2035  PRINT TAB(10);"PLAYERS 1 & 3      PLAYERS 2 & 4"
  76. 2040  COLOR 7,0
  77. 2045  PRINT"GAMES      ";GAMES1;TAB(31);GAMES2
  78. 2050  PRINT"POINTS     ";PNTS1;TAB(31);PNTS2
  79. 2055  PRINT"TRICKS     ";TRCKS1;TAB(31);TRCKS2
  80. 2065  COLOR 0,7
  81. 2070  FOR I=1 TO 4
  82. 2075  LOCATE Y(I),X(I)
  83. 2080  PRINT NM$(I)
  84. 2085  NEXT I
  85. 2095  GOSUB 5915
  86. 2105  COLOR 7,0:LOCATE 2,50:PRINT"FLIPPED CARD"
  87. 2110  LOCATE 3,52:PRINT CTAB$(DECK(21,0));" OF ";CHR$(3+DECK(21,1))
  88. 2120  LOCATE 17,70:COLOR 9,0:PRINT"BIDS    "
  89. 2125  LOCATE 18,70:COLOR 15,0:PRINT"P";:COLOR 7,0:PRINT"ass"
  90. 2130  LOCATE 19,70:COLOR 15,0:PRINT"C";:COLOR 7,0:PRINT"lubs"
  91. 2135  LOCATE 20,70:COLOR 15,0:PRINT"D";:COLOR 7,0:PRINT"iamonds"
  92. 2140  LOCATE 21,70:COLOR 15,0:PRINT"H";:COLOR 7,0:PRINT"earts"
  93. 2145  LOCATE 22,70:COLOR 15,0:PRINT"S";:COLOR 7,0:PRINT"pades"
  94. 2150  LOCATE 23,70:COLOR 15,0:PRINT"A";:COLOR 7,0:PRINT"utobid"
  95. 2160  GOSUB 5785
  96. 2185  BN=FNINCM(DN)
  97. 2190  FLAG=0
  98. 2200  COLOR 0,7
  99. 2205  OLDBN=FNLAST(BN):LOCATE Y(OLDBN),X(OLDBN):PRINT NM$(OLDBN):COLOR 23,0:LOCATE Y(BN),X(BN):PRINT NM$(BN)
  100. 2215  IF LEFT$(NM$(BN),1)=CHR$(16)THEN COLOR 7,0:LOCATE 18,1:PRINT SP$;SP$:LOCATE 20,1:PRINT SP$;:GOSUB 5035:GOTO 2250
  101. 2220  LOCATE 18,1:COLOR 15,0
  102. 2225  FOR I=1 TO 15:DUMY$=INKEY$:NEXT I:PRINT"ENTER BID ";NM$(BN);SP$
  103. 2230  LOCATE 20,1:PRINT SPC(10):LOCATE 20,1:INPUT BD$:BD$=LEFT$(BD$,1)
  104. 2235  IF BD$=""THEN BD$="P"
  105. 2240  BD=INSTR("HDCSAP",BD$)-1:IF BD<0 THEN LOCATE 19,1:COLOR 7,0:BEEP:PRINT"RE-ENTER BID     ":GOTO 2230
  106. 2245  IF BD=4 THEN GOSUB 5035
  107. 2250  LOCATE 19,1:PRINT SPC(18):IF BD=5 THEN 2265
  108. 2255  IF(FLAG=1 AND BD=DECK(21,1))OR(FLAG=0 AND BD<>DECK(21,1))THEN LOCATE 19,1:COLOR 7,0:BEEP:PRINT"IMPROPER SUIT BID      ";:GOTO 2230
  109. 2260  GOTO 2310
  110. 2265  IF FLAG=1 AND BN=DN THEN COLOR 0,7:LOCATE Y(BN),X(BN):PRINT NM$(BN):DN=FNINCM(DN):LOCATE 24,1:COLOR 16,7:PRINT"EVERYONE PASSED.  SHUFFLING FOR NEXT DEALER";:FLAG=0:COLOR 7,0:GOTO 1195
  111. 2270  IF BN=DN THEN FLAG=1:SUIT=-1
  112. 2275  IF FLAG=1 AND BN=DN THEN COLOR 7,0:LOCATE 2,50:PRINT SPC(20):LOCATE 3,50:PRINT SPC(20)
  113. 2280  BN=FNINCM(BN)
  114. 2285  SUIT=-1
  115. 2290  GOTO 2200
  116. 2310  IF LEFT$(NM$(BN),1)=CHR$(16)OR BD$="A"THEN 2335
  117. 2315  COLOR 15,0:LOCATE 18,1:PRINT"ALONE (Y OR N)  ";:LOCATE 20,1:PRINT SP$:LOCATE 20,1:INPUT AL$
  118. 2320  AL$=LEFT$(AL$,1):IF AL$<>"N"AND AL$<>"Y"THEN LOCATE 19,1:BEEP:PRINT"ENTER Y OR N ONLY PLEASE!":GOTO 2315
  119. 2325  FOR I=18 TO 20:LOCATE I,1:PRINT SPC(34):NEXT I
  120. 2330  SUIT=BD:HISUIT=BD:GOSUB 5085
  121. 2335  LOCATE 4,45
  122. 2340  COLOR 7,0:PRINT NM$(BN);" BIDS ";
  123. 2345  IF HISUIT=2 THEN PRINT"CLUBS";ELSE IF HISUIT=1 THEN PRINT"DIAMONDS";ELSE IF HISUIT=0 THEN PRINT"HEARTS";ELSE PRINT"SPADES";
  124. 2350  IF AL$="Y"THEN PRINT" ALONE"
  125. 2355  IF FLAG=0 THEN LOCATE 20,1:COLOR 15,0:PRINT SP$:LOCATE 18,1:PRINT"HIT RETURN";SPC(20):LOCATE 20,1:DUMY$=INPUT$(1):LOCATE 18,1:PRINT SP$
  126. 2360  COLOR 7,0:LOCATE 2,50:PRINT SPC(19):LOCATE 3,50:PRINT SPC(19)
  127. 2370  FOR I=17 TO 23:LOCATE I,69:PRINT SPC(11):NEXT I
  128. 2380  LOCATE Y(BN),X(BN)
  129. 2385  PRINT NM$(BN)
  130. 3025  COLOR 7,0:LOCATE 24,1:PRINT SPACE$(79);
  131. 3030  LN=FNINCM(DN)
  132. 3045  ERASE SUIT:DIM SUIT(5,3)
  133. 3050  FOR I=1 TO 21
  134. 3055  IF DECK(I,0)=11 AND DECK(I,1)\ 2=HISUIT \ 2 AND DECK(I,1)<>HISUIT THEN DECK(I,0)=15
  135. 3060  IF DECK(I,0)=11 AND DECK(I,1)=HISUIT THEN DECK(I,0)=16
  136. 3065  IF I=21 THEN 3080
  137. 3070  PN=((I-1)\ 5)+1
  138. 3075  IF DECK(I,0)<>15 THEN SUIT(PN,DECK(I,1))=SUIT(PN,DECK(I,1))+1 ELSE SUIT(PN,HISUIT)=SUIT(PN,HISUIT)+1
  139. 3080  NEXT I
  140. 3090  IF AL$<>"Y"THEN DUMY=0:GOTO 3115 ELSE DUMY=FNINCM(FNINCM(BN))
  141. 3095  FOR I=(DUMY-1)*5+1 TO DUMY*5:DECK(I,0)=8:DECK(I,1)=252
  142. 3100  NEXT I
  143. 3105  IF DUMY=DN THEN PN=DN:GOSUB 5785:GOTO 3310
  144. 3115  FOR I=9 TO 16
  145. 3120  FOR N=0 TO 3
  146. 3125  CDPLAYED(N,I)=0
  147. 3130  NEXT N
  148. 3135  NEXT I
  149. 3145  IF FLAG=1 THEN PN=DN:GOSUB 5785:GOTO 3310
  150. 3150  IF LEFT$(NM$(DN),1)=CHR$(16)THEN 3245
  151. 3155  COLOR 15,0:LOCATE 17,1:PRINT"FLIPPED CARD IS THE ";CTAB$(DECK(21,0));" OF ";CHR$(3+DECK(21,1))
  152. 3160  LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:PRINT SPACE$(34):LOCATE 18,1:PRINT"ENTER CARD TO SLOUGH ";NM$(DN)
  153. 3165  LOCATE 20,1:COLOR 0,0:GOSUB 7125:COLOR 7,0
  154. 3170  IF CARDN$="0"AND CARDS$="A"THEN 3245
  155. 3175  CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3195
  156. 3180  NEXT N
  157. 3185  LOCATE 19,1:PRINT"BAD CARD                  ":BEEP:GOTO 3165
  158. 3195  CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:PRINT"BAD SUIT                ";:BEEP:GOTO 3165
  159. 3205  IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
  160. 3210  IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
  161. 3220  FOR N=FNCP(DN)TO DN*5:IF DECK(N,0)=CARDN AND DECK(N,1)=CARDS THEN I=N:FOR J=17 TO 20:LOCATE J,1:PRINT SPACE$(30):NEXT J:GOTO 3265
  162. 3225  NEXT N
  163. 3230  LOCATE 19,1:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3165
  164. 3245  ROUND=1:PN=DN:GOSUB 6650:ROUND=0
  165. 3250  IF I=0 THEN ERROR**********
  166. 3265  IF(DECK(I,1)=HISUIT)OR(DECK(I,0)=15)THEN 3275 ELSE SUIT(DN,DECK(I,1))=SUIT(DN,DECK(I,1))-1
  167. 3270  SUIT(DN,HISUIT)=SUIT(DN,HISUIT)+1
  168. 3275  DECK(I,0)=DECK(21,0)
  169. 3280  DECK(I,1)=HISUIT
  170. 3285  GOSUB 5785
  171. 3310  COLOR 7,0:FOR I=17 TO 24:LOCATE I,1:PRINT SPACE$(34);:NEXT
  172. 3315  IF LN=DUMY THEN LN=FNINCM(LN)
  173. 3320  PN=LN
  174. 3325  ROUND=ROUND+1:IF ROUND=6 THEN ROUND=0:GOTO 4525
  175. 3330  COLOR 23,0:LOCATE Y(PN),X(PN):PRINT NM$(PN)
  176. 3335  IF ROUND<5 THEN 3350
  177. 3340  I=PN*5:IF DECK(I,0)=15 THEN FOLSUIT=HISUIT ELSE FOLSUIT=DECK(I,1)
  178. 3345  GOSUB 6430:GOTO 3840
  179. 3350  IF LEFT$(NM$(PN),1)=CHR$(16)THEN 3495
  180. 3360  COLOR 15,0:LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:PRINT SPACE$(34):LOCATE 18,1:FOR I=1 TO 15:DUMY$=INKEY$:NEXT I:PRINT"ENTER YOUR CARD ";NM$(PN):LOCATE 20,1:GOSUB 7125:COLOR 7,0
  181. 3385  IF CARDS$="A"AND CARDN$="0"THEN 3495
  182. 3395  CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3415
  183. 3400  NEXT N
  184. 3405  LOCATE 19,1:PRINT"BAD CARD                  ":BEEP:GOTO 3360
  185. 3415  CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:PRINT"BAD SUIT                ";:BEEP:GOTO 3360
  186. 3425  IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
  187. 3430  IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
  188. 3440  FOR N=FNCP(PN)TO PN*5:IF DECK(N,0)=CARDN AND DECK(N,1)=CARDS THEN I=N:GOTO 3455
  189. 3445  NEXT N
  190. 3450  LOCATE 19,1:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3360
  191. 3455  IF CARDN=15 THEN IF CARDS=1 OR CARDS=3 THEN CARDS=CARDS-1 ELSE CARDS=CARDS+1
  192. 3460  FOLSUIT=CARDS
  193. 3465  LOCATE 19,1:PRINT SPC(30):GOSUB 6430:GOTO 3840
  194. 3495  IF BN<>LN OR ZHIP1(LN)=0 OR SUIT(PN,HISUIT)<1 THEN 3540
  195. 3510  FINDSUIT=HISUIT:GOSUB 6320
  196. 3520  I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430
  197. 3525  GOTO 3840
  198. 3540  IF SUIT(PN,HISUIT)=0 OR BN=PART(PN)THEN 3580
  199. 3545  FOR J=FNCP(PN)TO PN*5:IF(DECK(J,0)=14)AND(DECK(J,1)<>HISUIT)THEN 3550 ELSE NEXT:IF ROUND<>4 THEN 3580
  200. 3550  FOR J=16 TO 9 STEP-1:IF CDPLAYED(HISUIT,J)<>0 THEN NEXT J
  201. 3555  FINDSUIT=HISUIT:GOSUB 6320:IF DECK(HIPOS,0)=J THEN I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430:GOTO 3840
  202. 3580  LOW=FNCP(LN):HI=LN*5
  203. 3585  FOR I=LOW TO HI
  204. 3590  IF DECK(I,0)<>14 OR DECK(I,1)=HISUIT THEN 3610
  205. 3595  FOR J=9 TO 14:CDP=CDPLAYED(DECK(I,1),J):IF CDP>0 AND CDP<>LN AND CDP<>PART(LN)THEN 3610
  206. 3600  NEXT J
  207. 3605  FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  208. 3610  NEXT I
  209. 3625  FOR I=LOW TO HI
  210. 3630  IF DECK(I,0)<>13 OR DECK(I,1)=HISUIT THEN 3650
  211. 3635  FOR J=9 TO 14:CDP=CDPLAYED(DECK(I,1),J):IF CDP>0 AND CDP<>LN AND CDP<>PART(LN)THEN 3650
  212. 3640  NEXT J
  213. 3645  FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  214. 3650  NEXT I
  215. 3665  FOR I=LOW TO HI
  216. 3670  IF DECK(I,0)=14 AND DECK(I,1)<>HISUIT THEN 3685
  217. 3675  NEXT I
  218. 3680  GOTO 3700
  219. 3685  FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  220. 3700  FOR I=LOW TO HI
  221. 3705  IF DECK(I,0)=13 AND DECK(I,1)<>HISUIT THEN 3720
  222. 3710  NEXT I
  223. 3715  GOTO 3735
  224. 3720  FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  225. 3735  IF SUIT(PN,HISUIT)+ROUND=6 THEN 3820
  226. 3740  FOR I=0 TO 3:SUIT(5,I)=0:NEXT I
  227. 3745  FOR I=0 TO 3:FOR J=9 TO 14:SUIT(5,I)=SUIT(5,I)+SGN(CDPLAYED(I,J)):NEXT J:SUIT(5,I)=SUIT(5,I)+SUIT(PN,I):NEXT I
  228. 3750  SUIT(5,HISUIT)=SUIT(5,HISUIT)-1:SUIT(5,FNBOW(HISUIT))=SUIT(5,FNBOW(HISUIT))+1
  229. 3755  IF HISUIT=0 THEN LEAST=1:MOST=1 ELSE LEAST=0:MOST=0
  230. 3760  FOR I=1 TO 3:IF I=HISUIT THEN 3775
  231. 3765  IF(SUIT(5,I)>SUIT(5,MOST)AND SUIT(PN,I)>0)OR(SUIT(PN,MOST)=0)THEN MOST=I
  232. 3770  IF(SUIT(5,I)<SUIT(5,LEAST)AND SUIT(PN,I)>0)OR(SUIT(PN,LEAST)=0)THEN LEAST=I
  233. 3775  NEXT I
  234. 3790  IF PART(PN)=BN THEN FINDSUIT=MOST:GOSUB 6320:I=HIPOS:FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  235. 3805  FINDSUIT=LEAST:GOSUB 6320:I=HIPOS:FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
  236. 3820  FINDSUIT=HISUIT:GOSUB 6320:I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430:GOTO 3840
  237. 3840  PN=FNINCM(PN)
  238. 3845  COLOR 0,7:OLDPN=FNLAST(PN):LOCATE Y(OLDPN),X(OLDPN):PRINT NM$(OLDPN)
  239. 3850  IF PN=LN THEN 4425
  240. 3855  IF DUMY=PN THEN PN=FNINCM(PN):IF PN=LN THEN 4425
  241. 3860  COLOR 23,0:LOCATE Y(PN),X(PN):PRINT NM$(PN)
  242. 3865  IF ROUND=5 THEN I=PN*5:GOSUB 6430:GOTO 3840
  243. 3870  IF LEFT$(NM$(PN),1)=CHR$(16)THEN 4005
  244. 3880  COLOR 15,0:LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:FOR I=1 TO 15:DUMY$=INKEY$:NEXT I:PRINT"ENTER YOUR CARD ";NM$(PN);SPACE$(10):LOCATE 20,1:GOSUB 7125:COLOR 7,0
  245. 3895  IF CARDS$="A"AND CARDN$="0"THEN 4005
  246. 3905  CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3925
  247. 3910  NEXT N
  248. 3915  LOCATE 19,1:PRINT"BAD CARD                  ":BEEP:GOTO 3880
  249. 3925  CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:PRINT"BAD SUIT                ";:BEEP:GOTO 3880
  250. 3935  IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
  251. 3940  IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
  252. 3950  FOR N=FNCP(PN)TO PN*5:IF DECK(N,0)=CARDN AND DECK(N,1)=CARDS THEN I=N:GOTO 3965
  253. 3955  NEXT N
  254. 3960  LOCATE 19,1:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3880
  255. 3965  IF(CARDS=FOLSUIT)AND(CARDN<>15)THEN 3985
  256. 3970  IF(CARDS \ 2=FOLSUIT \ 2)AND(CARDN=15)AND(FOLSUIT<>CARDS)THEN 3985
  257. 3975  IF(SUIT(PN,FOLSUIT)>=1)OR(CARDN=15)THEN BEEP:LOCATE 19,1:PRINT"YOU MUST FOLLOW SUIT           ":GOTO 3880
  258. 3985  LOCATE 19,1:PRINT SPC(30):GOSUB 6430:GOTO 3840
  259. 4005  COLOR 7,0:LOCATE 18,1:PRINT SPACE$(30)
  260. 4010  LOCATE 20,1:PRINT SPACE$(30)
  261. 4020  NSUIT=SUIT(PN,FOLSUIT)
  262. 4025  IF NSUIT>0 THEN 4250
  263. 4035  IF SUIT(PN,HISUIT)=0 THEN GOSUB 6650:GOSUB 6430:GOTO 3840
  264. 4055  GOSUB 6570
  265. 4060  FINDSUIT=HISUIT:GOSUB 6320
  266. 4065  ON((PN+4-LN)MOD 4)+1 GOTO 4070,4085,4100,4205
  267. 4070  ERROR**********
  268. 4085  I=LOPOS:GOSUB 6430:GOTO 3840
  269. 4100  IF LN=HPOS THEN 4150
  270. 4115  V5=V2:FINDSUIT=HISUIT:GOSUB 7020
  271. 4120  IF V6=0 THEN GOSUB 6650 ELSE I=V6
  272. 4125  GOSUB 6430:GOTO 3840
  273. 4150  IF DUMY=FNINCM(PN)THEN GOSUB 6650:GOTO 4190
  274. 4155  NUMLFT=0:NUMHI=0
  275. 4160  FOR I=9 TO 14
  276. 4165  IF I=11 AND FOLSUIT \ 2=HISUIT \ 2 THEN 4180
  277. 4170  IF CDPLAYED(FOLSUIT,I)=0 THEN NUMLFT=NUMLFT+1
  278. 4175  IF CDPLAYED(FOLSUIT,I)=0 AND I>DECK(FNCP(LN),0)THEN NUMHI=NUMHI+1
  279. 4180  NEXT I
  280. 4185  IF NUMHI=0 AND NUMLFT>1 THEN GOSUB 6650 ELSE I=LOPOS
  281. 4190  GOSUB 6430:GOTO 3840
  282. 4205  IF PN=PART(HPOS)THEN GOSUB 6650:GOTO 4230
  283. 4210  IF DECK(FNCP(HPOS),1)=FOLSUIT THEN I=LOPOS:GOTO 4230
  284. 4215  V5=FNCP(HPOS):FINDSUIT=HISUIT:GOSUB 7020
  285. 4220  IF V6=0 THEN GOSUB 6650 ELSE I=V6
  286. 4230  GOSUB 6430:GOTO 3840
  287. 4250  IF NSUIT>1 THEN 4275
  288. 4255  FOR I=FNCP(PN)TO PN*5
  289. 4260  IF(DECK(I,1)=FOLSUIT AND DECK(I,0)<>15)OR(HISUIT=FOLSUIT AND DECK(I,0)=15)THEN GOSUB 6430:GOTO 3840
  290. 4265  NEXT I
  291. 4275  FINDSUIT=FOLSUIT:GOSUB 6320
  292. 4280  GOSUB 6570
  293. 4285  ON((PN+4-LN)MOD 4)+1 GOTO 4290,4305,4325,4385
  294. 4290  ERROR**********
  295. 4305  V1=HIPOS:V2=(((PN+2)MOD 4)*5)+ROUND:GOSUB 6850:IF V3=HIPOS THEN I=HIPOS ELSE I=LOPOS
  296. 4310  GOSUB 6430:GOTO 3840
  297. 4325  IF LN=HPOS THEN 4360
  298. 4340  V1=FNCP(HPOS):V2=HIPOS:GOSUB 6850:IF V3=HIPOS THEN I=HIPOS ELSE I=LOPOS
  299. 4345  GOSUB 6430:GOTO 3840
  300. 4360  IF(HISUIT<>FOLSUIT)AND(HICARD-DECK(FNCP(LN),0)>1)THEN I=HIPOS ELSE I=LOPOS
  301. 4365  GOSUB 6430:GOTO 3840
  302. 4385  IF HPOS MOD 2=PN MOD 2 THEN I=LOPOS:GOSUB 6430:GOTO 3840
  303. 4390  FINDSUIT=FOLSUIT:V5=FNCP(HPOS):GOSUB 7020
  304. 4395  IF V6>0 THEN I=V6:GOSUB 6430:GOTO 3840
  305. 4400  FINDSUIT=FOLSUIT:GOSUB 6320:I=LOPOS:GOSUB 6430:GOTO 3840
  306. 4425  GOSUB 6570:I=FNCP(HPOS)
  307. 4430  IF HPOS=1 OR HPOS=3 THEN TRCKS1=TRCKS1+1 ELSE TRCKS2=TRCKS2+1
  308. 4435  COLOR 7,0:LOCATE 4,1
  309. 4440  PRINT"TRICKS     ";TRCKS1;TAB(31);TRCKS2
  310. 4455  LN=HPOS
  311. 4460  DECK(FNCP(HPOS),0)=-DECK(FNCP(HPOS),0)
  312. 4465  IF DECK(FNCP(HPOS),0)=0 THEN ERROR**********
  313. 4470  PN=FNLAST(LN)
  314. 4475  FLAG3=1:GOSUB 5785:PN=LN
  315. 4480  COLOR 15,0:LOCATE 20,1:PRINT SPC(32):LOCATE 18,1:DUMY$=INKEY$:PRINT"HIT RETURN                  ":LOCATE 20,1:DUMY$=INPUT$(1)
  316. 4495  LOCATE 11,38:PRINT SP$:LOCATE 13,42:PRINT SP$:LOCATE 15,38:PRINT SP$:LOCATE 13,34:PRINT SP$
  317. 4505  GOTO 3310
  318. 4525  S1=0:S2=0
  319. 4535  MSG1$="":MSG2$=""
  320. 4540  IF((BN=1)OR(BN=3))AND((TRCKS1=3)OR(TRCKS1=4))THEN S1=1
  321. 4545  IF((BN=1)OR(BN=3))AND(TRCKS1=5)THEN MSG2$="  GOOD GAME!!":IF AL$="Y"THEN S1=4 ELSE S1=2
  322. 4550  IF((BN=2)OR(BN=4))AND(TRCKS1>2)THEN MSG1$="EUCHRE !!!  ":IF AL$="Y"THEN S1=4 ELSE S1=2
  323. 4560  IF((BN=2)OR(BN=4))AND((TRCKS2=3)OR(TRCKS2=4))THEN S2=1
  324. 4565  IF((BN=2)OR(BN=4))AND(TRCKS2=5)THEN MSG2$="  GOOD GAME!!":IF AL$="Y"THEN S2=4 ELSE S2=2
  325. 4570  IF((BN=1)OR(BN=3))AND(TRCKS2>2)THEN MSG1$="EUCHRE !!!  ":IF AL$="Y"THEN S2=4 ELSE S2=2
  326. 4580  DN=FNINCM(DN)
  327. 4585  TRCKS1=0:TRCKS2=0
  328. 4590  PNTS1=PNTS1+S1:PNTS2=PNTS2+S2
  329. 4595  COLOR 7,0:LOCATE 18,1:PRINT SPACE$(30)
  330. 4600  FOR I=17 TO 23:LOCATE I,1:PRINT SPACE$(30);:NEXT
  331. 4605  LOCATE 3,45:PRINT SPACE$(30)
  332. 4615  IF S1>0 THEN LOCATE 22,1:PRINT SPC(70);:COLOR 7,0:PRINT SPC(70);:LOCATE 22,1:PRINT MSG1$;NM$(1);" AND ";NM$(3);" WIN THE HAND.";MSG2$;
  333. 4620  IF S2>0 THEN LOCATE 22,1:PRINT SPC(70);:COLOR 7,0:PRINT SPC(70);:LOCATE 22,1:PRINT MSG1$;NM$(2);" AND ";NM$(4);" WIN THE HAND.";MSG2$;
  334. 4630  IF PNTS1>=10 THEN GAMES1=GAMES1+1:LOCATE 23,1:PRINT SPC(70);:COLOR 23,0:LOCATE 23,1:PRINT NM$(1);" AND ";NM$(3);" WIN THE GAME!";
  335. 4635  IF PNTS2>=10 THEN GAMES2=GAMES2+1:LOCATE 23,1:PRINT SPC(70);:COLOR 23,0:LOCATE 23,1:PRINT NM$(2);" AND ";NM$(4);" WIN THE GAME!";
  336. 4645  COLOR 1,0:LOCATE 1,1
  337. 4650  PRINT TAB(10);"PLAYERS 1 & 3      PLAYERS 2 & 4"
  338. 4655  COLOR 7,0
  339. 4660  PRINT"GAMES      ";GAMES1;TAB(31);GAMES2
  340. 4665  PRINT"POINTS     ";PNTS1;TAB(31);PNTS2
  341. 4670  PRINT"TRICKS     ";TRCKS1;TAB(31);TRCKS2
  342. 4680  IF PNTS1>=10 OR PNTS2>=10 THEN PNTS1=0:PNTS2=0 ELSE GOTO 4700
  343. 4685  LOCATE 18,1:PRINT"DO YOU WANT TO PLAY AGAIN?":LOCATE 20,1:INPUT AGAIN$
  344. 4690  AG$=LEFT$(AGAIN$,1):IF AG$="N"THEN LOCATE 24,1:END ELSE IF AG$="Y"THEN 4700 ELSE LOCATE 19,1:PRINT"PLEASE ENTER Y OR N!":GOTO 4685
  345. 4700  COLOR 16,7:LOCATE 24,1:PRINT"SHUFFLING FOR NEXT HAND";:COLOR 7,0:GOTO 1195
  346. 5035  ZHIPNTS(BN)=0
  347. 5040  ZHIP1(BN)=0:ZP1(BN)=0
  348. 5045  HISUIT=0
  349. 5055  IF FLAG=0 THEN SUIT=DECK(21,1)ELSE SUIT=SUIT+1
  350. 5060  IF FLAG=1 AND SUIT=DECK(21,1)THEN SUIT=SUIT+1
  351. 5065  IF SUIT>3 THEN IF ZHIPNTS>3 THEN BD=HISUIT:GOTO 5660 ELSE BD=5:GOTO 5660
  352. 5085  VMAX=2
  353. 5090  TRPT=0
  354. 5095  ZPART=0.7
  355. 5100  ZPNTS=ZPART
  356. 5110  FOR I=0 TO 3
  357. 5115  FOR J=1 TO 4
  358. 5120  SUIT(J,I)=0
  359. 5125  NEXT J
  360. 5130  NEXT I
  361. 5150  FOR PNTR=(BN-1)*5+1 TO BN*5
  362. 5155  SUIT(BN,DECK(PNTR,1))=SUIT(BN,DECK(PNTR,1))+1
  363. 5160  IF DECK(PNTR,1)=SUIT THEN TRPT=TRPT+1:TRUMP(TRPT)=DECK(PNTR,0)
  364. 5165  IF TRUMP(TRPT)=11 THEN TRUMP(TRPT)=16
  365. 5170  IF DECK(PNTR,0)=11 AND DECK(PNTR,1)<>SUIT AND SUIT \ 2=DECK(PNTR,1)\ 2 THEN TRPT=TRPT+1:TRUMP(TRPT)=15:SUIT(BN,DECK(PNTR,1))=SUIT(BN,DECK(PNTR,1))-1:SUIT(BN,SUIT)=SUIT(BN,SUIT)+1
  366. 5175  NEXT PNTR
  367. 5185  IF BN=DN AND FLAG=0 THEN TRPT=TRPT+1:TRUMP(TRPT)=DECK(21,0):IF TRUMP(TRPT)=11 THEN TRUMP(TRPT)=16
  368. 5205  IF TRPT<2 THEN 5280
  369. 5210  FOR I=1 TO TRPT-1
  370. 5215  FOR J=I+1 TO TRPT
  371. 5220  IF TRUMP(I)>TRUMP(J)THEN SWAP TRUMP(I),TRUMP(J)
  372. 5225  NEXT J
  373. 5230  NEXT I
  374. 5250  IF(TRUMP(TRPT)<15)OR(TRPT<2)THEN 5305
  375. 5255  IF TRPT=2 THEN IF TRUMP(TRPT-1)<15 THEN 5305 ELSE ZPNTS=ZPNTS+0.25:GOTO 5285
  376. 5260  IF TRUMP(TRPT-1)=15 THEN IF TRUMP(TRPT-2)=14 THEN ZPNTS=ZPNTS+0.4 ELSE IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+0.35 ELSE ZPNTS=ZPNTS+0.3
  377. 5265  IF TRUMP(TRPT)=15 AND TRUMP(TRPT-1)=14 THEN IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+0.15 ELSE ZPNTS=ZPNTS+0.1
  378. 5270  IF TRUMP(TRPT)=16 AND TRUMP(TRPT-1)=14 THEN IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+0.25 ELSE IF TRUMP(TRPT-2)=12 THEN ZPNTS=ZPNTS+0.2 ELSE ZPNTS=ZPNTS+0.15
  379. 5280  IF LEFT$(NM$(BN),1)<>CHR$(16)AND BD<4 THEN ZHIP1(BN)=ZPNTS-ZPART:RETURN
  380. 5285  IF ZPNTS>ZPART THEN VMAX=1
  381. 5305  ZP1(BN)=ZPNTS-ZPART
  382. 5315  FOR I=0 TO 3
  383. 5320  IF TRPT=0 OR I=SUIT OR SUIT(BN,I)>0 OR VMAX<1 THEN 5400
  384. 5325  IF TRUMP(1)=9 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.6 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.6 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.8 ELSE ZPNTS=ZPNTS+0.9
  385. 5330  IF TRUMP(1)=10 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.85 ELSE ZPNTS=ZPNTS+0.95
  386. 5335  IF TRUMP(1)=12 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.75 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.9 ELSE ZPNTS=ZPNTS+1
  387. 5340  IF TRUMP(1)=13 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.75 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.8 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.9 ELSE ZPNTS=ZPNTS+1
  388. 5345  IF TRUMP(1)=14 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.85 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+1 ELSE IF TRUMP(2)=15 THEN ZPNTS=ZPNTS+0.9 ELSE ZPNTS=ZPNTS+0.95
  389. 5350  IF TRUMP(1)=15 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.95 ELSE ZPNTS=ZPNTS+1
  390. 5355  IF TRUMP(1)=16 THEN ZPNTS=ZPNTS+1
  391. 5365  FOR J=1 TO TRPT-1
  392. 5370  TRUMP(J)=TRUMP(J+1)
  393. 5375  NEXT J
  394. 5380  TRPT=TRPT-1
  395. 5390  VMAX=VMAX-1
  396. 5400  NEXT I
  397. 5410  ZP2(BN)=ZPNTS-ZP1(BN)-ZPART
  398. 5430  FOR PNTR=(BN-1)*5+1 TO BN*5
  399. 5435  IF DECK(PNTR,1)=SUIT THEN 5505
  400. 5455  CARD=DECK(PNTR,0):ST=DECK(PNTR,1)
  401. 5460  IF CARD=14 AND SUIT(BN,ST)<4 THEN ZPNTS=ZPNTS+0.65-(0.3*(SUIT(BN,ST)-1))
  402. 5465  IF CARD=13 AND SUIT(BN,ST)<3 THEN ZPNTS=ZPNTS+0.25-(0.2*(SUIT(BN,ST)-1))
  403. 5470  IF CARD=12 AND SUIT(BN,ST)=1 THEN ZPNTS=ZPNTS+0.1
  404. 5480  ZP3(BN)=ZPNTS-ZP2(BN)-ZP1(BN)-ZPART
  405. 5485  GOTO 5505
  406. 5505  NEXT PNTR
  407. 5520  GOSUB 5960
  408. 5525  ZP4(BN)=ZPNTS-ZP3(BN)-ZP2(BN)-ZP1(BN)-ZPART
  409. 5545  IF ZPNTS>4.1 THEN AL$="Y"
  410. 5550  IF ZPNTS>ZHIPNTS(BN)THEN ZHIPNTS=ZPNTS:ZHIPNTS(BN)=ZPNTS:HISUIT=SUIT:ZHIP1(BN)=ZP1(BN):ZHIP2(BN)=ZP2(BN):ZHIP3(BN)=ZP3(BN):ZHIP4(BN)=ZP4(BN):ZHIP5(BN)=ZP5(BN)
  411. 5555  IF FLAG=1 THEN 5055
  412. 5575  FCARD=DECK(21,0):IF FCARD=11 THEN FCARD=16
  413. 5585  IF BN=DN THEN IF ZPNTS>4.1 THEN AL$="Y":GOTO 5630 ELSE AL$="N":GOTO 5630
  414. 5595  IF BN MOD 2=DN MOD 2 THEN IF ZPNTS>4.1-((FCARD/20)-0.4)THEN AL$="Y":GOTO 5630 ELSE AL$="N":ZPNTS=ZPNTS+((FCARD/10)-0.8):GOTO 5630
  415. 5610  ZPNTS=ZPNTS-((FCARD/20)-0.4)
  416. 5615  IF ZPNTS>4.1 THEN AL$="Y"ELSE AL$="N"
  417. 5630  ZHIP5(BN)=ZPNTS-ZHIPNTS(BN):ZHIPNTS(BN)=ZPNTS:ZHIPNTS=ZPNTS
  418. 5635  IF ZPNTS>3 THEN BD=DECK(21,1)ELSE BD=5
  419. 5640  IF((BN=1 OR BN=3)AND(PNTS1>=8))OR((BN=2 OR BN=4)AND(PNTS2>=8))THEN AL$="N"
  420. 5660  RETURN
  421. 5685  D$=DATE$
  422. 5690  DA#=VAL(MID$(D$,4,2))*93000
  423. 5695  T$=TIME$
  424. 5700  SEC#=VAL(RIGHT$(T$,2))*99000
  425. 5705  MIN#=VAL(MID$(T$,4,2))*95000
  426. 5710  HR#=VAL(LEFT$(T$,2))*97000
  427. 5715  RSEED=INT((DA#+HR#+MIN#+SEC#)/541)
  428. 5720  IF VAL(RIGHT$(DATE$,2))<>80 GOTO 5760
  429. 5740  OPEN"EUCHRE.RND"AS #1:FIELD #1,10 AS RND1$
  430. 5745  GET #1,1:RND1=VAL(RND1$)/2+RSEED/2:LSET RND1$=STR$((RND1+1135)MOD 31000):PUT #1,1:CLOSE #1
  431. 5750  RSEED=(RND1+1135)MOD 31000
  432. 5760  RETURN
  433. 5785  IF OH$<>"Y"AND SOLIT=0 THEN 5890
  434. 5790  FOR PLYR=1 TO 4
  435. 5795  IF FLAG3=1 THEN IF PLYR<>HPOS THEN 5880
  436. 5800  IF FLAG2=1 THEN IF PLYR<>PN THEN 5880
  437. 5805  IF OH$<>"Y"AND LEFT$(NM$(PLYR),1)=CHR$(16)THEN 5880
  438. 5810  LOCATE Y(PLYR)+1,X(PLYR)
  439. 5815  COLOR 1,0
  440. 5820  FOR CRD=1 TO 5
  441. 5825  FLAG1=1
  442. 5830  IF PLYR=DUMY THEN COLOR 7,0:GOTO 5860
  443. 5835  IF DECK((PLYR-1)*5+CRD,0)<0 THEN FLAG1=-1:COLOR 9,0 ELSE COLOR 1,0
  444. 5840  IF CRD>ROUND THEN COLOR 7,0:GOTO 5860
  445. 5845  IF CRD<ROUND THEN 5860
  446. 5850  IF LN<=PN AND(PLYR>PN OR PLYR<LN)THEN COLOR 7,0
  447. 5855  IF LN>PN AND PLYR>PN AND PLYR<LN THEN COLOR 7,0
  448. 5860  PRINT CTAB$(DECK((PLYR-1)*5+CRD,0)*FLAG1);CHR$(3+DECK((PLYR-1)*5+CRD,1));" ";
  449. 5865  NEXT CRD
  450. 5870  COLOR 7,0
  451. 5875  PRINT"    ";
  452. 5880  NEXT PLYR
  453. 5890  FLAG2=0:FLAG3=0:RETURN
  454. 5915  COLOR 15,0
  455. 5920  OLDDN=FNLAST(DN)
  456. 5925  LOCATE Y(OLDDN),X(OLDDN)-1:PRINT" ":LOCATE Y(DN),X(DN)-1:PRINT CHR$(1)
  457. 5935  RETURN
  458. 5960  FOR I=TRPT TO 1 STEP-1
  459. 5970  IF TRUMP(I)=16 THEN ZPNTS=ZPNTS+1:GOTO 6255
  460. 5980  IF TRUMP(I)<15 THEN 6000
  461. 5985  IF TRPT=1 THEN ZPNTS=ZPNTS+0.75 ELSE IF TRPT>2 THEN ZPNTS=ZPNTS+1 ELSE IF I<TRPT THEN ZPNTS=ZPNTS+1 ELSE ZPNTS=ZPNTS+0.9
  462. 5990  GOTO 6255
  463. 6000  IF TRUMP(I)<14 THEN 6055
  464. 6005  IF I=TRPT-2 THEN ZPNTS=ZPNTS+1:GOTO 6255
  465. 6010  IF I<TRPT THEN 6025
  466. 6015  IF TRPT=1 THEN ZPNTS=ZPNTS+0.4 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.9 ELSE ZPNTS=ZPNTS+1
  467. 6020  GOTO 6255
  468. 6025  IF TRUMP(TRPT)=16 THEN 6040
  469. 6030  IF TRPT=2 THEN ZPNTS=ZPNTS+0.55 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.8 ELSE ZPNTS=ZPNTS+1
  470. 6035  GOTO 6255
  471. 6040  IF TRPT=2 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.9 ELSE ZPNTS=ZPNTS+1
  472. 6045  GOTO 6255
  473. 6055  IF TRUMP(I)<13 THEN 6155
  474. 6060  IF I=TRPT-3 THEN ZPNTS=ZPNTS+1:GOTO 6255
  475. 6065  IF I<TRPT THEN 6080
  476. 6070  IF TRPT=1 THEN ZPNTS=ZPNTS+0.1 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.75 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.95
  477. 6075  GOTO 6255
  478. 6080  IF I>TRPT-2 THEN 6115
  479. 6085  IF TRUMP(TRPT)=16 AND TRUMP(TRPT-1)=15 THEN IF TRPT=3 THEN ZPNTS=ZPNTS+0.95:GOTO 6255 ELSE ZPNTS=ZPNTS+1:GOTO 6255
  480. 6090  IF TRUMP(TRPT)=15 THEN 6105
  481. 6095  IF TRPT=3 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.95 ELSE ZPNTS=ZPNTS+1
  482. 6100  GOTO 6255
  483. 6105  IF TRPT=3 THEN ZPNTS=ZPNTS+0.35 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.55 ELSE ZPNTS=ZPNTS+0.8
  484. 6110  GOTO 6255
  485. 6115  IF TRUMP(TRPT)=15 THEN 6130 ELSE IF TRUMP(TRPT)=14 THEN 6140
  486. 6120  IF TRPT=2 THEN ZPNTS=ZPNTS+0.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.85 ELSE ZPNTS=ZPNTS+0.95
  487. 6125  GOTO 6255
  488. 6130  IF TRPT=2 THEN ZPNTS=ZPNTS+0.25 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.55 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.85 ELSE IF TRPT=5 THEN ZPNTS=ZPNTS+1
  489. 6135  GOTO 6255
  490. 6140  IF TRPT=2 THEN ZPNTS=ZPNTS+0.2 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.55 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.85 ELSE IF TRPT=5 THEN ZPNTS=ZPNTS+1
  491. 6145  GOTO 6255
  492. 6155  IF TRUMP(I)<12 THEN 6220
  493. 6160  IF I=TRPT-4 THEN ZPNTS=ZPNTS+1:GOTO 6255
  494. 6165  IF I=TRPT-2 THEN ZPNTS=ZPNTS+0.3:GOTO 6255
  495. 6170  IF I=TRPT-1 THEN ZPNTS=ZPNTS+0.2:GOTO 6255
  496. 6175  IF I=TRPT-3 THEN 6190
  497. 6180  IF TRPT=1 THEN ZPNTS=ZPNTS+0 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.15 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.25
  498. 6185  GOTO 6255
  499. 6190  IF TRPT=4 THEN 6205
  500. 6195  IF TRUMP(TRPT)=16 THEN ZPNTS=ZPNTS+1 ELSE ZPNTS=ZPNTS+0.9
  501. 6200  GOTO 6255
  502. 6205  IF TRUMP(TRPT)=15 THEN ZPNTS=ZPNTS+0.5 ELSE IF TRUMP(TRPT-1)=14 THEN ZPNTS=ZPNTS+0.6 ELSE IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+0.95 ELSE ZPNTS=ZPNTS+1
  503. 6210  GOTO 6255
  504. 6220  IF TRUMP(I)=9 THEN 6250
  505. 6225  IF I=TRPT-4 THEN ZPNTS=ZPNTS+0.95 ELSE IF I=TRPT-3 AND TRPT=5 THEN ZPNTS=ZPNTS+0.6 ELSE IF I=TRPT-2 AND TRPT=4 THEN ZPNTS=ZPNTS+0.45 ELSE IF I=TRPT-1 AND TRPT=3 THEN ZPNTS=ZPNTS+0.2
  506. 6230  GOTO 6255
  507. 6235  IF I=TRPT-3 THEN ZPNTS=ZPNTS+0.4 ELSE IF I=TRPT-2 THEN ZPNTS=ZPNTS+0.25 ELSE IF I=TRPT-1 THEN ZPNTS=ZPNTS+0.1
  508. 6240  GOTO 6255
  509. 6250  IF TRPT=5 THEN ZPNTS=ZPNTS+0.9 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.15 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+0.05
  510. 6255  NEXT I
  511. 6265  RETURN
  512. 6320  HIPOS=0
  513. 6325  LOPOS=0
  514. 6330  HICARD=0
  515. 6335  LOCARD=17
  516. 6345  FOR I=FNCP(PN)TO PN*5
  517. 6350  IF DECK(I,1)<>FINDSUIT AND(DECK(I,0)<>15 OR HISUIT<>FINDSUIT)THEN 6370
  518. 6355  IF DECK(I,0)=15 AND DECK(I,1)=FINDSUIT THEN 6370
  519. 6360  IF DECK(I,0)>HICARD THEN HICARD=DECK(I,0):HIPOS=I
  520. 6365  IF DECK(I,0)<LOCARD THEN LOCARD=DECK(I,0):LOPOS=I
  521. 6370  NEXT I
  522. 6375  IF HIPOS=0 OR LOPOS=0 THEN ERROR**********
  523. 6385  RETURN
  524. 6430  CPLAY=ABS(DECK(I,0))
  525. 6435  SPLAY=DECK(I,1)
  526. 6440  IF CPLAY=15 THEN IF DECK(I,1)=1 OR DECK(I,1)=3 THEN SPLAY=DECK(I,1)-1 ELSE SPLAY=DECK(I,1)+1
  527. 6445  CDPLAYED(SPLAY,CPLAY)=PN
  528. 6450  SUIT(PN,SPLAY)=SUIT(PN,SPLAY)-1
  529. 6455  SPLAY=DECK(I,1)
  530. 6460  SWAP DECK(FNCP(PN),0),DECK(I,0)
  531. 6465  SWAP DECK(FNCP(PN),1),DECK(I,1)
  532. 6470  IF DECK(I,0)=0 THEN ERROR**********
  533. 6485  IF PN=1 THEN LOCATE 11,38 ELSE IF PN=2 THEN LOCATE 13,42 ELSE IF PN=3 THEN LOCATE 15,38 ELSE LOCATE 13,34
  534. 6490  COLOR 15,0
  535. 6495  PRINT CTAB$(CPLAY);CHR$(SPLAY+3);" ";
  536. 6510  FLAG2=1:GOSUB 5785
  537. 6520  RETURN
  538. 6570  HPOS=LN:TESTPOS=HPOS
  539. 6580  TESTPOS=FNINCM(TESTPOS)
  540. 6585  IF TESTPOS=PN THEN RETURN
  541. 6590  V1=FNCP(HPOS):V2=FNCP(TESTPOS):GOSUB 6850:IF V3=V2 THEN HPOS=TESTPOS
  542. 6595  GOTO 6580
  543. 6650  LOW=FNCP(PN):HI=PN*5:SLOUGH=0
  544. 6655  IF SUIT(PN,HISUIT)<1 THEN 6710
  545. 6660  FOR I=LOW TO HI
  546. 6665  IF((SUIT(PN,DECK(I,1))>1)AND(SUIT(PN,HISUIT)>0))OR((SUIT(PN,DECK(I,1))=1)AND(SUIT(PN,HISUIT)=0))THEN 6685
  547. 6670  IF DECK(I,0)>12 THEN 6685
  548. 6675  IF DECK(I,1)=HISUIT THEN 6685
  549. 6680  IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0)<DECK(SLOUGH,0)THEN SLOUGH=I
  550. 6685  NEXT I
  551. 6695  IF SLOUGH<>0 THEN I=SLOUGH:RETURN
  552. 6710  FOR I=LOW TO HI
  553. 6715  IF DECK(I,1)=HISUIT THEN 6730
  554. 6720  IF DECK(I,0)=15 THEN 6730
  555. 6725  IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0)<DECK(SLOUGH,0)THEN SLOUGH=I
  556. 6730  NEXT I
  557. 6740  IF SLOUGH<>0 THEN I=SLOUGH:RETURN
  558. 6755  FOR I=LOW TO HI
  559. 6760  IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0)<DECK(SLOUGH,0)THEN SLOUGH=I
  560. 6765  NEXT I
  561. 6775  IF SLOUGH<>0 THEN I=SLOUGH:RETURN
  562. 6785  I=LOW:ERROR**********
  563. 6790  RETURN
  564. 6850  IF DECK(V1,1)=HISUIT THEN HI1=1 ELSE HI1=0
  565. 6855  IF DECK(V1,1)=FOLSUIT THEN FOL1=1 ELSE FOL1=0
  566. 6860  IF DECK(V2,1)=HISUIT THEN HI2=1 ELSE HI2=0
  567. 6865  IF DECK(V2,1)=FOLSUIT THEN FOL2=1 ELSE FOL2=0
  568. 6875  IF DECK(V1,0)=15 THEN HI1=1
  569. 6880  IF DECK(V2,0)=15 THEN HI2=1
  570. 6895  IF HI1 AND HI2=0 THEN V3=V1:RETURN
  571. 6900  IF HI2 AND HI1=0 THEN V3=V2:RETURN
  572. 6905  IF HI1 AND HI2 THEN 6940
  573. 6920  IF FOL1 AND FOL2=0 THEN V3=V1:RETURN
  574. 6925  IF FOL2 AND FOL1=0 THEN V3=V2:RETURN
  575. 6940  IF DECK(V1,0)>DECK(V2,0)THEN V3=V1 ELSE V3=V2
  576. 6950  RETURN
  577. 7020  V6=0
  578. 7025  FOR I=FNCP(PN)TO PN*5
  579. 7030  IF DECK(I,1)<>FINDSUIT AND(DECK(I,0)<>15 OR(DECK(I,1)\ 2<>FINDSUIT \ 2))THEN 7050
  580. 7035  V1=V5:V2=I:GOSUB 6850:IF V3=V5 THEN 7050
  581. 7040  IF V6=0 THEN V6=I:GOTO 7050
  582. 7045  V1=I:V2=V6:GOSUB 6850:IF V3=V6 THEN V6=I
  583. 7050  NEXT I
  584. 7060  RETURN
  585. 7085  COLOR 7,0:LOCATE 25,1:PRINT"ERROR #";ERR;" AT LINE #";ERL;:BEEP:INPUT DUMY$:RESUME NEXT
  586. 7125  LINE INPUT;CDPLAY$
  587. 7130  IF LEN(CDPLAY$)=0 THEN LOCATE 19,1:BEEP:PRINT"TYPE 'CARD, SUIT'        ":GOTO 7125
  588. 7135  IF LEFT$(CDPLAY$,1)=" "THEN CDPLAY$=MID$(CDPLAY$,2):GOTO 7130
  589. 7140  IF LEFT$(CDPLAY$,1)="1"THEN CARDN$=LEFT$(CDPLAY$,2):CDPLAY$=MID$(CDPLAY$,3)ELSE CARDN$=LEFT$(CDPLAY$,1):CDPLAY$=MID$(CDPLAY$,2)
  590. 7145  IF CARDN$="A"AND LEN(CDPLAY$)=0 THEN CARDN$="0":CARDS$="A":GOTO 7175
  591. 7155  IF LEN(CDPLAY$)=0 THEN LOCATE 19,1:BEEP:PRINT"TYPE 'CARD, SUIT'        ":GOTO 7125
  592. 7160  IF LEFT$(CDPLAY$,1)=" "OR LEFT$(CDPLAY$,1)=","OR LEFT$(CDPLAY$,1)="."THEN CDPLAY$=MID$(CDPLAY$,2):GOTO 7155
  593. 7165  CARDS$=LEFT$(CDPLAY$,1)
  594. 7175  LOCATE 19,1:PRINT SPC(34):RETURN
  595. 9999  END
  596.