Category : A Collection of Games for DOS and Windows
Archive   : EUCHRE.ZIP
Filename : EUCHRE.BAS

 
Output of file : EUCHRE.BAS contained in archive : EUCHRE.ZIP
10 REM ************** COLOR ADDED BY TOM SZALLER **************
20 REM ************* CLEVELAND, OHIO *************
100 REM ********** "EUCHRE.BAS" **********
150 REM $DYNAMIC
210 CLEAR,,2000
220 KEY OFF
230 COLOR 7,0
240 DEFINT A-Y
250 DIM SUIT(5,3)
260 DIM DECK(24,1)
270 DIM ZSHUFFLE(24)
280 DIM CTAB$(16)
290 DIM CDPLAYED(3,16)
315 DEF FNINCM(V7)=(V7 MOD 4)+1
320 DEF FNCP(V8)=((V8-1)*5)+ROUND
325 DEF FNLAST(V9)=((V9+2)MOD 4)+1
330 DEF FNBOW(V10)=(V10-(2*(V10 MOD 2))+5)MOD 4
345 DATA 7, 36, 13, 56, 18, 36, 13, 14
350 FOR I=1 TO 4
355 READ Y(I),X(I)
360 NEXT I
370 SP$=STRING$(10," ")
385 PART(1)=3:PART(2)=4:PART(3)=1:PART(4)=2
400 DATA 9, 10, J, Q, K, A, J, J
405 FOR I=9 TO 16
410 READ CTAB$(I)
415 NEXT I
420 CTAB$(8)=CHR$(255)
1020 CLS
1025 COLOR 3,0:LOCATE 5,20:PRINT"*********** COMPUTER EUCHRE ***********"
1030 PRINT
1035 DEF SEG=0:X=PEEK(&H417)AND &H40:IF X=0 THEN POKE &H417,PEEK(&H417)OR &H40:
1040 COLOR 6,0:PRINT"ENTER RETURN TO HAVE THE COMPUTER PLAY"
1045 FOR I=1 TO 4
1050 PRINT:COLOR 14,0:PRINT"ENTER THE NAME OF PLAYER #";I;" ";
1055 COLOR 15,0:INPUT NM$(I)
1065 COLOR 12,0:IF LEN(NM$(I))>10 THEN BEEP:PRINT"PLEASE LIMIT NAME TO 10 CHARACTERS":COLOR 15,0:GOTO 1050
1070 IF NM$(I)=""THEN NM$(I)=CHR$(16)+"PLAYER"+STR$(I)
1075 NEXT I
1085 PRINT:COLOR 3,0:INPUT"ENTER THE NUMBER OF THE DEALER ( 0 TO 4 ) ";DN
1090 COLOR 15,0:IF DN=0 THEN GOSUB 5685:RANDOMIZE RSEED:DN=1+INT(RND*4)
1095 IF DN<1 OR DN>4 THEN BEEP:PRINT"FOLLOW DIRECTIONS!":GOTO 1085 ELSE DN=INT(DN)
1100 '
1105 COLOR 6,0:PRINT:INPUT"DO YOU WISH TO PLAY WITH OPEN HANDS ( Y OR N ) ";OH$
1110 COLOR 15,0:IF OH$=""THEN OH$="N"
1115 OH$=LEFT$(OH$,1):IF OH$<>"Y"AND OH$<>"N"THEN BEEP:PRINT"PLEASE FOLLOW DIRECTIONS!":GOTO 1105
1125 SOLIT=0:FOR I=1 TO 4:IF LEFT$(NM$(I),1)<>CHR$(16)THEN SOLIT=SOLIT+1
1130 NEXT I
1135 IF SOLIT<>1 THEN SOLIT=0
1145 CLS
1150 COLOR 25,0
1155 LOCATE 11,33
1160 PRINT"SHUFFLING . . ."
1165 COLOR 7,0
1195 GOSUB 5685
1200 RANDOMIZE RSEED
1215 FOR I=1 TO 24:DECK(I,0)=((I-1)MOD 6)+9:DECK(I,1)=(I-1)\ 6:ZSHUFFLE(I)=RND:NEXT
1230 FOR I=1 TO 23:FOR J=I+1 TO 24
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)
1240 NEXT J:NEXT I
1265 FOR I=1 TO 15:DUMY$=INKEY$:NEXT I
1270 IF OH$="Y"OR SOLIT=1 THEN 2025
1280 FOR N=1 TO 4
1290 IF LEFT$(NM$(N),1)=CHR$(16)THEN 1340
1295 CLS:COLOR 14:PRINT"HERE IS YOUR HAND ";NM$(N):BEEP
1300 COLOR 13,0:PRINT"MAKE SURE NO ONE IS LOOKING AND ENTER RETURN TO SEE YOUR HAND"
1305 PRINT
1310 INPUT DUMY$
1315 FOR I=1 TO 5
1320 PRINT CTAB$(DECK(5*(N-1)+I,0));" OF ";CHR$(3+DECK(5*(N-1)+I,1))
1325 NEXT I
1330 PRINT:PRINT:COLOR 10,0:PRINT"HIT RETURN WHEN YOU HAVE SEEN AND RECORDED YOUR CARDS"
1335 INPUT DUMY$
1340 NEXT N
2025 CLS
2030 COLOR 2,0
2035 PRINT TAB(10);"PLAYERS 1 & 3 PLAYERS 2 & 4"
2045 COLOR 14,0:PRINT"GAMES ";GAMES1;TAB(31);GAMES2
2050 COLOR 11,0:PRINT"POINTS ";PNTS1;TAB(31);PNTS2
2055 COLOR 12,0:PRINT"TRICKS ";TRCKS1;TAB(31);TRCKS2
2065 COLOR 10,0
2070 FOR I=1 TO 4
2075 LOCATE Y(I),X(I)
2080 PRINT NM$(I)
2085 NEXT I
2095 GOSUB 5920
2105 COLOR 0,7:LOCATE 2,50:PRINT"FLIPPED CARD"
2110 COLOR 15,4,0:LOCATE 3,52:PRINT CTAB$(DECK(21,0));" OF ";CHR$(3+DECK(21,1))
2120 LOCATE 17,70:COLOR 15,6:PRINT"BIDS"
2125 LOCATE 18,70:COLOR 15,0:PRINT"P";:COLOR 12,0:PRINT"ass"
2130 LOCATE 19,70:COLOR 15,0:PRINT"C";:COLOR 11,0:PRINT"lubs"
2135 LOCATE 20,70:COLOR 15,0:PRINT"D";:COLOR 10,0:PRINT"iamonds"
2140 LOCATE 21,70:COLOR 15,0:PRINT"H";:COLOR 13,0:PRINT"earts"
2145 LOCATE 22,70:COLOR 15,0:PRINT"S";:COLOR 14,0:PRINT"pades"
2150 LOCATE 23,70:COLOR 15,0:PRINT"A";:COLOR 9,0:PRINT"utobid"
2160 GOSUB 5785
2185 BN=FNINCM(DN)
2190 FLAG=0
2200 COLOR 10,0
2205 OLDBN=FNLAST(BN):LOCATE Y(OLDBN),X(OLDBN):PRINT NM$(OLDBN):COLOR 25,0:LOCATE Y(BN),X(BN):PRINT NM$(BN)
2215 IF LEFT$(NM$(BN),1)=CHR$(16)THEN COLOR 5,0:LOCATE 18,1:PRINT SP$;SP$:LOCATE 20,1:PRINT SP$;:GOSUB 5035:GOTO 2250
2220 LOCATE 18,1
2225 FOR I=1 TO 15:DUMY$=INKEY$:NEXT I:COLOR 14,0:PRINT"ENTER BID ";NM$(BN);SP$
2230 LOCATE 20,1:PRINT SPC(10):LOCATE 20,1:INPUT BD$:BD$=LEFT$(BD$,1)
2235 IF BD$=""THEN BD$="P"
2240 BD=INSTR("HDCSAP",BD$)-1:IF BD<0 THEN LOCATE 19,1:COLOR 12,0:BEEP:PRINT"RE-ENTER BID ":GOTO 2230
2245 IF BD=4 THEN GOSUB 5035
2250 LOCATE 19,1:PRINT SPC(18):IF BD=5 THEN 2265
2255 IF(FLAG=1 AND BD=DECK(21,1))OR(FLAG=0 AND BD<>DECK(21,1))THEN LOCATE 19,1:COLOR 12,0:BEEP:PRINT"IMPROPER SUIT BID ":GOTO 2230
2260 GOTO 2310
2265 IF FLAG=1 AND BN=DN THEN COLOR 14,0:LOCATE Y(BN),X(BN):PRINT NM$(BN):DN=FNINCM(DN):LOCATE 24,1:COLOR 15,5:PRINT"EVERYONE PASSED. SHUFFLING FOR NEXT DEALER";:COLOR 15,0:FLAG=0:GOTO 1195
2270 IF BN=DN THEN FLAG=1:SUIT=-1
2275 IF FLAG=1 AND BN=DN THEN COLOR 11,0:LOCATE 2,50:PRINT SPC(20):LOCATE 3,50:PRINT SPC(20)
2280 BN=FNINCM(BN)
2285 SUIT=-1
2290 GOTO 2200
2310 IF LEFT$(NM$(BN),1)=CHR$(16)OR BD$="A"THEN 2335
2315 COLOR 11,0:LOCATE 18,1:PRINT"ALONE (Y OR N) ";:LOCATE 20,1:PRINT SP$:LOCATE 20,1:INPUT AL$
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
2325 COLOR 14,0:FOR I=18 TO 20:LOCATE I,1:PRINT SPC(34):NEXT I
2330 SUIT=BD:HISUIT=BD:GOSUB 5085
2335 LOCATE 4,45
2340 COLOR 15,6:PRINT NM$(BN);" BIDS";
2345 COLOR 11,0:IF HISUIT=2 THEN PRINT" CLUBS";ELSE IF HISUIT=1 THEN PRINT" DIAMONDS";ELSE IF HISUIT=0 THEN PRINT" HEARTS";ELSE PRINT" SPADES";
2350 IF AL$="Y"THEN PRINT" ALONE"
2355 IF FLAG=0 THEN LOCATE 20,1:PRINT SP$:LOCATE 18,1:COLOR 3,0:PRINT"HIT RETURN";SPC(20):LOCATE 20,1:DUMY$=INPUT$(1):LOCATE 18,1:PRINT SP$
2360 LOCATE 2,50:PRINT SPC(19):LOCATE 3,50:PRINT SPC(19)
2370 FOR I=17 TO 23:LOCATE I,69:PRINT SPC(11):NEXT I
2380 LOCATE Y(BN),X(BN)
2385 PRINT NM$(BN)
3025 COLOR 14,0:LOCATE 24,1:PRINT SPACE$(79);
3030 LN=FNINCM(DN)
3045 ERASE SUIT:DIM SUIT(5,3)
3050 FOR I=1 TO 21
3055 IF DECK(I,0)=11 AND DECK(I,1)\ 2=HISUIT \ 2 AND DECK(I,1)<>HISUIT THEN DECK(I,0)=15
3060 IF DECK(I,0)=11 AND DECK(I,1)=HISUIT THEN DECK(I,0)=16
3065 IF I=21 THEN 3080
3070 PN=((I-1)\ 5)+1
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
3080 NEXT I
3090 IF AL$<>"Y"THEN DUMY=0:GOTO 3115 ELSE DUMY=FNINCM(FNINCM(BN))
3095 FOR I=(DUMY-1)*5+1 TO DUMY*5:DECK(I,0)=8:DECK(I,1)=252
3100 NEXT I
3105 IF DUMY=DN THEN PN=DN:GOSUB 5785:GOTO 3310
3115 FOR I=9 TO 16
3120 FOR N=0 TO 3
3125 CDPLAYED(N,I)=0
3130 NEXT N
3135 NEXT I
3145 IF FLAG=1 THEN PN=DN:GOSUB 5785:GOTO 3310
3150 IF LEFT$(NM$(DN),1)=CHR$(16)THEN 3245
3155 COLOR 3,0:LOCATE 17,1:PRINT"FLIPPED CARD IS THE ";CTAB$(DECK(21,0));" OF ";CHR$(3+DECK(21,1))
3160 LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:PRINT SPACE$(34):LOCATE 18,1:PRINT"ENTER CARD TO SLOUGH... ";NM$(DN)
3165 COLOR 10,0:LOCATE 20,1:GOSUB 7125
3170 IF CARDN$="0"AND CARDS$="A"THEN 3245
3175 CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3195
3180 NEXT N
3185 COLOR 12,0:LOCATE 19,1:PRINT"BAD CARD ":BEEP:GOTO 3165
3195 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:COLOR 12,0:PRINT"BAD SUIT ";:BEEP:GOTO 3165
3205 IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
3210 IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
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
3225 NEXT N
3230 COLOR 12,0:LOCATE 19,1:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3165
3245 ROUND=1:PN=DN:GOSUB 6650:ROUND=0
3250 IF I=0 THEN print "ERROR**********":stop
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
3270 SUIT(DN,HISUIT)=SUIT(DN,HISUIT)+1
3275 DECK(I,0)=DECK(21,0)
3280 DECK(I,1)=HISUIT
3285 GOSUB 5785
3310 FOR I=17 TO 24:LOCATE I,1:PRINT SPACE$(34);:NEXT
3315 IF LN=DUMY THEN LN=FNINCM(LN)
3320 PN=LN
3325 ROUND=ROUND+1:IF ROUND=6 THEN ROUND=0:GOTO 4525
3330 COLOR 25,0:LOCATE Y(PN),X(PN):PRINT NM$(PN)
3335 IF ROUND<5 THEN 3350
3340 I=PN*5:IF DECK(I,0)=15 THEN FOLSUIT=HISUIT ELSE FOLSUIT=DECK(I,1)
3345 GOSUB 6430:GOTO 3840
3350 IF LEFT$(NM$(PN),1)=CHR$(16)THEN 3495
3360 COLOR 10,0:LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:PRINT SPACE$(34):LOCATE 18,1:FOR I=1 TO 15:COLOR 14,0:DUMY$=INKEY$:NEXT I:PRINT"ENTER YOUR CARD ";NM$(PN):LOCATE 20,1:GOSUB 7125
3385 IF CARDS$="A"AND CARDN$="0"THEN 3495
3395 CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3415
3400 NEXT N
3405 LOCATE 19,1:COLOR 12,0:PRINT"BAD CARD ":BEEP:GOTO 3360
3415 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:COLOR 12,0:PRINT"BAD SUIT ";:BEEP:GOTO 3360
3425 IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
3430 IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
3440 FOR N=FNCP(PN)TO PN*5:IF DECK(N,0)=CARDN AND DECK(N,1)=CARDS THEN I=N:GOTO 3455
3445 NEXT N
3450 LOCATE 19,1:COLOR 12,0:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3360
3455 IF CARDN=15 THEN IF CARDS=1 OR CARDS=3 THEN CARDS=CARDS-1 ELSE CARDS=CARDS+1
3460 FOLSUIT=CARDS
3465 LOCATE 19,1:PRINT SPC(30):GOSUB 6430:GOTO 3840
3495 IF BN<>LN OR ZHIP1(LN)=0 OR SUIT(PN,HISUIT)<1 THEN 3540
3510 FINDSUIT=HISUIT:GOSUB 6320
3520 I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430
3525 GOTO 3840
3540 IF SUIT(PN,HISUIT)=0 OR BN=PART(PN)THEN 3580
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
3550 FOR J=16 TO 9 STEP-1:IF CDPLAYED(HISUIT,J)<>0 THEN NEXT J
3555 FINDSUIT=HISUIT:GOSUB 6320:IF DECK(HIPOS,0)=J THEN I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430:GOTO 3840
3580 LOW=FNCP(LN):HI=LN*5
3585 FOR I=LOW TO HI
3590 IF DECK(I,0)<>14 OR DECK(I,1)=HISUIT THEN 3610
3595 FOR J=9 TO 14:CDP=CDPLAYED(DECK(I,1),J):IF CDP>0 AND CDP<>LN AND CDP<>PART(LN)THEN 3610
3600 NEXT J
3605 FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3610 NEXT I
3625 FOR I=LOW TO HI
3630 IF DECK(I,0)<>13 OR DECK(I,1)=HISUIT THEN 3650
3635 FOR J=9 TO 14:CDP=CDPLAYED(DECK(I,1),J):IF CDP>0 AND CDP<>LN AND CDP<>PART(LN)THEN 3650
3640 NEXT J
3645 FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3650 NEXT I
3665 FOR I=LOW TO HI
3670 IF DECK(I,0)=14 AND DECK(I,1)<>HISUIT THEN 3685
3675 NEXT I
3680 GOTO 3700
3685 FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3700 FOR I=LOW TO HI
3705 IF DECK(I,0)=13 AND DECK(I,1)<>HISUIT THEN 3720
3710 NEXT I
3715 GOTO 3735
3720 FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3735 IF SUIT(PN,HISUIT)+ROUND=6 THEN 3820
3740 FOR I=0 TO 3:SUIT(5,I)=0:NEXT I
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
3750 SUIT(5,HISUIT)=SUIT(5,HISUIT)-1:SUIT(5,FNBOW(HISUIT))=SUIT(5,FNBOW(HISUIT))+1
3755 IF HISUIT=0 THEN LEAST=1:MOST=1 ELSE LEAST=0:MOST=0
3760 FOR I=1 TO 3:IF I=HISUIT THEN 3775
3765 IF(SUIT(5,I)>SUIT(5,MOST)AND SUIT(PN,I)>0)OR(SUIT(PN,MOST)=0)THEN MOST=I
3770 IF(SUIT(5,I)0)OR(SUIT(PN,LEAST)=0)THEN LEAST=I
3775 NEXT I
3790 IF PART(PN)=BN THEN FINDSUIT=MOST:GOSUB 6320:I=HIPOS:FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3805 FINDSUIT=LEAST:GOSUB 6320:I=HIPOS:FOLSUIT=DECK(I,1):GOSUB 6430:GOTO 3840
3820 FINDSUIT=HISUIT:GOSUB 6320:I=HIPOS:FOLSUIT=HISUIT:GOSUB 6430:GOTO 3840
3840 PN=FNINCM(PN)
3845 OLDPN=FNLAST(PN):LOCATE Y(OLDPN),X(OLDPN):PRINT NM$(OLDPN)
3850 IF PN=LN THEN 4425
3855 IF DUMY=PN THEN PN=FNINCM(PN):IF PN=LN THEN 4425
3860 COLOR 25,0:LOCATE Y(PN),X(PN):PRINT NM$(PN)
3865 IF ROUND=5 THEN I=PN*5:GOSUB 6430:GOTO 3840
3870 IF LEFT$(NM$(PN),1)=CHR$(16)THEN 4005
3880 COLOR 10,0:LOCATE 20,1:PRINT SPC(27):LOCATE 18,1:FOR I=1 TO 15:COLOR 14,0:DUMY$=INKEY$:NEXT I:PRINT"ENTER YOUR CARD ";NM$(PN);SPACE$(10):LOCATE 20,1:GOSUB 7125
3895 IF CARDS$="A"AND CARDN$="0"THEN 4005
3905 CARDN=0:FOR N=9 TO 14:IF CARDN$=CTAB$(N)THEN CARDN=N:GOTO 3925
3910 NEXT N
3915 LOCATE 19,1:COLOR 12,0:PRINT"BAD CARD ":BEEP:GOTO 3880
3925 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1:COLOR 12,0:PRINT"BAD SUIT ";:BEEP:GOTO 3880
3935 IF CARDN=11 AND CARDS \ 2=HISUIT \ 2 THEN CARDN=15
3940 IF CARDN=15 AND CARDS=HISUIT THEN CARDN=16
3950 FOR N=FNCP(PN)TO PN*5:IF DECK(N,0)=CARDN AND DECK(N,1)=CARDS THEN I=N:GOTO 3965
3955 NEXT N
3960 LOCATE 19,1:COLOR 12,0:PRINT"YOU DON'T HAVE THAT CARD":BEEP:GOTO 3880
3965 IF(CARDS=FOLSUIT)AND(CARDN<>15)THEN 3985
3970 IF(CARDS \ 2=FOLSUIT \ 2)AND(CARDN=15)AND(FOLSUIT<>CARDS)THEN 3985
3975 IF(SUIT(PN,FOLSUIT)>=1) THEN BEEP:LOCATE 19,1:COLOR 12,0:PRINT"YOU MUST FOLLOW SUIT ":GOTO 3880
3985 LOCATE 19,1:PRINT SPC(30):GOSUB 6430:GOTO 3840
4005 COLOR 13,0:LOCATE 18,1:PRINT SPACE$(30)
4010 COLOR 14,0:LOCATE 20,1:PRINT SPACE$(30)
4020 NSUIT=SUIT(PN,FOLSUIT)
4025 IF NSUIT>0 THEN 4250
4035 IF SUIT(PN,HISUIT)=0 THEN GOSUB 6650:GOSUB 6430:GOTO 3840
4055 GOSUB 6570
4060 FINDSUIT=HISUIT:GOSUB 6320
4065 ON((PN+4-LN)MOD 4)+1 GOTO 4070,4085,4100,4205
4070 print "ERROR**********":stop
4085 I=LOPOS:GOSUB 6430:GOTO 3840
4100 IF LN=HPOS THEN 4150
4115 V5=V2:FINDSUIT=HISUIT:GOSUB 7020
4120 IF V6=0 THEN GOSUB 6650 ELSE I=V6
4125 GOSUB 6430:GOTO 3840
4150 IF DUMY=FNINCM(PN)THEN GOSUB 6650:GOTO 4190
4155 NUMLFT=0:NUMHI=0
4160 FOR I=9 TO 14
4165 IF I=11 AND FOLSUIT \ 2=HISUIT \ 2 THEN 4180
4170 IF CDPLAYED(FOLSUIT,I)=0 THEN NUMLFT=NUMLFT+1
4175 IF CDPLAYED(FOLSUIT,I)=0 AND I>DECK(FNCP(LN),0)THEN NUMHI=NUMHI+1
4180 NEXT I
4185 IF NUMHI=0 AND NUMLFT>1 THEN GOSUB 6650 ELSE I=LOPOS
4190 GOSUB 6430:GOTO 3840
4205 IF PN=PART(HPOS)THEN GOSUB 6650:GOTO 4230
4210 IF DECK(FNCP(HPOS),1)=FOLSUIT THEN I=LOPOS:GOTO 4230
4215 V5=FNCP(HPOS):FINDSUIT=HISUIT:GOSUB 7020
4220 IF V6=0 THEN GOSUB 6650 ELSE I=V6
4230 GOSUB 6430:GOTO 3840
4250 IF NSUIT>1 THEN 4275
4255 FOR I=FNCP(PN)TO PN*5
4260 IF(DECK(I,1)=FOLSUIT AND DECK(I,0)<>15)OR(HISUIT=FOLSUIT AND DECK(I,0)=15)THEN GOSUB 6430:GOTO 3840
4265 NEXT I
4275 FINDSUIT=FOLSUIT:GOSUB 6320
4280 GOSUB 6570
4285 ON((PN+4-LN)MOD 4)+1 GOTO 4290,4305,4325,4385
4290 print "ERROR**********":stop
4305 V1=HIPOS:V2=(((PN+2)MOD 4)*5)+ROUND:GOSUB 6850:IF V3=HIPOS THEN I=HIPOS ELSE I=LOPOS
4310 GOSUB 6430:GOTO 3840
4325 IF LN=HPOS THEN 4360
4340 V1=FNCP(HPOS):V2=HIPOS:GOSUB 6850:IF V3=HIPOS THEN I=HIPOS ELSE I=LOPOS
4345 GOSUB 6430:GOTO 3840
4360 IF(HISUIT<>FOLSUIT)AND(HICARD-DECK(FNCP(LN),0)>1)THEN I=HIPOS ELSE I=LOPOS
4365 GOSUB 6430:GOTO 3840
4385 IF HPOS MOD 2=PN MOD 2 THEN I=LOPOS:GOSUB 6430:GOTO 3840
4390 FINDSUIT=FOLSUIT:V5=FNCP(HPOS):GOSUB 7020
4395 IF V6>0 THEN I=V6:GOSUB 6430:GOTO 3840
4400 FINDSUIT=FOLSUIT:GOSUB 6320:I=LOPOS:GOSUB 6430:GOTO 3840
4425 GOSUB 6570:I=FNCP(HPOS)
4430 IF HPOS=1 OR HPOS=3 THEN TRCKS1=TRCKS1+1 ELSE TRCKS2=TRCKS2+1
4435 LOCATE 4,1
4440 COLOR 12,0:PRINT"TRICKS ";TRCKS1;TAB(31);TRCKS2
4455 COLOR 10,0:LN=HPOS
4460 DECK(FNCP(HPOS),0)=-DECK(FNCP(HPOS),0)
4465 IF DECK(FNCP(HPOS),0)=0 THEN print "ERROR**********":stop
4470 PN=FNLAST(LN)
4475 FLAG3=1:GOSUB 5785:PN=LN
4480 LOCATE 20,1:PRINT SPC(32):LOCATE 18,1:DUMY$=INKEY$:COLOR 3,0:PRINT"HIT RETURN ":LOCATE 20,1:COLOR 10,0:DUMY$=INPUT$(1)
4495 LOCATE 11,38:PRINT SP$:LOCATE 13,42:PRINT SP$:LOCATE 15,38:PRINT SP$:LOCATE 13,34:PRINT SP$
4505 GOTO 3310
4525 S1=0:S2=0
4535 MSG1$="":MSG2$=""
4540 IF((BN=1)OR(BN=3))AND((TRCKS1=3)OR(TRCKS1=4))THEN S1=1
4545 IF((BN=1)OR(BN=3))AND(TRCKS1=5)THEN MSG2$=" GOOD GAME!!":IF AL$="Y"THEN S1=4 ELSE S1=2
4550 IF((BN=2)OR(BN=4))AND(TRCKS1>2)THEN MSG1$="EUCHRE !!! ":IF AL$="Y"THEN S1=4 ELSE S1=2
4560 IF((BN=2)OR(BN=4))AND((TRCKS2=3)OR(TRCKS2=4))THEN S2=1
4565 IF((BN=2)OR(BN=4))AND(TRCKS2=5)THEN MSG2$=" GOOD GAME!!":IF AL$="Y"THEN S2=4 ELSE S2=2
4570 IF((BN=1)OR(BN=3))AND(TRCKS2>2)THEN MSG1$="EUCHRE !!! ":IF AL$="Y"THEN S2=4 ELSE S2=2
4580 DN=FNINCM(DN)
4585 TRCKS1=0:TRCKS2=0
4590 PNTS1=PNTS1+S1:PNTS2=PNTS2+S2
4595 LOCATE 18,1:PRINT SPACE$(30)
4600 FOR I=17 TO 23:LOCATE I,1:PRINT SPACE$(30);:NEXT
4605 LOCATE 3,45:COLOR 10,0:PRINT SPACE$(30)
4615 IF S1>0 THEN LOCATE 22,1:PRINT SPC(70);:COLOR 15,0:PRINT SPC(70);:LOCATE 22,1:PRINT MSG1$;NM$(1);" AND ";NM$(3);" WIN THE HAND.";MSG2$;
4620 IF S2>0 THEN LOCATE 22,1:PRINT SPC(70);:COLOR 15,0:PRINT SPC(70);:LOCATE 22,1:PRINT MSG1$;NM$(2);" AND ";NM$(4);" WIN THE HAND.";MSG2$;
4630 IF PNTS1>=10 THEN GAMES1=GAMES1+1:LOCATE 23,1:PRINT SPC(70);:COLOR 25,0:LOCATE 23,1:PRINT NM$(1);" AND ";NM$(3);" WIN THE GAME!";
4635 IF PNTS2>=10 THEN GAMES2=GAMES2+1:LOCATE 23,1:PRINT SPC(70);:COLOR 25,0:LOCATE 23,1:PRINT NM$(2);" AND ";NM$(4);" WIN THE GAME!";
4645 COLOR 6,0:LOCATE 1,1
4650 PRINT TAB(10);"PLAYERS 1 & 3 PLAYERS 2 & 4"
4655 COLOR 14,0
4660 PRINT"GAMES ";GAMES1;TAB(31);GAMES2
4665 PRINT"POINTS ";PNTS1;TAB(31);PNTS2
4670 PRINT"TRICKS ";TRCKS1;TAB(31);TRCKS2
4680 IF PNTS1>=10 OR PNTS2>=10 THEN PNTS1=0:PNTS2=0 ELSE GOTO 4700
4685 LOCATE 18,1:COLOR 10,0:PRINT"DO YOU WANT TO PLAY AGAIN?":LOCATE 20,1:COLOR 9,0:INPUT AGAIN$
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
4700 COLOR 25,0:LOCATE 24,1:PRINT"SHUFFLING FOR NEXT HAND";:GOTO 1195
5035 ZHIPNTS(BN)=0
5040 ZHIP1(BN)=0:ZP1(BN)=0
5045 HISUIT=0
5055 IF FLAG=0 THEN SUIT=DECK(21,1)ELSE SUIT=SUIT+1
5060 IF FLAG=1 AND SUIT=DECK(21,1)THEN SUIT=SUIT+1
5065 IF SUIT>3 THEN IF ZHIPNTS>3 THEN BD=HISUIT:GOTO 5660 ELSE BD=5:GOTO 5660
5085 VMAX=2
5090 TRPT=0
5095 ZPART=.7
5100 ZPNTS=ZPART
5110 FOR I=0 TO 3
5115 FOR J=1 TO 4
5120 SUIT(J,I)=0
5125 NEXT J
5130 NEXT I
5150 FOR PNTR=(BN-1)*5+1 TO BN*5
5155 SUIT(BN,DECK(PNTR,1))=SUIT(BN,DECK(PNTR,1))+1
5160 IF DECK(PNTR,1)=SUIT THEN TRPT=TRPT+1:TRUMP(TRPT)=DECK(PNTR,0)
5165 IF TRUMP(TRPT)=11 THEN TRUMP(TRPT)=16
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
5175 NEXT PNTR
5185 IF BN=DN AND FLAG=0 THEN TRPT=TRPT+1:TRUMP(TRPT)=DECK(21,0):IF TRUMP(TRPT)=11 THEN TRUMP(TRPT)=16
5205 IF TRPT<2 THEN 5280
5210 FOR I=1 TO TRPT-1
5215 FOR J=I+1 TO TRPT
5220 IF TRUMP(I)>TRUMP(J)THEN SWAP TRUMP(I),TRUMP(J)
5225 NEXT J
5230 NEXT I
5250 IF(TRUMP(TRPT)<15)OR(TRPT<2)THEN 5305
5255 IF TRPT=2 THEN IF TRUMP(TRPT-1)<15 THEN 5305 ELSE ZPNTS=ZPNTS+.25:GOTO 5285
5260 IF TRUMP(TRPT-1)=15 THEN IF TRUMP(TRPT-2)=14 THEN ZPNTS=ZPNTS+.4 ELSE IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+.35 ELSE ZPNTS=ZPNTS+.3
5265 IF TRUMP(TRPT)=15 AND TRUMP(TRPT-1)=14 THEN IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+.15 ELSE ZPNTS=ZPNTS+.1
5270 IF TRUMP(TRPT)=16 AND TRUMP(TRPT-1)=14 THEN IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+.25 ELSE IF TRUMP(TRPT-2)=12 THEN ZPNTS=ZPNTS+.2 ELSE ZPNTS=ZPNTS+.15
5280 IF LEFT$(NM$(BN),1)<>CHR$(16)AND BD<4 THEN ZHIP1(BN)=ZPNTS-ZPART:RETURN
5285 IF ZPNTS>ZPART THEN VMAX=1
5305 ZP1(BN)=ZPNTS-ZPART
5315 FOR I=0 TO 3
5320 IF TRPT=0 OR I=SUIT OR SUIT(BN,I)>0 OR VMAX<1 THEN 5400
5325 IF TRUMP(1)=9 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.6 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.6 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.65 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.8 ELSE ZPNTS=ZPNTS+.9000001
5330 IF TRUMP(1)=10 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.65 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.65 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.7 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.8499999 ELSE ZPNTS=ZPNTS+.95
5335 IF TRUMP(1)=12 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.7 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.7 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.75 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.9000001 ELSE ZPNTS=ZPNTS+1
5340 IF TRUMP(1)=13 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.75 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.8 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.9000001 ELSE ZPNTS=ZPNTS+1
5345 IF TRUMP(1)=14 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.8499999 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+1 ELSE IF TRUMP(2)=15 THEN ZPNTS=ZPNTS+.9000001 ELSE ZPNTS=ZPNTS+.95
5350 IF TRUMP(1)=15 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+.95 ELSE ZPNTS=ZPNTS+1
5355 IF TRUMP(1)=16 THEN ZPNTS=ZPNTS+1
5365 FOR J=1 TO TRPT-1
5370 TRUMP(J)=TRUMP(J+1)
5375 NEXT J
5380 TRPT=TRPT-1
5390 VMAX=VMAX-1
5400 NEXT I
5410 ZP2(BN)=ZPNTS-ZP1(BN)-ZPART
5430 FOR PNTR=(BN-1)*5+1 TO BN*5
5435 IF DECK(PNTR,1)=SUIT THEN 5505
5455 CARD=DECK(PNTR,0):ST=DECK(PNTR,1)
5460 IF CARD=14 AND SUIT(BN,ST)<4 THEN ZPNTS=ZPNTS+.65-(.3*(SUIT(BN,ST)-1))
5465 IF CARD=13 AND SUIT(BN,ST)<3 THEN ZPNTS=ZPNTS+.25-(.2*(SUIT(BN,ST)-1))
5470 IF CARD=12 AND SUIT(BN,ST)=1 THEN ZPNTS=ZPNTS+.1
5480 ZP3(BN)=ZPNTS-ZP2(BN)-ZP1(BN)-ZPART
5485 GOTO 5505
5505 NEXT PNTR
5520 GOSUB 5960
5525 ZP4(BN)=ZPNTS-ZP3(BN)-ZP2(BN)-ZP1(BN)-ZPART
5545 IF ZPNTS>4.1 THEN AL$="Y"
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)
5555 IF FLAG=1 THEN 5055
5575 FCARD=DECK(21,0):IF FCARD=11 THEN FCARD=16
5585 IF BN=DN THEN IF ZPNTS>4.1 THEN AL$="Y":GOTO 5630 ELSE AL$="N":GOTO 5630
5595 IF BN MOD 2=DN MOD 2 THEN IF ZPNTS>4.1-((FCARD/20)-.4)THEN AL$="Y":GOTO 5630 ELSE AL$="N":ZPNTS=ZPNTS+((FCARD/10)-.8):GOTO 5630
5610 ZPNTS=ZPNTS-((FCARD/20)-.4)
5615 IF ZPNTS>4.1 THEN AL$="Y"ELSE AL$="N"
5630 ZHIP5(BN)=ZPNTS-ZHIPNTS(BN):ZHIPNTS(BN)=ZPNTS:ZHIPNTS=ZPNTS
5635 IF ZPNTS>3 THEN BD=DECK(21,1)ELSE BD=5
5640 IF((BN=1 OR BN=3)AND(PNTS1>=8))OR((BN=2 OR BN=4)AND(PNTS2>=8))THEN AL$="N"
5660 RETURN
5685 D$=DATE$
5690 DA#=VAL(MID$(D$,4,2))*93000!
5695 T$=TIME$
5700 SEC#=VAL(RIGHT$(T$,2))*99000!
5705 MIN#=VAL(MID$(T$,4,2))*95000!
5710 HR#=VAL(LEFT$(T$,2))*97000!
5715 RSEED=INT((DA#+HR#+MIN#+SEC#)/541)
5720 IF VAL(RIGHT$(DATE$,2))<>80 GOTO 5760
5740 OPEN"EUCHRE.RND"AS #1:FIELD #1,10 AS RND1$
5745 GET #1,1:RND1=VAL(RND1$)/2+RSEED/2:LSET RND1$=STR$((RND1+1135)MOD 31000):PUT #1,1:CLOSE #1
5750 RSEED=(RND1+1135)MOD 31000
5760 RETURN
5785 IF OH$<>"Y"AND SOLIT=0 THEN 5890
5790 FOR PLYR=1 TO 4
5795 IF FLAG3=1 THEN IF PLYR<>HPOS THEN 5880
5800 IF FLAG2=1 THEN IF PLYR<>PN THEN 5880
5805 IF OH$<>"Y"AND LEFT$(NM$(PLYR),1)=CHR$(16)THEN 5880
5810 LOCATE Y(PLYR)+1,X(PLYR)
5815 COLOR 14,0
5820 FOR CRD=1 TO 5
5825 FLAG1=1
5830 IF PLYR=DUMY THEN COLOR 14,0:GOTO 5860
5835 IF DECK((PLYR-1)*5+CRD,0)<0 THEN FLAG1=-1:COLOR 11,0 ELSE COLOR 6,0
5840 IF CRD>ROUND THEN COLOR 15,0:GOTO 5860
5845 IF CRD 5850 IF LN<=PN AND(PLYR>PN OR PLYR 5855 IF LN>PN AND PLYR>PN AND PLYR 5860 PRINT CTAB$(DECK((PLYR-1)*5+CRD,0)*FLAG1);CHR$(3+DECK((PLYR-1)*5+CRD,1));" ";
5865 NEXT CRD
5870 COLOR 6,0
5875 PRINT" ";
5880 COLOR 10,0:NEXT PLYR
5890 COLOR 10,0:FLAG2=0:FLAG3=0:RETURN
5920 OLDDN=FNLAST(DN)
5925 LOCATE Y(OLDDN),X(OLDDN)-1:PRINT" ":LOCATE Y(DN),X(DN)-1:PRINT CHR$(1)
5935 RETURN
5960 FOR I=TRPT TO 1 STEP-1
5970 IF TRUMP(I)=16 THEN ZPNTS=ZPNTS+1:GOTO 6255
5980 IF TRUMP(I)<15 THEN 6000
5985 IF TRPT=1 THEN ZPNTS=ZPNTS+.75 ELSE IF TRPT>2 THEN ZPNTS=ZPNTS+1 ELSE IF I 5990 GOTO 6255
6000 IF TRUMP(I)<14 THEN 6055
6005 IF I=TRPT-2 THEN ZPNTS=ZPNTS+1:GOTO 6255
6010 IF I 6015 IF TRPT=1 THEN ZPNTS=ZPNTS+.4 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.65 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.9000001 ELSE ZPNTS=ZPNTS+1
6020 GOTO 6255
6025 IF TRUMP(TRPT)=16 THEN 6040
6030 IF TRPT=2 THEN ZPNTS=ZPNTS+.55 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.8 ELSE ZPNTS=ZPNTS+1
6035 GOTO 6255
6040 IF TRPT=2 THEN ZPNTS=ZPNTS+.7 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.9000001 ELSE ZPNTS=ZPNTS+1
6045 GOTO 6255
6055 IF TRUMP(I)<13 THEN 6155
6060 IF I=TRPT-3 THEN ZPNTS=ZPNTS+1:GOTO 6255
6065 IF I 6070 IF TRPT=1 THEN ZPNTS=ZPNTS+.1 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.75 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.95
6075 GOTO 6255
6080 IF I>TRPT-2 THEN 6115
6085 IF TRUMP(TRPT)=16 AND TRUMP(TRPT-1)=15 THEN IF TRPT=3 THEN ZPNTS=ZPNTS+.95:GOTO 6255 ELSE ZPNTS=ZPNTS+1:GOTO 6255
6090 IF TRUMP(TRPT)=15 THEN 6105
6095 IF TRPT=3 THEN ZPNTS=ZPNTS+.7 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.95 ELSE ZPNTS=ZPNTS+1
6100 GOTO 6255
6105 IF TRPT=3 THEN ZPNTS=ZPNTS+.35 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.55 ELSE ZPNTS=ZPNTS+.8
6110 GOTO 6255
6115 IF TRUMP(TRPT)=15 THEN 6130 ELSE IF TRUMP(TRPT)=14 THEN 6140
6120 IF TRPT=2 THEN ZPNTS=ZPNTS+.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.65 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.8499999 ELSE ZPNTS=ZPNTS+.95
6125 GOTO 6255
6130 IF TRPT=2 THEN ZPNTS=ZPNTS+.25 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.55 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.8499999 ELSE IF TRPT=5 THEN ZPNTS=ZPNTS+1
6135 GOTO 6255
6140 IF TRPT=2 THEN ZPNTS=ZPNTS+.2 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.55 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.8499999 ELSE IF TRPT=5 THEN ZPNTS=ZPNTS+1
6145 GOTO 6255
6155 IF TRUMP(I)<12 THEN 6220
6160 IF I=TRPT-4 THEN ZPNTS=ZPNTS+1:GOTO 6255
6165 IF I=TRPT-2 THEN ZPNTS=ZPNTS+.3:GOTO 6255
6170 IF I=TRPT-1 THEN ZPNTS=ZPNTS+.2:GOTO 6255
6175 IF I=TRPT-3 THEN 6190
6180 IF TRPT=1 THEN ZPNTS=ZPNTS+0 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.15 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.25
6185 GOTO 6255
6190 IF TRPT=4 THEN 6205
6195 IF TRUMP(TRPT)=16 THEN ZPNTS=ZPNTS+1 ELSE ZPNTS=ZPNTS+.9000001
6200 GOTO 6255
6205 IF TRUMP(TRPT)=15 THEN ZPNTS=ZPNTS+.5 ELSE IF TRUMP(TRPT-1)=14 THEN ZPNTS=ZPNTS+.6 ELSE IF TRUMP(TRPT-2)=13 THEN ZPNTS=ZPNTS+.95 ELSE ZPNTS=ZPNTS+1
6210 GOTO 6255
6220 IF TRUMP(I)=9 THEN 6250
6225 IF I=TRPT-4 THEN ZPNTS=ZPNTS+.95 ELSE IF I=TRPT-3 AND TRPT=5 THEN ZPNTS=ZPNTS+.6 ELSE IF I=TRPT-2 AND TRPT=4 THEN ZPNTS=ZPNTS+.45 ELSE IF I=TRPT-1 AND TRPT=3 THEN ZPNTS=ZPNTS+.2
6230 GOTO 6255
6235 IF I=TRPT-3 THEN ZPNTS=ZPNTS+.4 ELSE IF I=TRPT-2 THEN ZPNTS=ZPNTS+.25 ELSE IF I=TRPT-1 THEN ZPNTS=ZPNTS+.1
6240 GOTO 6255
6250 IF TRPT=5 THEN ZPNTS=ZPNTS+.9000001 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+.15 ELSE IF TRPT=2 THEN ZPNTS=ZPNTS+.05
6255 NEXT I
6265 RETURN
6320 HIPOS=0
6325 LOPOS=0
6330 HICARD=0
6335 LOCARD=17
6345 FOR I=FNCP(PN)TO PN*5
6350 IF DECK(I,1)<>FINDSUIT AND(DECK(I,0)<>15 OR HISUIT<>FINDSUIT)THEN 6370
6355 IF DECK(I,0)=15 AND DECK(I,1)=FINDSUIT THEN 6370
6360 IF DECK(I,0)>HICARD THEN HICARD=DECK(I,0):HIPOS=I
6365 IF DECK(I,0) 6370 NEXT I
6375 IF HIPOS=0 OR LOPOS=0 THEN print "ERROR**********":stop
6385 RETURN
6430 CPLAY=ABS(DECK(I,0))
6435 SPLAY=DECK(I,1)
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
6445 CDPLAYED(SPLAY,CPLAY)=PN
6450 SUIT(PN,SPLAY)=SUIT(PN,SPLAY)-1
6455 SPLAY=DECK(I,1)
6460 SWAP DECK(FNCP(PN),0),DECK(I,0)
6465 SWAP DECK(FNCP(PN),1),DECK(I,1)
6470 COLOR 12,0:IF DECK(I,0)=0 THEN print "ERROR**********":stop
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
6495 PRINT CTAB$(CPLAY);CHR$(SPLAY+3);" ";
6510 FLAG2=1:GOSUB 5785
6520 RETURN
6570 HPOS=LN:TESTPOS=HPOS
6580 TESTPOS=FNINCM(TESTPOS)
6585 IF TESTPOS=PN THEN RETURN
6590 V1=FNCP(HPOS):V2=FNCP(TESTPOS):GOSUB 6850:IF V3=V2 THEN HPOS=TESTPOS
6595 GOTO 6580
6650 LOW=FNCP(PN):HI=PN*5:SLOUGH=0
6655 IF SUIT(PN,HISUIT)<1 THEN 6710
6660 FOR I=LOW TO HI
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
6670 IF DECK(I,0)>12 THEN 6685
6675 IF DECK(I,1)=HISUIT THEN 6685
6680 IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0) 6685 NEXT I
6695 IF SLOUGH<>0 THEN I=SLOUGH:RETURN
6710 FOR I=LOW TO HI
6715 IF DECK(I,1)=HISUIT THEN 6730
6720 IF DECK(I,0)=15 THEN 6730
6725 IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0) 6730 NEXT I
6740 IF SLOUGH<>0 THEN I=SLOUGH:RETURN
6755 FOR I=LOW TO HI
6760 IF SLOUGH=0 THEN SLOUGH=I ELSE IF DECK(I,0) 6765 NEXT I
6775 IF SLOUGH<>0 THEN I=SLOUGH:RETURN
6785 I=LOW:print "ERROR**********":stop
6790 RETURN
6850 IF DECK(V1,1)=HISUIT THEN HI1=1 ELSE HI1=0
6855 IF DECK(V1,1)=FOLSUIT THEN FOL1=1 ELSE FOL1=0
6860 IF DECK(V2,1)=HISUIT THEN HI2=1 ELSE HI2=0
6865 IF DECK(V2,1)=FOLSUIT THEN FOL2=1 ELSE FOL2=0
6875 IF DECK(V1,0)=15 THEN HI1=1
6880 IF DECK(V2,0)=15 THEN HI2=1
6895 IF HI1 AND HI2=0 THEN V3=V1:RETURN
6900 IF HI2 AND HI1=0 THEN V3=V2:RETURN
6905 IF HI1 AND HI2 THEN 6940
6920 IF FOL1 AND FOL2=0 THEN V3=V1:RETURN
6925 IF FOL2 AND FOL1=0 THEN V3=V2:RETURN
6940 IF DECK(V1,0)>DECK(V2,0)THEN V3=V1 ELSE V3=V2
6950 RETURN
7020 V6=0
7025 FOR I=FNCP(PN)TO PN*5
7030 IF DECK(I,1)<>FINDSUIT AND(DECK(I,0)<>15 OR(DECK(I,1)\ 2<>FINDSUIT \ 2))THEN 7050
7035 V1=V5:V2=I:GOSUB 6850:IF V3=V5 THEN 7050
7040 IF V6=0 THEN V6=I:GOTO 7050
7045 V1=I:V2=V6:GOSUB 6850:IF V3=V6 THEN V6=I
7050 NEXT I
7060 RETURN
7085 LOCATE 25,1:COLOR 12,0:PRINT"ERROR #";ERR;" AT LINE #";ERL;:BEEP:COLOR 14,0:INPUT DUMY$:RESUME NEXT
7125 LINE INPUT;CDPLAY$
7130 IF LEN(CDPLAY$)=0 THEN LOCATE 19,1:BEEP:PRINT"TYPE 'CARD, SUIT' ":GOTO 7125
7135 IF LEFT$(CDPLAY$,1)=" "THEN CDPLAY$=MID$(CDPLAY$,2):GOTO 7130
7140 IF LEFT$(CDPLAY$,1)="1"THEN CARDN$=LEFT$(CDPLAY$,2):CDPLAY$=MID$(CDPLAY$,3)ELSE CARDN$=LEFT$(CDPLAY$,1):CDPLAY$=MID$(CDPLAY$,2)
7145 IF CARDN$="A"AND LEN(CDPLAY$)=0 THEN CARDN$="0":CARDS$="A":GOTO 7175
7155 IF LEN(CDPLAY$)=0 THEN LOCATE 19,1:BEEP:PRINT"TYPE 'CARD, SUIT' ":GOTO 7125
7160 IF LEFT$(CDPLAY$,1)=" "OR LEFT$(CDPLAY$,1)=","OR LEFT$(CDPLAY$,1)="."THEN CDPLAY$=MID$(CDPLAY$,2):GOTO 7155
7165 CARDS$=LEFT$(CDPLAY$,1)
7175 LOCATE 19,1:PRINT SPC(34):RETURN
9999 SYSTEM


  3 Responses to “Category : A Collection of Games for DOS and Windows
Archive   : EUCHRE.ZIP
Filename : EUCHRE.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/