⟦b87f1f839⟧

TextFileVerbose

job stb 4 3447
preroff=set 84 disc1
scope user preroff
message start compile preroff
preroff=algol
begin
<*-------------------------------------------------------
 this program is a preprocessor to the roff
text editing program.

its main purpose is to replace blank lines with the
roff-command '>sp1' and to perform automatic counting
of section numbers.

preroff was programmed 16.12.1979 by stb
------------------------------------------------------*>

integer array line(1:200), section(1:4), chapter(1:75);

integer line_length,lf,sp,ff,sp_fix,
        contents_niveau,
_       sep,no_of_files,file_no,

_       c_a1,command_char,c_a2,c_a3,c_a4,c_ap,i,ul,ll,c_cc,
_       c_fg,c_ex,fg_no,ex_no,boss_line,c_bl,contents_line;

boolean finished,no_fill_mode,boss_line_mode,danish,appendix;

real array param(1:2);

long array field name;

long array files(1:2*75);

zone in(128*2,2,stderror),
     contents(128,1,stderror);

\f


procedure init_com(com,first,second);
value first,second;
integer com,first,second;
com:=62 shift 16 + first shift 8 + second;


\f


procedure no_fill(no_fill_yes);
value no_fill_yes;  boolean no_fill_yes;
begin
no_fill_mode:=no_fill_yes;

write(out,if no_fill_mode then <:>nf:> else <:>fi:>,
_     <:<10>:>);
end;

\f


procedure print_contents(level);
value level; integer level;
begin <* prints a line in the table of contents *>
integer chars;
if  level <=  contents_niveau  then
begin

if contentsline>50 then
begin <* change page *>
outchar(contents,ff+128);

for contentsline:=1 step 1 until 6 do outchar(contents,lf);

contentsline:=0;
end;

contentsline:=contentsline+1;

if section(2)=0 then 
begin outchar(contents,10);
contentsline:=contentsline+1;
end;
 
write(contents,false add 32,10);

chars:=write(contents,false add 32, ((case level of (0,4,9,16))))
_     +print_section_number_2
_     +write(contents,<:  :>)
_     +print_line_rest_2
_     +write(contents,<: :>)
;

write(contents,false add 46,60-chars,false add 10,1);
end level <= ;

end print contents;

\f


procedure print_line;
begin <* prints the line contained in the 'line-arrAy'
and handles possible preroff-commands *>
integer com,i;

com:=if line_length<3 then 0 else
_    (if line(1)=command_char then 62 else 0)  shift 16 + line(2) shift 8 + line(3);

if line_length=0 then write(out,<:>sp1<10>:>)
else
if com=c_a1 then
begin <* start a new chapter *>
section(1):=section(1)+1;

for i:=2,3,4 do section(i):=0;

if (section(1) > 1 )  or  appendix then
write(out,<:>np<10>:>);
print_section_head;
print_contents(1);
end
else
if com=c_a2 then
begin
section(2):=section(2)+1;

for i:=3,4 do section(i):=0;

print_section_head;
print_contents(2);
end
else
if com=c_a3 then
begin
section(3):=section(3)+1;
section(4):=0;
print_section_head;
print_contents(3);
end
else
if com=c_a4 then
begin
section(4):=section(4)+1;
print_section_head;
print_contents(4);
end
else
if com=c_fg then
begin <* figure *>
nofill(false);
write(out,<:>nf<10>>in-8<10>>ll+50<10>:>,
_     false add spfix,(70-linelength-9)//2,
_     <:fig. :>,fgno,<:. :>);
fg_no:=fg_no+1;
printlinerest(false);
write(out,<:>fi<10>>ll-50<10>>in8<10>:>);
end
else
if com=c_ex then
begin <* example *>
nofill(false);
write(out,<:>ne8<10>>ul<10>:>,
_     if danish then <:Eksempel:> else <:Example:>,
_     false add ul,1,<<d>,ex_no,<:::>,
_     false add ul,1);
printlinerest(true);
ex_no:=ex_no+1;
end
else
if com=c_ap then
begin <* appendices start here *>
appendix:=true;
section(1):=0;
end
else
if com=c_bl then
begin <* set bossline mode *>
boss_line_mode:=true;
end
else
begin <* ordinary line *>

if line_length >= 1 then
begin
if line(1)=sp then
begin integer i;

for i:=1 step 1 until line_length do
if line(i)=sp then line(i):=sp_fix;

if -, no_fill_mode then no_fill(true);
end
else
if line(1)<>sp and no_fill_mode then no_fill(false);
end;

for i:=1 step 1 until line_length do
outchar(out,line(i));
outchar(out,lf);
end;

line_length:=0;
bossline:=bossline+10;
end print line;


\f


procedure print_line_rest(underline);
value underline;  boolean underline;
begin <* prints the rest of a line starting with
a preroff_command. underline indicates whether spaces 
shall be converted into underlines *>
integer i;

i:=4;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<=line_length do
begin
outchar(out,if (line(i)=sp) and underline then ul
_       else line(i));
i:=i+1;
end;

if bosslinemode then write(out,false add spfix,1,<<d>,bossline);
outchar(out,10);
end print line rest;

\f


integer procedure print_line_rest_2;
begin <* prints the rest of the input_line as it is *>
integer i,chars;

i:=4;
chars:=0;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<line_length do
begin
outchar(contents,line(i));
i:=i+1;
chars:=chars+1;
end;

if line(line_length)<>46 then
begin <* the line doesn't end with a period *>
outchar(contents,line(linelength));
chars:=chars+1;
end;


print_line_rest2:=chars;
end;


\f


procedure print_section_head;
begin <* provides the roff-commands necessary to
make the proper format of a section_header.

the section_number is taken from the 'section'-array *>

integer i,extra_ll;

procedure print_section_number(spaces);
value spaces; boolean spaces;
begin integer i,j;
i:= if appendix then write(out, false add (section(1)+64),1)
else  write(out,<<d>,section(1));

for j:=2,3,4 do
if section(j)>0 then
i:=i+write(out,<:.:>,<<d>,section(j));

if spaces then write(out,false add ul,8-i);
end print section number;


nofill(false);

write(out,<:>ne8<10>:>);

if section(2)<>0 then write(out,<:>sp2<10>:>);

extra_ll:=line_length+8-ll;

if extra_ll>0 then write(out,<:>ll+:>,<<d>,extra_ll+2,false add 10,1);

write(out,<:>in-8<10>>ul<10>:>);

print_section_number(true);
i:=4;

while (i<=line_length) and (line(i)=sp) do i:=i+1;

while i<=line_length do
begin
outchar(out,if line(i)<>sp then line(i) else ul);
i:=i+1;
end;
  
if bosslinemode then write(out, << d>,bossline);

if extra_ll <= 0 then
begin <* write the section number right justified *>
write(out,<:<10>>rj<10>:>);
print_section_number(false);
end
else
write(out,<:<10>>ll-:>,<<d>,extra_ll+2);
 
write(out,<:<10>>sp1<10>>in8<10>:>);

end print section head;

\f


integer procedure print_section_number2;
begin <* prints the section number as it is in the
contents file *>
integer chars,i;

if appendix then
chars:=write(contents, false add (section(1)+64),1,
_            if section(2)=0 then <:.:> else <::>)
else
chars:=write(contents,<<d>,section(1),
_            if section(2)=0 then <:.:> else <::>);

for i:=2,3,4 do
if section(i)>0 then
chars:=chars+write(contents,<:.:>,<<d>,section(i));

print_section_number2:=chars;
end;



\f


procedure read_line;
begin <* reads a line from input and stores
the characters in the 'line'-array *>

integer char;
boolean line_finished;

line_length:=0;
line_finished:=false;

repeat 
readchar(in,char);

if char=25 then line_finished:=finished:=true
else
begin
if (char=lf) or (char=ff) then line_finished:=true
else
begin
line_length:=line_length+1;
line(line_length):=char;
end;
end;

until finished or line_finished;

if finished then
begin
if no_of_files > file_no then
begin   <* change input file *>
  finished := false;
  file_no := file_no + 1;
  close(in,true);
  name := name + 8;
  open(in,4,files.name,0);
  if chapter(file_no) > 0 then section(1) := chapter(file_no) - 1;
  boss_line := 0;
end change input file;
end;
end read line;

\f


procedure testout(text,int);
value int; integer int; string text;
begin write(out,<:**** :>,text,<:  :>,int,false add lf,1);
setposition(out,0,0);
end test out;




\f


<******* i n i t i a l i s e   ******>

finished:=false;
no_fill_mode:=false;
bosslinemode:=false;
danish:=true;
appendix:=false;
contentsline:=10;
ll:=58;
lf:=10;
ff:=12;
ul:=95;
sp:=32;
sp_fix:=64;
command_char:=62;   <*  >  *>

fg_no:=1;
ex_no:=1;
bossline:=10;

init_com(c_a1,97,49);
init_com(c_a2,97,50);
init_com(c_a3,97,51);
init_com(c_a4,97,52);
init_com(c_ap,97,112);
init_com(c_fg,102,103);
init_com(c_ex,101,120);
init_com(c_bl,98,108);

for i:=1 step 1 until 4 do section(i):=0;
i := 1;
no_of_files := 0;
sep := system(4,i,param);
name := 0;
while sep = 4 shift 12 + 10 or sep = 8 shift 12 + 4 do
begin
  if sep = 4 shift 12 + 10 then
  begin
  files.name(1) := long param(1);
  files.name(2) := long param(2);
  no_of_files   := no_of_files + 1;
  chapter(no_of_files) := 0;
  name := name + 8;
  end
  else
  begin
  chapter(no_of_files) := param(1);
  end;
  i := i + 1;
  sep := system(4,i,param);
end;
if sep <> 0 then no_of_files := no_of_files - 1;
if no_of_files < 1 then system(9,no_of_files,<:<10>in files:>);
file_no := 1;
name := 0;
open(in,4,files.name,0);

open(contents,4,<:contents:>,0);

l{sfpboo(<:bosslines:>,bosslinemode);
l{sfpboo(<:bossline:>,bosslinemode);\f


contents_niveau := l{sfptal(<:cont:>);
if contents_niveau = 0 then contents_niveau := 100;  <* uendelig niveau antal *>
l{sfpboo(<:bl:>,bosslinemode);

l{sfpboo(<:danish:>,danish);
l{sfpboo(<:da:>,danish);


\f


<*******   m a i n   l o o p    ******>

write(contents,false add ff,1,false add lf,10,false add 32,10);
write(contents, if danish then <:INDHOLD:> else <:CONTENTS:>,
_     false add 32, if danish then 52 else 51,
_     if danish then <:SIDE:> else <:PAGE:>);
write(contents,false add lf,1,false add 32,10,false add ul,63,false add lf,2);


write(out,<:>pw+16<10>>ll+8<10>:>);
write(out,<:>he <64><126><35><126><64><10>:>,
_         <:>in8<10>:>);



repeat
read_line;
print_line
until finished;

write(out,<:>np<10>:>);
outchar(out,ff);
outchar(contents,ff);
outchar(contents,lf);
outchar(contents,25);
close(contents,true);

end
if warning.yes
(message warning compilation not ok
finis)
message compilation ok
finis
«eof»
DataMuseum.dk

RC3500

⟦b87f1f839⟧ TextFileVerbose

Derivation

TextFileVerbose
