# FILE 9 OF SOFTWARE TOOLS FROM LBL #-h- ROFFSYM 901 asc 23-MAY-79 21:45:50 # additional definitions for the text formatter of chapter 7 # put on a file called 'roffsym' # These are used only by the text formatter define(INSIZE,400) define(MAXOUT,400) define(FLMAX,10) define(PAGENUM,SHARP) define(DATECHAR,PERCENT) define(PAGEWIDTH,65) define(PAGELEN,66) define(MAXCHARS,10) define(UNKNOWN,0) define(LEFT,1) define(CENTER,2) define(RIGHT,3) define(CONTROLL,12) define(FI,1) define(NF,2) define(BR,3) define(LS,4) define(BP,5) define(SP,6) define(IN,7) define(RM,8) define(TI,9) define(CE,10) define(UL,11) define(HE,12) define(FO,13) define(PL,14) define(PO,15) define(BD,16) define(M1,17) define(M2,18) define(M3,19) define(M4,20) define(EH,21) define(OH,22) define(EF,23) define(OF,24) define(CC,25) define(NE,26) define(BS,27) define(JU,28) define(NJ,29) define(HUGE,1000) #-h- COUT 503 asc 23-MAY-79 21:45:51 # common block /cout/ # put on a file called 'cout' # used only the text formatter common /cout/ outp, outw, outwds, prep, outbuf(MAXOUT) integer outp # last char position in outbuf; init = 0 integer outw # width of text currently in outbuf; init = 0 integer prep # last charac position of next to last # word in outbuf; init=0 integer outwds # number of words in outbuf; init = 0 character outbuf # lines to be filled collect here #-h- CPAGE 1676 asc 23-MAY-79 21:45:54 # common block /cpage/ # put on a file called 'cpage' # used only by the text formatter common /cpage/ curpag,newpag,lineno,plval,m1val,m2val,m3val,m4val, bottom, ehlim(2), ohlim(2), eflim(2), oflim(2), stopx, frstpg, lstpag, print, offset, ehead(MAXLINE), ohead(MAXLINE), efoot(MAXLINE), ofoot(MAXLINE) integer curpag # current output page number; init = 0 integer newpag # next output page number; init = 1 integer lineno # next line to be printed; init = 0 integer plval # page length in lines; init = PAGELEN = 66 integer m1val # margin before and including header integer m2val # margin after header integer m3val # margin after last text line integer m4val # bottom margin, including footer integer bottom # last live line on page, = plval-m3val-m4val integer ehlim # left,right margins for even header;init=inval,rmval integer frstpg #first page to begin printing with integer lstpag #last page to be printed integer print #flag to indicate whether page should be printed integer offset #number of blanks to offset page by; init = 0 integer ohlim # left,right margins for odd header;init=inval,rmval integer eflim # left,right margins for even footer;init=inval,rmval integer oflim # left,right margins for odd footer;init=inval,rmval integer stopx #flag for pausing between pages character ehead # top of page title for even pages;init=NEWLINE character ohead # top of page title for odd pages;init=NEWLINE character efoot # bot of page title for even pages;init=NEWLINE character ofoot # bot of page title for odd pages;init=NEWLINE #-h- CPARAM 966 asc 23-MAY-79 21:45:55 # common block /cparam/ # put on a file called 'cparam' # used only by the text formatter common /cparam/ fill, lsval, inval, rmval, tival, ceval, ulval, boval, tjust(3), bsval, rjust, cchar integer fill # fill if YES; init = YES integer lsval # current line spacing; init = 1 integer inval # current indent; >= 0; init = 0 integer rmval # current right margin; init = PAGEWIDTH = 60 integer tival # current temporary indent; init = 0 integer ceval # number of lines to center; init = 0 integer ulval # number of lines to underline; init = 0 integer boval # number of lines to boldface; init = 0 integer tjust # justification types for heads and foots; # init = LEFT, CENTER, RIGHT integer bsval # number of lines to blank suppress; init=0 integer rjust # right justify filled lines if YES; init=YES character cchar # line control character; init = PERIOD #-h- FLIST 244 asc 7-JUN-79 17:15:47 ## flist common block # Put on a file called 'flist' # Used by the tools: sort, roff, lpr (VMS version), ls (VMS version) #flist - common block common /flist/ flevel, ffiles(FILENAMESIZE, FLMAX) integer flevel character ffiles #-h- RSCRAT 267 asc 23-MAY-79 21:45:57 # common block /rscrat/ # put on a file called 'rscrat' # used only by the text formatter common /rscrat/ tbuf1(MAXLINE), tbuf2(MAXLINE), ttl(MAXLINE) character tbuf1 # scratch arrays for use by puttl and tabs character tbuf2 # character ttl # #-h- ROFF.R 27345 asc 8-JUN-79 14:21:23 #-h- ROFMAIN.Q 129 29-SEP-78 10:27:51 #------------------------------------------------------------- ## main driver for roff call initr4 call roff call endr4 end #-h- ROFFS.Q 1222 asc 23-MAY-79 21:45:10 #------------------------------------------------------------- # include symbols include roffsym #-------------------------------------------------------------- ## roff -- roff program subroutine roff character iarg(FILENAMESIZE) character inbuf(INSIZE) integer i, int integer getarg, open, getlin # integer getctp, type include flist include cpage include cout include cparam data flevel/0/ call rofint for (i=1; getarg(i, iarg, FILENAMESIZE) ^= EOF; i=i+1) { if ((iarg(1) == MINUS | iarg(1) == PLUS) & iarg(2) ^= EOS) call rofcmd(iarg) else if (iarg(1) == QMARK & iarg(2) == EOS) call error ('usage: roff +n! -n! -s! -po! file!.') else call fstack(iarg) } if (flevel <= 0) { flevel = 1 ffiles(1,1) = MINUS } for (i=1; i<= flevel; i=i+1) { if (ffiles(1,i) == MINUS) int = STDIN else int = open (ffiles(1,i), READ) if (int == ERR) call cant(ffiles(1,i)) while (getlin(inbuf, int) ^= EOF) { if (inbuf(1) == cchar) call comand(inbuf) else call text(inbuf) } if (int ^= STDIN) call close(int) } if (lineno > 0 | outp > 0) call space(HUGE) call putc(NEWLINE) return end #-h- BRK.Q 322 10-AUG-78 15:40:19 #------------------------------------------------------------ ## brk - end current filled line subroutine brk include cout if (outp > 0) { outbuf(outp) = NEWLINE outbuf(outp+1) = EOS call put(outbuf) } outp = 0 outw = 0 outwds = 0 prep = 0 return end #-h- CENTER.Q 279 10-AUG-78 22:04:05 #------------------------------------------------------------ ## center - center a line by setting tival subroutine center(buf) character buf(ARB) # integer max integer width include cparam tival = max((rmval+tival-width(buf))/2, 0) return end #-h- ROFCMD.Q 1208 asc 8-JUN-79 14:16:20 #------------------------------------------------------------ ## rofcmd - process control command (preceded by MINUS or PLUS sign) subroutine rofcmd (iarg) integer create, ctoi, i, val character iarg(ARB), argtyp, terml(FILENAMESIZE) include flist include cpage include cparam #check for pause flag (-S) if (iarg(1) == MINUS & (iarg(2) == LETS | iarg(2) == BIGS)) { #open channel to user's teletype call termin (terml) stopx = create(terml, READ) if (stopx == ERR) { call remark ("Can't open user's terminal.") stopx = 0 } } #check for page offset (-POn) else if (iarg(1) == MINUS & (iarg(2) == LETP | iarg(2) == BIGP) & (iarg(3) == LETO | iarg(3) == BIGO)) { i = 4 val = ctoi (iarg, i) argtyp = iarg(4) call set (offset, val, argtyp, 0, 0, rmval-1) } #check for beginning page number (+n) else if (iarg(1) == PLUS) { i = 2 frstpg = ctoi (iarg, i) } #check for last page number (-n) else if (iarg(1) == MINUS) { i = 2 lstpag = ctoi (iarg, i) } #error else call remark ('ignoring invalid argument.' ) return end #-h- COMAND.Q 3210 asc 12-APR-79 12:23:00 #------------------------------------------------------------ ## comand - perform formatting command # call to set for underline corrected 12 April 78 - DEH subroutine comand(buf) character buf(MAXLINE), argtyp # integer max integer comtyp, getval integer ct, spval, val include cpage include cparam ct = comtyp(buf) if (ct == UNKNOWN) # ignore unknown commands return val = getval(buf, argtyp) if (ct == FI) { call brk fill = YES } else if (ct == NF) { call brk fill = NO } else if (ct == BR) call brk else if (ct == LS) call set(lsval, val, argtyp, 1, 1, HUGE) else if (ct == CE) { call brk call set(ceval, val, argtyp, 1, 0, HUGE) } else if (ct == UL) call set(ulval, val, argtyp, 1, 0, HUGE) else if (ct == BD) { call set(boval, val, argtyp, 0, 1, HUGE) } else if (ct == HE) { call gettl(buf, ehead, ehlim) call gettl(buf, ohead, ohlim) } else if (ct == FO) { call gettl(buf, efoot, eflim) call gettl(buf, ofoot, oflim) } else if (ct == BP) { call brk # perform break explicitly if (lineno > 0) { call space(HUGE) } call set(curpag, val, argtyp, curpag+1, -HUGE, HUGE) newpag = curpag } else if (ct == SP) { call set(spval, val, argtyp, 1, 0, HUGE) call space(spval) } else if (ct == IN) { call brk call set(inval, val, argtyp, 0, 0, rmval-1) tival = inval } else if (ct == RM) call set(rmval, val, argtyp, PAGEWIDTH, tival+1, HUGE) else if (ct == TI) { call brk call set(tival, val, argtyp, 0, 0, rmval) } else if (ct == PL) { call set(plval, val, argtyp, PAGELEN, m1val+m2val+m3val+m4val+1, HUGE) bottom = plval - m3val - m4val } else if (ct == PO) call set (offset, val, argtyp, 0, 0, rmval-1) else if (ct == M1) call set (m1val, val, argtyp, 3, 0, plval-m2val-m3val-m4val-1) else if (ct == M2) call set (m2val, val, argtyp, 2, 0, plval-m1val-m3val-m4val-1) else if (ct == M3) { call set (m3val, val, argtyp, 2, 0, plval-m1val-m2val-m4val-1) bottom = plval - m3val - m4val } else if (ct == M4) { call set (m4val, val, argtyp, 3, 0, plval-m1val-m2val-m3val-1) bottom = plval - m3val - m4val } else if (ct == EH) call gettl(buf,ehead, ehlim) else if (ct == OH) call gettl(buf,ohead, ohlim) else if (ct == EF) call gettl(buf,efoot, eflim) else if (ct == OF) call gettl(buf,ofoot, oflim) else if (ct == CC) cchar = argtyp else if (ct == NE) { if ((lineno + val) > bottom & lineno <= bottom) { call space(val) lineno = 0 } } else if (ct == BS) call set(bsval, val, argtyp, 1, 0, HUGE) else if (ct == JU) rjust = YES else if (ct == NJ) rjust = NO return end #-h- COMTYP.Q 1940 04-OCT-78 12:17:04 #------------------------------------------------------------ ## comtyp - decode command type integer function comtyp(buf) character buf(MAXLINE), c1, c2, clower c1 = clower(buf(2)) c2 = clower(buf(3)) if (c1 == LETF & c2 == LETI) comtyp = FI else if (c1 == LETN & c2 == LETF) comtyp = NF else if (c1 == LETB & c2 == LETR) comtyp = BR else if (c1 == LETL & c2 == LETS) comtyp = LS else if (c1 == LETB & c2 == LETP) comtyp = BP else if (c1 == LETS & c2 == LETP) comtyp = SP else if (c1 == LETI & c2 == LETN) comtyp = IN else if (c1 == LETR & c2 == LETM) comtyp = RM else if (c1 == LETT & c2 == LETI) comtyp = TI else if (c1 == LETC & c2 == LETE) comtyp = CE else if (c1 == LETU & c2 == LETL) comtyp = UL else if (c1 == LETH & c2 == LETE) comtyp = HE else if (c1 == LETF & c2 == LETO) comtyp = FO else if (c1 == LETP & c2 == LETL) comtyp = PL else if (c1 == LETP & c2 == LETO) comtyp = PO else if (c1 == LETB & c2 == LETD) comtyp = BD else if (c1 == LETM & c2 == DIG1) comtyp = M1 else if (c1 == LETM & c2 == DIG2) comtyp = M2 else if (c1 == LETM & c2 == DIG3) comtyp = M3 else if (c1 == LETM & c2 == DIG4) comtyp = M4 else if (c1 == LETE & c2 == LETH) comtyp = EH else if (c1 == LETO & c2 == LETH) comtyp = OH else if (c1 == LETE & c2 == LETF) comtyp = EF else if (c1 == LETO & c2 == LETF) comtyp = OF else if (c1 == LETC & c2 == LETC) comtyp = CC else if (c1 == LETN & c2 == LETE) comtyp = NE else if (c1 == LETB & c2 == LETS) comtyp = BS else if (c1 == LETJ & c2 == LETU) comtyp = JU else if (c1 == LETN & c2 == LETJ) comtyp = NJ else comtyp = UNKNOWN return end #-h- FSTACK.Q 358 10-AUG-78 16:37:49 #------------------------------------------------------------ ## fstack - generate stack of input files subroutine fstack (iarg) integer i character iarg(FILENAMESIZE) include flist if (flevel < FLMAX) { flevel = flevel + 1 for (i=1; i<=FILENAMESIZE; i=i+1) ffiles(i,flevel) = iarg(i) } return end #-h- GETTL.Q 528 10-AUG-78 15:42:28 #------------------------------------------------------------ ## gettl - copy title from buf to ttl subroutine gettl(buf, ttl, lim) character buf(MAXLINE), ttl(MAXLINE) integer i, lim(2) include cparam i = 1 # skip command name while (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= NEWLINE) i = i + 1 call skipbl(buf, i) # find argument call scopy(buf, i, ttl, 1) # copy titles to ttl lim(1) = inval # set limits lim(2) = rmval return end #-h- GETVAL.Q 512 10-AUG-78 15:42:30 #------------------------------------------------------------ ## getval - evaluate optional numeric argument integer function getval(buf, argtyp) character buf(MAXLINE), argtyp integer ctoi integer i i = 1 # skip command name while (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= NEWLINE) i = i + 1 call skipbl(buf, i) # find argument argtyp = buf(i) if (argtyp == PLUS | argtyp == MINUS) i = i + 1 getval = ctoi(buf, i) return end #-h- ROFINT.Q 1139 04-OCT-78 12:17:10 #------------------------------------------------------------ ## rofint - set parameters to default values subroutine rofint include cparam include cpage include cout #initialize /cparam/ variables inval = 0 rmval = PAGEWIDTH tival = 0 lsval = 1 fill = YES ceval = 0 ulval = 0 boval = 0 cchar = PERIOD # initial command character tjust(1) = LEFT; tjust(2) = CENTER; tjust(3) = RIGHT bsval = 0 rjust = YES #initialize /cpage/ variables lineno = 0 curpag = 0 newpag = 1 plval = PAGELEN m1val = 3; m2val = 2; m3val = 2; m4val = 3 bottom = plval - m3val - m4val ehead(1) = EOS # initial titles ohead(1) = EOS efoot(1) = EOS ofoot(1) = EOS ehlim(1) = inval; ehlim(2) = rmval #initial limits for headers ohlim(1) = inval; ohlim(2) = rmval eflim(1) = inval; eflim(2) = rmval oflim(1) = inval; oflim(2) = rmval print = YES frstpg = 0 lstpag = 1000 stopx = 0 offset = 0 #initialize /cout/ variables outp = 0 outw = 0 outwds = 0 prep = 0 return end #-h- LEADBL.Q 506 10-AUG-78 22:04:27 #------------------------------------------------------------ ## leadbl - delete leading blanks, set tival subroutine leadbl(buf) character buf(MAXLINE) # integer max integer i, j include cparam call brk for (i = 1; buf(i) == BLANK; i = i + 1) # find 1st non-blank ; if (buf(i) ^= NEWLINE) tival = i - 1 for (j = 1; buf(i) ^= EOS; j = j + 1) { # move line to left buf(j) = buf(i) i = i + 1 } buf(j) = EOS return end #-h- PFOOT.Q 399 10-AUG-78 15:43:49 #------------------------------------------------------------ ## pfoot - put out page footer subroutine pfoot include cpage integer even call skip(m3val) # check for even/odd if(even(curpag) == YES) call puttl(efoot,eflim,curpag) else call puttl(ofoot,oflim,curpag) if(print == YES) call putc(CONTROLL) return end #-h- PHEAD.Q 1092 asc 8-JUN-79 14:14:05 #------------------------------------------------------------ ## phead - put out page header subroutine phead include cpage include rscrat integer even, first, tty, getlin, junk data first /YES/ curpag = newpag #see if current page should be printed if (curpag >= frstpg & curpag <= lstpag) print = YES else print = NO if (print == YES) { if (first == YES) { if (stopx ^= 0 & tty(STDOUT) == YES) { call putlin('Position paper, then hit CR to continue.', STDOUT) call putch(NEWLINE, STDOUT) } first = NO if (tty(STDOUT) ^= YES) call putc(CONTROLL) } if (stopx ^= 0 & tty(STDOUT) == YES) junk = getlin (tbuf1, stopx) } newpag = newpag + 1 call skip(m1val-1) lineno = max(m1val-1, 0) # check for even/odd if(even(curpag) == YES) call puttl(ehead,ehlim,curpag) else call puttl(ohead,ohlim,curpag) call skip(m2val) lineno = lineno + max(m2val, 0) return end #-h- PUT.Q 716 10-AUG-78 22:04:31 #------------------------------------------------------------ ## put - put out line with proper spacing and indenting subroutine put(buf) character buf(MAXLINE) # integer min integer i include cpage include cparam if (lineno == 0 | lineno > bottom) call phead if (print == YES) #handle page offset { for (i=1; i<=offset; i=i+1) call putc (BLANK) } for (i = 1; i <= tival; i = i + 1) # indenting if (print == YES) call putc(BLANK) tival = inval if (print == YES) call putlin(buf, STDOUT) call skip(min(lsval-1, bottom-lineno)) lineno = lineno + lsval if (lineno > bottom) call pfoot return end #-h- PUTTL.Q 1535 09-OCT-78 14:12:06 #------------------------------------------------------------ ## puttl - put out title line with optional page number subroutine puttl(buf, lim, pageno) character buf(MAXLINE), chars(MAXCHARS), delim, datbuf(10) integer pageno, lim(2), first integer nc, itoc, i, j, n, left, right, gfield include cpage include cparam include rscrat data first /YES/ if (print == YES & buf(1) ^= EOS) { if (first == YES) { call date(datbuf) datbuf(10) = EOS first = NO } lineno = lineno + 1 # increment line count left = lim(1) + 1 right = lim(2) + 1 nc = itoc(pageno, chars, MAXCHARS) # format pageno # nc = no. of characters i = 1 delim = buf(i) # get delimiter for (j=1; j 0) { call sbst (tbuf1,PAGENUM,tbuf2,chars,nc) call sbst (tbuf2,DATECHAR,tbuf1,datbuf,9) call justfy(tbuf1,left,right,tjust(n),ttl) } } until (buf(i) == EOS | buf(i) == NEWLINE | n == 3) ttl(right) = NEWLINE ttl(right+1) = EOS for (i=1; i<=offset; i=i+1) call putc(BLANK) # offset for (i=1; ttl(i) ^= EOS; i=i+1) call putc(ttl(i)) #title } return end #-h- PUTWRD.Q 2011 asc 12-APR-79 12:24:51 #------------------------------------------------------------ ## putwrd - put a word in outbuf; includes margin justification # changed to allow blank suppression between words--26MAY78-JSS # cosmetic adjustments of 1st 4 lines of executable code # done 12 April 79 - DEH subroutine putwrd(wrdbuf, bs) character wrdbuf(INSIZE) integer length, width integer last, llval, nextra, w integer bs, nb, i, j, wwidth include cout include cparam include rscrat prep = outp if (outp ^= 0 & bs > 0) nb = 0 else nb = 1 w = width(wrdbuf) last = length(wrdbuf) + outp + nb # new end of outbuf llval = rmval - tival wwidth = outw + w + nb - 1 if (prep > 0 & (wwidth > llval | last >= MAXOUT)) # too big { last = last - prep if (nb == 0) # copy entire compressed word into wrdbuf { i = prep + 1 j = 1 while (i < outp) { tbuf1(j) = outbuf(i) i = i + 1 j = j + 1 } call scopy(wrdbuf, 1, tbuf1, j) call scopy(tbuf1, 1, wrdbuf, 1) outwds = outwds - 1 # compressed word was contained in count } outp = prep w = width(wrdbuf) nextra = llval - wwidth + w + 1 nb = 1 # check to see if last word in outbuf is end of sentence if (outbuf(outp-2) == PERIOD & outbuf(outp-1) == BLANK) { outp = outp - 1 nextra = nextra + 1 } if (rjust == YES) { call spread(outbuf, outp, nextra, outwds) if (nextra > 0 & outwds > 1) outp = outp + nextra } call brk # flush previous line } call scopy(wrdbuf, 1, outbuf, outp+nb) outp = last outbuf(outp) = BLANK # blank between words outw = outw + w + nb # 1 for blank outwds = outwds + nb return end #-h- SET.Q 603 10-AUG-78 22:04:38 #------------------------------------------------------------ ## set - set parameter and check range subroutine set(param, val, argtyp, defval, minval, maxval) # integer max, min character argtyp integer defval, maxval, minval, param, val if (argtyp == NEWLINE) # defaulted param = defval else if (argtyp == PLUS) # relative + param = param + val else if (argtyp == MINUS) # relative - param = param - val else # absolute param = val param = min(param, maxval) param = max(param, minval) return end #-h- SKIP.Q 266 10-AUG-78 15:44:13 #------------------------------------------------------------ ## skip - output n blank lines subroutine skip(n) integer i, n include cpage for (i = 1; i <= n; i = i + 1) { if (print == YES) call putc(NEWLINE) } return end #-h- SPACE.Q 403 10-AUG-78 22:05:58 #------------------------------------------------------------ ## space - space n lines or to bottom of page subroutine space(n) # integer min integer n include cpage call brk if (lineno > bottom) return if (lineno == 0) call phead call skip(min(n, bottom+1-lineno)) lineno = lineno + n if (lineno > bottom) call pfoot return end #-h- SPREAD.Q 1071 10-AUG-78 22:06:00 #------------------------------------------------------------ ## spread - spread words to justify right margin subroutine spread(buf, outp, nextra, outwds) character buf(MAXOUT) include cparam # integer min integer dir, i, j, nb, ne, nextra, nholes, outp, outwds data dir /0/ if (nextra <= 0 | outwds <= 1) return dir = 1 - dir # reverse previous direction ne = nextra nholes = outwds - 1 if (tival ^= inval & nholes > 1) nholes = nholes - 1 i = outp - 1 j = min(MAXOUT-2, i+ne) # leave room for NEWLINE, EOS while (i < j) { buf(j) = buf(i) # check for a blank following a non-blank if (buf(i) == BLANK & buf(i-1) ^= BLANK) { if (dir == 0) nb = (ne-1) / nholes + 1 else nb = ne / nholes ne = ne - nb nholes = nholes - 1 for ( ; nb > 0; nb = nb - 1) { j = j - 1 buf(j) = BLANK } } i = i - 1 j = j - 1 } return end #-h- TEXT.Q 1307 10-AUG-78 15:46:35 #------------------------------------------------------------ ## text - process text lines subroutine text(inbuf) character inbuf(INSIZE), wrdbuf(INSIZE) integer getwrb integer i, bs, j include cparam if (inbuf(1) == BLANK | inbuf(1) == NEWLINE) call leadbl(inbuf) # move left, set tival if (ulval > 0) { # underlining call underl(inbuf, wrdbuf, INSIZE) ulval = ulval - 1 } if (boval > 0) { # boldfacing call bold(inbuf, wrdbuf, INSIZE) boval = boval - 1 } if (ceval > 0) { # centering call center(inbuf) call put(inbuf) ceval = ceval - 1 } else if (inbuf(1) == NEWLINE) # all blank line call put(inbuf) else if (fill == NO) # unfilled text call put(inbuf) else # filled text { j = 0 for (i = 1; getwrb(inbuf, i, wrdbuf) > 0; ) { j = j + 1 if(bsval > 0 & j == 1) { bs = 1 bsval = bsval - 1 } else bs = 0 call putwrd(wrdbuf, bs) } } return end #-h- UNDERL.Q 618 10-AUG-78 15:46:46 #------------------------------------------------------------ ## underl - underline a line subroutine underl(buf, tbuf, size) integer i, j, size character buf(size), tbuf(size) j = 1 # expand into tbuf for (i = 1; buf(i) ^= NEWLINE & j < size-1; i = i + 1) { if (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= BACKSPACE) { tbuf(j) = UNDERLINE tbuf(j+1) = BACKSPACE j = j + 2 } tbuf(j) = buf(i) j = j + 1 } tbuf(j) = NEWLINE tbuf(j+1) = EOS call scopy(tbuf, 1, buf, 1) # copy it back to buf return end #-h- WIDTH.Q 383 10-AUG-78 15:46:49 #------------------------------------------------------------ ## width - compute width of character string integer function width(buf) character buf(MAXLINE) integer i width = 0 for (i = 1; buf(i) ^= EOS; i = i + 1) if (buf(i) == BACKSPACE) width = width - 1 else if (buf(i) ^= NEWLINE) width = width + 1 return end #-h- BOLD.Q 692 10-AUG-78 15:46:53 #------------------------------------------------------------ ## bold - bold-face or overstrike a line subroutine bold(buf, tbuf, size) integer i, j, size character buf(size), tbuf(size) j = 1 # expand into tbuf for (i = 1; buf(i) ^= NEWLINE & j < size-1; i = i + 1) { tbuf(j) = buf(i) j = j + 1 if (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= BACKSPACE) { tbuf(j) = BACKSPACE tbuf(j+1) = tbuf(j-1) tbuf(j+2) = BACKSPACE tbuf(j+3) = tbuf(j+1) j = j + 4 } } tbuf(j) = NEWLINE tbuf(j+1) = EOS call scopy(tbuf, 1, buf, 1) # copy it back to buf return end #-h- EVEN.Q 250 10-AUG-78 15:46:56 #------------------------------------------------------------ ## even - integer function returning true if integer is even integer function even(i) integer i,mod if(mod(i,2) == 0) even = YES else even = NO return end #-h- GETWRB.Q 1246 10-AUG-78 15:51:45 #---------------------------------------------------------- ## getwrb - new getwrd -- hangs onto trailing blanks integer function getwrb(in,i,out) character in(ARB),out(ARB) integer i, j # space forward to first character while (in(i) == BLANK | in(i) == TAB) i = i + 1 # now count and copy non-blank characters j = 1 while (in(i) ^= EOS & in(i) ^= BLANK & in(i) ^= TAB & in(i) ^= NEWLIееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее