10REM 35 Card Clearence 20REM by Carl Wheat 30REM (c) Carl Wheat 40: 50MODE1:VDU23;8202;0;0;0;:*FX4,1 60VDU5,19,2,2,0,0,0:GCOL0,130 70BJ=&1100:RJ=&111B:GJ=&1130 80BQ=&113B:RQ=&114A:GQ=&1169 90BK=&1184:RK=&1199:GK=&11AC 100P=&11B3:P$=$P:A$=CHR$224 110C$=CHR$240:D$=CHR$241 120H$=CHR$242:S$=CHR$243 130L$=CHR$8:X$=CHR$9 140Y$=CHR$10:U$=CHR$11 150DIM P%(53),F%(8),T%(8,20) 160: 170REPEAT:PROCsetup 180REPEAT:REPEAT:K%=GET 190IF K%=44 OR K%=46 PROCmove 200UNTIL K%=90 OR K%=32 OR K%=27 210IF K%=90 PROCstack 220IF K%=32 PROCturnover 230*FX21,0 240UNTIL K%=27 OR E%=52:GCOL0,0 250IF E%<>52 CLG ELSE MOVE250,600:PRIN T"You have finished it." 260MOVE150,500:PRINT"Do you want anoth er go? Y/N":K$=GET$ 270UNTIL K$="N" OR K$="n":*FX4,0 280MODE7:END 290: 300DEFPROCmove:PROCarrow(2) 310IFK%=44 A%=A%-172:IFA%<20 A%=1120 320IFK%=46 A%=A%+172:IFA%>1120 A%=88 330PROCarrow(0):ENDPROC 340: 350DEFPROCarrow(C%):MOVE A%,35 360GCOL0,C%:PRINT A$:ENDPROC 370: 380DEFPROCsuit(C%) 390S%=C% DIV 13:N%=C% MOD 13 400IF N%=0 N%=13:S%=S%-1 410N$=STR$(N%) 420IF N$="1" N$="A" 430IF N$="11" N$="J" 440IF N$="12" N$="Q" 450IF N$="13" N$="K" 460IF S%=0 F$=H$:L%=1 470IF S%=1 F$=S$:L%=0 480IF S%=2 F$=D$:L%=1 490IF S%=3 F$=C$:L%=0 500ENDPROC 510: 520DEFPROCblank(C%):GCOL0,C% 530PLOT0,132,0:PLOT81,0,180 540PLOT81,-132,-180:PLOT81,0,180 550IF C%=2 ENDPROC 560GCOL0,0:PLOT1,132,0:PLOT1,0,-180 570PLOT1,-132,0:PLOT1,0,180:ENDPROC 580: 590DEFPROCback 600PROCblank(3):GCOL0,1 610PLOT0,20,-12:PRINT P$:ENDPROC 620: 630DEFPROCfront:PROCblank(3) 640GCOL0,L%:PLOT0,8,-8:PRINT N$+F$; 650IF N%=1 PROCace 660IF N%=2 PROCtwo 670IF N%=3 PROCthree 680IF N%=4 PROCfour 690IF N%=5 PROCfive 700IF N%=6 PROCsix 710IF N%=7 PROCseven 720IF N%=8 PROCeight 730IF N%=9 PROCnine 740IF N%=10 PROCten 750IF N%=11 PROCjack 760IF N%=12 PROCqueen 770IF N%=13 PROCking 780ENDPROC 790: 800DEFPROCturnover 810IF H%=0 ENDPROC 820PROCsuit(P%(H%)) 830MOVE 650,800:PROCfront 840F%=P%(H%):H%=H%-1 850IF H%=0 PROCcomment 860ENDPROC 870: 880DEFPROCcomment 890MOVE 450,800:PROCblank(2):GCOL0,0 900MOVE 200,960:PRINT"No more cards." 910MOVE 200,900:PRINT"Press ESCAPE" 920MOVE 200,840:PRINT"to re-deal." 930ENDPROC 940: 950DEFPROCstack 960M%=0:X%=FNc:Y%=F%(X%) 970IF Y%=0 ENDPROC 980PROCsuit(F%):P%=N% 990PROCsuit(T%(X%,Y%)) 1000IF P%-N%=1 OR N%-P%=1 OR N%-P%=12 O R P%-N%=12 M%=1 1010IF M%=0 ENDPROC 1020MOVE 650,800:PROCfront 1030F%=T%(X%,Y%):E%=E%+1 1040MOVE FNx,FNy:PROCblank(2) 1050F%(X%)=F%(X%)-1:Y%=F%(X%) 1060IF Y%=0 ENDPROC 1070PROCsuit(T%(X%,Y%)) 1080MOVE FNx,FNy:PROCfront 1090ENDPROC 1100: 1110DEFFNc=(A%+150) DIV 170 1120DEFFNx=X%*170-120 1130DEFFNy=600-(Y%*60) 1140: 1150DEFPROCsetup:GCOL0,130:*FX229,1 1160CLG:GCOL0,0:MOVE300,550 1170PRINT"SHUFFLING THE CARDS" 1180FOR I%=1TO52:P%(I%)=I%:NEXT I% 1190Z%=RND(-TIME):H%=18 1200FOR Z%=1TO100:J%=RND(52) 1210REPEAT:I%=RND(52):UNTIL I%<>J% 1220N%=P%(J%):P%(J%)=P%(I%) 1230P%(I%)=N%:NEXT Z% 1240FOR J%=1TO5:FOR I%=1TO7 1250T%(I%,J%)=P%(H%):H%=H%+1 1260NEXT I%,J%:CLG 1270FOR X%=15TO1205 STEP 170 1280MOVE X%,22:PRINT".":NEXT X% 1290FOR Y%=1TO5:FOR X%=1TO7 1300PROCsuit(T%(X%,Y%)) 1310MOVE FNx,FNy:PROCfront 1320NEXT X%:NEXT Y% 1330FORX%=1TO7:F%(X%)=5:NEXT X% 1340MOVE 450,800:PROCback 1350H%=17:E%=17:PROCturnover 1360A%=100:PROCarrow(0) 1370ENDPROC 1380: 1390DEFPROCace:PLOT0,-20,-72 1400PRINT F$:ENDPROC 1410DEFPROCtwo:PLOT0,-20,-108 1420PRINT F$+L$+U$+U$+F$:ENDPROC 1430DEFPROCthree:PLOT0,-20,-108 1440PRINT F$+L$+U$+F$+L$+U$+F$:ENDPROC 1450DEFPROCfour:PLOT0,-52,-120 1460PRINT F$+X$+F$+STRING$(3,L$)+U$+U$+ F$+X$+F$;:ENDPROC 1470DEFPROCfive:PROCfour 1480PRINT L$+L$+Y$+F$:ENDPROC 1490DEFPROCsix:PROCfour 1500PRINT STRING$(3,CHR$8)+Y$+F$+X$+F$; :ENDPROC 1510DEFPROCseven:PROCsix 1520PLOT0,-64,16:PRINT F$;:ENDPROC 1530DEFPROCeight:PROCseven 1540PRINT L$+Y$+F$:ENDPROC 1550DEFPROCnine:PLOT0,-52,-132 1560B$=F$+X$+F$+STRING$(3,L$)+U$:PRINT STRING$(4,B$); 1570PLOT0,32,-80:PRINT F$:ENDPROC 1580DEFPROCten:PLOT0,-84,-132 1590B$=F$+X$+F$+STRING$(3,L$)+U$:PRINT STRING$(4,B$); 1600PLOT0,32,-112:PRINT F$+L$+U$+U$+F$: ENDPROC 1610: 1620DEFPROCjack 1630B$=$BJ:R$=$RJ:G$=$GJ 1640PROCpicture:ENDPROC 1650DEFPROCqueen 1660B$=$BQ:R$=$RQ:G$=$GQ 1670PROCpicture:ENDPROC 1680DEFPROCking 1690B$=$BK:R$=$RK:G$=$GK 1700PROCpicture:ENDPROC 1710: 1720DEFPROCpicture 1730PLOT0,-68,-136 1740GCOL0,0:PRINT B$; 1750GCOL0,1:PRINT R$; 1760GCOL0,2:PRINT G$ 1770ENDPROC