10 REM ******************************
   20 REM NC BBC BASIC program Compacter
   30 REM  By Jim McGregor & Alan Watt
   40 REM ******************************
   50 REM NC100/200 Version 1 : 4/98
   60 REM Downloaded from Tim's NC Users' Site
   70 REM http://www.ncus.org.uk
   80 REM Taken from "Advanced programming techniques
   90 REM for the BBC MICRO"
  100 REM By J.McGregor & A.Watt (ISBN 0-201-14059-4)
  110 CLS:PRINTTAB(0,0)CHR$17"NC BBC BASIC File Compacter"CHR$18
  120 INPUT'"Please type in the inital value of PAGE : "page
  130 pp=page:lp=page
  140 DIM var$(100)
  150 lastvar=-1
  160 REPEAT
  170   PROCline
  180 UNTIL ?lp=0
  190 PROCcopycode:PROCcopycode:PROCcopycode
  200 END
  210 DEF PROCline
  220 LOCAL chars,countp
  230 chars=0
  240 countp=pp
  250 PROCcopycode
  260 ln=?lp
  270 PROCcopycode
  280 ln=(?lp*256)+ln:PRINTTAB(0,4)"Current line : ";ln
  290 PROCcopycode
  300 PROCskipspaces
  310 IF ?lp=42 OR ?lp=&DC PROCcopyline ELSE IF ?lp<>13 REPEAT:PROCcheckcode:UNTIL ?lp=13
  320 PROCcopycode
  330 ?countp=chars
  340 IF chars=4 pp=pp-4
  350 ENDPROC
  360 DEF PROCcopycode
  370 ?pp=?lp:pp=pp+1
  380 lp=lp+1:chars=chars+1
  390 ENDPROC
  400 DEF PROCcheckcode
  410 IF ?lp=32 lp=lp+1:ENDPROC
  420 IF ?lp=34 PROCcopystring:ENDPROC
  430 IF ?lp=&F4 PROCrem:ENDPROC
  440 IF (?lp>64 AND ?lp<91) OR (?lp>96 AND ?lp<123) OR ?lp=95 PROCvariable:ENDPROC
  450 IF ?lp>47 AND ?lp<58 PROCnumber:ENDPROC
  460 IF ?lp=38 PROChex:ENDPROC
  470 IF ?lp=&ED PROCnext:ENDPROC
  480 IF ?lp=141 PROCcopycode:PROCcopycode:PROCcopycode:ENDPROC:REM 141 is a code that precedes a label
  490 IF ?lp=42 AND (?(pp-1)=58 OR ?(pp-1)=&8B OR ?(pp-1)=&8C) PROCcopyline:ENDPROC
  500 PROCcopycode
  510 ENDPROC
  520 DEF PROCcopystring
  530 REPEAT
  540   PROCcopycode
  550 UNTIL ?lp=34
  560 PROCcopycode
  570 ENDPROC
  580 DEF PROCrem
  590 REPEAT
  600   lp=lp+1
  610 UNTIL?lp=13
  620 ENDPROC
  630 DEF PROCvariable
  640 LOCAL name$,position
  650 name$=""
  660 REPEAT
  670   IF FNvarchar name$=name$+CHR$(?lp):lp=lp+1
  680 UNTIL NOT FNvarchar
  690 IF LEN(name$)=1 AND ASC(name$)>64 AND ASC(name$)<91 PROCputvar(name$):ENDPROC
  700 position=FNlookup
  710 newname$=FNmakename(position)
  720 PROCputvar(newname$)
  730 ENDPROC
  740 DEF PROCputvar(n$)
  750 LOCAL i
  760 FOR i=1 TO LEN(n$)
  770   ?pp=ASC(MID$(n$,i,1))
  780   pp=pp+1:chars=chars+1
  790 NEXT
  800 PROCskipspaces
  810 IF FNvarchar ?pp=32:pp=pp+1:chars=chars+1
  820 ENDPROC
  830 DEF FNlookup
  840 LOCAL i
  850 i=-1
  860 REPEAT
  870   i=i+1
  880   found=(var$(i)=name$)
  890 UNTIL found OR i>lastvar
  900 IF found THEN =i
  910 lastvar=lastvar+1
  920 var$(lastvar)=name$
  930 =lastvar
  940 DEF FNmakename(no)
  950 letter$=CHR$(no MOD 26+97)
  960 IF no<26 =letter$
  970 =letter$+CHR$(no DIV 26+96)
  980 DEF PROChex
  990 LOCAL hexchar, ch
 1000 PROCcopycode
 1010 REPEAT
 1020   ch=?lp
 1030   hexchar=(ch>47 AND ch<58) OR (ch>64 AND ch<71)
 1040   IF hexchar PROCcopycode
 1050 UNTIL NOT hexchar
 1060 ENDPROC
 1070 DEF PROCnext
 1080 PROCcopycode
 1090 PROCskipspaces
 1100 REPEAT
 1110   IF ?lp=44 ?pp=58:pp=pp+1:?pp=237:pp=pp+1:lp=lp+1:chars=chars+2:PROCskipspaces
 1120   REPEAT
 1130     IF FNvarchar lp=lp+1
 1140   UNTIL NOT FNvarchar
 1150   PROCskipspaces
 1160 UNTIL ?lp<>44
 1170 ENDPROC
 1180 DEF FNvarchar
 1190 LOCAL ch
 1200 ch=?lp
 1210 =(ch>64 AND ch<91) OR (ch>96 AND ch<123) OR (ch>47 AND ch<58) OR ch=95
 1220 DEF PROCskipspaces
 1230 REPEAT
 1240   IF ?lp=32 lp=lp+1
 1250 UNTIL ?lp<>32
 1260 ENDPROC
 1270 DEF PROCcopyline
 1280 REPEAT
 1290   PROCcopycode
 1300 UNTIL ?lp=13
 1310 ENDPROC
 1320 DEF PROCnumber
 1330 PROCcopynumber
 1340 PROCskipspaces
 1350 IF FNvarchar ?pp=32:pp=pp+1:chars=chars+1
 1360 ENDPROC
 1370 DEF PROCcopynumber
 1380 REPEAT
 1390   PROCcopycode
 1400 UNTIL ?lp<48 OR ?lp>57
 1410 ENDPROC