program LibraryUtility;

{
                written 10/09/84 by Steve Freeman

  This program was written to function as Gary Novosielski's LU.  As such it
  will function as a utility to manipulate library members under any operating
  system which will support TURBO Pascal.  Minor rewrites may be necessary for
  other versions of Pascal.

  This program is placed into the Public Domain by the author and, as a Public
  Domain program, may NOT be used for commercial purposes.


  Notes by John Plocher

  The program only uses a subset of the info stored in the library:

          --- Makeup of a library entry header ---
      status           :  (Unused, in use, and deleted)
      name             :  (Name of member stored in library)
      ext              :  (Type "    "      "    "    "    )
      index            :  (where in lib this member is stored)
      length_of_member :  (it's length )
      CRC              :  *** NOT IMPLEMENTED ***
      CreationDate     :  *** NOT IMPLEMENTED ***
      LastChangeDate   :  *** NOT IMPLEMENTED ***
      CreationTime     :  *** NOT IMPLEMENTED ***
      LastChangeTime   :  *** NOT IMPLEMENTED ***
      PadCount         : (used internally by LU)
      filler           : ( room for expansion )



        Modification history

       Version    Date       Who            Comments
       -------    ----       ---            --------
       1.22        1/12/85   John Plocher   Made library selection part of
                                            the program loop - No need to
                                            re-run LU to work on other
                                            libraries.  Changed active/total
                                            entries used display to reflect
                                            the fact that the library itself
                                            always uses the first entry and
                                            thus shouldn't be counted.
       1.21        1/12/85   John Plocher   Fixed MakeName bug where a
                                            filetype < 3 chars was incorrectly
                                            handled.  See MakeName comments.
       1.20        1/12/85   John Plocher   Added windows and function keys
       1.10        1/11/85   John Plocher   Rewrote to use screen in an
                                            intelegent manner with all
                                            data visable at one time.
                                            Also reformatted source code in
                                            a readable format.
       1.00       10/ 9/84   Steve Freeman  Initial coding
}

const V {ersion}       = '1.23';
      BufferSize       =  127;      { maximum size of data buffer - 1 }
      EntriesPerBuffer =  4;        { (BufferSize+1)/32 }
      maxent           =  128;      { maximum dir entries this program will take }
      Hell_Freezes_Over= False;     { Main driver loop termination... }
      esc              =  ^[;
      BS               =  ^H;
      HI               =  ^['p';
      LO               =  ^['q';
      CURSOR_OFF       =  ^['x5';
      CURSOR_ON        =  ^['y5';
      FK1              =  #$F1;     { function key values }
      FK2              =  #$F2;
      FK3              =  #$F3;
      FK4              =  #$F4;
      FK5              =  #$F5;
      FK6              =  #$F6;
      FK7              =  #$F7;

type TimeType     = integer;
     FileNameType = array[1..11] of char;
     LibFileType  = file;

     EntryType    = record
                   status         : byte;
                   name           : array[1..8] of char;
                   ext            : array[1..3] of char;
                   index          : integer;
                   length_of_member         : integer;
                   CRC            : integer;
                   CreationDate   : integer;
                   LastChangeDate : integer;
                   CreationTime   : TimeType;
                   LastChangeTime : TimeType;
                   PadCount       : byte;
                   filler         : array[27..31] of byte;
     end;
     EntryPtr     = ^EntryType;

     hexstr       = string[4];
     string10     = string[10];
     filename     = string[12];
     maxstr       = string[255];

var buffer           : array[0..BufferSize] of byte;
    library,
    file2            : file;
    SizeFile         : file of byte;
    DirectoryChanged : boolean;
    LibName,
    fname            : filename;
    LibSize,
    NumEntries       : integer;
    LibEntry         : EntryType;
    Dir              : array[0..maxent] of EntryPtr;
    active,
    unused,
    deleted          : integer;
    w_table : record x1,x2,y1,y2,
                   currx,curry : integer;
                   overwrote   : array[0..2048] of integer;
            end;
    screen : array[0..2048] of integer absolute $F000:0000;

{$I lu-1.pas }   {      Window handlers and status line drivers }

  function Confirm: boolean;
    var c: char;
  begin
      w_write_s(' Confirm operation (Y/N): ');
      repeat
          read(kbd,c);
          c := upcase(c);
      until (c in ['Y','N']);
      w_write_c(c);
      confirm := (c = 'Y')
  end;

  function hex(num: integer): hexstr;
  var i, j: integer;
      h: string[16];
      str: hexstr;
  begin
      str := '0000';   h := '0123456789ABCDEF';   j := num;
      for i:=4 downto 1 do begin
          str[i] := h[(j and 15)+1];
          j := j shr 4;
      end;
      hex := str;
  end;

  procedure MakeName(f: filename; var name: FileNameType);
  var dotpos,
      endname,
      i       : integer;
  begin
      name := '           ';
      for i:=1 to length(f) do
          f[i] := upcase(f[i]);
      dotpos := pos('.',f);
      if dotpos > 0 then begin
          endname := dotpos-1;
          for i:=1 to 3 do
              if (f[ dotpos+i ] <> ' ')
              AND (DOTPOS + I <= LENGTH(F))then (* ONLY copy chars if they   *)
                                                (* are actually there! - jmp *)
                     name[8+i] := f[dotpos+i];
      end
      else
          endname := length(f);
      for i:=1 to endname do
          name[i] := f[i];
  end;

  procedure PutName(f: filename; n: integer);
  var i: integer;
      name: FileNameType;
  begin
      MakeName(f,name);
      for i:=1 to 8 do
          Dir[n]^.name[i] := name[i];
      for i:=1 to 3 do
          Dir[n]^.ext[i]  := name[i+8];
  end;

  function FindMember(f: filename): integer;
  var member, dotpos, endname, i, k: integer;
      lookup: FileNameType;
      found: boolean;

    function NamesMatch(entry: integer): boolean;
    var match: boolean;
    begin
        NamesMatch := true;
        with Dir[entry]^ do begin
            for k:=1 to 8 do
                if name[k]<>lookup[k] then
                    NamesMatch := false;
            for k:=1 to 3 do
                if ext[k]<>lookup[8+k] then
                    NamesMatch := false;
        end;
    end;

  begin
      MakeName(f,lookup);
      found := false;   i := 1;
      while not(found) and (i<NumEntries) do
          if NamesMatch(i) then
              found := true
          else
              i := i + 1;

      if (active=1) or not(found) then
          FindMember := 0
      else
          FindMember := i
  end;

  function Parse(f: filename): filename;
  var i: integer;
  begin
      if f <> '' then begin
          for i:=1 to length(f) do
              f[i]:=upcase(f[i]);
          i := pos('.',f);
          if i>0 then
              f:=copy(f,1,i-1);
          f := f + '.LBR';
      end;
      Parse := f;
  end;

  procedure WriteDirectoryToDisk(var lib: LibFileType);
  var member, i: integer;
  begin
      reset(lib);
      member := 0;
      while member < NumEntries do begin
          for i:=0 to EntriesPerBuffer-1 do
              move(Dir[member+i]^,buffer[32*i],32);
          blockwrite(lib,buffer,1);
          member := member + 4
      end;
      DirectoryChanged := false
  end;

  procedure ZeroEntry(n: integer);
  begin
      fillchar(Dir[n]^,32,chr(0));      {clear the record}
      fillchar(Dir[n]^.name[1],11,' '); {clear file name}
      Dir[n]^.status := -1;             {mark unused}
  end;

  procedure SortDir;
  var i, j: integer;

    function larger(a, b: integer): boolean;
    var ok, x: integer;
        c1, c2: char;
    begin
        ok := 0;   x := 1;
        if (Dir[a]^.status <> 0) and (Dir[b]^.status <> 0) then ok := 2;
        if (Dir[a]^.status <> 0) and (ok = 0)              then ok := 1;
        if (Dir[b]^.status <> 0) and (ok = 0)              then ok := 2;
        while (x < 12) and (ok=0) do begin
            c1 := Dir[a]^.name[x];
            c2 := Dir[b]^.name[x];
            if c1 > c2 then ok := 1;
            if c1 < c2 then ok := 2;
            x := x + 1
        end;
        if ok=1 then
            larger := true
        else
            larger := false
    end;

    procedure swap(x, y: integer);
    var temp: EntryPtr;
    begin
        temp   := Dir[x];
        Dir[x] := Dir[y];
        Dir[y] := temp
    end;

  begin
      for i:=1 to NumEntries-1 do
          if Dir[i]^.status <> 0 then
              ZeroEntry(i);
      for i:=1 to NumEntries-2 do begin
          for j:=i+1 to NumEntries-1 do
              if larger(i,j) then
                  swap(i,j);
      end;
  end;

  procedure CreateDirectory;
  var i: integer;
  begin
      w_make(15,65,10,14);
      rewrite(library);
      w_write_s(' Creating a new library.  Name = ');
      w_write_s(LibName); w_writeln;
      w_write_s(' How many entries? ');  readln(i); w_writeln;
      NumEntries := i + 1;        {add 1 for Directory entry}
      i := NumEntries MOD 4;
      if i <> 0 then
          NumEntries := NumEntries + (4 - i);

      for i:=0 to NumEntries-1 do begin
          new(Dir[i]);
          ZeroEntry(i);
      end;

      Dir[0]^.status := 0; {directory entry is always used}
      Dir[0]^.length_of_member := NumEntries DIV 4;
      active         := 1;
      unused         := NumEntries - 1;
      deleted        := 0;
      WriteDirectoryToDisk(library);
      w_write_s(' Library created and initialized.');
      delay(1000);
      LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}
      w_delete;
  end;

  procedure GetDirectory;
  var i, offset: integer;
  begin
      offset := 0;
      DirectoryChanged := false;
      LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}
      blockread(library,buffer,1);
      new(Dir[0]);                 {make space for directory header}
      move(buffer[0],Dir[0]^,32);  {move header entry}
      NumEntries := (128 * Dir[0]^.length_of_member) DIV 32;
      for i:=1 to NumEntries-1 do begin
          if (i MOD EntriesPerBuffer) = 0 then begin {read next block}
              blockread(library,buffer,1);
              offset := offset + EntriesPerBuffer;
          end;
          new(Dir[i]);
          move(buffer[32*(i-offset)],Dir[i]^,32);
      end;
      active  := 1;
      unused  := 0;
      deleted := 0;
      for i:=1 to NumEntries-1 do
          if Dir[i]^.status=0 then
              active := active + 1
          else
              if Dir[i]^.status=$FE then
                  deleted := deleted + 1
              else
                  unused := unused + 1;
  end;

  procedure OpenLibrary;
  begin
      assign(library,LibName);
      {$I-} reset(library) {$I+};
      if IOresult=0 then
          GetDirectory
      else
          CreateDirectory;
  end;

  procedure Directory;
  var i, j: integer;
  begin
      gotoxy(3,6);  write(#$BA,'  name          index  length    CRC');
      gotoxy(41,6); write(#$B3,'  name          index  length    CRC ',#$BA);
      gotoxy(3,7);  write(#$C7); for i := 5 to 79 do write(#$C4); write(#$B6);
      gotoxy(41,7); write(#$C5);
      gotoxy(41,5); write(#$D1);
      for i:=1 to NumEntries-1 do
          with Dir[i]^ do begin
              if odd(i) then begin gotoxy(3,8+(i-1) div 2); write(#$BA); end
              else begin gotoxy(41,8+ (i-1) div 2); write(#$B3); end;
              if status <> $FF then begin
                  if status=$FE then
                      write('*')
                  else write(' ');
                  for j:=1 to 8 do
                      write(name[j]);
                  write('.');
                  for j:=1 to 3 do
                      write(ext[j]);
                  write(' ',index:8,length_of_member:8,'   ',hex(CRC));
              end
              else write('  <empty>                            ');
              gotoxy(79,8+(i-1) div 2);
              write(#$BA);
          end;  (* with *)
      gotoxy(41,8+(i-1) div 2);
      write(#$B3);
      gotoxy(79,8+(i-1) div 2);
      write(#$BA);
      gotoxy(3,9+(i-1) div 2);  write(#$C8);
      for i := 5 to 41 do write(#$CD);
      write(#$CF);
      for i := 43 to 79 do write(#$CD);
      write(#$BC);
  end;

{$I lu-2.pas } { command handlers - removed to include file for space reasons }

  procedure NewLib;
  var str : filename;
      x : integer;
  begin
      clrscr;
      gotoxy(3,1);
      write(#$C9); for x := 4 to 25 do write(#$CD); write(#$BB);
      gotoxy(3,2); write(#$BA,' Library Utility (LU) ',   #$BA);
      gotoxy(3,3); write(#$BA);gotoxy(26,3);        write(#$BA);
      gotoxy(3,4); write(#$BA,'   version ',V,'       ',  #$BA);
      gotoxy(3,5); write(#$C8);
      for x := 4 to 25 do write(#$CD); write(#$BC);
      w_make(10,70,6,15);
      w_gotoxy(2,2);
      w_write_s('What library file do you want to use?              ');
      w_writeln;
      w_writeln;
      w_write_s('  Library name format is <filename>[.lbr]'); w_writeln;
      w_writeln;
      w_write_s('  The extention ".LBR" is assumed in all cases'); w_writeln;
      w_write_s('  A null filename (just press <CR>) exits the program.');
      w_gotoxy(40,2);
      readln(str); w_writeln;
      LibName := Parse(str);
      if length(LibName)=0 then begin
          gotoxy(1,23);
          halt;
      end;
      w_delete;
  end;

  procedure Menu;
  var selection: char;
      x : integer;
  begin
      OpenLibrary;

      {    draw character graphics on screen  --  set up display 'form' }

      gotoxy(26,1); write(#$CB); for x :=27 to 78 do write(#$CD); write(#$BB);
      gotoxy(27,2);
      write('  Name: ',LibName,'':14-length(LibName),#$B3);
      gotoxy(79,2); write(#$BA);
      gotoxy(26,3);write(#$C7);gotoxy(79,3);write(#$B6);
      gotoxy(27,3); for x := 27 to 78 do write(#$C4);
      gotoxy(79,4); write(#$BA); gotoxy(3,5); write(#$CC);
      for x := 4 to 25 do write(#$CD); write(#$CA);
      for x :=27 to 78 do write(#$CD); write(#$B9);
      gotoxy(49,1); write(#$D1); gotoxy(63,1); write(#$D1);
      gotoxy(49,3); write(#$C5); gotoxy(63,3); write(#$C5);
      gotoxy(49,5); write(#$CF); gotoxy(63,5); write(#$CF);

      repeat
          write(CURSOR_OFF);
          if w_table.x1 <> -1 then begin
              delay(2000);
              w_delete;
          end;
          LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}

          { Update info on screen which could have changed cuz of last cmd }

          gotoxy(27,4);
          write(     '  Size: ',LibSize:3,'K bytes    ',#$B3);
          gotoxy(50,2);
          write(' Total: ',active+deleted+unused - 1:3,'  ',#$B3);
          gotoxy(50,4);
          write(     ' Active: ',active - 1:3,' ',#$B3);
          gotoxy(64,2);
          write(' Erased: ',deleted:3,'  ');
          gotoxy(64,4);
          write(     ' Unused: ',unused:3);

          { turn on status line for function key input }

          set_status('1 Extract ','2 Add     ','3 Erase   ',
                     '4 Unerase ','5 Pack    ','6 Help    ','7 Quit    ');
          Directory; { show updated library directory }
          repeat
              read(kbd,selection);
              selection := upcase(selection);
          until (selection in ['X','A','E','U','P','?','H','Q',
                               FK1,FK2,FK3,FK4,FK5,FK6,FK7]);
          clear_status;
          write(CURSOR_ON);
          case selection of
                'A',FK2: Add;
                'X',FK1: Extract;
            'H','?',FK6: Help;
                'E',FK3: Delete; (* erase *)
                'P',FK5: Reorganize; (* pack *)
                'U',FK4: Undelete;
                'Q',FK7:;
          end;
      until selection in ['Q',FK7];
      if DirectoryChanged then WriteDirectoryToDisk(library);
      close(library);
  end;

begin {Main}
  w_table.x1 := -1;
  repeat
      NewLib;
      Menu;
  until Hell_Freezes_Over;
end.
  textcolor(lightgray);textbackground(black);
   write('-exit');
     { read filename to be added-if null, exit fr