10REM SIXTY SIX v.2.23 20REM by M.Bobrowski 4'94 30: 40PROCinit 50REPEAT:PROCreset 60PROCshuffle:PROCdeal 70PROCgame:PROCscore 80UNTIL end%:PROCend 90MODE 131:END 100: 1000DEF PROCinit:DIM V%(1),v%(1),t%(1), p%(1),r%(1) 1010G%=RND(2)-1:end%=FALSE:r%(0)=0:r%(1 )=0:num$="A"+CHR$228+"KQJ9" 1020ENDPROC 1030: 1040DEF PROCreset 1050GCOL0,130:PROCwindow(1):FORI%=2TO5: PROCwindow(I%):CLG:NEXT 1060FORI%=0TO1:p%(I%)=0:t%(I%)=0:NEXT:R %=RND(-TIME):M%=7:ms%=0 1070ENDPROC 1080: 1090DEF PROCshuffle 1100FOR I%=1 TO 24:A%?I%=I%:NEXT 1110FOR I%=1 TO 24:R%=RND(24):J%=A%?R% 1120A%?R%=A%?I%:A%?I%=J%:NEXT 1130ENDPROC 1140: 1150DEF PROCdeal 1160FORI%=1TO6:P%?I%=A%?I%:NEXT:?P%=6:H %=P%:PROCsort(6) 1170FORI%=1TO6:C%?I%=A%?(I%+6):NEXT:?C% =6:H%=C%:PROCsort(6) 1180tr%=A%?24:T%=FNs(tr%) 1190po%=13:ENDPROC 1200: 1210DEF PROCgame 1220PROChand:PROCpack 1230ph%=1:REPEAT:PROCwindow(2):CLG:PROC window(5):GCOL0,0:VDU5:IF po%>15 X%=920 ELSE X%=904 1240MOVE X%,511:PRINT"Pack:";STR$(25-po %):VDU4 1250PROCwindow(1):FOR ro%=1 TO 2:IF G% H%=C% ELSE H%=P% 1260IF ro%=1 L%=TRUE ELSE L%=FALSE 1270PROCgo(G%):V%(G%)=N%:IF M%=0:ro%=2: NEXT:UNTIL TRUE:ENDPROC 1280PROCtable(N%):PROCdelete 1290G%=(G%+1)MOD 2:NEXT 1300PROCevaluate:PROCgetcards 1310UNTIL po%=25:PROCwindow(5):PROCwind ow(3):CLG:GCOL0,3:VDU5:MOVE 992,700:PRIN T"Trumps:":GCOL0,1:MOVE 992,620 1320IF T%=1 PRINT"Hearts" ELSE IF T%=2 PRINT"Spades" ELSE IF T%=3 PRINT"Diamond s"; ELSE PRINT"Clubs" 1330VDU4:PROCwindow(1) 1340ph%=2:REPEAT:PROCwindow(2):CLG:FOR ro%=1 TO 2:IF G% H%=C% ELSE H%=P% 1350IF ro%=1 L%=TRUE ELSE L%=FALSE 1360PROCgo(G%):V%(G%)=N%:IF M%=0:ro%=2: NEXT:UNTIL TRUE:ENDPROC 1370PROCtable(N%):PROCdelete:IF G%=0 PR OChand 1380G%=(G%+1)MOD 2:NEXT 1390PROCevaluate 1400UNTIL (?C%=0 AND ?P%=0) OR M%=0 1410ENDPROC 1420: 1430DEF PROCgo(G%) 1440IF G%=1 PROCcompgo:ENDPROC 1450IF NOT L% AND ?P%=1:N%=P%?1:ps%=FNs (N%):ENDPROC 1460REPEAT 1470CLS:IF L% COLOUR1 ELSE COLOUR2 1480PRINT"Your go":COLOUR2 1490SOUND1,4,200,10:REPEAT:M%=GET-48:UN TIL M%>=0 AND M%<=?P%:IF ?P%=1 AND M%=1 N%=P%?1:ps%=FNs(N%):UNTIL TRUE:ENDPROC 1500IF L% AND M%=0 AND p%(0)>=66 UNTIL TRUE:ENDPROC ELSE IF M%=0 SOUND1,3,8,30: COLOUR1:PRINT"Score too low":COLOUR2:PRI NT'"Penalty: -10";:PROCwait:p%(0)=p%(0)- 10:UNTIL FALSE 1510N%=P%?M%:pv%=FNn(N%):ps%=FNs(N%) 1520IF L% AND po%<24 AND pv%=6 AND ps%= T% AND t%(0)>0 PROCchange:UNTIL FALSE 1530ch%=TRUE:IF ph%=2 AND NOT L% PROCch eck 1540UNTIL ch% 1550IF L% AND t%(0)>0 AND pv%=4 PROCmar riage 1560ENDPROC 1570: 1580DEF PROCcompgo 1590IF L% PROCcompgo1 ELSE PROCcompgo2 1600IF M%=0 ENDPROC 1610PROCwait 1620cs%=FNs(N%) 1630ENDPROC 1640: 1650DEF PROCcompgo1 1660CLS:COLOUR1:PRINT"My go":COLOUR2 1670IF p%(1)>=66 M%=0:ENDPROC 1680IF ?C%=1 N%=C%?1:ENDPROC 1690IF t%(1)>0 AND po%<24 PROCnine:IF F % PROCchange:GOTO1660 1700IF t%(1)>0 PROCpair:IF F% ENDPROC 1710B%=FNse1:IF B% N%=C%?n% ELSE R%=RND (?C%):N%=C%?R% 1720ENDPROC 1730: 1740DEF PROCcompgo2 1750CLS:COLOUR2:PRINT"My go":IF ?C%=1 N %=C%?1:ENDPROC 1760IF ph%=1 B%=FNse2 ELSE B%=FNse3 1770IF B% N%=C%?n% ELSE R%=RND(?C%):N%= C%?R% 1780ENDPROC 1790: 1800DEF PROCevaluate 1810FOR I%=0 TO 1:n%=FNn(V%(I%)):v%(I%) =W%?n%:NEXT 1820IF ps%=cs% IF v%(0)>v%(1) G%=0:U%=T RUE:GOTO1870 1830IF ps%=cs% IF v%(0)<v%(1) G%=1:U%=F ALSE:GOTO1870 1840IF ps%=T% G%=0:U%=TRUE:GOTO1870 1850IF cs%=T% G%=1:U%=FALSE:GOTO1870 1860IF ps%<>cs% IF G%=0 U%=TRUE ELSE U% =FALSE 1870sum%=v%(0)+v%(1):CLS:COLOUR1:t%(G%) =t%(G%)+1:COLOUR3:IF U% p%(0)=p%(0)+sum% :PRINT"Your"; ELSE p%(1)=p%(1)+sum%:PRIN T"My"; 1880PRINT" trick":PROCwait:ENDPROC 1890: 1900DEF PROChand 1910GCOL0,130:PROCwindow(4):CLG:IF ?P%= 0 ENDPROC 1920FOR I%=1 TO ?P%:X%=I%*192-128:Y%=44 7:PROCdisplay(P%?I%) 1930NEXT:ENDPROC 1940: 1950DEF PROCdisplay(Z%) 1960S%=FNs(Z%):K%=FNn(Z%):!&78=&3000+X% DIV2+&280*(1023-Y%)DIV32:CALL &998 1970GCOL0,S%MOD2:VDU5:MOVE X%+8-4*(K%=2 ),Y%-12:PRINTMID$(num$,K%,1):MOVE X%+8,Y %-44:VDU(223+S%):IF K%=1 PROCace(236+S%* 4) ELSE IF K%>2 AND K%<6 PROCface(&B00+( K%-3)*72) ELSE PROCpip 1980VDU4:ENDPROC 1990: 2000DEF PROCpack 2010X%=896:Y%=767:PROCwindow(3):PROCdis play(tr%) 2020!&78=&45D8:CALL&998:GCOL0,0:PLOT69, 944,767:PLOT69,944,547 2030GCOL0,1:VDU5:FOR Y%=747 TO 567 STEP -32:MOVE 964,Y%:PRINTSTRING$(5,CHR$229): NEXT:VDU4 2040ENDPROC 2050: 2060DEF PROCtable(N%) 2070PROCwindow(2):SOUND0,-10,5,2 2080Y%=767:IF L% X%=256 ELSE X%=448 2090PROCdisplay(N%) 2100ENDPROC 2110: 2120DEF PROCdelete 2130FORI%=1TO ?H%:IF H%?I%=N% Q%=I%:I%= ?H% 2140NEXT:FORI%=Q%TO ?H%-1:H%?I%=H%?(I%+ 1):NEXT 2150H%?(?H%)=0:?H%=?H%-1 2160IF ph%=2 OR H%=C% ENDPROC 2170GCOL0,2:PROCwindow(4):Y%=447 2180X%=Q%*192-128:MOVE X%,Y%:MOVEX%+180 ,Y%:PLOT85,X%,Y%-224:PLOT85,X%+180,Y%-22 4 2190ENDPROC 2200: 2210DEF PROCgetcards 2220IF U% PROCget(P%):PROChand:PROCget( C%):ENDPROC 2230PROCget(C%):PROCget(P%):PROChand 2240ENDPROC 2250: 2260DEF PROCget(H%) 2270?H%=?H%+1 2280H%?(?H%)=A%?po%:po%=po%+1 2290PROCsort(?H%):ENDPROC 2300: 2310DEF PROCsort(D%):IF D%<2 ENDPROC 2320LOCAL B%:FOR J%=1TOD%-1:Z%=J% 2330FOR I%=Z%+1 TO D% 2340IF H%?Z%>H%?I% Z%=I% 2350NEXT 2360B%=H%?J%:H%?J%=H%?Z%:H%?Z%=B% 2370NEXT:ENDPROC 2380: 2390DEF PROCcheck 2400IF ps%=cs% ENDPROC 2410F%=FALSE:FOR I%=1 TO ?P%:Q%=I%?P%:s %=FNs(Q%) 2420IF s%=cs% F%=TRUE:I%=?P% 2430NEXT:IF F% ch%=FALSE:PROCbad:ENDPRO C 2440IF ps%=T% ENDPROC 2450FOR I%=1 TO ?P%:Q%=I%?P%:s%=FNs(Q%) 2460IF s%=T% F%=TRUE:I%=?P% 2470NEXT:IF F% ch%=FALSE:PROCbad:ENDPRO C 2480ENDPROC 2490: 2500DEF PROCchange 2510IF G%=0 n%=M% 2520Q%=H%?n%:H%?n%=A%?24:A%?24=Q%:tr%=Q % 2530PROCpack:PROCsort(?H%):IF G%=0 PROC hand 2540CLS:COLOUR1:PRINT"Exchange":SOUND1, 1,120,4:SOUND1,1,100,4:PROCwait 2550ENDPROC 2560: 2570DEF PROCmarriage 2580IF G%=0 COLOUR3:PRINT'"Pair ? ";:RE PEAT:G$=GET$:UNTILINSTR("YyNn",G$):PRINT G$:COLOUR1:IF INSTR("Nn",G$) ENDPROC 2590IF G%=0 AND M%>1 AND P%?(M%-1)=N%-1 ms%=ps% ELSE IF G%=0 SOUND1,2,76,8:COLO UR2:PRINT'"Don't cheat":PROCwait:ENDPROC 2600IF G%=1 CLS:COLOUR1:PRINT"Pair" 2610IF ms%=T% bo%=40 ELSE bo%=20 2620p%(G%)=p%(G%)+bo%:PRINT'"Bonus: ";b o%;:SOUND1,1,120,4:SOUND1,1,100,4:PROCwa it 2630ENDPROC 2640: 2650DEF PROCnine 2660F%=FALSE:FOR I%=1 TO ?C%:Q%=C%?I%:I F T%=FNs(Q%) AND FNn(Q%)=6 F%=TRUE:n%=I% :I%=?C% 2670NEXT:ENDPROC 2680: 2690DEF PROCpair 2700F%=FALSE:a%=FNn(H%?1):b%=FNs(H%?1) 2710FOR I%=2 TO ?H%:c%=FNn(H%?I%):d%=FN s(H%?I%) 2720IF c%=4 AND a%=3 AND d%=b% F%=TRUE: n%=I%:ms%=d% 2730a%=c%:b%=d%:NEXT 2740IF NOT F% ENDPROC 2750N%=C%?n% 2760PROCmarriage 2770ENDPROC 2780: 2790DEF FNs(K%)=(K%-1)DIV6+1 2800DEF FNn(K%)=(K%-1)MOD6+1 2810: 2820DEF FNse1 2830F%=FALSE:FOR I%=1 TO ?C%:PROCval 2840IF v%>4 AND NOT(s%=T%) F%=TRUE:n%=I % 2850NEXT:IF F% THEN=n% 2860FOR I%=1 TO ?C%:PROCval 2870IF v%<3 AND NOT(s%=T%) F%=TRUE:n%=I % 2880NEXT:IF F% THEN=n% 2890FOR I%=1 TO ?C%:PROCval 2900IF (v%=5 OR v%<3) AND s%=T% F%=TRUE :n%=I% 2910NEXT:IF F% THEN=n% ELSE =0 2920: 2930DEF FNse2 2940F%=FALSE:FOR I%=1 TO ?C%:PROCval 2950IF s%=ps% AND pv%=4 AND v%<4 F%=TRU E:n%=I% 2960NEXT:IF F% THEN=n% 2970FOR I%=1 TO ?C%:PROCval 2980IF s%=ps% AND v%<pv% AND v%<3 F%=TR UE:n%=I% 2990NEXT:IF F% THEN=n% 3000FOR I%=1 TO ?C%:PROCval 3010IF s%=T% AND NOT(ps%=T%) AND pv%<4 AND (v%<3 OR v%=5) F%=TRUE:n%=I% 3020NEXT:IF F% THEN=n% 3030FOR I%=1 TO ?C%:PROCval 3040IF NOT(s%=T%) AND v%>4 F%=TRUE:n%=I % 3050NEXT:IF F% THEN=n% 3060=0 3070: 3080DEF FNse3 3090F%=FALSE:FOR I%=1 TO ?C%:PROCval 3100IF s%=ps% AND v%<pv% F%=TRUE:n%=I% 3110NEXT:IF F% THEN=n% 3120O%=0:FOR I%=1 TO ?C%:PROCval 3130IF s%=ps% AND v%>O%:O%=v%:n%=I% 3140NEXT:IF O%>0 F%=TRUE:=n% 3150O%=0:FOR I%=1 TO ?C%:PROCval 3160IF s%=T% AND v%>O%:O%=v%:n%=I% 3170NEXT:IF O%>0 F%=TRUE:=n% 3180O%=0:FOR I%=1 TO ?C%:PROCval 3190IF v%>O%:O%=v%:n%=I% 3200NEXT:IF O%>0 F%=TRUE:=n% 3210=0 3220: 3230DEF PROCval 3240Q%=C%?I%:v%=FNn(Q%):s%=FNs(Q%) 3250ENDPROC 3260: 3270DEF PROCscore 3280p%=p%(0):c%=p%(1):CLS:COLOUR1:IF M% =0 CLS:COLOUR1:PRINT"Sixty Six"':COLOUR3 :w%=G%:PROCadd(G%):GOTO3330 3290COLOUR3:IF (p%<66 AND c%<66) OR p%= c% PRINT"No one wins":PROCwait:ENDPROC 3300IF p%>c% AND p%>66 w%=0 3310IF c%>p% AND c%>66 w%=1 3320IF p%>c% PROCadd(0) ELSE PROCadd(1) 3330IF c%<2 PROCadd(0) ELSE IF p%<2 PRO Cadd(1) 3340IF c%<33 PROCadd(0) ELSE IF p%<33 P ROCadd(1) 3350IF w% PRINT" I win"; ELSE PRINT" Y ou win"; 3360G%=(w%+1)MOD2:COLOUR129:VDU28,30,6, 38,3:CLS 3370COLOUR0:PRINT;p%;TAB(0,2);c%; 3380COLOUR3:PRINTTAB(6,0);r%(0);TAB(6,2 );r%(1);:COLOUR128 3390PROCtune:IF r%(0)>7 OR r%(1)>7 end% =TRUE 3400ENDPROC 3410: 3420DEF PROCadd(Z%) 3430r%(Z%)=r%(Z%)+1 3440ENDPROC 3450: 3460DEF PROCwindow(Z%) 3470IF Z%=1:VDU17,128,28,15,30,38,28,12 3480IF Z%=2:VDU24,8;515;768;791; 3490IF Z%=3:VDU24,768;515;1268;791; 3500IF Z%=4:VDU24,8;212;1268;451; 3510IF Z%=5:VDU24,880;451;1260;511;16 3520ENDPROC 3530: 3540DEF PROCbad:SOUND1,2,76,8:COLOUR1:P RINT'"Illegal" 3550DEF PROCwait 3560de%=INKEY200:ENDPROC 3570: 3580DEF PROCtune 3590RESTORE:FORI%=1TO24:READ pi%,du%:SO UND1,1,pi%,du%:NEXT:PROCwait 3600DATA 100,4,100,4,96,4,88,4,88,4,80, 4,100,8,100,4,96,4,108,8,108,4,100,4,116 ,8,100,4,100,4,96,4,88,4,88,4,80,4,100,8 ,100,4,96,4,108,8,100,8 3610ENDPROC 3620: 3630DEF PROCend 3640PROCwindow(1):COLOUR1:PRINT"GAME OV ER":COLOUR2:PRINT'" Again ?";:G$=GET$:IF INSTR("Yy",G$) RUN 3650ENDPROC 3660: 3670DEF PROCpip 3680FOR y%=Y%-20 TO Y%-164 STEP-48:FOR x%=X%+56 TO X%+120 STEP64 3690MOVE x%,y%:VDU(223+S%):NEXT, 3700IF K%=6 MOVE X%+88,Y%-92:VDU(223+S% ):ENDPROC 3710MOVE X%+88,Y%-44:VDU(223+S%):MOVE X %+88,Y%-140:VDU(223+S%) 3720ENDPROC 3730: 3740DEF PROCface(A%) 3750!&70=A%:!&72=X%+44:!&74=Y%-56:CALL& 938 3760ENDPROC 3770: 3780DEF PROCace(n%) 3790MOVE X%+60,Y%-80:VDUn%,n%+1,8,8,10, n%+2,n%+3 3800ENDPROC