{$C-,V- }
program pcdisk3d; {adapted from John Friell's PC-DISK
                  by G. Gallo April 17, 1985}

{ types and vars req'd for disk space and dir procedures }
Const
  blink_yes    = true;
  blink_no     = false;
  yes_no       : set of char = ['Y','y','N','n'];
  max_records  = 1000;

Type
  str255     =   string[255];
  str80      =   string[80];
  str11      =   string[11];
  str33      =   string[33];
  regpack      = record
                   ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
                 end;
  mem_ptr      = ^pointer_type;
  pointer_type = array [1..2] of integer;

  word         = array [1..2] of char;
  cat_type     = record
                   vol_record : integer;
                   fil        : string[11];
                   sizelo     : word;
                   sizehi     : word;
                   time       : word;
                   date       : word;
                   memo       : string[33];
                 end;
  temp_type    = record
                   fil        : string[11];
                   sizelo     : word;
                   sizehi     : word;
                   time       : word;
                   date       : word;
                   memo       : string[33];
                 end;

Var
  one_memo,
  orig_path,
  fullpathname,
  catname                       : str33;
  asciiz,filez                  : string[32];  {string input for dir scan}
  template                      : str80;
  Answer,S                      : str255;
  id,volume,pathname            : str11;
  R                             : regpack;
  pointer,dta,fcb_addr          : mem_ptr;
  bts                           : real;
  c1,r1,c2,r2,
  x, i, y, q, e, w, check_num,
  drv, crt_reg,
  z, t4, t1, t2, t3,
  vol_min, vol_max,
  cat_num, vol_num              : Integer;
  ok, done, found, changed      : Boolean;
  Ctype,GetType,ch,
  orig_drive, default_drive     : Char;
  catfile                       : file of cat_type;
  cat_array                     : array [1..max_records] of cat_type;
  vol_array                     : array [1..100] of str11;
  temp_array                    : array [1..100] of temp_type;
  dta_area                      : array [1..130] of byte;
  fcb                           : array [-7..36] of char;
  temp                          : string[11];
  InsertOn,Exitt,
  Escape,
  F1,F10,
  Use_Default                   : Boolean; {for input routine}

(* the following screen and input routines were written by Donald R. Ramsey
and Larry Romero and are part of TURBO-UT - a public domain utility package*)

procedure Center(S: str255; Col,Row,L: integer);
  { Center a string on a line of L length beginning at position Col,Row }
  {** (Col,Row) is row and column to center on **}
  {** L is the length of the line to center on **}
var I: integer;
 begin
    gotoXY(Col,Row);
    for I:= 1 to L do write(' ');
    gotoXY(Col+(L-Length(S)) div 2,Row); write(S);
 end;

procedure InvVideo( InvStr: str255);
    { print a string in inverse video }
 begin
   textBackground(7);textcolor(0); write(InvStr);
   textBackground(0) ;textcolor(15);
 end;

procedure Color(BackGnd,Txt: integer);
   { change the background & text color }
 begin
   textBackGround(BackGnd); textColor(Txt);
 end;

function UpcaseStr(S : Str80) : Str80;
   { convert a string to UpperCase }
var
  P : Integer;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end;

procedure StripSpaces(S: str33; var NewStr: str33);
    {strip spaces from the end of a string}
 begin
   S:=S+'  '; NewStr := copy(S,1,pos('  ',S)-1);
 end;

procedure Beep(Tone,Duration : integer);
 begin
   Sound(Tone); Delay(Duration); NoSound;
 end;

procedure Say_Cap_Num;
   { Display Caps, Num, Insert in inverse video on line 25 of Video }
 var  Value  : integer;
 begin
 window(1,1,80,25);
     Value := Mem[0000:1047];      { test for caps, numbers, & cursor cntrl }
     gotoXY(65,25);
     Case Value of
       0   : begin LowVideo; write('               '); Inserton:= false; end;
       32  : begin LowVideo; write('     '); InvVideo('NUM');
                   Clreol; InsertOn:= false; end;
       64  : begin InvVideo('CAPS'); Clreol;
                   InsertOn:= false; end;
       96  : begin InvVideo('CAPS'); write(' '); InvVideo('NUM');
                   Clreol; InsertOn:=false; end;
       128 : begin LowVideo; write('         ');
                   InvVideo('Insert');InsertOn:=true; end;
       160 : begin LowVideo; write('     '); InvVideo('NUM');write(' ');
                   InvVideo('Insert'); InsertOn:=true; end;
       192 : begin InvVideo('CAPS'); write('     ');
                   InvVideo('Insert'); InsertOn:=true; end;
       224 : begin InvVideo('CAPS'); write(' ');InvVideo('NUM'); write(' ');
                   InvVideo('Insert'); InsertOn:= true; end;
     end; { Case }
     Window (c1,r1,c2,r2);
  end;

procedure Set_Cap_Num(Caps,Num,Insert : Char);
   { Set the Cap Lock, Number Lock, and Ins Keys as desired }
 var J : integer;
 begin
  if Insert='I' then J:=128 else J:=0;
  Case Caps of
    'C': begin if Num='N' then  MemW[0000:1047]:= 96+J
                else            MemW[0000:1047]:= 64+J;
         end;
    ' ': begin if Num='N' then  MemW[0000:1047]:= 32+J
                else            MemW[0000:1047]:=  0+J;
         end;
  end; { Case }
 end;

{.pa}
procedure Ck_edit_key(var Ch: Char);
   { test for an IBM Cursor control or Function key }
begin
  read(kbd,Ch);
  begin {see if IBM specific key pressed}
    case Ch of
      'H': Ch:=^E    ;  { up-arrow  }
      'P': Ch:=^X    ;  { dn-arrow  }
      'M': Ch:=^D    ;  { rt-arrow  }
      'K': Ch:=^S    ;  { left-arr  }
      'S': Ch:=#127  ;  { Del       }
      'R': Ch:=^V    ;  { insert    }
      'G': Ch:=^G    ;  { Home      }
      'O': Ch:=^O    ;  { End       }
      'I': Ch:=^R    ;  { Pg-Up     }
      'Q': Ch:=#00   ;  { Pg-Dn     }
      ';': Ch:=^a    ;  { F1        }
      '<': Ch:=^b    ;  { F2        }
      '=': Ch:=^c    ;  { F3        }
      '>': Ch:=^d    ;  { F4        }
      '?': Ch:=^e    ;  { F5        }
      '@': Ch:=^f    ;  { F6        }
      'A': Ch:=^g    ;  { F7        }
      'B': Ch:=^h    ;  { F8        }
      'C': Ch:=^i    ;  { F9        }
      'D': Ch:=^j    ;  { F10       }
      'u': Ch:=#117  ;  {ctrl-end   }
    end;   {Case Ch}
  end;   {IBM check}
end;  {Ck_edit_key}

procedure Get_Template(Template_num:integer; var template: str80);
   { Templates are specified by the Programmer }
 begin
  Case Template_num of
    1 : template := '';
    2 : template := '';
  end;
 end;

procedure Input(Typ: Char          ;    { Type of input        }
                Default: str255    ;    { Default string       }
                Col,Row: integer   ;    { Where start line     }
                Mlen: integer      ;    { Max length           }
                UpperCase:Boolean  ;    { True if auto Upcase  }
           var  F1,F10   : boolean);    { Returned true if F1 or F10 }

   {-- requires
       Global procedures:
         Say_Cap_Num, Set_Cap_Num, Color, Ck_edit_key, Beep, Get_template }
var
  X,J,LastValue: integer;
  OkChars,temp : set of Char;
  DF           : boolean;

{-------------------------- local procedures ---------------------------}
  procedure GotoX;
   begin
     GotoXY(X+Col-1,Row);
   end;

  procedure Ck_Cap_Num; { test for caps, numbers, & cursor cntrl }
   var Value : integer;
   begin
      repeat
        Value := Mem[0000:1047];
        if LastValue<>value then
          begin LastValue:=Value; Say_Cap_Num; GotoX; end;
      until keypressed;
   end;

  procedure PosX;
    begin
      while copy(template,X,1)<>#95 do
       begin
         Answer:=Answer + copy(template,X,1); X:=X+1; GotoX;
       end;
    end;

  procedure Del_Ans;
    begin
      Answer:=''; X:=1; GotoX;
      write(template);  GotoX; PosX;
    end;

{------------------------ end local procedures ------------------------}

begin
  if Typ='A'then  OKChars:=[' '..'}']
  else OKChars:=['0'..'9','+','-','.'];
  Temp := OKChars;  color(7,0); DF:= false;
  Case Typ of
    'A','N','$': begin  fillchar(template,80,#95);
                        template:=copy(template,1,Mlen);
                        if Typ='$' then
                         begin
                           X:=0; GotoX; HighVideo; write('$');
                         end;
                 end;
    'F':         begin
                   Get_template(Mlen,template); Mlen := length(template);
                   if copy(template,1,1)<>#95 then DF:= true;
                 end;

  end;

  if Typ = 'A' then if uppercase then Set_Cap_Num('C',' ',' ')
                    else Set_Cap_Num(' ',' ','I')
  else Set_Cap_Num(' ','N',' ');
  Color(7,0);
  Answer := ''; F1:=false; F10:=false;
  if Default<>'' then
    begin
      X:=1; GotoX; write(template); GotoX; write(default);
      Answer:=Default;
    end
  else Del_Ans;
  LastValue:=Mem[0000:1047]; Say_Cap_Num; GotoX;

  repeat
    Ck_Cap_Num; read(kbd,Ch);  Color(7,0);
    if (keypressed) and (Ch<>'p') and (Ch<>'q') then Ck_edit_key(Ch);
    if (Typ='F') and (X=1) and (Default<>'') and (Ch<>^1) and (Ch<>#13)
     then Del_Ans;
    case Ch of
       ^[: begin Del_Ans end;     { ESC pressed   }

       ^D: begin { Move cursor right : rt-arr }
             X:=X+1;
             if (X>length(Answer)+1) or (X>Mlen) then X:=X-1;
             GotoX;
           end;

       ^S: begin { Move cursor left : left-arr }
             if Typ='F' then Del_Ans  else
             begin
               X:=X-1; if X<1 then X:=1;
               GotoX;
             end;
           end;
       ^O: begin { Move cursor to end of line }
              X:=Length(Answer)+1; if X>Mlen then X:=Mlen; GotoX;
           end;
       ^G: begin { Move cursor to beginning of line }
             X:=1; GotoX;
           end;
       ^H: begin { Delete left char: BS }
             if Typ='F' then Del_Ans
             else
               begin
                 X:=X-1;
                 if (Length(Answer)>0) and (X>0)  then
                   begin
                     Delete(Answer,X,1); GotoX;
                     Write(copy(Answer,X,(Length(Answer)-X+1)),#95);
                     GotoX;
                   end
                 else X:=1;
             end; { Typ <> 'F' }
           end;

       #117: begin {delete end of line}
              i := (mlen-x);
              delete(answer,X,i);
              for e := 0 to i do write(#95);
              gotox;
              end;
       #127: begin { Delete }
               Delete(Answer,X,1);
               Write(copy(Answer,X,Length(Answer)-X+1),#95); GotoX;
             end;
        ^a : begin  { F1 pressed }
               F1 := true; exitt := true; Answer:= default;
             end;
        ^M : exitt := true;
        ^j : begin F10 := true; exitt := true; Answer := default; end;

    else
    if (length(Answer)+1 <= Mlen) or (not InsertOn) then
    begin   { non-IBM char }
        if Ch in OkChars  then
         begin
          if InsertOn then
          begin
           if length(Answer) < Mlen then
           begin             { OK to insert }
             insert(Ch,Answer,X);
               Case Typ of
                'A','N','$' : write(copy(Answer,X,Length(Answer)-X+1));
                'F'         : Write(Ch);
               end; {Case}
           end;        { OK to insert }
          end else     { end InsertOn }
          if X <= Mlen then
          begin
             write(Ch);
             if X>length(Answer) then Answer:=Answer+Ch
             else Answer[X]:=Ch;
          end;  { processing this key }
          if X+1 <= Mlen then X:=X+1;
          if (X > Length(Answer)) and (template[X]<>#95) then PosX;
         end { OkChars }
         else if (Ch<> ^V) then Beep(300,150);
             { beep if invalid char and ch is not Insert key }
        GotoX;
    end;   { non IBM key }
    if (typ<>'F') and (length(Answer)+1 > Mlen) and (Ch <> ^V)
     then  Beep(600,100);
   end;    {   CASE!!!   }
  until exitt = true;
 Color(0,15); X:=1; gotoX; write(Answer);
      { erase part of template that is left }
 X:=length(Answer)+1; GotoX;
 for J:= 1 to Mlen-x+1 do write(' ');
 exitt := false; Color(0,15);
 if (DF) and (length(Answer)=1) then
  begin
    gotoXY(col,row); write(' '); Answer:='';
  end;
end;          { end Input Procedure }
{---------------------  Procedures  -----------------------------}
{---- begin code from original PC-DISK---------}

procedure set_fcb; forward;
procedure get_vol; forward;
procedure save_catalog; forward;
procedure keycontinue;
begin
  write(' Tap any key to continue');
  read (kbd,ch);
  CLRSCR;
end;

procedure log_new_drive(ch:char);  {gg}
begin
     ch := upcase(ch);
     CHDIR(ch+':');
     default_drive := ch;
end;

Procedure drawbox_ibm (x1,y1,x2,y2,FG,BG : Integer; boxname : str80; blnk : boolean);
Begin
  window (x1,y1,x2,y1+1);
  textbackground(BG);
  GotoXY(1,1);
  x := x2-x1;
  if length(boxname) > x then boxname[0] := chr(x-4);
  textcolor(FG);
  Write('U');
  if blnk then textcolor(FG + blink) else textcolor(fg);
  write (boxname);
  textcolor(FG);
  for q := x1+length(boxname)+1 to x2-1 do Write('M');
  Write('8');
  for q := 2 to y2-y1 do
    Begin
      window (x1,y1,x2,y1+q+1);
      GotoXY(1,q); Write('3');
      if blnk then clreol;
      GotoXY(x2-x1+1,q); Write('3');
    end;
  Window(x1,y1,x2,y2+1);
  gotoXY(1,y2-y1+1);
  Write('T');
  for q := x1+1 to x2-1 do Write('M');
  Write('>');
end;

function upcase11(strng : str11) : str11;
var
  temp : str11;
  x : integer;
begin
  temp := '';
  for x := 1 to length(strng) do
    temp := temp + upcase(strng[x]);
  upcase11 := temp;
end;

procedure GetPath; {gg}
begin
     Getdir(0,fullpathname);
     if length(fullpathname) = 3 then
     pathname := 'ROOT       '
     else
     pathname := copy(fullpathname,4,11);
     pathname := upcaseStr(pathname);
     for x := 1 to (11-length(PATHNAME)) do pathname := pathname+' ';
end;

Procedure drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : str80; blnk : boolean);
Begin
  Drawbox_IBM (x1,y1,x2,y2,FG,BG,boxname,blnk);
  Window (x1+1,y1+1,x2-1,y2-1);
  c1:=x1+1; r1:=y1+1; c2:=x2-1; r2:=y2-1;
  Clrscr;
end;

procedure load_catalog;
begin
drawbox (30,15,78,22,lightcyan,black,'[ Catalog Load ]',blink_no);
volume := '';
get_vol;
if volume <> '' then
begin
  cat_num := 0;
  writeln ('Loading from file ',catname);
  set_fcb;
  assign (catfile, catname);
  {$I-}
  reset (catfile);
  {$I+}
  ok := (ioresult=0);
  if not ok then
    begin
      rewrite (catfile);
      writeln ('File not found, Creating a new one. ');
    end
  else
    begin
      cat_num := 0;
      vol_num := 0;
      while (not eof(catfile)) and (cat_num < max_records + 1) do
        begin
          cat_num := cat_num + 1;
          read (catfile, cat_array[cat_num]);
          if cat_array[cat_num].vol_record > vol_num then
            begin
              writeln ('Invalid record found and discarded.');
              cat_num := cat_num - 1;
            end
          else
            if cat_array[cat_num].vol_record = -1 then   { vol label record }
              begin
                vol_num := vol_num + 1;
                vol_array[vol_num] := cat_array[cat_num].fil;
              end;
        end;
      writeln (cat_num,' file entries loaded, ',max_records - cat_num,' empty.');
      writeln (vol_num,' volume entries loaded, ',100-vol_num,' empty.');
    end;
  close (catfile);
end
  else
    begin
      writeln('Cannot catalog a disk without a Volume Label.');
      writeln('A)dd one from the Main Menu.');
    end;
    keycontinue;
end;

procedure ChangeDir;    {gg}
begin
  drawbox (2,15,68,19,lightcyan,black,'[ Change Directory ]',blink_no);
  GetPath;
  writeln(' Current Directory is ',fullpathname);
  Write(' Enter name of new directory: ');
  input('A','',wherex,wherey,33,true,f1,f10);
  IF LENGTH(ANSWER) = 0 THEN begin
     writeln;
     write(' No change.');
     delay(900);
     EXIT;
     end;
  {$I-}
  ChDir(answer);
  {$I+}
       If IOResult<>0 Then
       begin
            Writeln;
            Write(' *** Cannot access that path  - ');
            keycontinue;
            Exit;
       end
       else
         writeln;
         Write(' Done.');
         GetPath;
         delay( 900 );
   end;

procedure ChangeDrive;      {gg}
var
ch : char;
begin
  drawbox (4,15,35,19,lightcyan,black,'[ Change Drive ]',blink_no);
  writeln(' Current drive is: ', default_drive+':');
  write(' Enter new drive: ');
     repeat
     read(KBD,ch);
     ch := upcase(ch);
       if not (ch in ['A'..'E',#13]) then write(^G)
       else writeln(ch);
     until ch in ['A'..'E',#13];
     if ch = #13 then write(' No change.')
      else begin
       log_new_drive(ch);
       write(' Done.');
       end;
delay(900);
end;


Procedure init;   {changed:  no longer calls Screen_on Screen_off, which
                  seemed to hang some systems (I don't know what it did??)
                  and is now called after every change of catalog. gg}
Begin
  done := False;
  changed := false;
  catname := '';
  cat_num := 0;
  vol_num := 0;
end;

procedure save_catalog;
begin
  drawbox (40,15,78,23,lightcyan,black,'[ Save Catalog ]',blink_no);
  writeln;
  writeln ('Saving to file ',catname);
  set_fcb;
  close (catfile);
  assign (catfile, catname);
  rewrite (catfile);
  x := 0;
  if cat_num = 0 then
    writeln ('No entries to save, aborted.')
  else
    begin
      while x < cat_num do
        begin
          x := x + 1;
          write (catfile, cat_array[x]);
        end;
    end;
  close (catfile);
  writeln;
  writeln (x,' entries saved, ',max_records-x,' empty.');
  KEYCONTINUE;
  if Ctype = 'F' then log_new_drive(orig_drive);
  init;
end;


Procedure big_exit;
begin
  if changed then
      begin
      drawbox (15,10,65,16,white,red,'[ Warning! ]',blink_yes);
      writeln;
      center ('  Catalog '+catname+' has been changed!',1,2,49);
      center ('  Do you want to Save [Y/N] ? ',1,3,49);
      repeat read (kbd,ch); until ch in yes_no;
      if upcase(ch) = 'Y' then
      save_catalog;
     end;
  done := true;
end;

procedure set_dta;
begin
{-- Set DTA address --}
  pointer := addr(dta_area);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $1A shl 8;
  MsDos(R);
end;

procedure get_dta;
begin
{-- Get DTA address in ES:BX --}
  r.ax := 0;
  r.es := 0;
  r.bx := 0;
  r.ax := $2F shl 8;
  MsDos(R);
  dta := ptr(r.es,r.bx);
end;

procedure set_fcb;
begin
{-- Set up an unopened FCB --}
  for x := -7 to 36 do fcb[x] := #0;
  fcb[-7] := #255;
  fcb[-1] := #0;
  filez := '*.*' + #0;
  pointer := addr(filez[1]);
  r.ds := seg(pointer^);
  r.si := ofs(pointer^);
  pointer := addr(fcb[0]);
  r.es := seg(pointer^);
  r.di := ofs(pointer^);
  r.ax := $29 shl 8;
  msdos(R);
  set_dta;
  get_dta;
end;


procedure msdos12;
begin
  set_dta;
  pointer := addr(fcb[-7]);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $12 shl 8;         { go after the next matching entry }
  msdos(R);
end;

procedure msdos11(x : integer);
begin
  set_fcb;
  fcb[-7] := #255;
  fcb[-1] := chr(x);
  pointer := addr(fcb[-7]);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $11 shl 8;
  msdos(R);
end;


procedure get_vol;
begin
  volume := '';
  msdos11(8);
  if (r.ax and 255) = 0 then
    begin
      for x := 8 to 18 do
        volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
      writeln('Volume is ',volume);
      writeln('Directory is ',fullpathname);
    end
  else
    writeln ('Disk has no Volume Label!');
end;

procedure delete_volume;
var
  vnum : integer;
begin
  drawbox (2,5,78,24,white,black,'[ Delete Volume ]',blink_yes);
  writeln (' Select the volume to be deleted by entering the number');
  writeln (' associated with the Volume Label.');
  for x := 1 to vol_num do
    write (' ',x:2,')',vol_array[x]:11);
  writeln;
  repeat
    write ('Enter volume number (<0> quits):');
    readln (vnum);
  until (vnum >= 0) and (vnum <= vol_num);
  if vnum = 0 then exit;
  writeln;
  write ('Delete volume ',vol_array[vnum],' [Y/N] ? ');
  repeat read (kbd,ch); until ch in yes_no;
  if upcase(ch) = 'Y' then
    begin
      writeln ('Deleting volume ',vol_array[vnum]);
      vol_min := 0;
      vol_max := 0;
      t2 := 0;  { count files found on disk }
      for x := 1 to cat_num  do
        if (cat_array[x].vol_record = vnum) and (vol_min = 0) then
          vol_min := x - 1
        else
          if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> vnum) then
            vol_max := x - 1 ;
      if vol_max = 0 then vol_max := cat_num;
      t1 := vol_max - vol_min + 1;
      for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
        cat_array[x] := cat_array[x -(t2-t1)];
      if vnum = vol_num then
        cat_num := vol_min - 1
      else
        cat_num := x;
      { now renumber the cat_array }
      vol_num := 0;
      for x := 1 to cat_num do
        begin
          if cat_array[x].vol_record = -1 then
            begin
              vol_num := vol_num + 1;
              vol_array[vol_num] := cat_array[x].fil;
            end
          else
            cat_array[x].vol_record := vol_num;
        end;
    end
  else
    writeln ('Aborted.');
  write (' Press any key to continue ');
  read(kbd,ch);
end;

procedure show_dta(x1,y1 : integer);
var
 t1,t2,d1,d2,hour,minutes,seconds,dd,mm,yy : integer;
 bytes : real;
begin
  for x := 8 to 15 do
    write(chr(mem[x1:y1+x]));
  write (' ');
  for x := 16 to 18 do
    write(chr(mem[x1:y1+x]));
  write (' ');
  t1 := mem[x1:y1+30];
  t2 := mem[x1:y1+31];
  d1 := mem[x1:y1+32];
  d2 := mem[x1:y1+33];
  bytes := mem[x1:y1+37]*256.0;
  bytes := bytes + mem[x1:y1+36];
  bytes := bytes + mem[x1:y1+38] * 65536.0;
  write (bytes:6:0,' ');
  hour := (t2 and 249) shr 3;
  if hour > 12 then hour := hour - 12;
  minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  write (hour:2,':');
  if minutes < 10 then write ('0');
  write (minutes);
  mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  dd := (d1 and 31);
  yy := 80 + ((d2 and 255) shr 1);
  write ('  ');
  if mm < 10 then write ('0'); write (mm,'-');
  if dd < 10 then write ('0'); write (dd,'-');
  write (yy:2);
end;


Function Free_Space( Drive_letter : Char) : Real;
{changed to reflect the available space on a hard drive}
var
  Tracks,                              { number of available Tracks }
  TotalTracks,                         { number of total Tracks }
  Drive,                               { Drive number }
  Bytes,                               { number of Bytes in one sector }
  Sectors              : Integer;      { number of total Sectors }
  Used                 : Real;

procedure DiskStatus( Drive : integer;  var Tracks, TotalTracks,
                      Bytes, Sectors : integer );
 var
  Regs                 : RegPack;
begin
  Regs.AX := $3600;               { Get Disk free space }
  Regs.DX := Drive;               { Store Drive number }
  MSDos( Regs );                  { Call MSDos to get disk info }
  Tracks := Regs.BX;              { Get number of Tracks Used }
  TotalTracks := Regs.DX;         {  "    "    "  total Tracks }
  Bytes := Regs.CX;               {  "    "    "  Bytes per sector }
  Sectors := Regs.AX              {  "    "    "  Sectors per cluster }
END; { of proc DiskStatus }

begin { main body of function Free_Space }
  Drive := 0;                             { Initialize Drive }
  drive_letter := upcase(drive_letter);
  case drive_letter of
    'A'..'E'  : drive := ord(drive_letter)-ord('A')+1;
  else
    drive := 0;
  end;
  DiskStatus( Drive, Tracks, TotalTracks, Bytes, Sectors );
  Free_Space  := (( Sectors * Bytes * 1.0 ) * Tracks );
end; { of function Free_Space }


procedure dir2;
var
  x : integer;
  bytes : real;
begin
  drawbox (1,5,39,24,white,black,'[ Dir ]',blink_yes);
  x := 2;
  GETPATH;
  get_vol;
  set_fcb;
  msdos11(3);
  if (r.ax and 255) = 0 then
    begin
      while (r.ax and 255) = 0 do
        begin
          x := x + 1;
          write (' ');
          show_dta (seg(dta^),ofs(dta^));
          writeln;
          if x/17 = int(x/17) then keycontinue;
          msdos12;
        end
    end
  else
    writeln ('Disk is Empty!');
  bytes := free_space(default_drive);
  writeln ('    Free space = ',bytes:6:0,' bytes');
  write   ('    Press any key to continue');
  read (kbd,ch);
end;


procedure update_disk;
begin
  drawbox (10,7,70,24,white,black,'[ Update Disk ]',blink_no);
  found := false;
  writeln;
  writeln ('Place disk in drive ',default_drive,' and press any key...');
  read (kbd,ch);
  id := '';
  get_vol;
  getpath; {gg}
  if length(catname) = 0 then begin        {refuse update if no
     writeln('No catalog loaded.');        catalog loaded gg.}
     keycontinue;
     exit;
     end;
  if volume <> '' then
    begin
     if (length(fullpathname) > 14) and (Ctype = 'T') then begin  {gg}
     writeln;
     writeln('Pathname longer than eleven characters.');
     write('Enter an identifying label for this directory: ');
     input('A','',wherex,wherey,11,true,f1,f10);
     pathname := answer;
     end;
      {scan the catalog for volume}
 if Ctype = 'T' then
      id := pathname {if tree-structured or individual catalog use ID}
 else
      id := volume;  { use volume }
 writeln;
 changed := true;
 for x := 1 to vol_num do
        begin
        if vol_array[x] = id then
          begin
            found := true;
            t1 := x;
            t4 := x;
          end;
        end;
      if found then  { Do a selective update/delete function }
        begin
          writeln ('Disk is already cataloged, performing update.');
          writeln;
          vol_min := 0;
          vol_max := 0;
          t2 := 0;  { count files found on disk }
          for x := 1 to cat_num  do
            if (cat_array[x].vol_record = t1) and (vol_min = 0) then
              vol_min := x
            else
              if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> t1) then
                vol_max := x - 1 ;
          if vol_max = 0 then vol_max := cat_num;
          msdos11(3);
          if (r.ax and 255) = 0 then
            begin
              while (r.ax and 255) = 0 do
                begin {q1}
                  t2 := t2 + 1;
                  temp := '';
                  for x := 8 to 18 do
                    temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
                  temp_array[t2].fil := temp;
                  temp_array[t2].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
                  temp_array[t2].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
                  temp_array[t2].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
                  temp_array[t2].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
                  temp_array[t2].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
                  temp_array[t2].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
                  temp_array[t2].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
                  temp_array[t2].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
                  {-- now find old entry if any --}
                  found := false;
                  for x := vol_min to vol_max do
                    begin
                      if cat_array[x].fil = temp then
                        begin
                          found := true;
                          t3 := x;
                        end;
                    end;

                  if not found then
                    begin
                      write (temp,'   Memo > ');
                      Input('A','',wherex,wherey,33,true,F1,F10);

                      writeln;
                      temp_array[t2].memo := answer;
                    end
                  else
                    begin
                      write (TEMP,'   Memo > ');
                      input('A',cat_array[t3].memo,wherex,wherey,33,true,F1,F10);
                      temp_array[t2].memo := answer;
                      writeln;
                    end;
                  msdos12;
                end
            end;
          writeln ('Updating catalog..  One moment...');
          t1 := vol_max - vol_min + 1;
          if t1 < t2 then
            begin
              {check to see if we will overrun the array}
              if (cat_num + (t2 - t1)) > max_records then
                begin
                  writeln ('Maximum of ',max_records,' files exceeded by ',cat_num + t2 - t1 - max_records,'.');
                  writeln ('Truncating to ',max_records);
                end;
              {move the file up t2 - t1 records}
              for x := (cat_num + t2 - t1) downto (vol_max + t2-t1 + 1) do
                cat_array[x] := cat_array[x - t2+t1];
              cat_num := cat_num + t2 - t1;
              {insert temp array}
              for x := 1 to t2 do
                begin
                  cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                  cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                  cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                  cat_array[x + vol_min - 1].time := temp_array[x].time;
                  cat_array[x + vol_min - 1].date := temp_array[x].date;
                  cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                  cat_array[x + vol_min - 1].vol_record := t4;
                end;
            end
          else  {the temp will fil in the old slot}
            if t1 > t2 then
              begin
                {insert temp array at vol_min}
                for x := 1 to t2 do
                  begin
                    cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                    cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                    cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                    cat_array[x + vol_min - 1].time := temp_array[x].time;
                    cat_array[x + vol_min - 1].date := temp_array[x].date;
                    cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                    cat_array[x + vol_min - 1].vol_record := t4;
                  end;
                { move the array down to meet it }
                for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
                  cat_array[x] := cat_array[x -(t2-t1)];
                cat_num := x;
              end
            else  { the replacement array is an exact match !}
              for x := 1 to t2 do
                begin
                  cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                  cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                  cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                  cat_array[x + vol_min - 1].time := temp_array[x].time;
                  cat_array[x + vol_min - 1].date := temp_array[x].date;
                  cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                  cat_array[x + vol_min - 1].vol_record := t4;
                end;
        end
      else           { Do a Complete Add function }
        begin
          msdos11(3);
          if (r.ax and 255) = 0 then
            begin
              if Ctype = 'T' then
              id := pathname
              else
              id := volume;
              cat_num := cat_num + 1;
              vol_num := vol_num + 1;
              vol_array[vol_num] := id;
              cat_array[cat_num].vol_record := -1;  { -1 means this is a vol entry }
              cat_array[cat_num].fil := id;
              cat_array[cat_num].memo := 'Volume Label';
              while ((r.ax and 255) = 0) and (cat_num < max_records + 1) do
                begin
                  cat_num := cat_num + 1;
                  temp := '';
                  for x := 8 to 18 do
                    temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
                  write (temp,'  ');
                  write (' Memo > ');
                  Input('A','',wherex,wherey,33,true,F1,F10);
                  one_memo := answer;
                  writeln;
                  cat_array[cat_num].vol_record := vol_num;
                  cat_array[cat_num].fil := temp;
                  cat_array[cat_num].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
                  cat_array[cat_num].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
                  cat_array[cat_num].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
                  cat_array[cat_num].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
                  cat_array[cat_num].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
                  cat_array[cat_num].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
                  cat_array[cat_num].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
                  cat_array[cat_num].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
                  cat_array[cat_num].memo := one_memo;
                  msdos12;
                end;
            end
          else
            writeln ('Disk has no files!');
        end;
      if cat_num = max_records then writeln ('The catalog is full.');
    end
  else
    begin
      writeln (' Cannot catalog a disk without a Volume Label.');
      writeln (' A)dd one from the Main Menu.');
    end;
    writeln;
  write (' Press any key to continue');
  read (kbd,ch);
end;

function upcase33(strng : str33) : str33;
var
  temp : str33;
  x : integer;
begin
  temp := '';
  for x := 1 to length(strng) do
    temp := temp + upcase(strng[x]);
  upcase33 := temp;
end;

procedure scan_comments;
var
  scanner : string[33];
  bytes : real;
  t1,t2,d1,d2,hour,minutes,mm,dd,yy,y : integer;
begin
  drawbox (7,6,70,10,lightcyan,black,'[ Scan Memos ]',blink_no);
  y := 0;
  write ('Enter string to scan for: ');
  input('A','',wherex,wherey,33,true,f1,f10);
  scanner := answer;
  drawbox (1,1,80,24,cyan,black,
  '[Volume   ] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  scanner := upcase33(scanner);
  for x := 1 to cat_num do
      if cat_array[x].vol_record = -1 then
           ID :=  cat_array[x].fil
    else
      begin
      if pos(scanner, upcase33(cat_array[x].memo)) > 0 then
        begin
          y := y + 1;
          write (id:11);
          write (' ',cat_array[x].fil:11);
          bytes := ord(cat_array[x].sizelo[2]) * 256.0;
          bytes := bytes + ord(cat_array[x].sizelo[1]);
          bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
          write (' ',bytes:6:0);
          t1 := ord(cat_array[x].time[1]);
          t2 := ord(cat_array[x].time[2]);
          d1 := ord(cat_array[x].date[1]);
          d2 := ord(cat_array[x].date[2]);
          hour := (t2 and 249) shr 3;
          if hour = 0 then
            write (' 00')
          else
            if hour < 10 then
              write (' 0',hour)
            else
              write (' ',hour);
          minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
          if minutes < 10 then write ('0');
          write (minutes);
          mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
          dd := (d1 and 31);
          yy := 80 + ((d2 and 255) shr 1);
          write (' ');
          if mm < 10 then write ('0'); write (mm,'-');
          if dd < 10 then write ('0'); write (dd,'-');
          write (yy:2);
          write (' ',cat_array[x].memo);
          if length(cat_array[x].memo) < 33 then writeln;
          if y/21 = int(y/21) then keycontinue;
        end;
      end;
  writeln;
  write ('End of catalog. Press any key to continue');
  read (kbd,ch);
end;

procedure scan_files;
var
  scanner : string[11];
  bytes : real;
  t1,t2,d1,d2,hour,minutes,mm,dd,yy,y: integer;
begin
  drawbox (7,6,70,10,lightcyan,black,'[ Scan Filenames ]',blink_no);
  y := 0;
  write ('Enter string to scan for: ');
  input('A','',wherex,wherey,11,true,f1,f10);
  scanner := answer;
  drawbox (1,1,80,24,cyan,black,
  '[Volume   ] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  scanner := upcase11(scanner);
  for x := 1 to cat_num do
    if cat_array[x].vol_record = -1 then
           ID :=  cat_array[x].fil
    else
      begin
      if pos(scanner, upcase11(cat_array[x].fil)) > 0 then
        begin
          y := y + 1;
          write (id:11);
          write (' ',cat_array[x].fil:11);
          bytes := ord(cat_array[x].sizelo[2]) * 256.0;
          bytes := bytes + ord(cat_array[x].sizelo[1]);
          bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
          write (' ',bytes:6:0);
          t1 := ord(cat_array[x].time[1]);
          t2 := ord(cat_array[x].time[2]);
          d1 := ord(cat_array[x].date[1]);
          d2 := ord(cat_array[x].date[2]);
          hour := (t2 and 249) shr 3;
          if hour = 0 then
            write (' 00')
          else
            if hour < 10 then
              write (' 0',hour)
            else
              write (' ',hour);
          minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
          if minutes < 10 then write ('0');
          write (minutes);
          mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
          dd := (d1 and 31);
          yy := 80 + ((d2 and 255) shr 1);
          write (' ');
          if mm < 10 then write ('0'); write (mm,'-');
          if dd < 10 then write ('0'); write (dd,'-');
          write (yy:2);
          write (' ',cat_array[x].memo);
          if length(cat_array[x].memo) < 33 then writeln;
          if y/21 = int(y/21) then keycontinue;
        end;
      end;
  writeln;
  write ('End of catalog. Press any key to continue');
  read (kbd,ch);
end;

procedure vol_disk;
var
  newvol : str11;
begin
  drawbox (3,15,55,20,lightgreen,black,'[ Volume Disk ]',blink_no);
  volume := '';
  msdos11(8);
  if (r.ax and 255) = 0 then
    begin
      for x := 8 to 18 do
        volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
      writeln ('Current Volume is ',volume);
      write ('Are you sure you want to change ? ');
      repeat read (kbd,ch); until ch in yes_no;
      if upcase(ch) = 'Y' then
        begin
          writeln;
          write ('Enter new Volume Label >');
          input('A','',wherex,wherey,11,true,f1,f10);
          newvol := answer;
          for x := length(newvol) to 11 do newvol := newvol + ' ';
          for x := 17 to 28 do fcb[x] := newvol[x-16];
          pointer := addr(fcb[-7]);
          r.ds := seg(pointer^);
          r.dx := ofs(pointer^);
          r.ax := $17 shl 8;
          msdos(R);
        end
    end
  else
    begin
      write ('Enter new Volume Label >');
      input('A','',wherex,wherey,11,true,f1,f10);
      newvol := answer;
      for x := length(newvol) to 11 do newvol := newvol + ' ';
      for x := 1 to 11 do fcb[x] := newvol[x];
      pointer := addr(fcb[-7]);
      r.ds := seg(pointer^);
      r.dx := ofs(pointer^);
      r.ax := $16 shl 8;
      msdos(R);
    end;
end;

procedure scan_submenu;
begin
  drawbox(1,5,80,9,lightred,black,'[ Scan Sub-Menu ]',blink_no);
  writeln ;
  write ('  1) Filenames   2) Memos   3) Exit   Your choice?  ');
  repeat
    read (kbd,ch);
  until ch in ['1'..'3'];
  case ch of
    '1' : scan_files;
    '2' : scan_comments;
  end;
end;

Procedure Indtype; {gg}
begin
drawbox(20,15,78,22,lightcyan,black,'[ Catalog Load ]',blink_no);
   Ctype := 'T';
   GetPath;
   Get_Vol;
   if pathname = 'ROOT       ' then begin
    catname := copy(volume,1,11);
    stripspaces(catname,catname);
    catname := catname+'.CAT';
    end
    else begin
    stripspaces(pathname,catname);
    catname := catname+'.CAT';
    end;
    writeln;
     write('Enter name of catalog: ');
     input('A',catname,24,whereY,33,true,F1,F10);
     catname := answer;
     writeln;
    Load_Catalog;
end;

procedure TreeType; {gg}
begin
     Ctype := 'T';
     drawbox (20,15,78,22,lightcyan,black,'[ Catalog Load ]',blink_no);
     writeln;
     write('Enter name of catalog: ');
     input('A',default_drive+':\TREELIB.CAT',24,2,33,true,F1,F10);
     catname := answer;
     writeln;
     GetPath;
     Load_Catalog;
end;

procedure FlopType; {gg}
begin
     Ctype := 'F';
     drawbox (20,15,78,22,lightcyan,black,'[ Catalog Load ]',blink_no);
     writeln;
     write('Enter name of catalog: ');
     input('A',default_drive+':\FLOPLIB.CAT',24,2,33,true,F1,F10);
     catname := answer;
     orig_drive := default_drive;
     writeln;
     write('     Drive to catalog: ');
     repeat
     read(kbd,ch);
     ch := upcase(ch);
       if not (ch in ['A'..'E']) then beep(350,150);
     until ch in ['A'..'E'];
     write(ch+':');
     Log_New_Drive(Ch);
     GetPath;
     Load_Catalog;
end;

procedure Load_Type;    {gg}
begin
  if changed then
     begin
      drawbox (10,17,70,22,white,red,'[ Warning! ]',blink_yes);
      center('  Catalog '+catname+' has been changed!',1,2,59);
      center ('  Do you want to Save [Y/N] ? ',1,3,59);
      repeat read (kbd,ch); until ch in yes_no;
     if upcase(ch) = 'Y' then
     save_catalog
     end;
  INIT;
  getdir(0,fullpathname);
  default_drive := fullpathname[1];
  drawbox(2,17,78,22,lightred,black,'[ Load Catalog ]',blink_no);
  writeln ;
  writeln (' T)ree Structured Library   F)loppy Library   D)irectory Catalog  E)xit');
  writeln;
  write('                            Your choice ? ');
  repeat
    read (kbd,ch);
    ch := upcase(ch);
  until ch in ['T','F','D','E'];
  write(ch);
  case ch of
    'T' : TreeType;
    'F' : FlopType;
    'D' : IndType;
  end;
end;

procedure show_catalog;
begin
  drawbox (1,5,30,24,white,black,'[ show ]',blink_no);
  for x := 1 to cat_num do
   begin
    writeln (x,' ',cat_array[x].vol_record,' ',cat_array[x].fil);
    if x/17 = int(x/17) then keycontinue;
   end;
   keycontinue;
end;

procedure Help;
begin
drawbox(1,1,80,24,white,black,'[ Help Screen ]', blink_no);
writeln;
writeln(' PCDISK is adapted from John Friel IIIs Disk cataloger.  If you find it');
writeln(' of value please send your contribution to him at:   ');
writeln('    The Forbin Project, 715 Walnut Street, Cedar Falls, Iowa 50613.');
writeln;
writeln;
writeln(' COMMANDS:');
writeln;
writeln(' L)oad Catalog submenu:');
writeln('    T)ree  - useful for keeping track of a hard disk');
writeln('    F)loppy - useful for keeping track of up to 1000 files on 100 floppies');
writeln('    D)irectory - for a catalog of the current drive or directory');
writeln(' U)pdate - presents existing file descriptions for editing or addition');
writeln(' F)ilenames - Lists only the filenames in the catalog');
writeln(' R)eview - search for a string (in filenames or memos)');
writeln(' A)dd - create or change a volume label on the current drive');
writeln(' E)rase - removes the specified volume from memory');
writeln(' D)ir - shows directory of current drive/disk');
writeln;
writeln(' If you have questions about, or discover bugs in, this version of ');
writeln(' PCDISK, please address them to G. Gallo at PCSI - 1-212-924-6598');
keycontinue;
end;

procedure options;
begin
    Drawbox (1,1,80,4,brown,black,'',blink_yes);
    textcolor(lightgreen);
    Writeln ('                          PC-Disk  Version 3.0D ');
    Write   ('         (c) The Forbin Project  - revised by G.G. 23 May 1985    ');
    drawbox(1,5,80,15,yellow,black,'[ Main Menu ]',blink_no);
    writeln;
    writeln ('          L)oad Catalog                 R)eview Catalog in Memory');
    writeln ('          U)pdate Catalog in Memory     A)dd/Change Volume Label');
    writeln ('          S)ave Catalog to Disk         E)rase a Volume from Memory');
    writeln ('          D)isk Directory               H)elp Screen');
    writeln ('          C)hange Current Directory     F)ilenames in Catalog');
    writeln ('          N)ew Drive                    Q)uit PC-Disk');
    writeln;
    write   ('                           Your choice:  ');
    gotoxy (41,9);
    repeat
      read (kbd,ch);
      Ch := upcase(ch);
    until ch in ['L','C','D','U','S','N','R','A','H','F','E','O','I','Q'];
    write(ch);
    case ch of
      'L' :  load_type;
      'C' :  changedir;
      'D' :  dir2;
      'U' :  update_disk;
      'S' :  save_catalog;
      'R' :  scan_submenu;
      'A' :  vol_disk;
      'H' :  help;
      'E' :  delete_volume;
      'F' :  show_catalog;
      'N' :  changedrive;
      'Q' :  big_exit;
    end; { case }
end;

begin {main}
  clrscr;
  init;
  getdir(0,fullpathname);
  orig_path := fullpathname;
  default_drive := fullpathname[1];
  repeat
  options;
  until done;
  chdir(orig_path);
  window(1,1,80,25);
  clrscr;
end.

.