Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50542/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