MkImg112.src

10 REM > MkImg112/s v1.12a

20 REM v1.02 -update option

30 REM v1.03 -@ option

40 REM v1.04 Catalogue stored in reverse sector start order

50 REM Uses default maximum disk size

60 REM Defaults to translating xxxx/x to x/xxxx on DFS

70 REM v1.05 Creates double-sided disk if source dir contains '0','1' or '0','2'

80 REM v1.06 Pads end of unused sectors

90 REM v1.07 Can create ADFS and HADFS images

100 REM v1.08 Correctly counts files in DFS subdirectories

110 REM v1.09 inpath can be a single file

120 REM todo: extending directory with -fs dfs62

130 REM v1.10 added -pad option, WinDOS f_scan, translates leaf names

140 REM v1.11 dfs62 done, file.txt -> dfs: t.file

150 REM v1.12 Fixed DFS filecount, d/file -> d.file translation, added -R <rootdir>

160 REM v1.12a Allows 'L' in .inf, skips crc, reads date/time/boot, DFS writes 'L'

170 REM Adding -dsd will be fiddly, needs major rewrite to implement

180 REM Probably veneer to gbpb(wr)

190 :

200 DIMctrl%127,name%79,zp%9:A$=FNOS_GetEnv:in%=0:out%=0:inc%=0:IFos%=32:PROCWin_TextIO

210 quit$=FNcl(" -qu",1):debug%=FNcl("-de",0):ON ERROR REPORT:PRINT:PROCexit(ERR)

220 IFFNcl("-help",0):PRINT"MkImg v1.12a (C)J.G.Harston 2005-2020":A$="-?"

230 IFFNcl("-?",0):PRINT"Syntax: MkImg outfile inpath -c num -fs type -@ -i@file -o opt -p -q -R root -r -s size -t title -quit command":PROCexit(0)

240 title$=FNcl("-t",1):opt%=VALFNcl("-o",1):type$=FNcl("-f",1):IFtype$="":type$="DFS"

250 cycle$=FNcl("-c",1):size$=FNcl("-s",1):rc%=FNcl("-r",0):vb%=NOTFNcl("-q",0)

260 dsd%=FNcl("-ds",0):pad%=FNcl("-p",0):stdin%=FNcl("-@",0):v1%=FNcl("-v1",0)

270 ex%=FNcl("-e",0):ex%=TRUE:root$=LEFT$(FNcl("-R",1),1):IFroot$="":root$="$"

280 size%=VALsize$*4:IF(ASCRIGHT$(size$,1)AND&DF)=77:size%=size%*1024

290 inc$="":A%=INSTR(" "+A$," -i@"):REM These need to be last options

300 IFA%:inc$=MID$(A$,A%+3,INSTR(A$," ",A%)-A%-3):A%=FNcl("-i@"+inc$,0)

310 out$=FNcl("",0):in$=FNcl("",0):leaf$=FNcl("",0)

320 d$=".":s$="/":IFos%AND40:d$="/":s$=".":IFos%AND32:d$="\"

330 :

340 ON ERROR REPORT:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND ERR<>17):PROCClose_All:PROCexit(ERR)

350 X%=ctrl%:Y%=X%DIV256:cycle%=0:files%=0:REM sj%=FALSE

360 REM date%=date%:REM Should set from date$

370 :

380 type$=FNuc(type$):fstype%=INSTR("HADFS24",type$):IFfstype%=0:fstype%=3*INSTR("DFS31",type$)+4*INSTR("DFS62",type$)

390 IFfstype%<1 OR fstype%>4:PRINT"Unsupported filesystem":PROCexit(220)

400 IFVALRIGHT$(type$,2)=24:fstype%=0

410 IFfstype%=1:IFsize%>&10000:fstype%=0

420 IFfstype%=1:IFsize%=&10000:size%=&FFFF

430 IFfstype%=0:IFsize%=&1000000:size%=&FFFFFF

440 IFfstype%=0:tln%=16:dsz%=23:fsz%=32:root%=&47:dmax%=&01000000:REM HADFS24

450 IFfstype%=1:tln%=16:dsz%=31:fsz%=24:root%=&47:dmax%=&00010000:REM HADFS

460 IFfstype%=2:tln%=19:dsz%=47:fsz%=26:root%=&02:dmax%=&00200000:REM ADFS

470 IFfstype%=3:tln%=12:dsz%=31:fsz%=16:root%=&01:dmax%=&00000400:REM DFS

480 IFfstype%=4:tln%=12:dsz%=62:fsz%=16:root%=&01:dmax%=&00000400:REM DFS62

490 IFsize%:dmax%=size%

500 side%=0:dskid%=RND(65535)

510 IFfstype%<3:ex%=FALSE:REM dsd%=FALSE

520 :

530 IFdebug%:PRINT" run$='"run$"'"'"quit$='"quit$"'"'" out$='"out$"'"'" in$='"in$"'"'" inc$='"inc$"'"

540 IFdebug%:PRINT" recurse=";rc%;" verbose=";vb%;" fstype%=";fstype%;" dsd%=";dsd%

550 IFdebug%:PRINT" tln=";tln%;" dsz=";dsz%;" fsz=";fsz%;" root=&";~root%;" dskid=&";~dskid%

560 IFdebug%:PRINT" dmax=&";~dmax%;" size%=&";~size%;" pad%=";pad%

570 IFdebug%:PRINT" root='";root$;"'"

580 :

590 DIM A%-1:max%=HIMEM-A%-4096:DIM mem% max%:wr%=2:rd%=4

600 IFout$="":INPUT"Destination file: "out$

610 :

620 REM IFupd%:IFFNChkDir:PROCEnter0:PROCexit(0)

630 :

640 out%=FNf_openout(out$):IFout%=0:PRINT"Can't open '"out$"'":PROCexit(192)

650 title$=LEFT$(title$+STRING$(20," "),tln%):PROCdskHdr

660 CLOSE#out%:out%=0:X%!2=&FFFB2200:IFfstype%=2:X%!2=&FFFFCE00

670 A%=FNfile(out$,2):out%=FNf_openup(out$):PTR#out%=EXT#out%

680 A%=0:idate%=0:IFin$<>"":A%=FNf_info(in$):idate%=X%!15

690 IFin$="" OR inc$<>"" OR stdin%:PROCEnter:A%=2 ELSE IFA%=2:PROCcd(in$):PROCChkDir:PROCScan("",root%):A%=2

700 IFA%=1:PROCChkDir:p$="":PROCAdd:A%=2

710 IFA%<>2:PRINT"Dir. '"in$"' not found" ELSE PROCsetFSM

720 IFpad%:IFsize%:IFEXT#out%<size%*256:PTR#out%=size%*256-1:BPUT#out%,0

730 CLOSE#out%:out%=0:PROCexit(0):END

740 :

750 REM DEFPROCEnter0:IFNOTstdin%:ENDPROC

760 REM REPEAT:INPUTLINE""A$:PRINTCHR$11;SPC(LENA$);STRING$(LENA$,CHR$127);:UNTILA$="":ENDPROC

770 :

780 DEFPROCEnter:p$=""

790 IFinc$="" AND NOTstdin%:PRINT"Enter files to include, end with RETURN"

800 IFinc$<>"" AND NOTstdin%:OSCLI"Exec "+inc$:inc%=FNbyte(198,0,255):IFos%=32:inc%=!540

810 IFin$<>"":PROCcd(in$)

820 PROCChkDir:IFinc%:IFEXT#inc%=0:ENDPROC

830 REPEAT:IFinc%=0:PRINT"Enter filename: ";

840 INPUT LINE""in$:IFstdin%:PRINTCHR$11;SPC(16+LENin$);STRING$(16+LENin$,CHR$127)

850 leaf$="":PROCAdd:A%=0:IFinc%:A%=EOF#inc% OR (EXT#inc%-PTR#inc%<2)

860 UNTILin$="" OR A%:IFinc$<>"":*Exec

870 ENDPROC

880 :

890 DEFPROCAdd

900 IFleaf$="":leaf$=in$:A%=INSTR(in$,","):IFA%:leaf$=MID$(in$,A%+1):in$=LEFT$(in$,A%-1)

910 t%=0:IFin$<>"":IFASCin$<>124:t%=FNf_info(in$):IFinc% OR stdin%:VDU11

920 IFt%:A%=FNadd ELSE IFin$<>"":IFASCin$<>124:PRINT"File '"in$"' not found"

930 ENDPROC

940 :

950 REM DEFFNChkDir:fs%=FNfs:sj%=fs%=5:in0$=in$:in$=out$:IFin$="":=FALSE

960 REM A%=FNf_info(in$):date%=FNz_date(X%!15):in$=in0$:IFA%=0:=FALSE

970 REM A%=FNf_info(in$):IFFNz_date(X%!15)>date% OR A%=0:=FALSE

980 REM IFA%=2:PROCcd(in$)

990 REM =TRUE:REM out$ newer or same as in$, don't update

1000 :

1010 REM DEFPROCChkDir:fs%=FNfs:sj%=fs%=5:IFrc%=0:ENDPROC

1020 DEFPROCChkDir:fs%=FNfs:IFrc%=0:ENDPROC

1030 IFFNf_scan(0)<>"0":ENDPROC

1040 A$=FNf_scan(X%!9):IFA$<>"1":IFA$<>"2":ENDPROC

1050 rc%=-2:ENDPROC

1060 :

1070 DEFPROCScan(p$,dir%):LOCALp%,r%:IFfstype%<=2:LOCAL files%

1080 REPEAT:in$=FNf_scan(p%):r%=LENin$:p%=X%!9:IFr%:PROCRdName

1090 UNTILr%=0:ENDPROC

1100 :

1110 DEFPROCRdName:IFASCin$=46:IFos%<8:ENDPROC

1120 cycle%=X%?0:t%=FNf_info(in$)

1130 leaf$=in$:IFos%AND-24:leaf$=FNfn_unbbc(leaf$)

1140 sec%=FNadd:IFt%<>2:ENDPROC

1150 IFrc%=0 OR sec%=0:ENDPROC

1160 PROCcd(in$):PROCScan(p$+in$+d$,sec%):PROCcd("^"):ENDPROC

1170 :

1180 DEFFNadd:REM in$=native source filename, leaf$=Acorn dest leafname

1190 IFt%=2:IFfstype%>2:PROCside2:=dir%

1200 IFt%=2:IFrc%=0:=dir%

1210 load%=X%!2:exec%=X%!6:fsize%=X%!10:attr%=X%?14:IFfs%<>16:attr%=attr%AND&7F

1220 mdate%=X%!15:mtime%=X%!17:cdate%=X%!20:ctime%=X%!22:acc%=X%!25:PROCinf

1230 IFvb%:PRINT"Adding ";p$;in$;"... ";

1240 PTR#out%=EXT#out%:PROCalign:ptr0%=EXT#out%-side%

1250 IFptr0%+fsize%>dmax%*256:PRINT"disk full":=0

1260 IFfsz%=24:IFfsize%>&7FFFF:PRINT"file too long":=0

1270 IFfiles%>=dsz%:IFfstype%>1:PRINT"cat full":=0

1280 IFfiles%>=dsz%:PROCextend

1290 :

1300 REM DFS+ex% DFS+ex%=0 non-DFS

1310 REM leaf$='file' from PROCScan -> file -> use use use

1320 REM leaf$='file/ext' from PROCScan -> file/ext -> e/file use use

1330 REM leaf$='file' from input file -> file -> use use use

1340 REM leaf$='file/ext' from input file -> file/ext -> e/file use use

1350 REM leaf$='file.ext' from input file -> file/ext -> e/file use use

1360 REM leaf$='d/file' from input file -> d/file -> d/file use use

1370 REM leaf$='d.file' from input file -> d/file -> d/file use use

1380 :

1390 REPEATA%=INSTR(leaf$,"."):IFA%:leaf$=LEFT$(leaf$,A%-1)+"/"+MID$(leaf$,A%+1)

1400 UNTILA%=0:IFex%:A%=INSTR(leaf$,"/",3):IFA%:leaf$=FNuc(MID$(leaf$+" ",A%+1,1))+"/"+LEFT$(leaf$,A%-1)

1410 IFex%:IFMID$(leaf$,2,1)<>"/":leaf$=root$+"/"+leaf$

1420 :

1430 IFt%<>2:in%=FNf_openin(in$):IFin%=0:PRINT"Can't open '"in$"'.":=0

1440 IFt%<>2:PROCtrans:CLOSE#in%:in%=0 ELSE PROCmkdir

1450 PROCalign:sect%=ptr0%DIV256:ptr0%=EXT#out%:files%=files%+1

1460 IFfstype%>2:PROCaddDFS

1470 IFfstype%=2:PROCaddADFS

1480 IFfstype%<2:PROCaddHADFS

1490 PTR#out%=EXT#out%

1500 IFvb%:VDU8,8,8:PRINT"Done."

1510 =sect%

1520 :

1530 REM Check for .inf metadata on DOS/Windows

1540 DEFPROCinf:IF(os%AND-24)=0:ENDPROC

1550 A$=in$:IFFNf_info(A$+s$+"inf")=0:IFINSTR(A$,"."):REPEAT:A$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)=s$ORA$="":A$=LEFT$(A$,LENA$-1)

1560 A$=A$+s$+"inf":IFFNf_info(A$)=1:IFX%!10<80:in%=OPENIN(A$):A$=GET$#in%:CLOSE#in%:in%=0 ELSE ENDPROC

1570 A%=INSTR(A$,"BOOT="):IFA%:opt%=VALMID$(A$,A%+5):A$=LEFT$(A$,A%-1)

1580 A%=INSTR(A$,"CRC="):IFA%:A$=LEFT$(A$,A%-1)

1590 A%=VALFNcl("",0):load%=FNinf(0):exec%=FNinf(load%):A%=FNinf(0)

1600 IFLEFT$(A$,1)="L":attr%=&19:A$=FNs(MID$(A$,2)) ELSE attr%=FNinf(&33)

1610 mdate%=FNinf(0):mtime%=FNinf(0):cdate%=FNinf(mdate%):ctime%=FNinf(0)

1620 ENDPROC

1630 DEFFNinf(A%):IFLENA$:=EVAL("&"+FNcl("",0))ELSE=A%

1640 :

1650 DEFPROCaddDFS:IFrc%:IFLENp$=-2*rc%:leaf$=RIGHT$(p$,2)+MID$(leaf$,3)

1660 REM rc%=-1, source P.file -> P.file

1670 REM rc%=-2. source 0.P.file -> P.file

1680 leaf$=MID$(leaf$+" ",3,7)+CHR$(ASCleaf$OR((attr%AND8)*16))

1690 PROCf_gbpb(rd%-1,out%,mem%,512,side%+512*(files%DIV32))

1700 FORA%=252TO16STEP-4:mem%!A%=mem%!(A%-8):mem%!(256+A%)=mem%!(256+A%-8):NEXT

1710 A%=mem%?16:$(mem%+8)=leaf$:mem%?16=A%

1720 mem%?&104=cycle%:mem%?&105=((files%MOD32)+(files%DIV32))*8:mem%?&106=opt%*16+ptr0%DIV65536:mem%?&107=ptr0%DIV256

1730 mem%!&108=load%:mem%!&10A=exec%:mem%!&10C=fsize%:mem%?&10F=sect%

1740 mem%?&10E=sect%DIV256+(load%AND&30000)DIV16384+(fsize%AND&30000)DIV4096+(exec%AND&30000)DIV1024

1750 PROCf_gbpb(wr%-1,out%,mem%,512,side%+512*(files%DIV32))

1760 ENDPROC

1770 :

1780 DEFPROCaddADFS:fptr%=mem%:$fptr%=LEFT$(leaf$+CHR$13+" ",10)

1790 PROCaddAttr((attr%AND3)+(attr%AND8)DIV2+((t%=2)AND8)+(((attr%AND6)=4)AND16)+(attr%AND&30)*2+(((attr%AND&60)=&40)AND128)+(attr%AND&80)*2)

1800 fptr%!10=load%:fptr%!14=exec%:fptr%!18=fsize%:fptr%!22=sect%:fptr%?25=0

1810 PROCf_gbpb(wr%-1,out%,mem%,fsz%,dir%*256+files%*fsz%-21)

1820 ENDPROC

1830 :

1840 DEFPROCaddHADFS

1850 mdate%=FNh_date(mdate%):cdate%=FNh_date(cdate%)

1860 mtime%=(mtime%AND&1F)*2048+(mtime%AND&3F00)DIV8+(mtime%AND&3F0000)DIV131072

1870 REM ctime%=(ctime%AND&1F)*2048+(ctime%AND&3F00)DIV8+(ctime%AND&3F0000)DIV131072

1880 PTR#out%=dir%*256+12:BPUT#out%,files%+((fsz%=32)AND&80):fptr%=mem%

1890 $fptr%=LEFT$(leaf$+" ",10):PROCaddAttr(((attr%EOR&33)AND255)+((t%=2)AND256))

1900 fptr%!10=load%:fptr%!14=exec%:fptr%!18=fsize%

1910 IFfsz%=32:fptr%!22=sect%:fptr%?25=0:fptr%!26=mdate%:fptr%!28=mtime%:fptr%?30=cdate%:fptr%?31=cdate%DIV256

1920 IFfsz%=24:fptr%?22=sect%:fptr%?23=sect%DIV256:fptr%?20=(fptr%?20AND7)+(mdate%AND&F8):fptr%?21=mdate%DIV256

1930 IFfsz%=24:fptr%?9=(fptr%?9AND127)+(mdate%AND1)*128:fptr%?13=(fptr%?13AND63)+(mdate%AND6)*32

1940 PROCf_gbpb(wr%-1,out%,fptr%,fsz%,dir%*256+files%*fsz%)

1950 ENDPROC

1960 :

1970 DEFPROCaddAttr(bits%):bits%=bits%*128:FORA%=0TO9:fptr%?A%=(fptr%?A% AND127)+(bits%AND128):bits%=bits%DIV2:NEXT:ENDPROC

1980 :

1990 DEFPROCextend:PROCf_gbpb(rd%-1,out%,mem%,fsz%,dir%*256)

2000 IFfsz%=24:first%=mem%!&14 AND &FFFF:mem%?&0E=ptr0%DIV&100:mem%?&0F=ptr0%DIV&10000

2010 IFfsz%=32:first%=mem%!&14 AND &FFFFFF:mem%?&17=ptr0%DIV&100:mem%?&18=ptr0%DIV&10000:mem%?&19=ptr0%DIV&1000000

2020 PROCf_gbpb(wr%-1,out%,mem%,fsz%,dir%*256):IFfirst%=0:first%=dir%

2030 mem%?&0C=mem%?12AND31:mem%?&14=first%:mem%?&15=first%DIV256:IFfsz%=24:mem%?&0E=0:mem%?&0F=0

2040 IFfsz%=32:mem%?&17=0:mem%?&18=0:mem%?&19=0:mem%?&16=first%DIV&1000000

2050 PROCf_gbpb(wr%-1,out%,mem%,fsz%,ptr0%)

2060 PROCalign:BPUT#out%,0:PROCalign:BPUT#out%,0:PROCalign

2070 dir%=ptr0%DIV&100:ptr0%=EXT#out%:files%=0:ENDPROC

2080 :

2090 DEFPROCmkdir:fsize%=(dsz%*fsz%+64)AND&F00

2100 FORA%=0TOfsize%-1STEP4:mem%!A%=0:NEXT

2110 IFfstype%=2:$mem%=CHR$0+"Hugo":mem%?5=0:$(mem%+&4CC)=leaf$:mem%!&4D6=dir%:IFtitle$="":title$=leaf$

2120 IFfstype%=2:$(mem%+&4D9)=title$:mem%!&4EC=0:$(mem%+&4FB)="Hugo":mem%?&4FF=0

2130 IFfstype%<2:$mem%=LEFT$(leaf$+" ",10):mem%!&0A=dir%:mem%!&10=dskid%:mem%?&12=opt%:opt%=0

2140 IFfstype%=0:mem%!&0A=&800000:mem%!&1A=dir%

2150 PROCf_gbpb(wr%,out%,mem%,fsize%,0):ENDPROC

2160 :

2170 DEFPROCtrans:IFfsize%=0 OR t%=2:ENDPROC

2180 copyend%=fsize%:ptr%=0:REPEAT:IFvb%:PRINTFNsofar(ptr%,copyend%);

2190 len%=max%:IFptr%+len%>copyend%:len%=copyend%-ptr%

2200 PROCf_gbpb(rd%,in%,mem%,len%,0):PROCf_gbpb(wr%,out%,mem%,len%,0)

2210 ptr%=ptr%+len%:UNTIL ptr%>=copyend%:ENDPROC

2220 :

2230 DEFPROCalign:FORA%=0TO255STEP4:mem%!A%=0:NEXT

2240 A%=256-(PTR#out%AND255):IFA%<256:PROCf_gbpb(wr%,out%,mem%,A%,0)

2250 ENDPROC

2260 :

2270 DEFPROCdskHdr:files%=0:FORA%=0TO511STEP4:mem%!A%=0:NEXT

2280 IFfstype%>2:PROCdfsHdr

2290 IFfstype%=2:PROCadfsHdr

2300 IFfstype%<2:PROChadfsHdr

2310 ptr0%=PTR#out%:ENDPROC

2320 :

2330 DEFPROCdfsHdr:$mem%=LEFT$(title$,8):mem%!8=0:$(mem%+256)=MID$(title$,9):mem%!260=0

2340 PROCf_gbpb(wr%-1,out%,mem%,512,side%)

2350 IFfstype%=4:!mem%=&AAAAAAAA:mem%!4=&AAAAAAAA:mem%!256=0:PROCf_gbpb(wr%-1,out%,mem%,512,side%+512)

2360 ENDPROC

2370 :

2380 DEFPROChadfsHdr:$mem%=title$:$(mem%+16)=CHR$0+"(C)JGH"+CHR$0:mem%!&18=dskid%

2390 mem%!&1C=dmax%:mem%?31=(fsz%=32)AND&80:IFfsz%=24:mem%?30=1

2400 PROCf_gbpb(wr%-1,out%,mem%,256,&4600):REM Fall through to...

2410 DEFPROCadfsHdr

2420 dir%=root%:leaf$="$":PTR#out%=root%*256:PROCmkdir:title$=""

2430 ENDPROC

2440 :

2450 DEFPROCsetFSM:idate%=FNh_date(idate%):stp%=2:IFfsz%=32:stp%=3

2460 IFsize%=0:size%=ptr0%DIV256

2470 PROCf_gbpb(rd%-1,out%,mem%,512,(root%-1+1*(fstype%=2))*256)

2480 IFfstype%<2:mem%!&1A=idate%:mem%!&1C=size%:mem%?&1F=(fsz%=32)AND&80:IFfsz%=24:mem%?&1E=1

2490 IFfstype%<2:mem%!&20=2:mem%!(&20+stp%)=&44:mem%!(&20+2*stp%)=ptr0%DIV256:mem%!(&20+3*stp%)=size%-ptr0%DIV256

2500 IFfstype%=2:mem%!&FC=size%:mem%!&1FB=dskid%:mem%?&1FD=opt%:mem%?&1FE=3:mem%!&00=ptr0%DIV256:mem%!&100=size%-ptr0%DIV256:mem%?&FF=FNsum(mem%):mem%?&1FF=FNsum(mem%+256)

2510 IFfstype%>2:mem%?&106=opt%*16+size%DIV256:mem%?&107=size%

2520 PROCf_gbpb(wr%-1,out%,mem%,512,(root%-1+1*(fstype%=2))*256)

2530 IFfstype%<4:ENDPROC

2540 PROCf_gbpb(rd%-1,out%,mem%,512,side%+512)

2550 mem%?&106=opt%*16+size%DIV256:mem%?&107=size%

2560 PROCf_gbpb(wr%-1,out%,mem%,512,side%+512)

2570 ENDPROC

2580 :

2590 DEFFNsum(mem%):S%=255:FORA%=254TO0STEP-1:IFS%>255:S%=(S%+1)AND255

2600 S%=S%+mem%?A%:NEXT:=S%AND255

2610 :

2620 DEFPROCside2:IFin$<>"1":IFin$<>"2":ENDPROC

2630 IFrc%<>-2 OR p$<>"":ENDPROC

2640 IFsize%:PTR#out%=side%+256+6:BPUT#out%,opt%*16+size%DIV256:BPUT#out%,size%

2650 IFEXT#out%>&32000:PRINT"Side 0 too full":PROCClose_All:PROCexit(128-2)

2660 PTR#out%=EXT#out%:FORA%=0TO255STEP4:mem%!A%=&E5E5E5E5:NEXT

2670 REPEAT:PROCf_gbpb(wr%,out%,mem%,256,0):UNTILEXT#out%>=&32000

2680 side%=&32000:PROCdskHdr:ENDPROC

2690 :

2700 DEFFNh_date(A%)=(A%AND&FF00)+(A%AND31)*8+(A%AND&E0)DIV32

2710 :

2720 REM DEFFNz_date(A%):=(A%AND31)+(A%AND&F00)DIV8+((A%AND&F000)DIV8+(A%AND&E0)*256)+&200

2730 :

2740 DEFFNsofar(A%,B%):VDU8,8,8:PRINTFNd0(A%/(B%+1)*100,2);"%";:=""

2750 :

2760 :