Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0170/frame.for
There is 1 other file named frame.for in the archive. Click here to see a list.
C RENBR(FRAME/FRAME FROFF SAMPLE OUTPUT FOR MANUAL)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
C THIS PROGRAM CONVERTS SMALL PAGES OF SAMPLE FROFF
C OUTPUT TEXT INTO PARALLEL PAGES OF UNIFORM SIZE
C FRAMED BY ASTERISKS FOR USE IN THE FROFF INSTRUCTION
C MANUAL. A 1 CARRIAGE CONTROL CHARACTER CAN APPEAR IN
C THE LEFTMOST COLUMN OF THE FIRST LINE BUT IS NOT
C NECESSARY. THE FIRST LINE OF EACH OF THE FOLLOWING
C PAGES MUST BE INDICATED BY A 1 CARRIAGE CONTROL
C CHARACTER IN THE LEFTMOST COLUMN. ANY CARRIAGE
C CONTROL CHARACTER OTHER THAN 1 IS IGNORED.
C
C FOR EXAMPLE, THE FOLLOWING FROFF OUTPUT
C
C A
C BC
C DEF
C 1GHIJ
C KLMNO
C PQRSTU
C VWXYZAB
C CDEFGHIJ
C KLMNOPQRS
C 1TUVWXYZABC
C TUVWXYZABC
C KLMNOPQRS
C CDEFGHIJ
C VWXYZAB
C PQRSTU
C KLMNO
C GHIJ
C DEF
C 1BC
C A
C
C WOULD BE CONVERTED BY THIS PROGRAM INTO THE FOLLOWING
C
C ************ ************ ************ ************
C *A * *GHIJ * *TUVWXYZABC* *BC *
C *BC * *KLMNO * *TUVWXYZABC* *A *
C *DEF * *PQRSTU * *KLMNOPQRS * * *
C * * *VWXYZAB * *CDEFGHIJ * * *
C * * *CDEFGHIJ * *VWXYZAB * * *
C * * *KLMNOPQRS * *PQRSTU * * *
C * * * * *KLMNO * * *
C * * * * *GHIJ * * *
C * * * * *DEF * * *
C ************ ************ ************ ************
C
DOUBLE PRECISION FILINP,FILOUT
DIMENSION LTRALL(6000),LTRINP(60),LTROUT(132),
1LTRDEB(5)
DATA LTRDEB/1HD,1HE,1HB,1HU,1HG/
DATA LTRSTR,LTRSPA,LTRONE/1H*,1H ,1H1/
DATA IDSK,JDSK/1,20/
C
C OPEN NEXT INPUT FILE
TYPE 1
1 FORMAT(' FRAME'/
1' CONVERTS SERIAL OUTPUT TO PARALLEL FRAMED PAGES')
2 TYPE 3
3 FORMAT(' INPUT FILE? ',$)
ACCEPT 4,FILINP
4 FORMAT(1A10)
OPEN(UNIT=IDSK,FILE=FILINP,ACCESS='SEQIN',ERR=2)
TYPE 5
5 FORMAT(' OUTPUT FILE? ',$)
ACCEPT 4,FILOUT
OPEN(UNIT=JDSK,FILE=FILOUT,ACCESS='SEQOUT')
C
C SET INITIAL PAGE SIZE
MAXWID=0
MAXHIH=0
KOLUMN=1
TYPE 6
6 FORMAT(' COLUMNS BETWEEN FRAMES? ',$)
ACCEPT 8,KOLUMN
TYPE 7
7 FORMAT(' MINIMUM FRAMED WIDTH? ',$)
ACCEPT 8,MAXWID
8 FORMAT(I)
TYPE 9
9 FORMAT(' MINIMUM FRAMED HEIGHT? ',$)
ACCEPT 8,MAXHIH
IF(MAXWID.LT.0)MAXWID=0
IF(MAXHIH.LT.0)MAXHIH=0
KNTCHR=0
KNTPAG=0
NOWWID=0
NOWHIH=0
C
C READ NEXT INPUT LINE
10 READ(IDSK,11,END=30)LTR1ST,LTRINP
11 FORMAT(1A1,60A1)
IF(KNTCHR.NE.0)GO TO 13
DO 12 I=1,5
IF(LTRINP(I).NE.LTRDEB(I))GO TO 13
12 CONTINUE
GO TO 10
13 IF(LTR1ST.NE.LTRONE)GO TO 17
IF(KNTCHR.EQ.0)GO TO 17
14 IF(NOWHIH.GE.MAXHIH)GO TO 16
NOWHIH=NOWHIH+1
DO 15 I=1,MAXWID
KNTCHR=KNTCHR+1
LTRALL(KNTCHR)=LTRSPA
15 CONTINUE
GO TO 14
16 KNTPAG=KNTPAG+1
NOWHIH=0
C
C DETERMINE WIDTH OF NEW LINE
17 NEWWID=1
DO 18 I=1,60
IF(LTRINP(I).NE.LTRSPA)NEWWID=I
18 CONTINUE
C
C EXPAND PREVIOUS LINES IF NEW LINE IS WIDER
IF(NEWWID.LE.MAXWID)GO TO 23
IF(KNTCHR.EQ.0)GO TO 22
INIKNT=KNTCHR
KNTCHR=NEWWID*(NOWHIH+(MAXHIH*KNTPAG))
NEEDED=NEWWID-MAXWID
I=KNTCHR
19 DO 20 J=1,NEEDED
LTRALL(I)=LTRSPA
I=I-1
20 CONTINUE
DO 21 J=1,MAXWID
LTRALL(I)=LTRALL(INIKNT)
I=I-1
INIKNT=INIKNT-1
21 CONTINUE
IF(INIKNT.GT.0)GO TO 19
22 MAXWID=NEWWID
C
C LENGTHEN PREVIOUS PAGES IF NEW PAGE IS LONGER
23 IF(NOWHIH.LT.MAXHIH)GO TO 28
IF(KNTPAG.EQ.0)GO TO 27
NEEDED=MAXWID*MAXHIH
INIKNT=KNTCHR
KNTCHR=KNTCHR+(MAXWID*KNTPAG)
I=KNTCHR
24 DO 25 J=1,NEEDED
LTRALL(I)=LTRALL(INIKNT)
I=I-1
INIKNT=INIKNT-1
25 CONTINUE
IF(I.LE.0)GO TO 27
DO 26 J=1,MAXWID
LTRALL(I)=LTRSPA
I=I-1
26 CONTINUE
GO TO 24
27 MAXHIH=MAXHIH+1
C
C STORE THE NEW LINE OF TEXT
28 NOWHIH=NOWHIH+1
DO 29 I=1,MAXWID
KNTCHR=KNTCHR+1
LTRALL(KNTCHR)=LTRINP(I)
29 CONTINUE
GO TO 10
C
C CONSTRUCT THE SIDE-BY-SIDE ILLUSTRATIONS
30 IF(KNTCHR.EQ.0)GO TO 51
I=MAXHIH+2
WRITE(JDSK,31)I
31 FORMAT('.NOFILL.TEST PAGE',1I3)
32 IF(NOWHIH.GE.MAXHIH)GO TO 34
NOWHIH=NOWHIH+1
DO 33 I=1,MAXWID
KNTCHR=KNTCHR+1
LTRALL(KNTCHR)=LTRSPA
33 CONTINUE
GO TO 32
34 KNTPAG=KNTPAG+1
KNTCHR=0
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
DO 38 NOWPAG=1,KNTPAG
DO 35 I=1,MAXWID
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
35 CONTINUE
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
IF(NOWPAG.EQ.KNTPAG)GO TO 38
IF(KOLUMN.LT.0)GO TO 38
IF(KOLUMN.EQ.0)GO TO 37
DO 36 I=1,KOLUMN
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSPA
36 CONTINUE
37 KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
38 CONTINUE
WRITE(JDSK,43)(LTROUT(I),I=1,KNTCHR)
INIKNT=0
DO 44 NOWHIH=1,MAXHIH
KNTCHR=0
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
LOCATN=INIKNT
INIKNT=INIKNT+MAXWID
DO 42 NOWPAG=1,KNTPAG
DO 39 NOWWID=1,MAXWID
KNTCHR=KNTCHR+1
LOCATN=LOCATN+1
LTROUT(KNTCHR)=LTRALL(LOCATN)
39 CONTINUE
LOCATN=LOCATN+(MAXWID*(MAXHIH-1))
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
IF(NOWPAG.EQ.KNTPAG)GO TO 42
IF(KOLUMN.LT.0)GO TO 42
IF(KOLUMN.EQ.0)GO TO 41
DO 40 I=1,KOLUMN
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSPA
40 CONTINUE
41 KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
42 CONTINUE
WRITE(JDSK,43)(LTROUT(I),I=1,KNTCHR)
43 FORMAT(132A1)
44 CONTINUE
KNTCHR=0
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
DO 48 NOWPAG=1,KNTPAG
DO 45 I=1,MAXWID
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
45 CONTINUE
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
IF(NOWPAG.EQ.KNTPAG)GO TO 48
IF(KOLUMN.LT.0)GO TO 48
IF(KOLUMN.EQ.0)GO TO 47
DO 46 I=1,KOLUMN
KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSPA
46 CONTINUE
47 KNTCHR=KNTCHR+1
LTROUT(KNTCHR)=LTRSTR
48 CONTINUE
WRITE(JDSK,43)(LTROUT(I),I=1,KNTCHR)
WRITE(JDSK,49)
49 FORMAT('.FILL')
TYPE 50,MAXWID,KNTPAG,KNTCHR
50 FORMAT(' PAGE WIDTH: ',1I3/
1' PAGE COUNT: ',1I3/
2' TOTAL WIDTH:',1I3)
51 STOP
END