program index;

var
   in_char : char;        { character returned by readakey function }
   place : byte;          { pointer to current "position" of select screen }
   col: byte;             { column on screen for display purposes }
   count    : byte;       { temporary counter variable }
   Filename : string[12]; { name of file to be deleted  }
   num : integer;         { loop limit variable }
   heaptop : ^integer;    { marker to start of free heapspace }
   print_flag : boolean;  { true if printer attached }

type
   filepointer = ^heapinfo; { establish 'filepointer' as pointer type }

   result = record
            ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
            end;

   heapinfo = record                    { format of heap records }
              name : string[12];        { filename w/ extension }
              description : string[80]; { descriptive string     }
              next : filepointer;       { 'next' ptr in 2x link list }
              last : filepointer;       { 'last' ptr in 2x link list }
              end;

   fileinfo = record                    { format of disk file records }
              name : string[12];        { filename w/ extension }
              description : string[80]; { descriptive string     }
              end;

var
   first,current,last, tptra : filepointer;  { 2x link list pointers }
   filerec : fileinfo;                       { filerec is current record from disk }
   file1   : file of fileinfo;
   intr_rec : result;

label  exit;

const
     alpha : byte = 2;
     background : byte = 1;

testline:array [1..42] of byte =
     ($c9,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$bb,
      $c8,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$bc);

testline2:array [1..21] of byte =
     ($40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40);

vertlineleft:array [1..8] of byte =
     ($c9,$ba,$ba,$ba,$ba,$ba,$ba,$c8);

vertlineleftback:array [1..8] of byte =
     ($40,$40,$40,$40,$40,$40,$40,$40);

vertlineright:array [1..8] of byte =
     ($bb,$ba,$ba,$ba,$ba,$ba,$ba,$bc);

vertlinerightback :array [1..8] of byte =
     ($40,$40,$40,$40,$40,$40,$40,$40);

firstletter:array[1..6] of byte =
     ($0f,$0f,$0f,$0f,$0f,$0f);

cursorlineaccent : array[1..12] of byte =
     ($5f,$50,$50,$50,$50,$50,$50,$50,$50,$50,$50,$50);

cursorlinenormal:array[1..12] of byte =
     ($0f,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07);

{*******************************************************************}
function cursordown(pos,modval:byte) : byte;
{*******************************************************************}
{   this routine will return the updated value of the pointer 'pos'
    for doing a cursor down movement.
    'pos' = current pointer position (0 <= pos < modval)
    'modval' = upper limit (ie count of items in list)

    example: if you have 5 items in the list, this function will return
             a number between 0 & modval-1.  (0 & 4)                    }

begin
   cursordown := (pos + 1) mod modval;
end; { end of cursordown }

{*******************************************************************}
function cursorup(pos,mod_val:byte) : byte;
{*******************************************************************}
{   this routine will return the updated value of the pointer 'pos'
    for doing a cursor up movement.
    'pos' = current pointer position (0 <= pos < modval)
    'modval' = upper limit (ie count of items in list)

    example: if you have 5 items in the list, this function will return
             a number between 0 & modval-1.  ( 0 & 4 )                  }

begin
   cursorup := (pos + mod_val - 1) mod mod_val;
end;  {end of cursorup }

{*******************************************************************}
function readakey : char;
{*******************************************************************}
{   this function returns the value of a keystroke. If an extended keystroke
    is used ( like a cursorkey), that keystroke is detected, and modified
    as per below. This will assign normal codes to the cursor movements,
    not the ones assigned by turbo pascal.                              }

var
   in_key : char;
begin
   read(kbd,in_key);          { wait for a keystroke }
   if keypressed then         { if an extended key, read keystroke }
   begin
      read(kbd,in_key);       { then the extended keystroke  }
      case in_key of
      'H' : in_key  := ^K; { vert tab (cursor up)}
      'M' : in_key  := ^I; { cursor right (tab) }
      'P' : in_key  := ^J; { line feed (cursor down)}
      'K' : in_key  := ^S; { backspace (cursor left)}
      'S' : in_key  := ^P; { DLE }
      end;  { end of case }
   end;
   readakey := in_key;  { set value for return }
end; { end of readakey }

{******************************************************************}
procedure quickprint(Row,Col,HowMany,start_pos:integer;code,option:byte);
{******************************************************************}
{ option 1 = print horizontally
  option 2 = print vertically
  option 3 = highlight alpha or background

  Row = starting row position
  Col = starting screen column
  Howmany = number of bytes to be displayed or highlighted
  start_pos = either the offset of an array to be printed, or
              the attribute byte value to be set
  code = 2 for alpha bytes, 1 for backgrounds
  option = as described above             }

var
   Start: integer;     { starting offset into graphics ram }
   count: integer;     { loop counter                      }

begin
   Start := ((Row-1)*160) + (Col*2) - code;
      for count := 0 to howmany-1 do
      begin
         if option = 3
            then mem[$b800:start] := start_pos
            else Mem[$b800:start] := mem[cseg:start_pos+count];   { set attribute byte    }
         if option = 2 then start := start + 160
                       else start := start + 2;          { increment to next byte}
      end;
end;  { end of quickprint }

{*******************************************************************}
procedure movecursor(var place,col:byte;row,num,width:byte);
{*******************************************************************}
{  this proc will move a cursor between user define limits on the screen
   place = current cursor position ( between 0 and # items-1 )
   col = screen column where cursor starts
   row = screen row where current cursor is
   num = number of lines of cursor travel possible
   width = width of cursor ( # characters )    }

begin
   repeat
      in_char := readakey;   { get a character from keyboard    }
      case in_char of
      ^K  : begin            { cursor up }
               quickprint(row+place,col,width,ofs(cursorlinenormal),background,1);
               place := cursorup(place,num);   { calc new row }
               quickprint(row+place,col,width,ofs(cursorlineaccent),background,1);
            end;
      ^J  : begin            { cursor down }
               quickprint(row+place,col,width,ofs(cursorlinenormal),background,1);
               place := cursordown(place,num); { calc new row }
               quickprint(row+place,col,width,ofs(cursorlineaccent),background,1);
            end;

      end;  {end case}
   until (in_char in [^M,^[,'R','r','W','w','D','d','I','i','Q','q','P','p','S','s','F','f']);
   end;  {end movecursor}

{*******************************************************************}
procedure putbox;
{*******************************************************************}
{  this procedure will put the 'box' on the screen for any given
   routine. no parameters are passed.                             }

begin
   clrscr;
   quickprint(9,30,21,ofs(testline),alpha,1);
   quickprint(9,30,21,ofs(testline2),background,1);
   quickprint(16,30,21,ofs(testline)+21,alpha,1);
   quickprint(16,30,21,ofs(testline2),background,1);
   quickprint(9,30,8,ofs(vertlineleft),alpha,2);
   quickprint(9,30,8,ofs(vertlineleftback),background,2);
   quickprint(9,50,8,ofs(vertlineright),alpha,2);
   quickprint(9,50,8,ofs(vertlinerightback),background,2);

end;  { end putbox}

{*******************************************************************}
procedure init;
{*******************************************************************}
{  this procedure initializes the disk file this program requires
   to be present. No parameters are passed. It checks for an existing
   file, and warns if the file will be destroyed   }

begin
   putbox;
   gotoxy(34,9);write(' INITIALIZE ');

     {$i-}
     reset(file1);
     {$i+}
     if ioresult <> 0          { file not in existance }
        then begin
             rewrite(file1);   { create file }
             first := nil;     { set pointers for empty lists }
             tptra := nil;     { set pointers for empty lists }
             end

        else begin      { file exists - may be overwritten }
             gotoxy(31,11);write('Index file exists.');
             gotoxy(31,12);write('Current index file');
             gotoxy(33,13);write('will be lost.');
             gotoxy(32,14);write('Continue (Y/N)? ');
             read(in_char);                            { read response }
             if upcase(in_char) = 'Y'                  { if 'y' then do }
                then begin
                     erase(file1);          { purge exist. file }
                     rewrite(file1);        { create empty file }
                     first := nil;          { set pointers for empty lists }
                     tptra := nil;          { set pointers for empty lists }
                     end;
             end;
end; { end of initialize }

{*******************************************************************}
procedure showmenu;
{********************************************************************}
{ this proc displays the main menu for the program }
begin
   putbox;              { draw box }
   gotoxy(32,9);write(' INDEX Main Menu ');
   gotoxy(35,10);write('Read files');
   gotoxy(35,11);write('Write file');
   gotoxy(35,12);write('Delete file');
   gotoxy(35,13);write('Initialize');
   gotoxy(35,14);write('Quit');
   gotoxy(35,15);write('Print');
   quickprint(10,35,6,ofs(firstletter),background,2);       {highlight first letter }
   quickprint(10,35,12,ofs(cursorlineaccent),background,1); {display cursor }
        { display help line }
   gotoxy(10,25);textcolor(black);textbackground(lightgray);
   write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
   write('-move bar. Select by pressing a ');textcolor(white);
   write('highlighted ');textcolor(lightgray);
   write('letter or ');textcolor(black);textbackground(lightgray);
   write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);

end; { end of showmenu }

{******************************************************************}
procedure select;
{******************************************************************}
{  this proc will allow the user to select any file from the list
   to either read its contents, or delete it from the list. If there are
   more files than space to show them, this function will allow
   the user to scroll through the complete list.    }

var
   row, col, place : byte;
label exit;

begin
  count := 0;row := 10; col := 35; place := 0; num := 6;
  window(col,row,col+12,row+6);   { set window for filename display }
  gotoxy(1,1);
  if tptra = nil                  { check ptr to start of list }
     then begin                   { if = nil: list empty   }
          writeln('No current');
          writeln('  files  ');
          delay(5000);
          goto exit;
          end
     else repeat                  { if <> nil: list has entries }
          writeln(tptra^.name);   { display filename }
          tptra := tptra^.next;   { move to next in list }
          count := count + 1;
          until (count = num) or (tptra = nil);  { continue until all displayed or window full }
 window(col,row,col+12,row+5);    { reset window to 1 row smaller(takes care of last}
                                  { writeln command and it reposition of the cursor }
 tptra := first;                  { reset temp pointer }
 gotoxy(col,row);quickprint(row,col,12,$70,background,3);
 {*** loop from here until a file is selected *****}
 repeat
 in_char := readakey;             { grab a input character }
 case in_char of
 ^K : begin                       { cursor up}
      if tptra^.last <> nil       { if <> nil, we can travel back through list }
         then if place = 0        { if at top: need to scroll back }
              then begin
                   tptra := tptra^.last;    { go back one entry }
                   gotoxy(1,1);
                   { push (scroll) entries down and make room for one at top }
                   insline;quickprint(row+place+1,col,12,$07,background,3);
                   write(tptra^.name);
                   quickprint(row+place,col,12,$70,background,3);
                   end
              else begin          { not at top: we can move cursor up w/o scroll }
                   quickprint(row+place,col,12,$07,background,3);
                   place := cursorup(place,num);
                   quickprint(row+place,col,12,$70,background,3);
                   tptra := tptra^.last;
                   end;
      end;
 ^J : begin                        { move down }
      if tptra^.next <> nil        { if <> nil, we can still travel forward in list }
         then if place = num-1     { if =, we need to scroll screen up }
                 then begin
                      tptra := tptra^.next;     { get next entry }
                      gotoxy(1,1);delline;      { scroll up and make room at bottom }
                      quickprint(row+place-1,col,12,$07,background,3);
                      gotoxy(1,num);            { goto bottom of screen }
                      write(tptra^.name);       { display next filename }
                      quickprint(row+place,col,12,$70,background,3);
                      end
                 else begin        { we can travel down (forward) w/o scroll }
                      quickprint(row+place,col,12,$07,background,3);
                      place := cursordown(place,num);
                      quickprint(row+place,col,12,$70,background,3);
                      tptra := tptra^.next;
                      end;
      end;
 end; { end case }
 until (in_char in [^M,^[,';']);
exit:
 window(1,1,80,25);          { reset window }
 end; { end of select}

{*******************************************************************}
procedure readfiles;
{*******************************************************************}
{  this proc reads the current contents of the index file and
   sets up the double link list pointers. If the file 'INDEX.NDX'
   is not on the disk, an error message is printed out   }

var
   row, place, col : byte;
begin
   {$i-}
   assign(file1,'INDEX.NDX');
   reset(file1);
   {$i+}
   if ioresult <> 0
      then begin  { file doesnt exist }
           putbox;
           gotoxy(36,9);write(' ERROR ');
           gotoxy(32,11);write(' Program must be');
           gotoxy(32,12);write('initialized first');
           delay(5000);
           end

      else begin          { file exists-set up double link lists }
           first := nil;            { set initial pointers to nil }
           tptra := nil;            { set initial pointers to nil }
           while not eof(file1) do
              begin
              read(file1,filerec);              { read a record from file }
              new(current);                     { grab pointer from pool }
              current^.name := filerec.name;    { set name        }
              current^.description := filerec.description; {set description }
              current^.next := first;           { set forward pointer }
              current^.last := nil;             { set backward pointer }
              if first <> nil then first^.last := current;  { special case}
              if first = nil then last := current;  {set 'last' pointer for kicks}
              first := current;                 { update initial pointer }
              tptra := current;                 { update initial pointer }
              end;
           end;

end; { end of readfiles }

{*************************************************************}
procedure writefiles;
{*************************************************************}
{  this proc will add (insert) a file name/description into the
   current link-list of files           }

var dummy : char;
label exit;
begin
   putbox;     { display box }
   gotoxy(36,9);write(' WRITE ');gotoxy(33,12);write('Enter filename:');
   gotoxy(35,25);
   textcolor(black);textbackground(lightgray);
   write('<',chr($c4),chr($d9));
   textcolor(lightgray);textbackground(black);
   write('-exit');
     { read filename to be added-if null, exit from this proc }
   gotoxy(36,14);read(filerec.name);
   if length(filerec.name) = 0 then goto exit;

   {******* convert filename to all caps *****}
   for count := 1 to length(filerec.name) do
      filerec.name[count] := upcase(filerec.name[count]);

   {******** check for existing filename first *********}
   current := nil;
   while tptra <> nil do
   begin
      if tptra^.name = filerec.name then current := tptra;
      tptra := tptra^.next;
   end;

   { set a window for easy display }
   window(31,10,49,15);clrscr;writeln;
   if current = nil   { file not currently in list }
      then begin
           writeln(' Enter description');
           write('  (80 chars max.):');
           window(1,1,80,25);                     { reset window }
           quickprint(22,1,80,$70,background,3);  { highlight input line }
           gotoxy(1,22);read(filerec.description);{ read description }
           new(current);                          { grab new pointer from pool }
           current^.name := filerec.name;               { set name }
           current^.description := filerec.description; { set description }
           current^.next := first;                      { set front pointer }
           current^.last := nil;                        { set back pointer }
           if first <> nil then first^.last := current; { special case pointer }
           if first = nil then last := current;         { set 'last' ptr for kicks}
           first := current;                      { update initial pointer }
           tptra := current;                      { update initial pointer }
           end
      else begin       { file already in index file }
           write('WARNING-description');
           writeln('   exists. This');
           writeln('  will overwrite.');
           write('Continue (y/n) ? ');
           read(dummy);                 { read response }
           clrscr;
           if upcase(dummy) = 'Y'
              then begin                { update file entry }
                   clrscr;writeln;
                   writeln(' Enter description');
                   write('  (80 chars max.):');
                   window(1,1,80,25);                      { reset the window }
                   quickprint(22,1,80,$70,background,3);   { highlight input line }
                   gotoxy(1,22);read(filerec.description); { read response }
                   current^.name := filerec.name;          { update name }
                   current^.description := filerec.description; { update descr }
                   tptra := first;                         { reset the temp pointer }
                   end

              else window(1,1,80,25);           { reset window to normal }

           end;
exit:
end;  { end of writefiles }

{***************************************************************}
procedure closeupshop;
{***************************************************************}
{  this proc will write the new file list out to the disk file. It
   is used when the user selects the 'Q' option.     }

begin
   rewrite(file1);             { reset file pointer }
   while tptra <> nil do       { write out until end of lists }
   begin
      filerec.name := tptra^.name;
      filerec.description := tptra^.description;
      write(file1,filerec);
      tptra := tptra^.next;    { update pointer to next item }
   end;
   close(file1);               { close the file }
end;  {end of closeupshop }

{*************************************************************}
procedure lookfile;
{*************************************************************}
{  this proc will allow the user to select which file to
   view. It calls routine 'select'    }

label exit;
begin
   putbox;        { display box }
   gotoxy(36,9);write('  READ  ');
          { display help line }
   gotoxy(7,25);textcolor(black);textbackground(lightgray);
   write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
   write('-move bar. Select by pressing function key ');textcolor(white);
   write('F1 ');textcolor(lightgray);
   write('or ');textcolor(black);textbackground(lightgray);
   write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
   write('.  ');textcolor(black);textbackground(lightgray);
   write('Esc');textcolor(lightgray);textbackground(black);
   write('-exit');

   select;       { return with file to be viewed ( or ESC to quit }
   if in_char = ^[ then goto exit;   { ESC ? go back to main menu }
   if tptra <> nil
      then begin
           gotoxy(1,22);
           clreol;write(tptra^.description);      { write descrip. line }
           quickprint(22,1,80,$40,background,3);  { highlight it }
           repeat
           until keypressed;                      { loop until key pressed }
           end;
   tptra := first;                                { reset temp pointer }
exit:
   end;  { end of lookfile }

{*************************************************************}
procedure deletefiles;
{*************************************************************}
{  this proc will delete a given file from the link list. }

var
   deleted  : boolean;
label exit;
begin
   putbox;   { display box }
   gotoxy(36,9);write(' DELETE ');
             { display help line }
   gotoxy(10,25);textcolor(black);textbackground(lightgray);
   write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
   write('-move bar. Select by pressing function key ');textcolor(white);
   write('F1 ');textcolor(lightgray);
   write('or ');textcolor(black);textbackground(lightgray);
   write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
   write('.  ');textcolor(black);textbackground(lightgray);
   write('Esc');textcolor(lightgray);textbackground(black);
   write('-exit');

   select;         { return with file to be deleted or ESC to exit }
   if in_char = ^[ then goto exit;   { ESC ? - exit }
   filename := tptra^.name;          { set file for deletion }
   deleted := false;                 { set deleted flag to false }
   if first = nil                    { empty list ? }
      then writeln('nothing to delete')
      else                           { list not empty-is it first item ? }
          if first^.name = filename then
              begin
              first := first^.next;
              first^.last := nil;
              deleted := true;
              end
          else begin               { not first item-search for filename }
               current := first^.next;
             {  last := first; }
               while (current <> nil) and (deleted = false) do
                  begin  {traverse and delete }
                  if current^.name = filename then { is current name the one ? }
                      begin                        { yes }
                      current^.last^.next := current^.next;
                      if current^.next <> nil
                         then current^.next^.last := current^.last;

                     { last^.next := current^.next;} { reset pointer }
                     { last := current^.next;      } { reset pointer }
                     { if last <> nil              } { special case }
                     {      then last^.last := current^.last; }
                      deleted := true;             { set deleted flag to true }
                      end
                  else         { move to next list name }
                     begin
                    { last := current;}          { update ptr of last entry }
                     current := current^.next; { update ptr to next entry }
                     end;
                  end;
               end;

exit:
tptra := first;  { reset temp pointer }
end;  { end of delete }

{*******************************************************************}
procedure print;
{*******************************************************************}
{  this proc will print the contents of the link list on either
   the printer, to the screen, or to a disk file   }
var namefile : string[12];
    file2 : text;
label exit;
begin
   putbox;
   gotoxy(37,9);write(' PRINT ');

   gotoxy(35,11);write('Screen');
   gotoxy(35,12);write('File');
   gotoxy(35,13);write('Printer');
   quickprint(10,35,6,ofs(firstletter),background,2);
   quickprint(11,35,12,ofs(cursorlineaccent),background,1);
   gotoxy(7,25);textcolor(black);textbackground(lightgray);
   write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
   write('-move bar. Select by pressing a ');textcolor(white);
   write('highlighted ');textcolor(lightgray);
   write('letter or ');textcolor(black);textbackground(lightgray);
   write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
   write('.  ');textcolor(black);textbackground(lightgray);
   write('Esc');textcolor(lightgray);textbackground(black);
   write('-exit');

   place := 0;movecursor(place,col,11,3,12);
   if in_char = ^[ then goto exit;
   case in_char of
   'S','s' : place := 0;
   'F','f' : place := 1;
   'P','p' : place := 2;
   end;  { end case }
   if place = 0 then clrscr;
   if place = 1
      then begin
           window(31,10,49,15);clrscr;writeln;
           writeln(' Enter filename:  ');
           read(namefile);
           if length(namefile) = 0 then goto exit;
           assign(file2,namefile);
           rewrite(file2);
           end;
   while tptra <> nil do
      begin
      filerec.name := tptra^.name;
      filerec.description := tptra^.description;
      case place of
      0 : begin
          writeln(filerec.name);
          writeln(filerec.description);writeln;
          delay(500);
          end;
      1 : writeln(file2,filerec.name:12,'  ',filerec.description);
      2 : begin
          if print_flag = true
            then writeln(lst,filerec.name:12,'  ',filerec.description)
            else begin
                 clrscr;gotoxy(10,10);write('Printer error');delay(1000);
                 end;
          end;
      end;  { end case }
      tptra := tptra^.next;
      end;
      if place = 1 then close(file2);
   tptra := first;
exit:
window(1,1,80,25);
end; { end of print }

{**************************************************************}
{*  main driver starts here ....                              *}
{**************************************************************}
begin
   textmode(bw80);lowvideo;

   {******** set no visible cursor ********}
   intr_rec.ax := $0100;
   intr_rec.cx := $0f0f;
   intr($10,intr_rec);

   {********** printer test ************}
   print_flag := false;
   place := port[$0379];
   if place = $df then print_flag := true;
   place := port[$03bd];
   if place = $df then print_flag := true;

   readfiles;
   repeat
      clrscr;
      showmenu;
      place := 0;col := 35;
      { no parms given so get cursor movement results }
      movecursor(place,col,10,6,12);
      { if in_char = ^M, then place has cursor position }
      { else jump based on in_char value }
      case in_char of { case #2 }
      'R','r' : place := 0;
      'W','w' : place := 1;
      'D','d' : place := 2;
      'I','i' : place := 3;
      'Q','q' : place := 4;
      'P','p' : place := 5;
      end; { end case #2 }

      case place of   { case #1 }
      0 : begin  { read }
          lookfile;
          end;
      1 : begin   { write }
          writefiles;
          end;
      2 : begin   { delete }
          deletefiles;
          end;
      3 : begin   { init }
          init
          end;
      4 : begin     { quit }
          goto exit
          end;
      5 : begin   { print }
          print;
          end;
      end; { end case #1 }

 until true = false;

exit:
   closeupshop;
   release(heaptop);
   lowvideo;
end.sDos (BiosRec);
     With BiosRec do
          Begin