10
20
30
40
50
60
70
65
80 :
90 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END
100 A$=FNOS_GetEnv+" ":PROCf_init:IFos%>31:PROCWin_TextIO
110 DIM ctrl% 31,name% 80,type$(3):X%=ctrl%:Y%=X%DIV256:wr%=2:rd%=4
120 type$(0)="Basic":type$(1)="Num ":type$(2)="Char ":type$(3)="Bytes"
130 IFA$=" ":INPUT "Source file: "in$:INPUT "Destination dir: "outd$:INPUT "Options/flags: "A$:A$=in$+" "+outd$+" "+A$
140 ro%=FNcl("-r",0)
150
160 A$=A$+" ":vb%=FNcl("-v",0)
170 in$=FNcl("",1):outd$=FNcl("",1):IFoutd$<>"":IFRIGHT$(outd$,1)=d$:outd$=LEFT$(outd$,LENoutd$-1)
180 IFin$="-?":PRINT"Usage: UnTAP <src> (<destdir>) -v -ro":PROCexit(0):END
190 IFin$="":PROCexit(0):END
200 :
210 in%=FNf_openin(in$):IFin%=0:PRINT"File '"in$"' not found":PROCexit(214):END
220 IFoutd$<>"":PROCf_cdir(outd$):outd$=outd$+d$
230 DIM A%-1:max%=HIMEM-A%-2500:DIM mem% max%
240 PROCf_gbpb(rd%,in%,mem%,10,0):mem%?7=13
250 tap%=(($mem%="ZXTape!"AND4))OR(((!mem%AND&FFFFFF)=&11)AND1)
260 IF(tap%AND4)=0:PTR#in%=0
270 :
280 IFvb%:PRINT "Filename Type Start Extr Len";
290 REPEAT:IF(tap%AND4):REPEATUNTILBGET#in%=&10:A%=BGET#in%+BGET#in%
300 num%=(BGET#in%+256*BGET#in%)-1+(tap%AND1):flag%=BGET#in%
310 IFflag%=&00:PROCRdHeader ELSE IFflag%=&FF:PROCRdData ELSE PROCRdSkip
320 UNTILEOF#in%:CLOSE#in%:in%=0:IFvb%:PRINT
330 PROCexit(0):END
340 :
350 DEFPROCRdSkip:PTR#in%=PTR#in%+num%:ENDPROC
360 :
370 DEFPROCRdHeader
380 IFnum%>max%:PROCRdSkip:ENDPROC :
390 PROCf_gbpb(rd%,in%,mem%,num%,0) :
400 SpType% =mem%?0
410 SpLen% =(mem%!11)AND&FFFF
420 SpStart%=(mem%!13)AND&FFFF
430 SpExtra%=(mem%!15)AND&FFFF
440 mem%?11=13:SpName$=$(mem%+1)
450 IFNOTvb%:ENDPROC
460 PRINT'FNfn_clean(SpName$);" ";:IFro%:PROCHeaderRO ELSE PROCHeaderZX
470 ENDPROC
480 :
490 DEFPROCHeaderZX
500 IF SpType%<4:PRINT type$(SpType%); ELSE PRINT " &"FNh0(SpType%,2)" ";
510 PRINT" "FNh0(SpStart%,4)" "FNh0(SpExtra%,4)" "FNh0(SpLen%,4);
520 ENDPROC
530 :
540 DEFPROCHeaderRO
550 PRINTFNhi(SpType%);FNh0(SpStart%,4);" ";FNhi(SpType%);FNh0(SpExtra%,4);" ";FNh0(SpLen%,4);
560 ENDPROC
570 :
580 DEFPROCRdData
590 num%=num%-1+(tap%AND1):SpName$=FNs(SpName$):out$=outd$+FNfn_unspec(SpName$)
600 len%=num%:IFlen%>max%:len%=max%
610 PROCf_gbpb(rd%,in%,mem%,len%,0)
620 OSCLI"Save "+FNf_name(out$)+" "+STR$~mem%+"+"+STR$~num%+" "+STR$~(SpType%*&10000+SpExtra%)+" "+STR$~(SpType%*&10000+SpStart%)
630 num%=num%-len%:IFnum%<1:IF(tap%AND1)=0:chk%=BGET#in%
640 IFnum%<1:ENDPROC
650 out%=FNf_openup(out$):PTR#out%=len%
660 REPEAT
670 len%=num%:IFlen%>max%:len%=max%
680 PROCf_gbpb(rd%,in%,mem%,len%,0)
690 PROCf_gbpb(wr%,out%,mem%,len%,0)
700 num%=num%-len%:UNTIL num%<1
710 IF(tap%AND1)=0:chk%=BGET#in%
720 CLOSE#out%:out%=0:ENDPROC
730 :
740 DEFFNfn_clean(A$):IF A$="":=""
750 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)
760 NEXT:=A$
770 :
780 DEFFNfn_unspec(B$):IF B$="":="_"
790 LOCALB%,C$:A$="""#$%&:<>*.@[\]^{|}~":C$="'?S;+;()+/=(/)'(')'"
800 IF(os%AND-24):A$=""":<>?*/\|":C$="';()#+..'":IF(os%AND-32):A$="""?*/":C$="'#+."
810 FOR A%=1 TO LEN B$:B%=INSTR(A$,MID$(B$,A%,1))
820 IF B%:B$=LEFT$(B$,A%-1)+MID$(C$,B%,1)+MID$(B$,A%+1)
830 IF MID$(B$,A%,1)<"!" OR MID$(B$,A%,1)>"~":B$=LEFT$(B$,A%-1)+"_"+MID$(B$,A%+1)
840 NEXT:=B$
850 :
860 DEFFNhi(A%)
870 IFA%<3:=FNh0(A%,2) ELSE =FNh0(-1,2)
880 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
890 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
900 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
910 =A$
920 :
930 DEFPROCClose_All:*Exec
940 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
950 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
960 ENDPROC
970 :
980 DEFPROCf_init
990 d$=".":s$="/":IFos%AND40:d$="/":s$=".":IFos%>31:d$="\"
1000 ENDPROC
1010 :
1020 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))
1030 DEFFNf_openout(A$)=OPENOUT(FNf_name(A$))
1040 DEFFNf_openup(A$)=OPENUP(FNf_name(A$))
1050 DEFFNf_name(A$):IFos%>31:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,"\",A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."
1060 =A$
1070 :
1080 DEFPROCf_cdir(A$)
1090 IF(os%AND40):A$="mkdir "+A$ ELSE A$="cdir "+A$
1100 IF FALSE THEN
1110 OSCLIA$:ENDPROC
1120 ENDIF
1130 LOCAL ERROR:ON ERROR LOCAL:ENDPROC
1140 OSCLIA$
1150 ENDPROC
1160 :
1170 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)
1180 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL &FFD1:ENDPROC
1190 IFA%=1ORA%=3:PTR#?X%=X%!9
1200 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
1210 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
1220 :
1230 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$
1240 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$
1250 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE
1260 IFn%=0:IFl$<>"":=FALSE
1270 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""
1280 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))
1290 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))
1300 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$
1310 l$=MID$(A$,A%+1,INSTR(A$+""" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$
1320 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
1330 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
1340 =A$
1350 :
1360 DEFFNOS_GetEnv:LOCALA%,X%,Y%,P%,A$:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:DIMX%TRUE
1370 IF!PAGE=&D7C1C7C5:run$=ARGV$(0):IFARGC:FORA%=1TOARGC:A$=A$+ARGV$(A%)+" ":NEXT:=LEFT$(A$,LENA$-1)ELSEIF!PAGE=&D7C1C7C5:=""
1380 IFPAGE>&FFFFF:DIMX%LOCAL256:A$=@cmd$:SYS"GetModuleFileName",0,X%,255:run$=$$X%:Y%=INSTR(@lib$,@tmp$)=0:P%=TRUE
1390 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$+" "
1400 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
1410 A$=" "+A$:REPEATREPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1ELSEA%=INSTR(A$+" "," ")
1420 IFY%:run$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1):Y%=0
1430 UNTILASCA$<>32:=A$
1440 :
1450 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$
1460 ENDPROC
1470 :
1480 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)
1490 IFPAGE>&FFFFF:QUIT A% ELSE END
1500 ENDPROC
1510 :
1520 DEFPROCWin_TextIO
1530 SYS "GetStdHandle",-10 TO @hfile%(1):*INPUT 13
1540 SYS "GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14
1550 SYS "SetConsoleMode",@hfile%(1),0:ENDPROC
1560 :