program edit_nlq;

{ Edit an existing print font file.  Allows for random
  update of any character but all column data for that
  char must be stepped through. }

label 0;

const
  hex_digits : array[0..$f] of char =
               ('0','1','2','3','4','5','6','7',
                '8','9','A','B','C','D','E','F');
type
  pass = array [0..11] of byte;

  chardesc = record
    ch : char;
    pass1 : pass;
    pass2 : pass;
  end;

  str2 = string[2];

var
  i : integer;
  descfile : file of chardesc;
  ch2 : char;
  inpdesc : chardesc;
  fn : string[16];

function readhex (curr_value : byte) : byte;

{ Readhex first displays the current value in hex, then
  accepts up to 2 hex digits as input.  If a carriage return
  is entered without any other input, the current value is
  retained.  A leading zero is not necessary, i.e.  0F is the
  same as F<CR>.  Lower case is OK and invalid input is ignored. }

var
  inpstr : str2;
  ch : char;

begin

  inpstr := '';          { blank the input string }
                         { then display current value }
  write(hex_digits[(curr_value and $f0) shr 4],
        hex_digits[curr_value and $f],'  ');

  repeat                 { now accept input, looping til get 2 valid
                           hex digits, or <CR> }
    read(kbd,ch);
    ch := upcase(ch);
    if ch in['0'..'9','A'..'F'] then
    begin
      write(ch);
      inpstr := inpstr + ch;
    end;
  until (length(inpstr)=2) or (ch=^m);

  if length(inpstr) > 0 then  { if was valid input, return the new data }
  begin
    while length(inpstr) < 2 do inpstr := '0' + inpstr;
    if inpstr[1] > '9' then inpstr[1] := chr(ord(inpstr[1])-7);
    if inpstr[2] > '9' then inpstr[2] := chr(ord(inpstr[2])-7);
    readhex := (ord(inpstr[1])-$30)*16 + (ord(inpstr[2])-$30);
  end

  else readhex := curr_value;  { no valid input, return old data }
end;



begin

  writeln;
  write('Font file to edit: ');
  readln(fn);
  writeln;
  assign(descfile, fn);
  reset(descfile);
  with inpdesc do

  repeat
    write('Char: ');
    read(kbd,ch2);
    if not(ch2 in [' '..'~']) then goto 0  { any non printable char ends }
      else writeln(ch2);
    seek(descfile,ord(ch2)-ord(' ')); { get old data, stored with data
                                       for ' ' at record 0.  If you
                                       want to print ctl chars, change this. }
    read(descfile,inpdesc);
    seek(descfile,ord(ch2)-ord(' ')); { prepare to rewrite record }

    { now get 12 columns of dot patterns for pass 1 }
    for i := 0 to 11 do
    begin
      write('Pass1 ',i:2,'  ');
      pass1[i] := readhex(pass1[i]);
      writeln;
    end;
    writeln;

    { then get 12 columns of data for pass 2 }
    for i := 0 to 11 do
    begin
      write('Pass2 ',i:2,'  ');
      pass2[i] := readhex(pass2[i]);
      writeln;
    end;
    writeln;
    writeln;
    write(descfile,inpdesc);   { update record in file }
  until false;                 { do forever, or until get non printing char}

  0 : close(descfile);
end.