10
20
30
40 :
50
60
70
80
90 :
100 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END
110 A$=FNOS_GetEnv+" ":IFos%>31:PROCWin_TextIO
120 seclen%=543:DIM ctrl% 31,name% 80,mem% seclen%-1,type$(4):X%=ctrl%:Y%=X%DIV256:wr%=2:rd%=4
130 type$(0)="Print":type$(1)="Basic":type$(2)="Num ":type$(3)="Char ":type$(4)="Bytes"
140 IFA$=" ":INPUT "Source tapefile: "in$:INPUT "Destination microdrive file: "out$:INPUT "Microdrive cartridge title: "title$:A$=in$+" "+out$+" "+title$+" "
150 SpTitle$=FNcl("-t",1)
160
170 A$=A$+" ":vb%=FNcl("-v",0)
180 in$=FNcl("",0):out$=FNcl("",0):IF SpTitle$="":SpTitle$=FNcl("",0)
190 IFin$="-?" OR (in$<>"" AND out$=""):PRINT"Usage: TAPtoMDR <src> <dest> (<title>) -v":PROCexit(0):END
200 IFin$=""ORout$="":PROCexit(0):END
210 :
220 in%=FNf_openin(in$):IFin%=0:PRINT"File '"in$"' not found":PROCexit(214):END
230 PROCf_gbpb(rd%,in%,mem%,10,0):mem%?7=13
240 tap%=(($mem%="ZXTape!"AND4))OR(((!mem%AND&FFFFFF)=&11)AND1)
250 IF(tap%AND4)=0:PTR#in%=0
260
270
280 :
290 out%=FNf_openout(out$):IFout%=0:PRINT"Couldn't open file '"out$"'":CLOSE#in%:in%=0:PROCexit(192):END
300 IFos%<8:A%=FNfile(out$,5):X%?5=&FF:X%?4=&FF:X%?3=&FD:A%=FNfile(out$,1)
310 ok%=TRUE:ON ERROR ok%=FALSE
320 IFos%<8:IFok%:OSCLI"SetType "+out$+" 054":OSCLI"Stamp "+out$
330 :
340 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END
350 IFvb%:PRINT "Filename Type Len Start Extr";
360 sect%=255
370 REPEAT
380 IF(tap%AND4):REPEATUNTILBGET#in%=&10:A%=BGET#in%+BGET#in%
390 len%=(BGET#in%+256*BGET#in%)+(tap%AND1)-1:flag%=BGET#in%
400 IFflag%=&00:PROCRdHeader ELSE IFflag%=&FF:PROCRdData ELSE PROCRdSkip
410 UNTILEOF#in%
420 PROCFillToEnd:BPUT#out%,0:IFvb%:PRINT:
430 CLOSE#out%:out%=0:CLOSE#in%:in%=0:PROCexit(0):END
440 :
450 DEFPROCRdSkip:PTR#in%=PTR#in%+len%:ENDPROC
460 :
470 DEFPROCRdHeader
480 IFlen%>32:PROCRdSkip:ENDPROC :
490 PROCf_gbpb(rd%,in%,mem%,len%,0) :
500 SpType% =mem%?0
510 SpLen% =mem%!11 AND &FFFF
520 SpStart%=mem%!13 AND &FFFF
530 SpExtra%=mem%!15 AND &FFFF
540 mem%?11=13:SpName$=$(mem%+1)
550 IF(SpStart%ANDSpExtra%AND&FFFF)=&FFFF:SpType%=-1 :
560 IFNOTvb%:ENDPROC
570 PRINT'FNfn_clean(SpName$);" ";:IF SpType%<4:PRINT type$(SpType%+1); ELSE PRINT " &"FNh0(SpType%,2)" ";
580 PRINT" "FNh0(SpLen%,4)" "FNh0(SpStart%,4)" "FNh0(SpExtra%,4);
590 ENDPROC
600 :
610 DEFPROCRdData
620 len%=len%-1
630 SpLen% =len%
640 SpLine%=SpStart%
650 IF(SpStart%ANDSpExtra%)=-1:SpType%=-1
660 IFSpType%=0:SpLine% =SpStart%:SpStart%=0
670 IFSpType%=1:SpStart%=SpExtra%:SpExtra%=(SpLine%DIV256)+256*(SpLine%AND255):
680 IFSpType%=2:SpStart%=SpExtra%:SpExtra%=(SpLine%DIV256)+256*(SpLine%AND255):
690 :
700
710 off%=9:IF SpType%=-1:off%=0
720 sect%=sect%-1:rec%=0:num%=512-off%:IFlen%<num%:num%=len%
730 IF FNchkfull:ENDPROC
740 PROCSecHeader
750 mem%!17=num%+9 :
760 $(mem%+19)=FNpad(SpName$,10):
770 mem%?29=FNsum(15,28) :
780 mem%?30=SpType%
790 mem%!31=SpLen%
800 mem%!33=SpStart%
810 mem%!35=SpExtra%
820 mem%!37=SpLine%
830 PROCf_gbpb(4,in%,mem%+30+off%,num%,0):
840 mem%?542=FNsum(30,541) :
850 PROCf_gbpb(2,out%,mem%,543,0) :
860 len%=len%-num%
870 IF len%<1:IF(tap%AND1)=0:A%=BGET#in%
880 IF len%<1:ENDPROC :
890 :
900
910 REPEAT
920 sect%=sect%-1:rec%=rec%+1:num%=512:IF len%<num%:num%=len%
930 IF FNchkfull:ENDPROC
940 PROCSecHeader
950 mem%!17=num% :
960 $(mem%+19)=FNpad(SpName$,10) :
970 mem%?29=FNsum(15,28) :
980 PROCf_gbpb(4,in%,mem%+30,num%,0) :
990 mem%?542=FNsum(30,541) :
1000 PROCf_gbpb(2,out%,mem%,543,0) :
1010 len%=len%-num%
1020 UNTIL len%<1:IF(tap%AND1)=0:A%=BGET#in%
1030 ENDPROC
1040 :
1050 DEFPROCSecClear:FOR A%=0 TO 542:mem%?A%=0:NEXT:ENDPROC
1060 :
1070 DEFPROCSecHeader
1080 PROCSecClear
1090 mem%?0=1 :
1100 mem%?1=sect% :
1110 $(mem%+4)=FNpad(SpTitle$,10) :
1120 mem%?14=FNsum(0,13) :
1130 mem%?15=(SpType%<>-1) AND 4 :
1140 IF num%=len%:mem%?15=mem%?15 OR 2:
1150 mem%?16=rec%
1160 ENDPROC
1170 :
1180 DEFPROCFillToEnd
1190 IF sect%<1:ENDPROC :
1200 SpType%=-1:rec%=0:num%=0:len%=0
1210 REPEAT:sect%=sect%-1
1220 PROCSecHeader:mem%?15=0 :
1230 PROCf_gbpb(2,out%,mem%,543,0)
1240 UNTIL sect%<2:ENDPROC
1250 :
1260 DEFFNchkfull
1270 IF sect%<1:PRINT'"Microdrive full":PTR#in%=EXT#in:=TRUE
1280 =FALSE
1290 :
1300 DEFFNsum(st%,en%):LOCAL chk%
1310 FOR A%=st% TO en%:chk%=chk%+mem%?A%:IFchk%<256:chk%=chk%+1 ELSE chk%=chk%+2
1320 chk%=chk%AND&FF:IFchk%<>0:chk%=chk%-1
1330 NEXT:=chk%
1340 :
1350 DEFFNpad(A$,L%):A$=LEFT$(A$,L%):=A$+STRING$(L%-LEN A$," ")
1360 :
1370 DEFFNfn_clean(A$):IF A$="":=""
1380 FOR A%=1 TO LEN A$:IF MID$(A$,A%,1)<" " OR MID$(A$,A%,1)>"~":A$=LEFT$(A$,A%-1)+"_"+MID$(A$,A%+1)
1390 NEXT:=A$
1400 :
1410 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
1420 :
1430 DEFPROCClose_All:*EXEC
1440 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
1450 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
1460 ENDPROC
1470 :
1480 DEFFNfile(A$,A%):IFPAGE<&FFFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF
1490 =0
1500 :
1510 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))
1520 DEFFNf_openout(A$)=OPENOUT(FNf_name(A$))
1530 DEFFNf_openup(A$)=OPENUP(FNf_name(A$))
1540 DEFFNf_name(A$):IFos%>31:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,"\",A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."
1550 =A$
1560 :
1570 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)
1580 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL &FFD1:ENDPROC
1590 IFA%=1ORA%=3:PTR#?X%=X%!9
1600 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
1610 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
1620 :
1630 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$
1640 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$
1650 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE
1660 IFn%=0:IFl$<>"":=FALSE
1670 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""
1680 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))
1690 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))
1700 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$
1710 l$=MID$(A$,A%+1,INSTR(A$+""" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$
1720 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
1730 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
1740 =A$
1750 :
1760 DEFFNOS_GetEnv:LOCALA%,X%,Y%,P%,A$:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:DIMX%TRUE
1770 IF!PAGE=&D7C1C7C5:run$=ARGV$(0):IFARGC:FORA%=1TOARGC:A$=A$+ARGV$(A%)+" ":NEXT:=LEFT$(A$,LENA$-1)ELSEIF!PAGE=&D7C1C7C5:=""
1780 IFPAGE>&FFFFF:DIMX%LOCAL256:A$=@cmd$:SYS"GetModuleFileName",0,X%,255:run$=$$X%:Y%=INSTR(@lib$,@tmp$)=0:P%=TRUE
1790 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$+" "
1800 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
1810 A$=" "+A$:REPEATREPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1ELSEA%=INSTR(A$+" "," ")
1820 IFY%:run$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1):Y%=0
1830 UNTILASCA$<>32:=A$
1840 :
1850 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$
1860 ENDPROC
1870 :
1880 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)
1890 IFPAGE>&FFFFF:QUIT A% ELSE END
1900 ENDPROC
1910 :
1920 DEFPROCWin_TextIO
1930 SYS "GetStdHandle",-10 TO @hfile%(1):*INPUT 13
1940 SYS "GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14
1950 SYS "SetConsoleMode",@hfile%(1),0:ENDPROC
1960 :