{ PICS0B.INC  Pascal Integrated Communications System Overlays}
{ 5/25/87 Ver 1.6 Copyright 1987 by Les Archambault}

Overlay procedure ReadDir( var entries, space_used: integer; var first: FilePtr);
{ Create an alphabetized list of files in the current file area }
  var
    i, j, off: integer;
    this: FilePtr;
    searchblk: FileBlock;                 { Buffer to define search params }
    answerblk: array[0..num_drives] of FileBlock;  { Buffer to receive file names }

 procedure InsertFile(fname: name_array; index, size: integer;
                     var entries, total: integer; var first: FilePtr);
   { Insert a new file name into an alphabetic list }
  var
    space: integer;
    f,                                      { File name entry being created }
    this, last: FilePtr;                    { Followers for insertion }
    fn: FileName;
  begin
    if maxavail>128 then
      begin
        fn := '           ';                    { Initialize string }
        move(fname, fn[1], 11);                 { Move name into place }
        insert('.', fn, 9);
        last := nil;
        this := first;
        while (this <> nil) and (this^.fname < fn) do
          begin
            last := this;
            this := this^.next
          end;
        space := size shr 3;
        if (size mod 8) <> 0
          then space := succ(space);
        if this^.fname <> fn
          then
            begin
              entries := succ(entries);
              total := total + space;
              new(f);
              f^.fname := fn;
              f^.index := index;
              f^.fsize := size;
              f^.next  := this;
              if last = nil
                then first := f
                else last^.next := f
            end
        else if (this^.fname = fn) and (this^.fsize < size)
          then
            begin
              total := total + space;
              space := this^.fsize shr 3;
              if (this^.fsize mod 8) <> 0
                then space := succ(space);
              total := total - space;
              this^.fsize := size
            end;
      end  {got enough heap}
      else
       putstat('Not enough Heap space for file names.');
  end;

  begin  {ReadDir}
    new_dir := TRUE;
    space_used := 0;
    while first <> nil do                 { Clean out any old directory list }
      begin
        this := first;
        first := first^.Next;             { Go to next on chain }
        dispose(this)                     { Reclaim space }
      end;
    DirEntries := 0;
    with searchblk do
      begin
        drive := 0;
        for i := 1 to 11 do
          fname[i] := ord('?');
        extent := ord('?');
        s1     := ord('?');
        s2     := ord('?');
        reccount := 0;
        for i := 16 to 31 do
          map[i] := 0
      end;
    SetSect(SetDrv, SetUsr);
    BDOS(setdma, addr(answerblk));
    off := BDOS(findfirst, addr(searchblk));
    while off <> 255 do
      begin
        with answerblk[off] do
          { Non-system or sysop and not creating system directory? }
          if (($80 and ord(fname[10])) = 0) or
             ((user_rec.access >= 250) and (mode<>sysop_mode)) then
                InsertFile(fname, 0, reccount + (extent + (s2 shl 5)) shl 7,
                entries, space_used, first);
        off := BDOS(findnext, addr(searchblk))
      end;
    BDOS(setdma, fcb);                    { Restore DMA buffer }
    setsect(HomDrv,HomUsr);
    free_space := diskfree(SetDrv,SetUsr);
  end;

Overlay procedure LibReadDir( var entries, space_used: integer; var first: FilePtr);
{ Read library directory }
  var
    i, off: integer;
    this:Fileptr;
    LibBlock: array[0..num_drives] of EntryBlock;

 procedure InsertFile(fname: name_array; index, size: integer;
                     var entries, total: integer; var first: FilePtr);
   { Insert a new file name into an alphabetic list }
  var
    space: integer;
    f,                                      { File name entry being created }
    this, last: FilePtr;                    { Followers for insertion }
    fn: FileName;
  begin
    if maxavail>128 then
      begin
        fn := '           ';                    { Initialize string }
        move(fname, fn[1], 11);                 { Move name into place }
        insert('.', fn, 9);
        last := nil;
        this := first;
        while (this <> nil) and (this^.fname < fn) do
          begin
            last := this;
            this := this^.next
          end;
        space := size shr 3;
        if (size mod 8) <> 0
          then space := succ(space);
        if this^.fname <> fn
          then
            begin
              entries := succ(entries);
              total := total + space;
              new(f);
              f^.fname := fn;
              f^.index := index;
              f^.fsize := size;
              f^.next  := this;
              if last = nil
                then first := f
                else last^.next := f
            end
        else if (this^.fname = fn) and (this^.fsize < size)
          then
            begin
              total := total + space;
              space := this^.fsize shr 3;
              if (this^.fsize mod 8) <> 0
                then space := succ(space);
              total := total - space;
              this^.fsize := size
            end;
      end  {got enough heap}
      else
       putstat('Not enough Heap space for file names.');
  end;

  begin  {LibReadDir}
    SetSect(SetDrv, SetUsr);
    Assign(libr_file, LibReq);
    {$I-} Reset(libr_file) {$I+};
    if (IOresult=0) and (filesize(libr_file)>0)
      then
        begin
          while first <> nil do                 { Clean out any old directory list }
            begin
              this := first;
              first := first^.Next;             { Go to next on chain }
              dispose(this)                     { Reclaim space }
            end;
          {$I-} blockread(libr_file, LibBlock, 1) {$I+};
          in_library := (IOresult = 0);
          i := 1;
          while in_library and (i < 11) do
            if LibBlock[0].fname[i] = $20
              then i := succ(i)
              else in_library := FALSE;
          in_library := in_library and (LibBlock[0].status = 0);
          if in_library
            then
              begin
                new_dir := TRUE;
                space_used := 0;
                LibEntries := 0;
                for i := 1 to pred(LibBlock[0].fsize shl 2) do
                  begin
                    off := i mod 4;
                    if off = 0
                      then blockread(libr_file, LibBlock, 1);
                    with LibBlock[off] do
                      if status < $FE then
                         InsertFile(fname, index, fsize, entries, space_used, first);
                  end
              end
        end;
    SetSect(HomDrv, HomUsr)
  end;

Overlay procedure ArcReadDir( var entries, space_used: integer; var first: FilePtr);

var
    size     : real;
    c,i,x    : integer;
    extname  : name_array;
    this     : FilePtr;

  procedure InsertFile(fname: name_array; index, size: integer;
                     var entries, total: integer; var first: FilePtr);
   { Insert a new file name into an alphabetic list }
  var
    space: integer;
    f,                                      { File name entry being created }
    this, last: FilePtr;                    { Followers for insertion }
    fn: FileName;
  begin
    if maxavail>128 then
      begin
        fn := '           ';                    { Initialize string }
        move(fname, fn[1], 11);                 { Move name into place }
        insert('.', fn, 9);
        last := nil;
        this := first;
        while (this <> nil) and (this^.fname < fn) do
          begin
            last := this;
            this := this^.next
          end;
        space := size shr 3;
        if (size mod 8) <> 0
          then space := succ(space);
        if this^.fname <> fn
          then
            begin
              entries := succ(entries);
              total := total + space;
              new(f);
              f^.fname := fn;
              f^.index := index;
              f^.fsize := size;
              f^.next  := this;
              if last = nil
                then first := f
                else last^.next := f
            end
        else if (this^.fname = fn) and (this^.fsize < size)
          then
            begin
              total := total + space;
              space := this^.fsize shr 3;
              if (this^.fsize mod 8) <> 0
                then space := succ(space);
              total := total - space;
              this^.fsize := size
            end;
      end  {got enough heap}
      else
       putstat('Not enough Heap space for file names.');
  end;

  begin   {ArcReadDir}
    SetSect(SetDrv,SetUsr);
    Assign(Arc_File,ArcReq);
    {$I-} Reset(arc_file) {$I+};
    if (IOresult=0) and (filesize(arc_file)>0)
      then
        begin
          if mode=files_mode then
            begin
              writeln(usr);
              writeln(usr,'Reading Arc Directory - Please wait...');
            end;
          while first <> nil do                 { Clean out any old directory list }
            begin
              this := first;
              first := first^.Next;             { Go to next on chain }
              dispose(this)                     { Reclaim space }
            end;
          new_dir := TRUE;  OK:=True;
          Arcspace := 0;
          ArcEntries := 0;
          {$I-} blockread(arc_file,arcbuf,1); {$I+}
          Endfile:=(ioresult<>0);
          arcptr:=1;
          setsect(HomDrv,HomUsr);
            while (Read_Arc_Hdr) and OK do
              begin
                in_arc:=true;
                fillchar(extname,11,' ');
                i := 1; x:=1;
                while hdr.name[i-1] <> #0 do
                  begin
                    if hdr.name[i-1]='.' then x:=9
                    else
                      begin
                        extname[x]:=ord(hdr.name[i-1]);
                        x:=succ(x);
                      end;
                    i:=succ(i);
                  end;
                size := long_to_real(hdr.size);
                if (size>0.0) and (size<128.0) then size:=128.0;
                if (not endfile) then
                  begin
                    InsertFile(extname, 0, trunc(size/128.0),
                       entries, space_used, first);
                    Setsect(HomDrv,HomUsr);
                    ArcSeek(long_to_real(hdr.size), 1);
                  end;
                setsect(HomDrv,HomUsr);
              end;    {reading arc file header}
          setsect(SetDrv,SetUsr);
          if (not OK) then
            begin
              writeln(usr,'Warning! Error reading Arc file ',arcreq,'.');
            end;
        end
        else
          begin
            writeln(usr,'Error opening Arc File ',arcreq,'.');
            new_dir:=false;
            close(arc_file);
          end;
    setsect(HomDrv,HomUsr);
  end; {ArcReadDir}

Overlay Procedure Position_Arcfile(arcname:filename; var ok_to_send:boolean);

var
    name_found  : boolean;
    c,i,x    : integer;
    work_name: filename;

  begin
    name_found:=false;
    setsect(SetDrv,SetUsr);
    {$I-} Reset(arc_file) {$I+};
    if IOresult = 0
      then
        begin
          {$I-} blockread(arc_file,arcbuf,1); {$I+}
          endfile:=(ioresult<>0);
          arcptr:=1;
          repeat
            setsect(HomDrv,HomUsr);
            OK:= Read_Arc_Hdr;
            if ok and (not endfile) then
              begin
                work_name:='';
                i := 1;
                while hdr.name[i-1] <> #0 do
                  begin
                    work_name:=work_name+hdr.name[i-1];
                    i:=succ(i);
                  end;
                if arcname=work_name then name_found:=true;
              end;    {reading arc file header}
            if (not endfile) and (not name_found) then
              begin
                setsect(HomDrv,HomUsr);
                ArcSeek(long_to_real(hdr.size), 1);
              end;
          until endfile or (not OK) or name_found;
          if name_found then ok_to_send:=true;
        end
        else
          ok_to_send:=false;
    setsect(HomDrv,HomUsr);
  end;

overlay function greg_to_jul(day, mon, yr: integer): real;
{ Convert from Gregorian date to Julian }
  var
    i: integer;
  begin
    i := (mon - 14) div 12;
    greg_to_jul := day - 32075 + 367 * (mon - 2 - 12 * i) div 12 -
                   3 * (yr + 6800 + i) div 400 + 365.25 * (yr + 6700 + i)
  end;

Overlay Function Expand_Filename(tfname:filename):filename;
{ Expands filename to 12 characters and expands wildcards}

Var work_name:filename;
    n,x,k: integer;

Begin
  work_name:='            ';
  work_name[9]:='.';
  x:=1;  k:=1;
  while (x<=length(tfname)) and (k<13) do
    begin
      if tfname[x]='.' then
        begin
          k:=10; x:=succ(x);
        end;
      if tfname[x]='*' then
        begin
          if k<9 then
            begin
              for n:=k to 8 do work_name[n]:='?';
              k:=10;
            end
          else
            begin
              if k>9 then for n:=k to 12 do work_name[n]:='?';
              k:=13;
            end;
        end
      else
      work_name[k]:=tfname[x];
      x:=succ(x);
      k:=succ(k);
    end;
  Expand_filename:=work_name;
end;

Overlay Function Equal_names(Test,Target:filename):boolean;
{ tests equality of two filenames including wildcards expanded
  with the Expand_filename function}

Var x:integer;
    match:boolean;

begin
  match:=true;
  x:=1;
  repeat
    if (test[x]<>'?') and (test[x]<>target[x]) then match:=false;
    x:=succ(x);
  until (match=false) or (x>length(test));
  equal_names:=match;
end;

overlay procedure hide_release(name: FileName; status: record_status; drive,user:integer);
{ Hide or release file }
  var
    i: integer;
    temp_file: file;
  begin
    SetSect(drive,user);
    Assign(temp_file, name);
    i := pos('.', name) + 2;
    if status = public
      then name[i] := chr($7F and ord(name[i]))  { Turn $SYS bit off }
      else name[i] := chr($80 or ord(name[i]));  { Turn $SYS bit on }
    {$I-} Rename(temp_file, name) {$I+};
    if IOresult <> 0
      then writeln(USR, name, ' not found.')
  end;

{end of PICS0B.INC }