perm filename PASTE.SAI[PUB,TES]1 blob
sn#129304 filedate 1974-11-07 generic text, type T, neo UTF8
00100 BEGOF("PASTE")
00200
00300 COMMENT
00400
00500 *** Variations at Different Sites ***
00600
00700 In PLACELINE, some sites don't need to allocate extra text lines for
00800 superscripts and subscripts in XCRIBL mode.
00900
01000 ***
01100
01200 Paste a line, with its leading and somescripts and footnotes,
01300 into a column obeying GROUP constraints.
01400
01500 ;
01600
01700 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE PASTE! ;$"#
00200 BEGIN "PASTE!"
00300 FTGP ← 0 ;
00310 FTGP2 ← 0 ; TES 11/2/74 ;
00355 MILLVERTI ← -MILLVERTIDEFAULT ; TES 11/2/74 SET TO MSPREADM AT 1ST TEXT LINE ;
00377 NEEDMILLVERTI ← FALSE ; TES 11/2/74 ;
00400 BIND(DECLARE(SYMNUM("FOOT"), PORTYPE), IXFOOT ← PUTI(4, -1)) ;
00500 MESGS ← 0 ;
00600 NOPGPH ← TRUE ;
00700 END "PASTE!" ;
00100 PUBLIC RECURSIVE PROCEDURE DBREAK ;$"#
00200 IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
00300 BEGIN INTEGER STTS ;
00400 NOPGPH ← -1 ;
00500 BOUND(3) ;
00600 IF POSN > INDENT OR VERBATIM THEN
00700 BEGIN "A PGPH"
00800 PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, XMAXIM-FSHORT,
00900 FAKE, ABOVEX MAX BRKABX,
01000 -(BELOWX MIN BRKBLX),
01100 IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
01150 IF NOFILL THEN MLEADNM ELSE IF FIRST THEN MLEADFM ELSE MSPREADM,
01200 PLBL, JUSTJUST, 0) ;
01300 FSHORT ← SINCELFM ← 0 ;
01400 IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
01500 STARTS ← STARTS + STTS ; END ;
01600 END "A PGPH" ;
01700 END "DBREAK" ;
00100 PUBLIC SIMPLE STRING PROCEDURE ENOUGH(STRING STR ; INTEGER WID, F) ;$"#
00200 BEGIN TES 11/29/73 enough of STR to extend WID charws in font F ;
00300 INTEGER WASF, N, X ; STRING S2 ;
00400 WASF ← THISFONT ; S2 ← STR ;
00500 IDASSIGN(FNTFIL[F], CW) ; X ← WID * CHARW ; N ← 0 ;
00600 WHILE FULSTR(S2) AND X GEQ 0 DO
00700 BEGIN N←N+1 ; X ← X-CW[LOP(S2)] END ;
00800 IF X<0 THEN N ← N-1 ;
00900 IDASSIGN(FNTFIL[WASF], CW) ;
01000 RETURN(STR[1 TO N]) ;
01100 END ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE LINESLEFT ;$"#
00200 BEGIN
00300 INTEGER TOT, LEFT ;
00400 TOT ← LEFT ← IF AREAIXM AND 0 LEQ STATUS LEQ 2 THEN LINES ELSE LINECT(IXTEXT) ;
00500 LEFT ← LEFT + XGENLINES; RKJ;
00600 IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
00700 IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
00800 (IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
00900 RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
01000 END "LINESLEFT" ;
00100 PUBLIC RECURSIVE INTEGER PROCEDURE FIND!ROOM(INTEGER SOURCE,
00200 EXTRA, FROMCOL, FROMLINE, MORECOMING) ;$"#
00300 BEGIN "FIND!ROOM"
00400 INTEGER WANT, LEAD, I, C, L, SAVEAREA, KOLS ; LABEL FOUND, TRYHERE ;
00500 STRING FTSTR ; TES 9/12/74 ;
00600 ASSUREAREA ;
00700 IF SOURCE LEQ 0 THEN BEGIN WANT←EXTRA ; LEAD←-SOURCE END ELSE BEGIN WANT←1; LEAD←0 END;
00800 IF WANT > LINES THEN TES 12/6/73 LENGTHENED MESSAGE ;
00900 BEGIN WARN("Can't fit here",
01000 <"This line (with its PREFACE,SPREAD,SOMESCRIPTS) needs " &
01100 CVS(WANT) & " lines of paper,
01200 but AREA " & SYM[LDB(BIXNUM(AREAIXM))] &
01300 " is declared only " & CVS(LINES) & " lines HIGH">);
01400 RETURN(FALSE) ;
01500 END;
01600 KOLS ← IF FROMCOL > COLS THEN 2*COLS ELSE COLS ;
01700 TRYHERE:
01800 FOR C ← FROMCOL THRU KOLS DO
01900 IF (LINES-MORECOMING) - (L← IF C=FROMCOL THEN FROMLINE ELSE 0) + XGENLINES - PINE GEQ
02000 (IF L THEN WANT+LEAD ELSE WANT) THEN GO TO FOUND ;
02100 IF GLINEM AND C NEQ FROMCOL AND MOVEGROUP(TRUE, KOLS+1-COLS,0,EXTRA) THEN
02200 BEGIN C←COL; L←LINE; GO FOUND END ;
02300 IF TEXTAR(AREAIXM) THEN
02400 BEGIN
02500 FTSTR ← SSTK[FOOTSTR(AREAIXM)] ; SSTK[FOOTSTR(AREAIXM)] ← NULL ; TES 9/12/74 ;
02600 NEXTPAGE ; OPENAREA(AREAIXM) ;
02700 SSTK[FOOTSTR(AREAIXM)] ← FTSTR & SSTK[FOOTSTR(AREAIXM)] ; TES 9/12/74 ;
02800 IF FROMCOL>COLS AND COL LEQ COLS OR FROMCOL LEQ COLS AND COL>COLS THEN
02900 BEGIN
03000 TES 12/6/73 DELETED: IF FROMCOL>COLS THEN FOOTTOP ← 1 ; COMMENT ADDED BY RKJ ;
03100 PAL SWAP COL ; LINE SWAP PINE ;
03200 END ;
03300 FROMCOL ← COL ; FROMLINE ← LINE; GO TO TRYHERE ;
03400 END
03500 ELSE BEGIN TES 12/6/73 LENGTHENED MESSAGE ;
03600 WARN("TITLE AREA overflow","Overflowed title area " & SYM[LDB(BIXNUM(AREAIXM))]) ;
03700 FOR C ← 1 THRU COLS DO AA[C, 0] ← AA[COLS+C,0] ← 0 ;
03800 PAL ← (C ← COL ← 1) + COLS ; L ← 0 ;
03900 END ;
04000 FOUND:
04100 IF C=COL THEN LINE←L
04200 ELSE IF GLINEM AND MOVEGROUP(FALSE, C, L, EXTRA) THEN BEGIN L ← LINE ; C ← COL END
04300 ELSE BEGIN
04400 COL ← C ; PAL ← (COL+COLS-1) MOD (2*COLS) + 1 ;
04500 LINE ← L ; PINE ← RH(AA[PAL,0]) ;
04600 END ;
04700 IF OLX+WANT+LEAD > OLXX THEN GROWOWLS(WANT+LEAD+25) ;
04760 IF LINE+WANT+LEAD > ARRINFO(AA,4) THEN GROWAA(LINE+WANT+LEAD+10) ; TES 11/6/74;
04800 IF LINE AND LEAD THEN
04900 BEGIN
05000 FOR I ← 1 THRU LEAD DO AA[COL, LINE+I] ← NEWBLANK(IF GROUPM OR I>1 THEN ABV!BLW ELSE BLW) ;
05100 LINE ← LINE + LEAD ;
05200 END ;
05300 RETURN(L+1) ;
05400 END "FIND!ROOM" ;
00100 PUBLIC INTEGER SIMPLE PROCEDURE NEWBLANK(INTEGER MOLE) ;$"#
00200 BEGIN MOLES[OLX←OLX+1]←MOLE ; OWLS[OLX]←0 ; RETURN(OLX); END "NEWBLANK";
00300
00400 PUBLIC INTEGER SIMPLE PROCEDURE NEWNEWBLANK(INTEGER NMOLE) ;$"#
00500 BEGIN NMOLES[NOLX←NOLX+1]←NMOLE ; NOWLS[NOLX]←0 ; RETURN(NOLX); END "NEWNEWBLANK";
00100 PRIVATE SIMPLE INTEGER PROCEDURE OWLOUT(STRING C1,C2,C3) ;$"#
00200 BEGIN "OWLOUT"
00300 TES 11/2/74 2 ARGUMENTS TO AVOID CONCATENATION ;
00400 IF 0=LENGTH(C1)+LENGTH(C2)+LENGTH(C3) THEN RETURN(0) ;
00500 OWLSEQ ← OWLSEQ + 1 ;
00600 IF INTER LEQ 0 THEN NOPORTION ;
00700 OUT(SINTER, CVS(OWLSEQ)) ; OUT(SINTER, ALTMODE) ;
00800 OUT(SINTER, C1) ; OUT(SINTER, C2) ; OUT(SINTER, C3) ;
00900 RETURN(OWLSEQ) ;
01000 END "OWLOUT" ;
01100
01200 PRIVATE SIMPLE PROCEDURE OWLPLACE(INTEGER OWLOUTVALUE, MILLLEAD) ;$"#
01300 BEGIN "OWLPLACE"
01400 TES 11/2/74 ALLOWS OWLOUT (FORMERLY OWT) TO BE CALLED WITHOUT COPYING OWL ;
01500 OWLS[OLX] ← OWLOUTVALUE ;
01600 IF MILLVERTI<0 THEN MILLVERTI←MSPREADM
01700 ELSE IF MILLVERTI NEQ MILLLEAD THEN
01800 BEGIN
01900 NEEDMILLVERTI ← TRUE ;
02000 OVEREST ← OVEREST + ((MILLVERTI-MILLLEAD)*VBPI)/1000 ;
02100 END ;
02200 MLEAD[OLX] ← MILLLEAD-MILLVERTI ; TES 11/2/74 EXTRA LEADING ;
02300 END "OWLPLACE" ;
00100 PUBLIC RECURSIVE PROCEDURE PLACELINE(INTEGER CHARS,POSN,XPOSN,FAKE,
00200 ABOVE,BELOW,LEADB,MLEADB,FIRSTLBL,
00250 JUSTIFY,MORECOMING) ;$"#
00300 BEGIN "PLACELINE"
00400 INTEGER FOOTFLAG, NEEDS, TOPLINE, GR, ATOP, I, TOLBL, LBL, FOOTNUM, WASFRAME, WASCOL, WASOLX ;
00500 COMMENT FOOTFLAG CHANGES RKJ 10-10-73;
00600 STRING XREF;
00650 INTEGER SOWL, MSKIP, MGSKIP, MCHARH ; TES 11/2&7/74 ;
00700 IF NOT DEBUG THEN XREF ← ALTMODE
00800 ELSE BEGIN
00900 XREF ← ERRLINE&"/"&SRCPAGE&"["&MACLINE&"]" ;
01000 FOR I ← 1 THRU MESGS DO XREF ← XREF & RUBOUT & MESGSARR[I] ;
01100 MESGS←0 ; XREF ← XREF & ALTMODE ;
01200 END ;
01300 IFC SAILVER OR PARCVER OR ITSVER
01400 THENC IF XCRIBL THEN ABOVE←BELOW←0; comment scripts; ENDC
01500 SOWL ← OWLOUT(XREF,OWL[1 TO CHARS], CRLF) ; TES 11/2/74 AVOID CAT ;
01600 ASSUREAREA ;
01610 MGSKIP ← MILLGSKIP(AREAIXM) ; MILLGSKIP(AREAIXM) ← 0 ; TES 11/7/74 ;
01620 MSKIP ← MILLSKIP(AREAIXM) ; MILLSKIP(AREAIXM) ← 0 ; TES 11/7/74 ;
01700 IF COL > COLS THEN
01800 BEGIN "INFOOT" TES 12/6/73 SEPARATED CASES ;
01900 IF FOOTNUM ← FOOTTOP THEN
02000 BEGIN comment First Footnote belonging to a line ;
02100 GR ← GROUPM ; TES 1/15/74 ADDED 'OR GLINEM=0' BELOW: ;
02200 TES 8/22/74 PAL BELOW WAS COL! ;
02300 IF GROUPM=0 OR GLINEM=0 THEN GLINEM ← AA[PAL,PINE] ;
02400 GROUPM ← 1 ; FOOTTOP ← 0 ;
02500 END ;
02600 IF ATOP ← LINE=0 THEN ABOVE ← ABOVE + 1 + (FTGP+FTGP2) ; comment assure room for FOOTSEP ;
02700 END "INFOOT" ;
02800 FOOTFLAG ← COL LEQ COLS AND FULSTR(SSTK[FOOTSTR(AREAIXM)]);
02900 IF FOOTFLAG THEN
03000 MORECOMING←MORECOMING+2; RKJ 11/20/73 ;
03002
03005 TES ADDED 11/7/74 : ;
03010 MLEADB ← MLEADB + MSKIP ;
03015 MCHARH ← IF XCRIBL THEN ABS(MILLVERTI) + (CHARH*1000 + VBPI/2)/VBPI ELSE 166 ;
03020 LEADB ← LEADB + MLEADB DIV MCHARH ; MLEADB ← MLEADB MOD MCHARH ;
03030 ABOVE ← ABOVE + MGSKIP DIV MCHARH ;
03040 MGSKIP ← MGSKIP MOD MCHARH ;
03050
03100 WHILE NOT (TOPLINE ← FIND!ROOM(-LEADB,NEEDS←ABOVE+BELOW+1,COL,LINE,MORECOMING)) DO
03200 BEGIN ABOVE←(ABOVE-1)MAX 0; BELOW←(BELOW-1)MAX 0 END;
03300 IF XCRIBL AND (COL = 1 OR COL = COLS+1) THEN TES 11/19/73 COL 1 ONLY! ;
03400 BEGIN "KLUDGE"
03500 OVEREST←OVEREST+NEEDS*(STDCHARH-CHARH);
03600 IF ABS(OVEREST)>STDCHARH THEN
03700 BEGIN
03800 XGENLINES←XGENLINES+OVEREST DIV STDCHARH;
03900 OVEREST←OVEREST MOD STDCHARH;
04000 END;
04100 END "KLUDGE";
04200 WASOLX ← OLX - (LINE + 1 - TOPLINE) ;
04300 IF COL > COLS THEN
04400 BEGIN "BEGFOOT" TES 12/6/73 SEPARATED CASES ;
04500 IF FOOTNUM THEN COMMENT FIRST FOOTNOTE BELONGING TO A LINE ;
04600 BEGIN "FOOT1"
04700 GROUPM ← GR ; IF GROUPM=0 THEN GLINEM ← 0 ;
04800 END "FOOT1" ;
04900 IF ATOP THEN BEGIN ABOVE ← ABOVE - 1 - (FTGP+FTGP2) ; TES 11/29/73 ;
05000 NEEDS ← NEEDS - 1 - (FTGP+FTGP2) END ;
05100 IF LINE = 0 THEN
05150 BEGIN "PUTFOOTSEPS"
05200 TES 11/29/73 ADDED FTGP AND ENOUGH ;
05250 TES 11/2&7/74 ADDED FTGP2 AND MILLVERTIDEFAULT ;
05260 MLEADB ← MILLVERTIDEFAULT ; TES 11/7/74 ;
05300 FOR I ← 1 THRU FTGP DO AA[COL,I] ←
05350 NEWBLANK(IF I=1 THEN ABV ELSE ABV!BLW) ;
05400 AA[COL, LINE←TOPLINE←1+FTGP] ← OLX ← OLX + 1 ;
05450 IF XCRIBL THEN
05500 OWLPLACE(OWLOUT(XREF,PICKFONT(FSFONT),
05550 ENOUGH(FOOTSEP,COLWID(AREAIXM),FSFONT)&CRLF),
05600 MILLVERTIDEFAULT)
05650 ELSE
05700 OWLPLACE(OWLOUT(XREF,
05725 FOOTSEP[1 TO COLWID(AREAIXM)],
05737 CRLF),
05750 MILLVERTIDEFAULT) ;
05800 MOLES[OLX] ← IF FTGP=0 THEN BLW ELSE ABV!BLW ;
05850 FOR I ← LINE+1 THRU LINE+FTGP2 DO AA[COL,I] ← NEWBLANK(ABV!BLW);
05900 LINE ← LINE + FTGP2 ; TES 11/6/74 ;
05950 END "PUTFOOTSEPS" ;
06200 END "BEGFOOT" ;
06300 FOR I ← 1 THRU ABOVE DO AA[COL,LINE+I] ←
06400 NEWBLANK(IF GROUPM OR TOPLINE<LINE+I THEN ABV!BLW ELSE BLW) ;
06500 AA[COL, LINE+ABOVE+1] ← OLX ← OLX + 1 ;
06510 IF LINE = 0 THEN MLEADB ← MILLVERTIDEFAULT ; TES 11/7/74 ;
06600 OWLPLACE(SOWL, MGSKIP+MLEADB) ; TES 11/2&7/74 ;
06700 MOLES[OLX] ← (IF GROUPM OR TOPLINE<LINE+ABOVE+1 THEN ABV ELSE 0) LOR (IF GROUPM OR BELOW THEN BLW ELSE 0);
06800 IF XCRIBL THEN I←MAXIM*CHARW + FAKE - XPOSN ELSE I←MAXIM - (POSN-FAKE);
06900 IF JUSTIFY AND I > 0 THEN SHORT[OLX]←I ;
07000 IF FIRSTLBL NEQ -TWO(13) THEN
07100 BEGIN "PAGE LABELS"
07200 LBL ← PLBL ; TOLBL ← 0 ;
07300 WHILE LBL NEQ FIRSTLBL AND LBL NEQ -TWO(13) DO
07400 LBL ← IF (TOLBL←LBL)>0 THEN ITBL[TOLBL] ELSE NUMBER[-TOLBL] ;
07500 IF LBL=-TWO(13) THEN WARN("=","Page label not in Page Label L.L.!!!")
07600 ELSE IF TOLBL=0 THEN PLBL ← -TWO(13)
07700 ELSE IF TOLBL > 0 THEN ITBL[TOLBL] ← -TWO(13)
07800 ELSE NUMBER[-TOLBL] ← -TWO(13) ;
07900 BRKPLBL ← PLBL ;
08000 DPB(IF FIRSTLBL<0 THEN PUTI(1,FIRSTLBL) ELSE FIRSTLBL, LABELM(OLX)) ;
08100 END "PAGE LABELS" ;
08200 FOR I ← ABOVE+2 THRU NEEDS DO AA[COL,LINE+I] ← NEWBLANK(IF GROUPM OR I<NEEDS THEN ABV!BLW ELSE BLW) ;
08300 IF GROUPM AND NOT GLINEM THEN
08400 DPB(0,ABOVEM(GLINEM←IF COL>COLS THEN TOPMOST(PAL,PINE) ELSE AA[COL,TOPLINE])) ;
08500 TES 12/6/73 ADDED TOPMOST(PAL,PINE) ;
08600 LINE ← LINE + NEEDS ;
08700 IF FOOTFLAG THEN comment, Footnotes ;
08800 BEGIN "FOOTNOTES"
08900 WHILE (FOOTNUM←IF PINE=0 THEN 1 ELSE LDB(FOOTM(AA[PAL,PINE])) + 1) = 31 DO
09000 BEGIN
09100 WARN("=",">30 lines in col. "&COL&" want footnotes.") ;
09200 FIND!ROOM(LINE, 1, COL+1, 0, 0) ;
09300 END ;
09400 IF FOOTNUM=32 THEN FOOTNUM ← 1 ; DPB(FOOTNUM, FOOTM(OLX)) ;
09500 SEND(IXFOOT, CRLF&TB&TB& "END ""!FOOTNOTES"";;") ;
09600 AA[COL,0] ← LHRH(COVERED, LINE) ; PINE SWAP LINE ; PAL SWAP COL ;
09700 WASCOL ← COL ; WASFRAME ← FRAMEIDA ; BEGINBLOCK(TRUE, 3, "!FOOTNOTES") ; BREAKM ← 0 ;
09800 FOOTTOP ← -1 ; WASOLX ← OLX ; RECEIVE(IXFOOT, NULL) ; PASS ; TOEND ; FOOTTOP ← 0 ;
09900 AA[COL,0] ← LHRH(COVERED, LINE) ;
10000 IF WASCOL NEQ COL OR WASFRAME NEQ FRAMEIDA THEN
10100 BEGIN FOOTNUM ← 31 ; IF WASFRAME=FRAMEIDA THEN DPB(31, FOOTM(WASOLX)) END ;
10200 DPB(FOOTNUM, FOOTM(AA[COL,LINE])) ; PAL SWAP COL ; PINE SWAP LINE ;
10300 END "FOOTNOTES" ;
10400 END "PLACELINE" ;
00100 PRIVATE SIMPLE INTEGER PROCEDURE TOPMOST(INTEGER COLNO, LINO) ;$"#
00200 BEGIN TES 12/6/73 USED BY PLACELINE FOR GLINEM IN FOOT ;
00300 WHILE LINO>1 AND (LDB(ABOVEM(AA[COLNO,LINO])) OR LDB(BELOWM(AA[COL,LINO-1]))) DO
00400 LINO ← LINO - 1 ;
00500 RETURN(AA[COLNO,LINO]) ;
00600 END "TOPMOST" ;
00100 FINISHED
00200
00300 ENDOF("PASTE")