Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50541/envelo.for
There is 1 other file named envelo.for in the archive. Click here to see a list.
C RENBR(ENVELO/TYPE ADDRESSES ONTO ENVELOPES)
C
C Donald Barth, Yale School of Management
C
C This program types addresses onto either separate
C envelopes or envelopes mounted on continuous fanfold
C forms.
C
C These addresses either are defined by a file in which
C the various components of the address appear to the
C right of at signs and a letter identifying the type
C of component, or are defined by an input file in
C which 1 or more lines starting with a period
C separates the already formatted addresses.
C
C DESCRIPTION OF DOT FORMAT INTPUT FILE
C ----------- -- --- ------ ------ ----
C
C If the addresses are defined by a dot format file,
C then at least one line starting with a period in its
C leftmost column must appear between the addresses.
C The lines which start with periods are otherwise
C ignored. One or more lines starting with a period
C can appear before the first address and after the
C last address, but are not necessary.
C
C If the final line of an address starts with the word
C Dear and ends with a colon or comma, then this line
C is assumed to contain a salutation line and is not
C printed on the envelope.
C
C DESCRIPTION OF AT SIGN FORMAT INTPUT FILE
C ----------- -- -- ---- ------ ------ ----
C
C Each line in an at sign format input file defines a
C single component of an address. The first 2
C characters of each line identify the type of
C component and are not copied into the output file.
C Those portions of the address which require a full
C line, for example department name, organization name,
C and street address, can be continued on as many
C subsequent lines as necessary, and are then written
C out in the same order in which they were encountered
C in the input file. The various components of the
C address can, however, be specified in any order. The
C following at sign character pairs are recognized.
C
C @# Start of new address. Rest of line is ignored.
C @@ End of file. Rest of file is ignored.
C @A Street address. Several can appear.
C @C City name.
C @D Department. Several can appear.
C @E Name suffix (Jr., III, etc.).
C @F First name.
C @G Name for salutation. Do not include Dear or colon.
C @I Identification number. Any spacing. Not used.
C @K Top line key or code.
C @L Last name.
C @M Middle name. Include period if initial.
C @N Country. Don't include if local country.
C @O Organization name. Several can appear.
C @P Name prefix (Mr., Ms., etc.).
C @S State (any form, 2 letters, 4, full, etc.).
C @T Title. Several can appear.
C @Y Any line at bottom of address. (@YCAMPUS MAIL).
C @Z Zip code (any form, 5 digits, 9, etc.).
C
C SAMPLES OF THE 2 TYPES OF INPUT FILES
C ------- -- --- - ----- -- ----- -----
C
C The at sign and dot format files shown below are
C equivalent.
C
C @I 608
C @PMr.
C @FJohn
C @MB.
C @LSmith
C @EJr.
C @TDirector
C @DCareer Counseling Office
C @OCentral College
C @CRockport
C @SCT
C @Z06352
C @GMr. Smith
C @#
C @GLinda
C @Z51222
C @STN
C @CVictorville
C @A6721 Main Street
C @OVillage University
C @OCollege of Science
C @DDepartment of Chemistry
C @LJones
C @MF.
C @FLinda
C @PMs.
C @I 611
C @@
C
C
C .LITERAL
C Mr. John B. Smith, Jr.
C Director
C Career Counseling Office
C Central College
C Rockport, CT 06352
C
C Dear Mr. Smith:
C .END LITERAL.END SPLICE
C .LITERAL
C Ms. Linda F. Jones
C Department of Chemistry
C Village University
C College of Science
C 6721 Main Street
C Victorville, TN 51222
C
C Dear Linda:
C .END LITERAL.END SPLICE
C
C
C ARRAYS USED TO STORE THE DIGITS AND LETTERS A-Z
DIMENSION LTRDGT(10),LTRABC(26),LWRABC(26)
C
C ARRAYS USED TO STORE WORD DEAR FOR FINDING SALUTATION
C LTRDEA(LMTDEA),LWRDEA(LMTDEA)
C
DIMENSION LTRDEA(5),LWRDEA(5)
C
C ARRAY USED TO STORE LINE READ FROM ADDRESS FILE
C LTRBFR(LMTBFR)
C
DIMENSION LTRBFR(72)
C
C ARRAY USED TO STORE LINE TO BE WRITTEN TO ENVELOPE
C LTROUT(LMTOUT)
C
DIMENSION LTROUT(300)
C
C ARRAYS USED FOR UNASSEMBLED ADDRESS READ IN AT FORM
C ISTART(LMTKND),ICHAIN(LMTSEC),LENGTH(LMTSEC),
C LOCATN(LMTSEC),LTRSTR(LMTSTR),LTRKND(LMTKND)
C
DIMENSION ISTART(26),ICHAIN(30),LENGTH(30),
1LOCATN(30),LTRSTR(2000),LTRKND(26)
C
C ARRAYS USED TO STORE WORD TO BE SEARCHED FOR
C LTRNXT(LMTNXT),LWRNXT(LMTNXT)
C
DIMENSION LTRNXT(40),LWRNXT(40)
C
C ARRAYS USED TO STORE THE ASSEMBLED ADDRESS
C LTRADR(LMTCHR),LNGLIN(LMTLIN)
C
DIMENSION LTRADR(1500),LNGLIN(12)
C
C ARRAYS USED TO STORE THE RETURN ADDRESS
C LTRRTN(LMTRTN),LNGRTL(LMTRTL)
C
DIMENSION LTRRTN(300),LNGRTL(10)
C
DATA LTRSPA,LTRDOT,LTRCOM,LTRCOL,LTRATS,LTRSTA,
1LTRQUE/
21H ,1H.,1H,,1H:,1H@,1H*,1H?/
DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
2 1HX,1HY,1HZ/
DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
2 1Hx,1Hy,1Hz/
DATA LTRKND /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
2 1HX,1HY,1HZ/
DATA LTRDEA/1HD,1HE,1HA,1HR,1H /
DATA LWRDEA/1Hd,1He,1Ha,1Hr,1H /
C
C DIMENSION OF WORD TO BE IN FIRST ADDRESS
DATA LMTNXT/40/
C
C DIMENSION OF SINGLE LINE INPUT BUFFER
DATA LMTBFR/72/
C
C DIMENSION OF SINGLE LINE OUTPUT BUFFER
DATA LMTOUT/300/
C
C DIMENSION OF THE ADDRESS COMPONENT STORAGE
DATA LMTKND,LMTSEC,LMTONE,LMTTWO,LMTSTR/
126,30,70,50,2000/
C
C DIMENSION OF THE RETURN ADDRESS
DATA LMTRTN,LMTRTL/300,10/
C
C DIMENSION OF RECONSTRUCTED ADDRESS
DATA LMTLIN,LMTCHR/12,1500/
C
C DIMENSION OF WORD DEAR USED TO LOCATE SALUTATIONS
DATA LMTDEA/5/
C
C DO NOT INCLUDE CODE LINE IN ADDRESS
DATA IFCODE/0/
C
C UNIT NUMBERS
DATA IDISK,JDISK,ITTY,JTTY/1,20,5,5/
C
C ********************************
C * *
C * N N OOOOO TTTTT EEEEE *
C * NN N O O T E *
C * N N N O O T EEEE *
C * N NN O O T E *
C * N N OOOOO T EEEEE *
C * *
C ********************************
C
C LTRTAB = THE TAB CHARACTER WHICH MOVES THE NEXT
C PRINTING CHARACTER TO THE RIGHT OF THE NEXT
C INTEGRAL MULTIPLE OF 8 COLUMNS. THE TAB
C CHARACTER CAN BE TYPED BY THE USER TO CAUSE
C THE RETYPING OF THE CURRENT ADDRESS. ON
C SYSTEMS WHICH DO NOT HAVE THE TAB CHARACTER,
C THE TESTS FOR THIS CHARACTER CAN JUST BE
C REMOVED, SINCE ANY SINGLE PRINTING CHARACTER
C CAN SIMILARLY BE TYPED BY THE USER TO CAUSE
C THE RETYPING OF THE CURRENT ADDRESS. THE
C USE OF THE PRINTING CHARACTER, HOWEVER,
C WASTES THE ENVELOPE UPON WHICH IT IS TYPED.
C LTRTAB IS DEFINED IN OCTAL, RATHER THAN
C HOLLERITH, SINCE THE EDITOR USED TO WRITE
C THIS PROGRAM ITSELF CONVERTS A TAB CHARACTER
C TO THE CORRESPONDING NUMBER OF SPACES.
C ISYSTM = NUMBER OF BLANK LINES WHICH APPEAR BETWEEN A
C LINE TYPED BY THE USER AND THE NEXT LINE
C DISPLAYED BY THIS PROGRAM. THIS LINE
C SPACING IS DEPENDENT UPON THE OPERATING
C SYSTEM BEING USED. ISYSTM IS USED TO
C CALCULATE THE NUMBER OF LINES TYPED ON THE
C TERMINAL DURING A DIALOG BETWEEN THE USER
C AND THE PROGRAM. THE PROGRAM SHOULD RUN
C RELATIVELY WELL EVEN WITH THE WRONG VALUE OF
C ISYSTM, BUT THE USER WOULD HAVE TO MAKE A
C MINOR ADJUSTMENT BETWEEN ALIGNING THE TARGET
C PATTERN ON ENVELOPES WHICH ARE MOUNTED ON
C FANFOLD PAPER AND THE ACTUAL TYPING OF THE
C ADDRESSES.
C = 0, NO EXTRA BLANK LINE SEPARATES AN ITEM
C TYPED BY THE USER AND THE NEXT LINE TYPED BY
C THIS PROGRAM. IF THE USER TYPES A CONTROL-Z
C OR END-OF-OF FILE, THEN THE NEXT LINE
C WRITTEN BY THE PROGRAM WILL APPEAR
C IMMEDIATELY TO THE RIGHT OF THE UP-ARROW Z
C BY WHICH THE CONTROL-Z IS REPRESENTED ON THE
C TERMINAL.
C = 1, ONE EXTRA BLANK LINE SEPARATES AN ITEM
C TYPED BY THE USER AND THE NEXT LINE TYPED BY
C THIS PROGRAM. IF THE USER TYPES A CONTROL-Z
C OR END-OF-OF FILE, THEN THE NEXT LINE
C WRITTEN BY THE PROGRAM WILL APPEAR ON THE
C NEXT LINE IMMEDIATELY BELOW THE UP-ARROW Z
C BY WHICH THE CONTROL-Z IS REPRESENTED
C
DATA LTRTAB/"045004020100/
DATA ISYSTM/1/
C
C ***********************************************
C * *
C * USER INTERACTION TO SET TYPE OF ENVELOPES *
C * *
C ***********************************************
C
C TELL USER WHAT PROGRAM THIS IS
CALL ENVHLP(ITTY,19)
C
C ASK THE USER TO DESCRIBE THE ENVELOPES
CALL ENVHOW(IFNFLD,IOVERP,IRETRN,ISYSTM,ITTY ,
1 JRETRN,JTTY ,KOPIES,KRETRN,LBLBOX,LBLMAX,LMTBFR,
2 LMTRTL,LMTRTN,LNGENV,LNGRTL,LTRBFR,LTRRTN,MAXRTL,
3 MRGBOT,MRGCEN,MRGCOR,MRGDWN,MRGMID,MRGTOP)
C
C SET TERMINAL CHARACTERISTICS
C TTYSET IS A SYSTEM DEPENDENT ROUTINE WHICH TURNS OFF
C THE PAUSING AFTER A SET NUMBER OF LINES HAVE BEEN
C TYPED ON THE TERMINAL
IF(IFNFLD.LT.0)GO TO 1
CALL TTYSET
1 CONTINUE
C
C PREPARE FOR FIRST ADDRESS
C KNTLCL = NUMBER ENVELOPES THIS FILE W/O TARGETS
C KNTROW = NUMBER ENVELOPES THIS FILE WITH TARGETS
C KNTTTL = NUMBER ENVELOPES ALL FILES W/O TARGETS
C KNTLBL = NUMBER ENVELOPES ALL FILES WITH TARGETS
C KNTOUT = NUMBER LINES WRITTEN TO OUTPUT DEVICE
C
KNTLBL=0
KNTOUT=0
IFEVER=0
KNTFIL=0
KNTTTL=0
C
C MAXIMUM NUMBER OF ENVELOPES IN SINGLE FILE
MAXROW=LBLMAX-LBLBOX
IF(MAXROW.LE.0)MAXROW=LBLMAX
KNTROW=0
C
C LENGTHEN SEPARATE ENVELOPES TO EJECT FROM TERMINAL
LNGTYP=LNGENV
IF(IFNFLD.NE.0)GO TO 2
LNGENV=LNGENV+6
2 CONTINUE
C
C ASK USER FOR NAME OF THE SOURCE FILE TO BE READ
3 WRITE(ITTY,4)
4 FORMAT(' File containing addresses? ',$)
IF(IFNFLD.GE.0)KNTOUT=KNTOUT+ISYSTM+1
ISTORE=1
IWRITE=0
CALL FILOPN(ISTORE,IDISK,ITTY,JTTY,IWRITE,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 121
IF(IFOPEN.GT.0)GO TO 5
C FILE CANNOT BE OPENED MESSAGE CONSISTS OF 2 LINES
IF(IFNFLD.GE.0)KNTOUT=KNTOUT+2
GO TO 3
5 CONTINUE
C
C ITEMS TO BE RESET FOR EACH NEW FILE PROCESSED
MINNXT=1
MAXNXT=-1
IEOF=0
KNTADR=0
KNTINP=0
INFORM=0
IAUTHR=-1
C
C *************************************
C * *
C * READ NEXT ADDRESS IN DOT FORMAT *
C * *
C *************************************
C
C GET NEXT LINE OF ADDRESS
6 IF(IAUTHR.GT.0)GO TO 14
KNTLIN=0
KNTCHR=0
7 IF(IEOF.NE.0)GO TO 112
READ(IDISK,8,END=15)LTRBFR
8 FORMAT(72A1)
KNTINP=KNTINP+1
IF(IAUTHR.EQ.0)GO TO 9
IF(LTRBFR(1).EQ.LTRATS)GO TO 13
IAUTHR=0
C
C STORE THE LINE IF NOT A DOT COMMAND
9 IF(LTRBFR(1).EQ.LTRDOT)GO TO 16
IF(KNTLIN.GE.LMTLIN)GO TO 7
MAXPRT=LMTBFR+1
10 MAXPRT=MAXPRT-1
IF(MAXPRT.LE.0)GO TO 7
IF(LTRBFR(MAXPRT).EQ.LTRSPA)GO TO 10
I=0
11 IF(I.GE.MAXPRT)GO TO 12
IF(KNTCHR.GE.LMTCHR)GO TO 12
I=I+1
KNTCHR=KNTCHR+1
LTRADR(KNTCHR)=LTRBFR(I)
GO TO 11
12 KNTLIN=KNTLIN+1
LNGLIN(KNTLIN)=I
GO TO 7
C
C *****************************************
C * *
C * READ NEXT ADDRESS IN AT SIGN FORMAT *
C * *
C *****************************************
C
C GET NEXT ADDRESS
13 IAUTHR=1
KNTINP=-2
14 CALL GETADR(ITTY,IDISK,LMTKND,LMTSEC,
1LTRKND,ISTART,ICHAIN,LENGTH,LTRSTR,KNTINP,LOCATN,
2LMTSTR,INFORM,LTRBFR,LMTBFR)
IF(KNTINP.EQ.0)GO TO 112
C
C CONSTRUCT THE NEXT ADDRESS
CALL PUTADR(LMTONE,LMTKND,LMTSEC,LMTTWO,ISTART,
1 ICHAIN,LENGTH,LTRSTR,LOCATN,LMTSTR,LNGLIN,KNTLIN,
2 LMTLIN,LTRADR,LMTCHR,KNTCHR,IFCODE,LOCTTL)
GO TO 16
C
C ************************************
C * *
C * REMOVE SALUTATION FROM ADDRESS *
C * *
C ************************************
C
C DOT COMMAND INDICATES END OF ADDRESS
15 IEOF=1
16 IF(KNTLIN.LE.0)GO TO 6
C
C TRIM OFF TERMINAL SALUTATION LINE
MINTST=KNTCHR-LNGLIN(KNTLIN)
DO 17 KOLUMN=1,LMTDEA
MINTST=MINTST+1
IF(LTRADR(MINTST).EQ.LTRDEA(KOLUMN))GO TO 17
IF(LTRADR(MINTST).EQ.LWRDEA(KOLUMN))GO TO 17
GO TO 20
17 CONTINUE
IF(LTRADR(KNTCHR).EQ.LTRCOL)GO TO 18
IF(LTRADR(KNTCHR).EQ.LTRCOM)GO TO 18
GO TO 20
18 KNTCHR=KNTCHR-LNGLIN(KNTLIN)
19 KNTLIN=KNTLIN-1
20 IF(KNTLIN.LE.0)GO TO 6
IF(LNGLIN(KNTLIN).LE.0)GO TO 19
C
C ************************************************
C * *
C * CHECK IF THIS IS ADDRESS REQUESTED BY USER *
C * *
C ************************************************
C
C CHECK IF THIS ADDRESS HAS BEEN SPECIFIED BY USER
21 IF(MAXNXT.LE.0)GO TO 32
MAXTST=0
DO 31 LINE=1,KNTLIN
MINTST=MAXTST+1
MAXTST=MAXTST+LNGLIN(LINE)
IF(MINTST.GT.MAXTST)GO TO 31
DO 30 KOLUMN=MINTST,MAXTST
MATCH=KOLUMN
IF(KOLUMN.EQ.MINTST)GO TO 23
IF(LTRADR(KOLUMN).EQ.LTRSPA)GO TO 22
IF(LTRADR(KOLUMN).EQ.LTRCOM)GO TO 22
GO TO 30
22 MATCH=KOLUMN+1
23 INNER=MINNXT
24 IF(MATCH.GT.MAXTST)GO TO 31
IF(LTRADR(MATCH).NE.LTRSPA)GO TO 25
IF(LTRNXT(INNER).NE.LTRSPA)GO TO 30
MATCH=MATCH+1
GO TO 24
25 IF(LTRNXT(INNER).NE.LTRSPA)GO TO 26
IF(INNER.GE.MAXNXT)GO TO 26
INNER=INNER+1
GO TO 25
26 IF(LTRADR(MATCH).EQ.LTRNXT(INNER))GO TO 27
IF(LTRADR(MATCH).EQ.LWRNXT(INNER))GO TO 27
GO TO 30
27 INNER=INNER+1
MATCH=MATCH+1
IF(INNER.LE.MAXNXT)GO TO 24
IF(MATCH.GT.MAXTST)GO TO 32
LTRNOW=LTRADR(MATCH)
IF(LTRNOW.EQ.LTRSPA)GO TO 32
IF(LTRNOW.EQ.LTRCOM)GO TO 32
DO 28 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 30
IF(LTRNOW.EQ.LWRABC(I))GO TO 30
28 CONTINUE
DO 29 I=1,10
IF(LTRNOW.EQ.LTRDGT(I))GO TO 30
29 CONTINUE
GO TO 32
30 CONTINUE
31 CONTINUE
GO TO 6
32 CONTINUE
C
C ****************************************
C * *
C * TELL USER TO INSERT FIRST ENVELOPE *
C * *
C ****************************************
C
DO 107 KOPY=1,KOPIES
DO 106 IRETRN=JRETRN,KRETRN
IFWAIT=0
33 IF(IFNFLD.GE.0)GO TO 38
IF(MAXNXT.LT.0)GO TO 46
C
C DECIDE FILE TO WHICH ADDRESS IS TO BE WRITTEN
IF(KNTROW.EQ.0)GO TO 37
IF(KNTROW.GT.0)GO TO 35
KNTROW=-KNTROW
WRITE(ITTY,34)KNTFIL
34 FORMAT(' Output file number',1I4,' is being continued')
GO TO 84
35 IF(KNTROW.LE.MAXROW)GO TO 84
ISTORE=2
CALL FILEND(ISTORE,JDISK)
WRITE(ITTY,36)KNTFIL,KNTLCL
36 FORMAT(' Output file number',1I4,' contains',1I10,' envelopes')
37 KNTROW=1
ISTORE=2
CALL FILNXT(ISTORE,JDISK,ITTY,KNTFIL,2)
IF(KNTFIL.LE.0)GO TO 131
KNTLCL=0
IF(LBLBOX.LE.0)GO TO 84
GO TO 61
C
C START OF RETYPING OF ANOTHER COPY OF ENVELOPE
38 IF(MAXNXT.GT.0)GO TO 79
IF(MAXNXT.EQ.0)GO TO 84
C
C FIRST ENVELOPE
IF(IFNFLD.NE.0)GO TO 40
IF(MAXRTL.GT.0)GO TO 39
CALL ENVHLP(ITTY,24)
KNTOUT=KNTOUT+5
GO TO 41
39 CALL ENVHLP(ITTY,25)
KNTOUT=KNTOUT+5
GO TO 41
40 CALL ENVHLP(ITTY,26)
KNTOUT=KNTOUT+5
GO TO 41
C
C RESET LINE COUNT IF FIRST TIME LINE TYPED BY USER
41 IF(IFEVER.NE.0)GO TO 42
IFEVER=1
KNTOUT=0
GO TO 48
C
C EJECT BLANK LINES BEFORE READING LINE TYPED BY USER
42 IF(IFNFLD.EQ.0)GO TO 43
C COUNT USER PRESSING RETURN AS LINE ON FANFOLD PAPER
KNTOUT=KNTOUT+ISYSTM+1
43 NEEDED=(KNTLBL*LNGENV)
IF(NEEDED.GE.KNTOUT)GO TO 48
44 KNTLBL=KNTLBL+1
NEEDED=NEEDED+LNGENV
IF(NEEDED.GE.KNTOUT)GO TO 45
IF(IFNFLD.NE.0)GO TO 44
KNTOUT=KNTOUT-ISYSTM-1
GO TO 44
45 IF(NEEDED.LE.KNTOUT)GO TO 48
KNTOUT=KNTOUT+1
WRITE(ITTY,99)
GO TO 45
C
C WAIT UNTIL USER PRESSES RETURN KEY
46 WRITE(ITTY,47)
47 FORMAT(' Word or phrase unique to first envelope? ',$)
48 READ(JTTY,49,END=57)LTRNXT
49 FORMAT(40A1)
C
C FIND OUT IF USER WANTS TO SEARCH FOR PARTICULAR NAME
MINNXT=0
MAXNXT=0
50 MINNXT=MINNXT+1
IF(MINNXT.GT.LMTNXT)GO TO 59
IF(LTRNXT(MINNXT).EQ.LTRSPA)GO TO 50
MAXNXT=LMTNXT+1
51 MAXNXT=MAXNXT-1
IF(LTRNXT(MAXNXT).EQ.LTRSPA)GO TO 51
IF(MINNXT.LT.MAXNXT)GO TO 108
IF(LTRNXT(MINNXT).EQ.LTRQUE)GO TO 54
IF(IFNFLD.GE.0)GO TO 53
WRITE(ITTY,52)
52 FORMAT(' Word must be longer than a single character')
GO TO 46
53 IF(LTRNXT(MINNXT).EQ.LTRTAB)GO TO 84
IFWAIT=0
GO TO 60
54 IF(IFNFLD.GE.0)GO TO 55
CALL ENVHLP(ITTY,22)
GO TO 46
55 IF(KNTADR.NE.0)GO TO 56
CALL ENVHLP(ITTY,23)
KNTOUT=KNTOUT+9
GO TO 42
56 CALL ENVHLP(ITTY,27)
KNTOUT=KNTOUT+11
GO TO 42
57 CALL TTYEOF(JTTY)
IF(IFNFLD.LT.0)GO TO 58
IF(ISYSTM.EQ.0)WRITE(ITTY,99)
KNTOUT=KNTOUT-ISYSTM
MINNXT=1
MAXNXT=0
GO TO 79
58 CALL TTYEOF(JTTY)
WRITE(ITTY,99)
GO TO 46
59 IF(IFWAIT.NE.0)GO TO 106
GO TO 33
C
C ******************************
C * *
C * GENERATE TARGET ENVELOPE *
C * *
C ******************************
C
60 LBLBOX=-1
61 NOWBOX=1
62 LEVEL1=MRGTOP+1
LEVEL2=MRGTOP+MAXRTL
IF(LEVEL2.GT.LNGTYP)LEVEL2=LNGTYP
LEVEL3=MRGMID+1
LEVEL4=MRGBOT
IF(LEVEL4.GT.LNGTYP)LEVEL4=LNGTYP
LEVEL0=KNTLBL*LNGENV
LEVEL1=LEVEL1+LEVEL0
LEVEL2=LEVEL2+LEVEL0
LEVEL3=LEVEL3+LEVEL0
LEVEL4=LEVEL4+LEVEL0
NEEDED=LNGENV
IF(IFNFLD.EQ.0)GO TO 63
NEEDED=NEEDED-ISYSTM-1
IF(NEEDED.LT.0)NEEDED=0
63 LEVEL0=LEVEL0+NEEDED
C
C DETERMINE WHAT IS TO BE ON NEXT LINE OF ADDRESS
64 IF(KNTOUT.GE.LEVEL0)GO TO 78
KNTOUT=KNTOUT+1
LEVEL6=1
IF(MAXRTL.EQ.0)GO TO 65
IF(KNTOUT.LT.LEVEL1)GO TO 65
IF(KNTOUT.GT.LEVEL2)GO TO 65
LEVEL6=2
65 IF(KNTOUT.LT.LEVEL3)GO TO 66
IF(KNTOUT.GT.LEVEL4)GO TO 66
LEVEL6=LEVEL6+2
66 LOWBFR=0
GO TO(76,71,68,67),LEVEL6
C
C COPY ASTERISKS INTO OUTPUT LINE
67 IF(MRGCOR.LE.MRGCEN)GO TO 71
68 IF(LOWBFR.GE.MRGCEN)GO TO 69
IF(LOWBFR.GE.LMTOUT)GO TO 74
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSPA
GO TO 68
69 J=1
IF(KNTOUT.EQ.LEVEL3)J=20
IF(KNTOUT.EQ.LEVEL4)J=20
DO 70 I=1,J
IF(LOWBFR.GE.LMTOUT)GO TO 74
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSTA
70 CONTINUE
IF(LEVEL6.NE.4)GO TO 74
IF(MRGCOR.LE.MRGCEN)GO TO 74
71 IF(LOWBFR.GE.MRGCOR)GO TO 72
IF(LOWBFR.GE.LMTOUT)GO TO 74
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSPA
GO TO 71
72 J=1
IF(KNTOUT.EQ.LEVEL1)J=20
IF(KNTOUT.EQ.LEVEL2)J=20
DO 73 I=1,J
IF(LOWBFR.GE.LMTOUT)GO TO 74
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSTA
73 CONTINUE
IF(LEVEL6.NE.4)GO TO 74
IF(MRGCOR.LE.MRGCEN)GO TO 68
74 IF(IFNFLD.GE.0)GO TO 75
WRITE(JDISK,100)(LTROUT(I),I=1,LOWBFR)
GO TO 64
75 WRITE(ITTY,101)(LTROUT(I),I=1,LOWBFR)
GO TO 64
C
C SHOW LINES NOT IN ADDRESSES
76 IF(IFNFLD.GE.0)GO TO 77
WRITE(JDISK,99)
GO TO 64
77 WRITE(ITTY,99)
GO TO 64
C
C ADVANCE COUNT OF NUMBER OF ADDRESSES TYPED
78 KNTLBL=KNTLBL+1
NOWBOX=NOWBOX+1
IF(NOWBOX.LE.LBLBOX)GO TO 62
IF(LBLBOX.LT.0)GO TO 41
GO TO 84
C
C ******************************************
C * *
C * SKIP OVER ENVELOPE SPOILED BY DIALOG *
C * *
C ******************************************
C
C ERROR MESSAGE HELD UNTIL AN ENVELOPE IS READY
C NECESSARY FOR WHEN USER HAS TYPED NAME TO BE LOCATED
79 NEEDED=(KNTLBL*LNGENV)+MRGMID
80 IF(NEEDED.LE.KNTOUT)GO TO 81
KNTOUT=KNTOUT+1
WRITE(ITTY,99)
GO TO 80
81 KNTOUT=KNTOUT+1
WRITE(ITTY,82)
82 FORMAT(' DISCARD THIS ENVELOPE')
KNTLBL=KNTLBL+1
IF(IFNFLD.NE.0)GO TO 84
NEEDED=(KNTLBL*LNGENV)
83 IF(NEEDED.LE.KNTOUT)GO TO 42
KNTOUT=KNTOUT+1
WRITE(ITTY,99)
GO TO 83
C
C *******************************
C * *
C * TYPE ADDRESS ONTO ENELOPE *
C * *
C *******************************
C
C LOCATIONS OF ADDRESS ON NEXT ENVELOPE
C LEVEL1 = TOP OF RETURN ADDRESS
C LEVEL2 = BOTTOM OF RETURN ADDRESS
C LEVEL3 = TOP OF DESTINATION ADDRESS
C LEVEL4 = BOTTOM OF DESTINATION ADDRESS
C LEVEL0 = BOTTOM OF ENVELOPE
C
C DECIDE WHICH ADDRESS IS AT CORNER
84 IF(IRETRN.EQ.2)GO TO 85
C
C CONSTANT ADDRESS IS AT CORNER
NOWCOR=MRGCOR
NOWCEN=MRGCEN
LEVEL1=MRGDWN-MAXRTL
IF(LEVEL1.GT.MRGTOP)LEVEL1=MRGTOP
LEVEL3=MRGBOT-KNTLIN
IF(LEVEL3.GT.MRGMID)LEVEL3=MRGMID
GO TO 86
C
C VARYING ADDRESS IS AT CORNER
85 NOWCOR=MRGCEN
NOWCEN=MRGCOR
LEVEL1=MRGBOT-MAXRTL
IF(LEVEL1.GT.MRGMID)LEVEL1=MRGMID
LEVEL3=MRGDWN-KNTLIN
IF(LEVEL3.GT.MRGTOP)LEVEL3=MRGTOP
C
C PREPARE TO TYPE TOP LINE OF THE ADDRESSES
86 IF(LEVEL1.LT.0)LEVEL1=0
LEVEL2=LEVEL1+MAXRTL
IF(LEVEL2.GT.LNGTYP)LEVEL2=LNGTYP
IF(LEVEL3.LT.0)LEVEL3=0
LEVEL4=LEVEL3+KNTLIN
IF(LEVEL4.GT.LNGTYP)LEVEL4=LNGTYP
LEVEL0=KNTLBL*LNGENV
LEVEL1=LEVEL1+LEVEL0
LEVEL2=LEVEL2+LEVEL0
LEVEL3=LEVEL3+LEVEL0
LEVEL4=LEVEL4+LEVEL0
LEVEL0=LEVEL0+LNGENV
MAXTOP=0
LINTOP=0
MAXBOT=0
LINBOT=0
C
C DETERMINE WHAT IS TO BE ON NEXT LINE OF ADDRESS
87 IF(KNTOUT.GE.LEVEL0)GO TO 105
KNTOUT=KNTOUT+1
LEVEL6=1
IF(KNTOUT.LE.LEVEL1)GO TO 88
IF(KNTOUT.GT.LEVEL2)GO TO 88
LINTOP=LINTOP+1
MINTOP=MAXTOP+1
MAXTOP=MAXTOP+LNGRTL(LINTOP)
LEVEL6=2
88 IF(KNTOUT.LE.LEVEL3)GO TO 89
IF(KNTOUT.GT.LEVEL4)GO TO 89
LINBOT=LINBOT+1
MINBOT=MAXBOT+1
MAXBOT=MAXBOT+LNGLIN(LINBOT)
LEVEL6=LEVEL6+2
89 LOWBFR=0
GO TO(103,94,91,90),LEVEL6
C
C COPY ADDRESS OR ADDRESSES INTO OUTPUT LINE
90 IF(NOWCOR.LE.NOWCEN)GO TO 94
91 IF(LOWBFR.GE.NOWCEN)GO TO 92
IF(LOWBFR.GE.LMTOUT)GO TO 97
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSPA
GO TO 91
92 IF(MINBOT.GT.MAXBOT)GO TO 93
IF(LOWBFR.GE.LMTOUT)GO TO 97
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRADR(MINBOT)
MINBOT=MINBOT+1
GO TO 92
93 IF(LEVEL6.NE.4)GO TO 97
IF(NOWCOR.LE.NOWCEN)GO TO 97
94 IF(LOWBFR.GE.NOWCOR)GO TO 95
IF(LOWBFR.GE.LMTOUT)GO TO 97
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRSPA
GO TO 94
95 IF(MINTOP.GT.MAXTOP)GO TO 96
IF(LOWBFR.GE.LMTOUT)GO TO 97
LOWBFR=LOWBFR+1
LTROUT(LOWBFR)=LTRRTN(MINTOP)
MINTOP=MINTOP+1
GO TO 95
96 IF(LEVEL6.NE.4)GO TO 97
IF(NOWCOR.LE.NOWCEN)GO TO 91
97 IF(IFNFLD.GE.0)GO TO 98
WRITE(JDISK,100)(LTROUT(I),I=1,LOWBFR)
GO TO 87
98 WRITE(ITTY,101)(LTROUT(I),I=1,LOWBFR)
IF(IOVERP.NE.0)WRITE(ITTY,102)(LTROUT(I),I=1,LOWBFR)
GO TO 87
C
C FORMAT STATEMENTS FOR THE ENVELOPES
99 FORMAT(1X)
100 FORMAT(300A1)
101 FORMAT(1X,300A1)
102 FORMAT('+',300A1)
C
C SPACE ABOVE, BETWEEN OR BELOW ADDRESS
103 IF(IFNFLD.GE.0)GO TO 104
WRITE(JDISK,99)
GO TO 87
104 WRITE(ITTY,99)
GO TO 87
C
C ************************
C * *
C * ENVELOPE COMPLETED *
C * *
C ************************
C
C ADVANCE COUNTS OF NUMBER OF ADDRESSES TYPED
105 CONTINUE
KNTTTL=KNTTTL+1
KNTLCL=KNTLCL+1
KNTLBL=KNTLBL+1
KNTROW=KNTROW+1
KNTADR=1
MINNXT=1
MAXNXT=0
IFWAIT=1
IF(IFNFLD.EQ.0)GO TO 48
C
C END OF COPIES AND RETURN-MAIN ADDRESS LOOPS
106 CONTINUE
107 CONTINUE
GO TO 6
C
C CONVERT CASES OF LETTERS IN PHRASE TYPED BY USER
108 IF(MINNXT.GT.MAXNXT)GO TO 111
DO 110 I=MINNXT,MAXNXT
LWRNXT(I)=LTRNXT(I)
DO 109 J=1,26
IF(LTRNXT(I).EQ.LWRABC(J))LTRNXT(I)=LTRABC(J)
IF(LWRNXT(I).EQ.LTRABC(J))LWRNXT(I)=LWRABC(J)
109 CONTINUE
110 CONTINUE
111 IF(KNTADR.NE.0)GO TO 6
KNTADR=1
GO TO 21
C
C CLOSE AND REOPEN OUTPUT FILE IN APPEND MODE
112 IF(IFNFLD.GE.0)GO TO 115
IF(KNTROW.LE.0)GO TO 115
WRITE(ITTY,113)KNTFIL,KNTLCL
113 FORMAT(' Output file number',1I4,' contains',1I10,' envelopes')
IF(KNTROW.GT.MAXROW)GO TO 114
ISTORE=2
C FOLLOWING CALL CLOSES OUTPUT FILE AND REOPENS FILE IN
C APPEND MODE. THIS CALL IS NOT REALLY NECESSARY.
CALL FILCUT(ISTORE,JDISK)
KNTROW=-KNTROW
GO TO 115
114 ISTORE=2
CALL FILEND(ISTORE,JDISK)
KNTROW=0
115 CONTINUE
C
C TELL USER IF SPECIFIED ADDRESS NOT FOUND
IF(MINNXT.GT.MAXNXT)GO TO 117
WRITE(ITTY,116)(LTRNXT(I),I=MINNXT,MAXNXT)
116 FORMAT(' Could not locate ',40A1)
IF(IFNFLD.GE.0)KNTOUT=KNTOUT+1
GO TO 121
C
C EJECT EXTRA LINES ON LAST FANFOLD ENVELOPE SINCE IT
C MIGHT BE ALIGNED SO LOW THAT USER TYPING WOULD
C BE ON BOTTOM OF ENVELOPE JUST COMPLETED
117 IF(IFNFLD.EQ.0)GO TO 121
NEEDED=MRGMID
IF(MAXRTL.EQ.0)GO TO 118
IF(NEEDED.GT.MRGTOP)NEEDED=MRGTOP
118 NEEDED=(KNTLBL*LNGENV)+NEEDED
119 IF(NEEDED.LE.KNTOUT)GO TO 121
KNTOUT=KNTOUT+1
IF(IFNFLD.GE.0)GO TO 120
WRITE(JDISK,99)
GO TO 119
120 WRITE(ITTY,99)
GO TO 119
C
C ASK USER IF ADDITIONAL LABELS ARE TO BE PROCESSED
121 WRITE(ITTY,122)
122 FORMAT(' Process additional addresses (Y or N)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
IF(IFNFLD.LT.0)GO TO 123
KNTOUT=KNTOUT+ISYSTM+1
123 GO TO(121,125,125,124,125,125,125,124),KIND
124 IF(LETTER.EQ.14)GO TO 127
IF(LETTER.EQ.25)GO TO 3
125 IF(IFNFLD.LT.0)GO TO 126
CALL ENVHLP(ITTY,20)
KNTOUT=KNTOUT+3
GO TO 121
126 CALL ENVHLP(ITTY,21)
GO TO 121
C
C ALL DONE WITH ALL LABELS
127 IF(KNTROW.EQ.0)GO TO 130
IF(IFNFLD.GE.0)GO TO 128
ISTORE=2
CALL FILEND(ISTORE,JDISK)
128 WRITE(ITTY,129)KNTTTL
129 FORMAT(' Total envelopes produced:',1I10)
130 GO TO 133
C
C SOMETHING WRONG WITH OUTPUT FILE
131 WRITE(ITTY,132)
132 FORMAT(' Cannot open output file')
C
C ALL DONE WITH ALL ENVELOPES
C LEAVE ROUTINE EXITS WITHOUT TIME SUMMARY
133 CALL LEAVE
STOP
END
SUBROUTINE ENVHOW(IFNFLD,IOVERP,IRETRN,ISYSTM,ITTY ,
1 JRETRN,JTTY ,KOPIES,KRETRN,LBLBOX,LBLMAX,LMTBFR,
2 LMTRTL,LMTRTN,LNGENV,LNGRTL,LTRBFR,LTRRTN,MAXRTL,
3 MRGBOT,MRGCEN,MRGCOR,MRGDWN,MRGMID,MRGTOP)
C RENBR(/ASK USER TO DESCRIBE ENVELOPES)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
DIMENSION LNGRTL(LMTRTL)
DIMENSION LTRBFR(LMTBFR),LTRRTN(LMTRTN)
C
DATA LTRQUE,LTRSPA/1H?,1H /
C
C ASK USER IF FANFOLD ENVELOPES WILL BE USED
1 WRITE(ITTY,2)
2 FORMAT(
1' Separate or Continuous envelopes or File (S, C or F)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(1,4,4,3,4,4,4,3),KIND
C IFNFLD = -1, CONTINUOUS ENVELOPES WRITTEN TO FILE
C = 0, SEPARATE ENVELOPES WRITTEN TO TERMINAL
C = 1, CONTINUOUS ENVELOPES WRITTEN TO TERMINAL
3 IFNFLD=-2
IF(LETTER.EQ.19)IFNFLD=0
IF(LETTER.EQ. 6)IFNFLD=-1
IF(LETTER.EQ. 3)IFNFLD=1
IF(IFNFLD.GE.-1)GO TO 5
4 CALL ENVHLP(ITTY,1)
GO TO 1
5 CONTINUE
C
C ASK HOW MANY TARGET ENVELOPES ARE DESIRED
LBLBOX=0
IF(IFNFLD.GE.0)GO TO 10
6 WRITE(ITTY,7)
7 FORMAT(' Number of target envelopes in each file? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(6,8,9,9,9,9,9,9),KIND
8 LBLBOX=IVALUE
IF(LBLBOX.GE.0)GO TO 10
9 CALL ENVHLP(ITTY,2)
GO TO 6
10 CONTINUE
C
C ASK MAXIMUM NUMBER OF ENVELOPES IN EACH OUTPUT FILE
LBLMAX=0
IF(IFNFLD.GE.0)GO TO 15
11 WRITE(ITTY,12)
12 FORMAT(' Maximum number of envelopes in each file? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(11,13,14,14,14,14,14,14),KIND
13 LBLMAX=IVALUE
IF(LBLMAX.GT.0)GO TO 15
14 CALL ENVHLP(ITTY,3)
GO TO 11
15 CONTINUE
C
C ASK IF WIDE OR NARROW ENVELOPES ARE TO BE USED
16 WRITE(ITTY,17)
17 FORMAT(' Wide, Narrow or Other size envelopes (W, N',
1' or O)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(16,19,19,18,19,19,19,18),KIND
18 KNDENV=-2
IF(LETTER.EQ.14)KNDENV=0
IF(LETTER.EQ.15)KNDENV=-1
IF(LETTER.EQ.23)KNDENV=1
IF(KNDENV.GE.-1)GO TO 20
19 CALL ENVHLP(ITTY,4)
GO TO 16
20 CONTINUE
C
C ASK USER TO SPECIFY SIZE OF SPECIAL ENVELOPE
IF(KNDENV.GE.0)GO TO 32
DO 31 NUMBER=1,7
21 IF(NUMBER.EQ.1)WRITE(ITTY,22)
IF(NUMBER.EQ.2)WRITE(ITTY,23)
IF(NUMBER.EQ.3)WRITE(ITTY,24)
IF(NUMBER.EQ.4)WRITE(ITTY,25)
IF(NUMBER.EQ.5)WRITE(ITTY,26)
IF(NUMBER.EQ.6)WRITE(ITTY,27)
IF(NUMBER.EQ.7)WRITE(ITTY,28)
22 FORMAT(' Maximum number of lines above corner addre',
1'ss? ',$)
23 FORMAT(' Minimum number of lines below corner addre',
1'ss? ',$)
24 FORMAT(' Maximum number of lines above middle addre',
1'ss? ',$)
25 FORMAT(' Minimum number of lines below middle addre',
1'ss? ',$)
26 FORMAT(' Height of envelope as number of lines? ',$)
27 FORMAT(' Number of blank columns left of corner add',
1'ress? ',$)
28 FORMAT(' Number of blank columns left of middle add',
1'ress? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(21,29,30,30,30,30,30,30),KIND
29 IF(IVALUE.LT.0)GO TO 30
IF(NUMBER.EQ.1)MRGTOP=IVALUE
IF(NUMBER.EQ.2)MRGDWN=IVALUE
IF(NUMBER.EQ.3)MRGMID=IVALUE
IF(NUMBER.EQ.4)MRGBOT=IVALUE
IF(NUMBER.EQ.5)LNGENV=IVALUE
IF(NUMBER.EQ.6)MRGCOR=IVALUE
IF(NUMBER.EQ.7)MRGCEN=IVALUE
GO TO 31
30 IF(NUMBER.EQ.1)CALL ENVHLP(ITTY,5)
IF(NUMBER.EQ.2)CALL ENVHLP(ITTY,6)
IF(NUMBER.EQ.3)CALL ENVHLP(ITTY,7)
IF(NUMBER.EQ.4)CALL ENVHLP(ITTY,8)
IF(NUMBER.EQ.5)CALL ENVHLP(ITTY,9)
IF(NUMBER.EQ.6)CALL ENVHLP(ITTY,10)
IF(NUMBER.EQ.7)CALL ENVHLP(ITTY,11)
GO TO 21
31 CONTINUE
32 CONTINUE
C
C ASK USER TO SPECIFY PITCH
IF(KNDENV.LT.0)GO TO 37
33 WRITE(ITTY,34)
34 FORMAT(' Pica or Elite spacing (P or E)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(33,36,36,35,36,36,36,35),KIND
35 IPITCH=0
IF(LETTER.EQ.16)IPITCH=10
IF(LETTER.EQ. 5)IPITCH=12
IF(IPITCH.NE.0)GO TO 37
36 CALL ENVHLP(ITTY,12)
GO TO 33
37 CONTINUE
C
C ASK USER TO EACH LINE IS TO BE TYPED TWICE
IOVERP=0
IF(IFNFLD.LT.0)GO TO 42
38 WRITE(ITTY,39)
39 FORMAT(' Light or dark type (L or D)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(38,41,41,40,41,41,41,40),KIND
40 IOVERP=-1
IF(LETTER.EQ.12)IOVERP=0
IF(LETTER.EQ. 4)IOVERP=1
IF(IOVERP.GE.0)GO TO 42
41 CALL ENVHLP(ITTY,13)
GO TO 38
42 CONTINUE
C
C ASK USER HOW MANY COPIES OF EACH ENVELOPE
43 WRITE(ITTY,44)
44 FORMAT(' Type how many copies of each envelope? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(43,45,46,46,46,46,46,46),KIND
45 KOPIES=IVALUE
IF(KOPIES.GT.0)GO TO 47
46 CALL ENVHLP(ITTY,14)
GO TO 43
47 CONTINUE
C
C ASK WHICH OPERATING SYSTEM IS BEING USED
ISYSTM=0
IF(IFNFLD.LT.0)GO TO 52
48 WRITE(ITTY,49)
49 FORMAT(' Did a blank line appear after the answer y',
1'ou just typed (Y or N)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(48,51,51,50,51,51,51,50),KIND
50 ISYSTM=-1
IF(LETTER.EQ.14)ISYSTM=0
IF(LETTER.EQ.25)ISYSTM=1
IF(ISYSTM.GE.0)GO TO 52
51 CALL ENVHLP(ITTY,15)
GO TO 48
52 CONTINUE
C
C ASK USER FOR RETURN ADDRESS
C MAXRTL = NUMBER OF RETURN ADDRESS LINES
C MAXRTN = NUMBER OF RETURN ADDRESS CHARACTERS
MAXRTL=0
MAXRTN=0
WRITE(ITTY,53)
53 FORMAT(' Type return address (press RETURN key agai',
1'n when done)')
54 IF(MAXRTL.GE.LMTRTL)GO TO 62
WRITE(ITTY,55)
55 FORMAT(' ?',$)
READ(JTTY,56)LTRBFR
56 FORMAT(72A1)
MAXBFR=LMTBFR
IF(MAXBFR.GT.(LMTRTN-MAXRTN))MAXBFR=LMTRTN-MAXRTN
57 IF(MAXBFR.LE.0)GO TO 62
IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 58
MAXBFR=MAXBFR-1
GO TO 57
58 IF(LTRBFR(MAXBFR).NE.LTRQUE)GO TO 60
I=0
59 I=I+1
IF(LTRBFR(I).EQ.LTRSPA)GO TO 59
IF(I.NE.MAXBFR)GO TO 60
IF(MAXRTL.EQ.0)CALL ENVHLP(ITTY,16)
IF(MAXRTL.GT.0)CALL ENVHLP(ITTY,17)
GO TO 54
60 MAXRTL=MAXRTL+1
LNGRTL(MAXRTL)=MAXBFR
DO 61 I=1,MAXBFR
MAXRTN=MAXRTN+1
LTRRTN(MAXRTN)=LTRBFR(I)
61 CONTINUE
GO TO 54
62 IF(MAXRTL.EQ.0)WRITE(ITTY,63)
63 FORMAT(' No return address')
C
C ASK FOR POSITION OF RETURN ADDRESS ON ENVELOPE
IRETRN=-1
IF(MAXRTL.LE.0)GO TO 68
64 WRITE(ITTY,65)
65 FORMAT(' Return address at corner, middle or both (',
1'C, M or B)? ',$)
CALL ANSWER(JTTY,KIND,LETTER,IVALUE,AVALUE)
GO TO(64,67,67,66,67,67,67,66),KIND
66 IRETRN=-2
IF(LETTER.EQ. 3)IRETRN=-1
IF(LETTER.EQ.13)IRETRN=1
IF(LETTER.EQ. 2)IRETRN=0
IF(IRETRN.GE.-1)GO TO 68
67 CALL ENVHLP(ITTY,18)
GO TO 64
68 CONTINUE
JRETRN=1
KRETRN=2
IF(IRETRN.EQ.-1)KRETRN=1
IF(IRETRN.EQ.1)JRETRN=2
C
C ************************************************
C * *
C * CALCULATE DIMENSIONS OF STANDARD ENVELOPES *
C * *
C ************************************************
C
C MRGCOR
C +-------+
C : :
C +--********************************************
C : *MRGTOP: *
C : * +-----------------------------------*
C : * First line of return address *
C : * Final line of return address *
C LNGENV: * +-----------------------------------*
C : * : *
C : * : +----- First line of main address *
C : *MRGDWN: : Final line of main address *
C : * MRGMID: +-------------------------------*
C : * MRGBOT: *
C : * : : : *
C +--********************************************
C : :
C +--------------+
C MRGCEN
C
C MRGTOP = NUMBER OF BLANK LINES ABOVE RETURN ADDRESS.
C MRGMID = IN THIS SECTION ONLY, IS THE LOWEST ALLOWED
C LOCATION OF THE MAIN ADDRESS, STATED AS THE
C MINIMUM NUMBER OF LINES INCLUDING ALL OF THE
C LINES IN THE ADDRESS AND ALL THOSE BELOW IT
C ON THE ENVELOPE. OUTSIDE THIS SECTION,
C MRGMID IS THE MAXIMUM NUMBER OF LINES ABOVE
C THE MAIN ADDRESS.
C MRGBOT = MINIMUM NUMBER OF BLANK LINES BELOW THE MAIN
C ADDRESS.
C LNGENV = HEIGHT OF ENVELOPE STATED AS NUMBER OF
C LINES. FOR FANFOLD ENVELOPES THIS IS HEIGHT
C OF EXPOSED PORTION OF EACH ENVELOPE.
C MRGCOR = NUMBER OF BLANK COLUMNS TO LEFT OF CORNER
C ADDRESS.
C MRGCEN = NUMBER OF BLANK COLUMNS TO LEFT OF MAIN
C ADDRESS.
C
C THERE ARE 4 BASIC VERTICAL FORMATS
C 1 SEPARATE ENVELOPES WITHOUT RETURN ADDRESS. EACH IS
C LINED UP WITH TOP OF BAIL
C 2 SEPARATE ENVELOPES WITH RETURN ADDRESS. EACH IS
C LINED UP WITH TOP OF PRINTHEAD
C 3 FANFOLD ENVELOPES WITHOUT RETURN ADDRESS TOP OF
C EXPOSED PORTION IS LINED UP WITH TOP OF PRINTHEAD.
C 4 FANFOLD ENVELOPES WITH RETURN ADDRESS TOP OF
C EXPOSED PORTION IS LINED UP WITH TOP OF PRINTHEAD.
C
IF(KNDENV.GT.0)GO TO 72
IF(KNDENV.LT.0)GO TO 77
C
C FORMAT FOR NARROW ENVELOPES
IF(IFNFLD.NE.0)GO TO 70
IF(MAXRTL.GT.0)GO TO 69
MRGTOP=0
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=17
MRGCOR=0
MRGCEN=(28*IPITCH)/12
GO TO 76
69 MRGTOP=0
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=22
MRGCOR=0
MRGCEN=(34*IPITCH)/12
GO TO 76
70 IF(MAXRTL.GT.0)GO TO 71
IF(IFNFLD.LT.0)GO TO 71
MRGTOP=2
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=21
MRGCOR=0
MRGCEN=(34*IPITCH)/12
GO TO 76
71 MRGTOP=2
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=21
MRGCOR=0
MRGCEN=(34*IPITCH)/12
GO TO 76
C
C FORMAT FOR WIDE ENVELOPES
72 IF(IFNFLD.NE.0)GO TO 74
IF(MAXRTL.GT.0)GO TO 73
MRGTOP=0
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=18
MRGCOR=0
MRGCEN=(40*IPITCH)/12
GO TO 76
73 MRGTOP=0
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=23
MRGCOR=0
MRGCEN=(46*IPITCH)/12
GO TO 76
74 IF(MAXRTL.GT.0)GO TO 75
IF(IFNFLD.LT.0)GO TO 75
MRGTOP=2
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=21
MRGCOR=0
MRGCEN=(46*IPITCH)/12
GO TO 76
75 MRGTOP=2
MRGDWN=3
MRGMID=11
MRGBOT=3
LNGENV=21
MRGCOR=0
MRGCEN=(46*IPITCH)/12
GO TO 76
C
C MRGMID = FROM THIS POINT IS LOWEST LOCATION IN WHICH
C TOP LINE OF MIDDLE ADDRESS CAN APPEAR.
C MRGBOT = FROM THIS POINT IS LOWEST LOCATION IN WHICH
C BOTTOM LINE OF MIDDLE ADDRESS CAN APPEAR.
C MRGDWB = FROM THIS POINT IS LOWEST LOCATION IN WHICH
C BOTTOM LINE OF CORNER ADDRESS CAN APPEAR.
76 MRGMID=LNGENV-MRGMID
77 MRGBOT=LNGENV-MRGBOT
MRGDWN=LNGENV-MRGDWN
C
C RETURN TO CALLING PROGRAM
RETURN
END
SUBROUTINE ENVHLP(ITTY,MESAGE)
C RENBR(/HELP MESSAGES FOR ENVELO PROGRAM)/M1000
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THE FORMAT STATEMENTS IN THIS ROUTINE WERE PRODUCED
C BY THE FORMAT PROGRAM WHICH WAS WRITTEN BY THE
C CURRENT AUTHOR AND WHICH IS AVAILABLE FROM THE DECUS
C LIBRARY.
C
C HOW ENVELOPES WILL BE FED INTO TERMINAL
IF(MESAGE.EQ. 1)WRITE(ITTY,1)
1 FORMAT(' Answer'/' S (for Separate) if you will in',
1'sert separate envelopes into the terminal'/' C (f',
2'or Continuous) if you will insert envelopes mounte',
3'd on continuous fanfold'/4X,'paper into the term',
4'inal'/' F (for File) if you want addresses to be ',
5' written to an output file to be'/4X,'printe',
6'd later on continuous envelopes')
C
C NUMBER OF TARGET ENVELOPES AT START OF FILE
IF(MESAGE.EQ. 2)WRITE(ITTY,2)
2 FORMAT(' This program can produce a series of targe',
1't envelopes at the start of each'/' output ',
2'file for use in aligning the envelopes in the prin',
3'ter or terminal. Type'/' the number of target env',
4'elopes desired at the start of each file.')
C
C MAXIMUM NUMBER OF ENVELOPES IN SINGLE FILE
IF(MESAGE.EQ. 3)WRITE(ITTY,3)
3 FORMAT(' This program can limit the length of each ',
1'output file. Type the maximum number'/' of envel',
2'opes which can be written into each file.')
C
C SIZE OF ENVELOPES
IF(MESAGE.EQ. 4)WRITE(ITTY,4)
4 FORMAT(' Answer'/' W (for Wide) if you are using w',
1'ide envelopes 9.5 inches wide by 4 1/8 high'/' N ',
2'(for Narros) if you are using narrow envelopes 7.5',
3' inches wide by 4 high'/' O (for Other) if you wa',
4'nt to specify other dimensions for envelopes')
C
C DIMENSIONS OF NON-STANDARD ENVELOPES
IF(MESAGE.EQ. 5)WRITE(ITTY,5)
5 FORMAT(' Type the maximum number of lines between t',
1'he top of the envelope and the address'/' at the ',
2' upper left corner of the envelope. If the envel',
3'opes are on continuous'/' fanfold paper, then this',
4' is the number of lines between the bottom o',
5'f the'/' previous envelope and the address at the',
6' upper left corner.')
IF(MESAGE.EQ. 6)WRITE(ITTY,6)
6 FORMAT(' Type the minimum number of lines between t',
1'he bottom of the address at the upper'/' left cor',
2'ner of the envelope and the bottom of the envelope',
3'.')
IF(MESAGE.EQ. 7)WRITE(ITTY,7)
7 FORMAT(' Type the maximum number of lines between t',
1'he top of the envelope and the address'/' at the ',
2' middle of the envelope. If the envelopes are',
3' on continuous fanfold'/' paper, then this is the ',
4'number of lines between the bottom of the pr',
5'evious'/' envelope and the address at the middle.')
IF(MESAGE.EQ. 8)WRITE(ITTY,8)
8 FORMAT(' Type the minimum number of lines between t',
1'he bottom of the address at the middle'/' of the e',
2'nvelope and the bottom of the envelope.')
IF(MESAGE.EQ. 9)WRITE(ITTY,9)
9 FORMAT(' Type the total height of envelope stated a',
1's the number of lines from top to'/' bottom. ',
2' If the envelopes are on continuous fanfold p',
3'aper, then this is the'/' distance between the exp',
4'osed bottoms of consecutive envelopes.')
IF(MESAGE.EQ.10)WRITE(ITTY,10)
10 FORMAT(' Type the number of blank columns by which ',
1'the address in the upper left corner'/' of the ',
2' envelope is to be shifted to the right of the le',
3'ftmost column in which'/' the terminal can type an',
4'ything')
IF(MESAGE.EQ.11)WRITE(ITTY,11)
11 FORMAT(' Type the number of blank columns by which ',
1'the address in the middle of the'/' envelope',
2' is to be shifted to the right of the leftmo',
3'st column in which the'/' terminal can type anythi',
4'ng.')
C
C CHARACTERS PER INCH
IF(MESAGE.EQ.12)WRITE(ITTY,12)
12 FORMAT(' Answer'/' P (for Pica) if the addresses w',
1'ill be typed or printed using a pica spacing of'/
24X,'10 characters per inch'/' E (for Elite) if usi',
3'ng an elite spacing of 12 characters per inch')
C
C OVERSTRIKE
IF(MESAGE.EQ.13)WRITE(ITTY,13)
13 FORMAT(' Answer'/' L (for Light) if each line is t',
1'o be typed once for normal density'/' D (for Dark',
2') if each line is to be typed twice to make it dar',
3'ker')
C
C COPIES OF EACH ENVELOPE
IF(MESAGE.EQ.14)WRITE(ITTY,14)
14 FORMAT(' Each address can be typed onto 1 or sever',
1'al envelopes. Type the number of'/' envelope',
2's to be typed with each address')
C
C ASK IF BLANK LINE APPEARED AFTER PREVIOUS ANSWER
IF(MESAGE.EQ.15)WRITE(ITTY,15)
15 FORMAT(' The answer to this question is used to kee',
1'p track of the number of lines which'/' have bee',
2'n displayed on the terminal. Answer'/' Y (for Ye',
3's) if a blank line appeared between the last answe',
4'r which you typed'/4X,'and this question. T',
5'he dialog between you and the program will have b',
6'een'/4X,'mostly double spaced.'/' N (for No) if a',
7' blank line did not appear between the last answ',
8'er which you'/4X,'typed and this question. T',
9'he dialog between you and the program will have')
IF(MESAGE.EQ.15)WRITE(ITTY,16)
16 FORMAT(4X,'been mostly single spaced.')
C
C TEXT OF RETURN ADDRESS
IF(MESAGE.EQ.16)WRITE(ITTY,17)
17 FORMAT(' Type the first line of the return address.',
1' If the envelopes are not to include'/' return ',
2'addresses, then merely press the RETURN key here w',
3'ithout typing anything'/' else before it. The ret',
4'urn address can include 1 or several lines. Pres',
5's the'/' RETURN key an extra time after you',
6' have typed the final line of the return'/' addres',
7's.')
IF(MESAGE.EQ.17)WRITE(ITTY,18)
18 FORMAT(' Type the next line of the return address. ',
1' Press the RETURN key an extra time'/' after yo',
2'u have typed the final line of the return address.')
C
C POSITION OF RETURN ADDRESS
IF(MESAGE.EQ.18)WRITE(ITTY,19)
19 FORMAT(' The return address can be placed at the up',
1'per left corner of each envelope with'/' the chan',
2'ging address at the center, or the relative positi',
3'ons of these addresses'/' can be reversed. Answer'/
4' C (for Corner) to get 1 envelope with return add',
5'ress at upper left corner'/' M (for Middle) to ge',
6't 1 envelope with return address at the center'/' ',
7'B (for Both) to get first envelope with return ad',
8'dress at corner and second'/4X,'envelope with ',
9'return address at center')
C
C IDENTIFY PROGRAM TO USER
IF(MESAGE.EQ.19)WRITE(ITTY,20)
20 FORMAT(' ENVELO (05/83)'/' Reads an address file in',
1' which each line starts with an at sign or in ',
2' which'/' addresses are separated by 1 or mo',
3're lines starting with periods. Types'/' addres',
4'ses directly onto separate or fanfold envelopes or',
5' writes an output file'/' to be printed later.'/)
C
C ASK IF ARE DONE PROCESSING
IF(MESAGE.EQ.20)WRITE(ITTY,21)
21 FORMAT(' Answer'/' Y if you want to process more a',
1'ddresses and type these onto the terminal'/' N if',
2' you do not want to process any more addresses')
IF(MESAGE.EQ.21)WRITE(ITTY,22)
22 FORMAT(' Answer'/' Y if you want to process more a',
1'ddresses and append these to the current output'/
24X,'file'/' N if you do not want to process any mo',
3're addresses')
C
C ALLOW USER TO SELECT WORD OR PHRASE IN NEXT ENVELOP
IF(MESAGE.EQ.22)WRITE(ITTY,23)
23 FORMAT(' Do either of the following'/' 1 Merely pr',
1'ess the RETURN key to produce all addresses.'/' 2 ',
2' Type a word or a phrase to produce all addresses',
3' starting with the first'/4X,'address contain',
4'ing this word or phrase. Addresses which appear',
5' before the'/4X,'first appearance of this word or ',
6' phrase will be discarded. Be sure to'/4X,
7'include all punctuation marks which appear betw',
8'een the words if you type a')
IF(MESAGE.EQ.22)WRITE(ITTY,24)
24 FORMAT(4X,'phrase. The cases of the alphabetic let',
1'ters A through Z are ignored.')
IF(MESAGE.EQ.23)WRITE(ITTY,25)
25 FORMAT(' Do one of the following'/' 1 Merely press',
1' the RETURN key to produce the first address.'/' 2',
2' Press the key for a single printing character an',
3'd then the RETURN key to'/4X,'obtain a target',
4' envelope and then produce the first address.'/' 3',
5' Type a word or a phrase to produce the first add',
6'ress containing this word or'/4X,'phrase. Addre',
7'sses which appear before the first appearance of ',
8'this word or'/4X,'phrase will be discarded. Be su',
9're to include all punctuation marks which')
IF(MESAGE.EQ.23)WRITE(ITTY,26)
26 FORMAT(4X,'appear between the words if you type a',
1' phrase. The cases of the alphabetic'/4X,'letters',
2' A through Z are ignored.')
IF(MESAGE.EQ.27)WRITE(ITTY,27)
27 FORMAT(' Do one of the following'/' 1 Merely press',
1' the RETURN key to produce the next address.'/' 2 ',
2' Press the TAB key and then the RETURN key to pr',
3'oduce the current address'/4X,'again.'/' 3 Pre',
4'ss the key for a single printing character and th',
5'en the RETURN key to'/4X,'obtain a target enve',
6'lope and then produce the current address again.'/
7' 4 Type a word or a phrase to produce the next ad',
8'dress containing this word or')
IF(MESAGE.EQ.27)WRITE(ITTY,28)
28 FORMAT(4X,'phrase. Addresses which appear befor',
1'e the next appearance of this word or'/4X,'phrase ',
2'will be discarded. Be sure to include all punct',
3'uation marks which'/4X,'appear between the wor',
4'ds if you type a phrase. The cases of the alphabe',
5'tic'/4X,'letters A through Z are ignored.')
C
C INSTRUCT USER HOW TO INSERT ENVELOPES
IF(MESAGE.EQ.24)WRITE(ITTY,29)
29 FORMAT(' Line up top of first envelope flush with t',
1'op of paper bail and flush with left'/' end of ',
2' platen, then press the RETURN key. After each en',
3'velope has been typed,'/' insert another and press',
4' RETURN again. Press the TAB key before RETU',
5'RN to'/' instead repeat last envelope. Type ',
6'a person''s name and RETURN to start with'/' that ',
7'person.')
IF(MESAGE.EQ.25)WRITE(ITTY,30)
30 FORMAT(' Line up top of first envelope with top of ',
1'printwheel and 1/2 inch right of left'/' end of ',
2' platen, then press the RETURN key. After each e',
3'nvelope has been typed'/' insert another and press',
4' RETURN gain. Press the TAB key before RETU',
5'RN to'/' instead repeat last envelope. Type ',
6'a person''s name and RETURN to start with'/' that ',
7'person.')
IF(MESAGE.EQ.26)WRITE(ITTY,31)
31 FORMAT(' Insert envelopes on fanfold paper so print',
1'head is on the bottom line of the'/' previous',
2' envelope and left edge of the backing paper is ',
3'flush with left end of'/' the platen. Press the R',
4'ETURN key when the paper is properly aligned, or t',
5'ype a'/' single letter and press RETURN for a ',
6'target envelope, or type a person''s name'/' and p',
7'ress RETURN to start at that person.')
RETURN
END