10
20
30
40
50
60
70
80
90
100
110
120
130
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
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:
450 CLOSE#out%:out%=0:PROCexit(0):END
460 :
470
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%:
630 IF(load%AND&FFFF0000)=&FFF20000:load%=(load%AND&FFFF)OR&30000:exec%=load%:
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%:
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):
820 IFSpType%=2:SpStart%=SpExtra%:SpExtra%=(SpLine%DIV256)+256*(SpLine%AND255):
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
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% :
940 $(mem%+19)=FNpad(SpName$,10):
950 mem%?29=FNsum(15,28) :
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):
1020 mem%?542=FNsum(30,541) :
1030 PROCf_gbpb(2,out%,mem%,543,0) :
1040 len%=len%-num%
1050 IF len%<1:CLOSE#in%:in%=0:IFvb%:PRINT
1060 IF len%<1:ENDPROC :
1070 :
1080
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% :
1150 $(mem%+19)=FNpad(SpName$,10) :
1160 mem%?29=FNsum(15,28) :
1170 PROCf_gbpb(4,in%,mem%+30,num%,0) :
1180 mem%?542=FNsum(30,541) :
1190 PROCf_gbpb(2,out%,mem%,543,0) :
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 :
1290 mem%?1=sect% :
1300 $(mem%+4)=FNpad(SpTitle$,10) :
1310 mem%?14=FNsum(0,13) :
1320 mem%?15=(SpType%<>-1) AND 4 :
1330 IF num%=len%:mem%?15=mem%?15 OR 2:
1340 mem%?16=rec%
1350 ENDPROC
1360 :
1370 DEFPROCFillToEnd
1380 IF sect%<1:ENDPROC :
1390 SpType%=-1:rec%=0:num%=0:len%=0
1400 REPEAT:sect%=sect%-1
1410 PROCSecHeader:mem%?15=0 :
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 :