home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / nlq.lbr / PRNTNLQ.PQS / PRNTNLQ.PAS
Pascal/Delphi Source File  |  1986-10-30  |  5KB  |  161 lines
  1. program print_near_letter_quality;
  2. {
  3.   Written for Turbo Pascal V3.00 for CP/M-80 and designed to
  4.   be run as a COM file.  To run in memory mode, make the changes
  5.   as commented for running with Turbo version 2.  Uses printer
  6.   codes for Star Micronics Delta 10 printer but can be modified
  7.   for use with other bit mode graphics printers.
  8. }
  9.  
  10. type
  11.   pass = array [0..11] of byte; { dot columns for 1 pass of 1 char }
  12.  
  13.   chardesc = record             { file storage of char dot data }
  14.     ch : char;
  15.     pass1 : pass;
  16.     pass2 : pass;
  17.   end;
  18.  
  19.   passes = record               { array element for memory dot patterns }
  20.     pass1 : pass;
  21.     pass2 : pass;
  22.   end;
  23.  
  24.   anystr = string[255];
  25.  
  26. var
  27.   descfile : file of chardesc;  { dot pattern file }
  28.   infile : text;                { text to print }
  29.   infilename : string[16];      { text file name }
  30.   inpdesc : chardesc;           { temporary for reading dot data file }
  31.   passdat : array[' '..'~'] of passes;  { memory dot patterns }
  32.   line : anystr;                { text line to be printed }
  33.  
  34.  
  35.  
  36. PROCEDURE printnlq(s:anystr);
  37.  
  38. { This PROCEDURE prints each line of input text as two passes of
  39.   graphics dot patterns with a half dot line feed between each. }
  40.  
  41. var
  42.   i : integer;
  43.  
  44.  
  45. PROCEDURE prefix(nchars:integer);
  46.  
  47. { Send graphics mode command string to printer.  For Delta 10
  48.   <ESC> 'L' selects 120 DPI then the two binary bytes that are
  49.   the total number of dot columns to be printed, low byte first }
  50.  
  51. begin
  52.   nchars := nchars * 12;   { 12 half dot columns / char }
  53.   write(lst,^[,'L',chr(lo(nchars)),chr(hi(nchars)));
  54. end;
  55.  
  56.  
  57. PROCEDURE printpass(p:pass);
  58.  
  59. { Send data for one pass of one character to the printer.  The
  60.   calling routine has done the table lookup and passes the
  61.   data as a parameter }
  62.  
  63. var i : integer;
  64. begin
  65.   for i := 0 to 11 do write(lst,chr(p[i]));
  66. end;
  67.  
  68.  
  69.  
  70. PROCEDURE halfdotlf;
  71.  
  72. { Tell printer to advance paper 1/144 ".  For Delta 10 the
  73.   command string is <ESC> 'J' followed by the binary # of
  74.   144ths to advance }
  75.  
  76. begin
  77.   write(lst,^[,'J',^a);
  78. end;
  79.  
  80.  
  81.  
  82. begin                     { PROCEDURE printnlq }
  83.  
  84.   if length(s) > 0 then   { anything to print? }
  85.   begin
  86.     s := copy(s,1,80);    { not real fancy, truncate at max allowed chars }
  87.  
  88.     for i := 1 to length(s) do  { remove all char codes for which no patterns}
  89.       if not(s[i] in [' '..'~']) then s[i] := ' ';
  90.  
  91.     halfdotlf;            { vertical registration is better if you do this }
  92.     prefix(length(s));    { 120 DPI graphics mode command }
  93.                           { now print the first pass of dots }
  94.     for i := 1 to length(s) do printpass(passdat[s[i]].pass1);
  95.     halfdotlf;            { advance paper for second pass }
  96.  
  97.     prefix(length(s));    { print the second pass of dots }
  98.     for i := 1 to length(s) do printpass(passdat[s[i]].pass2);
  99.  
  100.     write(lst,^[,'J',chr(22)); { finally, do 11 half dot line feed
  101.                                  to prepare for next line }
  102.   end
  103.  
  104.   else writeln(lst);      { null string, just do line feed }
  105.  
  106. end;                      { PROCEDURE printnlq }
  107.  
  108.  
  109.  
  110. begin     { Main program }
  111.  
  112. { PARAMCOUNT and PARAMSTR are features of Turbo V3.  If you are using
  113.   version 2, comment out the following 5 lines and use the marked code
  114.   instead }
  115.  
  116.   if paramcount < 1 then
  117.   begin
  118.     writeln('No text file!',^G);
  119.     halt;
  120.   end;
  121.  
  122. { ******* Use these lines for version 2 **********
  123.   write('Text file: ');
  124.   readln(infilename);
  125.                          }
  126.  
  127. { At this point you could prompt for alternate font file
  128.   or pull an alternate font filename from the command line.
  129.   There should probably be a check for font file present here. }
  130.  
  131.   assign(descfile, 'ascii2.nlq');
  132.   reset(descfile);
  133.  
  134.   repeat       { Read dot patterns from font file, store in data array }
  135.     read(descfile,inpdesc);
  136.     passdat[inpdesc.ch].pass1 := inpdesc.pass1;
  137.     passdat[inpdesc.ch].pass2 := inpdesc.pass2;
  138.   until eof(descfile);
  139.   close(descfile);
  140.  
  141.   {$i- turn off I/O checking so don't get runtime error if no text file}
  142.  
  143.   infilename := paramstr(1);  { comment out this line for version 2 }
  144.  
  145.   assign(infile,infilename);  { try to open input file }
  146.   reset(infile);
  147.  
  148.   if ioresult <> 0 then       { if file open unsuccessful, scream }
  149.   begin
  150.     writeln('Input file empty!',^G);
  151.     halt;
  152.   end;
  153.  
  154.   {$i+ turn I/O checking back on }
  155.  
  156.   repeat                     { read and print each line from input file }
  157.     readln(infile,line);
  158.     printnlq(line);
  159.   until eof(infile);
  160. end.
  161.