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