MkMDR

10 REM > MkMDR 1.20

20 REM (C) J.G.Harston

30 REM Make an MDR file from spectrum files with load/exec addresses

40 REM

50 REM v1.00 Based on FileToTAP v1.05

60 REM FUSE complains about checksums

70 REM v1.01 Only uses sectors 254-1

80 REM v1.02 Writes data lengths of &200 instead of &209

90 REM v1.03 Checksums correct 512 bytes of data

100 REM v1.06 Command line interface, based on BINtoTAP

110 REM v1.07 Updated ProgEnv library for BB4Wv6+Brandy

120 REM v1.15 Avoids OSCLI to set filetype, cleans source name, adds Print files, defaults to Basic

130 REM v1.20 Renamed to MkMDR, updated parameters

140 :

150 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END

160 A$=FNOS_GetEnv+" ":IFos%>31:PROCWin_TextIO

170 DIM ctrl% 31,name% 80,mem% 542,type$(4):X%=ctrl%:Y%=X%DIV256

180 type$(0)="Print":type$(1)="Basic":type$(2)="Num ":type$(3)="Char ":type$(4)="Bytes"

190 IFA$=" ":INPUT "Source file/dir: "in$:INPUT "Destination file: "out$:INPUT"Cartridge title: "SpTitle$:INPUT"Options/flags: "A$:A$=FNnul(out$)+" "+FNnul(in$)+" -t "+FNnul(SpTitle$)+" "+A$

200 apnd%=FNcl("-a",0):spec%=FNcl("-s",0)

210 embd%=FNcl("-e",0):SpTitle$=FNcl("-t",1)

220 REM CmdLine bugfix requires space before final option

230 A$=A$+" ":vb%=FNcl("-v",0)

240 out$=FNcl("",1):IFout$="""""":out$=""

250 in$=FNcl("",1):IFin$="""""":in$=""

260 nm$=FNcl("",1):ld$=FNcl("",1):ex$=FNcl("",1):tp$=FNcl("",1)

270 ld%=-1:ex%=-1:tp%=-1:in%=0:out%=0

280 IFld$<>"":ld%=EVAL("&"+ld$):tp%=0

290 IFex$<>"":ex%=EVAL("&"+ex$):tp%=3

300 IFtp$<>"":tp%=EVAL("&"+tp$)

310 IFout$=("-?")ORout$="":PROCsyntax:PROCexit(220 AND (LENout$<>0)):END

320 :

330 IFin$<>"":A%=FNfile(in$,5):IF(A%AND1):in%=FNf_openin(in$):IFin%=0:A%=0

340 IFin$<>"":IFA%=0:PRINT"File '"in$"' not found":PROCexit(214):END

350 IFapnd%:out%=FNf_openup(out$)

360 IFout%=0:out%=FNf_openout(out$)

370 IFout%=0:PRINT"Couldn't open file '"out$"'":PROCClose_All:PROCexit(192):END

380 IFos%<8:A%=FNfile(out$,5):X%?5=&FF:X%?4=&FF:X%?3=&FD:A%=FNfile(out$,1)

390 ok%=TRUE:ON ERROR ok%=FALSE

400 IFos%<8:IFok%:OSCLI"SetType "+out$+" 054":OSCLI"Stamp "+out$

410 :

420 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END

430 sect%=255:IFin%:A%=FNfile(in$,5):PROCFile ELSE IFin$="":PROCEnter ELSE PROCStore

440 PROCFillToEnd:BPUT#out%,0:REM Not write protected

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

460 :

470 REM This needs to be able to take address parameters

480 DEFPROCEnter

490 PRINT "Enter input filenames, terminated with RETURN"

500 REPEAT:INPUT LINE "File: "in$

510 IFLEFT$(in$,1)="*":OSCLIMID$(in$,2) ELSE IFin$<>"":INPUT"Store as: "nm$:PROCStore

520 UNTILin$="":ENDPROC

530 :

540 DEFPROCStore

550 IF(FNfile(in$,5)AND1):PROCFile:ENDPROC

560 OSCLI"Dir "+in$:i%=0:REPEAT:in$=FNgbpb8(i%):i%=X%!9

570 IFin$<>"":A%=FNfile(in$,5):IF(A%AND1):nm$="":PROCFile

580 UNTILin$="" OR sect%<0:ENDPROC

590 :

600 DEFPROCFile

610 load%=X%!2:exec%=X%!6:len%=X%!10:attr%=X%!14

620 IF(load%AND&FFFFFF00)=&FFF70000:load%=&30000:exec%=load%:REM Speculator ROM file

630 IF(load%AND&FFFF0000)=&FFF20000:load%=(load%AND&FFFF)OR&30000:exec%=load%:REM Z80Tube file

640 IFlen%>&EFFF:PRINT"File '"in$"' too long":ENDPROC

650 IFlen%=0 :PRINT"File '"in$"' too short":ENDPROC

660 IFin%=0:in%=FNf_openin(in$):IFin%=0:PRINT"File '"in$"' not found":ENDPROC

670 IFembd%:ld%=0:ex%=0:IFlen%>3:PTR#in%=len%-4:ld%=BGET#in%+256*BGET#in%:ex%=BGET#in%+256*BGET#in%:len%=len%-4

680 IFld%<>-1:load%=&30000+ld%:REM Should these be AND &3FFFF ?

690 IFex%<>-1:exec%=&30000+ex% ELSE IFtp%=0:exec%=len%

700 IFnm$="":nm$=FNfn_unbbc(in$)

710 :

720 SpName$ =FNpad(nm$,10)

730 SpStart%=(load%AND&FFFF)

740 SpExtra%=(exec%AND&FFFF)

750 SpLine% =SpStart%

760 SpLen% =len%

770 SpType% =(load%AND&30000)DIV&10000

780 IFtp%<>-1:SpType%=tp%:IFtp%>255:SpType%=-1

790 IF(load%ANDexec%AND&FFFF)=&FFFF:SpType%=-1

800 IFSpType%=0:SpLine% =SpStart%:SpStart%=0

810 IFSpType%=1:SpStart%=SpExtra%:SpExtra%=(SpLine%DIV256)+256*(SpLine%AND255):REM Bigendian

820 IFSpType%=2:SpStart%=SpExtra%:SpExtra%=(SpLine%DIV256)+256*(SpLine%AND255):REM Bigendian

830 :

840 IFvb%:PRINT SpName$" ";:IFSpType%<4:PRINT type$(SpType%+1); ELSE IFvb%:PRINT " &"FNh0(SpType%,2)" ";

850 IFvb%:PRINT " "FNh0(len%,4)" "FNh0(SpStart%,4)" "FNh0(SpExtra%,4)" "FNh0(SpLine%,4);

860 :

870 REM Do first block:

880 off%=9:IF SpType%=-1:off%=0

890 sect%=sect%-1:rec%=0:num%=512-off%:IF len%<num%:num%=len%

900 IF apnd%:PROCFindFreeSector

910 IF FNchkfull:ENDPROC

920 PROCSecHeader

930 mem%!17=num%+off% :REM Record size

940 $(mem%+19)=FNpad(SpName$,10):REM Filename

950 mem%?29=FNsum(15,28) :REM Checksum next 14 bytes

960 mem%?30=SpType%

970 mem%!31=SpLen%

980 mem%!33=SpStart%

990 mem%!35=SpExtra%

1000 mem%!37=SpLine%

1010 PROCf_gbpb(3,in%,mem%+30+off%,num%,0):REM Read first block

1020 mem%?542=FNsum(30,541) :REM Checksum of data

1030 PROCf_gbpb(2,out%,mem%,543,0) :REM Write first block

1040 len%=len%-num%

1050 IF len%<1:CLOSE#in%:in%=0:IFvb%:PRINT

1060 IF len%<1:ENDPROC :REM Only one block

1070 :

1080 REM Do following blocks:

1090 REPEAT

1100 sect%=sect%-1:rec%=rec%+1:num%=512:IF len%<num%:num%=len%

1110 IF apnd%:PROCFindFreeSector

1120 IF FNchkfull:ENDPROC

1130 PROCSecHeader

1140 mem%!17=num% :REM Block size

1150 $(mem%+19)=FNpad(SpName$,10) :REM Filename

1160 mem%?29=FNsum(15,28) :REM Checksum next 14 bytes

1170 PROCf_gbpb(4,in%,mem%+30,num%,0) :REM Read a block

1180 mem%?542=FNsum(30,541) :REM Checksum of data

1190 PROCf_gbpb(2,out%,mem%,543,0) :REM Write a block

1200 len%=len%-num%

1210 UNTIL len%<1:CLOSE#in%:in%=0:IFvb%:PRINT

1220 ENDPROC

1230 :

1240 DEFPROCSecClear:FOR A%=0 TO 542:mem%?A%=0:NEXT:ENDPROC

1250 :

1260 DEFPROCSecHeader

1270 PROCSecClear

1280 mem%?0=1 :REM Header block

1290 mem%?1=sect% :REM Sector number

1300 $(mem%+4)=FNpad(SpTitle$,10) :REM Cartridge name

1310 mem%?14=FNsum(0,13) :REM Checksum first 14 bytes

1320 mem%?15=(SpType%<>-1) AND 4 :REM Data or Print block

1330 IF num%=len%:mem%?15=mem%?15 OR 2:REM EOF block

1340 mem%?16=rec%

1350 ENDPROC

1360 :

1370 DEFPROCFillToEnd

1380 IF sect%<1:ENDPROC :REM Microdrive full

1390 SpType%=-1:rec%=0:num%=0:len%=0

1400 REPEAT:sect%=sect%-1

1410 PROCSecHeader:mem%?15=0 :REM Free block

1420 PROCf_gbpb(2,out%,mem%,543,0)

1430 UNTIL sect%<2:ENDPROC

1440 :

1450 DEFPROCFindFreeSector

1460 PTR#out%=0

1470 REPEAT:mem%!1=0:mem%?15=0

1480 ptr%=PTR#out%:PROCf_gbpb(4,out%,mem%,543,0)

1490 UNTIL mem%!15=0

1500 PTR#out%=ptr%:sect%=mem%!1 AND &FFFF

1510 ENDPROC

1520 :

1530 DEFFNchkfull

1540 IF sect%<1:PRINT'"Microdrive full":CLOSE#in%:in%=0:=TRUE

1550 =FALSE

1560 :

1570 DEFFNsum(st%,en%):LOCAL chk%

1580 FOR A%=st% TO en%:chk%=chk%+mem%?A%:IF chk%<256:chk%=chk%+1 ELSE chk%=chk%+2

1590 chk%=chk%AND&FF:IFchk%<>0:chk%=chk%-1

1600 NEXT:=chk%

1610 :

1620 DEFPROCsyntax:PRINT"Usage: MkMDR outfile infile -append -embed -t title [name [load [exec [type]]]]":ENDPROC

1630 :

1640 DEFFNnul(A$):IF LENA$:=A$ ELSE =""""""

1650 DEFFNpad(A$,L%):A$=LEFT$(A$,L%):=A$+STRING$(L%-LEN A$," ")

1660 DEFFNfn_unbbc(A$):IFA$="" OR os%>7:=""

1670 FORA%=1TOLENA$:IFMID$(A$,A%,1)="/":A$=LEFT$(A$,A%-1)+"."+MID$(A$,A%+1)

1680 NEXT:=A$

1690 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)

1700 :

1710 DEFPROCClose_All:*EXEC

1720 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

1730 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

1740 ENDPROC

1750 :

1760 DEFFNfile(A$,A%):IFPAGE<&FFFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF

1770 A$=FNf_name(A$):IFA%=255 OR A%=5:X%!14=OPENIN(A$):IFX%!14:X%!10=EXT#X%!14:CLOSE#X%!14

1780 IFA%=255:IFX%?6=0:OSCLI"LOAD """+A$+""" "+STR$~X%!2:=1

1790 IFA%=5:IFX%!14:=1 ELSE IF A%=5:=0

1800 IFA%=0:OSCLI"SAVE """+A$+""" "+STR$~X%!10+" "+STR$~X%!14:X%!10=X%!14-X%!10:=1

1810 IFA%=7:OSCLI"SAVE """+A$+""" "+STR$~PAGE+"+"+STR$~X%!10:X%!10=X%!14-X%!10:=1

1820 IFA%=8 THEN

1830 LOCAL ERROR:ON ERROR LOCAL:=2

1840 OSCLI"MKDIR "+A$:=2

1850 ENDIF

1860 =0

1870 :

1880 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))

1890 DEFFNf_openout(A$)=OPENOUT(FNf_name(A$))

1900 DEFFNf_openup(A$)=OPENUP(FNf_name(A$))

1910 DEFFNf_name(A$):IFos%>31:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,"\",A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."

1920 =A$

1930 :

1940 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)

1950 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL &FFD1:ENDPROC

1960 IFA%=1ORA%=3:PTR#?X%=X%!9

1970 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%

1980 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC

1990 :

2000 DEFFNgbpb8(ptr%):IFPAGE>&FFFFF:=""

2010 X%!1=name%:X%!5=1:X%!9=ptr%:A%=8:CALL&FFD1:IFX%!5=1:=""

2020 A%=name%:A%?(1+?A%)=13:=$(A%+1)

2030 :

2040 DEFFNcl(l$,n%):IFl$="":A$=FNs(A$):IFASCA$=34:A%=INSTR(A$+" "" ",""" ",2):l$=MID$(A$,2,A%-2):A$=FNs(MID$(A$,A%+1)):=l$

2050 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$

2060 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE

2070 IFn%=0:IFl$<>"":=FALSE

2080 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""

2090 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))

2100 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))

2110 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$

2120 l$=MID$(A$,A%+1,INSTR(A$+""" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$

2130 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "

2140 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "

2150 =A$

2160 :

2170 DEFFNOS_GetEnv:LOCALA%,X%,Y%,P%,A$:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:DIMX%TRUE

2180 IF!PAGE=&D7C1C7C5:run$=ARGV$(0):IFARGC:FORA%=1TOARGC:A$=A$+ARGV$(A%)+" ":NEXT:=LEFT$(A$,LENA$-1)ELSEIF!PAGE=&D7C1C7C5:=""

2190 IFPAGE>&FFFFF:DIMX%LOCAL256:A$=@cmd$:SYS"GetModuleFileName",0,X%,255:run$=$$X%:Y%=INSTR(@lib$,@tmp$)=0:P%=TRUE

2200 IFP%=0:IFHIMEM>&FFFF:run$=$&8100:SYS"OS_GetEnv"TOA$,,A%:SYS"OS_WriteEnv","",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):P%=TRUE:Y%=TRUE:IFINSTR(A$," ")=0:A$=run$+" "

2210 IFP%=0:P%=X%:[OPT 0:NOP:]:P%=?X%:Y%=TRUE:IFP%=&EAORP%=18:A$=$&600 ELSEIFP%=0:A$=$(PAGE-&300)ELSEIFP%=&A0:A$=$(^@%-256):Y%=?(PAGE-2)AND64ELSEIFP%=&90:A$=$&100:Y%=!&200

2220 A$=" "+A$:REPEATREPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1ELSEA%=INSTR(A$+" "," ")

2230 IFY%:run$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1):Y%=0

2240 UNTILASCA$<>32:=A$

2250 :

2260 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$

2270 ENDPROC

2280 :

2290 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)

2300 IFPAGE>&FFFFF:QUIT A% ELSE END

2310 ENDPROC

2320 :

2330 DEFPROCWin_TextIO

2340 SYS "GetStdHandle",-10 TO @hfile%(1):*INPUT 13

2350 SYS "GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14

2360 SYS "SetConsoleMode",@hfile%(1),0:ENDPROC

2370 :