Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50476/banner.for
There are 2 other files named banner.for in the archive. Click here to see a list.
C     RENBR(BANNER/CONSTRUCT LETTERING ALONG FANFOLD PAPER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS PROGRAM CONSTRUCTS LARGE MULTI-PAGE BANNER WHICH
C     CAN  BE  PRINTED ON LINE-PRINTER.  BANNER CAN CONTAIN
C     SEVERAL PARALLEL LINES OF LETTERING.   EACH  LINE  IN
C     INPUT   FILE   SHOULD  CONTAIN  HEIGHT  MAGNIFICATION
C     FACTOR,  WIDTH  MAGNIFICATION FACTOR,  INTERCHARACTER
C     SPACING  (BEFORE  APPLICATION  OF WIDTH MAGNIFICATION
C     FACTOR),  AND NUMBER  OF  BLANK LINES  TO BE INSERTED
C     BEFORE TEXT,  FOLLOWED ON SAME LINE BY  ONE CHARACTER
C     WHICH  IS  IGNORED  AND THEN BY A SINGLE LINE OF TEXT
C     WHICH IS TO BE REPRESENTED.  FACTORS ARE SPECIFIED AS
C     INTEGERS.   LINE  CONTAINING  SINGLE  ZERO TERMINATES
C     LINES OF  TEXT  TO  BE  SHOWN  IN  PARALLEL  COLUMNS.
C     ADDITIONAL  GROUPS  OF  LINES  CONTAINING NUMBERS AND
C     TEXT  CAN  FOLLOW.   TWO   CONSECUTIVE   LINES   EACH
C     CONTAINING SINGLE ZERO TERMINATE EXECUTION.
C
C     CHARACTERS PRODUCED BY THIS  PROGRAM  ARE  TURNED  90
C     DEGREES   FROM   ORIENTATION   FOR  WHICH  THEY  WERE
C     DESIGNED.  IF TEXT5 FONT IS USED,  HEIGHT  AND  WIDTH
C     MAGNIFICATION  FACTORS  OF  1 WILL GIVE LETTERS WHICH
C     ARE 9 COLUMNS HIGH AND 14 LINES WIDE.  LETTERING  CAN
C     EXTEND  ACROSS  FULL 132 COLUMN WIDTH OF LINE-PRINTER
C     PAPER.   TWO  PARALLEL  LINES  OF  LETTERING  CAN  BE
C     GENERATED  IF  HEIGHT  MAGNIFICATION  FACTOR OF 5 AND
C     WIDTH MAGNIFICATION FACTOR  OF  2  ARE  USED.   THREE
C     PARALLEL LINES CAN BE GENERATED IF HEIGHT FACTOR OF 3
C     AND WIDTH  FACTOR  OF  1  ARE  USED.   INTERCHARACTER
C     SPACING SHOULD BE ABOUT 2.
C
C     CONTENTS  OF  TYPICAL  INPUT  FILE  DESCRIBING  FIRST
C     BANNER  CONTAINING  3  LINES, AND SECOND CONTAINING 2
C     LINES ARE SHOWN BELOW
C
C               3 1 2 0 TOP LINE, 1ST BANNER
C               3 1 2 0 MIDDLE LINE, 1ST BANNER
C               3 1 2 0 BOTTOM LINE, 1ST BANNER
C               3 1 2 0 LINE REJECTED BECAUSE WON'T FIT
C               0
C               5 2 2 0 TOP LINE, 2ND BANNER
C               5 2 2 0 BOTTOM LINE, 2ND BANNER
C               0
C               0
C
      DIMENSION LTTR(1000),IBUFFR(132),ISTORE(240),
     1LINKND(10),LINLNG(10),LINHIH(10),NEEDED(10),
     2LINWID(10),LINUSD(10),LINSPC(10),INITAL(10),
     3MULTPL(4)
      DATA IDISK,JDISK,ITTY,JTTY,MAXBFR,MAXSTR/
     11,20,5,5,132,240/
      DATA IBLANK,IONE,ISTAR,IPLUS/1H ,1H1,1H*,1H+/
      DATA MOVE,ISPACE/1,0/
      DATA MULTPL/1HH,1HI,1HO,1HX/
      CALL TEXT5
      LONGST=0
      WRITE(JTTY,1)
    1 FORMAT(39H NUMBER OF IMPRESSIONS (- FOR DARKEST) ,$)
      READ(ITTY,2)KOPIES
    2 FORMAT(I)
      IF(KOPIES.LT.-4)KOPIES=-4
      IF(KOPIES.GT.8)KOPIES=8
C
C     READ HEIGHT, WIDTH, SPACING AND TEXT TO REPRESENT
      IEOF=0
    3 KNTLIN=0
      LTREND=0
    4 KNTLIN=KNTLIN+1
      IF(KNTLIN.GT.10)GO TO 12
      READ(IDISK,5,END=11)IBUFFR
    5 FORMAT(132A1)
      LOWBFR=1
      LINHIH(KNTLIN)=3
      LINWID(KNTLIN)=1
      LINSPC(KNTLIN)=2
      INITAL(KNTLIN)=0
      NEEDED(KNTLIN)=0
      LINLNG(KNTLIN)=-1
      LINKND(KNTLIN)=0
      DO 7 INDEX=1,4
      CALL DAIHFT(0,0,0,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE)
      GO TO(12,8,6),KIND
    6 IF(INDEX.EQ.1)LINHIH(KNTLIN)=IVALUE
      IF(INDEX.EQ.2)LINWID(KNTLIN)=IVALUE
      IF(INDEX.EQ.3)LINSPC(KNTLIN)=IVALUE
    7 CONTINUE
      IF(IVALUE.LE.0)GO TO 9
      INITAL(KNTLIN)=IVALUE
      LINKND(KNTLIN)=1
      GO TO 9
    8 LOWBFR=LOWBFR-1
    9 LTRBGN=LTREND
      LTREND=LTREND+100
   10 LTRBGN=LTRBGN+1
      IF(LTRBGN.GT.LTREND)GO TO 4
      LOWBFR=LOWBFR+1
      LTTR(LTRBGN)=IBLANK
      IF(LOWBFR.LE.MAXBFR)LTTR(LTRBGN)=IBUFFR(LOWBFR)
      GO TO 10
   11 IEOF=1
   12 KNTLIN=KNTLIN-1
      IF(KNTLIN.LE.0)GO TO 45
C
C     PRODUCE EACH LINE OF LETTERING UNTIL ALL LINES DONE
      IF(LONGST.GT.0)WRITE(JDISK,13)
   13 FORMAT(1X/1X/1X/1X/1X/1X/1X/1X)
      LONGST=0
      KONTRL=IONE
   14 NOWLIN=KNTLIN
      MAXUSD=0
      GO TO 17
C
C     INSERT SEPARATION BETWEEN COLUMNS OF TEXT
   15 IF(MAGNFY.LT.LINHIH(NOWLIN))MAGNFY=LINHIH(NOWLIN)
   16 IF(MAXUSD.GE.MAXBFR)GO TO 37
      MAGNFY=MAGNFY-1
      MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IBLANK
      IF(MAGNFY.GT.0)GO TO 16
C
C     REPRESENT CURRENT LINE OF CURRENT COLUMN OF TEXT
   17 MAGNFY=LINHIH(NOWLIN)
      NEEDED(NOWLIN)=NEEDED(NOWLIN)-1
      IF(NEEDED(NOWLIN).GT.0)GO TO 21
      NEEDED(NOWLIN)=LINWID(NOWLIN)
      LFTCOL=MAXUSD
      LTREND=100*NOWLIN
      LTRBGN=LTREND-99
      INISTR=(24*NOWLIN)-23
      KIND=LINKND(NOWLIN)
      INTRVL=LINSPC(NOWLIN)
      CALL DATURN(INTRVL,MOVE  ,ISPACE,LTTR  ,LTRBGN,
     1LTREND,LFTCOL,MAXBFR,IBUFFR,MAXUSD,MAGNFY,INISTR,
     2MAXSTR,KIND  ,ISTORE)
      IF(INITAL(NOWLIN).LE.0)GO TO 18
      IF(KIND.NE.1)GO TO 20
      NEEDED(NOWLIN)=INITAL(NOWLIN)
      INITAL(NOWLIN)=-INITAL(NOWLIN)
      LINKND(NOWLIN)=0
      KIND=2
      GO TO 19
   18 LINKND(NOWLIN)=KIND
   19 LINUSD(NOWLIN)=MAXUSD
   20 GO TO(23,22,37,41,43),KIND
   21 MAXUSD=LINUSD(NOWLIN)
   22 NOWLIN=NOWLIN-1
      IF(NOWLIN.GT.0)GO TO 15
      GO TO 25
C
C     DONE WITH THIS COLUMN OF TEXT, CHECK IF DONE WITH ALL
   23 IF(LINLNG(NOWLIN).LT.0)LINLNG(NOWLIN)=LONGST
      NOWLIN=NOWLIN-1
      IF(NOWLIN.GT.0)GO TO 15
      NOWLIN=KNTLIN
   24 IF(NOWLIN.LE.0)GO TO 33
      IF(LINLNG(NOWLIN).LT.0)GO TO 25
      NOWLIN=NOWLIN-1
      GO TO 24
C
C     OUTPUT CURRRENT LINE
   25 LONGST=LONGST+1
      IF(KOPIES.LT.0)GO TO 28
      J=KOPIES
   26 WRITE(JDISK,27)KONTRL,(IBUFFR(I),I=1,MAXUSD)
   27 FORMAT(133A1)
      KONTRL=IPLUS
      J=J-1
      IF(J.GT.0)GO TO 26
      GO TO 32
   28 DO 31 K=1,4
      LETTER=MULTPL(K)
      DO 29 I=1,MAXUSD
      IF(IBUFFR(I).NE.IBLANK)IBUFFR(I)=LETTER
   29 CONTINUE
      J=KOPIES
   30 WRITE(JDISK,27)KONTRL,(IBUFFR(I),I=1,MAXUSD)
      KONTRL=IPLUS
      J=J+1
      IF(J.LT.0)GO TO 30
   31 CONTINUE
   32 KONTRL=ISTAR
      GO TO 14
C
C     ERROR MESSAGES AND SUMMATION
   33 WRITE(JTTY,34)(LINLNG(I),I=1,KNTLIN)
   34 FORMAT(18H LENGTHS (TOP 1ST),10I5)
      DO 35 I=1,KNTLIN
   35 LINLNG(I)=(LONGST-LINLNG(I)-INITAL(I))/2
      WRITE(JTTY,36)(LINLNG(I),I=1,KNTLIN)
   36 FORMAT(18H NEEDED TO CENTER ,10I5)
      GO TO 40
   37 WRITE(JTTY,38),KNTLIN
   38 FORMAT(36H LETTERS TOO HIGH TO REPRESENT LINE ,I3)
      DO 39 I=1,KNTLIN
      NEEDED(I)=0
      LINKND(I)=0
      IF(INITAL(I).EQ.0)GO TO 39
      IF(INITAL(I).LT.0)INITAL(I)=-INITAL(I)
      LINKND(I)=1
   39 CONTINUE
      IF(KNTLIN.GT.1)GO TO 12
   40 IF(IEOF.EQ.0)GO TO 3
      GO TO 45
C
C     SERIOUS ERROR CONDITIONS
   41 WRITE(JTTY,42)
   42 FORMAT(20H INSUFFICENT STORAGE)
      GO TO 45
   43 WRITE(JTTY,44)
   44 FORMAT(16H FONT NOT LOADED)
   45 ENDFILE JDISK
      STOP
C251676520779$
      END