PROGRAM dirfile(input,output);

{by Steve Clamage}

{reads disk directory, optionally sorts it, writes it to FILES.SUB}

CONST
    MAXNAMES = 200;             {max file names in directory}
    SRCHF = 17;                 {CP/M search for first}
    SRCHN = 18;                 {CP/M search for next}
    SETDMA = 26;                {CP/M set dma address}

TYPE
    NAMEREC = 
        record
            name : string[12];
            ext  : string[3];
        end;

    SORTTYPE = (NOSORT, BYFILE, BYEXTN);

VAR
    i, loc, nfiles : INTEGER;
    leader, trailer : STRING;
    fname : STRING;
    extn : STRING[3];
    store : array [0 .. MAXNAMES] of NAMEREC;
    sentinel : NAMEREC;
    fcb : array [0 .. 35] of CHAR;
    buf : array [0 .. 127] of CHAR;
    fileout : TEXT;
    optn : CHAR;
    howsort : SORTTYPE;

{call BDOS}
	EXTERNAL FUNCTION @bdos(func, parm : INTEGER) : INTEGER;
{validate file name}
	EXTERNAL FUNCTION cpmname(filename : STRING) : BOOLEAN;

PROCEDURE getfname;		{get file name into fname, extn}
    VAR
        j : INTEGER;
    BEGIN
        fname[0] := chr(0);
        extn[0] := chr(0);
        for j := 1 to 8 do
            if buf[loc+j] <> ' ' then
              begin
                fname[j] := buf[loc+j];
                fname[0] := chr(j);
              end;
        for j := 9 to 11 do
            if buf[loc+j] <> ' ' then
              begin
                extn[j-8] := buf[loc+j];
                extn[0] := chr(j-8);
              end;
    END;

PROCEDURE putfname;		{insert file name into output buffer}
    VAR                         {insertion sort algorithm}
        pos, i : INTEGER;
    BEGIN
        if (howsort = NOSORT) or (nfiles = 0) then      {don't sort}
            pos := nfiles
        else if howsort = BYFILE then           {insert by file name}
          begin
            pos := 0;
            while fname > store[pos].name do    {start of this name}
                pos := pos + 1;
            while (fname = store[pos].name) 
	    and (extn > store[pos].ext) do	{ext within file name}
                pos := pos + 1;
          end
        else if howsort = BYEXTN then           {insert by extension}
          begin
            pos := 0;
            while extn > store[pos].ext do      {start of this extention}
                pos := pos + 1;
            while (extn = store[pos].ext) 
	    and (fname > store[pos].name) do	{file name within ext}
                pos := pos + 1;
          end;
        for i := nfiles downto pos do		{make space for new entry}
            store[i+1] := store[i];
        store[pos].name := fname;
        store[pos].ext := extn;
        nfiles := nfiles + 1;
    END;

{main entry point}

BEGIN
    fcb[0] := chr(0);                   {initialize file control block}
    for i := 1 to 11 do
        fcb[i] := '?';
    for i := 12 to 35 do
        fcb[i] := chr(0);

    sentinel.name := '~~~~~~~~';        {sentinel to terminate search}
    sentinel.ext := '~~~';
    store[0] := sentinel;

    repeat                              {ask for sorting method}
        writeln;
        write ('SORT: No sort, by Extension, by Filename (N, E, F)? ');
        readln(optn);
        if optn > 'a' then              {convert to uppercase}
            optn := chr(ord(optn) - ord(' '));
    until optn in ['N', 'E', 'F'];
    case optn of
        'N' : howsort := NOSORT;
        'E' : howsort := BYEXTN;
        'F' : howsort := BYFILE;
    end;

    nfiles := 0;                        {number of file names}
    i := @bdos(SETDMA, addr(buf));      {set dma address}
    loc := 32 * @bdos(SRCHF, addr(fcb)); {get first file name}
    while loc <= 32*3 do                {sort all names into store[]}
      begin
        getfname;
        putfname;
        loc := 32 * @bdos(SRCHN, addr(fcb));    {get next file name}
    end;

    writeln;
    write ('Leader?  ');                {example:  B:=A:  }
    readln(leader);
    write ('Trailer? ');                {example:  [V]    }
    readln(trailer);

{write out results}

    repeat
        write ('Output file name? ');
        readln(fname);
    until cpmname(fname);
    assign (fileout, fname);
    rewrite(fileout);
    for i := 0 to nfiles-1 do
      begin
        if length(store[i].ext) > 0 then
            fname := concat(store[i].name, '.', store[i].ext)
        else
            fname := store[i].name;
        writeln(fileout, leader, fname, trailer)
      end;
    close(fileout, i);
    writeln(nfiles, ' file names written');

END.