10REM Thousand 3.05 20REM by M.Bobrowski 5'94 30: 40PROCinit 50REPEAT:PROCreset 60PROCshuffle:PROCdeal 70PROCgame:PROCscore 80UNTIL end%:PROCend 90MODE 131:END 100: 110DEF PROCinit:DIM V%(1),v%(1),t%(1), p%(1),q%(4) 120G%=RND(2)-1:w%=G%:end%=FALSE:t%(0)= 0:t%(1)=0:Z$="000":num$="A"+CHR$228+"KQJ 9":COLOUR131:COLOUR1:VDU28,29,5,38,3:CLS :PRINT" 0"SPC5"0"''" 0"SPC5"0";:ENDPROC 130DEF PROCreset 140GCOL0,130:PROCwindow(6):COLOUR3:PRI NT'"No Trumps":PROCwindow(1):FORI%=2TO5: PROCwindow(I%):CLG:q%(I%-1)=0:NEXT:p%(0) =0:p%(1)=0:R%=RND(-TIME):M%=7:E%=FALSE:m s%=0:r%=0:ENDPROC 150DEF PROCshuffle 160FOR I%=1 TO 24:A%?I%=I%:NEXT 170FOR I%=1 TO 24:R%=RND(24):J%=A%?R% 180A%?R%=A%?I%:A%?I%=J%:NEXT:ENDPROC 190DEF PROCdeal 200FORI%=1TO6:P%?I%=A%?I%:NEXT:?P%=6:H %=P%:PROCsort(6) 210FORI%=1TO6:C%?I%=A%?(I%+6):NEXT:?C% =6:H%=C%:PROCsort(6) 220T%=0:po%=13:ENDPROC 230DEF PROCgame 240PROChand:PROCpack 250ph%=1:REPEAT:PROCwindow(2):CLG:PROC window(5):GCOL0,0:VDU5:IF po%>15 X%=928 ELSE X%=912 260MOVE X%,511:PRINT"Pack:";STR$(25-po %):VDU4 270PROCwindow(1):PROCmove:PROCgetcards 280UNTIL po%=25:PROCwindow(5):PROCwind ow(3):CLG:GCOL0,3:VDU5:MOVE 1008,700:PRI NT"Pack":GCOL0,1:MOVE 992,620:PRINT"Empt y":VDU4:PROCwindow(1) 290ph%=2:REPEAT:PROCwindow(2):CLG:PROC move 300UNTIL (?C%=0 AND ?P%=0) OR M%=0:END PROC 310DEF PROCmove 320FOR ro%=1 TO 2:IF G% H%=C% ELSE H%= P% 330IF ro%=1 L%=TRUE ELSE L%=FALSE 340PROCgo(G%):V%(G%)=N% 350PROCtable(N%):PROCdelete:IF E% PROC bonus 360IF ph%=2 AND G%=0 PROChand 370G%=(G%+1)MOD 2:NEXT 380PROCevaluate:ENDPROC 390DEF PROCgo(G%) 400IF G% PROCcompgo:ENDPROC 410IF ?P%=1 N%=P%?1:ps%=FNs(N%):ENDPRO C 420REPEAT 430CLS:IF L% COLOUR1 ELSE COLOUR2 440PRINT"Your go":COLOUR2:SOUND1,4,200 ,10 450REPEAT:M%=GET-48:UNTIL M%>0 AND M%< =?P% 460N%=P%?M%:pv%=FNn(N%):ps%=FNs(N%) 470ch%=TRUE:IF NOT L% PROCcheck 480UNTIL ch% 490IF L% AND po%>14 AND pv%=4 PROCmarr iage 500ENDPROC 510DEF PROCcompgo 520IF L% PROCcompgo1 ELSE PROCcompgo2 530PROCwait:cs%=FNs(N%):ENDPROC 540DEF PROCcompgo1 550CLS:COLOUR1:PRINT"My go":COLOUR2 560IF ?C%=1 N%=C%?1:ENDPROC 570IF po%>14 PROCpair:IF E% ENDPROC 580IF T%=0 OR r%=0 B%=FNse1 ELSE B%=FN se2 590IF B% N%=C%?n% ELSE R%=RND(?C%):N%= C%?R% 600ENDPROC 610DEF PROCcompgo2 620CLS:COLOUR2:PRINT"My go":IF ?C%=1 N %=C%?1:ENDPROC 630IF ph%=1 B%=FNse3 ELSE B%=FNse4 640IF B% N%=C%?n% ELSE R%=RND(?C%):N%= C%?R% 650ENDPROC 660DEF PROCevaluate 670FOR I%=0 TO 1:n%=FNn(V%(I%)):v%(I%) =W%?n%:NEXT:q%(ps%)=q%(ps%)+1:q%(cs%)=q% (cs%)+1 680IF ps%=cs% IF v%(0)>v%(1) G%=0:U%=T RUE:GOTO730 690IF ps%=cs% IF v%(0)<v%(1) G%=1:U%=F ALSE:GOTO730 700IF ps%=T% G%=0:U%=TRUE:GOTO730 710IF cs%=T% G%=1:U%=FALSE:GOTO730 720IF ps%<>cs% IF G%=0 U%=TRUE ELSE U% =FALSE 730sum%=v%(0)+v%(1):CLS:COLOUR1:IF U% p%(0)=p%(0)+sum%:PRINT"Your"; ELSE p%(1) =p%(1)+sum%:PRINT"My"; 740PRINT" trick":PROCwait 750IF ps%=T% r%=r%+1 760IF cs%=T% r%=r%+1 770IF r%=6 r%=0 780ENDPROC 790DEF PROChand 800GCOL0,130:PROCwindow(4):CLG:IF ?P%= 0 ENDPROC 810FOR I%=1 TO ?P%:X%=I%*192-128:Y%=44 7:PROCdisplay(P%?I%):NEXT:ENDPROC 820DEF PROCdisplay(Z%) 830S%=FNs(Z%):K%=FNn(Z%):!&78=&3000+X% DIV2+&280*(1023-Y%)DIV32:CALL &998 840GCOL0,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 850VDU4:ENDPROC 860DEF PROCpack 870PROCwindow(3):X%=928:Y%=767:GCOL0,3 :MOVEX%+4,Y%-4:MOVEX%+176,Y%-4:PLOT85,X% +4,Y%-216:PLOT85,X%+176,Y%-216:GCOL0,0:M OVEX%,Y%:PLOT45,X%+180,Y%:PLOT45,X%+180, Y%-220:PLOT45,X%,Y%-220:PLOT45,X%,Y% 880GCOL0,0:PLOT69,X%+4,Y%-216:PLOT69,X %+4,Y%-4:PLOT69,X%+176,Y%-4:PLOT69,X%+17 6,Y%-216:GCOL0,1:VDU5:FOR Y%=747 TO 567 STEP-32:MOVE 948,Y%:PRINTSTRING$(5,CHR$2 29):NEXT:VDU4:ENDPROC 890DEF PROCtable(N%) 900PROCwindow(2):SOUND0,-10,5,2:Y%=767 :IF G% X%=448 ELSE X%=256 910PROCdisplay(N%):ENDPROC 920DEF PROCdelete 930FORI%=1TO ?H%:IF H%?I%=N% Q%=I%:I%= ?H% 940NEXT:FORI%=Q%TO ?H%-1:H%?I%=H%?(I%+ 1):NEXT 950H%?(?H%)=0:?H%=?H%-1:IF G% ENDPROC 960GCOL0,2:PROCwindow(4):Y%=447:X%=Q%* 192-128:MOVE X%,Y%:MOVEX%+180,Y%:PLOT85, X%,Y%-224:PLOT85,X%+180,Y%-224:ENDPROC 970DEF PROCgetcards 980IF U% PROCget(P%):PROChand:PROCget( C%):ENDPROC 990PROCget(C%):PROCget(P%):PROChand:EN DPROC 1000DEF PROCget(H%) 1010?H%=?H%+1:H%?(?H%)=A%?po%:po%=po%+1 :PROCsort(?H%):ENDPROC 1020DEF PROCsort(D%):IF D%<2 ENDPROC 1030LOCAL B%:FOR J%=1TOD%-1:Z%=J% 1040FOR I%=Z%+1 TO D%:IF H%?Z%>H%?I% Z% =I% 1050NEXT:B%=H%?J%:H%?J%=H%?Z%:H%?Z%=B% 1060NEXT:ENDPROC 1070DEF PROCcheck 1080IF ps%=cs% ENDPROC 1090F%=FALSE:FOR I%=1 TO ?P%:Q%=I%?P%:s %=FNs(Q%):IF s%=cs% F%=TRUE:I%=?P% 1100NEXT:IF F% ch%=FALSE:PROCbad:ENDPRO C 1110IF ps%=T% ENDPROC 1120FOR I%=1 TO ?P%:Q%=I%?P%:s%=FNs(Q%) :IF s%=T% F%=TRUE:I%=?P% 1130NEXT:IF F% ch%=FALSE:PROCbad:ENDPRO C 1140ENDPROC 1150DEF PROCmarriage 1160SOUND1,4,200,10:COLOUR3:PRINT'"Pair ? ";:REPEAT:G$=GET$:UNTILINSTR("YyNn",G $):PRINTG$:COLOUR1:IF INSTR("Nn",G$) END PROC 1170IF M%>1 AND P%?(M%-1)=N%-1 ms%=ps%: E%=TRUE ELSE SOUND1,2,76,8:COLOUR2:PRINT '"Don't cheat":PROCwait 1180ENDPROC 1190DEF PROCpair 1200E%=FALSE:a%=FNn(H%?1):b%=FNs(H%?1) 1210FOR I%=2 TO ?H%:c%=FNn(H%?I%):d%=FN s(H%?I%) 1220IF c%=4 AND a%=3 AND d%=b% E%=TRUE: n%=I%:ms%=d% 1230a%=c%:b%=d%:NEXT 1240IF NOT E% ENDPROC 1250N%=C%?n%:PROCbell:COLOUR1:PRINT'"Pa ir":ENDPROC 1260DEF PROCbonus 1270T%=ms%:r%=q%(T%):PROCwindow(6):COLO UR3:PRINT"Trumps:"':COLOUR2:IF T%=1 PRIN T"Hearts";:bo%=100 ELSE IF T%=2 PRINT"Sp ades";:bo%=40 ELSE IF T%=3 PRINT"Diamond s";:bo%=80 ELSE IF T%=4 PRINT"Clubs";:bo %=60 1280PROCwindow(1):COLOUR1:p%(G%)=p%(G%) +bo%:PRINT'"Bonus: ";bo%;:PROCbell:E%=FA LSE:ENDPROC 1290DEF FNs(K%)=(K%-1)DIV6+1 1300DEF FNn(K%)=(K%-1)MOD6+1 1310DEF PROCval:Q%=C%?I%:v%=FNn(Q%):s%= FNs(Q%):ENDPROC 1320DEF FNse1 1330F%=FALSE:FOR I%=1 TO ?C%:PROCval:IF v%=1 F%=TRUE:n%=I%:I%=?C% 1340NEXT:IF F%:=n% 1350FOR I%=1 TO ?C%:PROCval:IF v%>4 F%= TRUE:n%=I% 1360NEXT:IF F%:=n% 1370FOR I%=1 TO ?C%:PROCval:IF v%=2 F%= TRUE:n%=I% 1380NEXT:IF F% THEN =n% ELSE =0 1390DEF FNse2 1400F%=FALSE:FOR I%=1 TO ?C%:PROCval:IF s%=T% F%=TRUE:n%=I% 1410NEXT:IF F%:=n% 1420FOR I%=1 TO ?C%:PROCval:IF v%>4 F%= TRUE:n%=I% 1430NEXT:IF F%:=n% 1440FOR I%=1 TO ?C%:PROCval:IF v%<3 F%= TRUE:n%=I% 1450NEXT:IF F% THEN =n% ELSE =0 1460DEF FNse3 1470F%=FALSE:FOR I%=1 TO ?C%:PROCval:IF s%=ps% AND pv%=4 AND v%<4 F%=TRUE:n%=I% 1480NEXT:IF F%:=n% 1490FOR I%=1 TO ?C%:PROCval:IF s%=ps% A ND v%<pv% AND v%<3 F%=TRUE:n%=I% 1500NEXT:IF F%:=n% 1510O%=0:FOR I%=1 TO ?C%:PROCval:IF s%= ps% AND v%>O%:O%=v%:n%=I% 1520NEXT:IF O%>0 F%=TRUE:=n% 1530O%=0:FOR I%=1 TO ?C%:PROCval:IF s%= T% AND v%>O%:O%=v%:n%=I% 1540NEXT:IF O%>0 F%=TRUE:=n% 1550FOR I%=1 TO ?C%:PROCval:IF v%>4 F%= TRUE:n%=I% 1560NEXT:IF F%:=n% 1570FOR I%=1 TO ?C%:PROCval:IF v%=2 F%= TRUE:n%=I% 1580NEXT:IF F%:=n% 1590FOR I%=1 TO ?C%:PROCval:IF v%=1 F%= TRUE:n%=I% 1600NEXT:IF F% THEN =n% ELSE =0 1610DEF FNse4 1620F%=FALSE:FOR I%=1 TO ?C%:PROCval:IF s%=ps% AND v%<pv% AND (v%<3 OR v%=5) F% =TRUE:n%=I% 1630NEXT:IF F%:=n% 1640O%=0:FOR I%=1 TO ?C%:PROCval:IF s%= ps% AND v%>O%:O%=v%:n%=I% 1650NEXT:IF O%>0 F%=TRUE:=n% 1660O%=0:FOR I%=1 TO ?C%:PROCval:IF s%= T% AND v%>O%:O%=v%:n%=I% 1670NEXT:IF O%>0 F%=TRUE:=n% 1680O%=0:FOR I%=1 TO ?C%:PROCval:IF v%> O%:O%=v%:n%=I% 1690NEXT:IF O%>0 F%=TRUE:=n% ELSE =0 1700DEF PROCscore 1710p%=p%(0):c%=p%(1):CLS:COLOUR1:IF p% >c% PRINT'" You win":w%=0 1720IF p%<c% PRINT'" I win";:w%=1 ELSE IF p%=c% PRINT'" Draw"; 1730FOR I%=0TO1:t%(I%)=t%(I%)+p%(I%):NE XT 1740G%=(w%+1)MOD2:COLOUR131:VDU28,29,5, 38,3 1750COLOUR1:PRINTRIGHT$(Z$+STR$p%,3)TAB (0,2)RIGHT$(Z$+STR$c%,3)TAB(6,0);RIGHT$( Z$+STR$t%(0),3)TAB(6,2)RIGHT$(Z$+STR$t%( 1),3);:IF t%(0)>999 OR t%(1)>999 PRINTTA B(5,0)RIGHT$(" "+STR$t%(0),4)TAB(5,2)RIG HT$(" "+STR$t%(1),4); 1760PROCtune:IF t%(0)>999 OR t%(1)>999 end%=TRUE 1770ENDPROC 1780DEF PROCwindow(Z%) 1790IF Z%=1:VDU17,128,28,2,30,27,28,12 1800IF Z%=2:VDU24,8;515;768;791; 1810IF Z%=3:VDU24,768;515;1268;791; 1820IF Z%=4:VDU24,8;212;1268;451; 1830IF Z%=5:VDU24,880;451;1260;511;16 1840IF Z%=6:VDU17,128,28,28,30,38,28,12 1850ENDPROC 1860DEF PROCbad:SOUND1,2,76,8:COLOUR1:P RINT'"Illegal" 1870DEF PROCwait 1880de%=INKEY200:ENDPROC 1890DEF PROCtune 1900RESTORE:FORI%=1TO25:READ pi%,du%:IF pi% SOUND1,1,pi%,du% ELSE SOUND1,0,0,du % 1910NEXT:PROCwait 1920DATA 144,8,136,8,128,8,136,8,0,2,14 4,4,144,2,136,4,136,4,128,4,136,4,144,8, 164,4,164,4,144,8,164,4,164,4,144,8,144, 4,128,4,136,4,144,4,136,4,128,2,116,6 1930ENDPROC 1940DEF PROCbell 1950SOUND1,1,120,4:SOUND1,1,100,4:PROCw ait:ENDPROC 1960DEF PROCend 1970PROCwindow(6):PROCwindow(1):COLOUR1 :PRINTTAB(13)"GAME OVER":PROCtune:COLOUR 2:PRINT'TAB(14)"Again ?";:G$=GET$:IF INS TR("Yy",G$) RUN 1980ENDPROC 1990DEF PROCpip 2000FOR y%=Y%-20 TO Y%-164 STEP-48:FOR x%=X%+56 TO X%+120 STEP64 2010MOVE x%,y%:VDU(223+S%):NEXT,:IF K%= 6 MOVE X%+88,Y%-92:VDU(223+S%):ENDPROC 2020MOVE X%+88,Y%-44:VDU(223+S%):MOVE X %+88,Y%-140:VDU(223+S%):ENDPROC 2030DEF PROCface(A%) 2040!&70=A%:!&72=X%+44:!&74=Y%-56:CALL& 938:ENDPROC 2050DEF PROCace(n%) 2060MOVE X%+60,Y%-80:VDU n%,n%+1,8,8,10 ,n%+2,n%+3:ENDPROC 2070