$title ('SDIR - Display Files')
display:
do;
                 /*  Display Module for SDIR */

$include(comlit.lit)

$include(mon.plm)

dcl (cur$drv, cur$usr) byte external;

dcl (os,bdos) byte external;
$include(vers.lit)

dcl used$de address external;        /* number of used directory entries */

dcl sorted boolean external;
dcl filesfound address external;

$include (search.lit)
dcl find find$structure external;

dcl format byte external,       /* format is one of the following */
    page$len address external,  /* page size before printing new headers */
    message boolean external,   /* print titles and msg when no file found */
    formfeeds boolean external; /* use form feeds to separate headers */

$include(format.lit)

dcl file$displayed boolean public initial (false);
              /* true if we ever display a file, from any drive or user */
              /* used by main.plm for file not found message            */

dcl dir$label byte external;

$include(fcb.lit)
$include(xfcb.lit)

dcl
        buf$fcb$adr address external,       /* index into directory buffer  */
        buf$fcb based buf$fcb$adr (32) byte,
                                            /* fcb template for dir         */

        (f$i$adr,last$f$i$adr,first$f$i$adr) address external,
        cur$file address;                   /* number of file currently     */
                                            /* being displayed              */

$include(finfo.lit)
                                            /* structure of file info       */ 
dcl     file$info based f$i$adr f$info$structure;

dcl     x$i$adr address external,
        xfcb$info based x$i$adr x$info$structure;

dcl     f$i$indices$base address external,  /* if sorted then f$i$indices   */
        f$i$indices based f$i$indices$base (1) address; /* are here         */


/* -------- Routines in util.plm -------- */

printchar: procedure (char) external;
    dcl char byte;
end printchar;

print: procedure (string$adr) external;      /* BDOS call # 9               */
    dcl string$adr address;
end print;

printb: procedure external;
end printb;

crlf: procedure external;
end crlf;

printfn: procedure(fname$adr) external;
    dcl fname$adr address;
end printfn;

pdecimal: procedure(v,prec,zerosup) external;
                       /* print value val, field size = (log10 prec) + 1  */
                       /* with leading zero suppression if zerosup = true */
    declare v address,                           /* value to print        */
            prec address,                        /* precision             */
            zerosup boolean;                     /* zero suppression flag */
end pdecimal;

p3byte: procedure(byte3adr,prec)external;
                                /* print 3 byte value with 0 suppression */
      dcl (byte3adr,prec) address; /* assume high order bit is < 10         */
end p3byte;

add3byte: procedure (byte3$adr,word$amt) external;
    dcl (byte3$adr, word$amt) address;
end add3byte;            /* add word to 3 byte structure */

add3byte3: procedure (byte3$adr,byte3) external;
    dcl (byte3$adr, byte3) address;
end add3byte3;            /* add 3 byte quantity to 3 byte total */

shr3byte: procedure (byte3$adr) external;
    dcl byte3$adr address;
end shr3byte;


/* -------- Routines in search.plm -------- */

search$first: procedure(fcb$adr) byte external;
    dcl fcb$adr address;
end search$first;

search$next: procedure byte external;
end search$next;

break: procedure external;
end break;

match: procedure boolean external;
    dcl fcb$adr address;
end match;


/* -------- Other external routines -------- */

display$time$stamp: procedure (ts$adr) external;     /* in dts.plm */
    dcl ts$adr address;
end display$time$stamp;

terminate: procedure external;                       /* in main.plm */
end terminate;

mult23: procedure(index) address external;           /* in sort.plm */
    dcl index address;
end mult23;


/* -------- From dpb86.plm or dpb80.plm -------- */

$include(dpb.lit)

dpb$byte: procedure (dpb$index) byte external;
    dcl dpb$index byte;
end dpb$byte;

dpb$word: procedure (dpb$index) address external;
    dcl dpb$index byte;
end dpb$word;


/* -------- routines and data structures local to this module -------- */

dcl     total$kbytes structure (    /* grand total k bytes of files matched */
          lword address,
          hbyte byte),
        total$recs structure (      /* grand total records of files matched */
          lword address,
          hbyte byte),
        total$1k$blocks structure(  /* how many 1k blocks are allocated     */
          lword address,
          hbyte byte);
 
add$totals: procedure;

    call add3byte(.total$kbytes,file$info.kbytes);
    call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
    call add3byte(.total$1k$blocks,file$info.onekblocks);
    
end add$totals;


dcl files$per$line byte;
dcl cur$line address;

dcl hdr (*) byte data      ('    Name     Bytes   Recs   Attributes $');
dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
dcl hdr$pu (*) byte data        ('  Prot      Update    $');
dcl hdr$xfcb$bars (*) byte data (' ------ --------------  --------------$');
dcl hdr$access (*) byte data                          ('      Access    $');
dcl hdr$create (*) byte data                          ('      Create    $');
                                   /* example date        04/02/55 00:34  */

display$file$info: procedure;
                                                    /* print filename.typ   */
    call printfn(.file$info.name(0));
    call printb;
    call pdecimal(file$info.kbytes,10000,true);
    call printchar('k');                           /* up to 32 Meg - Bytes  */
                                                   /* or 32,000k            */
    call printb;
    call p3byte(.file$info.recs$lword,1);          /* records               */
    call printb;
    if rol(file$info.name(f$dirsys-1),1) then      /* Type                  */
       call print(.('Sys$'));
    else call print(.('Dir$'));
    call printb;
    if rol(file$info.name(f$rw-1),1) then
        call print(.('RO$'));
    else call print(.('RW$'));
    call printb;
    if  rol(file$info.name(f$arc-1),1) then        /* arc bit was on in all */
        call print$char('A');                      /* dir entries           */
    else call printb;
    if rol(file$info.name(0),1) then
        call print$char('1');
    else call printb;
    if rol(file$info.name(1),1) then
        call print$char('2');
    else call printb;
    if rol(file$info.name(2),1) then
        call print$char('3');
    else call printb;
    if rol(file$info.name(3),1) then
        call print$char('4');
    else call printb;
end display$file$info;

display$xfcb$info: procedure;
        if file$info.x$i$adr <> 0 then
        do;
            call printb;
            x$i$adr = file$info.x$i$adr;
            if (xfcb$info.passmode and pm$read) <> 0 then
                call print(.('Read  $'));
            else if (xfcb$info.passmode and pm$write) <> 0 then
                call print(.('Write $'));
            else if (xfcb$info.passmode and pm$delete) <> 0 then
                call print(.('Delete$'));
            else
                call print(.('None  $'));
            call printb;
            if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
                call display$timestamp(.xfcb$info.update);
            else call print(.('              $'));
                call printb; call printb;
            if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
                 call display$timestamp(.xfcb$info.create(0));
                                                /* Create/Access */
        end;
end display$xfcb$info;

dcl first$title boolean initial (true);

display$title: procedure;

    if formfeeds then
        call print$char(ff);
    else if not first$title then
        call crlf;
    call print(.('Directory For Drive $'));
    call printchar('A'+ cur$drv); call printchar(':');
    if bdos >= bdos20 then 
    do;
        call print(.('  User $'));
        call pdecimal(cur$usr,10,true);
    end;
    call crlf;
    cur$line = 2;
    first$title = false;
end display$title;

short$display: procedure (fname$adr);
    dcl fname$adr address;
    if cur$file mod files$per$line = 0 then
        do;
            if cur$line mod page$len = 0 then
            do; call crlf;
                call display$title;
                call crlf;
            end;
            else
                call crlf;
            cur$line = cur$line + 1;
            call printchar(cur$drv + 'A');
        end;
    else call printb;
    call print(.(': $'));
    call printfn(fname$adr);
    call break;
    cur$file = cur$file + 1;
end short$display;

test$att: procedure(char,off,on) boolean;
    dcl (char,off,on) byte;
    if (80h and char) <> 80h and off then
        return(true);
    if (80h and char) = 80h and on then
        return(true);
    return(false);
end test$att;

right$attributes: procedure(name$adr) boolean;
    dcl name$adr address,
        name based name$adr (1) byte;
    return 
        test$att(name(f$rw-1),find.rw,find.ro) and
        test$att(name(f$dirsys-1),find.dir,find.sys);
end right$attributes;

short$dir: procedure;             /* looks like "DIR" command */
    dcl dcnt byte;
    fcb(f$drvusr) = '?';
    files$per$line = 4;
    dcnt = search$first(.fcb);
    do while dcnt <> 0ffh;
        buf$fcb$adr = shl(dcnt and 11b,5)+.buff;    /* dcnt mod 4 * 32      */
        if (buf$fcb(f$drvusr) and 0f0h) = 0 and
            buf$fcb(f$ex)<= dpb$byte(extmsk$b) then /* no dir labels, xfcbs */
            if match then
                if right$attributes(.buf$fcb(f$name)) then
                    call short$display(.buf$fcb(f$name));
        dcnt = search$next;
    end;
end short$dir;

dcl (last$plus$one,index) address;

getnxt$file$info: procedure;     /* set f$i$adr to base file$info on file    */
dcl right$usr boolean;           /* to be displayed, f$i$adr = 0ffffh if end */
    right$usr = false;
    if sorted then
    do; index = index + 1;
        f$i$adr = mult23(f$i$indices(index));
        do while file$info.usr <> cur$usr and index <> filesfound;
           index = index + 1;
           f$i$adr = mult23(f$i$indices(index));
        end;
        if index = files$found then
           f$i$adr = last$plus$one;               /* no more files */
    end;
    else /* not sorted display in order found in directory */
    do;  /* use last$plus$one to avoid wrap around problems */
        f$i$adr = f$i$adr + size(file$info);
        do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
            f$i$adr = f$i$adr + size(file$info);
        end;
    end;
end getnxt$file$info;

size$display: procedure;
    if (format and form$size) <> 0 then
        files$per$line = 3;
    else files$per$line = 4;
    do while f$i$adr <> last$plus$one;
    if ((file$info.x$i$adr <> 0 and find.xfcb) or
        file$info.x$i$adr  = 0 and find.nonxfcb) and
        right$attributes(.file$info.name(0)) then 
        do;
            call add$totals;
            call short$display(.file$info.name(0));
            call pdecimal(file$info.kbytes,10000,true);
            call print(.('k$'));
        end;
        call getnxt$file$info;
    end;
end size$display;

display$no$dirlabel: procedure;
    files$per$line = 2;
    do while f$i$adr <> last$plus$one;
     if ((file$info.x$i$adr <> 0 and find.xfcb) or
         (file$info.x$i$adr  = 0 and find.nonxfcb)) and
         right$attributes(.file$info.name(0)) then
     do;
      if cur$file mod files$per$line = 0 then  /* need new line */
      do;
        if cur$line mod page$len = 0 then
        do; call crlf;
            call display$title;
            call crlf;
            call print(.hdr);
            call printb;                    /* two sets of hdrs  */
            call print(.hdr);
            call crlf;
            call print(.hdr$bars);
            call printb;
            call print(.hdr$bars);
            call crlf;
            cur$line = cur$line + 3;
        end;
        else
        do; call crlf;
            cur$line = cur$line + 1;
        end; 
      end;
      else
        call printb;                           /* separate the files        */

      call display$file$info;
      cur$file = cur$file + 1;
      call add$totals;
      call break;
     end; 
     call getnxt$file$info;
    end;
end display$no$dirlabel;

display$with$dirlabel: procedure;
    files$per$line = 1;
    do while f$i$adr <> last$plus$one;
      if ((file$info.x$i$adr <> 0 and find.xfcb) or
         (file$info.x$i$adr  = 0 and find.nonxfcb)) and
         right$attributes(.file$info.name(0)) then 
      do;
        cur$file = cur$file + 1;
        if cur$line mod page$len = 0 then
        do; call crlf;
            call display$title; 
            call crlf;
            call print(.hdr);
            call print(.hdr$pu);
            if (dirlabel and dl$access) <> 0 then
                call print(.hdr$access);
            else
                call print(.hdr$create);
            call crlf;
            call print(.hdr$bars);
            call print(.hdr$xfcb$bars);
            cur$line = cur$line + 2;
        end;
        call crlf;
        call display$file$info;        /* display non bdos 3.0 file info    */
        call display$xfcb$info;
        call break;
        cur$line = cur$line + 1;
        call add$totals;
      end;
      call getnxt$file$info;
    end;
end display$with$dirlabel;


display$files: procedure public; /* MODULE ENTRY POINT         */
                                 /* display the collected data */
    cur$line, cur$file = 0;      /* force titles and new line  */
    totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
    total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
    f$i$adr = first$f$i$adr - size(file$info);        /* initial if no sort */
    last$plus$one = last$f$i$adr + size(file$info);
    index = 0ffffh;              /* initial if sorted          */
    call getnxt$file$info;       /* base file info record      */

    if format > 2 then
    do;
        call print(.('Illegal Format Value$'));
        call terminate;          /* default could be patched - watch it */
    end;

    do case format;              /* format = */   
        call short$dir;                       /* form$short          */
        call size$display;                    /* form$size           */
                                              /* form = full         */
        if (dir$label and dl$exists) <> 0 then
            call display$with$dirlabel;
        else 
            call display$no$dirlabel;
                                        /* don't display if no dir   */
    end;                                /* label and finding xfcbs   */


    if format <> form$short and cur$file > 0 then    /* print totals */
    do;
        if cur$line + 4 > page$len and formfeeds then
        do;
            call printchar(cr);
            call printchar(ff);                 /* need a new page ? */
        end;
        else
        do;
            call crlf;
            call crlf;
        end;
        call print(.(      'Total Bytes     = $'));
        call p3byte(.total$kbytes,1);         /* 6 digit max */
        call printchar('k');
        call print(.('  Total Records = $'));
        call p3byte(.total$recs,10);      /* 7 digit max */
        call print(.('  Files Found = $'));
        call pdecimal(cur$file,1000,true);    /* 4 digit max */
        call print(.(cr,lf,'Total 1k Blocks = $'));
        call p3byte(.total$1k$blocks,1);           /* 6 digit max */
        call print(.('   Used/Max Dir Entries For Drive $'));
        call print$char('A' + cur$drv);
        call print$char(':'); call printb;
        call pdecimal(used$de,1000,true);
        call print$char('/');
        call pdecimal(dpb$word(dirmax$w) + 1,1000,true);
    end;

    if cur$file = 0 then
    do;
        if message then
        do; call crlf;
            call display$title;
            call print(.('File Not Found.',cr,lf,'$'));
        end;
        call break;
    end;
    else
    do; file$displayed = true;
        if not formfeeds then
            call print(.(cr,lf,'$'));
    end;

end display$files;

end display;