10 REM > Archive225
   20 REM ARCER 1.8 BY ANDREW BLACK
   30 REM Extended Ver 2 by J.G.Harston
   40 REM This program may be freely distributed
   50 CLEAR:MODE&87:VDU23;2,53;0;0;0:DIMb&FF:c=b+32:A$=FNOS:vr$="2.25":s%=&87:l%=0:k%=0:qt$=""
   60 I%=INSTR(A$,"-q"):IFI%:qt$=MID$(A$,1+INSTR(A$," ",I%)):A$=LEFT$(A$,I%-1)
   70 d$="%.suffix":sf%=0:PROCr1:IFr0%=1:DIMsf% X%!10:sf%?(X%!10)=13:OSCLI"Load "+d$+" "+STR$~sf%
   80 e$="":DIMA%-1:mx%=HIMEM-A%-2000:IFmx%>&FFFF:mx%=&FFFF
   90 DIMzp%7,dt%mx%:PROCf:PROChp:IFA$<>"":OSCLI"Key0 E"+A$+"|M":*FX138,0,192
  100 ONERRORIFFNerr:PROCend:A$=CHR$13:END
  110 REPEAT:X%=b:Y%=X%DIV256:UNTILFNg:PRINT"Exit":PROCend:A$=CHR$13:END
  120 DEFFNerr:IFs%<>&87:s%=&87:VDU22,s%,23;2,53;0;0;0:PROCf
  130 REPORT:OSCLI"FX15":OSCLI"EXEC":IFl%:A%=l%:l%=0:CLOSE#A%
  140 IFk%:A%=k%:k%=0:CLOSE#A%
  150 PRINT:=INKEY-1ANDINKEY-2
  160 DEFPROCend:A$=qt$:qt$="":IFA$=""ORASCA$=42:OSCLIA$:ENDPROC ELSE CHAINA$:ENDPROC
  170 DEFFNg:VDU58:REPEATe$=GET$:IFe$>"`" e$=CHR$(ASCe$AND&DF)
  180 UNTILINSTR("ACDEGQX?*",e$):VDU127:IFe$="C"ORe$="A":PROCh(e$="A")
  190 IFe$="D":PROCs
  200 IFe$="E":PROCx
  210 IFe$="?":PROChp
  220 IFe$="*":INPUTLINE"*"e$:OSCLIe$
  230 IFe$="G":PROCg
  240 IFe$="Q":INPUTLINE""qt$:qt$=MID$(qt$,INSTR(qt$," ")+1):CLS:PROChp
  250 =e$="X"
  260 DEFPROCa:IFar%=64:PRINT"CJR"; ELSE IFar%=80:PRINT"ZIP"; ELSE IFar%:PRINT"GetBack"; ELSE PRINT"Black";
  270 ENDPROC
  280 DEFPROCh(f%):PRINT'"Archive Mode":INPUT" Destination file "j$:PRINT"(B)lack/(C)JR/(G)etBack/(Z)ip archive:";:REPEATar%=GETAND&DF:UNTILINSTR("BCGZ",CHR$ar%):VDUar%:ar%=((ar%=67)AND64)OR((ar%=90)AND80)OR((ar%=71)AND13)
  290 IFf%:IFar%=80:PRINT'"Extending ZIPs - can't yet":ENDPROC
  300 l%=0:IFf%:l%=OPENUP(j$):IFl%:IFFNchk:ENDPROC
  310 PRINTCHR$13;SPC40;CHR$8;CHR$13;:IFl%:PTR#l%=EXT#l%:PRINT"Extend"; ELSE l%=OPENOUT(j$):at%=1:PRINT"Creat";
  320 p$="":k%=l%:l%=0:PRINT"ing a";:PROCa:PRINT"archive.":IFk%=0:PRINT"Couldn't open file"'"'"j$"'":OSCLI"Exec":ENDPROC
  330 IFar%=80:PROCiC:BPUT#k%,0:CLOSE#k%:k%=OPENUP(j$)
  340 n%=-1:IFPTR#k%=0ANDar%=64:FORn%=0TO50:PRINT#k%,l%:NEXT:n%=0:end%=EXT#k%
  350 IFar%=0ANDPTR#k%=0:PRINT#k%,"",&FF000000,0,0:at%=0
  360 IFar%=64ANDn%<0:REPEATINPUT#k%,a%:n%=n%+1:UNTILa%=0:end%=EXT#k%
  370 IFar%=80:n%=0
  380 fs%=FNfs:PRINT"Enter filenames, dir names, *commands, end with RETURN":REPEAT:REPEAT:REPEAT:INPUTLINE"File: "d$:IFASCd$=42:OSCLId$
  390     UNTILASCd$<>42 ANDASCd$<>124:l%=0:IFd$<>"":PRINTCHR$11;STRING$((LENd$+6)MOD40+5,CHR$9);:d2$=d$:d$=LEFT$(d$,INSTR(d$+",",",")-1):d2$=MID$(d2$,2+LENd$):l%=OPENIN(d$):IFl%=0:PRINT'"File not found"
  400   UNTILl%<>0 ORd$="":IFd$<>"":PROCr:IFr0%=2:CLOSE#l%:l%=0:OSCLI"DIR "+d$:PROCdir("") ELSE IFd$<>"":PROCc
  410 PRINT:UNTILd$="":VDU11:IFar%=80:PROCzc:PROCze
  420 CLOSE#k%:k%=0:d$=j$:PROCr1:$c=d$:A%=b?2:b!2=&FFFDDC00+A%:A%=2:CALL&FFDD
  430 PRINT"Transfer completed":ENDPROC
  440 DEFPROCc:IFd2$<>"":d$=d2$
  450 IFr0%=2:IFar%=64ORar%=0:ENDPROC
  460 p%=b!2:q%=b!6:m%=EXT#l%:a%=b!14:md%=b!15:IFar%=64:PTR#k%=n%*5:PRINT#k%,end%:PTR#k%=end%:PRINT#k%,p$+d$,p%,q%,m%,a% ELSE IFar%=80:PROCzi ELSE IFar%=13:PROCpb ELSE PRINT#k%,p$+d$,m%,p%,q%:IFat%=0:PRINT#k%,a%
  470 IFr0%AND1:PROCtr(l%,k%,m%,TRUE):CLOSE#l%:l%=0
  480 n%=n%+1:end%=PTR#k%:IFat%=0:PTR#k%=2:PRINT#k%,(end%-17)OR&FF000000:PTR#k%=end%
  490 IFar%=80:PTR#k%=cp%:PROCwr32((NOTcrc%)AND(m%<>0)):PTR#k%=end%
  500 ENDPROC
  510 DEFPROCpb:FORz%=1TOLENp$+LENd$:BPUT#k%,ASCMID$(p$+d$,z%,1):NEXT:BPUT#k%,13:PROCwr16(r0%+256):PROCwr32(p%):PROCwr32(q%):PROCwr32(m%):BPUT#k%,a%:PROCwr32(md%):ENDPROC
  520 DEFPROCzi:d2$=p$+d$+LEFT$(".",r0%=2):PROCzn1:PROCwr32(&04034B50):PROCwr32(0):PROCwr32(0):!zp%=a%:?zp%=1+(zp%?2 DIV16)+((zp%?1 AND&E0)DIV2):PROCwr16((zp%?1 AND31)+32*(zp%?2 AND15)+&200*?zp%):cp%=PTR#k%:PROCwr32(0):PROCwr32(m%):PROCwr32(m%)
  530 PROCwr16(LENd2$):PROCwr16(24):FORz%=1TOLENd2$:BPUT#k%,ASCMID$(d2$,z%,1):NEXT
  540 PROCwr16(&4341):PROCwr16(20):PROCwr32(&30435241):PROCwr32(p%):PROCwr32(q%):PROCwr32(a%):PROCwr32(0):crc%=-1:ENDPROC
  550 DEFPROCzc:ep%=0:cp%=PTR#k%:fp%=0:IFEXT#k%<30:ENDPROC
  560 VDU134,9,9,9:REPEAT:ep%=PTR#k%:PTR#k%=fp%:lp%=fp%:PRINTFNpc(lp%,ep%);
  570   FORz%=0TO29:dt%?z%=BGET#k%:NEXT:A%=dt%?26:FORz%=1TOA%:dt%?(z%+29)=BGET#k%:NEXT:FORz%=A%+30TOA%+53:dt%?z%=BGET#k%:NEXT:fp%=PTR#k%+dt%!18:PTR#k%=ep%
  580 PROCwr32(&02014B50):PROCwr16(0):FORz%=4TO29:BPUT#k%,dt%?z%:NEXT:PROCwr32(0):PROCwr16(0):PROCwr32(&20):PROCwr32(lp%):FORz%=30TOA%+53:BPUT#k%,dt%?z%:NEXT:ep%=PTR#k%:UNTILfp%>=cp%:ENDPROC
  590 DEFPROCze:PROCwr32(&06054B50):PROCwr32(0):PROCwr16(n%):PROCwr16(n%):PROCwr32(ep%-cp%):PROCwr32(cp%):PROCwr16(0):VDU13:ENDPROC
  600 DEFPROCiC:cC%=cC%:IFcC%:ENDPROC ELSE IF FALSE THEN
  610   IF?&FFF7<>&6C:ENDPROC
  620   cC%=dt%:dt%=dt%+90:mx%=mx%-90:ca%=&70:cl%=&72:cc%=&74
  630   FORz%=0TO1:P%=cC%:[OPTz%*2:.bl:LDX#8:LDA(ca%-8AND&FF,X):EORcc%
  640     .rl:LSRcc%+3:RORcc%+2:RORcc%+1:RORA:BCCcl:TAY:LDAcc%+3:EOR#&ED
  650     STAcc%+3:LDAcc%+2:EOR#&B8:STAcc%+2:LDAcc%+1:EOR#&83:STAcc%+1:TYA
  660     EOR#&20:.cl:DEX:BNErl:INCca%:BNEnx:INCca%+1:.nx:STAcc%:LDAcl%:BNEsk
  670   DECcl%+1:.sk:DECcl%:BNEbl:LDAcl%+1:BNEbl:RTS:]:NEXT:ENDPROC
  680   SAVE:ENDPROC
  690   DEFPROCs:PRINT'"Dearchive Mode":IFFNsrc:ENDPROC
  700   v%=TRUE:IFFNchk:ENDPROC
  710   PROCz:h%=PTR#l%:FORj%=0TO1:n%=0:ptr%=-1:PTR#l%=h%:IFar%=64:INPUT#l%,ptr%
  720     REPEATPROCi:IFNOTeof%:IFf%=0:PROCo ELSE IFNOTeof%:PTR#l%=PTR#l%+m%
  730       IFNOTeof%:IFar%=64:PTR#l%=n%*5:INPUT#l%,ptr%
  740       IFj%=1:PRINTFNpc(PTR#l%,EXT#l%);
  750     UNTILEOF#l%ORptr%=0OReof%:IFv%:PRINT:j%=2 ELSE IFj%=0:PRINT'SPC4;
  760   NEXTj%:CLOSE#l%:l%=0:PRINTCHR$13"Transfer completed":ENDPROC
  770   DEFPROCo:IFj%=0:IFRIGHT$(d$,1)<>".":k%=OPENOUT(FNout(d$)):PRINT'" Extracting ";d$;SPC4;:PROCtr(l%,k%,m%,FALSE):CLOSE#k%:k%=0:PROCw:ENDPROC
  780   PTR#l%=PTR#l%+m%:IFRIGHT$(d$,1)=".":v%=0:d$=LEFT$(d$,LENd$-1):PROCw:ENDPROC ELSE ENDPROC
  790   DEFPROCop:!b=0:b?1=O%+1+LENd$:b!3=A%:b?7=T%:$(b+O%)=d$:A%=&14:CALL&FFF1:ENDPROC
  800   DEFPROCw:$c=FNout(d$):!b=c:b!2=p%:b!6=q%:b!14=a%:IFfs%=4:b?14=a%AND8 ELSEIFfs%<>16:b?14=a%AND&3B
  810   A%=1:CALL&FFDD:IFFNfs<>5ORINSTR(d$,":",2):ENDPROC
  820   b!8=md%:A%=19:T%=5:O%=10:PROCop:b!8=cd%:b!10=ct%:b!13=md%:b!15=mt%:A%=19:T%=64:O%=18:PROCop:ENDPROC
  830   DEFPROCr1:X%=b:Y%=X%DIV256:fs%=FNfs:PROCr:ENDPROC
  840   DEFPROCr:d$=FNs(d$):z%=TRUE:IFfs%=5:IFINSTR(d$,":",2)=0:A%=18:T%=64:O%=8:PROCop:IFb?3=0:z%=b!10
  850   $c=d$:!b=c:A%=5:r0%=USR&FFDD AND&FF:IFz%<>TRUE:b!15=z%
  860   IFfs%<>16:b?14=b?14AND127:IFfs%=4:b?14=(b?14OR7)EOR(b?14DIV4)
  870   ENDPROC
  880   DEFPROCf:PRINT""STRING$(39,"p");:VDU134,157,141:PRINT" Black/CJR/GetBack/ZIP Archiver":VDU134,157,141:PRINT" Black/CJR/GetBack/ZIP Archiver"'SPC6"Version "vr$"  by J.G.Harston"'""STRING$(39,"`");
  890   VDU28,0,24,39,5,15:PRINT:CLS:ENDPROC
  900   DEFPROCx:PRINT'"Examine archive":IFFNsrc:ENDPROC
  910   IFFNchk:ENDPROC
  920   PROCex(TRUE):ENDPROC
  930   DEFPROCex(F%):VDU131:PROCa:PRINT" archive "t$" contains:":ln%=512:n%=0:ptr%=-1:IFar%=64:INPUT#l%,ptr%
  940   REPEAT:PROCi:IFNOTeof%:ln%=ln%+m%+256-(m%AND&FF):PRINT""RIGHT$(d$,14);SPC(15-LENRIGHT$(d$,14));:IFF%:PRINTFNh0(p%,8);"+";FNh0(m%,4);" ";FNh0(q%,8);:IFf%:PRINT" *"CHR$8 ELSE IFNOTeof%:IFF%OR(n%MOD3)=2:PRINTCHR$8;CHR$8;CHR$8
  950     IFNOTeof%:PTR#l%=PTR#l%+m%:IFar%=64:PTR#l%=5*n%:INPUT#l%,ptr%
  960   UNTILEOF#l% ORptr%=0 OReof%:IFF%=0 AND(n%MOD3):PRINT
  970   PRINT" Total size: ";ln%DIV1024;"K   ";n%;" file"LEFT$("s",n%>1)".":PROCz:IFF%:CLOSE#l%:l%=0
  980   ENDPROC
  990   DEFFNpc(A%,N%):VDU8,8,8:PRINTFNd0(100*A%DIVN%,2)"%";:=""
 1000   DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
 1010   DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
 1020   DEFFNuc(A$):LOCAL B$:IFA$="":=""
 1030   REPEATB$=B$+CHR$(ASCA$AND((A$<"@")OR&DF)):A$=MID$(A$,2):UNTILA$="":=B$
 1040   DEFFNlc(A$):LOCAL B$:IFA$="":=""
 1050   REPEATB$=B$+CHR$(ASCA$OR((A$<"_")AND&20)):A$=MID$(A$,2):UNTILA$="":=B$
 1060   DEFPROChp:PRINT" (C)reate an archive"TAB(21)"(D)earchive files"'" (A)dd to an archive"TAB(21)"(G)et single file"'" (E)xamine archive"TAB(21)"(*)command"'" e(X)it program"TAB(21)"(?)Help":ENDPROC
 1070   DEFPROCtr(c1%,c2%,n%,cf%):IFEXT#c1%=0:ENDPROC
 1080   REPEAT:b%=mx%:IFn%<b%:b%=n%
 1090     PRINTFNpc(PTR#c1%,EXT#c1%);:?b=c1%:b!1=dt%:b!5=b%:A%=4:CALL&FFD1:IFcf%:IFar%=80:PROCcc
 1100   ?b=c2%:b!1=dt%:b!5=b%:A%=2:CALL&FFD1:n%=n%-b%:UNTILn%<1:VDU127,127,127:ENDPROC
 1110   DEFPROCcc:IFcC%:!ca%=dt%:!cl%=b%:!cc%=crc%:CALLcC%:crc%=!cc%:ENDPROC
 1120   S%=crc%:FORy%=dt%TOdt%+b%-1:S%=S%EOR?y%:FORZ%=1TO8:T%=S%:S%=(((S%+(S%<0))DIV2)AND&7FFFFFFF):IFT%AND1:S%=S%EOR&EDB88320
 1130       IF(y%AND255)=0:PRINTFNpc(y%-dt%+PTR#c1%-b%,EXT#c1%);
 1140   NEXT:NEXT:crc%=S%:ENDPROC
 1150   DEFFNsrc:INPUT" Enter source file: "t$:l%=OPENIN(t$):IFl%=0:PRINT"File not found":=TRUE ELSE =FALSE
 1160   DEFFNrd32:?zp%=BGET#l%:zp%?1=BGET#l%:zp%?2=BGET#l%:zp%?3=BGET#l%:=!zp%
 1170   DEFFNrd16:!zp%=0:?zp%=BGET#l%:zp%?1=BGET#l%:=!zp%
 1180   DEFPROCwr32(A%):!zp%=A%:BPUT#k%,?zp%:BPUT#k%,zp%?1:BPUT#k%,zp%?2:BPUT#k%,zp%?3:ENDPROC
 1190   DEFPROCwr16(A%):!zp%=A%:BPUT#k%,?zp%:BPUT#k%,zp%?1:ENDPROC
 1200   DEFPROCz:u%=EXT#l%:n%=((u%/1536)*9)DIV3.5:PRINT" Dearchive complete file in ";n%" secs.":ENDPROC
 1210   DEFPROCi:eof%=0:IFar%=13:PROCgb:PROCb:mt%=dt%!17:ct%=mt% ELSEIFar%=80:PROCuz ELSEIFar%=64:PTR#l%=ptr%:INPUT#l%,d$,p%,q%,m%,a%:PROCb ELSEIFar%=0:INPUT#l%,d$,m%,p%,q%:a%=&33:PROCb:IFat%=0:INPUT#l%,a%:PROCb
 1220   f%=(m%AND&FF000000)DIV&1000000:m%=m%AND&FFFFFF:n%=n%+1:ENDPROC
 1230   DEFPROCb:!zp%=a%:zp%!3=0:md%=zp%!1:cd%=zp%!1:mt%=0:ct%=0:ENDPROC
 1240   DEFPROCgb:z%=0:A%=BGET#l%:d$="":REPEATd$=d$+CHR$A%:A%=BGET#l%:UNTILA%=13:el%=19:PROCif:p%=dt%!2:q%=dt%!6:a%=dt%!14:m%=dt%!10AND(?dt%=1):d$=d$+LEFT$(".",?dt%=2):ENDPROC
 1250   DEFPROCuz:IFFNrd32<>&04034B50:n%=n%-1:eof%=TRUE:ENDPROC
 1260   z%=FNrd16:z%=FNrd16:ty%=FNrd16:mt%=FNft(FNrd16):md%=FNfd(FNrd16)
 1270   ct%=mt%:cd%=md%:crc%=FNrd32:m%=FNrd32:fsz%=FNrd32:nl%=FNrd16:el%=FNrd16
 1280   ac%=-1:FORz%=0TO127 STEP4:dt%!z%=0:NEXT
 1290   d$="":d2$="":IFnl%:FORz%=1TOnl%:d2$=d2$+CHR$BGET#l%:NEXT:PROCzn2
 1300   dt%!8=0:dt%!12=0:dt%!16=&33:dt%!17=md%:IFel%:PROCif:IFel%<16:dt%!12=dt%!8
 1310   p%=dt%!8:q%=dt%!12:a%=dt%!16:md%=dt%!17:m%=m%OR(ty%*&1000000):IFel%>25:cd%=dt%!24:IFel%>27:ct%=dt%!26:IFel%>31:ac%=dt%!28
 1320   ENDPROC
 1330   DEFFNfd(A%):A%=A%-&200:=(A%AND31)+((A%AND&1E0)*8)+((A%AND&1E00)*8)+((A%AND&E000)DIV256)
 1340   DEFFNft(A%)=((A%AND&F800)DIV2048)+((A%AND&7E0)*8)+((A%AND31)*131072)
 1350   DEFPROCif:FORz%=0TOel%-1:dt%?z%=BGET#l%:NEXT:ENDPROC
 1360   DEFFNchk:PTR#l%=0:ar%=BGET#l%:IFar%>32:ar%=BGET#l%:ar%=13OR(ar%<>13ANDar%<33)
 1370   PTR#l%=0:IFBGET#l%=80:IFBGET#l%=&4B:IFBGET#l%=3:ar%=80
 1380   IFar%=64:PTR#l%=5:ar%=64OR(ar%<>64)
 1390   IFar%<0:PRINT"Not a Black/CJR/GetBack/ZIP archive":CLOSE#l%:l%=0:=TRUE
 1400   PTR#l%=0:at%=1:IFar%=0:at%=BGET#l%+BGET#l%:PTR#l%=0:IFat%=0:PTR#l%=17
 1410   =FALSE
 1420   DEFPROCzn:IFINSTR(d2$,".")+INSTR(d2$,"/")=0:ENDPROC
 1430   FORA%=1TOLENd2$:B%=ASCMID$(d2$,A%,1):IF(B%AND&FE)=46:d2$=LEFT$(d2$,A%-1)+CHR$(B%EOR1)+MID$(d2$,A%+1)
 1440   NEXT:ENDPROC
 1450   DEFPROCzn1:d2$=FNsf(d2$,(p%AND&FFF00)DIV256):PROCzn:ENDPROC
 1460   DEFPROCzn2:PROCzn:d$=d2$:d2$="":A%=0:REPEAT:B%=INSTR(d$+".",".",A%+1):IFB%-A%>11:d$=LEFT$(d$,A%+10)+MID$(d$,B%):B%=A%+11
 1470   A%=B%:UNTILB%>LENd$:ENDPROC
 1480   DEFFNout(d$):IFFNfs=4:=LEFT$(d$,INSTR(d$,".")+7)
 1490   IFINSTR(d$,".")=0:=LEFT$(d$,10):REM * in PROCzn?
 1500   LOCALn%,d2$:d2$=d$:REPEATn%=INSTR(d2$,".",n%+1):IFn%:d$=LEFT$(d2$,n%-1):PROCr:IFr0%=0:OSCLI"CDIR "+d$
 1510   UNTILn%=0:=d2$
 1520   DEFFNfs:LOCALA%,E%,Y%:=(USR&FFDA)AND&FF
 1530   DEFPROCdir(p$):LOCALr%,i%:rc%=NOT(RIGHT$(d$,2)=" r"ORRIGHT$(d$,2)=" R"):i%=0:REPEATA%=8:b!1=c:b!5=1:b!9=i%:CALL&FFD1:i%=b!9:r%=b!5
 1540     IFr%=0:c?(1+?c)=13:d$=$(c+1):PROCr:b$=d$:d2$=d$:IFr0%AND1:l%=OPENIN(d$):PRINT'"File: "d$;SPC4;:PROCc ELSEIFr0%=2:IFrc%:PROCc:OSCLI"Dir "+b$:PROCdir(p$+b$+"."):*Dir ^
 1550   UNTILr%<>0:ENDPROC
 1560   DEFPROCg:PRINT'"Get single files":IFFNsrc:ENDPROC
 1570   IFFNchk:ENDPROC
 1580   PROCex(FALSE):REPEAT
 1590     INPUT"Select file to examine: "a$:a$=FNuc(a$):IFFNchk
 1600     n%=0:REPEAT:IFar%=64:PTR#l%=5*n%:INPUT#l%,ptr%
 1610     PROCi:ptr%=PTR#l%:PTR#l%=PTR#l%+m%:n$=FNuc(d$):UNTILEOF#l% ORa$=n$:IFa$<>n$ ORf%:PRINT"File not found"
 1620   UNTILa$=n$:PTR#l%=ptr%
 1630   PRINT""RIGHT$(d$,14);SPC(15-LENRIGHT$(d$,14));FNh0(p%,8);"+";FNh0(m%,4);" ";FNh0(q%,8);:IFf%:PRINT" *"CHR$8 ELSE PRINT
 1640   PRINT"(E)xtract"SPC4"(D)ump"SPC8"(T)ype ";
 1650   REPEATn%=GET AND&DF:UNTILn%=68 ORn%=69 ORn%=84:PRINT
 1660   IFn%=68:PROCdmp
 1670   IFn%=69:k%=OPENOUT(FNout(d$)):PROCtr(l%,k%,m%,FALSE):CLOSE#k%:k%=0:PROCw
 1680   IFn%=84:PROCtyp
 1690   CLOSE#l%:l%=0:ENDPROC
 1700   DEFPROCdmp:REPEATPRINTFNh0(PTR#l%-ptr%,4);" ";:FORn%=0TO7:IFm%>0:dt%?n%=BGET#l%:PRINTFNh0(dt%?n%,2);" ";:m%=m%-1 ELSE dt%?n%=32:PRINT"   ";
 1710       NEXT:FORn%=0TO7:IFdt%?n%<32 OR dt%?n%>126:VDU46 ELSE VDUdt%?n%
 1720   NEXT:PRINT:UNTILm%<1:ENDPROC
 1730   DEFPROCtyp:IFHIMEM>&7FFF:A%=133:X%=&83:A%=((USR&FFF4)AND&FFFF00)DIV256:IFA%>&7FFF:s%=&83:VDU22,s%
 1740   VDU14:REPEATn%=BGET#l%:m%=m%-1:IFn%>127 OR(n%<127 ANDn%>31):VDUn%
 1750     IFn%=13:PRINT
 1760     IFn%<32 ANDn%<>13 ANDn%<>10:COLOUR135:COLOUR0:VDU64+n%:COLOUR128:COLOUR7
 1770   UNTILm%<1:VDU15:IFs%<>&87:PRINT'"Press SPACE to continue":n%=GET:s%=&87:VDU22,s%:PROCf
 1780   ENDPROC
 1790   DEFFNOS:IFPAGE<&3000:A$=$&600 ELSE IFPAGE<&4000:A$=$(PAGE-&300) ELSE SYS"OS_GetEnv"TOA$:A$=MID$(A$,INSTR(A$+" "," ",INSTR(A$+" "," ")+1)+1)
 1800   A$=FNs(A$):=FNs(MID$(A$,INSTR(A$+" "," ")+1))
 1810   DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 1820   IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 1830   =A$
 1840   DEFFNsf(n$,t%):LOCALe%,f%,sp%,xt$:IFLENn$<10ORsf%=0:=n$
 1850   A%=0:REPEATe%=A%+1:A%=INSTR(n$,".",e%):UNTILA%=0:IFLENn$-e%<9:=n$ELSEe%=INSTR(n$,"/",e%):IFe%=0:=n$
 1860   xt$=FNlc(MID$(n$,e%+1)):sp%=sf%:REPEAT:f%=LEFT$($sp%,LENxt$)=xt$:IFsp%?3=44:f%=f%ANDt%=EVAL("&"+$(sp%+4))
 1870   A%=sp%:sp%=sp%+1+LEN$sp%:UNTIL?sp%=13ORf%:IFf%:xt$=LEFT$($A%,3)
 1880   IFRIGHT$(n$,1)<="_":IFRIGHT$(n$,1)<>"/":xt$=FNuc(xt$)
 1890   =LEFT$(n$,e%-1)+"/"+xt$
65453   OSCLIEPAGEWHENPLOTPAGEELLIPSELENRECTANGLEERRORLEN41147ORINTPOSPROCATNCIRCLELOADWHEN PAGEREPORTEVALTRUEO{TIMEINTLOADWHEN*PAGEREPORTEXTCHR$CIRCLETIMEINTWHEN"ȑ "TIMEINT g{EXT[EVAL{LRESTOREOSCLIQ%=PA.:CH."*BASIC {{{{a{a{`|{`` g{,z0ȱR{02 ee  { {R
31696   ONHIMEM{EXITLOCALLENPTR QUITMOUSELENCIRCLE`MOUSE

Download Archive

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.