Category : Printer Utilities
Archive   : TINYLST.ZIP
Filename : TL.PAS

 
Output of file : TL.PAS contained in archive : TINYLST.ZIP

const
lines=300; {This is number of lines per page.}
initstring=#27'3'#15#27'S0'#15; {This is the printer init string. It
sets Superscript, 15/216 inch line
spacing, and compressed print. Change
this string for non Epson compatible
printers.}



type
chararray=array[1..2000] of char;
linetype=string[66];
pagetype=array[1..lines] of linetype;

var
page:pagetype;
block:chararray;
fil:text;
reform,new:boolean;
stop,maxlines:integer;
inname:linetype;

procedure readabunch;
var
i:integer;
begin
i:=1;
if not new then
for i:=1 to 100 do
block[i]:=block[1900+i];
repeat
read(fil,block[i]);
if block[i]<>#10 then
i:=succ(i);
until (i=2000) or eof(fil);
stop:=1900;
if i<1900 then
stop:=i;
if eof(fil) then block[i]:=#26;
end;

function countleft(s:integer):integer;
var
i:integer;
begin
i:=0;
while block[i+s]=' ' do
i:=succ(i);
countleft:=i;
end;

function pad(s:linetype):linetype;
var
s1:linetype;
begin
s1:=s;
while length(s1)<66 do
s1:=s1+' ';
pad:=s1;
end;

procedure printpage;
var
i:integer;
begin
i:=1;
while (i<=maxlines) and (i<=(lines div 2)) do
begin
write(lst,pad(page[i]));
if i+(lines div 2)<=maxlines then
write(lst,pad(page[i+(lines div 2)]));
i:=succ(i);
writeln(lst);
end;
writeln(lst,#12#10#10#10);
end;

procedure scrollline;
begin
if maxlines=lines then
begin
printpage;
maxlines:=1;
end
else
begin
maxlines:=succ(maxlines);
page[maxlines]:='';
end;
end;

procedure displaybunch;
var
i,j:integer;
const
lefmar:integer=0;
begin
for i:=1 to stop do
begin
if block[i]=#26 then
begin
printpage;
halt;
end;
if block[i]>#128 then
begin
textcolor(12);
writeln('|':66-wherex);
textcolor(14);
if lefmar>0 then
write(' ':lefmar);
scrollline;
if lefmar>0 then
for j:=1 to lefmar do
page[maxlines]:=page[maxlines]+' ';
if block[i]<>#160 then
block[i]:=chr(ord(block[i])-128);
end;
if block[i]=#13 then
begin
writeln('®');
lefmar:=countleft(succ(i));
scrollline;
end;
if block[i] in [' '..'~'] then
begin
write(block[i]);
page[maxlines]:=page[maxlines]+block[i];
end;
end;
end;

procedure openfile;
var
c:char;
begin
write('Enter input file name: ');
readln(inname);
assign(fil,inname);
reset(fil);
writeln;
write('Reform paragraphs? ');
readln(c);
reform:=upcase(c)='Y';
writeln;
end;

procedure removecrs;
var
i,j,lm,lefmar:integer;
begin
i:=1;
if new then
lefmar:=countleft(i);
repeat
while block[i]<>#13 do
i:=succ(i);
lm:=countleft(succ(i));
if block[succ(i)]='' then
begin
reform:=not reform;
block[succ(i)]:=#0;
lm:=countleft(i+2);
end;
if (lm<=lefmar) and (block[succ(i)]<>#13) and (block[pred(i)]<>#13)
and reform then
begin
block[i]:=' ';
if lm<>0 then
for j:=succ(i) to i+lm do
block[j]:=#0;
end;
lefmar:=lm;
i:=succ(i);
until (i>=stop);
end;

procedure insertlfs;
var
i,j,count,lefmar:integer;
const
leftovers:integer=1;
begin
i:=leftovers;
if new then
lefmar:=countleft(i);
new:=false;
repeat
count:=0;
if block[i]<>#13 then
count:=count+lefmar;
repeat
if block[i]<>#0 then count:=succ(count);
i:=succ(i);
until (count>63) or (block[i] in [#13,#26]);
case block[i] of
#13:lefmar:=countleft(succ(i));
#26:;
else
begin
while not (block[i] in [' ',#13,#128..#255]) do
i:=pred(i);
block[i]:=chr(ord(block[i])+128)
end
end;
until (i>stop) and (block[i] in [#13,#128..#255]);
leftovers:=i-stop;
end;

begin
writeln(lst,initstring);
new:=true;
clrscr;
openfile;
maxlines:=0;
scrollline;
repeat
readabunch;
removecrs;
insertlfs;
displaybunch;
until eof(fil);
close(fil);
end.