{ srof -- Turbo Pascal text formatter }

{ Mostly borrowed from Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL,
  chapter 7 }
{ Adaptation to Turbo Pascal 3.0 for DEC Rainbow by John Stone, 11/12/85 }
{ @hb added, margin resetting made to cause break -- 1/4/86 }
{ .LM and .RM revised so that line break precedes parameter change -- 1/15/86 }
{ .BM and .FM commands revised to reset 'bottom' variable -- 2/19/86 }
{ Line spacing setting forced to 1 between .LI and .RF -- 2/19/86 }
{ Boldfacing commands added -- 8/4/86 }
{ Command-line parsing, monitoring, explicit files added -- 8/5/86 }
{ New, more general header/footer commands added -- 8/5/86 }
{ Adapted for the VAX using Pascal-2 -- 8/22/86 }
{ Bad interaction between footnote counter and on-screen formatting fixed 
  -- 11/10/86 }
{ Alternative @## form for hard blank, @hr added -- 8/20/87 }
{ Adaptation to Suns using Berkeley Pascal -- 10/26/87 }

program srof (input, output, source, target);

label
    999;            { emergency exit }

const
    MAXSTR = 255;   { longest possible string }
    MAXARGS = 5;    { maximum number of command-line arguments }

    { ASCII character values }
    BLANK = ' ';
    EXCL = '!';
    DQUOTE = '"';
    SQUOTE = '''';
    RPAREN = ')';
    PLUS = '+';
    MINUS = '-';
    PERIOD = '.';
    COLON = ':';
    QUES = '?';
    WHORL = '@';
    LBRACK = '[';
    RBRACK = ']';
    RBRACE = '}';
    SLASH = '/';

    PAGEWIDTH = 80;
    PAGELEN = 66;

type
    XSTRING = array [0 .. MAXSTR] of char;
        { the zeroth element encodes the effective length of the string }
    XSTRARR = array [1 .. MAXARGS] of XSTRING;
        { the command-line arguments }
    DIRECTION = (RIGHTWARDS, LEFTWARDS);
    CMDTYPE = (BF, BL, BM, BR, CC, CE, CI, FC, FI, FM, FO, FT, HD, HE, HM, 
               JU, LI, LM, LS, NF, NJ, NP, PA, PG, PL, RF, RM, SP, TI, TM,
               TP, UL, UNKNOWN);
    DEVICE = (MONITOR, PRINTER);
    TITLE = record
                leftmarg: integer;
                lefttext: XSTRING;
                middletext: XSTRING;
                righttext: XSTRING;
                rightmarg: integer
            end;

var
    cmdchar : char;      { command signal; init = '.' }
    inlinechar : char;   { in-line command signal; init = '@' }
    hardblank : XSTRING; { in-line command for hard blank }
    althardblank : XSTRING;  { alternative in-line command for hard blank }

    { ASCII control characters -- constants except for Pascal syntax }
    BACKSPACE : char;   { = ^H }
    TAB : char;         { = ^I }
    NEWLINE : char;     { = ^J }
    ESCAPE : char;      { = ^[ }

    { files and file names }
    sourcename : XSTRING;    { operating system name for source file }
    source : text;           { the source file itself }
    targetname : XSTRING;    { operating system name for target file }
    target : text;           { the target file itself }

    { page parameters }
    curpage : integer;   { current output page number; init=0 }
    newpage : integer;   { next output page number; init=1 }
    lineno : integer;    { next line to be printed; init=0 }
    plval : integer;     { page length in lines; init=PAGELEN=66 }
    tmval : integer;     { margin before and including header }
    hmval : integer;     { margin after header }
    fmval : integer;     { margin after last text line }
    bmval : integer;     { bottom margin, including footer }
    bottom : integer;    { last line on page, =plval-fmval-bmval }
    header : TITLE;      { top of page title }
    footer : TITLE;      { bottom of page title }

    { global parameters }
    fill : Boolean;      { fill if true; init=true }
    justify : Boolean;   { justify if true; init=false }
    autoparagraph : Boolean;
                         { do automatic paragraphing if true; init=true }
    lsval : integer;     { current line spacing; init=1 }
    lmval : integer;     { current indent; >= 0; init=0 }
    rmval : integer;     { right margin; init=PAGEWIDTH=60 }
    tival : integer;     { current temporary indent; init=0 }
    ceval : integer;     { # of lines to center; init=0 }
    paval : integer;     { # of spaces to indent new paragraph; init=5 }

    { suspension of formatting }
    literal : Boolean;   { true when formatting is suspended; init=false }
    tempfill : Boolean;  { suspended value of 'fill' }
    tempjust : Boolean;  { suspended value of 'justify' }
    tempap : Boolean;    { suspended value of 'autoparagraph' }
    temppaval : integer; { suspended value of 'paval' }
    templsval : integer; { suspended value of 'lsval' }

    { management of underlining }
    ulval : integer;     { # of lines to underline; init=0 }
    ulflag : Boolean;    { whether underlining is in progress }
    ulshift : Boolean;   { whether underlining is about to be toggled }
    ulcross : Boolean;   { whether underlining continues on next line }
    ulbegin : XSTRING;   { escape sequence for starting underlining }
    vtulend : XSTRING;   { VT100 escape sequence for stopping underlining }
    printerulend: XSTRING;   { LA50, LN03 escape sequence for no underlining }
    uplus : XSTRING;     { in-line command for starting underlining }
    uminus : XSTRING;    { in-line command for stopping underlining }

    { management of boldfacing }
    bfval : integer;     { # of lines to boldface; init=0 }
    bfflag : Boolean;    { whether boldfacing is in progress }
    bfshift : Boolean;   { whether boldfacing is about to be toggled }
    bfcross : Boolean;   { whether boldfacing continues on next line }
    bfbegin : XSTRING;   { escape sequence for starting boldfacing }
    vtbfend : XSTRING;   { VT100 escape sequence for stopping boldfacing }
    printerbfend : XSTRING; { LA50, LN03 escape sequence for no boldfacing }
    bplus : XSTRING;     { in-line command for starting boldfacing }
    bminus : XSTRING;    { in-line command for stopping boldfacing }

    { management of subscripts, superscripts, and footnotes }
    halfup : XSTRING;    { escape sequence for half-line up }
    halfdown : XSTRING;  { escape sequence for half-line down }
    fnno : integer;      { footnote counter -- number of next fn }

    { output area }
    outw : integer;      { width of text in outbuf; init=0 }
    outwds : integer;    { number of words in outbuf; init=0 }
    outbuf : XSTRING;    { lines to be filled collect here }

    dir : DIRECTION;     { direction for blank padding }
    pos : integer;       { counts off positions in an input line }
    inbuf : XSTRING;     { input line }
    onscreen : Boolean;  { true if on-screen monitoring is requested }

{ halt -- emergency stop }
{ John Stone, 8/16/86 }
procedure halt (errorcode: integer);
begin
    goto 999
end;

{ parsecommandline -- obtain and count the command-line arguments }
{ John Stone, 10/27/87 }
{ Note: This procedure uses the 'argc' and 'argv' functions that are built
  into the Sun implementation of Pascal. }
procedure parsecommandline (var argcount: integer; var argvalues: XSTRARR);
label
    88;                         { early exit from copy loop }
var
    count : integer;            { counts off the command-line arguments }
    temp : packed array [1 .. MAXSTR] of char;   { string required by argv }
    pos : integer;              { counts off the characters in each command-
                                  line argument }
begin
    argcount := argc;
    for count := 0 to argcount - 1 do begin
        argv(count, temp);
        pos := 0;
        while pos < MAXSTR do
            if temp[succ(pos)] = BLANK then
                goto 88
            else begin
                pos := succ(pos);
                argvalues[count + 1][pos] := temp[pos]
            end;
        88:
            argvalues[count + 1][0] := chr(pos)
    end
end;
        
{ getnames -- recover filenames, switch settings from command line }
{ John Stone, 10/26/87 }
{ Note:  The switch to Unix-type filenames makes for an important difference
  in the user interface.  Since Unix does not require filetypes, the '.txt'
  is not appended to a source file specification automatically, as in the
  VAX and Rainbow versions. }
procedure getnames (var sourcename : XSTRING; var targetname : XSTRING;
    var onscreen : Boolean);
const
    SWITCHCHAR = MINUS;
var
    seekingsource : Boolean;    { true until the source name has been found }
    seekingtarget : Boolean;    { true until the target name has been found }
    argc : integer;             { number of command-line arguments }
    argv : XSTRARR;             { command-line arguments }
    count : integer;            { counts off the command-line arguments }
    charno : integer;           { counts off the characters in a file name }
    length : integer;           { the number of characters in a file name }
begin
    onscreen := false;          { defaults }
    seekingsource := true;
    seekingtarget := true;
    parsecommandline(argc, argv);
    for count := 2 to argc do begin
        if (argv[count][1] = SWITCHCHAR) then begin
            if (argv[count][2] = 'V') or (argv[count][2] = 'v') then
                onscreen := true
            else begin
                write(output, 'Invalid switch: ');
                for charno := 1 to ord(argv[count][0]) do
                    write(output, argv[count][charno]);
                writeln(output);
                halt(1)
            end
        end
        else if seekingsource then begin
            sourcename := argv[count];
            seekingsource := false
        end
        else if seekingtarget then begin
            targetname := argv[count];
            seekingtarget := false
        end
        else begin
            writeln(output, 'Too many command-line arguments');
            halt(1)
        end
    end;
    if (seekingsource) then begin
        writeln(output, 'You must specify an input file.');
        halt(1)
    end
    else if (seekingtarget) then begin
        targetname := sourcename;
        length := ord(sourcename[0]);
        if (sourcename[length - 3] <> PERIOD) or
           (sourcename[length - 2] <> 't') or
           (sourcename[length - 1] <> 'x') or
           (sourcename[length] <> 't') then begin
            if length + 4 <= MAXSTR then
                targetname[0] := chr(length + 4)
            else
                targetname[0] := chr(MAXSTR);
        end;
        length := ord(targetname[0]);
        targetname[length - 3] := PERIOD;
        targetname[length - 2] := 'd';
        targetname[length - 1] := 'o';
        targetname[length] := 'c'
    end
end;

{ openfiles -- set up source and target files }
{ John Stone, 10/27/87 }
procedure openfiles (var sourcename : XSTRING; var source : text;
    var targetname : XSTRING; var target : text);
var
    sourcelength : integer;  { the number of characters in the name of the
                               source file }
    targetlength : integer;  { the number of characters in the name of the
                               target file }
    filename : packed array [1 .. MAXSTR] of char;
                       { a file name, as a standard Pascal string }
    pos : integer;     { one character in a file name }
begin
    sourcelength := ord(sourcename[0]);
    for pos := 1 to sourcelength do
        filename[pos] := sourcename[pos];
    for pos := succ(sourcelength) to MAXSTR do
        filename[pos] := BLANK;
    reset(source, filename);
    targetlength := ord(targetname[0]);
    for pos := 1 to targetlength do
        filename[pos] := targetname[pos];
    for pos := succ(targetlength) to MAXSTR do
        filename[pos] := BLANK;
    rewrite(target, filename)
end;
        
{ putstr -- put out string to designated file }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 329 }
{ John Stone, 3/31/85 }
procedure putstr (var outfile : text; var s : XSTRING);
var
    i : integer;
begin
    for i := 1 to ord(s[0]) do
        if (s[i] = NEWLINE) then
            writeln(outfile)
        else
            write(outfile, s[i]);
end;

{ lowercase -- converts caps to lowercase, leaves others alone }
{ John Stone, 11/2/85 }
function lowercase (c : char) : char;
begin
    if (c >= 'A') and (c <= 'Z') then
        lowercase := chr(ord(c) + 32)
    else
        lowercase := c
end;

{ scopy -- copy xstring at src[i] to dest[j] }
{ John Stone, 11/12/85 }
procedure scopy (var src : XSTRING; i : integer; var dest : XSTRING;
        j : integer);
begin
    while (i <= ord(src[0])) and (j <= MAXSTR) do begin
        dest[j] := src[i];
        i := succ(i);
        j := succ(j)
    end;
    dest[0] := chr(pred(j))
end;

{ ctoi -- convert string at s[i] to integer, increment i }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 59 }
{ John Stone, 3/31/85 }
function ctoi (var s : XSTRING; var i : integer) : integer;
var
    n, sign : integer;
begin
    while (s[i] = BLANK) or (s[i] = TAB) do
        i := succ(i);
    if (s[i] = MINUS) then
        sign := -1
    else
        sign := 1;
    if (s[i] = PLUS) or (s[i] = MINUS) then
        i := succ(i);
    n := 0;
    while (s[i] >= '0') and (s[i] <= '9') and (i <= ord(s[0])) do begin
        n := 10 * n + ord(s[i]) - ord('0');
        i := succ(i)
    end;
    ctoi := sign * n
end;

{ getcmd -- decode command type }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 236 }
{ John Stone, 11/12/85 }
function getcmd (var buf : XSTRING) : CMDTYPE;
var
    cmd : packed array [1..2] of char;
begin
    cmd[1] := lowercase(buf[2]);
    cmd[2] := lowercase(buf[3]);
    if (cmd = 'fi') then
        getcmd := FI
    else if (cmd = 'nf') then
        getcmd := NF
    else if (cmd = 'ju') then
        getcmd := JU
    else if (cmd = 'nj') then
        getcmd := NJ
    else if (cmd = 'br') then
        getcmd := BR
    else if (cmd = 'ls') then
        getcmd := LS
    else if (cmd = 'pg') then
        getcmd := PG
    else if (cmd = 'bl') then
        getcmd := BL
    else if (cmd = 'sp') then
        getcmd := SP
    else if (cmd = 'lm') then
        getcmd := LM
    else if (cmd = 'rm') then
        getcmd := RM
    else if (cmd = 'ti') then
        getcmd := TI
    else if (cmd = 'ce') then
        getcmd := CE
    else if (cmd = 'ul') then
        getcmd := UL
    else if (cmd = 'bf') then
        getcmd := BF
    else if (cmd = 'he') then
        getcmd := HE
    else if (cmd = 'fo') then
        getcmd := FO
    else if (cmd = 'hd') then
        getcmd := HD
    else if (cmd = 'ft') then
        getcmd := FT
    else if (cmd = 'pl') then
        getcmd := PL
    else if (cmd = 'cc') then
        getcmd := CC
    else if (cmd = 'ci') then
        getcmd := CI
    else if (cmd = 'tm') then
        getcmd := TM
    else if (cmd = 'bm') then
        getcmd := BM
    else if (cmd = 'fm') then
        getcmd := FM
    else if (cmd = 'hm') then
        getcmd := HM
    else if (cmd = 'tp') then
        getcmd := TP
    else if (cmd = 'pa') then
        getcmd := PA
    else if (cmd = 'np') then
        getcmd := NP
    else if (cmd = 'li') then
        getcmd := LI
    else if (cmd = 'rf') then
        getcmd := RF
    else if (cmd = 'fc') then
        getcmd := FC
    else
        getcmd := UNKNOWN
end;

{ setparam -- set parameter and check range }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 238 }
{ John Stone, 4/28/85 }
procedure setparam (var param : integer; val: integer; argtype: char;
        defval, minval, maxval: integer);
begin
    if (argtype = NEWLINE) then     { defaulted }
        param := defval
    else if (argtype = PLUS) then   { relative + }
        param := param + val
    else if (argtype = MINUS) then  { relative - }
        param := param - val
    else    { absolute }
        param := val;
    if param > maxval then
        param := maxval;
    if param < minval then
        param := minval
end;

{ getval -- evaluate optional numeric argument }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 237 }
{ John Stone, 4/28/85 }
function getval (var buf : XSTRING; var argtype : char) : integer;
var
    i : integer;
begin
    i := 1; { skip over command name }
    while (buf[i] <> BLANK) and (buf[i] <> TAB) and (buf[i] <> NEWLINE) do
        i := succ(i);
    while (buf[i] = BLANK) or (buf[i] = TAB) do
        i := succ(i);  { find argument }
    argtype := buf[i];
    if (argtype = PLUS) or (argtype = MINUS) then
        i := succ(i);
    getval := ctoi(buf, i)
end;

{ inttostr -- constructs a string representation of a specified integer }
{ John Stone, 8/21/86 }
procedure inttostr (n: integer; var result: XSTRING);
var
    pos: integer;
        
    { fillpos -- first invokes itself recursively to put all the 
    early digits of the decimal representation of a specified integer 
    into appropriate positions in a string, then fits in a digit after them }
    { John Stone, 8/21/86 }
    procedure fillpos (n: integer; var pos: integer; var result: XSTRING);
    begin
        if n >= 10 then
            fillpos (n div 10, pos, result);
        pos := succ (pos);
        result[pos] := chr (ord ('0') + n mod 10)
    end;

begin { procedure inttostr }
    if n < 0 then begin
        n := -n;
        result[1] := '-';
        pos := 1
    end
    else
        pos := 0;
    fillpos (n, pos, result);
    result[0] := chr(pos)
end;

{ insert -- add new xstring to object string at indicated position }
{ John Stone, 11/12/85 }
procedure insert (var src : XSTRING; var dest : XSTRING; pos : integer);
var
    spos, dpos : integer;
begin
    if ord(src[0]) + ord(dest[0]) > MAXSTR then
        dest[0] := chr(MAXSTR)
    else
        dest[0] := chr(ord(src[0]) + ord(dest[0]));
    for dpos := ord(dest[0]) downto pos + ord(src[0]) do
        dest[dpos] := dest[dpos - ord(src[0])];
    for spos := ord(src[0]) downto 1 do
        dest[pred(spos + pos)] := src[spos]
end;   

{ getdate -- recover date of execution as a string }
{ John Stone, 10/26/87 }
procedure getdate (var datestr : XSTRING);
var
    systemdate : alfa;           { predefined type in Berkeley Pascal }
    systemmonth : packed array [1 .. 3] of char;
    daystr, yearstr : XSTRING;
    pos : integer;
begin
    date(systemdate);
    systemmonth[1] := systemdate[4];
    systemmonth[2] := systemdate[5];
    systemmonth[3] := systemdate[6];
    if systemmonth = 'Jan' then begin
        datestr[0] := chr(8);
        datestr[1] := 'J';
        datestr[2] := 'a';
        datestr[3] := 'n';
        datestr[4] := 'u';
        datestr[5] := 'a';
        datestr[6] := 'r';
        datestr[7] := 'y';
        datestr[8] := ' '
    end
    else if systemmonth = 'Feb' then begin
        datestr[0] := chr(9);
        datestr[1] := 'F';
        datestr[2] := 'e';
        datestr[3] := 'b';
        datestr[4] := 'r';
        datestr[5] := 'u';
        datestr[6] := 'a';
        datestr[7] := 'r';
        datestr[8] := 'y';
        datestr[9] := ' '
    end
    else if systemmonth = 'Mar' then begin
        datestr[0] := chr(6);
        datestr[1] := 'M';
        datestr[2] := 'a';
        datestr[3] := 'r';
        datestr[4] := 'c';
        datestr[5] := 'h';
        datestr[6] := ' '
    end
    else if systemmonth = 'Apr' then begin
        datestr[0] := chr(6);
        datestr[1] := 'A';
        datestr[2] := 'p';
        datestr[3] := 'r';
        datestr[4] := 'i';
        datestr[5] := 'l';
        datestr[6] := ' '
    end
    else if systemmonth = 'May' then begin
        datestr[0] := chr(4);
        datestr[1] := 'M';
        datestr[2] := 'a';
        datestr[3] := 'y';
        datestr[4] := ' '
    end
    else if systemmonth = 'Jun' then begin
        datestr[0] := chr(5);
        datestr[1] := 'J';
        datestr[2] := 'u';
        datestr[3] := 'n';
        datestr[4] := 'e';
        datestr[5] := ' '
    end
    else if systemmonth = 'Jul' then begin
        datestr[0] := chr(5);
        datestr[1] := 'J';
        datestr[2] := 'u';
        datestr[3] := 'l';
        datestr[4] := 'y';
        datestr[5] := ' '
    end
    else if systemmonth = 'Aug' then begin
        datestr[0] := chr(7);
        datestr[1] := 'A';
        datestr[2] := 'u';
        datestr[3] := 'g';
        datestr[4] := 'u';
        datestr[5] := 's';
        datestr[6] := 't';
        datestr[7] := ' ';
    end
    else if systemmonth = 'Sep' then begin
        datestr[0] := chr(10);
        datestr[1] := 'S';
        datestr[2] := 'e';
        datestr[3] := 'p';
        datestr[4] := 't';
        datestr[5] := 'e';
        datestr[6] := 'm';
        datestr[7] := 'b';
        datestr[8] := 'e';
        datestr[9] := 'r';
        datestr[10] := ' '
    end
    else if systemmonth = 'Oct' then begin
        datestr[0] := chr(8);
        datestr[1] := 'O';
        datestr[2] := 'c';
        datestr[3] := 't';
        datestr[4] := 'o';
        datestr[5] := 'b';
        datestr[6] := 'e';
        datestr[7] := 'r';
        datestr[8] := ' '
    end
    else if systemmonth = 'Nov' then begin
        datestr[0] := chr(9);
        datestr[1] := 'N';
        datestr[2] := 'o';
        datestr[3] := 'v';
        datestr[4] := 'e';
        datestr[5] := 'm';
        datestr[6] := 'b';
        datestr[7] := 'e';
        datestr[8] := 'r';
        datestr[9] := ' '
    end
    else if systemmonth = 'Dec' then begin
        datestr[0] := chr(9);
        datestr[1] := 'D';
        datestr[2] := 'e';
        datestr[3] := 'c';
        datestr[4] := 'e';
        datestr[5] := 'm';
        datestr[6] := 'b';
        datestr[7] := 'e';
        datestr[8] := 'r';
        datestr[9] := ' '
    end;
    if systemdate[1] = BLANK then begin
        daystr[0] := chr(1);
        daystr[1] := systemdate[2]
    end
    else begin
        daystr[0] := chr(2);
        daystr[1] := systemdate[1];
        daystr[2] := systemdate[2]
    end;
    insert(daystr, datestr, succ(ord(datestr[0])));
    pos := ord(datestr[0]);
    datestr[pos + 1] := ',';
    datestr[pos + 2] := ' ';
    datestr[0] := chr(pos + 2);
    yearstr[0] := chr(4);
    yearstr[1] := '1';
    yearstr[2] := '9';
    yearstr[3] := systemdate[8];
    yearstr[4] := systemdate[9];
    insert(yearstr, datestr, succ(ord(datestr[0])))
end;

{ gethour -- recover hour and minute of execution as a string }
{ John Stone, 10/26/87 }
procedure gethour (var hourstr : XSTRING);
var
    systemtime : alfa;        { predefined type in Sun Pascal }
    hour, minute : integer;
    beforenoon : Boolean;
    pos : integer;
begin
    time(systemtime);
    if systemtime[2] = BLANK then
        hour := ord(systemtime[3]) - ord('0')
    else
        hour := 10 * (ord(systemtime[2]) - ord('0')) +
                   ord(systemtime[3]) - ord('0');
    minute := 10 * (ord(systemtime[5]) - ord('0')) +
                 ord(systemtime[6]) - ord('0');
    beforenoon := (hour < 12);
    if not beforenoon then
        hour := hour - 12;
    if hour = 0 then
        hour := 12;
    inttostr(hour, hourstr);
    hourstr[0] := succ(hourstr[0]);
    hourstr[ord(hourstr[0])] := COLON;
    hourstr[0] := succ(hourstr[0]);
    hourstr[ord(hourstr[0])] := chr(ord('0') + minute div 10);
    hourstr[0] := succ(hourstr[0]);
    hourstr[ord(hourstr[0])] := chr(ord('0') + minute mod 10);
    hourstr[0] := succ(hourstr[0]);
    hourstr[ord(hourstr[0])] := BLANK;
    pos := ord(hourstr[0]);
    if beforenoon then begin
        hourstr[0] := chr(pos + 4);
        hourstr[pos + 1] := 'a';
        hourstr[pos + 2] := '.';
        hourstr[pos + 3] := 'm';
        hourstr[pos + 4] := '.'
    end
    else if (hour = 12) and (minute = 0) then begin
        hourstr[0] := chr(pos + 2);
        hourstr[pos + 1] := 'm';
        hourstr[pos + 2] := '.'
    end
    else begin
        hourstr[0] := chr(pos + 4);
        hourstr[pos + 1] := 'p';
        hourstr[pos + 2] := '.';
        hourstr[pos + 3] := 'm';
        hourstr[pos + 4] := '.'
    end
end;
        
{ expandescapes -- replace in-line controls with escape sequences for a 
  specified device }
{ John Stone, 11/1/85, 1/4/86 }
procedure expandescapes (var source : XSTRING; var result : XSTRING;
    dev: DEVICE);
const
    ILCSKIP = 3;
var
    spos, rpos : integer;
    cmd : packed array [1..2] of char;
    fnstr : XSTRING;
    pagestr : XSTRING;
    datestr : XSTRING;
    blankstr : XSTRING;
    hourstr : XSTRING;
begin
    result[0] := chr(0);
    spos := 1;
    rpos := 1;
    while (spos <= pred(pred(ord(source[0])))) do
        if source[spos] = inlinechar then begin
            cmd[1] := lowercase(source[succ(spos)]);
            cmd[2] := lowercase(source[succ(succ(spos))]);
            if cmd = 'u+' then begin
                ulflag := true;
                scopy(ulbegin, 1, result, rpos);
                spos := spos + ILCSKIP;
                rpos := rpos + ord(ulbegin[0])
            end
            else if cmd = 'u-' then begin
                ulflag := false;
                case dev of
                    MONITOR:
                        begin
                            scopy(vtulend, 1, result, rpos);
                            rpos := rpos + ord(vtulend[0]);
                            if bfflag then begin
                                scopy(bfbegin, 1, result, rpos);
                                rpos := rpos + ord(bfbegin[0])
                            end
                        end;
                    PRINTER:
                        begin
                            scopy(printerulend, 1, result, rpos);
                            rpos := rpos + ord(printerulend[0])
                        end
                end;
                spos := spos + ILCSKIP;
            end
            else if cmd = 'b+' then begin
                bfflag := true;
                scopy(bfbegin, 1, result, rpos);
                spos := spos + ILCSKIP;
                rpos := rpos + ord(bfbegin[0])
            end
            else if cmd = 'b-' then begin
                bfflag := false;
                case dev of
                    MONITOR:
                        begin
                            scopy(vtbfend, 1, result, rpos);
                            rpos := rpos + ord(vtbfend[0]);
                            if ulflag then begin
                                scopy(ulbegin, 1, result, rpos);
                                rpos := rpos + ord(ulbegin[0])
                            end
                        end;
                    PRINTER:
                        begin
                            scopy(printerbfend, 1, result, rpos);
                            rpos := rpos + ord(printerbfend[0])
                        end
                end;
                spos := spos + ILCSKIP
            end
            else if cmd = 'fn' then begin
                scopy(halfup, 1, result, rpos);
                rpos := rpos + ord(halfup[0]);
                inttostr(fnno, fnstr);
                scopy(fnstr, 1, result, rpos);
                rpos := rpos + ord(fnstr[0]);
                scopy(halfdown, 1, result, rpos);
                rpos := rpos + ord(halfdown[0]);
                spos := spos + ILCSKIP;
                fnno := succ(fnno)
            end
            else if cmd = 'su' then begin
                scopy(halfup, 1, result, rpos);
                spos := spos + ILCSKIP;
                rpos := rpos + ord(halfup[0]);
                result[rpos] := source[spos];
                result[0] := succ(result[0]);
                spos := succ(spos);
                rpos := succ(rpos);
                scopy(halfdown, 1, result, rpos);
                rpos := rpos + ord(halfdown[0])
            end
            else if cmd = 'sb' then begin
                scopy(halfdown, 1, result, rpos);
                spos := spos + ILCSKIP;
                rpos := rpos + ord(halfdown[0]);
                result[rpos] := source[spos];
                result[0] := succ(result[0]);
                spos := succ(spos);
                rpos := succ(rpos);
                scopy(halfup, 1, result, rpos);
                rpos := rpos + ord(halfup[0])
            end
            else if cmd = 'pn' then begin
                spos := spos + ILCSKIP;
                inttostr(curpage, pagestr);
                scopy(pagestr, 1, result, rpos);
                rpos := rpos + ord(pagestr[0])
            end
            else if cmd = 'da' then begin
                spos := spos + ILCSKIP;
                getdate(datestr);
                scopy(datestr, 1, result, rpos);
                rpos := rpos + ord(datestr[0])
            end
            else if (cmd = 'hb') or (cmd = '##') then begin
                spos := spos + ILCSKIP;
                blankstr[0] := chr(1);
                blankstr[1] := BLANK;
                scopy(blankstr, 1, result, rpos);
                rpos := succ(rpos)
            end
            else if cmd = 'hr' then begin
                spos := spos + ILCSKIP;
                gethour(hourstr);
                scopy(hourstr, 1, result, rpos);
                rpos := rpos + ord(hourstr[0])
            end
            else begin
                result[rpos] := source[spos];
                result[0] := succ(result[0]);
                spos := succ(spos);
                rpos := succ(rpos)
            end
        end
        else begin
            result[rpos] := source[spos];
            result[0] := succ(result[0]);
            spos := succ(spos);
            rpos := succ(rpos)
        end;
    scopy(source, spos, result, rpos)
end;

{ gettl -- construct title from buf the easy way (for .HE and .FO commands) }
{ John Stone, 8/5/86 }
procedure gettl (var buf : XSTRING; var ttl : TITLE);
var
    i : integer;
begin
    with ttl do begin
        leftmarg := 1;
        i := 1; { skip command name }
        while (buf[i] <> BLANK) and (buf[i] <> TAB) and (buf[i] <> NEWLINE) do
            i := succ(i);
        while (buf[i] = BLANK) or (buf[i] = TAB) do
            i := succ(i);     { find argument }
        if (buf[i] = SQUOTE) or (buf[i] = DQUOTE) then
            i := succ(i);     { strip leading quote }
        scopy(buf, i, lefttext, 1);
        lefttext[0] := pred(lefttext[0]);    { strip closing NEWLINE }
        middletext[0] := chr(0);
        righttext[0] := chr(0);
        rightmarg := rmval
    end
end;

{ gettitle -- construct title from buf the hard way (for .HD and .FT commands) }
{ John Stone, 8/5/86 }
procedure gettitle (var buf : XSTRING; var ttl : TITLE);
var
    i : integer;
    separator : char;
    position : integer;
begin
    with ttl do begin
        leftmarg := lmval;
        i := 1; { skip command name }
        while (buf[i] <> BLANK) and (buf[i] <> TAB) and (buf[i] <> NEWLINE) do
            i := succ(i);
        while (buf[i] = BLANK) or (buf[i] = TAB) do
            i := succ(i);     { find beginning of title segments }
        separator := buf[i];
        i := succ(i);
        position := 0;
        while (buf[i] <> separator) and (buf[i] <> NEWLINE) do begin
            position := succ(position);
            lefttext[position] := buf[i];
            i := succ(i)
        end;
        lefttext[0] := chr(position);
        if buf[i] <> NEWLINE then begin
            i := succ(i);
            position := 0;
            while (buf[i] <> separator) and (buf[i] <> NEWLINE) do begin
                position := succ(position);
                middletext[position] := buf[i];
                i := succ(i)
            end;
            middletext[0] := chr(position);
            if buf[i] <> NEWLINE then begin
                i := succ(i);
                position := 0;
                while (buf[i] <> separator) and (buf[i] <> NEWLINE) do begin
                    position := succ(position);
                    righttext[position] := buf[i];
                    i := succ(i)
                end;
                righttext[0] := chr(position)
            end
        end;
        rightmarg := rmval
    end
end;

{ ilcwidth -- compute width of in-line command at buf[pos] }
{ John Stone, 11/1/85, 1/4/86 }
function ilcwidth (var buf : XSTRING; var pos : integer): integer;
const
    ILCSKIP = 3;
var
    cmd : packed array [1..2] of char;
    form : XSTRING;
begin
    if succ(succ(pos)) > ord(buf[0]) then begin
        pos := succ(pos);
        ilcwidth := 1
    end
    else begin
        cmd[1] := lowercase(buf[succ(pos)]);
        cmd[2] := lowercase(buf[succ(succ(pos))]);
        if (cmd = 'fn') then begin
            pos := pos + ILCSKIP;
            inttostr(fnno, form);
            ilcwidth := ord(form[0])
        end
        else if (cmd = 'pn') then begin
            pos := pos + ILCSKIP;
            inttostr(curpage, form);
            ilcwidth := ord(form[0])
        end
        else if (cmd = 'da') then begin
            pos := pos + ILCSKIP;
            getdate(form);
            ilcwidth := ord(form[0])
        end
        else if (cmd = 'u+') or (cmd = 'u-') or
                (cmd = 'b+') or (cmd = 'b-') or
                (cmd = 'su') or (cmd = 'sb') then begin
            pos := pos + ILCSKIP;
            ilcwidth := 0
        end
        else if (cmd = 'hb') or (cmd = '##') then begin
            pos := pos + ILCSKIP;
            ilcwidth := 1
        end
        else if (cmd = 'hr') then begin
            pos := pos + ILCSKIP;
            gethour(form);
            ilcwidth := ord(form[0])
        end
        else begin
            pos := succ(pos);
            ilcwidth := 1
        end
    end
end;

{ width -- compute width of character string }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 249 }
{ John Stone, 11/1/85 }
function width (var buf : XSTRING) : integer;
var
    i, w : integer;
begin
    w := 0;
    i := 1;
    while (i <= ord(buf[0])) do
        if (buf[i] = BACKSPACE) then begin
            if w > 0 then
                w := pred(w);
            i := succ(i)
        end
        else if (buf[i] = inlinechar) then
            w := w + ilcwidth(buf, i)
        else if (buf[i] = NEWLINE) then
            i := succ(i)
        else begin
            w := succ(w);
            i := succ(i)
        end;
    width := w
end;

{ buildline -- convert TITLE to XSTRING for output }
{ John Stone, 8/5/86 }
procedure buildline (var ttl : TITLE; var line : XSTRING);
var
    leftwidth : integer;
    middlewidth : integer;
    rightwidth : integer;
    centerstart : integer;
    position : integer;
    count : integer;
begin
    with ttl do begin
        leftwidth := width(lefttext);
        middlewidth := width(middletext);
        rightwidth := width(righttext);
        centerstart := (leftmarg + rightmarg - middlewidth) div 2;
        position := 0;
        for count := 1 to leftmarg do begin
            position := succ(position);
            line[position] := BLANK
        end;
        for count := 1 to ord(lefttext[0]) do begin
            position := succ(position);
            line[position] := lefttext[count]
        end;
        for count := succ(leftmarg + leftwidth) to centerstart do begin
            position := succ(position);
            line[position] := BLANK
        end;
        for count := 1 to ord(middletext[0]) do begin
            position := succ(position);
            line[position] := middletext[count]
        end;
        for count := succ(centerstart + middlewidth) to 
                                            rightmarg - rightwidth do begin
            position := succ(position);
            line[position] := BLANK
        end;
        for count := 1 to ord(righttext[0]) do begin
            position := succ(position);
            line[position] := righttext[count]
        end;
        position := succ(position);
        line[position] := NEWLINE;
        line[0] := chr(position)
    end
end;

{ puthead -- put out page header }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 240 }
{ John Stone, 11/12/85 }
procedure puthead;
var
    i : integer;
    headline : XSTRING;
    expanded : XSTRING;
    tempulflag : Boolean;
    tempbfflag : Boolean;
    tempfnno : integer;
begin
    curpage := newpage;
    newpage := succ(newpage);
    for i := 1 to tmval do begin
        writeln(target);
        if onscreen then
            writeln(output)
    end;
    if (hmval > 0) then begin
        buildline(header, headline);
        tempulflag := ulflag;
        ulflag := false;
        tempbfflag := bfflag;
        bfflag := false;
        tempfnno := fnno;
        expandescapes(headline, expanded, PRINTER);
        putstr(target, expanded);
        if onscreen then begin
            fnno := tempfnno;
            expandescapes(headline, expanded, MONITOR);
            putstr(output, expanded)
        end;
        ulflag := tempulflag;
        bfflag := tempbfflag;
        for i := 1 to pred(hmval) do begin
            writeln(target);
            if onscreen then
                writeln(output)
        end
    end;
    lineno := succ(tmval + hmval)
end;

{ putfoot -- put out page footer }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 241 }
{ John Stone, 11/12/85 }
procedure putfoot;
var
    i : integer;
    footline : XSTRING;
    expanded : XSTRING;
    tempulflag : Boolean;
    tempbfflag : Boolean;
    tempfnno : integer;
begin
    if (fmval > 0) then begin
        for i := 1 to pred(fmval) do begin
            writeln(target);
            if onscreen then
                writeln(output)
        end;
        buildline(footer, footline);
        tempulflag := ulflag;
        ulflag := false;
        tempbfflag := bfflag;
        bfflag := false;
        tempfnno := fnno;
        expandescapes(footline, expanded, PRINTER);
        putstr(target, expanded);
        if onscreen then begin
            fnno := tempfnno;
            expandescapes(footline, expanded, MONITOR);
            putstr(output, expanded)
        end;
        ulflag := tempulflag;
        bfflag := tempbfflag
    end;
    for i := 1 to bmval do begin
        writeln(target);
        if onscreen then
            writeln(output)
    end
end;

{ insertfront -- add new xstring before first nonblank of object string }
{ John Stone, 11/1/85 }
procedure insertfront (var newstr : XSTRING; var object : XSTRING);
var
    pos : integer;
begin
    pos := 1;
    while object[pos] = BLANK do 
        pos := succ(pos);
    insert(newstr, object, pos)
end;

{ insertrear -- insert new xstring after last visible character of object }
{ John Stone, 11/1/85 }
procedure insertrear (var newstr : XSTRING; var object : XSTRING);
var
    newpos : integer;
begin
    newpos := ord(object[0]);
    while ((object[newpos] = BLANK) or (object[newpos] = TAB) or 
           (object[newpos] = NEWLINE)) and (newpos > 0) do
        newpos := pred(newpos);
    insert(newstr, object, succ(newpos))
end;

{ put -- put out line with proper spacing and indenting }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 240 }
{ John Stone, 11/1/85 }
procedure put (var buf : XSTRING);
var
    i : integer;
    vtexpanded : XSTRING;
    printerexpanded : XSTRING;
    initialulflag : Boolean;
    initialbfflag : Boolean;
    initialfnno : integer;
begin
    if (lineno <= 0) or (lineno > bottom) then
        puthead;
    for i := 1 to lmval + tival do begin     { indenting }
        write(target, BLANK);
        if onscreen then
            write(output, BLANK)
    end;
    tival := 0;
    if ulcross then
        insertfront(ulbegin, buf);
    if bfcross then
        insertfront(bfbegin, buf);
    initialulflag := ulflag;
    initialbfflag := bfflag;
    initialfnno := fnno;
    expandescapes(buf, printerexpanded, PRINTER);
    if onscreen then begin
        ulflag := initialulflag;
        bfflag := initialbfflag;
        fnno := initialfnno;
        expandescapes(buf, vtexpanded, MONITOR)
    end;
    ulcross := ulflag;
    bfcross := bfflag;
    if ulcross then begin
        insertrear(printerulend, printerexpanded);
        if onscreen then
            insertrear(vtulend, vtexpanded)
    end;
    if bfcross then begin
        insertrear(printerbfend, printerexpanded);
        if onscreen then
            insertrear(vtbfend, vtexpanded)
    end;
    putstr(target, printerexpanded);
    if onscreen then
        putstr(output, vtexpanded);
    if lsval <= bottom - lineno then
        for i := 1 to pred(lsval) do begin
            writeln(target);
            if onscreen then
                writeln(output)
        end
    else
        for i := 1 to bottom - lineno do begin
            writeln(target);
            if onscreen then
                writeln(output)
        end;
    lineno := lineno + lsval;
    if (lineno > bottom) then
        putfoot
end;

{ break -- end current filled line }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 249 }
{ John Stone, 11/12/85 }
procedure break;
begin
    if (ord(outbuf[0]) > 0) then begin
        outbuf[ord(outbuf[0])] := NEWLINE;
        put(outbuf)
    end;
    outbuf[0] := chr(0);
    outw := 0;
    outwds := 0
end;

{ space -- space n lines or to bottom of page }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 243 }
{ John Stone, 4/28/85 }
procedure space (n : integer);
var
    i : integer;
begin
    break;
    if (lineno <= bottom) then begin
        if (lineno <= 0) then
            puthead;
        if n <= succ(bottom - lineno) then
            for i := 1 to n do begin
                writeln(target);
                if onscreen then
                    writeln(output)
            end
        else
            for i := 0 to bottom - lineno do begin
                writeln(target);
                if onscreen then
                    writeln(output)
            end;
        lineno := lineno + n;
        if (lineno > bottom) then
            putfoot
    end
end;

{ page -- get to top of new page }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 243 }
{ John Stone, 4/28/85 }
procedure page;
var
    i : integer;
begin
    break;
    if (lineno > 0) and (lineno <= bottom) then begin
        for i := 0 to bottom - lineno do begin
            writeln(target);
            if onscreen then
                writeln(output)
        end;
        putfoot
    end;
    lineno := 0
end;

{ leadbl -- delete leading blanks, set tival }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 246 }
{ John Stone, 11/12/85 }
procedure leadbl (var buf : XSTRING);
var
    i : integer;
    pos : integer;
begin
    break;
    i := 1;
    while (buf[i] = BLANK) do   { find 1st non-blank }
        i := succ(i);
    if (buf[i] <> NEWLINE) then
        if autoparagraph then
            tival := tival + paval
        else
            tival := pred(tival + i);
    i := pred(i);
    buf[0] := chr(ord(buf[0]) - i);
    for pos := 1 to ord(buf[0]) do
        buf[pos] := buf[pos + i]
end;

{ spread -- spread words to justify right margin }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 251 }
{ John Stone, 10/31/85 }
procedure spread (var buf : XSTRING; nextra, outwds : integer);
var
    i, j, nb, nholes : integer;
begin
    if (nextra > 0) and (outwds > 1) then begin
        if dir = RIGHTWARDS then
            dir := LEFTWARDS
        else
            dir := RIGHTWARDS;
        nholes := pred(outwds);
        i := pred(ord(buf[0]));
        if i + nextra < MAXSTR then
            j := i + nextra
        else
            j := pred(MAXSTR);
        buf[0] := chr(succ(j));
        while (i < j) do begin
            buf[j] := buf[i];
            if (buf[i] = BLANK) then begin
                if (dir = LEFTWARDS) then
                    nb := succ(pred(nextra) div nholes)
                else
                    nb := nextra div nholes;
                nextra := nextra - nb;
                nholes := pred(nholes);
                while (nb > 0) do begin
                    j := pred(j);
                    buf[j] := BLANK;
                    nb := pred(nb)
                end
            end;
            i := pred(i);
            j := pred(j)
        end
    end
end;

{ endbutonematch -- determines whether str1 matches the part of str2 that 
  immediately precedes its rightmost character }
function endbutonematch (var str1, str2 : XSTRING) : Boolean;
label
    99;
var
    distance : integer;
    backup : integer;
begin
    distance := ord(str1[0]);
    if ord(str2[0]) < distance then
        endbutonematch := false
    else begin
        for backup := 1 to distance do
            if str1[succ(distance) - backup] <> str2[ord(str2[0]) - backup] then begin
                endbutonematch := false;
                goto 99
            end;
        endbutonematch := true
    end;
    99:
end;

{ putword -- put word in outbuf; does margin justification; trims hard blanks }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 248 }
{ John Stone, 10/31/85, 1/4/86 }
procedure putword (var wordbuf : XSTRING);
var
    last, llval, nextra, w, pos : integer;
begin
    w := width(wordbuf);
    last := succ(ord(wordbuf[0]) + ord(outbuf[0]));    { new end of outbuf }
    llval := rmval - tival - lmval;
    if (ord(outbuf[0]) > 0) and ((outw+w > llval) or (last > MAXSTR)) then begin
        last := last - ord(outbuf[0]);    { remember end of wordbuf }
        if justify then begin
            nextra := succ(llval - outw);
            while (endbutonematch(hardblank, outbuf)) or
                    (endbutonematch(althardblank, outbuf)) do begin
                outbuf[0] := chr(ord(outbuf[0]) - 3);
                nextra := succ(nextra)
            end;
            if (nextra > 0) and (outwds > 1) then
                spread(outbuf, nextra, outwds)
        end;
        break   { flush previous line }
    end;
    for pos := 1 to ord(wordbuf[0]) do
        outbuf[ord(outbuf[0]) + pos] := wordbuf[pos];
    outbuf[last] := BLANK;
    outbuf[0] := chr(last);
    outw := succ(outw + w);       { 1 for blank }
    outwds := succ(outwds)
end;

{ getword -- get word from s[i] into out }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 72 }
{ John Stone, 11/12/85, 1/4/86 }
function getword (var s : XSTRING; i : integer; var out : XSTRING) : integer;
var
    j, k : integer;
    done : Boolean;
    ch : char;
begin
    out[0] := chr(0);
    while (s[i] = BLANK) or (s[i] = TAB) or (s[i] = NEWLINE) do
        i := succ(i);
    j := 1;
    while (i <= ord(s[0])) and (s[i] <> BLANK) and (s[i] <> TAB) and 
                                                   (s[i] <> NEWLINE) do begin
        out[j] := s[i];
        i := succ(i);
        j := succ(j)
    end;
    out[0] := chr(pred(j));
    ch := out[pred(j)];
    if (ch = PERIOD) or (ch = COLON) or (ch = EXCL) or (ch = QUES) then
        scopy(hardblank, 1, out, j)
    else if (ch = DQUOTE) or (ch = SQUOTE) or (ch = RPAREN) or (ch = RBRACK) or 
                                                       (ch = RBRACE) then begin
        k := pred(j);
        repeat
            k := pred(k);
            if k <= 0 then
                done := true
            else begin
                ch := out[k];
                done := (ch <> DQUOTE) and (ch <> SQUOTE) and (ch <> RPAREN) 
                                       and (ch <> RBRACK) and (ch <> RBRACE)
            end
        until done;
        if k > 0 then
            if (ch = PERIOD) or (ch = EXCL) or (ch = QUES) then
                        scopy(hardblank, 1, out, j)
    end;
    if i > ord(s[0]) then
        getword := 0
    else
        getword := i
end;

{ center -- center a line by setting tival }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 252 }
{ John Stone, 4/28/85 }
procedure center (var buf : XSTRING);
begin
    tival := (rmval + tival - lmval - width(buf)) div 2;
    if tival < 0 then
        tival := 0
end;

{ initfmt -- set format parameters to default values }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 256 }
{ John Stone, 11/12/85 }
procedure initfmt;
begin
    cmdchar := PERIOD;
    inlinechar := WHORL;
    fill := true;
    justify := false;
    autoparagraph := true;
    dir := LEFTWARDS;
    lmval := 10;
    rmval := PAGEWIDTH - 10;
    tival := 0;
    lsval := 1;
    ceval := 0;
    paval := 5;
    ulval := 0;
    ulflag := false;
    ulshift := false;
    ulcross := false;
    bfval := 0;
    bfflag := false;
    bfshift := false;
    bfcross := false;
    fnno := 1;
    lineno := 0;
    curpage := 0;
    newpage := 1;
    plval := PAGELEN;
    tmval := 6;
    hmval := 0;
    fmval := 0;
    bmval := 6;
    bottom := plval - fmval - bmval;
    tempfill := true;
    tempjust := false;
    tempap := true;
    temppaval := 5;
    with header do begin
        leftmarg := lmval;
        lefttext[0] := chr(0);
        middletext[0] := chr(0);
        righttext[0] := chr(0);
        rightmarg := rmval
    end;
    footer := header;
    outbuf[0] := chr(0);
    outw := 0;
    outwds := 0
end;

{ setstrings -- initialize escape sequences, etc. }
{ John Stone, 11/1/85 }
procedure setstrings;
begin
    BACKSPACE := chr(8);
    TAB := chr(9);
    NEWLINE := chr(10);
    ESCAPE := chr(27);
    ulbegin[0] := chr(4);
    ulbegin[1] := ESCAPE;
    ulbegin[2] := LBRACK;
    ulbegin[3] := '4';
    ulbegin[4] := 'm';
    vtulend[0] := chr(4);
    vtulend[1] := ESCAPE;
    vtulend[2] := LBRACK;
    vtulend[3] := '0';
    vtulend[4] := 'm';
    printerulend[0] := chr(5);
    printerulend[1] := ESCAPE;
    printerulend[2] := LBRACK;
    printerulend[3] := '2';
    printerulend[4] := '4';
    printerulend[5] := 'm';
    uplus[0] := chr(3);
    uplus[1] := inlinechar;
    uplus[2] := 'u';
    uplus[3] := '+';
    uminus[0] := chr(3);
    uminus[1] := inlinechar;
    uminus[2] := 'u';
    uminus[3] := '-';
    bfbegin[0] := chr(4);
    bfbegin[1] := ESCAPE;
    bfbegin[2] := LBRACK;
    bfbegin[3] := '1';
    bfbegin[4] := 'm';
    vtbfend[0] := chr(4);
    vtbfend[1] := ESCAPE;
    vtbfend[2] := LBRACK;
    vtbfend[3] := '0';
    vtbfend[4] := 'm';
    printerbfend[0] := chr(5);
    printerbfend[1] := ESCAPE;
    printerbfend[2] := LBRACK;
    printerbfend[3] := '2';
    printerbfend[4] := '2';
    printerbfend[5] := 'm';
    bplus[0] := chr(3);
    bplus[1] := inlinechar;
    bplus[2] := 'b';
    bplus[3] := '+';
    bminus[0] := chr(3);
    bminus[1] := inlinechar;
    bminus[2] := 'b';
    bminus[3] := '-';
    halfup[0] := chr(2);
    halfup[1] := ESCAPE;
    halfup[2] := 'L';
    halfdown[0] := chr(2);
    halfdown[1] := ESCAPE;
    halfdown[2] := 'K';
    hardblank[0] := chr(3);
    hardblank[1] := inlinechar;
    hardblank[2] := '#';
    hardblank[3] := '#';
    althardblank[0] := chr(3);
    althardblank[1] := inlinechar;
    althardblank[2] := 'h';
    althardblank[3] := 'b'
end;

{ command -- perform formatting command }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, pp. 234-5 }
{ John Stone, 11/12/85, 1/4/86, 1/15/86 }
procedure command (var buf : XSTRING);
const
    HUGE = 10000;
var
    cmd : CMDTYPE;
    argtype : char;
    spval, val : integer;
    noncelsval : integer;
begin
    cmd := getcmd(buf);
    if (cmd <> UNKNOWN) then
        val := getval(buf, argtype);
    case cmd of
        FI: 
            begin
                break;
                fill := true
            end;
        NF:
            begin
                break;
                fill := false
            end;
        JU:
            begin
                break;
                justify := true
            end;
        NJ:
            begin
                break;
                justify := false
            end;
        BR:
            break;
        LS:
            setparam(lsval, val, argtype, 1, 1, HUGE);
        CE:
            begin
                break;
                setparam(ceval, val, argtype, 1, 0, HUGE)
            end;
        UL:
            begin
                setparam(ulval, val, argtype, 1, 0, HUGE);
                ulflag := (ulval > 0);
                ulshift := true
            end;
        BF:
            begin
                setparam(bfval, val, argtype, 1, 0, HUGE);
                bfflag := (bfval > 0);
                bfshift := true
            end;
        HE:
            gettl(buf, header);
        FO:
            gettl(buf, footer);
        HD:
            gettitle(buf, header);
        FT:
            gettitle(buf, footer);
        PG:
            begin
                page;
                setparam(curpage, val, argtype, succ(curpage), -HUGE, HUGE);
                newpage := curpage
            end;
        BL:
            begin
                setparam(spval, val, argtype, 1, 0, HUGE);
                noncelsval := lsval;
                lsval := 1;
                space(spval);
                lsval := noncelsval
            end;
        SP:
            begin
                setparam(spval, val, argtype, 1, 0, HUGE);
                space(lsval * spval)
            end;
        LM:
            begin
                break;
                setparam(lmval, val, argtype, 0, 0, pred(rmval))
            end;
        RM:
            begin
                break;
                setparam(rmval, val, argtype,
                                    PAGEWIDTH, succ(lmval + tival), HUGE)
            end;
        TI:
            begin
                break;
                setparam(tival, val, argtype, 0, -HUGE, rmval)
            end;
        PL:
            begin
                setparam(plval, val, argtype,
                      PAGELEN, succ(tmval + hmval + fmval + bmval), HUGE);
                bottom := plval - fmval - bmval
            end;
        CC: 
            cmdchar := argtype;
        CI:
            begin
                inlinechar := argtype;
                uplus[1] := inlinechar;
                uminus[1] := inlinechar;
                bplus[1] := inlinechar;
                bminus[1] := inlinechar;
                hardblank[1] := inlinechar;
                althardblank[1] := inlinechar
            end;
        TM:
            setparam(tmval, val, argtype,
                               0, 0, pred(plval - hmval - fmval - bmval));
        BM:
            begin
                setparam(bmval, val, argtype,
                               0, 0, pred(plval - tmval - hmval - fmval));
                bottom := plval - fmval - bmval
            end;
        FM:
            begin
                setparam(fmval, val, argtype,
                               0, 0, pred(plval - tmval - hmval - bmval));
                bottom := plval - fmval - bmval
            end;
        HM:
            setparam(hmval, val, argtype,
                               0, 0, pred(plval - tmval - fmval - bmval));
        TP:
            begin
                if argtype = MINUS then
                    val := 0;
                if val > bottom - lineno then
                    page
            end;
        PA:
            begin
                autoparagraph := true;
                paval := 0;
                setparam (paval, val, argtype, 0, -lmval, pred(rmval - lmval))
            end;
        NP:
            autoparagraph := false;
        LI:
            if not literal then begin
                literal := true;
                tempfill := fill;
                fill := false;
                tempjust := justify;
                justify := false;
                tempap := autoparagraph;
                autoparagraph := false;
                temppaval := paval;
                templsval := lsval;
                lsval := 1
            end;
        RF:
            if literal then begin
                literal := false;
                fill := tempfill;
                justify := tempjust;
                autoparagraph := tempap;
                paval := temppaval;
                lsval := templsval
            end;
        FC:
            setparam(fnno, val, argtype, 1, 0, HUGE);
        UNKNOWN:
            { ignore }
    end
end;

{ detab -- replace tabs in input line with blanks }
{ John Stone, 11/12/85 }
procedure detab (var source, target : XSTRING);
const
    TABSPACE = 8;   { uniform interval between tab stops }
var
    spos, tpos : integer;
begin
    spos := 1;
    tpos := 1;
    while (spos <= ord(source[0])) do begin
        if source[spos] = TAB then
            repeat
                if tpos <= MAXSTR then
                    target[tpos] := BLANK;
                tpos := succ(tpos)
            until tpos mod TABSPACE = 1
        else if tpos <= MAXSTR then begin
            target[tpos] := source[spos];
            tpos := succ(tpos)
        end;
        spos := succ(spos)
    end;
    if tpos > MAXSTR then begin
        target[0] := chr(MAXSTR);
        target[MAXSTR] := NEWLINE
    end
    else
        target[0] := chr(pred(tpos))
end;

{ occursin -- determines whether a given character occurs in a given string }
{ John Stone, 8/21/86 }
function occursin (ch : char; var str : XSTRING) : Boolean;
label
    99;
var
    pos : integer;
begin
    for pos := 1 to ord(str[0]) do
        if str[pos] = ch then begin
            occursin := true;
            goto 99
        end;
    occursin := false;
    99:
end;

{ xtext -- process text lines }
{ Kernighan and Plauger, SOFTWARE TOOLS IN PASCAL, p. 254 }
{ John Stone, 11/1/85, 1/4/86 }
procedure xtext (var inbuf : XSTRING);
var
    detabbuf : XSTRING;
    wordbuf : XSTRING;
    i : integer;
begin
    if occursin(TAB, inbuf) then begin
        detabbuf := inbuf;
        detab (detabbuf, inbuf)
    end;
    if (inbuf[1] = BLANK) or (inbuf[1] = NEWLINE) then
        leadbl(inbuf);  { move left, set tival }
    if (ulshift) then begin
        if (ulflag) then       { start underlining }
            insertfront(uplus, inbuf)
        else                   { stop underlining }
            insertfront(uminus, inbuf);
        ulshift := false
    end;
    if (ulval > 0) then begin       { keep underlining }
        ulval := pred(ulval);
        if (ulval = 0) then
            insertrear(uminus, inbuf)
    end;
    if (bfshift) then begin
        if (bfflag) then       { start boldfacing }
            insertfront(bplus, inbuf)
        else                   { stop boldfacing }
            insertfront(bminus, inbuf);
        bfshift := false
    end;
    if (bfval > 0) then begin       { keep boldfacing }
        bfval := pred(bfval);
        if (bfval = 0) then
            insertrear(bminus, inbuf)
    end;
    if (ceval > 0) then begin       { centering }
        center(inbuf);
        put(inbuf);
        ceval := pred(ceval)
    end
    else if (inbuf[1] = NEWLINE) then   { all-blank line }
        put(inbuf)
    else if (not fill) then         { unfilled text }
        put(inbuf)
    else begin  { filled text }
        i := 1;
        repeat
            i := getword(inbuf, i, wordbuf);
            if (i > 0) then
                putword(wordbuf)
        until (i = 0)
    end
end;

begin { srof }
    initfmt;
    setstrings;
    getnames(sourcename, targetname, onscreen);
    openfiles(sourcename, source, targetname, target);
    if onscreen then
        putstr(output, vtbfend);
    while not eof(source) do begin
        pos := 0;
        while (pos < pred(MAXSTR)) and not eoln(source) do begin
            pos := succ(pos);
            read(source, inbuf[pos])
        end;
        readln(source);
        pos := succ(pos);
        inbuf[pos] := NEWLINE;
        inbuf[0] := chr(pos);
        if (inbuf[1] = cmdchar) then
            command(inbuf)
        else
            xtext(inbuf)
    end;
    page;   { flush last output, if any }
    999:
end.