10 REM CODECATCHER
   20 REM BY IAN FELL
   30 REM (C) THE MICRO USER
   40 MODE7
   50 ON ERROR MODE7:REPORT:PRINT" at ";ERL:END
   60 master=(INKEY-256=253)
   70 IF master PROCinit_shadow
   80 CLS:PRINT:PRINT:PRINT
   90 PROCsetup
  100 PROCchoice
  110 DIM cnt%26, store%(26,2)
  120 FOR A%=0 TO 26:cnt%?A%=0:NEXT
  130 VDU28,0,23,39,1:CLS
  140 PROCdisplay
  150 PROCletcount
  160 PROCbubble
  170 RESTORE 1960
  180 FOR D%=1 TO 26:READ a$
  190 store%(D%,2)=ASCa$:NEXT
  200 PROCreplace
  210 PROCguess
  220 REPEAT:PROCalter
  230 PROCturnabout:UNTIL FALSE:END
  240 DEFPROCsetup
  250 A%=0:B%=0:C%=0:D%=0:F%=0:G%=0:I%=0
  260 J%=0:L%=0:P%=0:Q%=0:T%=0:U%=0:V%=0
  270 W%=0:X%=0:Y%=0:C1%=0:C2%=0
  280 flag%=0:lp1%=0:lp2%=0:recl%=0
  290 temp%=0:G$="":T$="":temp$=""
  300 col$="":record$="":alph$=""
  310 ENDPROC
  320 DEFPROCchoice
  330 PROCmenu
  340 IF G%=1 PROCinput:ENDPROC
  350 IF G%=2 PROCunstore:ENDPROC
  360 IF G%=3 VDU26:CLS:GOTO361
  361 *EXEC !BOOT
  370 ENDPROC
  380 DEFPROCmenu
  390 PROCscreen("CodeCatcher",2,3)
  400 REPEAT:CLS:PRINT'
  410 PRINT'CHR$134SPC5"1. Type data"
  420 PRINT'CHR$134SPC5"2. Read file"
  430 PRINT'CHR$134SPC5"3. Quit"
  440 G%=FNgetchoice(3,1)
  450 ENDPROC
  460 DEFPROCscreen(T$,C1%,C2%):VDU26,12
  470 C1$=CHR$(144+C1%)
  480 C2$=CHR$(128+C2%)
  490 PROCline(C1$):PRINT
  500 T$=STRING$((36-LENT$)/2," ")+T$
  510 FOR I%=1 TO 2:PRINTC2$CHR$141T$:NEXT
  520 PROCline(C1$):PRINTTAB(0,24);
  530 PROCline(C1$):VDU28,0,23,39,5
  540 ENDPROC
  550 DEFPROCline(col$):PRINT col$;
  560 FOR I%=1 TO 38:VDU172:NEXT:ENDPROC
  570 DEFFNgetchoice(C%,L%):PRINT
  580 PRINT'CHR$133SPC5"Enter choice ";
  590 *FX15,1
  600 REPEAT G%=GET-48
  610 UNTIL G%>=L% AND G%<=C%
  620 PRINT G%:=G%
  630 DEFPROCinput
  640 DIM M%1000,N%1000:CLS
  650 PRINTCHR$134"Type message:":PRINT
  660 REPEAT
  670 V%=GET
  680 IF V%=127 PROCdel ELSE M%?X%=V%:VDUV%:X%=X%+1
  690 UNTIL V%=13
  700 FOR P%=1TOX%:N%?P%=M%?P%:NEXT
  710 ENDPROC
  720 DEFPROCdel:IF X%=0 VDU7:ENDPROC
  730 VDU V%:X%=X%-1:ENDPROC
  740 DEFPROCunstore
  750 PRINT'CHR$131SPC5"Loading data:"
  760 X=OPENIN"message"
  770 INPUT#X,X%
  780 DIM M%X%,N%X%
  790 FOR Y%=1TOX%:M%?Y%=BGET#X:NEXT
  800 CLOSE#X:PROCcopy:ENDPROC
  810 DEFPROCdisplay:PRINT
  820 FOR Y%=1 TO X%:VDU M%?Y%:NEXT
  830 PRINT''CHR$134SPC3"DECODING ..."
  840 PRINT"this can take some time!";
  850 ENDPROC
  860 DEFPROCletcount
  870 RESTORE 1960
  880 FOR A%=1 TO 26:READ temp$
  890 store%(A%,1)=ASCtemp$
  900 FOR Y%=1 TO X%
  910 IF M%?Y%=ASCtemp$ cnt%?A%=cnt%?A%+1
  920 NEXT:NEXT:ENDPROC
  930 DEFPROCbubble
  940 LOCAL lp1%,lp2%,last%
  950 last%=25
  960 FOR lp1%=1 TO 26:flag%=0
  970 FOR lp2%=1 TO 25
  980 IF cnt%?lp2%<cnt%?(lp2%+1) PROCswap(lp2%,lp2%+1):flag%=1
  990 NEXT
 1000 last%=last%-1
 1010 IF flag%=0 lp1%=26
 1020 NEXT:ENDPROC
 1030 DEFPROCswap(rec1%,rec2%)
 1040 spare%=cnt%?rec1%:temp%=store%(rec1%,1)
 1050 cnt%?rec1%=cnt%?rec2%:store%(rec1%,1)=store%(rec2%,1)
 1060 cnt%?rec2%=spare%:store%(rec2%,1)=temp%
 1070 ENDPROC
 1080 DEFPROCguess:IF NOTmaster ENDPROC
 1090 *FX112,2
 1100 CLS:VDU23;8202;0;0;0;0;26
 1110 PROCline(C1$):PRINTTAB(0,22);
 1120 PROCline(C1$):PRINT'CHR$133" Suggested codes: Return to toggle"
 1130 PRINTTAB(0,24);:PROCline(C1$)
 1140 VDU28,0,21,39,1:CLS:PRINT:D%=1
 1150 PROCformat
 1160 PRINT;cnt%?D%".";G$;
 1170 FOR D%=1 TO 26
 1180 PROCformat
 1190 IF cnt%?D%<cnt%?(D%-1) PRINT';cnt%?D%;"."G$;:PROCcolour:PRINTCHR$store%(D%,1)"="CHR$store%(D%,2)CHR$135:ELSE PROCcolour:PRINTCHR$store%(D%,1)"="CHR$store%(D%,2)CHR$135;
 1200 NEXT:*FX112,1
 1210 ENDPROC
 1220 DEFPROCformat
 1230 G$=STR$cnt%?D%:F%=LENG$
 1240 G$=STRING$(3-F%," "):ENDPROC
 1250 DEFPROCcolour
 1260 IF store%(D%,1)=W% VDU8,129
 1270 IF store%(D%,1)=U% VDU8,129
 1280 ENDPROC
 1290 DEFPROCreplace
 1300 FOR Y%=1TOX%:P%=M%?Y%
 1310 PROCchange:NEXT:*FX21
 1320 PROCupdate:ENDPROC
 1330 DEFPROCchange
 1340 FOR Q%=1 TO 26
 1350 IF store%(Q%,1)=P% M%?Y%=store%(Q%,2)
 1360 NEXT:ENDPROC
 1370 DEFPROCalter
 1380 VDU28,0,23,39,23
 1390 VDU23;29194;0;0;0;12
 1400 temp$="":PROCoptions
 1410 PROCtransfer
 1420 FOR Q%=1TO26:IF store%(Q%,2)=W% store%(Q%,2)=42
 1430 NEXT:FOR Q%=1TO26:IF store%(Q%,2)=U% store%(Q%,2)=W%
 1440 NEXT:FOR Q%=1TO26:IF store%(Q%,2)=42 store%(Q%,2)=U%
 1450 NEXT:VDU28,0,23,39,1
 1460 PROCguess:ENDPROC
 1470 DEFPROCoptions
 1480 PRINTCHR$133"Back([) End(@) Swap(A-Z) or Return :";:temp$=GET$:PRINT
 1490 IF temp$=CHR$13 PROCtoggle:REPEAT UNTIL GET:PROCtoggle:GOTO1480
 1500 IF temp$="@" PROCtransfer:PROClastcode:END
 1510 IF ASCtemp$<65 OR ASCtemp$>91 VDU7:GOTO 1480
 1520 IF temp$="[" IF LENrecord$>1 PROCbacktrack:ENDPROC:ELSEIF temp$="[" AND LENrecord$<2 VDU7:GOTO 1480
 1530 W%=ASCtemp$
 1540 PRINTCHR$133SPC7"Change to what (A-Z) : ";:temp$=GET$:PRINT
 1550 U%=ASCtemp$
 1560 IF U%<65 OR U%>91 VDU7:GOTO 1480
 1570 PRINTCHR$133"Making alterations";
 1580 record$=record$+CHR$W%+CHR$U%
 1590 ENDPROC
 1600 DEFPROCtransfer
 1610 FOR Q%=1TO26:store%(Q%,1)=store%(Q%,2):NEXT
 1620 ENDPROC
 1630 DEFPROCtoggle:IF NOTmaster VDU7:ENDPROC
 1640 T%=T%+1:IF T%>2 T%=1:VDU23;29194;0;0;0;:ELSE T%=2:VDU23;8202;0;0;0;
 1650 OSCLI"FX113,"+STR$T%
 1660 ENDPROC
 1670 DEFPROCbacktrack
 1680 U%=ASCRIGHT$(record$,1)
 1690 record$=LEFT$(record$,LENrecord$-1)
 1700 W%=ASCRIGHT$(record$,1)
 1710 record$=LEFT$(record$,LENrecord$-1)
 1720 ENDPROC
 1730 DEFPROCcopy
 1740 FORD%=1TOX%:N%?D%=M%?D%:NEXT
 1750  ENDPROC
 1760 DEFPROClastcode
 1770 VDU28,0,23,39,1:CLS:PRINT
 1780 alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 1790 FOR D%=1TOX%
 1800  J%=INSTR(alph$,CHR$N%?D%)
 1810 IF J%>0 PRINT" "CHR$N%?D%"="CHR$M%?D%;:alph$=LEFT$(alph$,J%-1)+MID$(alph$,J%+1,LENalph$)
 1820 NEXT:PRINT'
 1830 PRINTCHR$134alph$+" do not appear"
 1840 PRINT:ENDPROC
 1850  DEFPROCturnabout
 1860 FOR Y%=1TOX%:IF M%?Y%=W% M%?Y%=42
 1870 NEXT:FOR Y%=1TOX%:IF M%?Y%=U% M%?Y%=W%
 1880 NEXT:FOR Y%=1TOX%:IF M%?Y%=42 M%?Y%=U%
 1890 NEXT:PROCupdate:ENDPROC
 1900  DEFPROCupdate
 1910  VDU28,0,23,39,1,12:PRINT
 1920  FOR Y%=1TOX%:VDU M%?Y%:NEXT
 1930  PRINT'TAB(0,21);:PROCline(C1$)
 1940 IF master THEN *FX113,1
 1950 ENDPROC
 1960  DATA E,T,A,O,N,I,S,H,R,D,L,C,U,F,M,P,B,W,G,Y,V,K,X,Q,J,Z
 1970 DEF PROCinit_shadow
 1980 *SHADOW 1
 1990 *FX112,2
 2000 CLS
 2010 *FX112,1
 2020 ENDPROC