home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / nlq.lbr / EDITNLQ.PQS / EDITNLQ.PAS
Pascal/Delphi Source File  |  1986-10-30  |  3KB  |  118 lines
  1. program edit_nlq;
  2.  
  3. { Edit an existing print font file.  Allows for random
  4.   update of any character but all column data for that
  5.   char must be stepped through. }
  6.  
  7. label 0;
  8.  
  9. const
  10.   hex_digits : array[0..$f] of char =
  11.                ('0','1','2','3','4','5','6','7',
  12.                 '8','9','A','B','C','D','E','F');
  13. type
  14.   pass = array [0..11] of byte;
  15.  
  16.   chardesc = record
  17.     ch : char;
  18.     pass1 : pass;
  19.     pass2 : pass;
  20.   end;
  21.  
  22.   str2 = string[2];
  23.  
  24. var
  25.   i : integer;
  26.   descfile : file of chardesc;
  27.   ch2 : char;
  28.   inpdesc : chardesc;
  29.   fn : string[16];
  30.  
  31. function readhex (curr_value : byte) : byte;
  32.  
  33. { Readhex first displays the current value in hex, then
  34.   accepts up to 2 hex digits as input.  If a carriage return
  35.   is entered without any other input, the current value is
  36.   retained.  A leading zero is not necessary, i.e.  0F is the
  37.   same as F<CR>.  Lower case is OK and invalid input is ignored. }
  38.  
  39. var
  40.   inpstr : str2;
  41.   ch : char;
  42.  
  43. begin
  44.  
  45.   inpstr := '';          { blank the input string }
  46.                          { then display current value }
  47.   write(hex_digits[(curr_value and $f0) shr 4],
  48.         hex_digits[curr_value and $f],'  ');
  49.  
  50.   repeat                 { now accept input, looping til get 2 valid
  51.                            hex digits, or <CR> }
  52.     read(kbd,ch);
  53.     ch := upcase(ch);
  54.     if ch in['0'..'9','A'..'F'] then
  55.     begin
  56.       write(ch);
  57.       inpstr := inpstr + ch;
  58.     end;
  59.   until (length(inpstr)=2) or (ch=^m);
  60.  
  61.   if length(inpstr) > 0 then  { if was valid input, return the new data }
  62.   begin
  63.     while length(inpstr) < 2 do inpstr := '0' + inpstr;
  64.     if inpstr[1] > '9' then inpstr[1] := chr(ord(inpstr[1])-7);
  65.     if inpstr[2] > '9' then inpstr[2] := chr(ord(inpstr[2])-7);
  66.     readhex := (ord(inpstr[1])-$30)*16 + (ord(inpstr[2])-$30);
  67.   end
  68.  
  69.   else readhex := curr_value;  { no valid input, return old data }
  70. end;
  71.  
  72.  
  73.  
  74. begin
  75.  
  76.   writeln;
  77.   write('Font file to edit: ');
  78.   readln(fn);
  79.   writeln;
  80.   assign(descfile, fn);
  81.   reset(descfile);
  82.   with inpdesc do
  83.  
  84.   repeat
  85.     write('Char: ');
  86.     read(kbd,ch2);
  87.     if not(ch2 in [' '..'~']) then goto 0  { any non printable char ends }
  88.       else writeln(ch2);
  89.     seek(descfile,ord(ch2)-ord(' ')); { get old data, stored with data
  90.                                        for ' ' at record 0.  If you
  91.                                        want to print ctl chars, change this. }
  92.     read(descfile,inpdesc);
  93.     seek(descfile,ord(ch2)-ord(' ')); { prepare to rewrite record }
  94.  
  95.     { now get 12 columns of dot patterns for pass 1 }
  96.     for i := 0 to 11 do
  97.     begin
  98.       write('Pass1 ',i:2,'  ');
  99.       pass1[i] := readhex(pass1[i]);
  100.       writeln;
  101.     end;
  102.     writeln;
  103.  
  104.     { then get 12 columns of data for pass 2 }
  105.     for i := 0 to 11 do
  106.     begin
  107.       write('Pass2 ',i:2,'  ');
  108.       pass2[i] := readhex(pass2[i]);
  109.       writeln;
  110.     end;
  111.     writeln;
  112.     writeln;
  113.     write(descfile,inpdesc);   { update record in file }
  114.   until false;                 { do forever, or until get non printing char}
  115.  
  116.   0 : close(descfile);
  117. end.
  118.