{+++++++++++++++++++++++++++++++++++++++++++++++++++}
{+ DOTEXT MODULE FOR KFORMAT Text Output Processor +}
{+++++++++++++++++++++++++++++++++++++++++++++++++++}
{ compiler options for Pascal/Z compiler. }
{$C-}{ control-c checking OFF }
{$M-}{ integer mult & divd error checking OFF }
{$F-}{ floating point error checking OFF }
{
process text
}
PROCEDURE DOTEXT(inbuf:BUFFER);
VAR i :int;
wordbuf :BUFFER;
{
delete leading blanks & set tival
}
PROCEDURE LEADBL(VAR lbbuf:BUFFER);
VAR i :int;
BEGIN
DOBREAK;
i := 1;
WHILE ((lbbuf[i]=SPACE) and (i < LENGTH(lbbuf))) DO i := i + 1;
IF (lbbuf[i] <> NEWLINE) THEN tival := tival + i - 1;
IF ( i<>1 ) THEN DELETE(lbbuf,1,i-1); { *** 3-81 *** }
END;
{
width of a printed line
}
FUNCTION WIDTH(VAR w:BUFFER):int;
VAR i,wdth :int;
BEGIN
wdth := 0;
FOR i := 1 TO LENGTH(w) DO
IF (w[i]=BACKSPACE) THEN
wdth := wdth - 1
ELSE IF (w[i] <> NEWLINE) THEN
wdth := wdth + 1;
WIDTH := wdth;
END;
{
centers by setting temporary indent
}
PROCEDURE CENTER(VAR cebuf:BUFFER);
var k: int;
BEGIN
k := ( rmval + tival - WIDTH(cebuf) ) DIV 2;
tival := IMAX( k,0 );
END;
{
replace non-white space chars with bksp, "_"
}
PROCEDURE UNDERLINE(VAR inbuf:BUFFER);
VAR u :int;
ulstr :DSTRING;
BEGIN
ulstr := ' ';
ulstr[1] := BACKSPACE;
ulstr[2] := '_';
u := 1;
WHILE (u <= LENGTH(inbuf)) DO
begin
IF ( (inbuf[u] <> SPACE)
AND (inbuf[u] <> TAB)
AND (inbuf[u] <> BACKSPACE)
AND (inbuf[u] <> NEWLINE) ) THEN
BEGIN INSERT(ulstr,inbuf,u+1);
u := u + 3
END
ELSE
u := u + 1;
end;
END;
{
spread words to justify right margin
}
PROCEDURE SPREAD(VAR outbuf:BUFFER; outp, nextra, outwds:int);
VAR nb, { number blanks }
ne, { number extra }
nholes, { number holes }
i, j: int;
BEGIN
IF (nextra > 0) THEN
BEGIN{nextra > 0}
IF (outwds > 0) and ( spacefill ) THEN
BEGIN
direction := NOT direction; { tobble bias direction }
ne := nextra;
nholes := outwds - 1;
i := LENGTH(outbuf) - 1; { point at final non-blank }
WHILE ( ne > 0 ) DO
BEGIN
WHILE ( outbuf[i] <> SPACE ) DO i := i - 1;
IF ( direction ) THEN
nb := (ne-1) DIV nholes + 1 { rounded }
ELSE
nb := ne DIV nholes; { truncated }
ne := ne - nb;
nholes := nholes - 1;
WHILE ( nb > 0 ) DO { insert extra blanks }
BEGIN
INSERT(' ',outbuf,i+1);
nb := nb - 1;
END;
i := i - 1
END {while ne > 0}
END
END {IF nextra > 0}
END;
{
put a word in outbuf including margin justification
}
PROCEDURE PUTWORD(VAR pwbuf:BUFFER);
VAR w, last,
llval, nextra: int;
BEGIN
w := WIDTH(pwbuf); { printable width of pwbuf }
last := LENGTH(pwbuf) + outp + 1; { new end of outbuf }
llval := rmval - tival; { printable line length }
IF ((outp > 0)
AND ( ((outw + w) > llval) OR (last > MAXBUF) ) ) THEN{ too big }
BEGIN
last := last - outp; { remember end of wrdbuf }
nextra := llval - outw + 1; { # blanks needed to pad }
IF ( spacefill ) THEN
SPREAD(outbuf,outp,nextra,outwds);
IF ((nextra > 0) AND (outwds > 1)) THEN
outp := outp + nextra;
DOBREAK { flush previous line }
END;
outp := last;
{ * outbuf := CONCAT(outbuf,pwbuf,space); * }
append(outbuf,pwbuf); { add new word to outbuf }
append(outbuf,space); { add a blank }
outw := outw + w + 1; { update output width }
outwds := outwds + 1; { increment the word count }
END;
{
get a non-blank word from inbuf[] to wdbuf[] and
advance g. Returns length of wdbuf.
}
FUNCTION GETWORD(VAR inbuf: BUFFER; VAR g: int; VAR wdbuf: BUFFER):int;
VAR st: int;
BEGIN
WHILE (((inbuf[g]=SPACE) OR (inbuf[g]=TAB))
AND (g < LENGTH(inbuf))) DO g := g + 1;
st := g;
SKIPCHARS(inbuf,g);
wdbuf := COPY(inbuf,st,g-st);
GETWORD := LENGTH(wdbuf);
END;
BEGIN {dotext}
IF ((inbuf[1]=SPACE) OR (inbuf[1]=NEWLINE)) THEN
LEADBL(inbuf); { * move left, set tival * }
IF ( ulval > 0 ) THEN { * underlining * }
BEGIN
UNDERLINE(inbuf);
ulval := ulval - 1
END;
IF ( ceval > 0 ) THEN { * centering in effect * }
BEGIN
CENTER(inbuf);
PUTTEXT(inbuf);
ceval := ceval - 1;
END
ELSE IF (inbuf[1]=NEWLINE) THEN { * all blank line * }
PUTTEXT(inbuf)
ELSE IF ( NOT fill ) THEN { * un-filled text passes * }
PUTTEXT(inbuf) { * text "as is" * }
ELSE { * filled text * }
BEGIN
i := 1;
WHILE ( GETWORD(inbuf,i,wordbuf) > 0 ) DO
PUTWORD(wordbuf);
END;
END; {dotext}
