REM > MkTorch v0.02
      REM v0.01 File name handling assumes Windows
      REM v0.02 Fixed allocation table and overflow, directory overflow, forces upper case
      :
      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)
      
      :
      DEFPROCmkcpn(indir$,out$,dsd%)
      ssd%=(dsd%=0)
      
      REM track_number  = track<<2 + head
      REM sector_number = track_number<<4 + sector
      
      REM logical sector number:
      REM %ttttttttttthssss
      REM  ||||||||||||++++--- sector      0-15
      REM  |||||||||||+------- head (side) 0-1
      REM  +++++++++++-------- track       0-2047
      REM  sector number allows up to 16M disk
      
      REM Sector
      REM &0000-&0009 directory
      REM &000A-&000F reserved
      REM &0010-&0015 directory
      REM &0016-&0017 allocation map, bit n=sector n is not free - space for up to 512K disk
      REM &0018       test pattern
      REM &0019       system information
      REM &001A-&001F reserved
      REM &0020-      data
      
      REM Directory
      REM &00-&01 sector of allocation block
      REM           &0000=end of dir, &0000+n=L3 block, &8000+n=L2 block
      REM &02-&03 size in 128-byte records
      REM &04     user number
      REM &05-&0C file name
      REM &0D-&0F file extension
      
      REM L3 Allocation block
      REM &00-&01 sector of bytes 0-255, b14 set if 0-127 written, b15 set if 128-255 written
      REM &02-&03 sector of bytes 256-512, b14 set if 0-127 written, b15 set if 128-255 written
      REM etc.
      
      REM L2 Allocation block
      REM &00-&01 sector of first L3 allocation block
      REM &02-&03 sector of second L3 allocation block
      REM etc.
      
      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                                 :REM Clear to end of directory
      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                           :REM Allocation table
      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)       :REM Test pattern
      FOR A%=0 TO 255 STEP 4:data%!A%=0:NEXT A%:PROCwrite(data%,256,&1900)     :REM System information
      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%           :REM Allocation block
      data%!2=fsize%         :REM File size in 128-byte records
      data%?4=0              :REM User number
      $(data%+5)=FNuc(fname$):REM File name
      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$<>"":="":REM Not yet supported
      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":="":REM Non-Windows not yet supported
      LOCAL dir%,sh%:DIM dir% LOCAL 319:X%!9=ptr%+1
        "FindFirstFile",dir$+"\*.*",dir% TO sh%
      IF sh%<>-1 THEN
      REPEAT:A$=$$(dir%+44):IF A$="." OR A$="..":ptr%=ptr%+1
        IF ptr%=0:  "FindClose",sh%:=A$
        ptr%=ptr%-1:  "FindNextFile",sh%,dir% TO res%
      UNTIL res%=0:  "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$