program print_near_letter_quality;
{
  Written for Turbo Pascal V3.00 for CP/M-80 and designed to
  be run as a COM file.  To run in memory mode, make the changes
  as commented for running with Turbo version 2.  Uses printer
  codes for Star Micronics Delta 10 printer but can be modified
  for use with other bit mode graphics printers.
}

type
  pass = array [0..11] of byte; { dot columns for 1 pass of 1 char }

  chardesc = record             { file storage of char dot data }
    ch : char;
    pass1 : pass;
    pass2 : pass;
  end;

  passes = record               { array element for memory dot patterns }
    pass1 : pass;
    pass2 : pass;
  end;

  anystr = string[255];

var
  descfile : file of chardesc;  { dot pattern file }
  infile : text;                { text to print }
  infilename : string[16];      { text file name }
  inpdesc : chardesc;           { temporary for reading dot data file }
  passdat : array[' '..'~'] of passes;  { memory dot patterns }
  line : anystr;                { text line to be printed }



PROCEDURE printnlq(s:anystr);

{ This PROCEDURE prints each line of input text as two passes of
  graphics dot patterns with a half dot line feed between each. }

var
  i : integer;


PROCEDURE prefix(nchars:integer);

{ Send graphics mode command string to printer.  For Delta 10
  <ESC> 'L' selects 120 DPI then the two binary bytes that are
  the total number of dot columns to be printed, low byte first }

begin
  nchars := nchars * 12;   { 12 half dot columns / char }
  write(lst,^[,'L',chr(lo(nchars)),chr(hi(nchars)));
end;


PROCEDURE printpass(p:pass);

{ Send data for one pass of one character to the printer.  The
  calling routine has done the table lookup and passes the
  data as a parameter }

var i : integer;
begin
  for i := 0 to 11 do write(lst,chr(p[i]));
end;



PROCEDURE halfdotlf;

{ Tell printer to advance paper 1/144 ".  For Delta 10 the
  command string is <ESC> 'J' followed by the binary # of
  144ths to advance }

begin
  write(lst,^[,'J',^a);
end;



begin                     { PROCEDURE printnlq }

  if length(s) > 0 then   { anything to print? }
  begin
    s := copy(s,1,80);    { not real fancy, truncate at max allowed chars }

    for i := 1 to length(s) do  { remove all char codes for which no patterns}
      if not(s[i] in [' '..'~']) then s[i] := ' ';

    halfdotlf;            { vertical registration is better if you do this }
    prefix(length(s));    { 120 DPI graphics mode command }
                          { now print the first pass of dots }
    for i := 1 to length(s) do printpass(passdat[s[i]].pass1);
    halfdotlf;            { advance paper for second pass }

    prefix(length(s));    { print the second pass of dots }
    for i := 1 to length(s) do printpass(passdat[s[i]].pass2);

    write(lst,^[,'J',chr(22)); { finally, do 11 half dot line feed
                                 to prepare for next line }
  end

  else writeln(lst);      { null string, just do line feed }

end;                      { PROCEDURE printnlq }



begin     { Main program }

{ PARAMCOUNT and PARAMSTR are features of Turbo V3.  If you are using
  version 2, comment out the following 5 lines and use the marked code
  instead }

  if paramcount < 1 then
  begin
    writeln('No text file!',^G);
    halt;
  end;

{ ******* Use these lines for version 2 **********
  write('Text file: ');
  readln(infilename);
                         }

{ At this point you could prompt for alternate font file
  or pull an alternate font filename from the command line.
  There should probably be a check for font file present here. }

  assign(descfile, 'ascii2.nlq');
  reset(descfile);

  repeat       { Read dot patterns from font file, store in data array }
    read(descfile,inpdesc);
    passdat[inpdesc.ch].pass1 := inpdesc.pass1;
    passdat[inpdesc.ch].pass2 := inpdesc.pass2;
  until eof(descfile);
  close(descfile);

  {$i- turn off I/O checking so don't get runtime error if no text file}

  infilename := paramstr(1);  { comment out this line for version 2 }

  assign(infile,infilename);  { try to open input file }
  reset(infile);

  if ioresult <> 0 then       { if file open unsuccessful, scream }
  begin
    writeln('Input file empty!',^G);
    halt;
  end;

  {$i+ turn I/O checking back on }

  repeat                     { read and print each line from input file }
    readln(infile,line);
    printnlq(line);
  until eof(infile);
end.