{          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {          *       *       *                    *       *       *          }
 {      *       *       *       *        *       *       *       *       *  }
 {  *       *       *       *       *        *       *       *       *      }
 {      WinBase Copyright (c) 2002           Programmed by Fraser King      }
 {      *       *       *       *        *       *       *       *       *  }
 {  *       *       *       *       *        *       *       *       *      }
 {              *       *                            *       *              }
 {              *       *                            *       *              }
 {              *       *                            *       *              }
 {              *       *                            *       *              }
 {              *       *                            *       *              }
 {              *       *                            *       *              }
 {              *       *                            *       *              }


{
  the current folder needs to be in winbase folder or the parent of
  winbase folder, for the program to compile (use 'Change Dir in File menu)
}

{
 import and export
 have a disk menu. options to delete and rename
 I have add record so I need to have delete record. maybe a edit record.
}


program WinBase;

uses
   crt,dos;

const
   MAX_ITEMS      = 944;
   MAX_MATCHES    = 50;
   MAX_NAME       = 20;
   MAX_COMMENTS   = 12;
   MAX_PATH       = 79;
   REPEATED_NAMES = 5;
   MAXFILE        = 10;

   LeFT_POiNTeR   = #175;
   RiGHT_POiNTeR  = #174;
   UP_ARROW       = #72;
   DOWN_ARROW     = #80;
   LEFT_ARROW     = #75;
   RIGHT_ARROW    = #77;
   RETURN_KEY     = #13;
   SPACEBAR       = #32;
   ESCAPE_KEY     = #27;
   DELETE_KEY     = #8;

   VERTICAL_LINE  = #186;
   UNDERLINE      = #205;
   SKIP           = ' ';
   EMPTY          = '';

   path          : string  = '';
   Files         : byte = 0;
   saveSubjectNo : byte = 0; {for the file assoc}

   c1 : integer = 9;
   c2 : integer = 12;
   c3 : integer = 14;
   c4 : integer = 11;

   sort_types : array[1..2] of string[4] =
  ('Date','Name');

   view_types : array[1..2] of string[7] =
  ('List','Details');

type
   titlesRecord =
   RECORD
      fileName    : string[60];  { the name of the .dat file }
      subjectName : string[8];   { subject of txt file }
   END;

   optionsRecord =
   RECORD
      subjectNo   : integer;
      sortNo      : integer;
      viewNo      : integer;
   END;

   namelistRecord =
   RECORD
      name        : string[MAX_NAME];
      comments    : string[MAX_COMMENTS];
   END;

   PatternRec =
   RECORD
      storex,storey : byte;
      col2,letter2  : byte;
   END;

   progType    = array[1..{MAX}1] of boolean; {for setup assoc}

   DataRecord = {for setup assoc}
   RECORD
      path  : string;{[MaxPath]}
      osver : byte;
      prog  : progType;
      icons : array[1..4] of boolean;
   END;

   namelistType   = array[1..MAX_ITEMS] of namelistRecord;
   titlesType     = titlesRecord;
   optionsType    = optionsRecord;
   storeMatchType = array[1..MAX_MATCHES] of integer;
   titlesArrType  = array [1..MAXFILE] of titlesRecord;
   PicType        = file of PatternRec;


function return_column(len : integer): integer;

begin
   return_column := 40-(len div 2);
end;


procedure draw_underline(x,y,len : integer);

var
   i : integer;

begin
   gotoxy(x,y);
   for i := 1 to len do
      write(UNDERLINE);
end;


procedure clear;

begin
   textcolor(black);
   clrscr;
end;


procedure clrwin(x1,y1,x2,y2 : integer);

begin
   window(x1,y1,x2,y2);
   clear;
   window(1,1,80,25);
end;


procedure writeto(text : string;
                   x,y : integer;
                colour : integer);

begin
   textcolor(colour);
   gotoxy(x,y);
   write(text);
end;


procedure writexy(text : string;
                   row : integer;
                colour : integer);

var
   len    : integer;
   column : integer;

begin
   len := length(text);
   column := return_column(len);
   writeto(text,column,row,colour);
end;


{procedure colourchar(text : string;
                      row : integer);

var
   rnd,len  : integer;
   column,i : integer;

begin
   len := length(text);
   column := return_column(len);
   gotoxy(column,row);

   for i := 1 to len do
   begin
      rnd := random(15)+1;
      textcolor(rnd);
      write(text[i]);
   end;
end;}


procedure pause(var ch : char);

begin
   ch := readkey;
   if ch = #0 then
      ch := readkey;

   if ch = #3 then { Ctrl-C }
   begin
      textcolor(lightgray);
      clrscr;
      halt;
   end;
end;


procedure display_pattern(path : string);

var
   P       : PicType;
   pattern : PatternRec;
   ch      : char;

begin
   assign(P,path+'WBtitle.gfx');
   {$I-} reset(P); {$I+}

   if IOresult <> 0 then
   begin
      writexy('Error loading WBTitle.gfx',12,c3);
      writexy('Press SPACE',14,c2);
      repeat
         pause(ch);
      until ch = SPACEBAR;
      clrscr;
      halt;
   end;

   while not eof(P) do
   begin
      read(P,pattern);
      with pattern do
         writeto(chr(letter2),storex,storey,col2);
   end;

   close(P);
end;


procedure set_file(var txtfile : text;
                       details : string;
                          name : string);
var
   ch : char;

begin
   if details <> 'close' then
   begin
      assign(txtfile, name);
      if details = 'reset' then
      {$I-} reset(txtfile) {$I+}
      else
      if details = 'rewrite' then
      {$I-} rewrite(txtfile) {$I+}
      else
      if details = 'append' then
      {$I-} append(txtfile); {$I+}

      if IOresult <> 0 then
      begin
         writexy('File access error',24,c3);
         writexy('Press SPACE',25,c2);
         repeat
            pause(ch);
         until ch = SPACEBAR;
         clrwin(1,24,79,25);
      end;
   end else
      close(txtfile);
end;


procedure readxy(var text : string;
           row,colour,max : integer);

var
   count : integer;
   ch    : char;

begin
   count := 1;
   text := EMPTY;
   repeat
      pause(ch);
      case ch of
         ESCAPE_KEY :
         begin
            clrwin(1,row,80,row);
            count := 1;
            text := EMPTY;
         end;
         DELETE_KEY :
         if count > 1 then
         begin
            dec(count);
            write(DELETE_KEY,SKIP,DELETE_KEY);
            delete(text,count,1);
            clrwin(1,row,80,row);
            writexy(text,row,colour);
         end;
         SPACEBAR..#127,#156 :
         if count <= max then
         begin
            inc(count);
            text := text + ch;
            writexy(text,row,colour);
         end;
      end;
   until ch = RETURN_KEY;
end;


procedure writecolour(text : string;
                       row : integer);

var
   len,i : integer;
   count : integer;

begin
   count := 0;
   for i := 1 to length(text) do
      if text[i] = '#' then
         inc(count,2);

   len := length(text)-count;
   gotoxy(40-(len div 2),row);

   for i := 1 to len do
   begin
      if text[i] = '#' then
      begin
         case text[i+1] of
            '1' : textcolor(c1);
            '2' : textcolor(c2);
            '3' : textcolor(c3);
            '4' : textcolor(c4);
         end;
         delete(text,i,2);
      end;
      write(text[i]);
   end;
end;


function conv(number : longint): string;

var
   tmpstr : string;

begin
   str(number,tmpstr);
   conv := tmpstr;
end;


procedure limits(var number : integer;
                    min,max : integer);

begin
   if number <= min then
      number := min
   else
   if number >= max then
      number := max;
end;


procedure initialise(var options : optionsType;
                         var row : integer);

begin
   with options do
   begin
      subjectNo := 1;
      sortNo := 2;
      viewNo := 2;
   end;
   row := 14;
end;


procedure wait_menu(min,max : integer;
                    var row : integer);

var
   ch : char;

begin
   repeat
      gotoxy(27,row);
      textcolor(c1);
      write(LeFT_POiNTeR);
      gotoxy(53,row);
      write(RiGHT_POiNTeR);

      pause(ch);

      gotoxy(27,row);
      write(SKIP);
      gotoxy(53,row);
      write(SKIP);

      case ch of
         UP_ARROW   : dec(row);
         DOWN_ARROW : inc(row);
      end;

      limits(row,min,max);
   until ch = RETURN_KEY;
end;


function main_menu(var row : integer;
                    titles : titlesType):integer;

begin
   clear;
   display_pattern(path);
   with titles do
   begin
{     colourchar('WinBase',11);}
      writecolour('#2'+'('+'#1'+fileName+'#2'+')',12);
      writexy('Add '+subjectName+' To List',14,c2);
      writexy('Find '+subjectName,15,c2);
      writexy('View List',16,c2);
      writexy({'Edit'}'New List',17,c2);
      writexy('Options',18,c2);
      writexy('Exit',19,c2);
   end;
   wait_menu(14,19,row);
   main_menu := row-13;
end;


function convert_to_lowercase(tmpstr : string) : string;

var
   i,tmpnum : integer;

begin
   for i := 1 to length(tmpstr) do
      if tmpstr[i] in ['A'..'Z'] then
      begin
         tmpnum := ord(tmpstr[i]);
         inc(tmpnum,32);
         tmpstr[i] := chr(tmpnum);
      end;
   convert_to_lowercase := tmpstr;
end;


procedure sort_list(var namelist : namelistType;
                       listcount : integer);

var
   i,m,sortcount : integer;
   lettercount   : integer;
   alpha         : array[1..26] of char;
   tmprec        : namelistType;

begin
   lettercount := 97;
   for i := 1 to 26 do
   begin
      alpha[i] := char(lettercount);
      inc(lettercount);
   end;

   sortcount := 0;
   for i := 1 to listcount do
      if namelist[i].name[1] in [#48..#57] then { numbers from 0 to 9 }
      begin
         inc(sortcount);
         tmprec[sortcount] := namelist[i];
      end;

   lettercount := 0;
   for m := 1 to 26 do
   begin
      inc(lettercount);
      for i := 1 to listcount do
      begin
         if alpha[lettercount] = namelist[i].name[1] then
         begin
            inc(sortcount);
            tmprec[sortcount] := namelist[i];
         end;
      end;
   end;

   namelist := tmprec;
end;


procedure save_to_disk(listCount : integer;
                          titles : titlesType;
                        namelist : namelistType);

var
   ListFile : text;
   i        : integer;

begin
   set_file(ListFile,'rewrite',path+titles.fileName);

   for i := 1 to listCount do
   begin
      writeln(ListFile,namelist[i].name);
      writeln(ListFile,namelist[i].comments);
   end;

   set_file(ListFile,'close',EMPTY);
end;


procedure add_to_list(var namelist : namelistType;
                     var listcount : integer;
                            titles : titlesType);

var
   tmpstr        : string;
   ok,quit,clr : boolean;
   i,storei      : integer;
   ch            : char;

begin
   clear;
   quit := false;
   repeat
      clrwin(1,9,80,14);
      ok := true;
      writexy('Press x to quit',9,c3);
      writexy('Type '+titles.subjectName+' to Add to list',10,c2);
      readxy(tmpstr,11,c1,MAX_NAME);
      tmpstr := convert_to_lowercase(tmpstr);

      storei := 0;   { code to avoid spaces at the start of string }
      for i := 1 to length(tmpstr) do
         if tmpstr[i] in [#48..#57,#97..#122] then
         begin
            storei := i;
            break;
         end;

      clr := false;  { this code only allows numbers + letters }
      if (not (tmpstr[1] in [#48..#57,#97..#122]))
        or (storei <> 1) then
         clr := true;

      if tmpstr = 'x' then
         quit := true;

      if (quit = false) and (clr = false) then
      begin
         if listcount = MAX_ITEMS then
         begin
            clear;
            writecolour('#2'+'There is a '+'#1'+'MAX'+'#2'+' of '+'#1'+
            conv(MAX_ITEMS)+'#2'+' names you can add',12);

            writecolour('#2'+'Press the '+'#1'+'SPACEBAR'+'#2'+
               ' to continue',22);

            sound(180);
            delay(300);
            nosound;

            repeat
               pause(ch);
            until ch = SPACEBAR;
            exit;
         end;

         for i := 1 to listcount do
         begin
            if namelist[i].name = tmpstr then
            begin
               clear;
               writecolour('#2'+'There''s already a '+'#1'+
               tmpstr+'#2'+' in the list',12);

               writecolour('#2'+'Press the '+'#1'+'SPACEBAR'+'#2'+
               ' to continue',22);

               sound(180);
               delay(300);
               nosound;

               repeat
                  pause(ch);
               until ch = SPACEBAR;

               clear;
               ok := false;
               break;
            end else
               ok := true;
         end;

         if ok then
         begin
            inc(listcount);
            namelist[listcount].name := tmpstr;

            ok := false;
            repeat
               writexy('Type In Any Comments',13,c2);
               readxy(tmpstr,14,c1,MAX_COMMENTS);

               storei := 0;  { code to avoid spaces at the start of string }
               for i := 1 to length(tmpstr) do
                  if tmpstr[i] in [#33..#126] then
                  begin
                     storei := i;
                     gotoxy(1,14);
                     clreol;
                     break;
                  end;

               if tmpstr = EMPTY then
                  ok := true;
            until (storei = 1) or (ok);

            namelist[listcount].comments := convert_to_lowercase(tmpstr);
            save_to_disk(listCount,titles,namelist);
         end;
      end;
   until quit = true;
end;


function find_max_pages(max_names,number : integer):integer;

begin
   if max_names < number then
      find_max_pages := 1
   else
      find_max_pages := round((max_names-1) div number)+1;
end;


procedure display_matches(var namelist : namelistType;
                                titles : titlesType;
                            storeMatch : storeMatchType;
                            matchCount : integer;
                               tmpname : string;
                              errormsg : boolean);

var
   tmpnum,pages : integer;
   row,row1     : integer;
   tmprow,i     : integer;
   max_pages    : integer;
   quit         : boolean;
   ch           : char;

begin
   clear;
   if matchCount = 0 then
   begin
      writexy('There is no matches',12,c2);
      pause(ch);
      exit;
   end;

   if matchCount >= 10 then
      tmpnum := 10
   else
      tmpnum := matchCount;

   quit := false;
   pages := 1;
   max_pages := find_max_pages(matchCount,10);
   row1 := 13-((5+tmpnum) div 2)+1;
   row := row1+5;  { row is where the names start }
   tmprow := row;

   writexy(conv(matchCount)+SKIP+titles.subjectName+'(s)'+' FOUND',row1,c1);
   writexy(tmpname,row1+1,c3);

   writeto('No.',22,row1+3,c1);
   writeto('Name',29,row1+3,c1);
   writeto('Comments',53,row1+3,c1);

   textcolor(c3);

   draw_underline(22,row1+4,3);
   draw_underline(29,row1+4,4);
   draw_underline(53,row1+4,8);

   for i := 1 to matchCount do
      with namelist[storeMatch[i]] do
      begin
         writeto(conv(storeMatch[i]),22,row,c1);
         writeto(name,29,row,c2);
         writeto(comments,53,row,c4);

         inc(row);
         if row = tmprow+10 then
         begin
            pause(ch);
            if (ch = ESCAPE_KEY) or (i = matchCount) then
            begin
               quit := true;
               break;
            end;
            clrwin(22,tmprow,60,21);
            inc(pages);
            row := tmprow;
         end;
         writexy('Page '+conv(pages)+' of '+conv(max_pages),25,c1);
         if errormsg then
            writecolour('#2'+'There''s '+'#1'+'MORE'+'#2'+
            ' matches but the limit is '+'#1'+conv(MAX_MATCHES),23);
         if quit then
            break;
      end;
   if row <> tmprow+10 then { less than 10 names }
      pause(ch);
end;


procedure find_website(var namelist : namelistType;
                          listcount : integer;
                             titles : titlesType;
                            options : optionsType;
                         storeMatch : storeMatchType);

var
   tmpstr,tmpname : string;
   i,m,store      : integer;
   tmprec         : namelistType;
   namelen        : integer;
   commentslen    : integer;
   len,column     : integer;
   wildcards,ok   : boolean;
   matchCount     : integer;
   charCount      : integer;
   types          : integer;
   errormsg       : boolean;
   ch             : char;

begin
   clear;
   if listcount = 0 then
   begin
      writexy('There''s No '+titles.subjectName+'(s) In The List',12,c2);
      pause(ch);
      exit;
   end;

   ok := false;
   tmpstr := EMPTY;
   errormsg := false;

   with options do
      if sortNo <> 1 then
      begin
         tmprec := namelist;
         sort_list(namelist,listcount);
      end;

   writexy('Wildcards Help',19,c3);
   writexy('Examples. day*  *disc  *game*',21,c1);

   writexy('Press RETURN to exit',11,c3);
   writexy('Type '+titles.subjectName+' to search for',12,c2);
   readxy(tmpstr,13,c1,MAX_NAME);

   tmpstr := convert_to_lowercase(tmpstr);
   len := length(tmpstr);

         { day*   *disc   *game* }
   { types   1      2        3     }

   types := 0;
   for i := 1 to len do
      if tmpstr[i] = '*' then
      begin
         tmpname := tmpstr;
         wildcards := true;
         if i <> 1 then { check to see if star is not the first char }
         begin
            delete(tmpstr,len,1);
            if types <> 3 then
               types := 1
            else
               delete(tmpstr,1,1);
            break;
         end
         else
         begin { i = 1 }
            if tmpstr[len] <> '*' then { if there's no star at the end }
            begin
               types := 2;
               delete(tmpstr,1,1);
               break;
            end
            else
               types := 3;
         end
      end
      else
         wildcards := false;

              {**** change this ****}
   if (tmpstr <> '') and (tmpstr <> ' ')
     and (tmpstr <> '  ') and (tmpstr <> '   ') then
      if wildcards then
      begin
         matchCount := 0;
         case types of
            1 :
            begin
               for i := 1 to listcount do
               begin
                  if matchCount >= MAX_MATCHES then
                  begin
                     errormsg := true;
                     break;
                  end;

                  charCount := 0;
                  for m := 1 to len-1 do
                     if namelist[i].name[m] = tmpstr[m] then
                        inc(charCount);

                  if charCount = len-1 then
                  begin
                     inc(matchCount); { matchCount is the no. of matches }
                     storeMatch[matchCount] := i; { stores every match }
                  end;
               end;
            end;
            3 :
            begin
               for i := 1 to listcount do
               begin
                  if matchCount >= MAX_MATCHES then
                  begin
                     errormsg := true;
                     break;
                  end;
                  if pos(tmpstr,namelist[i].name) <> 0 then
                  begin
                     inc(matchCount); { matchCount is the no. of matches }
                     storeMatch[matchCount] := i; { stores every match }
                  end;
               end;
            end;
         end;
         display_matches(namelist,titles,storeMatch,matchCount,tmpname,errormsg);
      end else
      begin
         for i := 1 to listcount do
         begin
            if namelist[i].name = tmpstr then
            begin
               ok := true;
               store := i;
               break;
            end else
               ok := false;
         end;

         clear;
         if ok then
         begin
            writecolour('#1'+'Found '+'#2'+'('+'#1'+conv(store)+
            '#2'+')',12);

            with namelist[store] do
            begin
               {code to centre the name and comments text}

               namelen := length(name)+13;
               commentslen := length(comments)+13;

               if namelen > commentslen then
                  len := namelen
               else
                  len := commentslen;

               column := return_column(len);

               {display results}

               writeto('Name      :  ',column,14,c2);
               writeto(name,column+13,14,c1);
               writeto('Comments  :  ',column,15,c2);

               textcolor(c1);

               if comments = EMPTY then
                  write('N/A')
               else
                  write(comments);
            end;
            pause(ch);
         end
         else
         begin
            writexy(tmpstr,12,c2);
            writexy('Not Found',14,c1);
            pause(ch);
         end;
      end;
   if options.sortNo <> 1 then
      namelist := tmprec;
end;


procedure view_list(var namelist : namelistType;
                       listcount : integer;
                          titles : titlesType;
                         options : optionsType);

var
   count,i,m,num   : integer;
   column,row,page : integer;
   max_pages       : integer;
   quit            : boolean;
   tmprec          : nameListType;
   ch              : char;

begin
   quit := false;
   if listcount = 0 then
   begin
      clear;
      writexy('There''s No '+titles.subjectName+'(s) In The List',12,c2);
      pause(ch);
      exit;
   end;

   with options do
      if sortNo <> 1 then
      begin
         tmprec := namelist;
         sort_list(namelist,listcount);
      end;

   if options.viewNo = 1 then
   begin    { display list }
      clear;
      page := 1;
      max_pages := find_max_pages(listcount,66);
      column := 1; num := 0;
      row := 2; count := 1;
      for i := 1 to listcount do
      begin
         textcolor(c1);
         gotoxy(column,row);
         write(count:4);
         textcolor(c2);
         gotoxy(column+5,row);
         write(namelist[count].name);
         inc(row); inc(count);
         inc(num);

         if row = 24 then
         begin
            row := 2;
            inc(column,27);
         end;
         if num = 66 then
         begin
            pause(ch);
            if (ch = ESCAPE_KEY) or (i = listcount) then
            begin
               quit := true;
               break;
            end;
            clear;
            textcolor(c2);
            num := 0; row := 2;
            column := 1;
            inc(page);
         end;
         writecolour('#1'+'Page '+conv(page)+' of '+conv(max_pages)+'#2'+
                    ' ('+'#1'+sort_types[options.sortNo]+'#2'+')',25);
         if quit then
            break;
      end;
      if num <> 66 then
         pause(ch);
   end else
   begin    { display details }
      clear;
      for m := 3 to 23 do
         writeto(VERTICAL_LINE,40,m,c3);
      max_pages := find_max_pages(listcount,42);
      page := 1; num := 0;
      row := 3; column := 1;
      for i := 1 to listcount do
      begin
         writeto('NAME',column+5+2,1,c1);
         writeto('COMMENT',column+27,1,c1);

         textcolor(c3);

         draw_underline(column+5+2,2,4);
         draw_underline(column+27,2,7);

         gotoxy(column,row);
         textcolor(c1);
         write(i:4);
         gotoxy(column+5,row);
         textcolor(c2);
         write(namelist[i].name);
         gotoxy(column+27,row);
         textcolor(c4);
         write(namelist[i].comments);
         writecolour('#1'+'Page '+conv(page)+' of '+conv(max_pages)+'#2'+
                    ' ('+'#1'+sort_types[options.sortNo]+'#2'+')',25);
         inc(num);
         inc(row);
         if row = 24 then
         begin
            inc(column,40);
            row := 3;
         end;
         if num = 42 then
         begin
            pause(ch);
            if (ch = ESCAPE_KEY) or (i = listcount) then
            begin
               quit := true;
               break;
            end;
            row := 3;
            column := 1;
            inc(page);
            num := 0;
            clrwin(1,1,39,25);
            clrwin(41,1,80,25);
         end;   { gets rid some of the flickering }
         if quit then
            break;
      end;
      if num <> 42 then
         pause(ch);
   end;
   if options.sortNo <> 1 then
      namelist := tmprec;
end;


procedure calculate_duplicates(var namelist : namelistType;
                                  listcount : integer;
                                     titles : titlesType);

var
   start,i,m   : integer;
   count,row   : integer;
   ok,setpause : boolean;
   tmprec      : namelistType;
   store       : array[1..REPEATED_NAMES] of integer;
   storeStr    : array[1..REPEATED_NAMES] of string[MAX_NAME];
   max,len     : integer;
   column      : integer;
   errormsg    : boolean;
   ch          : char;

begin
   tmprec := namelist;
   for i := 1 to REPEATED_NAMES do
   begin
      store[i] := 0;        { stores the amount of times repeated }
      storeStr[i] := EMPTY; { stores repeated strings             }
   end;
   clear;
   errormsg := false;
   count := 1; ok := false;
   setpause := false; start := 2;
   for i := 1 to listcount do
   begin
      for m := start to listcount do
      begin
         if namelist[i].name = namelist[m].name then
         begin
            if count > REPEATED_NAMES then
            begin
               errormsg := true;
               dec(count);
               break;
            end;
            namelist[m].name := EMPTY;
            inc(store[count]);
            setpause := true;
            ok := true;
         end;
      end;
      if errormsg then
         break;
      if ok then
      begin
         storeStr[count] := namelist[i].name;
         inc(count);
         ok := false;
      end;
      inc(start);
   end;

   if setpause then
   begin
      max := 1;
      for i := 1 to count do
      begin
         len := length(storeStr[i]);
         if len > max then
            max := len;
      end;

      row := 14;
      column := 40-(max div 2)-2;

      writecolour('#2'+'There are names in '+'#1'+titles.fileName+'#2'+
      ' which are repeated',11);

      for i := 1 to count do
      if storeStr[i] <> EMPTY then
      begin
         gotoxy(column,row);
         textcolor(c2); write(storeStr[i]);
         gotoxy(column+2+max,row);
         textcolor(c1); write('(');
         textcolor(c2); write(conv(store[i]+1));
         textcolor(c1); write(')');
         inc(row);
      end;

      if errormsg then
         writecolour('#2'+'There''s '+'#1'+'MORE'+'#2'+' than '+'#1'+
                    conv(REPEATED_NAMES)+'#2'+' repeated names',21);

      writecolour('#2'+'Press the '+'#1'+'SPACEBAR'+'#2'+' to continue',24);

      repeat
         pause(ch);
      until ch = SPACEBAR;
   end;
   namelist := tmprec;
end;


function file_exists(filename : string) : boolean;

var
   tmpfile : text;

begin
   file_exists := false;

   assign(tmpfile,filename);
   {$I-} reset(tmpfile); {$I+}

   if IOResult = 0 then
   begin
      file_exists := true;
      close(tmpfile);
   end;
end;


(*procedure select_path;

var
   ch        : char;
   ok        : boolean;
   i         : byte;
   filecount : byte;

begin
   ok := false;
   repeat
      clear;
      writexy('Please enter path',12,c2);
      readxy(path,13,c1,MAX_PATH);

      if path = EMPTY then { Pressing RETURN uses the default path }
         path := 'c:\mydocu~1\pascal\winbase\'
      else
         path := path+'\';

      if path = 'x' then
      begin
         textcolor(lightgray);
         clrscr;
         halt;
      end;

      filecount := 0;
      for i := 1 to Files do
         if file_exists(path+Fname[i]) then
            inc(filecount);

      case filecount of
         0  :
         begin
            writexy('WinBase files don''t exist in this directory',19,4);
            writexy('Press ''x'' to quit',20,6);
         end;
         1..Files-1 :
         begin
            writexy('One of the files must be missing or corrupt',19,4);
            writexy('You probably have to re-install WinBase',20,6);
         end;
         Files : ok := true;
      end;

      if filecount <> Files then
         pause(ch);
   until ok;
   clear;
end;*)


procedure load_list(var namelist : namelistType;
                   var listcount : integer;
                   var titlesArr : titlesArrType;
                     var options : optionsType;
                      var titles : titlesType);

var
   F      : text;
   tmpstr : string;

begin
   if saveSubjectNo = options.subjectNo then {loads the imported file}
   begin
      titles := titlesArr[options.subjectNo];
      set_file(F,'reset',paramstr(1));
   end
   else
   begin
      titles := titlesArr[options.subjectNo];
      set_file(F,'reset',path+titles.fileName); {loads dat file}
   end;

   listCount := 0;

   while not eof(F) do
   begin
      inc(listCount);

      readln(F,tmpstr);
      namelist[listCount].name := convert_to_lowercase(tmpstr);

      readln(F,tmpstr);
      namelist[listCount].comments := convert_to_lowercase(tmpstr);
   end;

   set_file(F,'close',EMPTY);
end;


procedure options_menu(var options : optionsType;
                         titlesArr : titlesArrType);

var
   colour : array[1..4] of integer;
   i,row  : integer;
   ch     : char;

begin
   clear;
   row := 18;
   with options do
   repeat
      writexy('Options Menu',7,c1);

      writeto('Filename',30,11,c2);
      writeto('Sort List',30,13,c2);
      writeto('View',30,15,c2);

      for i := 1 to 4 do
         colour[i] := c2;

      case row of
         11 : colour[1] := c1;
         13 : colour[2] := c1;
         15 : colour[3] := c1;
         18 : colour[4] := c1;
      end;

      clrwin(48,11,70,19);

      writeto(titlesArr[subjectNo].fileName,45,11,colour[1]);
      writeto(sort_types[sortNo],45,13,colour[2]);
      writeto(view_types[viewNo],45,15,colour[3]);

      writexy('Continue',18,colour[4]);

      pause(ch);
      case ch of
         LEFT_ARROW :
            case row of
               11 : dec(subjectNo);
               13 : dec(sortNo);
               15 : dec(viewNo);
            end;
         RIGHT_ARROW :
            case row of
               11 : inc(subjectNo);
               13 : inc(sortNo);
               15 : inc(viewNo);
            end;
         UP_ARROW :
            begin
               if row <= 15 then
                  dec(row,2)
               else
               if row >= 18 then
                  dec(row,3)
            end;
         DOWN_ARROW :
            begin
               if row <= 13 then
                  inc(row,2)
               else
               if row >= 15 then
                  inc(row,3);
            end;
      end;

      limits(row,11,18);
      limits(subjectNo,1,Files);
      limits(sortNo,1,2);
      limits(viewNo,1,2);

   until (row = 18) and (ch = RETURN_KEY);
end;


procedure load_text_files
     (var namelist : namelistType;
       var options : optionsType;
     var listcount : integer;
        var titles : titlesType;
     var titlesArr : titlesArrType);

var
   namesT : text;

   P : PathStr;
   D : DirStr;
   N : NameStr;
   E : ExtStr;

begin
   set_file(namesT,'reset',path+'names.dat'); {load .dat filenames}

   Files := 1;
   repeat
      with titlesArr[Files] do
      begin
         readln(namesT,fileName);
         readln(namesT,subjectName);
         readln(namesT);
         inc(Files);
      end;
   until eof(namesT);
   dec(Files); {because of the loop i have to takeaway one}

   set_file(namesT,'close',EMPTY);

   if paramstr(1) <> '' then
   begin
      P := paramstr(1); {removes path address. used for when showing the filename}
      Fsplit(P,D,N,E);

      inc(Files);
      options.subjectNo := Files;
      saveSubjectNo := FILES;
      with titlesArr[Files] do
      begin
         fileName := N+E;
         subjectName := 'Data';
      end;
   end;

   load_list(namelist,listcount,titlesArr,options,titles);
   {calculate_duplicates(namelist,listcount,titles);}

   {for i := 1 to Files+1 do
   begin
      with options do
      if i = Files+1 then
         subjectNo := 1
      else
         subjectNo := i;
      choose_titles(titles,options);
      load_list(namelist,listcount,titles);
      if i <> Files+1 then
         calculate_duplicates(namelist,listcount,titles);
   end;}
end;


procedure edit;

var
   ch : char;

begin
   clear;
   writexy('Presently Not Available',12,c2);
   pause(ch);
   clear;
end;


procedure find_path;

var
   T    : file of DataRecord; {for setup assoc}
   data : DataRecord;

begin
   if paramstr(1) <> '' then
   begin
      assign(T,'c:\windows\Batcomp.ini');
      {$I-} reset(T); {$I+}

      if IOresult = 0 then { file exists }
      begin
         read(T,data);
         path := data.path+'\winbase\';
         close(T);
      end else
      begin
         clrscr;
         halt;
      end;
   end
   else
   begin
   {  select_path;}
      GetDir(0,path); { 0 = Current drive }

      if file_exists(path+'\winbase\nul') then
         path := path+'\winbase\'
      else
         path := path + '\';
   end;
end;


procedure new_list(var titles : titlesType;
                var titlesArr : titlesArrType;
                  var options : optionsType);

var
   tmp    : string{[8]};
   namesF : text;
   dataF  : text;
   ch     : char;

begin
   clear;
   if Files = MAXFILE then
   begin
      writexy('Only 10 text files can be made',12,c2);
      writexy('Press any key',14,c1);
      pause(ch);
      dec(Files);
      exit;
   end;

   inc(Files);
   with titlesArr[Files] do
   begin
      writexy('Please type filename of new list',12,c2);
      writexy('Press RETURN to exit',19,c3);
      readxy(tmp,13,c1,8);

      if tmp = '' then
      begin
         dec(Files);
         exit;
      end;

      fileName := tmp+'.wbe';

      writexy('Please type subject of new list',15,c2);
      readxy(tmp,16,c1,8);

      if tmp = '' then {defualt subject}
         tmp := 'Data';

      subjectName := tmp;

      {makes new wbe file}

      set_file(dataF,'rewrite',path+fileName);
      set_file(dataF,'close',EMPTY);

      {writes new filename to names.dat}

      set_file(namesF,'append',path+'names.dat');

      writeln(namesF);
      writeln(namesF,FileName);
      writeln(namesF,subjectName);

      set_file(namesF,'close',EMPTY);
   end;

   options.subjectNo := Files;
   titles := titlesArr[Files];
end;


    {*  start of main program  *}


var
   listcount  : integer;
   row,option : integer;
   exit       : boolean;
   namelist   : namelistType;
   titles     : titlesType;
   options    : optionsType;
   storeMatch : storeMatchType;
   titlesArr  : titlesArrType;

begin
   textmode(80);
{   randomize;}

   initialise(options,row);
   find_path;

   load_text_files(namelist,options,listcount,titles,titlesArr);

   repeat
      option := main_menu(row,titles);
      case option of
         1 : add_to_list(namelist,listcount,titles);
         2 : find_website(namelist,listcount,titles,options,storeMatch);
         3 : view_list(namelist,listcount,titles,options);
         4 :
         begin
            new_list(titles,titlesArr,options);
            load_list(namelist,listcount,titlesArr,options,titles);
         end;
         5 :
         begin
            options_menu(options,titlesArr);
            load_list(namelist,listcount,titlesArr,options,titles);
         end;
         6 : exit := true;
      end;
   until exit;
   textcolor(lightgray);
   clrscr;
end.


    {*  end of main program  *}