CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol081/print.pas

Pascal/Delphi Source File | 1984-04-29 | 6.6 KB | 292 lines

{ Print utility for I.D.S. 460G "Paper Tiger" }

{ Author:  Peter Grogono }

program print;

const

{$ICONSTS.PAS }

printername = 'LST:';
namelength = 14;                      { Length of file name buffer }
bufferlength = 80;                    { Length of command buffer }

type

{$ITYPES.PAS }

nametype = array [1..namelength] of char;

var

filename : nametype;
infile, LP : text;

firstline, lastline, linenumber,
firstpage, lastpage, num, numcopies : integer;
charsperinch, linespacing, tabgap, margin, pagelen : byte;

textproc, boldface, varspacing : boolean;

{ Set default values of parameters }

procedure setdefaults;
begin
charsperinch := 12; firstline := 1; lastline := maxint; linespacing := 8;
margin := 0; tabgap := 8; linenumbers := 0; pagelen := 60; boldface := false;
varspacing := false; textproc := false; firstpage := 1; lastpage := maxint;
numcopies := 1
end; { setdefaults }

{ Read file name and instructions from console }

procedure readinstructions;

var

buffer : array [1..bufferlength] of char;
pos : byte;
ch, option : char;
parval : integer;

{ Display instructions for use of program }

procedure instructions;
begin
writeln;
write('Enter name of file to be printed,');
writeln(' and options as required.');
writeln('All input should be on one line.');
writeln('Use an asterisk (*) to denote a large number.');
writeln;
writeln('Option  Default  Function');
writeln;
writeln('B         off    Boldface (double-width characters)');
writeln('Cn        12     n = 10, 12, or 16 ch/inch');
writeln('Em,n      0,*    Print from line m to line n');
writeln('Gm        8      Set tab positions');
writeln('Ln        8      n/48 inches between lines (n >= 6)');
writeln('Mn        0      Left margin n columns wide');
writeln('Nn        0      Line numbers with n digits');
writeln('                 Default (n = 0): no line numbers');
writeln('Pn        60     n lines per page');
writeln('                 n = 0 suppresses page control');
writeln('Tm,n      1,*    Print file generated by TP');
writeln('                    from page m to page n');
writeln('V         off    Proportional spacing');
writeln('Xn        1      Make n copies');
writeln;
write('Enter instructions: ')
end; { instructions }

{ Get a character from the buffer }

procedure getchar;
begin
if ch <> chr(0) then
begin pos := pos + 1; ch := buffer[pos] end
end; { getchar }

{ Get a number from the buffer. * -> Maxint }

procedure getnum (var numval : integer);
begin
if ch = '*' then
begin numval := maxint; getchar end
else
begin numval := 0;
while ch in ['0'..'9'] do
begin numval := 10 * numval + ord(ch) - ord('0'); getchar end
end
end; { getnum }

begin { readinstructions }
if eoln(0) then instructions;
for pos := 1 to namelength do filename[pos] := blank;
pos := 0;
repeat read(ch) until ch <> blank;
while ch <> blank do
begin
if pos < namelength then
begin pos := pos + 1; filename[pos] := ch end;
if eoln(0) then ch := blank else read(ch)
end; { while }
writeln('Reading from: ',filename);

{ Move parameters into buffer }

pos := 0;
while not eoln(0) do
begin
read(ch);
if (ch <> blank) and (pos < bufferlength - 1) then
begin
pos := pos + 1;
if ch in ['a'..'z']
then buffer[pos] := chr(ord(ch)
- ord('a') + ord('A'))
else buffer[pos] := ch
end
end; { while }
buffer[pos+1] := chr(0); { Terminate buffer with null }

{ Scan buffer and interpret parameters }

pos := 0; getchar;
repeat
if ch in ['B','C','E','G','L','M','N','P','T','V','X']
then
begin
option := ch; getchar; getnum(parval);
case option of
'B' : boldface := true;
'C' : charsperinch := parval;
'E' : begin firstline := parval; getchar; getnum(lastline) end;
'G' : begin tabgap := parval; if tabgap = 0 then tabgap := 1 end;
'L' : linespacing := parval;
'M' : margin := parval;
'N' : linenumbers := parval;
'P' : pagelen := parval;
'T' : begin
textproc := true;
if parval >= 1 then
begin
firstpage := parval; getchar; getnum(parval);
if parval >= 1 then lastpage := parval
end
end;
'V' : varspacing := true;
'X' : numcopies := parval;
end { case }
end
else if ch <> chr(0) then getchar
until ch = chr(0)
end; { readinstructions }

{ Print the file }

procedure printfile;

var

ch : char;
line, textline, page : integer;
col, pos, cnt : byte;

{ Print page heading }

procedure printheading;
begin
if page > 0 then write(LP,chr(FF));
page := page + 1;
writeln(LP,filename,blank:40,'Page ',page:1);
writeln(LP)
end; { printheading }

{ Assembly language procedure used to copy TP files }

procedure copy (var infile : text;
firstpage, lastpage : integer);
external;

begin { printfile }

reset(filename,infile);
if eof(infile)
then writeln('Input file empty.')
else
begin

{ Set up LP }

rewrite(printername,LP);

{ -------------------------- Printer dependent code ------------------------ }

case charsperinch of
10 : write(LP,chr(29));
12 : write(LP,chr(30));
16 : write(LP,chr(31))
end; { case }
case boldface of
false : write(LP,chr(2));
true  : write(LP,chr(1))
end; { case }
case varspacing of
false : write(LP,chr(6));
true  : write(LP,chr(16))
end; { case }
write(LP,chr(ESC),'B');
write(LP,linespacing:1,chr(CR));

{ ---------------------- End of printer dependent code --------------------- }

{ Print the file }

for num := 1 to numcopies do
if textproc then copy(infile,firstpage,lastpage) else
begin
line := 0; textline := 0; page := 0;
writeln(LP,chr(FF));
while not eof(infile) do
begin
textline := textline + 1;
if (firstline <= textline) and (textline <= lastline)
then
begin
if (pagelen > 0) and (line mod pagelen = 0)
then printheading;
if margin > 0 then write(LP,blank:margin);
if linenumbers > 0 then write(LP,textline:linenumbers,blank);
col := 1;
while not eoln(infile) do
begin
read(infile,ch);
if ch = chr(TAB) then
begin
pos := 0;
while pos < col do pos := pos + tabgap;
for cnt := col to pos do
begin
write(LP,blank);
col := col + 1
end
end
else
begin
write(LP,ch);
col := col + 1
end
end; { while }
writeln(LP);
line := line + 1
end;
readln(infile)
end; { while }
if num < numcopies then reset(filename,infile)
end;
if not textproc then
begin
write(page:1,' page');
if page > 1 then write('s');
writeln(', ',line:1,' lines printed.')
end;

{ ------------------------ Printer dependent code -------------------------- }

write(LP,chr(30),chr(2),chr(6),chr(ESC),'B8',chr(CR))

{ ---------------------End of printer dependent code ----------------------- }

end
end; { printfile }

{ Main program }

begin { print }
setdefaults;
readinstructions;
printfile
end. { print }