Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/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