C%%A-RCB-0077-SL-12 LST -- 10 GET LINE AND KILL TRAILING BLANKS C Events: 1 Normal C 2 EOF Encountered C 3 FF encountered C 4 % encountered C 1000 IEVENT = 2 NBUF = MOD(NBUF+1,2) IFIRST = NBUF*NHALF + 1 IF(GETREC(LUDI,BUFFER(IFIRST))) GO TO 10 IEVENT = 1 NCHAR = MAX(1,NCHAR) ILAST = IFIRST + NCHAR - 1 IF(BUFFER(IFIRST+IPERPT).EQ.BPERC) IEVENT = 4 IF(BUFFER(IFIRST).EQ.BFF) IEVENT = 3 D IF(LEVEL.GE.4) WRITE(LUB,1030) (BUFFER(I), I=IFIRST,ILAST) D1030 FORMAT(' ',132A1) IF(NCHAR.LE.1) GO TO 10 DO 1040 I = 2,NCHAR IF(BUFFER(ILAST).GT.BLANK) GO TO 1060 ILAST = ILAST - 1 1040 CONTINUE 1060 NCHAR = 1 + ILAST - IFIRST GO TO 10 C%%A-RCB-0077-SL-12 LST -- 11 TEST FOR HEADER CONDITION C Events: 1 Normal C 2 ILINE=0 -- header time C 1100 IEVENT = 1 IF(ILINE.EQ.0) IEVENT = 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 12 PRINT THE RECORD C Events: 1 Normal C 2 Page full C C Leading carriage control characters are deleted. If a linefeed C is encountered , a blank line is printed. C 1200 IEVENT = 1 DO 1220 I = 1,NCHAR IF (BUFFER(IFIRST).EQ.BCR) GO TO 1215 IF (BUFFER(IFIRST).NE.BLF) GO TO 1225 WRITE (LUW,1210) 1210 FORMAT (10X) ILINE = ILINE + 1 1215 IFIRST = IFIRST + 1 1220 CONTINUE 1225 NCHAR = ILAST - IFIRST + 1 CALL PUTREC(LUW,BCC,1+IBACK,BUFFER(IFIRST-IBACK)) ILINE = ILINE + 1 IF(BCC.EQ.'0') ILINE = ILINE + 1 IF(ILINE.GE.MAXLIN) IEVENT = 2 BCC = BLANK IBACK = 0 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 13 FORCE NEW PAGE C Event: 1 C 1300 IEVENT = 1 IF(ILINE.NE.0) IPUSH = MAXPAG - ILINE ILINE = 0 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 14 PUSH TO NEW PAGE AND PRINT HEADER C Event: 1 C C Note that the printer leaves one blank line, so we print a top C margin of one line less than the bottom margin. MARGIN must be C set to at least 1. C 1400 IEVENT = 1 NPAGE = NPAGE + 1 C IPUSH = IPUSH + MARGIN - 1 C IPUSH = IPUSH - 2 - (MARGIN - 1) IF(IPUSH.GT.0) WRITE(LUW,1410) (BLANK,I=1,IPUSH) 1410 FORMAT(A1,5X) C WRITE (LUW,1415) (BLANK,I=1,MARGIN-1) C1415 FORMAT ('1',A1/(A1)) ILINE = ILINE + MARGIN - 1 IPUSH = 0 C WRITE(LUW,1430) BHEAD1,NPAGE 1430 FORMAT(' ',A1, T, 'Page',I3) WRITE(LUW,1450) BHEAD2 1450 FORMAT(' ',A1) WRITE(LUW,1470) 1470 FORMAT(10X) ILINE = ILINE + 3 MAXLIN = MAXPAG - MARGIN IF(NPAGE.EQ.1) MAXLIN = MAXLIN - NCUT GO TO 10 C%%A-RCB-0077-SL-12 LST -- 15 COPY HEADER FROM % LINE C Event: 1 C 1500 IEVENT = 1 IBASE = IFIRST + IPERPT - 2 ISTRT = 3 BCHAR = BUFFER(IBASE+ISTRT) IF(BCHAR.EQ.BUPARO) GO TO 10 C IF(BCHAR.NE.BPERC) NPAGE = 0 IF(BCHAR.EQ.BPERC) ISTRT = ISTRT + 1 NCHAR = ILAST - (IBASE+ISTRT) + 1 ISTOP = PAGWID - 2*INDENT - 10 NCHAR = MIN(NCHAR,ISTOP) + ISTRT - 1 ENCODE (HD1LNG,1510,BHEAD1) 1510 FORMAT ( (X)) CALL TABBER(BUFFER(IBASE+1),BHEAD1(INDENT+1),ISTRT,ISTOP,NCHAR) CALL ALTPRI(,PRILOW) GO TO 10 C%%A-RCB-0077-SL-12 LST -- 16 PROMPT AND READ HEADER FROM TERMINAL C Events: 1 Normal C 2 EOF on input C 1600 IEVENT = 2 ISTOP = PAGWID - 2*INDENT - 10 ENCODE (HD1LNG,1610,BHEAD1) 1610 FORMAT ( (X)) C WRITE (LUT,1615) BCR 1615 FORMAT (1X,A1,'TYPE HEADER LINE>') C DO 1670 ISTEP = 1,50 READ (LUT,1625,END=10) ICOUNT,(BHEAD3(I),I=1,ISTOP) 1625 FORMAT (Q,A1) IF(ICOUNT.EQ.0.AND.ISTEP.GT.1) GO TO 1680 ICOUNT = ISTOP CALL TABBER(BHEAD3,BHEAD1(INDENT+1),1,ISTOP,ICOUNT) WRITE (LUT,1645) (BHEAD1(INDENT+I), I=1,ICOUNT) 1645 FORMAT (1X,70A1) WRITE (LUT,1655) 1655 FORMAT (' CR OR RETYPE>') 1670 CONTINUE C 1680 WRITE(LUT,1685) 1685 FORMAT(' OK'/) IEVENT = 1 NPAGE = 0 CALL ALTPRI(,PRILOW) GO TO 10 C%%A-RCB-0077-SL-12 LST -- 17 EOF ON INPUT -- PUSH THE PAPER AND CLOSE C Event: 1 C 1700 IEVENT = 1 IF(ILINE.NE.0) IPUSH = MAXPAG - ILINE IPUSH = IPUSH + 27 WRITE(LUW,1710) (BLANK, I=1,IPUSH) 1710 FORMAT(A1,5X) ILINE = 0 NPAGE = 0 IPUSH = 0 CALL ALTPRI (,PRIHI) CALL CLOSE(LUW) GO TO 10 C%%A-RCB-0077-SL-12 LST -- 18 NEW PAGE AND 3-LINE HEADER C Event: 1 C C This is a copy of function 14, but it prints a subtitle below C BHEAD2. It is used for MAC, but it is included here for possible use C for other files. C 1800 IEVENT = 1 NPAGE = NPAGE + 1 C IPUSH = IPUSH + MARGIN - 1 IF (IPUSH.GT.0) WRITE (LUW,1810) (BLANK, I=1,IPUSH) 1810 FORMAT (A1,5X) ILINE = ILINE + MARGIN - 1 IPUSH = 0 C WRITE (LUW,1830) BHEAD1,NPAGE 1830 FORMAT (' ',A1, T, 'Page',I3) WRITE (LUW,1850) BHEAD2 1850 FORMAT (' ',A1) NCHAR = ISBTTL CALL PUTREC (LUW,BCC,1,BSBTTL) WRITE (LUW,1870) 1870 FORMAT (5X) ILINE = ILINE + 4 MAXLIN = MAXPAG - MARGIN IF (NPAGE.EQ.1) MAXLIN = MAXLIN - NCUT IF (.NOT.CONTEN) GO TO 10 WRITE (LUW,1875) 1875 FORMAT (' ',T10,' LINE # SUBTITLE'/10X) ILINE = ILINE + 2 GO TO 10 C 1900 GO TO 9400 C 2000 GO TO 9400 C 2100 GO TO 9400 C 2200 GO TO 9400 C 2300 GO TO 9400 C 2400 GO TO 9400 C 2500 GO TO 9400 C 2600 GO TO 9400 C 2700 GO TO 9400 C 2800 GO TO 9400 C 2900 GO TO 9400