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