10 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]      —~˙4˙o4~o4˙j5˙/%˙o4  .o4  xm0   
   20 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]      —˙~5˙o1˙_0oz%˙/ ˙o1  *o0  ˙j5   
   30 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]      —/*%/*%+/!˘' //%/*%  +/!/ ˘'  
   40 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08]        
   50 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]       By Andrew Black 
   60 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]       (c) Andrew Soft 1991    
   70 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08]          
   80 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08] ƒ     This program has been released 
   90 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08] ƒ     into Public Domain   
  100 REM [0x08]  [0x08]  [0x08]  [0x08]  [0x08]  [0x08] " [0x08]           
  110 ON ERROR PROCerror(0)
  120 :
  130 max%=30
  140 *DISC
  150 :
  160 DIM osfile &20, filename &10
  170 DIM file$(max%), length%(max%)
  180 DIM saddress%(max%), eaddress%(max%)
  190 DIM mark%(max%), note$(max%)
  200 :
  210 MODE 7
  220 VDU15
  230 VDU23;8202;0;0;0;
  240 :
  250 PROCtitle
  260 PROCmenu
  270 :
  280 END
  290 :
  300 DEF PROCdrive
  310 CLS
  320 INPUT" Which drive (0-3)"drv%
  330 IF drv%<0 OR drv%>3 THEN PROCdrive
  340 :
  350 PROCoscli("DR."+STR$drv%)
  360 :
  370 PRINT
  380 PROCoscli(".")
  390 :
  400 PRINT'"ƒCorrect drive?":G$=GET$
  410 IF G$="N" THEN PROCdrive
  420 PROCmenu
  430 ENDPROC
  440 :
  450 DEF PROCcompress
  460 PROCunmark
  470 version$="3.0"
  480 CLS
  490 PRINT"„ƒCompressing Mode  œ"
  500 PRINT'
  510 :
  520 INPUT" How many files to compress:"fnum%
  530 IF fnum%>max% OR fnum%<1 THEN PROCcompress
  540 :
  550 INPUT" Destination file:"dfile$
  560 PRINT
  570 INPUT" Archived by    :…"archive$
  580 INPUT" Date of archive:ƒ"date$
  590 PRINT
  600 :
  610 INPUT" How many note lines: "nlines%
  620 IF nlines%>10 OR nlines%<1 THEN GOTO 610
  630 :
  640 PRINT
  650 FOR F%=1 TO nlines%
  660 INPUT" Notes: "note$(F%) 
  670 NEXT
  680 :
  690 PRINT
  700 :
  710 CLS
  720 FOR G%=1 TO fnum%
  730 PRINT" Enter file ";G%;" to compress"
  740 INPUT" :ƒ"file$(G%)
  750 NEXT
  760 :
  770 PROCcheck_files
  780 :
  790 output%=OPENOUT(dfile$)
  800 time%=((((total%+&515)/1024)*9)*1.5)DIV1
  810 :
  820 CLS
  830 PRINT'" Writing file information..."
  840 :
  850 PRINT# output%,0,0,0,version$,fnum%,total%,archive$,date$,nlines%
  860 :
  870 FOR Q%=1 TO nlines%
  880 PRINT# output%,note$(Q%)
  890 NEXT
  900 :
  910 FOR Z%=1 TO fnum%
  920 PRINT# output%,file$(Z%),saddress%(Z%),eaddress%(Z%),length%(Z%),0
  930 NEXT
  940 :
  950 PRINT'" Compressing files"
  960 PRINT" Compression time: ";(time% DIV60)" min(s) ";(time% MOD60)" sec(s)"
  970 :
  980 PRINT
  990 FOR W%=1 TO fnum%
 1000 :
 1010 PRINT# output%,W%:REM Keeps track of file number
 1020 :
 1030 input%=OPENIN(file$(W%))
 1040 :
 1050 PRINT" Compressing "file$(W%)
 1060 PRINT
 1070 :
 1080 FOR R%=1 TO length%(W%)
 1090 BPUT# output%,BGET# input%
 1100 NEXT
 1110 :
 1120 CLOSE#input%
 1130 NEXT
 1140 :
 1150 CLOSE#output%
 1160 :
 1170 PRINT'"ƒˆTransfer successful"
 1180 G$=INKEY$(200)
 1190 ENDPROC
 1200 :
 1210 DEFPROCwrite_block
 1220 $filename=file$(L%)
 1230 !osfile=filename
 1240 !(osfile+2)=saddress%(L%)
 1250 !(osfile+6)=eaddress%(L%)
 1260 X%=osfileMOD256
 1270 Y%=osfileDIV256
 1280 A%=2
 1290 CALL&FFDD
 1300 X%=osfileMOD256
 1310 Y%=osfileDIV256
 1320 A%=3
 1330 CALL&FFDD
 1340 ENDPROC
 1350 :
 1360 DEFPROCread_block
 1370 $filename=file$(G%)
 1380 !osfile=filename
 1390 X%=osfileMOD256
 1400 Y%=osfileDIV256
 1410 A%=5
 1420 CALL&FFDD
 1430 saddress%(G%)=!(osfile+2)
 1440 eaddress%(G%)=!(osfile+6)
 1450 ENDPROC
 1460 :
 1470 DEF PROCoscli(s$)
 1480 $&900=s$:X%=&00:Y%=&09:CALL&FFF7:ENDPROC
 1490 :
 1500 DEF PROCerror(num%)
 1510 CLOSE#0
 1520 :
 1530 IF ERR=6 PRINT'"ƒNotArchiveƒfile":I$=INKEY$(200):PROCmenu:ENDPROC
 1540 IF ERR=17 THEN PROCmenu
 1550 IF num%=1 THEN PRINT'"ƒFile not found":I$=INKEY$(200):PROCmenu:ENDPROC
 1560 IF ERR=204 THEN PROCmenu
 1570 :
 1580 PRINT:REPORT:PRINT:END
 1590 ENDPROC
 1600 :
 1610 DEF PROCcheck_files
 1620 fils%=FNfiles
 1630 total%=0
 1640 IF fils%>max% THEN CLS:PRINT'"ƒAbandoning Mode":PRINT'"„Catalouge full":I$=INKEY$(400):PROCmenu:ENDPROC
 1650 :
 1660 PRINT
 1670 FOR G%=1 TO fnum%
 1680 :
 1690 input%=OPENIN(file$(G%))
 1700 IF input%=0 THEN PROCmark(G%):GOTO 1790
 1710 :
 1720 length%(G%)=EXT# input%
 1730 total%=length%(G%)+total%
 1740 :
 1750 :
 1760 CLOSE#input%
 1770 PROCread_block
 1780 :
 1790 NEXT
 1800 :
 1810 PROCcheck2
 1820 PROCcheck3
 1830 ENDPROC
 1840 :
 1850 DEF PROCmark(rec%)
 1860 mark%(rec%)=1
 1870 ENDPROC
 1880 :
 1890 DEF PROCcheck2
 1900 set=0
 1910 :
 1920 FOR K%=1 TO fnum%
 1930 IF mark%(K%)=1 THEN PRINT"†Unable to find file";file$(K%):set=1
 1940 NEXT
 1950 :
 1960 IF set=1 THEN I$=INKEY$(300):CLS:PRINT"ƒAbandoning mode":PRINT'"†Unable to find file(s)":I$=INKEY$(400):PROCmenu:ENDPROC
 1970 ENDPROC
 1980 :
 1990 :
 2000 DEF PROCcheck3
 2010 ON ERROR GOTO 2080
 2020 :
 2030 PROCoscli("SAVE "+dfile$+" 0000 "+STR$~(total%+&512+(&22*fnum%)))
 2040 :
 2050 ON ERROR PROCerror(0)
 2060 ENDPROC
 2070 :
 2080 IF ERR=198 CLS:PRINT"ƒAbandoning mode":PRINT'"Not enough disk space":I$=INKEY$(400):PROCmenu:ENDPROC
 2090 :
 2100 PROCerror(0)
 2110 ENDPROC
 2120 :
 2130 DEF PROCexit
 2140 CLS
 2150 PRINT" Exit (Y/N)":G$=GET$
 2160 IF G$="Y" THEN END
 2170 PROCmenu
 2180 ENDPROC
 2190 :
 2200 :
 2210 DEF PROCexamine
 2220 CLS
 2230 PRINT"„ƒExamine Archive  œ"
 2240 PRINT
 2250 INPUT" Enter file to examine: "bfile$
 2260 PRINT
 2270 INPUT" Send data to printer",G$
 2280 IF G$="Y" THEN set3=1 ELSE set3=0
 2290 :
 2300 input%=OPENIN(bfile$)
 2310 PROCex_dec(0)
 2320 I$=INKEY$(200)
 2330 ENDPROC
 2340 :
 2350 :
 2360 DEF PROCex_dec(choice%)
 2370 :
 2380 IF input%=0 THEN CLS:PRINT"ƒAbandoning mode":PRINT'"†Unable to find file…";bfile$:I$=INKEY$(300):PROCmenu:ENDPROC
 2390 :
 2400 INPUT# input%,spare%,spare%,spare%,version$,fnum%,total%,archive$,date$,nlines%
 2410 :
 2420 FOR E%=1 TO nlines%
 2430 INPUT# input%,note$(E%)
 2440 NEXT
 2450 :
 2460 :
 2470 FOR H%=1 TO fnum%
 2480 INPUT# input%,file$(H%),saddress%(H%),eaddress%(H%),length%(H%),spare%
 2490 NEXT
 2500 :
 2510 IF choice%=0 THEN CLOSE#input%
 2520 CLS
 2530 IF set3=0 THEN PRINT"ƒArchive file: ";bfile$
 2540 IF set3=1 THEN PRINT" Archive file: ";bfile$:VDU2
 2550 :
 2560 PRINT'" Archived with version: ";version$
 2570 PRINT
 2580 PRINT" Archived files: ";fnum%
 2590 PRINT" Files total size: ";total% DIV 1024".";(total% MOD 1024)DIV 10"K"
 2600 PRINT" Archived by: ";archive$
 2610 PRINT" Archive date: ";date$
 2620 PRINT
 2630 PRINT
 2640 :
 2650 FOR O%=1 TO nlines%
 2660 PRINT" Notes: ";note$(O%)
 2670 NEXT
 2680 PRINT
 2690 :
 2700 FOR U%=1 TO fnum%
 2710 neat$=STRING$(9-LEN(file$(U%))," ")
 2720 PRINT" Filename ";U%;": ";file$(U%);neat$" length: ";length%(U%) DIV 1024;".";(length%(U%) MOD 1024)DIV 10;"K"
 2730 IF set3=0 THEN I$=INKEY$(60)
 2740 NEXT
 2750 IF set3=1 THEN VDU3
 2760 :
 2770 PROCspace
 2780 ENDPROC
 2790 :
 2800 DEF PROCdecompress(switch%)
 2810 CLS
 2820 PRINT"„ƒDecompressing Mode  œ"
 2830 PRINT
 2840 INPUT" Enter file to decompress: "bfile$
 2850 :
 2860 input%=OPENIN(bfile$)
 2870 :
 2880 set3=0
 2890 PROCex_dec(1)
 2900 IF switch%=1 THEN PROClocate:ENDPROC
 2910 PROCd_check(switch%)
 2920 :
 2930 IF set2=1 THEN PROCre_cal
 2940 :
 2950 time%=(((total%/1024)*9)*1.5)DIV1
 2960 :
 2970 CLS
 2980 PRINT'" Decompressing time: ";(time% DIV60)" min(s) ";(time% MOD60)" sec(s)"
 2990 :
 3000 PROCdec_sec2
 3010 :
 3020 PRINT'"ƒTransfer successful"
 3030 G$=INKEY$(200)
 3040 ENDPROC
 3050 :
 3060 DEFPROCtitle
 3070 REM You may alter this section
 3080 REM as you want.
 3090 PRINT"—ppppppppppppppppppppppppppppppppppppppp";
 3100 VDU134,157,141
 3110 PRINT"„ARCer Vers 3.0 by Andrew Black"
 3120 VDU134,157,141
 3130 PRINT"ARCer Vers 3.0 by Andrew Black"
 3140 PRINT"”```````````````````````````````````````"
 3150 VDU28,0,24,39,4
 3160 ENDPROC
 3170 :
 3180 DEF PROCd_check(switch2%)
 3190 set2=0
 3200 fils%=FNfiles
 3210 :
 3220 IF switch2%=1 THEN fnum%=nofile%
 3230 IF fnum%>max% GOTO 3270
 3240 IF fnum%>(max%+1)-fils% THEN PRINT'"†Unable to decompressall†files.":PRINT'"ƒLack of catalouge file space":set2=1:PRINT':INPUT"„Carry on with decompressing",G$:IF G$="Y" THEN 3280
 3250 :
 3260 IF set2=0 ENDPROC
 3270 CLS:PRINT"ƒAbandoning Mode":PRINT'"†Lack of catalouge file space":I$=INKEY$(200):CLOSE#0:PROCmenu
 3280 :
 3290 IF set2=1 THEN fnum%=(max%+1)-fils%
 3300 ENDPROC
 3310 :
 3320 DEF PROCre_cal
 3330 total%=0
 3340 FOR G%=1 TO fnum%
 3350 total%=length%(G%)+total%
 3360 NEXT
 3370 ENDPROC
 3380 :
 3390 DEF PROCmenu
 3400 CLS
 3410 drv%=FNd
 3420 PRINT
 3430 PRINT" 1. Decompress archive"
 3440 PRINT'" 2. Compress archive"
 3450 PRINT'" 3. Examine archive"
 3460 PRINT'" 4. Change drive (Current: ";drv%")"
 3470 PRINT'" 5. Exit"
 3480 PRINT'" * Operating system command"
 3490 G$=GET$
 3500 :
 3510 IF G$="1" THEN PROCdecompress(0)
 3520 IF G$="2" THEN PROCcompress
 3530 IF G$="3" THEN PROCexamine
 3540 IF G$="4" THEN PROCdrive
 3550 IF G$="5" THEN PROCexit
 3560 IF G$="*" THEN PROCstar
 3570 :
 3580 IF G$="" THEN PROCmenu ELSE PROCmenu
 3590 ENDPROC
 3600 :
 3610 :
 3620 DEF PROCdec_sec
 3630 output%=OPENOUT(filec$)
 3640 :
 3650 PRINT'" Decompressing "filec$
 3660 :
 3670 FOR N%=1 TO lengthc%
 3680 BPUT# output%,BGET# input%
 3690 NEXT
 3700 :
 3710 CLOSE#output%
 3720 PROCwrite_block
 3730 ENDPROC
 3740 :
 3750 DEF PROCdec_sec2
 3760 FOR L%=1 TO fnum%
 3770 INPUT# input%,spare%:REM Number of file
 3780 filec$=file$(L%)
 3790 lengthc%=length%(L%)
 3800 PROCdec_sec
 3810 :
 3820 NEXT
 3830 :
 3840 CLOSE#input%
 3850 ENDPROC
 3860 :
 3870 DEF PROCstar
 3880 CLS
 3890 INPUT" *"star$
 3900 PROCoscli(star$)
 3910 PROCspace
 3920 ENDPROC
 3930 :
 3940 DEF PROCunmark
 3950 FOR R%=1 TO max%
 3960 mark%(R%)=0
 3970 NEXT
 3980 ENDPROC
 3990 :
 4000 REM"ƒThe machine code routines
 4010 REM"ƒhave been substuted for the
 4020 REM"ƒfollowing FuNctions in
 4030 REM"ƒsemi-BASIC.
 4040 :
 4050 DEFFNfiles
 4060 LOCAL A%,X%,Y%,blk%
 4070 DIM blk% 255
 4080 IF FNls(0,1,1,blk%) THEN =&FF
 4090 =blk%?5 DIV 8
 4100 :
 4110 DEFFNd
 4120 LOCAL A%,X%,Y%,b%
 4130 DIM b% 12,drv% 20
 4140 b%?0=0:b%!1=drv%:b%!5=0:b%!9=0
 4150 A%=5:X%=b%MOD256:Y%=b%DIV256:CALL&FFD1
 4160 =?(drv%+2+?drv%)
 4170 :
 4180 DEFFNls(trk%,sec%,unit%,addr%)
 4190 LOCAL A%,X%,Y%,blk%
 4200 DIM blk% 10
 4210 blk%?0=drv%:blk%!1=addr%:blk%?5=3:blk%?6=&53:blk%?7=trk%:blk%?8=sec%:blk%?9=&20+unit% 
 4220 A%=&7F:X%=blk%MOD256:Y%=blk%DIV256:CALL&FFF1
 4230 =blk%?10
 4240 :
 4250 DEF PROCspace
 4260 PRINT'"ƒ       Press space to continue"
 4270 REPEATUNTILGET=32
 4280 ENDPROC