|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 109056 (0x1aa00)
Types: TextFile
Names: »tcompose«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦1a9e12e70⟧ »ccompose«
└─⟦this⟧
\f
(
compose=algol connect.no fp.yes list.no
if ok.yes
scope user compose
lookup compose
)
begin comment TYPOL composing program.
VARIABLES IN ALPHABETIC ORDER:
a constant,see comment in program.
accuw accumulated width of current line.
b constant, see comment in program.
back true from call of proc backspace until a char.<>underline
is read. Used to allow xxxx_xxxx to be interpreted
as o n e word.
blind true if current line is empty(no visible character).
bool1,bool2 working variables.
bs constant,special value (5) for backspace.
bss constant,backspace-value for the typeset.machine.
c zone, connected to the console in case of a online run.
class integer array used by the hyphenation routine hyph.
c1,c2 pointers in codebuf used when code is to be saved
to next line.
censp no. of units to be generated before the first character
in current line when centering or quadding right mode.
chapstd standard value for <chapstart>.
chapstart distance in points from upper page limit to start
of a new page when pageshift is generated by the user.
codebuf buffer for control characters(code) for the typesetting
machine in current line.
codemode true if last action=putting characters in codebuf.
codemask codemask shift i<0 indicates that control characters
are generated after word no. i in current line.
comno processing a command, comno is assigned the command no.
according to the case construction in procedure typol
and the table comtab.
comtab table with all the commands on ISO-form, each element
contains the NUL-character and the two letters.
d constant, see comment in program.
dropjust true if currnet line dont have to be right-justified,
only used in justifying mode.
ff constant, ISO-value for formfeed.
figroom size in points of figures to be saved to the next page.
figsize size in points of figure to be saved until current
line is terminated.
figur false if a figur is to be saved to next page.
finis true when command EF is met.
first used in justification part of program, false if
additional words are read trying to make the word
spacing lesser.
fn pointer to first free place in footnote buffer.
fnfont array, element no. i contains the font no. for footnote
no. i on current page.
fnote buffer for footnotes.
fnoteno counts the footnotes on current page.
fontcode font-character values.
folip equal to <arg.1> in command PL.
font actual font=the parameter to the last FT-command met.
h1,h2 pointers in linebuf used when a word or part of a word
is saved to the next line.
h3 in case of hyphenation h3 saves the character in linebuf
to be replaced by a hyphen.
headlim max no. of char. in running head.
headmode true when setting a running head.
headp equal to <arg.4> in command PL.
hyp true if hyphenation has taken place (but not if a
natural breakpoint has been found).
hypdigit true if proc. hyph is called, used by proc. digit to change
the input table for + and -.
hyphinf zone connected to a backing store area containing
hyphenation information(hyph.mode 1 and 3).
hypmode hyphenation mode.
hypno value of the hyphenation procedure hyph.
i working variable.
intab contains the input table, see program description for
details.
j working variable.
k working varaible.
klass input class according to the input table of last
character read.
konvert table for conversion from ISO to the actual typesetting
machine code.
language language for source text used by the hyph. routine
1 danish
2 english.
lc constant, lover case value for the typeset. mach.
leading actual leading in points.
leftspa used in the justification part, true if wordspace
in previous line is bigger in the left part than in the
right part of the line.
lin pointer to first free place in linebuf.
line1 used under setting of running head, false if working on
an eventually second line in the head.
linelim max no. of char. in linebuf.
linebuf the line buffer containing all the words in a line on
ISO-form, special arrays (pib and pis) points on start
and end of a word.
linecount distance in points from upper page limit to actual place
on the page.
lineno counts lines with visible characters on a page.
linewidth line width in units.
machine no. on actual typesetting machine.
1. Justotext 70
2. DURA 941 Automatic Typewriter
3. Flexowriter
4. RC 610 Line Printer
margin left margin in units.
margtext array containing margin text generated by the MT-command.
maxnotelim max no. of footnotes on a page.
maxfactor constant, maxfactor*maxspace is the upper limit for the
average word space in a line, in which case it is not tried to
read more words to decrease the wordspace.
maxspace constant,maximum allowed word space in units.
minfactor minfactor*minspace is the lower limit for the average
word space in a line which is allowed(if possible) in the
case where the word space in the previous line have been
bigger than maxfactor*maxspace.
minlead constant, minimum leading on the actual typesetting machine,
used in connection with footnotes.
minspace minimum allowed word space in units.
mode current working mode.
1. justifying, 2. non-justifying, 3. tabulating,
4. centering, 5. quadding right.
more false indicates that reading from the source file to
current line is terminated.
mtext true if margin text is to be placed in following line.
mtextlim max no. of char. in margin text.
mtfont font no. for margin text.
newpage true if the PG-command is met.
newpar indentation in units of the following line when the
NP-command is met.
newpstd standard indentation in units in case of new paragraph.
nl constant, ISO-value for new line.
nlpar number of new line characters to be generated after
current line.
nls constant, new line value for the typeset.mach.
normsp normal width of a space in units.
normw average width of a character in units.
notefont font no. for the current note when setting footnotes.
notelim max no. of char. in all footnotes on a page.
notenumw the width in units of <d) > where d is a digit.
notemode true when setting footnotes.
nstext true if new section command met.
nummode equal to the first parameter in the last PN-command.
nump1 equal to <arg. 5> in command PL.
oldfont working variable for saving of font value when setting
running heads and fottnotes.
outcon true if zone out = console.
p1mask p1mask shift comno<0 indicates that command no. comno
allways contain one or one parameter followed by <text>.
p2mask constant, p2mask shift comno<0 indicates that command no.
comno contain one optional or more than one parameter.
pair integer array used by the hyphenation routine hyph.
pagnum actual page number.
pagelength distance in points from upper page limit to last real
text line.
pc points to first free place in codebuf.
pco pco(i) is equal to the number of characters placed in
codebuf to be written after word no. i.
pib pib(i) points in linebuf to start of word no. i.
pis pis(i) points in linebuf to end of word no. i.
pnfont font no. of page number.
point constant, equal to the size in mm of the typographical
unit point(0.3532).
pr zone connected to the proofreading file.
printbuf printbuf(i) contain information about characters to be
printed on the proofreading file after word no. i in current line
packed in this way:
bit 0-11 number of spaces
bit 12-23 =1 : indicates a font command, print *)
=2 : indicates a leading command, print **)
=3 : indicates both , print *) **)
printmask printmask shift i<0 indicates that printbuf(i) contains
something to be printed after word no. i.
printmode true if output is wanted on the list file.
prognl true after a programgenerated line shift.
progpage true from a programgenerated page shift to first real
text line is to be outputted on the following page.
q1,q2 working variables.
ra working array.
rh points to the first free place in rhead.
rhead buffer for running head.
rhfont font no. for running head.
runfont last font no. written on the object file.
runhead true if a running head is to be set on the following page.
runmode mode for output generation.
1. only list
2. only for the typesetting machine(object file).
3. both
s1,s2 working variables.
savecode true if control characters are saved from previous line.
savelead assigned to leading when entering notemode.
savell assigned to linewidth when entering notemode.
savemode assigned to mode when entering notemode.
saveword true if a word or part of word is saved from previous line.
sc1,sc2 saves the pointers c1 and c2 in connection with page shift, the
footnote setting maybe destroys them.
sep ISO-value for the actual separator.
set zone connected to the object file.
setmode true if output is wanted on the object file.
sh1,sh2,sh3 saves the pointers h1,h2,h3 in connection with page shift.
shiftlead true if more than one footnote on current page or the only
footnote contain more than one line.
shyp save value of hyp in connection with page shift.
size actual type size no.
smargin the coming left margin in units, used when the
LM-command dont occur in connection with line shift.
smtext true, if margin text is to be placed in the coming line,
used when the MT-command dont occur in connection with
line shift.
snitspace working variable for average word space.
sp constant, ISO-value for space.
sp1,sp2,sp3 constants, code-values to the typeset.mach. for
1 unit, 2 unit and 3 units space.
spamax true if the average in the previous line is bigger than
maxfactor*maxspace.
sps constant, space-value for the typeset.mach.
ssavecode true if control characters is to be saved under page shift.
ssaveword true if a word or part of word is to be saved under
page shift.
sstab special symbol table, sstab(i) contains class shift 12+value
for the character assigned to the special symbol no. i by
the SB command.
startofline true from end of the output of the previous line until
first character in next line is met.
startofword true from end of reading of previous word until reading
of first character in the next word is read.
stop constant, stopcode value for the typeset.mach.
swidth the coming line width in units, used when the LW-command
dont occur in connection with lineshift.
swordbuf buffer for word to be saved under page shift.
tabcount counts number of tabulator marks passed in current line.
tabno number of tabulator marks.
tabpar table with the distance in units between the tabulator
marks.
test constant,assign it to true if you want the value of the
most important variables printed on current output for
every line cycle.
text zone connected to the source file.
textp equal to <arg. 3> in command PL.
time constant, assign it to true if you want segment trans-
fer time, cpu and real time printed on current output.
toppage true from top of a page after a program generated
page shift to first significant char. is met,
used to avoid dobble page shift.
toptext true from top of a page to the first real text line
is to be outputted. Used to skip NL-commands in start
of a page.
typlim number of typol-commands in the actual edition of program.
u1 constant, ISO-value=1 which by the table konvert is
converted to the value for 1 unit space.
uc constant, the upper case value for the typeset.mach.
ulinemask ulinemask shift i<0 indicates that the space following
word no. i is to be underlined.
unit constant, equal to the size in mm of the least space unit
on the actual typesett. mach., also used when measuring
width of characters.
upperp equal to <arg. 2> in command PL.
v ISO-value for the last character read.
w count the words in current line.
wid width in units of first part of a hyphenated word.
word false when something signalizing end of a word is met
under reading from the source file
wordlim max no. of char. in the word possible to be saved
from one page to the next;
integer linelim,wordlim,mtextlim,headlim,notelim,maxnotelim,
hypmode,machine,language,hyphzl,proofzl,objzl;
boolean setmode,printmode;
real array prooffile,objfile,hyphfile,sourcefile(1:2);
begin comment scan call parameters;
integer sep,no,next,q;
real array param(1:2);
machine:=4; language:=1;
setmode:=false; printmode:=false;
hypmode:=4; objzl:=1;
hyphzl:=1; proofzl:=1;
sourcefile(1):=real<::>; no:=1;
sep:=system(4,1,param);
if sep=6 shift 12 + 10 then
begin comment left side;
system(4,0,objfile); setmode:=true;
no:=2; objzl:=128
end;
for sep:=system(4,no,param) while sep shift (-12) > 3 do
begin comment scan one parameter;
if sep extract 12 <> 10 then goto paramerror;
if param(1)=real<:machi:> add 110 then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 4 then
begin
machine:=param(1)+3;
if machine<4 or machine>5 then goto paramerror;
next:=no+2
end else
if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:proof:> then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
printmode:=true; proofzl:=128;
prooffile(1):=param(1); prooffile(2):=param(2);
next:=no+2
end else
if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
<* if param(1)=real<:langu:> add 97 then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
if param(1)=real<:d:> then language:=1 else
if param(1)=real<:e:> then language:=2 else
goto paramerror;
next:=no+2
end else
if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
*> if param(1)=real<:hyphe:> add 110 then
begin
next:=no+1; q:=0;
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
if param(1)=real<:c:> then
begin
q:=q+1; next:=next+1;
sep:=system(4,no+2,param)
end;
if sep=8 shift 12 + 10 then
begin
q:=q+2; next:=next+1;
hyphzl:=128;
hyphfile(1):=param(1); hyphfile(2):=param(2);
end;
hypmode:=case q of(2,3,1);
end else
if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
begin
sourcename:
if sourcefile(1)<>real<::> then goto paramerror else
begin
sourcefile(1):=param(1); sourcefile(2):=param(2);
next:=no+1;
end;
end;
if system(4,next,param) shift (-12) >=6 then
goto paramerror
else no:=next
end while;
if false then
paramerror:
begin
write(out,<:***compose param :>);
for sep:=system(4,no,param),
system(4,no,param) while sep shift (-12) > 5 do
begin
write(out,if sep shift (-12) = 8 then <:.:> else <: :>);
q:=1;
if sep extract 12 = 10 then
write(out,string param(increase(q))) else
write(out,<<d>,entier(param(1)+0.5));
no:=no+1
end;
outchar(out,10);
fpproc(7,0,0,3)
end;
end scan;
linelim:=300; wordlim:=75; mtextlim:=300;
headlim:=350; notelim:=400; maxnotelim:=6;
begin comment inner block;
boolean nl,sp,ff,bs,u1,sp1,sp2,sp3,nls,sps,bss,time,toptext,
compinit,runhead,finis,headmode,notemode,stop,shiftlead,nstext,hypdigit,
saveword,savecode,hyp,spamax,dropjust,figur,newpage,codemode,prognl,back,
toppage,shyp,ssaveword,test1,blind,mtext,smtext,ssavecode,startofword,outcon,
word,more,line1,first,bool1,bool2,leftspa,lc,uc,test,startofline,progpage,
up,esc,etx,eot,innotout;
integer typlim,p1mask,p2mask,mode,
font,tabcount,newpstd,newpar,linewidth,margin,pagelength,
sep,minlead,size,chapstd,chapstart,folip,upperp,textp,
sh1,mtfont,sh2,sh3,sc1,sc2,smargin,swidth,lineno,notenumw,stdlead,
headp,nump1,pnfont,pagnum,nummode,leading,maxspace,minspace,
runfont,normsp,i,j,k,q1,q2,a,b,d,h1,h2,h3,c1,c2,s1,s2,w,tabno,
linecount,pc,lin,printmask,codemask,ulinemask,figroom,figsize,
fnoteno,fn,rh,rhfont,accuw,censp,savelead,savemode,savemarg,
savell,oldfont,notefont,fcount,klass,v,hypno,wid,comno,nlpar,
specdel,delin,subleading;
real unit,point,snitspace,maxfactor,minfactor,normw,saveminus;
boolean array linebuf(1:linelim),codebuf(0:150),swordbuf(0:wordlim),
margtext(1:mtextlim),rhead(1:headlim),fnote(1:notelim);
integer array pib,pis,tabpar(1:24),comtab(1:30),printbuf,pco(0:24),sstab(1:18),
konvert,width,intab(0:127),fnfont(1:maxnotelim),fontcode(1:7);
real array ra(1:3);
zone c(5,1,stderror),pr(proofzl,1,stderror),set(objzl,1,stderror),
hyphinf(hyphzl,1,stderror);
procedure testvar;
begin boolean k;
procedure d(b);value b; boolean b;
write(out,<<dd>,if b then 1 else 0,<:,:>);
write(out,nl,1,<:test 1 line :>,<<ddd>,lineno,nl,1);
k:=false add 44;
d(compinit); d(runhead); d(finis); d(headmode); d(notemode);
d(shiftlead); d(saveword); d(savecode); d(hyp); d(dropjust); write(out,nl,1);
d(figur); d(newpage); d(codemode); d(word); d(more);
d(line1); d(first); d(leftspa); d(smtext); d(spamax); write(out,nl,1);
write(out,nl,1,<<ddddd>,mode,k,1,font,k,1,newpar,k,1,
linewidth,k,1,margin,k,1,size,k,1,leading,k,1,runfont,k,1,
w,k,1,tabcount,k,1,nl,1,h1,k,1,h2,k,1,h3,k,1,
sh1,k,1,sh2,k,1,sh3,k,1,c1,k,1,c2,k,1,sc1,k,1,sc2,k,1,nl,1,
linecount,k,1,pc,k,1,lin,k,1,printmask,k,1,
codemask,k,1,ulinemask,k,1,figroom,k,1,fn,k,1,rh,k,1,
accuw,k,1,nl,1,censp,k,1,pagnum,k,1,nummode,k,1,lineno,k,1,
figsize,k,1,fnoteno,k,1,hypno,k,1,smargin,k,1,
swidth,k,1,v,k,1,nl,1,wid,k,1,nl,1);
setposition(out,0,0)
end testvar;
procedure etext;
error(<:no EF command:>,2);
procedure error(s,a); value a; string s; integer a;
comment handling of logical errors not to be found
by the input program;
begin
write(out,nl,1,<:***typol :>,s); where;
if a=2 then goto exit else if a=3 then goto eexit;
end error;
procedure where;
write(out,<: page :>,<<ddd>,pagnum,<: line :>,lineno,nl,1);
procedure digit(b); value b; boolean b;
comment b=true: makes the input table ready for number reading
with the terminator comma and current separator,
b=false: restores the input table according to current mode;
begin integer i;
if b then
begin
for i:=48 step 1 until 57 do intab(i):=2 shift 12+i;
intab(44):=7 shift 12+44;
intab(32):=32;
if hypdigit then
begin saveminus:=real<::> add intab(43) shift 24 add intab(45);
intab(10):=7 shift 12+10;
for i:=43,45 do intab(i):=3 shift 12+i
end
else intab(sep):=7 shift 12+sep;
end else
begin
for i:=48 step 1 until 57,44 do intab(i):=5 shift 12+i;
intab(32):=(if mode=1 then 2 else 5) shift 12+32;
if hypdigit then
begin
for i:=43,45 do intab(i):=saveminus shift (if i=43 then (-24) else 0)
extract 24;
intab(10):=2 shift 12+10;
end
else intab(sep):=3 shift 12+sep;
end
end digit;
integer procedure hyph(a,n1,n2,n3,n4);
value n1,n2,n3,n4;
boolean array a; integer n1,n2,n3,n4;
begin
integer pnt,i,k,storen1,n,p;
integer array class(0:127);
integer procedure breakpt (a,n1,n2,n3,n4);
boolean array a; integer n1,n2,n3,n4;
begin
comment
procedure hyph is called when a hyphenation of a
line is wanted.
depending on the value of the global variable
hypmode the information is taken either from procedure
breakpt or from procedure breakpt and the console or
from the backing store. (see description of hypmode).
the value of hyph points at the element in array a after
which the break should be made.
procedure breakpt has the same parameters as
procedure hyph and contains an algorithm for finding
a natural breakpoint or a hyphenation point.
in case that anenglish text is to be processed
the corresponding procedure ebreakpt for english
hyphenation will be called.
the following possibilities are examined in the
mentioned sequence:
1. a natural breakpoint i.e. a point after
a punktuation character (p.ex.,:) or a
natural terminator (p.ex + -)).
2. a pair of consonants which can not be
pronounced.
3. a consonant between two vowels
4. two consonants between two vowels.
parameters:
a a boolean array, each element containing a character
of the line to be hyphenated or breaked.
composed characters will have the format:
<character><1-unit backspaces><character>
<1-unit backspaces>....<1-unit spaces>
each element contained in one element
of a.
n1 an integer pointing at an element of the
first character of the actual string (word)
in a.
n2 an integer pointing at an element of the
first character after which a break or
hyphenation may be made
n3 an integer pointing at an element of the
last character before which a break or
hyphenation may be made.
n4 an integer pointing at an element of the last
character of the actual string (word).
global variables:
language an integer denoting the language
of the actual text: 1 for danish
and 2 for english.
linelim. an integer denoting the upper limit
of the array a which should be declared
a(1:linelim).
hypmode an integer selecting the way of furnishing
the hyphenation information.
hypmode=1 the procedure prints on the console a
proposal of hyphenation (made by call of
procedure breakpt) which the user can
accept by typing + or reject by typing
- and the correct position of hyphenation.
the hyphenation - information is stored in
zone hyphinf.
hypmode=2 like hypmode=1 but the information is
not stored.
hypmode=3 the hyphenation - information is read
from zone hypheninf
hypmode=4 the hyphenation - information is taken
from the procedure breakpt without
communication with the user.
variables:
class an integer array classifying the characters as
follow, where the characters are shown by their
ISO-values.
class 0
0
class 1 (elements for composed characters only)
39,94,95,96,126
class 2 (punctnation characters)
33,44,46,58,59,63
class 3 (natural terminators)
35,36,37,38,41,43,45,60,61,62,64
class 4 (vowels)
65,69,73,79,85,89,91,92,93
97,101,105,111,117,121,123,124,125
class 5 (consonants)
class 6 (digits)
class 7
34,40,42,47 and 15<=characters<=31
class 8 (backspace)
5,8
class 9 (1-unit space)
1
2,3,4,5,6,7
class 12 spec. backspaces in start of underlined char.
2
pair an integer one dimensional array containing a
tabel denoting the pairs of consonants which
can be pronaunced together before the vowel
in a syllable.
the vertical entrance corresponding to the
index of pair denotes the left consonant and
the horizontal entrance corresponding to the
bit number of the elements in pair denote the
right consonant.
a bit=1 denotes that the pair can be pronounced.
bcdefghijklmnopqrstuvwxz
b 000100010000010010010000
c 000100110000010000010000
d 000100010000010010011100
e 111111111111111111111111
f 000100010010110010010000
g 000100010010110010010000
h 000100011000010000011100
i 111111111111111111111111
j 000100010000010000010000
k 000100010010110010011100
l 000100010000010000010000
m 000100010000010000010000
n 000100010000010000010000
o 111111111111111111111111
p 000100010000010010010000
q 000100010000010000010000
r 000100010000010000010000
s 000101011111111000111100
t 000100010000010010011100
u 111111111111111111111111
v 000100010000010010010000
w 000100010000010010010000
x 000100010000010000010000
z 000100010000010000010000
i,k,n,p working variables
storen1 the unmodified value of n1 which will
be stored if hypmod=1
pnt assigned the value of procedure breakpt
and modified to the character no. counted
from the left slash and read from the
console, in hypmode 1 and 2.
in hypmode=3 pnt is assigned the value of the
stored breakpoint
rightn2 pointers pointing in a at the rightmost element
of n2 and
rightn3 n3 respectively.
rightn3add1 pointer pointing in a at the rightmost
element of the character to the right of n3
leftn2 pointers pointing in a at the leftmost
element of n2
leftn3 and n3 respectively.
konr the values of right and left
konl character respectively in a pair of
consonants.
class2 a boolean set true when a class2 or class3
character is met during searching for a
natural breakpoint
;
integer i,n, rightn2,rightn3,leftn2,leftn3,k,p,rightn3add1,konr,konl,q,r;
boolean class2; integer array pair(0:23);
integer procedure pack(o1,o2,o3,o4,o5,o6,o7,o8);
integer o1,o2,o3,o4,o5,o6,o7,o8;
begin comment the parameters which should be octal digits
will be packed in pack in succeding groups of 3 bits;
integer k,o,i;
k:=0; i:=21;
for o:=o1,o2,o3,o4,o5,o6,o7,o8 do
begin
k:=k+o shift i;
i:=i-3;
end;
pack:=k;
end pack;
comment initialising of tabel of pairs of consonants;
pair(0):=pack(0,4,2,0,2,2,2,0);
pair(1):=pack(0,4,6,0,2,0,2,0);
pair(2):=pack(0,4,2,0,2,2,3,4);
pair(3):=pack(7,7,7,7,7,7,7,6);
pair(4):=pack(0,4,2,2,6,2,2,0);
pair(5):=pack(0,4,2,2,6,2,2,0);
pair(6):=pack(0,4,3,0,2,0,3,4);
pair(7):=pack(7,7,7,7,7,7,7,6);
pair(8):=pack(0,4,2,0,2,0,2,0);
pair(9):=pack(0,4,2,2,6,2,3,0);
pair(10):=pack(0,4,2,0,2,0,2,0);
pair(11):=pack(0,4,2,0,2,0,2,0);
pair(12):=pack(0,4,2,0,2,0,2,0);
pair(13):=pack(7,7,7,7,7,7,7,6);
pair(14):=pack(0,4,2,0,2,2,2,0);
pair(15):=pack(0,4,2,0,2,0,2,0);
pair(16):=pack(0,4,2,0,2,0,2,0);
pair(17):=pack(0,5,3,7,7,0,7,4);
pair(18):=pack(0,4,2,0,2,2,3,4);
pair(19):=pack(7,7,7,7,7,7,7,6);
pair(20):=pack(0,4,2,0,2,2,2,0);
pair(21):=pack(0,4,2,0,2,2,2,0);
pair(22):=pack(0,4,2,0,2,0,2,0);
breakpt:=0;
comment natural break
a natural break is made after a class 2 or a class 3
character if they are not followed by a class 2 character.
the scan is made against left from the rightmost element
of n2.
;
leftn2:=charleft(n2,a); leftn3:=charleft(n3,a); rightn3:=charright(n3,a);
rightn3add1:=charright(rightn3+1,a); rightn2:=charright(n2,a);
n4:=charright(n4,a); n1:=charleft(n1,a);
comment find punctuation character;
i:=leftn2-1; class2:=false;
for i:=i+1 while i<=leftn3-1 and -,class2 do
begin
k:=class(a(i) extract 7);
class2:=k=2 or k=3
end;
if class2 then
begin comment find the last of succeeding punctuation
characters if any occur;
k:=charright(i-1,a); p:=k+1;
for k:=charright(p,a) while class2 and k<=rightn3add1 do
begin
class2:=false;
for i:=p step 1 until k do
if class(a(i) extract 7)=2 then class2:=true;
n:=p; p:=k+1
end;
if n<=leftn3 then begin breakpt:=-(n-1);goto breakend end;
end;
comment hyphenation
foerst soeges en vokal bagfra hvorefter der soeges et
konsonantpar.
herefter slaas der op i den tosidede tabel pair med de
to konsonanter som indgangsvaerdier.
den aktuelle bit i pair er 1 hvis konsonanterne kan udtales
sammen og ellers 0.
er bitten 0 deles ordet det paagaeldende sted.
find vokal;
k:=charright(n4,a);
i:=k +1;
vokal:
for i:=i-1 while class(a(i) extract 7)<>4 and i>=leftn2 do;
if i>leftn2 then
begin
comment find konsonant;
i:=i+1;
kons: for i:=i-1 while class(a(i) extract 7)<>5 and i>rightn2 do;
nykonl: if i>rightn2 then
begin
konr:=a(i) extract 7;
konr:=konr-(if konr=90 then 67 else if konr=122 then 99 else
if konr>90 then 98 else 66); comment konv. til
pair-entrance;
comment find nabokonsonant;
i:=charleft(i,a)-1;
k:=charleft(i,a);
i:=i+1;
for i:=i-1 while class(a(i) extract 7)<>5 and i>=k do;
if i<k then
begin comment ingen nabokonsonant;
i:=i+1;
goto kons
end;
konl:=a(i) extract 7;
konl:=konl-(if konl=90 then 67 else if konl=122 then 99 else
if konl>90 then 98 else 66);
if (pair(konl) shift (konr-23)) extract 1 <>0 then
goto nykonl else
if i>=leftn3 then
begin
i:=charleft(i,a);
goto vokal
end
else
begin
breakpt:=charright(i,a);
goto breakend
end
end
comment deling foran konsonant mellem to vokaler.
find vokal;
i:=charright(rightn3+1,a)+1;
vok: for i:=i-1 while i>rightn2 and class(a(i) extract 7)<>4 do;
if i>rightn2 then
begin comment vokal fundet, find nabokonsonant;
n:=p:=charleft(i,a); k:=charleft(p-1,a);
for n:=n-1 while n>=k and class(a(n) extract 7)<>5 do;
if n<k then
begin
i:=p;
goto vok
end;
comment konsonant fundet, find nabovokal;
p:=charleft(k-1,a); n:=k;
if p>=n1 then
begin
for n:=n-1 while n>=p and class(a(n) extract 7)<>4 do;
if n>=p then
begin
breakpt:=k-1;
goto breakend
end
else
begin
i:=p;
goto vok
end
end;
end;
comment deling mellem to vokaler mellem to konsonanter.
find vokal;
i:=1+(if n4>rightn3 then charright(rightn3+1,a) else
rightn3); q:=charright(rightn2+1,a);
voc: for i:=i-1 while i>q and class(a(i) extract 7)<>4 do;
if i>q then
begin comment vokal fundet. find nabokonsonant;
n:=p:=charleft(i,a); k:=charleft(p-1,a);
for n:=n-1 while n>=k and class(a(n) extract 7)<>5 do;
if n<k then
begin
i:=p;
goto voc
end;
comment konsonant fundet, find ny nabokonsonant;
n:=k; p:=charleft(k-1,a);
if p>charright(n1,a) then
begin
for n:=n-1 while n>=p and class(a(n) extract 7)<>5 do;
if n<p then
begin
i:=k;
goto voc
end;
comment konsonant fundet, find nabovokal;
n:=p; r:=charleft(p-1,a);
for n:=n-1 while n>r and class(a(n) extract 7)<>4 do;
if n<r then
begin
i:=p;
goto voc
end;
comment vokal fundet;
breakpt:=k-1;
goto breakend
end
end i>q;
end;
breakend:
end breakpt;
integer procedure charright (p,a); value p; integer p;
boolean array a; comment the procedure scans towards
right to find the rightmost element of a given character
in the array a. p is the index pointing in a at an
arbitrary element of the actual character;
begin
integer k, m,q;
if p=linelim then
begin
charright:= linelim;
goto fin
end;
k:=p-1;
m:= class(a(p)extract 7); q:=class(a(p+1) extract 7);
for k:=k+1 while
(q>7 and q<>12) or
(m<>9 and m>7) do
begin
if k=linelim-1 then
begin
charright:=linelim;
goto fin
end;
m:=q;
q:=class(a(k+2) extract 7);
end;
charright:=k;
fin: end charright;
procedure outstring(p,q);
value p,q; integer p,q;
begin integer k; boolean class8;
class8:=false;
for i:=p step 1 until q do
begin
k:=class(a(i) extract 7);
write(c,
if k<8 and (a(i) extract 7<15 or a(i) extract 7>31) then a(i)
else if k=7 then false add 42
else if k=8 and -,class8 then false add 8 else false,1);
class8:=k=8;
end
end outstring;
integer procedure charleft(p,a);
value p; integer p; boolean array a;
comment the procedure is similar to
charright but looks for the leftmost
element of the actual character;
begin
integer k,m,q;
if p=1 then
begin
charleft:=1;
goto fin
end;
k:=p+1; m:=class(a(p) extract 7); q:=class(a(p-1) extract 7);
for k:=k - 1 while
(m>7 and m<>12) or q=8 or q=12 do
begin
if k=2 then
begin
charleft:=1;
goto fin
end;
m:=q;
q:=class(a(k-2) extract 7);
end;
charleft:=k;
fin: end charleft;
<*
integer procedure ebreakpt(A,n1,n2,n3,n4) ;
value n1,n2,n3,n4 ;
boolean array A ;
integer n1,n2,n3,n4 ;
begin
integer array class(0:127) , B(1:29) ,word,posn(0:n4-n1+2);
integer i,j,k,l,m,a,b,c,d ,m1,m2,m3,m4,class2,bs,fs ;
boolean init,dsmk ,composite,charset,newm2,newm3 ;
comment set up arrays and constants ;
for i := 0 step 1 until 127 do
class(i) := case i + 1 of
(3,7,7,7,7,7,7,7,
3,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,
7,8,3,3,3,9,9,3,
3,8,9,3,8,6,5,3,
4,4,4,4,4,4,4,4,
4,4,8,8,9,9,9,8,
9,1,2,2,2,1,2,2,
2,1,2,2,2,2,2,1,
2,2,2,2,2,1,2,2,
2,1,2,1,1,1,9,9,
9,1,2,2,2,1,2,2,
2,1,2,2,2,2,2,1,
2,2,2,2,2,1,2,2,
2,1,2,1,1,1,9,3 ) ;
for i := 1 step 1 until 29 do
B(i) := case i of
(9,8,6,8,9,8,6,1,9,5,
5,5,4,3,10,6,5,2,7,6,
9,5,6,5,9,5,9,9,9 ) ;
ebreakpt := 0 ;
m1 := 1 ; m2 := n2-n1+1 ;
m3 := n3-n1+1 ; m4 := n4-n1+1 ;
word(0) := word(m4+1) := 0 ;
bs := 8 ; composite := false ; fs := 5 ;
comment check for composite chars ;
for i := 1 step 1 until m4 do
begin
word(i) := A(n1+i-1) extract 7 ;
posn(i) := n1+i-1 ;
if word(i) = bs or word(i) = fs then composite := true ;
end ;
if composite then
begin comment word tidy-remove composites ;
j := 0 ;
for i := 1,i+1 while j<m4 do
begin
class2 := 0 ; charset := false ;
ABOVE:
for j := j+1 while word(j)=bs do ;
if word(j)=39 or (word(j)>93 and word(j)<97)
or word(j)=126 then
begin comment class 1 ;
if -, charset then goto INSERT
end
else
begin comment class2 ;
class2 := class2+1 ;
INSERT:
word(i) := word(j) ;
charset := true
end ;
if word(j+1)=bs then goto ABOVE ;
for j := j+1 while word(j)=fs do ;
if class2>1 then goto OUT ;
comment no ebreakpt can be found ;
j := j-1 ;posn(i) := n1+j-1 ;
comment posn of last char in composite ;
end dealing with one composite posn ;
m4 := i-1 ; newm2 := newm3 := true ;
for i := 1 step 1 until m4 do
begin
if newm2 then
begin
if posn(i)>=n2 then
begin m2 := i ;newm2 := false end ;
end
else
if newm3 then
begin
if posn(i)>=n3 then
begin m3 := i ; newm3 := false end ;
end ;
end find new m2,m3 ;
end word tidy ;
comment look for natural break ;
for i := m3-1 step -1 until m2 do
begin
j := case class(word(i)) of (1,1,1,1,1,2,3,4,4 ) ;
k := case class(word(i+1)) of (1,1,1,2,3,1,1,3,1);
l := case(j-1)*3+k of (1,1,1,2,1,2,2,2,2,2,2,1) ;
if l = 2 then
begin
ebreakpt := -posn(i) ; goto OUT
end natural breakpoint found ;
comment table used for case statement :
i+1 other digit punctuation
i
alphanum. 1 1 1
hyphen,minus 2 1 2
non-printing 2 2 2
non-alphan. 2 2 1 ;
end ;
comment natural break not found,find start and end
characters of word ;
for i := m2+1,i-1 while i>m1 and class(word(i-1))<6 do ;
a := i ; comment first of word ;
for i := m2-1,i+1 while i<m4 and class(word(i+1))<6 do ;
b:= i ; comment last of word ;
comment search valid last vowel in word ;
init := true ;
for i := b step -1 until m2+1 do
begin
j := class(word(i)) ; if j>3 then j := 3 ;
k := word(i) mod 32 ;
case j of
begin
comment 1 vowel ;
begin
if k<>5 or (-, init and -, dsmk) then goto VFOUND ;
init := dsmk := false
end ;
comment 2 consonant ;
begin
dsmk := if init and (k=4 or k=19) then true else false ;
init := false ;
end;
comment 3 other,no action ; ;
end of case statement ;
end of loop ;
comment no vowel found ;
goto OUT ;
VFOUND:
c := if i>m3 then m3 else i ;
comment find consonant to start new line ;
for i := c step -1 until m2+1 do
if class(word(i)) = 2 then
begin comment consonant found ;
j := word(i) mod 32 ;
k := B(j) ;
l := if class(word(i-1))>2 then 5 else B(word(i-1) mod 32 ) ;
if k>4 or l<6 then goto BELOW ;
m := case(l-6)*4+k of
(1,1,2,2,1,2,2,2,2,1,2,2,2,1,1,2,2,1,1,1) ;
comment table used in case statement :
i 1,h 2,r 3,n 4,m
i-1
6,invalid with r,h 1 1 2 2
7,------------ h 1 2 2 2
8,------------ r 2 1 2 2
9, vowels - o 2 1 1 2
10, o 2 1 1 1
5 is class of other characters ;
case m of
begin
comment 1 no action ; ;
comment 2 test for double consonant ;
BELOW:
if class(word(i+1))<>2 or j <> word(i+1) mod 32
then goto CFOUND ;
end of case statement ;
end of consonant check ;
goto OUT ; comment no break point ;
comment look for vowel before break ;
CFOUND:
d := i ;
for i := a step 1 until d-1 do
if class(word(i))=1 then
begin
ebreakpt := -posn(d-1) ;
if class(word(d-1))<3 then ebreakpt := posn(d-1) ;
goto OUT
end ;
OUT:
end of ebreakpt procedure ;
*>
for n:=3 step 1 until 14 do class(n):=11; class(1):=9;
class(2):=12; class(5):=class(8):=8; class(0):=0;
for n:=15 step 1 until 31 do class(n):=7;
n:=32;
for i:=11,2,7,
3,3,3,3,1,
7,3,7,3,2,
3,2,7,6,6,
6,6,6,6,6,
6,6,6,2,2,
3,3,3,2,3 do
begin
class (n):=i;
n:=n+1
end;
for n:=65 step 1 until 127 do class(n):=5;
for i:= 65,69,73,79,85,89,91,92,93 do
class(i):= class(i+32):=4;
class(94):= class(95):= class (126):=1;
class(127):=10;
storen1:=n1;
n:=case hypmode of (1,1,2,3);
digit(true);
case n of
begin
begin
comment hypmode=1 or 2 i. e. hyph.-information read
on-line;
pnt:=<*if language=2 then ebreakpt(a,n1,n2,n3,n4)
else *> breakpt(a,n1,n2,n3,n4);
n2:=charleft(n2,a); n3:=charleft(n3,a);
n:=if pnt=0 then n3-1 else abs(pnt);
write(c,<:<10>:>);
outstring(n1,n2-1); write(c,<:/:>); outstring(n2,n);
if pnt<>0 then
begin
if pnt>0 then write(c,<:-:>);
write(c,<:<10>:>);
end;
outstring(n+1,n3-1); write(c,<:/:>); outstring(n3,n4);
if pnt<>0 then
begin
write(c,<:<10>+/-: :>); setposition(c,0,0);
for i:=readchar(c,k) while -,(k=43 or k=45) do; setposition(c,0,0);
end else k:=45;
if k=43 then p:=hyph:=pnt else
begin
posagain: setposition(c,0,0);
write(c,<:
position: :>); setposition(c,0,0);
read(c,pnt); repeatchar(c); readchar(c,k);
if k<>10 or pnt>=n3 then goto posagain; setposition(c,0,0);
if pnt=0 then hyph:=0 else
begin
k:=abs(pnt); p:=n2-1;
for i:=1 step 1 until k do p:=charright(p+1,a);
if p<n2 or p>=n3 then
begin
write(c,<:
position outside limits.:>);
goto posagain
end;
p:=hyph:=sign(pnt)*p;
end;
end;
if hypmode=1 then write(hyphinf,<<ddd>,storen1,<:,:>,p,<:
:>);
end hypmode=1 or 2;
begin comment hypmode=3, hyphenation information read from
zone hyphinf where it has been stored in a preceeding run;
read(hyphinf,storen1,pnt);
if n1=storen1 then hyph:=pnt else
error(<:hyph. file not correct:>,2)
end hypmode=3;
begin comment hypmode=4 , hyphenation-information taken from
procedure breakpt only;
hyph:=breakpt(a,n1,n2,n3,n4);
end
end case;
digit(false);
end procedure hyph;
integer procedure typol;
comment reads and executes a command or numerical name from the
source file.
Jumps to labels outside the procedure are done if one of
the following commands is met:
RJ,SJ,TA,CT,QR.
typol is assigned the values:
1 - NL,NS
2 - NP
3 - PS,EF
4 - FG
5 - FN
6 - any other command;
begin integer p1,p2,com,q1,q2;
integer array par(1:24);
q1:=32;
for i:=i while q1=32 do readchar(in,q1);
if q1>47 & q1<58 then
begin comment numerical names generated by the input program;
comno:=0; for i:=i while q1<>sep do readchar(in,q1);
goto outtyp
end;
q2:=32;
for i:=i while q2=32 do readchar(in,q2);
if q1<97 then q1:=q1+32;
if q2<97 then q2:=q2+32;
com:=q1 shift 8 add q2;
i:=0;
for i:=i+1 while comtab(i)<>com & i<typlim+1 do;
if i=typlim+1 then
begin comment illegal command;
write(out,nl,1,false add q1,1,false add q2,1,sp,1);
error(<:unknown command:>,2)
end;
comno:=i;
comment initialize parameters;
digit(true);
p1:=par(1):=par(2):=-1;
if comno=19 then
begin comment pl;
par(1):=297; par(2):=30; par(3):=235;
par(4):=18; par(5):=10;
end;
if p1mask shift comno<0 then read(in,p1) else
if p2mask shift comno<0 then
begin comment command with one optional or with
more than one parameter;
i:=0;
for i:=i+1 while scan(par(1)) do read(in,par(i));
if comno=6 then tabno:=i-1;
end;
if comno=27 then read(in,p1);
if comno=12 then read(in,p2);
if comno=24 or comno=16 or comno=26 then
begin comment SE and SB;
p1:=32;
for i:=i while p1=32 do readchar(in,p1);
if comno=16 then
begin comment SB;
if p1<49 and p1>57 then read(in,p2)
else
begin comment digit first char after SB;
readchar(in,q1);
if q1=44 then
begin comment terminator, eq. 2 parameters;
read(in,p2)
end
else
begin comment only one parameter;
if q1=sep then
begin comment 1 digit;
p2:=p1-48; p1:=0
end else if q1>47 and q1<58 then
begin comment parameter contains 2 digits;
p2:=10+q1-48; p1:=0; readchar(in,q1)
end else error(<:SB invalide data:>,2);
end only 1 parameter
end digit first;
if p2> (case machine of(13,12,8,6,8)) then error(<:SB invalide data:>,1);
end SB;
end;
if comno<>10 & comno<>12 & comno<>15 & comno<>22 & comno<>23 then
begin comment not FN,RH MT or CM;
repeatchar(in); readchar(in,q2);
if q2<>sep then
begin comment read until separator met;
for i:=i while q2<>sep do readchar(in,q2);
end;
end;
if comno=18 then comno:=17; comment proces QR like CT;
digit(false);
case comno of
begin
begin comment NL,1;
nlpar:=if par(1)>-1 then par(1) else 1;
if prognl then
begin prognl:=false; nlpar:=nlpar-1
end;
q1:=(pagelength-linecount)/leading; if q1<1 then q1:=1;
if nlpar>q1 then nlpar:=q1+1;
if toptext and w=0 then nlpar:=0;
dropjust:=true
end;
begin comment RJ,2;
if mode>3 then calcensp; if mode=1 then goto outtyp;
mode:=1;
setclass(true);
goto if startofline then just else outnonjust
end;
begin comment SJ,3;
if mode>3 then calcensp; if mode=2 then goto outtyp;
q1:=mode; mode:=2;
setclass(false);
if startofline then goto nonjust else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end;
end;
begin comment FT,4;
font:=p1;
codebuf(pc):=false add fontcode(p1);
justpc(1);
if machine=2 then
begin
genstop(true);
if printmode then printfont(font shift 2);
end
else
if printmode then printfont(1)
end;
begin comment NP,5;
newpar:=if par(1)>-1 then par(1)/unit else newpstd;
if prognl then
begin prognl:=false; nlpar:=0
end;
if toptext and w=0 then nlpar:=0;
dropjust:=true
end;
begin comment TA,6;
if mode>3 then calcensp;
q1:=mode; mode:=3;
setclass(false);
if machine=1 then intab(32):=5 shift 12+6;
for i:=1 step 1 until tabno do tabpar(i):=par(i)/unit;
for i:=tabno+1 step 1 until 24 do tabpar(i):=0;
if startofline then goto tabul else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end;
end;
begin comment LM,7;
q1:=p1/unit;
q2:=linewidth-q1+margin;
if q2<0 then error(<:left margin:>,2);
if startofline and -,mtext then
begin linewidth:=q2; margin:=q1
end
else smargin:=q1
end;
begin comment LW,8;
q1:=p1/unit;
if startofline then
begin
linewidth:=q1-margin;
if linewidth<0 then error(<:left margin:>,2)
end
else swidth:=q1
end;
begin comment FG,9;
q1:=p1/point;
if pagelength-linecount>=q1 & figur then
begin comment room for figure on actual page;
q2:=q1/leading; comment no of NL;
if startofline then outnl(if prognl then q2-2 else q2-1) else figsize:=q2-1;
dropjust:=true; prognl:=false;
end
else
begin comment not room for figur on actual page,
save information;
figroom:=figroom+q1; figur:=false
end
end;
begin comment FN,10;
fnoteno:=fnoteno+1; fnfont(fnoteno):=p1;
q1:=0; q2:=fn; fn:=fn-1;
fn1:for fn:=fn+1 while q1<>sep do
begin comment save note in array fnote;
if fn>notelim then error(<:char. in footnotes:>,2);
readchar(in,q1);
fnote(fn):=false add q1
end;
if skipnum(fnote,fn,q1) then goto fn1;
k:=linecount;
linecount:=linecount+(entier((fn-q2)*normw/
(linewidth+margin-notenumw))+1)
*minlead;
if fnoteno>1 ! linecount-k>minlead then shiftlead:=true;
linecount:=linecount+leading;
comment estimated calculation of linespace for the note;
w:=w+1; comment place mark in text;
linebuf(lin):=false add (fnoteno+48); linebuf(lin+1):=false add 41;
pib(w):=lin; pis(w):=lin+1;
lin:=lin+2; startofline:=prognl:=false;
accuw:=accuw+width(49)+width(41)
end;
begin comment SC,11;
genstop(true)
end;
begin comment NS,12;
mtfont:=p1; nlpar:=p2;
q1:=i:=0;
for i:=i+1 while q1<>sep do
begin comment save new section text in margtext;
if i>mtextlim then error(<:char. in new section text:>,2);
readchar(in,q1);
if q1=8 then
begin backspace(margtext,i,false); i:=i-1
end
else
begin
if q1>127 then delim(q1);
margtext(i):=false add q1
end;
end;
margtext(i-1):=false; nstext:=true;
if prognl then
begin prognl:=false; nlpar:=nlpar-1;
end;
if pagelength-linecount-nlpar*leading<2*leading then
begin newpage:=true; chapstart:=upperp;
end;
if toptext and w=0 then nlpar:=0;
dropjust:=true;
end;
begin comment TS,13;
size:=p1; printfont(1);
comment do something if nescesary;
end;
begin comment PS,14;
q2:=if par(2)>-1 then (pagelength-linecount)-par(2)/point
else -1;
if q2<0 then
begin
chapstart:=if par(1)>-1 then par(1)/point else chapstd;
if toppage then comno:=0 else newpage:=dropjust:=true;
end else comno:=0;
end;
begin comment RH,15;
if par(1)>-1 then
begin
i:=0; q1:=0;
rh1:for i:=i+1 while q1<>sep do
begin comment save head in array rhead;
if i>headlim then error(<:char. in running head:>,2);
readchar(in,q1); rhead(i):=false add q1
end;
if skipnum(rhead,i,q1) then goto rh1;
runhead:=true;
pnfont:=rhfont:=par(1)
end
else runhead:=false
end;
begin comment SB,16;
q2:=sstab(p2);
if q2<>0 then
begin comment SS in use, restore class and value for old <char.>;
q1:=q2 extract 7; comment value;
intab(q1):= if q1=45 then (if mode=1 then 6 else 5) shift 12+45
else if q1=95 then (if mode=1 then 4 else 5) shift 12+95
else q2;
end;
if p1>32 or p1=0 then
begin comment <char.> present and not used as SS or no <char.>;
sstab(p2):=if p1>32 then intab(p1) else 0;
if p1>32 then intab(p1):=5 shift 12+p2+14;
end
else if p1>14 then
begin comment <char.> present and in use as SS;
sstab(p2):=sstab(p1-14); sstab(p1-14):=0;
intab(sstab(p2)extract 7):=5 shift 12+p2 +14;
end else error(<:SB invalide data:>,2)
end;
begin comment CT and QR,17 and 18;
if mode=3 and machine=1 then intab(32):=5 shift 12+32;
q1:=mode; mode:=if com extract 7=116 then 4 else 5;
if q1=mode then goto outtyp;
setclass(false);
if startofline then goto (if mode=4 then center else centrh)
else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end;
end;;
begin comment PL,19;
folip:=par(1)/point; upperp:=par(2)/point;
textp:=par(3)/point; headp:=par(4)/point;
nump1:=par(5)/point;
pagelength:=upperp+textp
end;
begin comment PN,20;
nummode:=par(1); pagnum:=par(2)
end;
begin comment LD,21;
leading:=p1;
if machine=1 then
begin
genstop(true); if printmode then printfont(2);
if setmode then
begin write(out,nl,1,<:///leading_:>,<<dd>,p1); where;
end;
end
else
if machine=5 then
begin
leading:=(leading//3)*3;
codebuf(pc):=esc; codebuf(pc+1):=false add 30;
codebuf(pc+2):=false add (entier(leading*2/3)+1);
justpc(3)
end;
end;
begin comment MT,22;
if smtext then error(<:double margin text:>,2);
mtfont:=p1;
q1:=i:=0;
for i:=i+1 while q1<>sep do
begin comment save margin text in array margtext;
if i>mtextlim then error(<:char. in margin text:>,2);
readchar(in,q1);
if q1=8 then
begin backspace(margtext,i,false); i:=i-1
end
else
begin
if q1>127 then delim(q1);
margtext(i):=false add q1
end
end;
margtext(i-1):=false;
if startofline and -,mtext then
begin
setmtext;
toptext:=false
end else
if startofline and mtext then error(<:double margin text:>,2)
else smtext:=true;
end;
begin comment CM,23;
cm1:q1:=0;
for i:=i while q1<>sep do
begin q2:=q1; readchar(in,q1)
end;
if skipnum(rhead,-1,q2) then goto cm1
end;
begin comment SE,24;
intab(sep):=5 shift 12+sep;
intab(p1):=3 shift 12+p1;
sep:=p1
end;
begin comment EF,25;
finis:=dropjust:=true
end;
begin comment DD,26;
intab(specdel):=delin;
if p1<>sep then
begin
delin:=intab(p1);
intab(p1):=5 shift 12 + 128;
specdel:=p1
end else specdel:=delin:=0
end;
begin comment SL,27;
subleading:=(p1//3)*3
end
end case comno;
outtyp:
typol:=if comno=1 ! comno=12 then 1 else if comno=5 then 2 else
if comno=14 ! comno=25 then 3 else if comno=9 & figur then 4 else
if comno=10 then 5 else 6;
end typol;
\f
boolean procedure skipnum(tex,p,q1); integer p,q1; boolean array tex;
comment used to decide if a end separator or start of numerical name is
met when storing (skipping) the <string> parameter in the commands
FN,RH and CM.
A numerical name is recognized if the separator is placed between a new
line character and a digit. This is not a 100 pct. correct solution.
skipnum=true : num. name, skip until term. separator and adjust p.
skipnum=false : end separator, signify end string in array tex.
p=-1 denotes a CM command, p=-2 denotes call from main routine;
begin integer pre;
pre:=if p=-1 then q1 else if p=-2 then 10 else
if p<3 then 0 else tex(p-2) extract 7;
readchar(in,q1);
if q1>47 and q1<58 and pre=10 then
begin
for i:=i while q1<>sep do readchar(in,q1);
q1:=0; if p>-1 then p:=p-2; skipnum:=true
end else
begin repeatchar(in); if p>-1 then tex(p-1):=false; skipnum:=false
end
end skipnum;
procedure printfont(t); value t; integer t;
comment places indication of shift of font or leading in printbuf
and mark in printmask;
begin integer q1,q2;
if w>23 then error(<:number of words in line:>,2);
q1:=printbuf(w) shift (-12);
q2:=if q1>0 & printmask shift w<0 then
(if machine=2 then q1 extract 2+t else
(if q1<>t then 3 else q1)) else t;
printbuf(w):=if printmask shift w<0 then q2 shift 12
+printbuf(w) extract 12 else q2 shift 12;
if printmask shift w>=0 then printmask:=printmask+1 shift (23-w)
end printfont;
procedure printproc(t); value t; integer t;
comment prints information contained in printbuf(t);
begin
write(pr,sp,t extract 12);
if machine=2 and t shift (-14) > 0 then
begin
write(pr,<:<60>:>,<<d>,t shift (-14),<:<62>:>);
t:=(t shift (-12) extract 2) shift 12
end;
if t shift (-12)>0 then write(pr,false add 42,t shift (-12),<:):>)
end printproc;
procedure placenum(numcode); value numcode; integer numcode;
comment write pagenumber according to the parameter numcode
former given in PN-command;
begin integer line,numw,dignum,s,m; boolean left;
if numcode=0 then goto fin;
dignum:=if pagnum<10 then 1 else if pagnum<100 then 2 else 3;
s:=case dignum of (real<<d>,real<<dd>,real<<ddd>);
left:=pagnum mod 2=0; m:=numcode;
line:=margin + linewidth; numw:=dignum * width(49);
q1:= if m=1!m=2 then (line-numw)//2 else
if (m=5!m=4&-,left)&-,runhead!m=3&-,left then line-numw else
if (m=5!m=4&-,left)&runhead then margin+linewidth-accuw-censp-numw else 0;
if q1>0 then outspace(q1,false,-2);
outnum(pagnum,dignum,s);
if m=4&left&runhead then censp:=(line-accuw)//2-numw;
fin:
end placenum;
procedure outnum(p,d,s);value p,d,s;integer p,d; real s;
comment outputs the pagenumber p with d digits, lagout s and font pnfont;
begin integer q1, q2;
if pnfont<>runfont then outfont(pnfont);
if printmode then write(pr,string s,p);
if setmode then
begin
q1:=p//100; q2:=p mod 100//10;
q1:=if q1>0 then q1+48 else 0; q2:=if d>1 then q2+48 else 0;
if up then
begin write(set,lc,1); up:=false end;
write(set,false add konvert(q1),1,false add konvert(q2),1, false add
konvert(p mod 10+48),1);
end;
if pnfont<>font then outfont(font);
end outnum;
procedure backspace(buf,p,norm); value norm; boolean norm; integer p; boolean array buf;
comment processes a composite character: <char1><BS><char2>
or <char1><bs><char2><bs><char3>.
p-1 points in buf on char1.
norm is false when called from proc. typol.
The widest character is placed first.
If the composite character contain an underline or a overline
a common right edge is establiched in case of end of word else
a common left edge;
begin integer q1,q2,q3,we,c1,c2,c3,wc1,wc2,wc3; boolean wordend,three,underover;
boolean procedure readq(tex,t); integer t; boolean array tex;
comment;
begin
qread(tex,t,c2); qread(tex,t,we);
if we=8 then
begin comment 3-double composite char.;
qread(tex,t,c3); qread(tex,t,we);
readq:=true
end else
begin comment 2-double composite char.;
c3:=0; readq:=false
end;
t:=t-1
end readq;
procedure max(c1,c2,c3); integer c1,c2,c3;
comment max changes possible the positions of the call characters
so the widest is placed first and so on;
begin integer i,w1,w2,w3,s1,s2,s3; integer array pos(1:3);
for i:=1,2,3 do pos(i):=i;
w1:=width(c1); w2:=width(c2); w3:=width(c3);
if w1<w2 then
begin pos(1):=2;
if w2<w3 then begin pos(1):=3; pos(3):=1 end
else if w3>w1 then begin pos(2):=3; pos(3):=1 end
else pos(2):=1
end
else if w2<w3 then begin pos(2):=3; pos(3):=2 end;
s1:=c1; s2:=c2; s3:=c3;
c1:=case pos(1) of (s1,s2,s3);
c2:=case pos(2) of (s1,s2,s3);
c3:=case pos(3) of (s1,s2,s3)
end max;
if p>linelim-5 or p>mtextlim-5 then error(<:char. in line:>,2);
c1:=buf(p-1) extract 7; p:=p-1;
if norm then accuw:=accuw-width(c1);
if headmode then three:=readq(rhead,rh) else
if notemode then three:=readq(fnote,fn) else
begin readchar(in,c2); readchar(in,we);
if we=8 then
begin comment 3-double composite char.;
readchar(in,c3); readchar(in,we);
three:=true
end else
begin comment 2-double composite char.;
c3:=0; three:=false
end;
repeatchar(in)
end;
if we=8 then error(<:to much composite char.:>,2);
wordend:=if we=9 or we=10 or we=12 or we=32 or we=sep then true else false;
comment place the widest char. in c1 and the width in wc1;
max(c1,c2,c3);
wc1:=width(c1); wc2:=width(c2); wc3:=width(c3);
if machine=5 then wc1:=wc2:=wc3:=1; comment diablo;
if c2=95 or c2=126 then
begin comment a under- or overline must be first char.;
q1:=c1; q2:=wc1; c1:=c2; wc1:=wc2; c2:=q1; wc2:=q2;
end;
underover:=if c1=95 or c1=126 then true else false;
if wordend and underover then
begin comment terminated an under- or overlined word in a nice way;
for q1:=p step 1 until p+wc1-wc2-1 do buf(q1):=false add 2;
comment iso 2 is used to signify preceding bss used by the
hyph. routine;
p:=p+wc1-wc2;
end;
buf(p):=false add c1; p:=p+1;
for q1:=p step 1 until p+(if wordend and underover then wc2 else wc1)
-1 do buf(q1):=bs;
p:=p+(if wordend then wc2 else wc1);
buf(p):=false add c2;
p:=p+1;
if three then
begin
for q1:=p step 1 until p+wc2-1 do buf(q1):=bs;
p:=p+wc2;
buf(p):=false add c3; p:=p+1
end;
if underover then
begin
if three then
begin
for q1:=p step 1 until p+wc2-wc3-1 do buf(q1):=u1;
p:=p+wc2-wc3
end;
if norm then accuw:=accuw+width(c2);
end else
begin
for q1:=p step 1 until p+wc1-(if three then wc3 else wc2)-1 do
buf(q1):=u1;
p:=p+wc1-(if three then wc3 else wc2);
if norm then accuw:=accuw+width(c1)
end;
back:=true;
end backspace;
boolean procedure scan(p1); value p1; integer p1;
comment character reading via the zone text until a digit or separator is met,
meeting a komma or <NL> the variabel, i, is increased by 1,
terminating on a digit the logical pointer is placed just before the digit,
scan=true: digit or minus met
scan=false: separator met;
begin integer s;
repeatchar(in); readchar(in,s);
if comno=15 & p1<>-1 ! s=sep then
begin scan:=false; goto ud
end;
rep: readchar(in,s);
if s>47 & s<58 ! s=45 then repeatchar(in) else
if s=sep then
begin scan:=false; goto ud
end else
begin
if s=44 then i:=i+1;
goto rep
end;
scan:=true;
ud: end scan;
integer procedure hypcall(wid); integer wid;
comment generates a call of the hyphenation routine hyph
and takes care of placing a eventual hyphen in linebuf,
if hyphenation is successfull wid is assigned the length
in units from the breakpoint to the end of word;
begin integer n1,n2,n3,n4,a,b,i,q1;
n1:=pib(w); n4:=pis(w); linebuf(n4+1):=false;
a:=accuw+(w-1)*maxspace - linewidth + width(45);
b:=accuw+(w-1)*minspace - linewidth + width(45);
i:=pis(w)+1; q1:=0;
for i:=i-1 while q1<=a do q1:= q1+width(linebuf(i) extract 7);
n2:=i+1; if n2<n1 then n2:=n1;
i:=pis(w)+1; q1:=0;
for i:=i-1 while q1<b do q1:=q1 + width(linebuf(i) extract 7);
n3:=i+1; if n3<n1 then n3:=n1; if hypmode<3 then setposition(c,0,0);
hypcall:=q1:=hyph(linebuf,n1,n2,n3,n4);
if hypmode<3 then setposition(c,0,0);
if q1<>0 then
begin comment calculate wid;
q1:=abs q1+1; wid:=0;
for i:=q1 step 1 until pis(w) do wid:=wid + width(linebuf(i) extract 7)
end
else wid:=0
end hypcall;
procedure genstop(m); value m; boolean m;
comment m=true: place a stopcode in codebuf
m=false : output a stopcode if setmode;
begin
if m then
begin codebuf(pc):=stop; justpc(1)
end
else if setmode then
begin
if up then write(set,lc,1); up:=false;
write(set,stop,1)
end
end;
procedure justpc(t); value t; integer t;
comment adjust pc and pco after putting t characters in codebuf;
begin
if w>23 then error(<:number of words in line:>,2);
pc:=pc+t;
pco(w):=if codemode then pco(w)+t else t;
if -,codemode then
begin codemask:=codemask+1 shift (23-w); codemode:=true
end
end just pc;
procedure outspace(un,m,p); value un,m,p; integer un,p; boolean m;
comment shares un units in a minimum number of space characters,
if m=true the characters are placed in codebuf (printbuf),
if m=false the characters are outputted via the zone set(pr),
if p>-1 & ulinemask shift p<0 the spaces are underlined (only set.mach.),
if p=-1 only output for setting machine if setmode,
if p=-2 output for setting machine and printer;
begin integer i,a1,a2,a3,q1; boolean b;
if un<=0 then goto esp;
if setmode then
begin
q1:=if machine>1 then (if machine=5 then 3 else 2) else 1;
case q1 of
begin
begin comment justotext 70;
if p>-1 & ulinemask shift p<0 then
begin comment output underlined space;
q1:=width(95);
write(set,uc,1,false add 40,un//q1+1,lc,1,bss,q1-un mod q1)
end
else
begin comment normal space;
a3:=un//3; q1:=un mod 3;
a2:=if q1=2 then 1 else 0; a1:=if q1=1 then 1 else 0;
if a2>0 then
begin if m then codebuf(pc):=sp2 else write(set,sp2,1)
end
else if a1>0 then
begin if m then codebuf(pc):=sp1 else write(set,sp1,1)
end;
if m then q1:=if a1>0 ! a2>0 then pc+1 else pc;
if a3>0 then
begin if m then
begin
codebuf(q1):=uc; codebuf(q1+a3+1):=lc;
for i:=q1+1 step 1 until q1+a3 do codebuf(i):=sp3
end
else write(set,uc,1,sp3,a3,lc,1)
end;
if m then justpc(a1+a2+(if a3>0 then a3+2 else 0))
end
end;
begin comment Flexowriter;
if p>-1 & ulinemask shift p<0 then
begin
if up then
begin write(set,lc,1); up:=false end;
b:=machine=2 and runfont=1;
q1:=konvert(95);
for i:=1 step 1 until un do
write(set,false add q1,1,if b then sps else false,1)
end
else if m then
begin for i:=pc step 1 until pc+un-1 do codebuf (i):=sps;
justpc(un)
end
else write(set,sps,un)
end;
begin comment diablo;
if p>-1 and ulinemask shift p<0 then
begin
a1:=un//normsp; a2:=un mod normsp;
write(set,false add 95,a1);
if a2>0 then write(set,false add 95,1,esc,1,etx,1,
bss,normsp-a2,esc,1,eot,1)
end
else
begin
a1:=un//normsp; a2:=un mod normsp;
if a2>0 then
begin
if m then
begin
codebuf(pc):=codebuf(pc+4):=esc;
codebuf(pc+1):=codebuf(pc+5):=false add 31;
codebuf(pc+3):=sps;
codebuf(pc+6):=false add 13;
codebuf(pc+2):=false add (a2*2+1)
end
else
write(set,<:<27><31>:>,false add (a2*2+1),1,<: <27><31><13>:>);
end;
if m then q1:=if a2>0 then pc+7 else pc;
if a1>0 then
begin
if m then
begin
for i:=q1 step 1 until q1+a1-1 do
codebuf(i):=sps
end
else write(set,sps,a1)
end;
if m then justpc(a1+(if a2>0 then 7 else 0))
end
end
end case;
end setmode;
if p=-2 & printmode then
begin comment output for printer;
q1:=un/normw; q1:=if q1=0 then 1 else q1;
if m then
begin printbuf(w):=if printmask shift w<0 then printbuf(w)+q1 else q1;
if printmask shift w>=0 then printmask:=printmask+1 shift (23-w)
end
else write(pr,sp,q1)
end
;esp:
end outspace;
procedure outfont(f); value f; integer f;
comment generates output via zone set according to font no. f;
begin
if setmode then
begin
if machine=2 then
begin
<* change(f); *> write(set,stop,1)
end
else
write(set,false add fontcode(f),1)
end;
runfont:=f;
if printmode then
begin
if machine=2 then write(pr,<:<60>:>,<<d>,f,<:<62>:>)
else write(pr,<:*):>)
end
end outfont;
<*
procedure change(fo); value fo; integer fo;
begin integer i,p;
write(out,nl,1,<:///font :>,<<d>,fo); where;
if fo=1 then
begin
for i:=1 step 1 until 10 do
begin
p:=case i of(40,41,44,46,48,52,53,55,56,57);
konvert(p):=case i of
(8+a,25+a,59,107,32,4,21,7,8,25)
end;
for i:=1 step 1 until 29 do
begin
p:=case i of
(97,98,115,100,117,118,103,104,121,81,82,67,84,69,
70,87,88,73,50,35,52,37,38,55,56,41,112,91,13);
konvert(64+i):=p+a; konvert(96+i):=p;
konvert(34):=130
end;
end fo=1
else if fo>1 and runfont=1 then
begin
for i:=1 step 1 until 10 do
begin
p:=case i of(40,41,44,46,48,52,53,55,56,57);
konvert(p):=case i of
(7+a,14+a,103,82,25,8,4,21,7,14)
end;
for i:=1 step 1 until 29 do
begin
p:=case i of (87,59,55,37,52,115,97,41,70,
112,38,56,81,50,88,100,118,69,73,13,35,
67,91,49,121,32,84,98,104);
konvert(64+i):=p+a;
konvert(96+i):=p
end;
konvert(34):=2+a
end bogstav og tal;
for i:=1 step 1 until 12 do
begin
p:=case i of(35,36,37,38,39,43,45,47,58,63,95,126);
konvert(p):=
if fo=1 then (case i of (130,130,130,32+a,59+a,64+a,
64,19+a,107+a,130,14,130))
else if fo=5 then (case i of (130,130,4+a,22+a,21+a,
117+a,64,107,19+a,107+a,25+a,130))
else if fo=7 then (case i of (21+a,4+a,130,64+a,103+a,19+a,
107,25+a,82+a,8+a,107+a,130))
else case i of (21+a,1+a,19+a,22+a,103+a,64+a,107,25+a,
82+a,8+a,107+a,64)
end;
for i:=1 step 1 until 10 do
begin
p:=case i of(33,42,49,59,60,61,62,64,94,96);
konvert(p):=case i of (
(case fo of (1+a,130,130,130,1+a,130,64)),
(case fo of (2+a,130,117+a,130,8+a,130,130)),
(case fo of (1,56,1,1,1,56,1)),
(case fo of (21+a,130,130,130,117,130,117)),
(case fo of (49,130,130,130,103+a,130,117+a)),
(case fo of (4+a,1,117,4+a,64+a,1,1+a)),
(case fo of (49+a,130 ,130,130,82+a,130,130)),
(case fo of (130,4+a,4+a,130,130,4+a,130)),
(case fo of (130,117,130,117,130,117,117)),
(case fo of (130,117+a,130,117+a,130,117+a,130)))
end
end change;
*>
procedure outtext(s); string s;
begin
write(out,nl,1,s); if outcon then setposition(out,0,0)
end outtext;
procedure settext(p); value p; integer p;
comment outputs a textunit placed in linebuf(pib(p):pis(p))
via zone set konverted to the actual typesetting code;
begin integer i,v,u,q1,q2,t,lf,u1;
for i:=pib(p) step 1 until pis(p) do
begin
u:=linebuf(i) extract 12;
if u>127 then
begin
u1:=u shift (-7); u:=u extract 7
end else u1:=0;
if blind then begin if u<>32 then blind:=false end;
v:=konvert(u);
if machine=2 and v>128 then
begin
write(out,nl,1,<:***char :>,<<d>,u); where;
v:=11
end;
comment only if different char. in the 2 fonts;
q1:=if v shift 1 < 0 then (if v shift 2<0 then 2 else 1) else 0;
if q1>0 & runfont<>q1 then write(set,stop,1);
lf:=2*entier(subleading*2/3)+1;
if u1>0 and machine=5 then
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add (if u1=1 then 68 else 85),1);
if u=30 and machine=5 then
begin
t:=linecount-subleading;
if t>=0 then
begin
linecount:=t;
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add 68,1,esc,1,false add 30,1,
false add (entier(leading*2/3)+1),1)
end
end else
if u=31 and machine=5 then
begin
t:=linecount+subleading;
if t<=pagelength or notemode then
begin
linecount:=t;
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add 85,1,
esc,1,false add 30,1,false add (entier(leading*2/3)+1),1)
end
end else
if u=59 & machine=1 then write(set,false add konvert(44),1,
bss,2,uc,1,false add konvert(58),1,lc,1) else
begin
if up and v>=0 then
begin write(set,lc,1); up:=false end
else if v<0 and -,up then
begin write(set,uc,1); up:=true end;
write(set,false add v,1)
end;
if u1>0 and machine=5 then
begin
write(set,esc,1,false add (if u1=1 then 85 else 68),1);
write(set,esc,1,false add 30,1,false add (entier(leading*2/3)+1),1)
end;
if v extract 7=14 then
begin if (machine=2 or machine=3 ) and linebuf(i+1) extract 7<>bs extract 7
then write(set,sps,1)
end;
comment only if different char. in the 2 fonts;
if q1>0 & runfont<>q1 then write(set,stop,1);
end
end settext;
procedure setmtext;
begin comment set margin text and fill up with spaces to
the actual left margin;
integer i,v,u,q1,oldfont,q2,q3,u1,lf,t;
i:=q1:=0; oldfont:=runfont; v:=-1;
if mtfont<>runfont then outfont(mtfont);
for i:=i+1 while v<>0 do
begin
v:=margtext(i) extract 7;
q1:=q1+width(v);
if q1>margin and -,nstext then
begin outspace(margin-q1+width(v),false,-2);
goto errmarg
end
else if q1>linewidth and nstext then error(<:linewidth exceeded:>,1);
if setmode then
begin
v:=margtext(i) extract 12;
if v>127 then
begin
u1:=v shift (-7); v:=v extract 7;
end else u1:=0;
u:=konvert(v);
if machine=2 and u>128 then
begin
write(out,nl,1,<:***char :>,<<d>,v); where;
u:=11
end
comment only if different char. in the 2 fonts;
q2:=if u shift 1<0 then (if u shift 2<0 then 2 else 1) else 0;
if q2>0 and runfont<>q2 then write(set,stop,1);
lf:=2*entier(subleading*2/3)+1;
if u1>0 and machine=5 then
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add (if u1=1 then 68 else 85),1);
if v=30 and machine=5 then
begin
t:=linecount-subleading;
if t>=0 then
begin
linecount:=t;
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add 68,1,esc,1,false add 30,1,
false add (entier(leading*2/3)+1),1)
end
end else
if v=31 and machine=5 then
begin
t:=linecount+subleading;
if t<=pagelength then
begin
linecount:=t;
write(set,esc,1,false add 30,1,false add lf,1,
esc,1,false add 85,1,esc,1,
false add 30,1,
false add (entier(leading*2/3)+1),1)
end
end else
begin
if up and u>=0 then
begin write(set,lc,1); up:=false end
else if u<0 and -,up then
begin write(set,uc,1); up:=true end;
end;
write(set,false add u,1);
if u1>0 and machine=5 then
write(set,esc,1,false add (if u1=1 then 85 else 68),1,
esc,1,false add 30,1,false add (entier(leading*2/3)+1),1);
if q2>0 and runfont<>q2 then write(set,stop,1);
end;
if (u extract 7=14) and setmode then
begin if (machine=2 or machine=3) and margtext(i+1) extract 7
<> bs extract 7 then write(set,sps,1);
end;
if printmode then
begin
v:=margtext(i) extract 12;
if v>14 and v<30 then write(pr,false add 42,1,<<d>,v-14)
else if v=30 then
write(pr,false add specdel,1,false add 117,1)
else if v=31 then
write(pr,false add specdel,1,false add 100,1)
else if v>127 then
write(pr,false add specdel,1,
false add (if v<256 then 104 else 108),1,
false add (v extract 7),1)
else write(pr,false add v,1)
end
end;
if nstext then goto resetfont;
outspace(margin-q1,false ,-2);
errmarg:
if margin-q1<0 then error(<:width of margin text:>,1);
resetfont:
if mtfont<>oldfont then outfont(oldfont);
if nstext then nstext:=false else mtext:=true;
end setmtext;
procedure outcode(p); value p; integer p;
comment outputs code placed in codebuf(pc:pc+pco(p)-1) via zone set;
begin integer i,t,q2;
t:=pc+pco(p)-1;
for i:=pc step 1 until t do
begin comment special for justotext 70;
q1:=codebuf(i) extract 7 -31;
q2:=q1+31;
if machine=1 & (q1=1!q1=2) then runfont:=q1;
if machine=2 and q2>0 and q2<8 then
begin
<* change(q2); *> runfont:=q2;
end
else
write(set,codebuf(i),1)
end;
pc:=t+1
end outcode;
procedure outnl(n); value n; integer n;
comment outputs n <NL> characters and adjust linecount;
begin integer p;
if leading>18 and machine<>1 and machine<>5 then
p:=leading//stdlead*n else p:=n;
if setmode then write(set,nls,p);
if printmode then
begin
if machine=5 then p:=leading//stdlead*n;
if p=0 then p:=1;
write(pr,nl,p)
end;
if -,notemode&n>0 then linecount:=linecount+n*leading
end outnl;
integer procedure qread(tex,p,v);
boolean array tex; integer p,v;
comment reads next character into v from tex and increase the pointer p
by 1,
qread is assigned the class of v defined as the
actual content of intab,
v=0 indicates end of string;
begin
v:=tex(p) extract 12; p:=p+1;
qread:=if (v>15 and v<32) or v>127 then 5 else
intab(v) shift (-12) extract 4;
if v=0 then
begin if first & linewidth-accuw-(w-1)*normsp>=0 then dropjust:=true else
if first & linewidth-accuw-(w-1)*minspace<0 then
begin v:=-1; p:=p-1
end;
word:=more:=false
end;
end qread;
procedure delim(v); integer v;
begin integer p,p1,q;
integer procedure rd(t); integer t;
rd:=if headmode then qread(rhead,rh,t) else
if notemode then qread(fnote,fn,t) else readchar(in,t);
if v shift (-7) extract 1 = 1 then
begin comment special delimiter, must by followed
by u,d,h or l
return value for v
after return value
u 30 (half LF up)
d 31 (half LF down)
h<c> c+128 (half LF up <c> half LF down)
l<c> c+256 (half LF down <c> half LF up)
;
rd(p);
if p=117 then v:=30 else
if p=100 then v:=31 else
if p=104 or p=108 then
begin
q:=rd(p1);
if q<4 or q>6 or p1>127 then
begin v:=63;
error(<:invalid char:>,1);
end else
v:=(if p=104 then 128 else 256)+p1
end
else
begin
v:=63;
error(<:invalide char:>,1)
end;
end
end delim;
procedure notsep(s); label s;
comment used in notemode and headmode when separator
is changed between the command FN or RH and the setting;
begin
klass:=5; goto s
end notsep;
procedure calcensp;
comment calculates censp as the spacewidth in units to be
generated to get the textline centered or quadded right;
begin
if accuw>0 then
begin
censp:=if mode=4!headmode then (linewidth+(if headmode then margin else 0)-accuw)//2
else linewidth-accuw;
if censp<0 then censp:=0;
end
else censp:=0
end calcensp;
procedure setclass(just); value just; boolean just;
comment just=true : set input classes as in just. mode
just=false :set input classes as in nonjust,tabul, centr. and quadding right mode;
begin integer i;
if just then
begin
intab(32):=2 shift 12+32; if intab(95) extract 7=95 then intab(95):=4 shift 12+95;
if intab(45) extract 7=45 then intab(45):=6 shift 12+45; intab(9):=0;
end else
begin
intab(32):=5 shift 12+32;
for i:=45,95 do if intab(i) extract 7=i then intab(i):=5 shift 12+i;
if mode=3 then intab(9):=6 shift 12+9 else intab(9):=0;
end;
end setclass;
\f
comment start program;
begin integer q,i;
procedure connect(z,name,exist); value exist;
zone z; array name; boolean exist;
begin integer array zdes(1:20),tail(1:10);
integer m;
q:=1; open(z,4,string name(increase(q)),0);
getzone6(z,zdes); zdes(13):=0; setzone6(z,zdes);
if exist then
begin m:=27;
q:=3; if monitor(42,z,0,tail)<>0 then goto L
end else m:=28;
q:=1 shift 1 + 1;
fpproc(m,q,z,name);
if q<>0 then
begin
L: i:=1; write(out,<:***compose end. connect :>,
string name(increase(i)),<:, :>,<<d>,q,nl,1);
fpproc(7,0,0,3)
end;
getzone6(z,zdes); zdes(10):=0; zdes(13):=0;
if exist then
begin
zdes(14):=zdes(15):=zdes(19);
zdes(16):=0;
end;
setzone6(z,zdes);
end;
test:=time:=false;
nl:=false add 10; sp:=false add 32;
ff:=false add 12; bs:=false add 5;
if printmode then connect(pr,prooffile,false);
if setmode then connect(set,objfile,false);
if hypmode=1 or hypmode=3 then
connect(hyphinf,hyphfile,hypmode=3);
if hypmode<3 then open(c,8,<:terminal:>,0);
if sourcefile(1)<>real<::> then
begin
fpproc(29,0,in,0);
fpproc(27,q,in,sourcefile);
if q<>0 then
begin
i:=1; write(out,<:***compose end. connect :>,
string sourcefile(increase(i)),<:, :>,
<<d>,q,nl,1);
fpproc(7,0,0,3);
end;
end;
if test then
begin
write(out,
<:<10>machine :>,machine,
<:<10>language :>,language,
<:<10>setmode :>,if setmode then <:yes:> else <:no:>,
<:<10>printmode :>,if printmode then <:yes:> else <:no:>,
<:<10>hypmode :>,hypmode);
outchar(out,10);
test:=false;
setposition(out,0,0)
end;
end;
write(out,<:compose begin. :>); systime(1,0,ra(1));
write(out,<< zd dd dd>,systime(2,ra(1),ra(2)),ra(2));
setposition(out,0,0);
comment initialize tables and variables dependent of machine;
a:=1 shift 23; b:=1 shift 22; d:=b+1 shift 21;
comment the bit positions contained in a,b and d in table konvert
have the following meaning:
a: upper case character
b: only existing in font no. 1
d: only existing in font no. 2;
leading:=stdlead:=12;
q1:=if machine=3 then 2 else machine;
case q1 of
begin
begin comment Justotext 70;
for i:=0 step 1 until 127 do
begin
konvert(i):= case i+1 of (
0,8,49,32,33,49,8+a,0,0,41,37,0,35,0,0,2,57,40+a,48+a,45,
57+a,45+a,50+a,38+a,46,46+a,8,8+a,0,0,0,0,4,34+a,57,60+a,60+a,50+a,58+a,2+a,
27+a,31+a,60+a,56+a,38,40,34,54+a,31,42,60,56,52,50,54,58,48,27,52+a,2+a,
57,42+a,57+a,38+a,60+a,24+a,19+a,14+a,18+a,16+a,
22+a,11+a,5+a,12+a,26+a,30+a,9+a,7+a,6+a,3+a,
13+a,29+a,10+a,20+a,1+a,28+a,15+a,25+a,23+a,21+a,
17+a,36+a,44+a,46+a,45+a,40+a,45,24,19,14,
18,16,22,11,5,12,26,30,9,7,6,3,13,29,10,20,1,28,15,25,
23,21,17,36,44,46,60+a,63);
width(i):= case i+1 of (
0,1,-1,0,0,-1,3,0,-1,0,0,0,0,0,0,0,3,5,2,0,
3,0,4,3,3,4,1,3,0,0,0,0,2,2,3,3,3,4,4,0,
2,2,4,3,2,3,2,3,3,3,3,3,3,3,3,3,3,3,2,2,
3,3,3,3,3,4,4,4,4,4,4,4,4,2,3,4,4,5,4,4,
4,4,4,3,4,4,4,5,4,4,4,5,4,4,0,5,0,3,3,3,
3,3,2,3,3,2,2,3,2,5,3,3,3,3,3,3,2,3,3,4,
3,3,3,4,3,3,3,0);
end i;
unit:=0.53107; comment dependent of type size;
nls:=false add 37; bss:=false add 49; sps:=sp2:=false add 4;
sp1:=false add 8; sp3:=false add 8; u1:=false add 1;
lc:=false add 47; uc:=false add 39;
normsp:=2; normw:=2.7;
fontcode(1):=32; fontcode(2):=33;
minlead:=10;
stop:=false add 35;
minspace:=1; maxspace:=5; maxfactor:=0.50; minfactor:=1.5;
end Justotext 70;
begin comment Flexowriter;
for i:=0 step 1 until 127 do
konvert(i):= case i+1 of (
0,0,0,0,0,0,0,0,0,62,128,0,11,0,0,
22+a+b,7+a+b,14+a+b,13+b,13+a+b,
16,103+a+d,19+a+d,22+a+d,8+a+d,2+a+d,117+d,
0,0,0,0,0,16,1+a,130,130,130,130,32+a,59+a,
8+a,25+a,2+a,64+a,59,64,107,19+a,32,1,2,19,4,21,22,7,8,25,107+a,21+a,
49,4+a,49+a,130,130,97+a,98+a,115+a,100+a,117+a,
118+a,103+a,104+a,121+a,
81+a,82+a,67+a,84+a,69+a,70+a,
87+a,88+a,73+a,50+a,35+a,52+a,37+a,38+a,55+a,56+a,
41+a,112+a,91+a,13+a,130,14,130,97,98,115,
100,117,118,103,104,121,81,82,67,84,69,70,87,88,73,50,35,52,37,38,
55,56,41,112,91,13,130,127);
for i:=0 step 1 until 14,27 step 1 until 31,127 do width(i):=0;
width(8):=width(5):=-1;
for i:=32 step 1 until 126,15,16,17,18,19,20 ,21,
22,23,24,25,26 do width(i):=1;
unit:=if machine=2 then 2.5435 else 2.1139;
sp1:=sp2:=sp3:=u1:=false;
nls:=false add 128; sps:=false add 16;
lc:=false add 122; uc:=false add 124;
for i:=1,2,3,4,5,6,7 do fontcode(i):=i;
normsp:=1;
normw:=1;
minlead:=12;
stop:=false add 11;
minspace:=1; maxspace:=2; maxfactor:=0.67; minfactor:=1.0;
end Flexowriter;;
begin comment RC 610 Line Printer;
for i:=0 step 1 until 127 do konvert(i):=i;
for i:=15 step 1 until 20 do
konvert(i):=case i-14 of (37,63,34,125,93,32);
for i:=15 step 1 until 20,32 step 1 until 126 do width(i):=1;
for i:=0 step 1 until 14,21 step 1 until 31,127 do width(i):=0;
konvert(5):=8;
width(5):=width(8):=-1;
unit:=2.5429;
lc:=uc:=sp1:=sp2:=sp3:=u1:=false;
nls:=false add 10; sps:=false add 32;
normsp:=1; fontcode(1):=fontcode(2):=127;
stop:=false add 127; normw:=1.0;
minlead:=12;
minspace:=1; maxspace:=2; maxfactor:=0.67; minfactor:=1.0;
end Line Printer;
begin comment diablo;
for i:=0 step 1 until 14,21 step 1 until 31,127 do
konvert(i):=width(i):=0 ;
for i:=32 step 1 until 126 do konvert(i):=i;
for i:=15 step 1 until 22 do
konvert(i):=case i-14 of(35,36,37,38,64,32,94,126);
konvert(5):=konvert(2):=8; konvert(10):=10;
for i:=15 step 1 until 22,32 step 1 until 126 do
width(i):=6;
width(5):=width(2):=-6;
unit:=0.4233;
lc:=uc:=false;
nls:=false add 10; sps:=false add 32;
normsp:=6; normw:=6;
minlead:=12; minspace:=3; maxspace:=10;
minfactor:=1.3; maxfactor:=0.6;
fontcode(1):=fontcode(2):=127;
bss:=false add 8; etx:=false add 51;
esc:=false add 27;
eot:=false add 52; stop:=false;
end diablo
end case machine;
comment initialize variables independent of machine;
begin
integer procedure q(s); string s;
q:=real s shift (-32) extract 16;
for i:=1 step 1 until 27 do comtab(i):=case i of (
q(<:nl:>),q(<:rj:>),q(<:sj:>),q(<:ft:>),q(<:np:>),q(<:ta:>),
q(<:lm:>),q(<:lw:>),q(<:fg:>),q(<:fn:>),q(<:sc:>),q(<:ns:>),
q(<:ts:>),q(<:ps:>),q(<:rh:>),q(<:sb:>),q(<:ct:>),q(<:qr:>),q(<:pl:>),
q(<:pn:>),q(<:ld:>),q(<:mt:>),q(<:cm:>),q(<:se:>),q(<:ef:>),
q(<:ds:>),q(<:sl:>));
end;
typlim:=27;
specdel:=delin:=0; subleading:=6;
for i:=0 step 1 until 31,127 do intab(i):=i; intab(25):=8 shift 12+25;
for i:=10,12,32 do intab(i):=2 shift 12+i;
intab(8):=7 shift 12+8;
for i:=33 step 1 until 126 do intab(i):=5 shift 12+i;
intab(95):=4 shift 12+95; intab(45):=6 shift 12+45;
tableindex:=0; intable(intab);
for i:=1 step 1 until 18 do sstab(i):=0;
compinit:=startofword:=figur:=toptext:=true;
runhead:=finis:=headmode:=notemode:=saveword:=
hypdigit:=savecode:=hyp:=spamax:=progpage:=back:=false;
toppage:=false;
point:=0.3532;
comment A4-format;
folip:=297/point; upperp:=30/point; textp:=235/point;
headp:=18/point; nump1:=10/point; pagelength:=textp+upperp;
chapstart:=chapstd:=50/point;
margin:=newpar:=0; linewidth:=140/unit;
newpstd:=5/unit; notenumw:=width(49)+width(41)+2*normsp;
pagnum:=lineno:=nlpar:=1; nummode:=5;
font:=pnfont:=runfont:=fn:=lineno:=nlpar:=1;
size:=1; comment dummy in this implementation;
mode:=1; sep:=42; intab(42):=3 shift 12+42;
p1mask:=1 shift 19+1 shift 16+1 shift 15+1 shift 14+1 shift 13+1 shift 11+
1 shift 10+ 1 shift 2+ 1 shift 1;
comment FT LM LW FG FN NS TS LD MT;
p2mask:=1 shift 22+1 shift 18+1 shift 17+1 shift 9+1 shift 8+
1 shift 4+1 shift 3;
comment NL NP TA PS RH PL PN;
figroom:=linecount:=figsize:=fnoteno:=censp:=0;
smargin:=swidth:=-1;
newpage:=ssaveword:=ssavecode:=smtext:=mtext:=nstext:=prognl:=false;
if printmode then write(pr,ff,1);
ra(1):=systime(1,0,ra(2)); blocksread:=0;
up:=false;
if setmode and machine=2 then write(set,lc,1);
goto lineinit;\f
pageshift:
if compinit then
begin compinit:=false; goto firstpage
end;
ssaveword:=ssavecode:=false;
if saveword then
begin comment save information about word to be transferred
to next page;
ssaveword:=true; saveword:=false;
if h2-h1>wordlim then error(<:char. in word:>,2);
shyp:=hyp; sh1:=h1; sh2:=h2; sh3:=h3;
for i:=0 step 1 until h2-h1 do swordbuf(i):=linebuf(i+h1);
end;
if savecode then
begin comment save information about code to be transferred
to next page;
ssavecode:=true; savecode:=false;
sc1:=c1; sc2:=c2
end;
if fnoteno=0 then goto pagenumb;
comment write footnotes in justifying mode;
if newpage ! finis then outnl((pagelength-linecount)/leading);
comment if pageshift because of PG or EF then lead to bottom;
outnl(1);
if mode<>1 then setclass(true);
savelead:=leading;
if leading<>minlead & shiftlead then
begin comment use minleading for footnotes;
leading:=minlead;
if machine=1 then
begin genstop(false);
if setmode then
begin write(out,nl,1,<:///leading :>,<<dd>,minlead); where;
end;
end
else if machine=5 then
write(set,esc,1,false add 30,1,false add (entier(leading*2/3)+1),1);
end;
savemode:=mode; mode:=1; notemode:=true;
savemarg:=margin; savell:=linewidth;
linewidth:=linewidth+margin; margin:=0;
oldfont:=notefont:=runfont;
fcount:=0; fn:=1;
outnote:
fcount:=fcount+1; accuw:=0;
if fcount>maxnotelim then error(<:number of footnotes:>,2);
if fcount<=fnoteno then
begin comment more footnotes;
q1:=fnfont(fcount);
if q1<> notefont then
begin comment change font;
outfont(q1); notefont:=q1
end;
if up then
begin write(set,lc,1); up:=false end;
if setmode then write(set,false add konvert(fcount+48),1,uc,1,
false add konvert(41),1,lc,1,sps,2);
if printmode then write(pr,<<d>, fcount,<:)__:>);
accuw:=accuw+notenumw;
goto notestart
end
else
begin comment restore variables;
if savemode <>1 then setclass(false);
if leading<>savelead then
begin leading:=savelead;
if machine=1 then
begin genstop(false);
if setmode then
begin write(out,nl,1,<:///leading :>,<<dd>,leading); where
end;
end
else if machine=5 and setmode then
write(set,esc,1,false add 30,1,false add (entier(leading*2/3)+1),1);
end;
margin:=savemarg; mode:=savemode; fnoteno:=0;
linewidth:=savell; notemode:=false;
if notefont<>oldfont then outfont(oldfont)
end;
pagenumb:
bool1:=printmode;
if nummode=1 ! nummode=3 then
begin comment place pagenumber at pagebottom;
outnl((folip-linecount-nump1)/leading);
placenum(nummode); printmode:=false;
if machine<>4 then outnl(nump1/leading)
end
else
begin printmode:=false;
if machine<>4 then outnl((folip-linecount)/leading);
end;
printmode :=bool1;
pagnum:=pagnum+1;
if printmode then write(pr,ff,1);
comment position is now on page limit;
firstpage:
q1:=if machine=3 then 2 else machine;
if setmode then
begin
case q1 of
begin
write(set,false add 34,25);
begin
write(out,nl,1,<:///top of page :>,<<ddd>,pagnum,nl,1);
if up then write(set,lc,1); up:=false;
write(set,false add 139,1,false,60);
end;;
write(set,ff,1);
write(set,false add 139,1,<:<27><30>:>,false add (entier(leading*2/3)+1),1)
end;
end;
if finis then goto exit;
linecount:=0;
fnoteno:=0; fn:=nlpar:=1; shiftlead:=false; lineno:=1;
if nummode=2 then
begin comment pagenumber centered on pagestop;
outnl(nump1/leading); lineno:=2;
placenum(nummode); outnl((headp-nump1)/leading)
end
else outnl(headp/leading);
if (nummode=4 ! nummode=5) & -,runhead then
begin comment pagenumber to left or right and no head;
placenum(nummode); outnl((upperp-headp)/leading); lineno:=2
end
else if runhead then
begin comment running head;
if mode=1 then setclass(false);
headmode:=line1:=true; rh:=1;
savelead:=leading;
if leading<>stdlead and machine>1 then
begin
leading:=stdlead;
if machine=5 and setmode then
write(set,esc,1,false add 30 ,1,false add (entier(leading*2/3)+1),1)
end;
goto lineinit;
headlab:
headmode:=false; if font<>runfont then outfont(font);
if savelead<>leading then
begin
leading:=savelead;
if machine=5 and setmode then
write(set,esc,1,false add 30,1,false add (entier(leading*2/3)+1),1)
end;
if mode=1 then setclass(true);
outnl((upperp-linecount)/leading)
end
else outnl((upperp-headp)/leading);
comment position is now on first normal line;
if newpage then
begin comment PG;
outnl((chapstart-upperp)/leading); newpage:=false
end;
if figroom>0 then
begin comment figure(s) saved from previous page;
q1:=pagelength-linecount;
if figroom<=q1 then
begin outnl(figroom/leading);
figur:=true; figroom:=0
end
else
begin outnl(q1/leading+1);
figroom:=figroom-q1
end
end;
if ssaveword then
begin comment restore inf. about word to be saved;
saveword:=true;
hyp:=shyp; h1:=sh1; h2:=sh2; h3:=sh3;
for i:=0 step 1 until h2-h1 do linebuf(h1+i):=swordbuf(i);
end;
if ssavecode then
begin comment restore inf. about code to be saved;
savecode :=true; c1:=sc1; c2:=sc2;
end;
toptext:=true;
if progpage then
begin progpage:=false; toppage:=true;
end;
\f
lineinit:
if smtext then
begin comment margin text in the following line;
setmtext; smtext:=toptext:=false
end;
if smargin>-1 then
begin
linewidth:=(if swidth>-1 then swidth else linewidth)-smargin+margin;
if linewidth<0 then error(<:left margin:>,2);
margin:=smargin; smargin:=-1
end;
if swidth>-1 then
begin
linewidth:=swidth-margin;
if linewidth<0 then error(<:left margin:>,2);
swidth:=-1
end;
if figsize>0 then
begin outnl(figsize); figsize:=0
end;
accuw:=0;
if notemode then
begin outspace(notenumw,false,-2); accuw:=notenumw
end;
notestart:
w:=0; comment initialize pointer etc;
q1:=nlpar;
lin:=pc:=nlpar:=1; first:=startofline:=true;
codemask:=printmask:=0;
more:=true;
codemode:=dropjust:=false;
if notemode then goto just; comment footnotes;
if headmode then goto centrh;
if nstext then
begin comment set new section text;
if margin>0 and q1>0 then outspace(margin,false,-2);
comment only if <linefeed> in NS command>0;
setmtext; toptext:=false; outnl(1)
end;
if linecount>=pagelength then
begin progpage:=true; goto pageshift
end;
if newpar>0 then
begin comment new paragraph;
outspace(newpar,false,-2); accuw:=newpar; newpar:=0;
end;
goto case mode of (just,nonjust,tabul,center,centrh);
just:
if saveword then
begin comment word or part of word from previous line;
if hyp then
begin comment hyphenation in previous line;
linebuf(1):=false add h3; accuw:=accuw+width(h3);
i:=2; q1:=h2-h1+2;
end
else
begin i:=1; q1:=h2-h1+1
end;
j:=0;
for i:=i step 1 until q1 do
begin linebuf(i):=linebuf(h1+j); j:=j+1;
accuw:=accuw+width(linebuf(i) extract 7)
end;
w:=1; pib(w):=1; pis(w):=q1;
lin:=pis(w)+1; hyp:=false;
if ulinemask<0 then
begin comment word followed by a underline was saved;
ulinemask:=1 shift 22
end else ulinemask:=0;
toppage:=startofline:=prognl:=false
end else ulinemask:=0;
if savecode then
begin comment code saved from previous line;
for j:=c2 step 1 until c2+c1-1 do
codebuf(pc+j-c2):=codebuf(j);
justpc(c1);
end;
saveword:=savecode:= false;
if linewidth-accuw<=0 then goto outline;
justfn:
more:=true;
for i:=i while more do
begin
klass:=if notemode then qread(fnote,fn,v) else readchar(in,v);
if klass=6 then klass:=5; comment hyphen in start of word ok;
branch:
case klass+1 of
begin;;;
begin comment separator;
if notemode then notsep(branch);
q1:=typol;
if q1<5 ! q1=5 & linewidth-accuw-(w-1)*maxspace<=0 then more:=false;
end;
begin comment underline;
if notemode then qread(fnote,fn,q1) else readchar(in,q1);
if notemode then fn:=fn-1 else repeatchar(in);
if ulinemask shift w >=0 or q1=8 then goto comp
end;
comp:
begin comment start of word;
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1; pib(w):=lin;
continueword:
for i:=i while word do
begin
next: if startofword then startofword:=false else
klass:=if notemode then qread(fnote,fn,v) else readchar(in,v);
if klass<>4 then back:=false;
e1: case klass+1 of
begin;;
word:=false;
begin comment separator;
if notemode then notsep(e1);
word:=false; repeatchar(in)
end;
begin comment underline;
if lin>linelim then error(<:char. in line:>,2);
if notemode then qread(fnote,fn,q1) else
readchar(in,q1);
if q1<>8 then
begin comment not backspace;
if notemode then fn:=fn-1 else repeatchar(in);
if back then
begin word:=false;
ulinemask:=ulinemask add (1 shift (23-w))
end else goto e2;
end
else
begin if notemode then fn:=fn-1 else repeatchar(in); goto e2
end;
end;
e2: begin comment part of word;
if v>127 then delim(v);
linebuf(lin):=false add v; lin:= lin+1;
accuw:=accuw+width(v extract 7);
end;
begin comment hyphen;
klass:=if notemode then qread(fnote,fn,q1) else
readchar(in,q1);
if q1=10 then
begin
e3: for i:=i while klass=2 do
klass:=if notemode then qread(fnote,fn,q1)
else readchar(in,q1);
if klass=3 and -,notemode then
begin
if skipnum(fnote,-2,i) then
begin klass:=2; goto e3
end else
begin
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v);
pis(w):=lin-1; startofword:=true;
goto branch
end
end separator met;
if notemode then fn:=fn-1 else repeatchar(in);
goto next
end
else
begin if notemode then fn:=fn-1 else repeatchar(in); goto e2
end
end;
backspace(linebuf,lin,true);
etext
end case;
end word;
startofword:=true;
pis(w):=lin-1;
if linewidth-accuw-(w-1)*maxspace<=0 then more:=false
end;;;
etext
end case;
end more;
goto outline;
nonjust:
for i:=i while more do
begin
klass:=readchar(in,v);
case klass+1 of
begin;;
more:=false;
if typol<5 then more:=false;;
begin comment start of textunit;
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1; pib(w):=lin;
repeatchar(in);
for i:=i while word do
begin
klass:=readchar(in,v);
case klass+1 of
begin;;
word:=more:=false;
begin comment separator;
word:=false; repeatchar(in);
end;;
begin comment part of textunit;
if lin>linelim then error(<:char. in line:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v extract 7);
end;;
backspace(linebuf,lin,true);
etext
end case;
end word;
pis(w):=lin-1;
end;;;
etext
end case;
end more;
goto outline;
tabul:
tabcount:=1; q2:=k:=accuw; comment q2 holds the width of the text
between the tab. marks;
for i:=i while more do
begin
klass:=readchar(in,v);
case klass+1 of
begin;;
more:=false;
if typol<5 then more:=false;;
begin comment start of textunit;
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1; pib(w):=lin;
repeatchar(in);
for i:=i while word do
begin
klass:=readchar(in,v);
case klass+1 of
begin;;
more:=word:=false;
begin comment separator;
word:=false; repeatchar(in)
end;;
begin comment part of textunit;
if lin>linelim then error(<:char. in line:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
q2:=q2+width(v extract 7)
end;
begin comment HT, calculate and output the space room ,q1, from the
actual position to the nearest tab. mark;
word:=false; repeatchar(in)
end;
backspace(linebuf,lin,true);
etext
end case;
end word;
pis(w):=lin-1; accuw:=accuw+q2; k:=q2; q2:=0
end textunit;
begin comment HT;
q1:=tabpar(tabcount)-k;
for tabcount:=tabcount+1 while q1<0 & tabcount<tabno+1 do
q1:=q1+tabpar(tabcount);
if tabcount>=tabno+1 & q1<0 then
begin comment no more tab.marks in line;
error(<:last tab.mark exceeded:>,1); q1:=0;
comment read until end of line;
end
else outspace(q1,true,-2);
accuw:=accuw+q1;
q2:=k:=0;
end;;
etext
end case
end more;
goto outline;
center:
v:=32;
for i:=i while v=32 do readchar(in,v);
repeatchar(in);
centrh:
for i:=i while more do
begin
klass:=if headmode then qread(rhead,rh,v) else readchar(in,v);
cen:
case klass+1 of
begin;;
more:=false;
begin if headmode then notsep(cen);
if typol<5 then more:=false
else if startofline then goto center
end;;
begin comment start of textunit;
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1; pib(w):=lin;
if headmode then rh:=rh-1 else repeatchar(in);
for i:=i while word do
begin
klass:=if headmode then qread(rhead,rh,v) else readchar(in,v);
ce1: case klass+1 of
begin;;
word:=more:=false;
begin comment separator;
if headmode then notsep(ce1);
word:=false; repeatchar(in)
end;;
begin comment part of textunit;
if lin>linelim then error(<:char. in line:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v extract 7)
end;;
backspace(linebuf,lin,true);
etext
end case;
end word;
pis(w):=lin-1
end textunit;;;
etext
end case;
end more;
calcensp;
\f
outline:
if mode=1 & -,headmode ! notemode then goto linejust;
comment output line in nonjust,tabul or centr mode;
outnonjust:
if linewidth+(if headmode then margin else 0)-accuw<0 then
error(<:linewidth exceeded:>,1);
pc:=1; blind:=true;
bool1:=headmode&nummode=4&pagnum mod 2=0&line1;
bool2:=headmode&(nummode=5!nummode=4&pagnum mod 2=1)&line1;
if mtext then mtext:=false else
if margin>0 & -,headmode and w>0 then outspace(margin,false,-2);
if bool1 then placenum(4);
if censp>0 then outspace(censp,false,-2);
if headmode and runfont<>rhfont then outfont(rhfont);
if setmode then
begin comment output for setting machine;
if codemask<0 then outcode(0);
for i:=1 step 1 until w do
begin
settext(i);
if codemask shift i <0 then outcode(i)
end
end;
if printmode then
begin comment output for printer;
if printmask<0 then printproc(printbuf(0));
for i:=1 step 1 until w do
begin
for j:=pib(i) step 1 until pis(i) do
begin
q1:=linebuf(j) extract 12;
if blind then
begin if false add q1 extract 7 <>32 then blind:=false
end;
if q1>14 & q1<30 ! q1=6 then
begin if q1=6 then write(pr,sp,1) else write(pr,false add 42,1,<<d>,q1-14)
end
else if q1=30 then
write(pr,false add specdel,1,false add 117,1)
else if q1=31 then
write(pr,false add specdel,1,false add 100,1)
else if q1>127 then
write(pr,false add specdel,1,false add (if q1<256 then 104 else 108),1,
false add (q1 extract 7),1)
else write(pr,false add (q1 extract 7),1);
comment indicate special symbol as * followed by the number;
end;
if printmask shift i<0 then printproc(printbuf(i))
end;
end;
if test then
begin testvar;
if printmode then setposition(pr,0,0);
if setmode then setposition(set,0,0);
end;
if bool2 then placenum(nummode);
if -,blind then lineno:=lineno+1;
if toptext and w=0 then nlpar:=0;
if -,headmode and w>0 then toptext:=false;
censp:=0;
outnl(nlpar);
line1:=false;
goto if v=0 then headlab else if (newpage ! finis) & -,headmode then pageshift
else lineinit;
linejust:
if dropjust and linewidth-accuw-(w-1)*normsp>=0 then goto outputline;
hypno:=-999;
if first then
begin comment the justification part starts here,
the width of the words read until now is with
max. spacing bigger than or equal the linewidth;
if linewidth-accuw-(w-1)*minspace>=0 then
begin comment hyphenatron not necessary;
if w>1 then
begin
if (linewidth-accuw)/(w-1)>=maxfactor*maxspace then
begin comment max. spacing;
first:=false;goto justfn
end
end
end
else
begin hypdigit:=true; hypno:=hypcall(wid); hypdigit:=false;
end;
end
else
begin comment the next word is read trying to change
the max. spacing;
q1:=linewidth-accuw; q2:=w-1;
snitspace:=q1/q2;
if q1-q2*minspace>=0 then
begin comment justification possible;
if snitspace>=minfactor*minspace & snitspace<maxfactor*maxspace
then first:=true
else
begin comment not normal spacing;
if snitspace>=maxfactor*maxspace then goto justfn
else
if -,spamax then first:=true
end
end
end;
if first then
begin comment all words read participate in this line;
if hypno<>-999 then
begin comment hyphenation has taken place;
if hypno<>0 then
begin comment no problems;
h1:=abs hypno+(if hypno>0 then 2 else 1);
h2:=pis(w); saveword:=true;
if hypno>0 then
begin comment hyphen;
h3:=linebuf(hypno+1) extract 7; hyp:=true;
linebuf(hypno+1):=false add 45
end;
pis(w):=if hypno>0 then hypno+1 else abs hypno;
accuw:=accuw-(if hypno>0 then wid-width(45) else wid)
end
else
begin comment problems,justify by increasing maxspace;
if w>2 then goto savelastword else
error(<:justification impossible:>,2)
end
end hypno<>-999
end first
else
savelastword:
begin comment the last word read is saved to the next line;
h1:=pib(w); h2:=pis(w); saveword:=true;
if ulinemask shift w<0 then ulinemask:=ulinemask+1 shift 23;
w:=w-1;
if codemask shift w<0 then
begin comment save generated code to the next line;
c1:=pco(w); c2:=pc-pco(w); savecode:=true
end;
for i:=h1 step 1 until h2 do accuw:=accuw-width(linebuf(i) extract 7);
end;
if -,notemode then prognl:=true;
comment calculate the spacing;
q1:=linewidth-accuw; q2:=w-1;
if q2=0 then q2:=10000;
snitspace:=q1/q2;
if snitspace>=maxfactor*maxspace then spamax:=true else spamax:=false;
s1:=q1//q2; k:=q1 mod q2;
s2:=if k>0 then s1+1 else s1;
outputline:
if mtext then mtext:=false else
if margin>0 and nlpar>0 then outspace(margin,false,-2);
pc:=1;
if setmode then
begin comment output for setting machine;
if codemask<0 then outcode(0);
for i:=1 step 1 until w do
begin
settext(i);
if codemask shift i<0 then outcode(i);
q1:=if dropjust then normsp else
if leftspa then (if i>k then s1 else s2) else
if i>q2-k then s2 else s1;
comment q1=the wordspace in units between word no. i and i+1;
if i<w then outspace(q1,false,if ulinemask shift i < 0 then i else -1);
end;
if k>0 & -,dropjust then leftspa:=-,leftspa
end setmode;
if printmode then
begin comment output for printer;
if printmask<0 then printproc(printbuf(0));
for i:=1 step 1 until w do
begin
for j:=pib(i) step 1 until pis(i) do
begin q1:=linebuf(j) extract 12;
if q1>14 & q1<30 then write(pr,false add 42,1,<<d>,q1-14)
else if q1=30 then
write(pr,false add specdel,1,false add 117,1)
else if q1=31 then
write(pr,false add specdel,1,false add 100,1)
else if q1>128 then
write(pr,false add specdel,
1,false add (if q1<256 then 104 else 108),1,
false add (q1 extract 7),1)
else write(pr,false add q1,1)
end;
if i<w & ulinemask shift i>=0 then write(pr,sp,1)
else if i<w then write(pr,false add 95,1);
if printmask shift i<0 then printproc(printbuf(i));
end;
end printmode;
if test then
begin testvar;
if printmode then setposition(pr,0,0);
if setmode then setposition(set,0,0);
end;
if w>0 then begin lineno:=lineno+1; toptext:=false end;
if -,compinit then outnl(nlpar);
goto if notemode & v=0 & -,saveword then outnote else
if (newpage ! finis) & -,notemode then pageshift else lineinit;
exit:
getzone(set,pib);
if setmode then
begin
if machine=2 then write(set,false add 150,1,false ,100) else
if machine=5 then write(set,false add 150,1) else
write(set,false,100,
if pib(1)=4 then false add 25 else false ,1);
end;
if printmode then write(pr,false add 25,1);
if hypmode=1 then write(hyphinf,false add 25,1);
if hypmode<3 then
begin
close(c,false)
end;
eexit:
if time then
begin
write(out,nl,1,<:segment transfer time: :>,blocksread//55);
ra(1):=systime(1,ra(2),ra(2))-ra(1);
write(out,nl,1,<:cpu and real time: :>,<<dddd.dd>,ra(1),ra(2));
end;
close(pr,true); close(set,true); close(hyphinf,true);
write(out,<:<10>compose end. :>);
systime(1,0,ra(1));
write(out,<< zd dd dd>,systime(2,ra(1),ra(2)),ra(2),nl,1);
fpproc(7,0,0,0)
end
end
▶EOF◀