function upcasestr(s:str80):str80;
var
  p:integer;

begin
  for p:= 1 to length(s) do
    s[p] := upcase(s[p]);
  upcasestr:=s;
end;

{ conststr returns a string with n characters of value c }
function conststr(c:char; n:integer):str80;
var
  s:str80;

begin
  if n<0 then n:=0;
  s[0]:=chr(n);
  fillchar(s[1],n,c);
  conststr:=s;
end;

{beep sounds the terminal bell or beeper}
procedure beep;
begin
  write(^G);
end;

procedure inputstr(var  s        :anystr;
                        l,x,y    :integer;
                        term     :charset;
                   var  tc       :char);

const underscore = '_';

var p : integer;
    ch: char;

begin
  gotoxy(x+1, y+1);write(s,conststr(underscore,l-length(s)));
  p:=0;
  repeat
    gotoxy(x+p+1,y+1);read(kbd,ch);
    case ch of
     #32..#126   : if p<l then begin
                     if length(s) = l then delete(s,l,1);
                     p:= p+1;
                     insert(ch,s,p);
                     write(copy(s,p,l));
                   end
                   else beep;

            ^S   : if p> 0 then p := p +1 else beep;

            ^D   : if p< length(s) then p := p + 1 else beep;

            ^A   : p := 0;

            ^F   : p := length(s);

            ^G   : if p < length(s) then begin
                     delete(s,p+1,1);
                     write(copy(s,p+1,l),underscore);
                   end;

       ^H,#127   : if p > 0 then begin
                     delete(s,p,1);
                     write(^H,copy(s,p,l),underscore);
                     p := p - 1;
                   end else beep;

            ^Y   : begin
                     write(conststr(underscore,length(s)-p));
                     delete(s,p+1,l);
                   end;

    else
      if not(ch in term) then beep;
    end; {case}
  until ch in term;
  p := length(s);
  gotoxy(x+p+1,y+1);
  write('':l-p);
  tc := ch;
end;

procedure select(    prompt : str80;
                     term   : charset;
                 var tc     : char);

var ch : char;

begin
  gotoxy(1,23); write(prompt,'?');clreol;
  repeat
    read(kbd,ch);
    tc:=upcase(ch);
    if not (tc in term) then beep;
  until tc in term;
  write(ch);
end;

{clearframe clears the display frame, lines 3 to 20 }

procedure clearframe;
var i : integer;

begin
 for i := 3 to 20 do
   begin
     gotoxy(1,i+1);clreol;
   end;
end;

{outform displays the entry form on the screen }

procedure outform;
begin
  gotoxy( 7, 5);write('Code:');
  gotoxy(29, 5);write('Date:');
  gotoxy( 1, 7);write('First Name:');
  gotoxy(29, 7);write('Last Name:');
  gotoxy( 4, 9);write('Company:');
  gotoxy( 2,10);write('Address 1 :');
  gotoxy( 2,11);write('Address 2 :');
  gotoxy( 6,13);write('Phone:');
  gotoxy(29,13);write('Extension:');
  gotoxy( 2,15);write('Remarks 1 :');
  gotoxy( 2,16);write('Remarks 2 :');
  gotoxy( 2,17);write('Remarks 3 :');
end;

{clearform clears all fields in the entry form}

procedure clearform;
begin
  gotoxy(13, 5);write('':15);
  gotoxy(35, 5);clreol;
  gotoxy(13, 7);write('':15);
  gotoxy(40, 7);clreol;
  gotoxy(13, 9);clreol;
  gotoxy(13,10);clreol;
  gotoxy(13,11);clreol;
  gotoxy(13,13);write('':15);
  gotoxy(40,13);clreol;
  gotoxy(13,15);clreol;
  gotoxy(13,16);clreol;
  gotoxy(13,17);clreol;
end;

procedure inputcust(var cust:custrec);
const term:charset = [^E,^I,^M,^X,^Z];

var l:integer; tc:char;

begin
  l := 1;
  with cust do repeat
    case l of
      1: inputstr(custcode   ,15,12, 4,term,tc);
      2: inputstr(entrydate  , 8,34, 4,term,tc);
      3: inputstr(firstname  ,15,12, 6,term,tc);
      4: inputstr(lastname   ,30,39, 6,term,tc);
      5: inputstr(company    ,40,12, 8,term,tc);
      6: inputstr(addr1      ,30,12, 9,term,tc);
      7: inputstr(addr2      ,30,12,10,term,tc);
      8: inputstr(phone      ,15,12,12,term,tc);
      9: inputstr(phoneext   , 5,39,12,term,tc);
     10: inputstr(remarks1   ,40,12,14,term,tc);
     11: inputstr(remarks2   ,40,12,15,term,tc);
     12: inputstr(remarks3   ,40,12,16,term,tc);
    end;
    if tc in [^I,^M,^X]
      then if l = 12 then l := 1 else l:= l + 1
      else if tc = ^E then if l = 1 then l := 12 else l := l+1;
  until (tc = ^M) and (l = 1) or (tc = ^X);
end;

{outcust displays the customer data contained in cust }

procedure outcust(var cust:custrec);
begin
  with cust do begin
    gotoxy(13, 5);write(custcode ,'':15-length(custcode ));
    gotoxy(35, 5);write(entrydate  );clreol;
    gotoxy(13, 7);write(firstname,'':15-length(firstname));
    gotoxy(40, 7);write(lastname   );clreol;
    gotoxy(13, 9);write(company    );clreol;
    gotoxy(13,10);write(addr1      );clreol;
    gotoxy(13,11);write(addr2      );clreol;
    gotoxy(13,13);write(phone    ,'':15-length(phone    ));
    gotoxy(40,13);write(phoneext   );clreol;
    gotoxy(13,15);write(remarks1   );clreol;
    gotoxy(13,16);write(remarks2   );clreol;
    gotoxy(13,17);write(remarks3   );clreol;
  end;
end;

function keyfromname(lastnm:str15; firstnm:str10):str25;
const blanks = '          ';

begin
  keyfromname := upcasestr(lastnm)+
                 copy(blanks,1,15-length(lastnm))+
                 upcasestr(firstnm);
end;

{ update is used to update the database }

procedure update;
var ch : char;

procedure add;
var
  dataf : integer;
  ccode : str15;
  keyn  : str25;
  cust  : custrec;

begin
  with cust do begin
    fillchar(cust,sizeof(cust),0);
    repeat
      inputcust(cust);
      ccode:=custcode;
      findkey(codeindexfile,dataf,ccode);
      if ok then begin
        gotoxy(6,19);
        write('ERROR : duplicate customer code');
        beep;
      end;
    until not ok;
    addrec(datf,dataf,cust);
    addkey(codeindexfile,dataf,custcode);
    keyn := keyfromname(lastname,firstname);
    addkey(nameindexfile,dataf,keyn);
    gotoxy(6,19);clreol;
  end;
end;

{find is used to find, edit, and delete customers }

procedure find;
var
  d,l,i               : integer;
  ch,tc               : char;
  ccode,pcode,firstnm : str15;
  keyn,pnm            : str25;
  lastnm              : str30;
  cust                : custrec;

begin
  if usedrecs(datf) > 0 then begin
    ccode := '';
    repeat
      inputstr(ccode,15,12,4,[^M,^Z],tc);
      if ccode <> '' then begin
        findkey(codeindexfile,d,ccode);
        if ok
          then begin getrec(datf,d,cust); outcust(cust) end
          else begin
                 gotoxy(6,19);
                 write('ERROR: Customer Code not found');
                 beep;
               end;
      end;
    until ok or (ccode = '');
    gotoxy(6,19);clreol;
    if ccode = '' then begin
      l := 1; firstnm := ''; lastnm := '';
      repeat
        case l of
          1:inputstr(firstnm,15,12,6,[^I,^M,^Z],tc);
          2:inputstr(lastnm,30,39,6,[^I,^M,^Z],tc);
        end;
        if tc in [^I,^M] then l := 3-l;
      until (tc = ^M) and (l = 1) or (tc = ^Z);
      keyn := keyfromname(lastnm,firstnm);
      searchkey(nameindexfile,d,keyn);
      if not ok then prevkey(nameindexfile,d,keyn);
      repeat
        getrec(datf,d,cust);
        outcust(cust);
        select('Find: [N]ext, [P]revious, [Q]uit',['N','P','Q'],ch);
        case ch of
         'N' : repeat nextkey(nameindexfile,d,keyn) until ok;
         'P' : repeat prevkey(nameindexfile,d,keyn) until ok;
        end;
      until ch = 'Q';
    end;
    select('Find: [E]dit, [D]elete, [Q]uit',['E','D','Q'],ch);
    with cust do
      case ch of
        'E' : begin
                pcode := custcode;
                pnm := keyfromname(lastname,firstname);
                repeat
                  inputcust(cust);
                  if custcode = pcode then ok:=false
                  else begin
                    ccode := custcode;
                    findkey(codeindexfile,i,ccode);
                    if ok then beep;
                  end;
                until not ok;
                putrec(datf,d,cust);
                if custcode <> pcode then begin
                  deletekey(codeindexfile,d,pcode);
                  addkey(codeindexfile,d,custcode);
                end;
                keyn := keyfromname(lastname,firstname);
                if keyn <> pnm then begin
                  deletekey(nameindexfile,d,pnm);
                  addkey(nameindexfile,d,keyn);
                end;
              end;

        'D' : begin
                deletekey(codeindexfile,d,custcode);
                keyn:=keyfromname(lastname,firstname);
                deletekey(nameindexfile,d,keyn);
                deleterec(datf,d);
              end;
      end;
  end { of usedrecs(datf) > 0 }
  else beep;
end; {find}

begin {update}
  outform;
  repeat
    select('Update: [A]dd, [F]ind, [Q]uit',['A','F','Q'],ch);
    case ch of
      'A' : add;
      'F' : find;
    end;
    if ch <> 'Q' then begin
      gotoxy(60,2); write(usedrecs(datf):5);
      clearform;
    end;
  until ch = 'Q'
end;

{list is used to list customers}

procedure list;
label escape;

var
  d,l,ld    : integer;
  ch,co,cs  : char;
  ccode     : str15;
  keyn      : str25;
  name      : str35;
  cust      : custrec;

begin
  select('Output device: [P]rinter, [S]creen',['P','S'],co);
  select('Sort by: [C]ode, [N]ame, [U]nsorted',['C','N','U'],cs);
  gotoxy(1,23);Write('Press <ESC> to abort');clreol;
  clearkey(codeindexfile);
  clearkey(nameindexfile);
  d:=0;
  ld:=filelen(datf)-1;
  l:=3;
  repeat
    if keypressed then begin
      read(kbd,ch);
      if ch = #27 then goto escape;
    end;
    case cs of
      'C' : nextkey(codeindexfile,d,ccode);
      'N' : nextkey(nameindexfile,d,keyn);
      'U' : begin
              ok := false;
              while (d < ld) and not ok do begin
                d := d +1;
                getrec(datf,d,cust);
                ok := (cust.custstatus = 0);
              end;
            end;
    end;{case}
    if ok then with cust do begin
      if cs <> 'U' then getrec(datf,d,cust);
      name := lastname;
      if firstname <> '' then name := name + ',' + firstname;
      if co = 'P' then begin
        write(lst,custcode,'':16-length(custcode));
        write(lst,name,'':36-length(name));
        writeln(lst,copy(company,1,25));
      end
      else begin
        if l = 21 then begin
          gotoxy(1,23);
          write('Press <RETURN> to continue or <ESC> to abort');
          clreol;
          repeat
            read(kbd,ch);
          until ch in [^M,#27];
          if ch = #27 then goto escape;
          gotoxy(1,23);
          write('Press <ESC> to abort');
          clearframe;
          l:=3;
        end;
        gotoxy(1,l+1);write(custcode);
        gotoxy(17,l+1);write(name);
        gotoxy(53,l+1);write(copy(company,1,25));
        l := l + 1;
      end;{of else begin}
    end;{of with cust do begin}
  until not ok;
  if co = 'S' then begin
    gotoxy(1,23);write('Press <RETURN>');clreol;
    repeat read(kbd,ch) until ch = ^M;
  end;
  escape:
end;