DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFileVerbose
    Names: »prooftxt«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »prooftxt« 

TextFileVerbose

job j 1 perm disc1 10 10
proof=set 30 disc1
scope user proof
message start compile proof
proof=algol
begin <*

this program is used to create proof readings of texts
which has been 'roff'ed. its purpose is to mark
upper_case letters (i.e. overprint them) and to make
underlines by overprint.

it was programmed 18.12.1979 by stb
and modified 10.09.1980 by hlv
*>

integer array  line,line1(1:200),table(0:255);

boolean finished,only_big_letters,sep_underscore;

integer cr,lf,em,ff,ul,bs,uc,line_length,line1_length,
_       ff2,last_char,char,i,ul1,sp;


\f


procedure read_line;
begin <* reads a line of characters from current input
into the 'line' array. possible overprints are
inserted into the 'line1'-array.
*>
boolean line_finished;

line_finished:=false;

line_length:=line1_length:=0;

repeat
last_char:=char;
readchar(in,char);

if char=ff2 then char:=ff;

if char=em then line_finished:=finished:=true

else
begin
if (char=lf) or (char=ff) then line_finished:=true
else
begin
if (char>=65) and (char<95) then
begin <* upper case letter - must be overprinted *>
if only_big_letters then
begin
line1_length:=line_length+1;
line1(line1_length):=uc;
end
end
else
if last_char=bs then
begin
line1_length:=line_length;
line1(line1_length):=if sep_underscore then ul1 else char;
end
else
if (char=ul) and sep_underscore then
begin
  line1_length:= line_length+1;
  char:= sp;
  line1(line1_length):= ul1;
end;

if (char<>bs) and (lastchar<>bs) then
begin
line_length:=line_length+1;
line(line_length):=char;
end;
end;
end;
until finished or line_finished;
end read line;



\f


procedure print_line;
begin <* prints a line and its possible overprinted line *>
integer i;
real array field raf,raf1;

for i:=1 step 1 until line_length do
outchar(out,line(i));
if line1_length>0 then
begin <* overprints in this line *>
outchar(out,if sep_underscore then lf else cr);

for i:=1 step 1 until line1_length do
outchar(out,line1(i));

end;

outchar(out,lf);

if char=ff then outchar(out,ff);
end;




\f


procedure init_line1;
begin <* fills line1 with spaces *>
real array field raf,raf1;
raf:=4*1;
raf1:=raf-4;
line1.raf1(1):=real<:     :> add 32;
tofrom(line1.raf,line1.raf1,99*4);
end;



\f


<*******    initialisation   ********>


finished:=false;
cr:=13;
lf:=10;
em:=25;
ff:=12;
ff2:=12+128;
ul:=95;
bs:=8+128;
ul1:= 61;
sp:= 32;
uc:=39;
char:=0;
only_big_letters:=false;
sep_underscore:= false;

table(0):=0;

for i:=1 step 1 until 255 do
table(i):=6 shift 12 + i;

intable(table);

l{s_fp_boo(<:big:>,only_big_letters);
l{s_fp_boo(<:su:>,sep_underscore);


\f


<*    main loop   *>


repeat
init_line1;
read_line;
print_line;
until finished;

outchar(out,ff);
end
if warning.yes
(message warning compilation not ok
finis)
message compilation ok
finis
«eof»