10 REM > MDRCat 1.15
   20 REM (C) J.G.Harston
   30 REM List files in MDR files
   40 REM v1.11
   50 REM v1.15 Added -dec option, cleaned filename, finds length of Print files
   60 :
   70 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR):END
   80 seclen%=543:DIM ctrl% 31,secbuf% seclen%-1,type$(4):in%=0:X%=ctrl%:Y%=X%DIV256
   90 A$=FNOS_GetEnv:IFos%>31:PROCWin_TextIO
  100 ro$="":IFA$="":INPUT"Input microdrive file: "A$
  110 A%=INSTR(A$+" "," "):IFA%:in$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1)
  120 A%=INSTR(A$+" "," "):IFA%:ro$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1)
  130 IFin$="-?":PRINT"Syntax: MDRCat <filename> (-hex|-dec)":PROCexit(0):END
  140 in%=FNf_openin(in$):IF in%=0:PRINT"'"in$"' not found":PROCexit(214):END
  150 type$(0)="Print":type$(1)="Basic":type$(2)="Numb ":type$(3)="Char ":type$(4)="Bytes"
  160 :
  170 ro%=LEFT$(ro$,2)="-r"
  180 hx%=LEFT$(ro$,2)<>"-d"
  190 IFro%=0:PRINT"Filename   Type "SPC(2+hx%)"Len"SPC(2+hx%)"Start"SPC(2+hx%)"Extr"SPC(2+hx%)"Line";
  200 IFro%:  PRINT"Filename   Start  Len  Extr   Line";
  210 ptr%=0:REPEAT:PROCHeader
  220   IF secbuf%?16=0 AND ((secbuf%?18 OR secbuf%?15) AND 2)=2 AND (secbuf%!17 AND &FFFF)<>0:PROCDisp
  230 UNTIL EOF#in% OR PTR#in%+seclen%>EXT#in%:PRINT
  240 CLOSE#in%:in%=0:PROCexit(0):END
  250 :
  260 DEFPROCHeader
  270 PROCgbpb(4,in%,secbuf%,40,0):PTR#in%=PTR#in%+seclen%-40:secbuf%?29=13
  280 ENDPROC
  290 :
  300 DEFPROCInfo
  310 f$=$(secbuf%+19)
  320 type% =secbuf%?30
  330 num%  =secbuf%!31 AND &FFFF
  340 start%=secbuf%!33 AND &FFFF
  350 exec% =secbuf%!35 AND &FFFF
  360 line% =secbuf%!37 AND &FFFF
  370 IF (secbuf%?15 AND 4):ENDPROC
  380 type%=-1:start%=-1:exec%=-1:line%=-1:num%=0
  390 ptr%=PTR#in%:PTR#in%=0:REPEAT:PROCHeader
  400   IF $(secbuf%+19)=f$:IF (secbuf%?15 AND 2)=2:num%=secbuf%?16*512+(secbuf%!17 AND &FFFF)
  410 UNTIL EOF#in% OR PTR#in%+seclen%>EXT#in%
  420 PTR#in%=ptr%
  430 ENDPROC
  440 :
  450 DEFPROCDisp
  460 PROCInfo:PRINT'FNfn_clean(f$);" ";
  470 IF ro%:PRINTFNhi(type%)FNh0(start%,4)"+"FNh0(num%,4)" "FNhi(type%)FNh0(exec%,4)" "FNh0(line%,4);:ENDPROC
  480 IF type%<4:PRINTtype$(type%+1); ELSE PRINT" &"FNh0(type%,2)" ";
  490 IF hx%  :PRINT" "FNh0(num%,4)" "FNh0(start%,4)" "FNh0(exec%,4)" "FNh0(line%,4);
  500 IF hx%=0:PRINT" "FNd(num%,5)" "FNd(start%,5)" "FNd(exec%,5)" "FNd(line%,5);
  510 ENDPROC
  520 :
  530 DEFFNfn_clean(A$):IF A$="":=""
  540 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)
  550 NEXT:=A$
  560 :
  570 DEFFNhi(A%):IF A%<3:=FNh0(A%,2) ELSE =FNh0(-1,2)
  580 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
  590 DEFFNd(A%,N%)=RIGHT$("       "+STR$A%,N%)
  600 :
  610 DEFPROCClose_All:*EXEC
  620 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
  630 ENDPROC
  640 :
  650 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))
  660 DEFFNf_name(A$):IFos%>31:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,"\",A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."
  670 =A$
  680 :
  690 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%)
  700 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL &FFD1:ENDPROC
  710 IFA%=1ORA%=3:PTR#?X%=X%!9
  720 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
  730 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
  740 :
  750 DEFFNOS_GetEnv:LOCALA%,X%,Y%,P%,A$:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:DIMX%TRUE
  760 IF!PAGE=&D7C1C7C5:run$=ARGV$(0):IFARGC:FORA%=1TOARGC:A$=A$+ARGV$(A%)+" ":NEXT:=LEFT$(A$,LENA$-1)ELSEIF!PAGE=&D7C1C7C5:=""
  770 IFPAGE>&FFFFF:DIMX%LOCAL256:A$=@cmd$:SYS"GetModuleFileName",0,X%,255:run$=$$X%:Y%=INSTR(@lib$,@tmp$)=0:P%=TRUE
  780 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$+" "
  790 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
  800 A$=" "+A$:REPEATREPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1ELSEA%=INSTR(A$+" "," ")
  810   IFY%:run$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1):Y%=0
  820 UNTILASCA$<>32:=A$
  830 :
  840 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$
  850 ENDPROC
  860 :
  870 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)
  880 IFPAGE>&FFFFF:QUIT A% ELSE END
  890 ENDPROC
  900 :
  910 DEFPROCWin_TextIO
  920 SYS "GetStdHandle",-10 TO @hfile%(1):*INPUT 13
  930 SYS "GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14
  940 SYS "SetConsoleMode",@hfile%(1),0:ENDPROC
  950 :