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