Home of the original IBM PC emulator for browsers.
[PCjs Machine "ibm5160"]
Waiting for machine "ibm5160" to load....
FUNNELS teaches math as a game, attracting young ones to the subject. A
very effective tool since they'll be too busy having fun to notice they
are learning!
Arithmetic problems fall from the sky and the idea is to solve them
before they hit the bucket on the ground. A tap on the space bar while
the problem is falling brings the solution. The "falling" speed can
be adjusted for age. When the buckets are full, the game is over.
Target ages: 5-11.
100 REM ********** "EUCHRE.BAS" **********
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 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 PRINT"ENTER RETURN TO HAVE THE COMPUTER PLAY"
1045 FOR I=1 TO 4
1050 PRINT:PRINT"ENTER THE NAME OF PLAYER #";I;" ";
1055 INPUT NM$(I)
1065 IF LEN(NM$(I))>10 THEN BEEP:PRINT"PLEASE LIMIT NAME TO 10 CHARACTERS":GOTO 1050
1070 IF NM$(I)=""THEN NM$(I)=CHR$(16)+"PLAYER"+STR$(I)
1075 NEXT I
1085 PRINT:INPUT"ENTER THE NUMBER OF THE DEALER ( 0 TO 4 ) ";DN
1090 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 PRINT:INPUT"DO YOU WISH TO PLAY WITH OPEN HANDS ( Y OR N ) ";OH$
1110 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 23,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
1285 COLOR 7,0
1290 IF LEFT$(NM$(N),1)=CHR$(16)THEN 1340
1295 CLS:PRINT"HERE IS YOUR HAND ";NM$(N):BEEP
1300 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:PRINT"HIT RETURN WHEN YOU HAVE SEEN AND RECORDED YOUR CARDS"
1335 INPUT DUMY$
1340 NEXT N
2025 CLS
2030 COLOR 1,0
2035 PRINT TAB(10);"PLAYERS 1 & 3 PLAYERS 2 & 4"
2040 COLOR 7,0
2045 PRINT"GAMES ";GAMES1;TAB(31);GAMES2
2050 PRINT"POINTS ";PNTS1;TAB(31);PNTS2
2055 PRINT"TRICKS ";TRCKS1;TAB(31);TRCKS2
2065 COLOR 0,7
2070 FOR I=1 TO 4
2075 LOCATE Y(I),X(I)
2080 PRINT NM$(I)
2085 NEXT I
2095 GOSUB 5915
2105 COLOR 7,0:LOCATE 2,50:PRINT"FLIPPED CARD"
2110 LOCATE 3,52:PRINT CTAB$(DECK(21,0));" OF ";CHR$(3+DECK(21,1))
2120 LOCATE 17,70:COLOR 9,0:PRINT"BIDS "
2125 LOCATE 18,70:COLOR 15,0:PRINT"P";:COLOR 7,0:PRINT"ass"
2130 LOCATE 19,70:COLOR 15,0:PRINT"C";:COLOR 7,0:PRINT"lubs"
2135 LOCATE 20,70:COLOR 15,0:PRINT"D";:COLOR 7,0:PRINT"iamonds"
2140 LOCATE 21,70:COLOR 15,0:PRINT"H";:COLOR 7,0:PRINT"earts"
2145 LOCATE 22,70:COLOR 15,0:PRINT"S";:COLOR 7,0:PRINT"pades"
2150 LOCATE 23,70:COLOR 15,0:PRINT"A";:COLOR 7,0:PRINT"utobid"
2160 GOSUB 5785
2185 BN=FNINCM(DN)
2190 FLAG=0
2200 COLOR 0,7
2205 OLDBN=FNLAST(BN):LOCATE Y(OLDBN),X(OLDBN):PRINT NM$(OLDBN):COLOR 23,0:LOCATE Y(BN),X(BN):PRINT NM$(BN)
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
2220 LOCATE 18,1:COLOR 15,0
2225 FOR I=1 TO 15:DUMY$=INKEY$:NEXT I: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 7,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 7,0:BEEP:PRINT"IMPROPER SUIT BID ";:GOTO 2230
2260 GOTO 2310
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
2270 IF BN=DN THEN FLAG=1:SUIT=-1
2275 IF FLAG=1 AND BN=DN THEN COLOR 7,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 15,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 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 7,0:PRINT NM$(BN);" BIDS ";
2345 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:COLOR 15,0:PRINT SP$:LOCATE 18,1:PRINT"HIT RETURN";SPC(20):LOCATE 20,1:DUMY$=INPUT$(1):LOCATE 18,1:PRINT SP$
2360 COLOR 7,0: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 7,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 15,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 LOCATE 20,1:COLOR 0,0:GOSUB 7125:COLOR 7,0
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 LOCATE 19,1:PRINT"BAD CARD ":BEEP:GOTO 3165
3195 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1: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 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 ERROR**********
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 COLOR 7,0: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 23,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 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
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:PRINT"BAD CARD ":BEEP:GOTO 3360
3415 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1: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: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)<SUIT(5,LEAST)AND SUIT(PN,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 COLOR 0,7: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 23,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 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
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:PRINT"BAD CARD ":BEEP:GOTO 3880
3925 CARDS=INSTR("HDCS",CARDS$)-1:IF CARDS<0 THEN LOCATE 19,1: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: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)OR(CARDN=15)THEN BEEP:LOCATE 19,1:PRINT"YOU MUST FOLLOW SUIT ":GOTO 3880
3985 LOCATE 19,1:PRINT SPC(30):GOSUB 6430:GOTO 3840
4005 COLOR 7,0:LOCATE 18,1:PRINT SPACE$(30)
4010 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 ERROR**********
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 ERROR**********
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 COLOR 7,0:LOCATE 4,1
4440 PRINT"TRICKS ";TRCKS1;TAB(31);TRCKS2
4455 LN=HPOS
4460 DECK(FNCP(HPOS),0)=-DECK(FNCP(HPOS),0)
4465 IF DECK(FNCP(HPOS),0)=0 THEN ERROR**********
4470 PN=FNLAST(LN)
4475 FLAG3=1:GOSUB 5785:PN=LN
4480 COLOR 15,0:LOCATE 20,1:PRINT SPC(32):LOCATE 18,1:DUMY$=INKEY$:PRINT"HIT RETURN ":LOCATE 20,1: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 COLOR 7,0:LOCATE 18,1:PRINT SPACE$(30)
4600 FOR I=17 TO 23:LOCATE I,1:PRINT SPACE$(30);:NEXT
4605 LOCATE 3,45:PRINT SPACE$(30)
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$;
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$;
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!";
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!";
4645 COLOR 1,0:LOCATE 1,1
4650 PRINT TAB(10);"PLAYERS 1 & 3 PLAYERS 2 & 4"
4655 COLOR 7,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:PRINT"DO YOU WANT TO PLAY AGAIN?":LOCATE 20,1: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 16,7:LOCATE 24,1:PRINT"SHUFFLING FOR NEXT HAND";:COLOR 7,0: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=0.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+0.25:GOTO 5285
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
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
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
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+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.9000001
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.8499999 ELSE ZPNTS=ZPNTS+0.95
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.9000001 ELSE ZPNTS=ZPNTS+1
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.9000001 ELSE ZPNTS=ZPNTS+1
5345 IF TRUMP(1)=14 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.8499999 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+1 ELSE IF TRUMP(2)=15 THEN ZPNTS=ZPNTS+0.9000001 ELSE ZPNTS=ZPNTS+0.95
5350 IF TRUMP(1)=15 THEN IF TRPT=1 THEN ZPNTS=ZPNTS+0.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+0.65-(0.3*(SUIT(BN,ST)-1))
5465 IF CARD=13 AND SUIT(BN,ST)<3 THEN ZPNTS=ZPNTS+0.25-(0.2*(SUIT(BN,ST)-1))
5470 IF CARD=12 AND SUIT(BN,ST)=1 THEN ZPNTS=ZPNTS+0.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)-0.4)THEN AL$="Y":GOTO 5630 ELSE AL$="N":ZPNTS=ZPNTS+((FCARD/10)-0.8):GOTO 5630
5610 ZPNTS=ZPNTS-((FCARD/20)-0.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 1,0
5820 FOR CRD=1 TO 5
5825 FLAG1=1
5830 IF PLYR=DUMY THEN COLOR 7,0:GOTO 5860
5835 IF DECK((PLYR-1)*5+CRD,0)<0 THEN FLAG1=-1:COLOR 9,0 ELSE COLOR 1,0
5840 IF CRD>ROUND THEN COLOR 7,0:GOTO 5860
5845 IF CRD<ROUND THEN 5860
5850 IF LN<=PN AND(PLYR>PN OR PLYR<LN)THEN COLOR 7,0
5855 IF LN>PN AND PLYR>PN AND PLYR<LN THEN COLOR 7,0
5860 PRINT CTAB$(DECK((PLYR-1)*5+CRD,0)*FLAG1);CHR$(3+DECK((PLYR-1)*5+CRD,1));" ";
5865 NEXT CRD
5870 COLOR 7,0
5875 PRINT" ";
5880 NEXT PLYR
5890 FLAG2=0:FLAG3=0:RETURN
5915 COLOR 15,0
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+0.75 ELSE IF TRPT>2 THEN ZPNTS=ZPNTS+1 ELSE IF I<TRPT THEN ZPNTS=ZPNTS+1 ELSE ZPNTS=ZPNTS+0.9000001
5990 GOTO 6255
6000 IF TRUMP(I)<14 THEN 6055
6005 IF I=TRPT-2 THEN ZPNTS=ZPNTS+1:GOTO 6255
6010 IF I<TRPT THEN 6025
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.9000001 ELSE ZPNTS=ZPNTS+1
6020 GOTO 6255
6025 IF TRUMP(TRPT)=16 THEN 6040
6030 IF TRPT=2 THEN ZPNTS=ZPNTS+0.55 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.8 ELSE ZPNTS=ZPNTS+1
6035 GOTO 6255
6040 IF TRPT=2 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.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<TRPT THEN 6080
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
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+0.95:GOTO 6255 ELSE ZPNTS=ZPNTS+1:GOTO 6255
6090 IF TRUMP(TRPT)=15 THEN 6105
6095 IF TRPT=3 THEN ZPNTS=ZPNTS+0.7 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.95 ELSE ZPNTS=ZPNTS+1
6100 GOTO 6255
6105 IF TRPT=3 THEN ZPNTS=ZPNTS+0.35 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.55 ELSE ZPNTS=ZPNTS+0.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+0.3 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.65 ELSE IF TRPT=4 THEN ZPNTS=ZPNTS+0.8499999 ELSE ZPNTS=ZPNTS+0.95
6125 GOTO 6255
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.8499999 ELSE IF TRPT=5 THEN ZPNTS=ZPNTS+1
6135 GOTO 6255
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.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+0.3:GOTO 6255
6170 IF I=TRPT-1 THEN ZPNTS=ZPNTS+0.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+0.15 ELSE IF TRPT=3 THEN ZPNTS=ZPNTS+0.25
6185 GOTO 6255
6190 IF TRPT=4 THEN 6205
6195 IF TRUMP(TRPT)=16 THEN ZPNTS=ZPNTS+1 ELSE ZPNTS=ZPNTS+0.9000001
6200 GOTO 6255
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
6210 GOTO 6255
6220 IF TRUMP(I)=9 THEN 6250
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
6230 GOTO 6255
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
6240 GOTO 6255
6250 IF TRPT=5 THEN ZPNTS=ZPNTS+0.9000001 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
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)<LOCARD THEN LOCARD=DECK(I,0):LOPOS=I
6370 NEXT I
6375 IF HIPOS=0 OR LOPOS=0 THEN ERROR**********
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 IF DECK(I,0)=0 THEN ERROR**********
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
6490 COLOR 15,0
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)<DECK(SLOUGH,0)THEN SLOUGH=I
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)<DECK(SLOUGH,0)THEN SLOUGH=I
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)<DECK(SLOUGH,0)THEN SLOUGH=I
6765 NEXT I
6775 IF SLOUGH<>0 THEN I=SLOUGH:RETURN
6785 I=LOW:ERROR**********
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 COLOR 7,0:LOCATE 25,1:PRINT"ERROR #";ERR;" AT LINE #";ERL;:BEEP: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 END
***** EUCHRE *****
RULES OF THE GAME
Euchre is a card game played with only the 9 through Ace.
It is played with 4 players with opposite players being
partners. After bidding for trump, each player takes turns
playing cards with the object being to take as many tricks
as possible.
Bidding - The dealer gives 5 cards to each player (4 cards remain).
The next remaining card is then turned over (the flipped card).
Players take turns bidding starting with the player to the left
of the dealer and continuing to the left. A player may either
bid a suit, or pass. In the first round of bidding, the only
suit that can be bid is the suit of the flipped card. If
everyone passes then the flipped card is turned upside down and
players go through another round of bidding. In the second
round, any suit may be bid except the suit of the flipped card.
If no suit is bid after the second round, the hand is thrown
in the the player to the left of the present dealer deals the
next hand.
If a player makes a bid, they have the option of going alone.
This means that the bidder's partner puts his cards down and
sits out the hand. A team can get more points by going alone
(see scoring).
If a bid is made in the first round, using the flipped card
suit, then the dealer picks up the flipped card and discards
any card he chooses (presumably a loser). This does not happen
if a bid is not made until the second round.
Playing - The player to the left of the dealer leads the first trick
and is followed by the player to his left until everybody has
played 1 card. The person with the highest card wins the trick
and leads the next one. If a following player has a card of the
same suit as the lead card, then that player must follow suit.
If he can't follow suit, then he can play any card.
When determining the winner of a trick, a trump card beats
any other suit. If no trump cards are played then the highest
card in the suit played by the leader wins the trick. A non-
trump card in a different suit then the lead suit cannot win
the trick.
Bowers - The highest card in the trump suit is the jack (called
the Right Bower) followed by the jack of the other suit of the
same color (called the Left Bower) and then followed by the Ace,
King, Queen, Ten, and Nine. For example, if Hearts are trump
then the highest trump cards are the Jack of Hearts, the Jack
of Diamonds, the Ace of Hearts, King of Hearts, Queen of Hearts,
Ten of Hearts, and Nine of Hearts. The left bower is considered
a trump card when following suit. So if Hearts is trump then
if a heart is led, a player can follow suit with the Jack of
Diamonds, but if diamonds is led, then a player cannot follow
with the Jack of Diamonds unless he has no diamonds in his hand.
In all other suits, the Ace is the highest card and the normal
order is followed, eg. Ace, King, Queen, Jack (except Left Bower),
Ten, and Nine.
Scoring -
BID # OF TRICKS TAKEN POINTS
(OUT OF 5 POSSIBLE)
------------------------------------------------------------------
NORMAL 1 OR 2 2 FOR OPPONENTS (EUCHRE)
NORMAL 3 OR 4 1 FOR BIDDERS
NORMAL 5 2 FOR BIDDERS
ALONE 1 OR 2 4 FOR OPPONENTS (EUCHRE)
ALONE 3 OR 4 1 FOR BIDDERS
ALONE 5 4 FOR BIDDERS
The game is won when 1 team gets 10 points.
Disk No 229
Program Title: FUNNELS & BUCKETS
PC-SIG version 1.6
The major program on this disk is FUNNELS, an educational game that teaches
math in a fun way. It's a way to get young ones interested in math and can
be a very effective tool -- they'll be too busy having fun to notice that
they are learning. The other programs are an air-traffic control game,
which is challenging almost beyond human comprehension, and a good version
of the Euchre card game.
Usage: Educational and Entertainment.
System Requirements: 128K memory and one disk drive.
How to Start: Type: FUNNELS or ATC (press enter) to start either game. To
read DOC files, enter: TYPE filename.ext (press enter). For instructions on
running BASIC programs, please refer to the GETTING STARTED section in this
catalog.
Suggested Registration: $10.00 for FUNNELS and $15.00 for ATC.
File Descriptions:
FUNNELS EXE A user-supported FUNNELS & BUCKETS game.
FUNNELS DOC FUNNELS documentation (15K).
FUNNELS INV Invoice for author contribution.
ATC EXE AIR TRAFFIC CONTROL game (US).
ATC1 BLD Part of ATC.
ATC2 BLD Part of ATC.
AUTOEXEC BAT Part of ATC.
ATC DAT Part of ATC.
ATCCOPY BAT Copies ATC from A: to B:.
EUCHRE BAS "Squished" version of EUCHRE.
EUCHRE DOC Rules for the card game EUCHRE.
EUCHRE SRC Source code for EUCHRE including comments.
EUCHRE INS Instructions for computer EUCHRE.
PC-SIG
1030D E Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1987,88 PC-SIG, Inc.
FUNNELS & BUCKETS
Version 2.00
User-Supported Educational Software
from
Data Sage
Yale Station 2902
New Haven, CT 06520
------------------------------------------------------------
For: IBM PC with PC-DOS
Requirements: Eighty-column display, one diskette drive,
96K random access memory (RAM)
Files Used: FUNNELS.EXE, FUNNELS.DOC, FUNNELS.INV
FUNNELS.SCR (created by program)
------------------------------------------------------------
Over dinner one evening, eight-year-old Jed said, "You
were right, Dad, when you told me learning math would pay
off."
His father raised a questioning eyebrow. "What do you
mean, son?" he asked.
"A boy in our class said he would give anything if
someone would do the last row of problems on his math
assignment. So I did and he paid me a dime."
The dime was only the beginning of the payoffs Jed will
get from the time and effort he invests in learning
arithmetic. Someday he may become an accountant or
financial advisor and charge hundreds of times that amount
for essentially the same work: solving number problems.
Whatever he does, his mastery of arithmetic will mean
he has some useful tools to achieve his personal goals.
Unfortunately, his classmate may never be able to use those
same tools, unless he overcomes his distaste for arithmetic.
Funnels & Buckets is a computer program meant to help
people like Jed and his classmate learn and enjoy
arithmetic. Although it is aimed at children, it can help
adults polish their skills.
BACKGROUND
Funnels & Buckets is a learning game. Playing it
improves your skill in adding, subtracting, multiplying, and
dividing. The object of the game is to POP equations by
solving them as they fall from a funnel. The funnel glides
across the ceiling of a room called The Cleaning Closet.
Funnels & Buckets Users Guide
As a player, your job is to type in the correct answers
to the equations before they reach the buckets. That will
POP them, and the more you POP, the higher your score. At
fast speeds, POPping will challenge even an adult.
The dastardly villain Burglar runs the funnel. He
wants to fill all the buckets in The Cleaning Closet with
equations. Burglar gets his name because he tries to steal
the points you earn from typing in an answer. Even worse,
if you type the wrong answer when he's around, he steals
TWICE the points. To avoid losing points, never type an
answer when he's around.
Meggie, the cleaning woman, is the game's heroine.
This is her cleaning closet, and the buckets belong to her.
She's busy cleaning, but she drops by often to reward you
with bonus points for stopping Burglar. If you type in the
correct answer when she's around, you get TRIPLE the points.
When you don't know an answer, Meggie will help you.
(Her cleaning job is just a money-making sideline. In real
life she is a math teacher.) Press the <space bar> when an
equation is falling and she'll show you how to get the right
answer. You can remember it for the next time Burglar drops
that equation.
START UP
To start Funnels & Buckets, place the diskette into
your logged disk drive and type:
FUNNELS <enter>
A title screen will appear. Press the <space bar> to get
the main menu.
SETTING UP THE GAME
Funnels & Buckets allows you to set up the game the way
you want. You control the type of problems (addition,
subtraction, multiplication, division, or mixed). You
control whether you want sound effects. And you control
how fast the game will go.
The game has already made its own choices. They appear
in parentheses to the right of the menu selections in the
middle box on the screen. If you want these choices, just
press the <space bar> to start playing. If you want to
change a choice, press the number key beside it on the menu.
Copyright (C) 1984 by Data Sage 2
Funnels & Buckets Users Guide
To change the type of problem, press <1>. A menu of
choices will appear in the bottom box on the screen. Choose
whether you want to add, subtract, multiply, divide, or
solve a mixture of problems. Difficult problems earn more
points than easy ones:
Addition . . . . . . . 5 points
Subtraction . . . . . 10 points
Multiplication . . . . 15 points
Division . . . . . . . 20 points
To choose whether you will have sound effects, press
<2>. A menu will appear in the bottom box on the screen.
Select quiet or sound.
To choose how fast the equations will fall, press <3>.
There are six options, ranging from FASTEST to SLOWEST. You
may choose the speed you want. The computer will
automatically speed things up as you get better and your
score gets higher.
You may get short instructions from the main menu by
pressing the <enter> key. You may quit by pressing <esc>.
PLAYING THE GAME
When you have chosen how you want the game to work,
press the <space bar>. Then use either set of number keys
to enter answers.
If you make a mistake typing the first digit of a two-
digit number, press the <backspace> key to start over.
Keep an eye out for Meggie and the Burglar at the top
of the screen. If Meggie comes, try to answer the question
right away to get bonus points. If Burglar comes, stop
typing until he leaves. Otherwise you'll lose points.
To get an explanation of a problem, press the <space
bar> when an equation is falling. Meggie will show how to
solve it.
You may change the speed, the sound, and the type of
problems anytime. This will not cause you to lose points.
Press the <esc> key to interrupt play. Make the changes you
want. Then press the <space bar> to continue play.
EXITING
The <esc> key always takes you back to the previous
screen. You may end the game at any time by pressing the
Copyright (C) 1984 by Data Sage 3
Funnels & Buckets Users Guide
<esc> key several times. The game will also end by itself
if Burglar succeeds in filling all the buckets.
The computer will compare your score with that of
previous players. If you beat all previous scores, it will
ask you to enter your name as the new record holder. Then
you may decide if you want to play again.
GETTING THE MOST FROM THE GAME
The value of Funnels & Buckets is that it makes
learning fun. Some people like the excitement of outpacing
the burglar. They lose track of time as they POP equations.
Others prefer the gentle explanations Meggie gives when they
press the <space bar>. A player learns best by playing the
game in his or her own way. That keeps it fun without
becoming threatening or boring.
Many children between the ages of four and seven prefer
to watch Meggie's explanation instead of playing for points.
Older children usually prefer both explanations and play.
Note that the game is designed so you only have to use
the numeric keypad, the <space bar>, the <backspace> key and
the <esc> key. The <esc> key, which is used for exiting, is
separated from the playing keys to prevent accidental use.
For children this will make play easier.
SHAREWARE
Funnels & Buckets is a "user-supported" program. User-
supported software, sometimes known by the name "shareware,"
is an experiment in software distribution. It is based on
three principles:
1. You are the best judge of how useful a
program is. By using it on your own computer, you
can you see whether it meets your needs. If it
doesn't you shouldn't have to pay for it.
2. The creation of personal computer
software can and should be supported by the
computing community.
If you use someone else's work, you will want to
contribute a small share of the cost, just as someone who
uses your work should do for you. Supporting a software
author helps him or her create more software and improve
what is already available.
Copyright (C) 1984 by Data Sage 4
Funnels & Buckets Users Guide
3. Copying and sharing software is a good
thing that should be encouraged.
Distributing "user-supported" software reduces the cost
of marketing, advertising, manufacturing, packaging, and
copy-protecting. It costs less to distribute, so you pay
less. (This is one way your users group or bulletin board
operator saves you money.) When you use a shareware
program, the author trusts you to send your fair share to
help support the program.
We've tried to make Funnels & Buckets as high-quality
as any professional program you can buy. Please give your
fair share. For your convenience, we've included an invoice
(FUNNELS.INV) on the disk. You can print it out and send it
with your check.
============================================================
> > > SUGGESTED CONTRIBUTION < < <
$10
Schools and organizations, please contribute $25 per
building.
============================================================
We encourage you to copy and share Funnels & Buckets
with others, if:
1. You do not change the program or the
documentation. (If even a few persons made
changes, there would soon be several different
versions and it would become difficult or
impossible to fix problems.)
2. You copy all three files:
FUNNELS.EXE
FUNNELS.DOC
FUNNELS.INV
(The score file FUNNELS.SCR is optional; the
computer will create it if it is not there.)
3. You do NOT charge any fee or
consideration, but inform the person to whom you
give a copy that this is a shareware program.
(User Groups may charge their normal library fee.)
Copyright (C) 1984 by Data Sage 5
Funnels & Buckets Users Guide
SUGGESTIONS WELCOME
If you have suggestions or comments about Funnels &
Buckets, we'd appreciate a letter. There's also room for
comments on the convenient invoice. Thank you for your
support.
ACKNOWLEDGEMENTS
Stan W. Merrill, Ph.D., created Funnels & Buckets and
programmed the IBM PC version. An earlier version appeared
in PC Disk Magazine (Volume I, Number 7). An Apple II
version, programmed by Paul Ravina, appeared in A+ Disk
Magazine (Volume I, Number 4). Many people have helped test
it, including JoLynn Bennett, Denise Dillman, Tracy Gibbons,
Erica Merrill, Jed Merrill, John Roeder, Scott Roeder, and
Tommy Roeder.
* * *
Copyright (C) 1984 by Data Sage 6
╔═════════════════════════════════════════════════════════════════════════╗
║ <<<< Disk No 229 FUNNELS & BUCKETS >>>> ║
╠═════════════════════════════════════════════════════════════════════════╣
║ To start the FUNNELS & BUCKETS program, type: FUNNELS (press enter) ║
║ ║
║ To start the AIR TRAFFIC CONTROLLER (ATC) game, type ATC (press enter) ║
╚═════════════════════════════════════════════════════════════════════════╝
Volume in drive A has no label
Directory of A:\
ATC DAT 384 1-01-80 12:13a
ATC EXE 50304 9-29-85 10:46p
ATC1 BLD 4096 4-12-87 11:39a
ATC2 BLD 4096 8-23-84 9:08p
ATCCOPY BAT 16 4-12-87 11:33a
ATCTTL BLD 4096 4-03-85 2:28p
AUTOEXEC BAT 11 7-12-84 10:29a
EUCHRE BAS 22784 7-21-84 3:09p
EUCHRE DOC 3645 7-21-84 3:52p
EUCHRE INS 4794 7-21-84 3:16p
EUCHRE SRC 36352 7-21-84 3:28p
FILES229 TXT 1557 8-02-88 12:02p
FUNNELS DOC 14713 9-21-84 1:58p
FUNNELS EXE 59904 9-21-84 3:01p
FUNNELS INV 2432 9-21-84 3:18p
GO BAT 38 7-22-88 9:08a
GO TXT 540 7-22-88 9:14a
17 file(s) 209762 bytes
103424 bytes free