:
DIM ctrl% 31,data% 512,name% 31:X%=ctrl%:Y%=X%DIV256
PRINT "MkTorch - Create Torch CPN disk images from source files"
INPUT "Source directory: "indir$:IF indir$="":indir$="CISCobol"
INPUT "Output file: "out$:IF out$="":out$="COBOLCPN.ssd"
IF MID$(out$,LENout$-3,1)=".":out$=LEFT$(out$,LENout$-4)
PROCmkcpn(indir$,out$+".ssd",FALSE)
PROCmkcpn(indir$,out$+".dsd",TRUE)
QUIT
:
DEFPROCmkcpn(indir$,out$,dsd%)
ssd%=(dsd%=0)
dirend%=0
diskend%=&20
out%=OPENOUT(out$)
idx%=0
REPEAT:file$=FNf_scan(indir$,idx%):idx%=X%!9:IF file$<>"":PROCaddfile(file$)
UNTIL file$=""
data%!0=0:data%!4=0:data%!8=0:data%!12=0 :
IF dirend%<256:REPEAT:PROCwrite(data%,16,dirend%*16):dirend%=dirend%+1:UNTIL dirend%>255
FOR A%=0 TO 511 STEP 4:data%!A%=&FC00FC00:NEXT :
FOR A%=0 TO diskend%-1:data%?(A%DIV8)=data%?(A%DIV8) OR 2^(A%AND7):NEXT
PROCwrite(data%,512,&1600)
FOR A%=0 TO 255:data%?A%=A%+&D6:NEXT A%:PROCwrite(data%,256,&1800) :
FOR A%=0 TO 255 STEP 4:data%!A%=0:NEXT A%:PROCwrite(data%,256,&1900) :
CLOSE#out%:out%=0
ENDPROC
:
DEFPROCaddfile(file$)
fname$=file$:IF RIGHT$(file$,4)=",fe4":fname$=LEFT$(file$,LENfile$-4)
PRINT fname$;SPC(14-LENfname$);
IF dirend%>255:PRINT " - directory full":ENDPROC
in%=OPENIN(indir$+"\"+file$):IF in%=0:in%=OPENIN(indir$+"\"+file$+",fe4")
IF in%=0:PRINT" - can't open":ENDPROC
A%=INSTR(fname$,"."):fname$=LEFT$(LEFT$(fname$,A%-1)+" ",8)+LEFT$(MID$(fname$,A%+1)+" ",3)
fsize%=(EXT#in%+127)DIV128:IF fsize%:fsize%=fsize%-1
PRINT FNh0(EXT#in%,6);" ";FNh0(fsize%,4);
:
dir0%=dirend%:disk0%=diskend%
sec%=FNnextsec:IF FNdiskfull:ENDPROC
PRINT " ";FNh0(sec%,4);" T:";FNd0(sec%DIV&20,3);" H:";(sec%DIV&10)AND1;" S:";sec%AND15;
l2%=0:a2%=2:l3%=sec%:a3%=0
IF fsize%>256:l2%=l3%:l3%=FNnextsec:!data%=l3%:PROCwrite(data%,2,l2%*256):sec%=sec% OR &8000:IF FNdiskfull:ENDPROC
data%!0=sec% :
data%!2=fsize% :
data%?4=0 :
$(data%+5)=FNuc(fname$):
PROCwrite(data%,16,dirend%*16)
dirend%=dirend%+1
REPEAT
sec%=FNnextsec:IF FNdiskfull:ENDPROC
!data%=sec% OR &C000
PROCwrite(data%,2,l3%*256+a3%):a3%=a3%+2
IF a3%>255:l3%=FNnextsec:!data%=l3%:PROCwrite(data%,2,l2%*256+a2%):a2%=a2%+2:a3%=0
FOR A%=0 TO 255 STEP 4:data%!A%=0:NEXT
PROCf_gbpb(4,in%,data%,256,0)
PROCwrite(data%,256,sec%*256)
fsize%=fsize%-2
UNTIL fsize%<0
CLOSE#in%:in%=0:PRINT
ENDPROC
:
DEFFNnextsec
A%=diskend%:diskend%=diskend%+1:IF (diskend% AND 15)=10:diskend%=diskend%+6
=A%
:
DEFFNdiskfull:IF diskend%<=&A00 OR ssd%=0:=FALSE
PRINT " - disk full":CLOSE#in%:in%=0:diskend%=disk0%:dirend%=dir0%:=TRUE
:
DEFPROCwrite(addr%,num%,ptr%):LOCAL hd%,tk%
IF ssd%:hd%=(ptr% DIV &1000) AND 1:tk%=ptr% DIV &2000
IF ssd%:ptr%=(hd%*80+tk%)*&A00+(ptr% AND &FFF)
IF dsd%:ptr%=(ptr% DIV &1000)*&A00+(ptr% AND &FFF)
PROCf_gbpb(1,out%,addr%,num%,ptr%)
ENDPROC
:
DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)
?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFF:CALL&FFD1:ENDPROC
IFA%=1ORA%=3:PTR#?X%=X%!9
REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
:
DEFFNf_scan(dir$,ptr%):X%!1=name%:X%!5=1:X%!9=ptr%
IF PAGE<&FFFF:IF dir$<>"":="":
IF PAGE<&FFFF:A%=8:CALL&FFD1:IFX%!5=1:=""
IF PAGE<&FFFF:A%=name%+1:A%!(A%?-1)=&D20:A%?(INSTR($A%," ")-1)=13:=$A%
IF INKEY-256<>ASC"W":="":
LOCAL dir%,sh%:DIM dir% LOCAL 319:X%!9=ptr%+1
SYS "FindFirstFile",dir$+"\*.*",dir% TO sh%
IF sh%<>-1 THEN
REPEAT:A$=$$(dir%+44):IF A$="." OR A$="..":ptr%=ptr%+1
IF ptr%=0:SYS "FindClose",sh%:=A$
ptr%=ptr%-1:SYS "FindNextFile",sh%,dir% TO res%
UNTIL res%=0:SYS "FindClose",sh%
ENDIF
=""
:
DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
DEFFNuc(A$):IFA$="":=""
FORA%=1TOLENA$:IFMID$(A$,A%,1)>"_":A$=LEFT$(A$,A%-1)+CHR$(ASCMID$(A$,A%,1)AND&5F)+MID$(A$,A%+1)
NEXT:=A$