PROGRAM MPRNO
C
C	This routine takes a text file and creates a MULPLT
C	compatable special features file for proportional
C	spaced, right and left justified text.
C
C					h gregg 1/15/81
C
	BYTE BSTRNG(80),BFILE(40),BFILE1(40),BEXT(4),CHAR,QEND
	BYTE BUFFER(350),QSPACE,DUMMY
	INTEGER*2 ITABLE(96),IXTRM(4)
	REAL*4 EXT
	REAL*8 FILE(5)
C
	EQUIVALENCE (EXT,BEXT(1))
	EQUIVALENCE (FILE(1),BFILE(1))
C
	COMMON/ERRLOG/LUNEL
	COMMON /SYMLIB/NUMEXT,NWEXTL,NBYTE,LIBNUM,LIBR(5000)
C
	DATA EXT/'.SYM'/
	DATA FILE/'SB0:[  1','0,10]ROM','SIM.SYM ',2*'        '/
	DATA BFILE1/40*"40/
	DATA LUNEL/5/
C
C	SETUP LIBRARY ...
C
	CALL SYMGET(2,0 )
	NUMEXT = 0
	NWEXTL = 5000
	LIBNUM = 0
C
C	GET LIBRARY SPEC
C
	WRITE (5,5)
5	FORMAT ('$Library (default=ROMSIM): ')
	READ (5,10) LEN,BSTRNG
10	FORMAT (Q,80A1)
	IF (LEN .EQ. 0) GOTO 60
30	DO 40 I=1,LEN
40	BFILE(I+13) = BSTRNG(I)
	DO 45 I=1,4
45	BFILE(I+LEN+13) = BEXT(I)
	DO 50 I=LEN+18,40
50	BFILE(I) = "40
60	LEN=1
	DO 70 I=1,40
	IF(BFILE(I).EQ."40)GO TO 70
	BFILE1(LEN) = BFILE(I)
	LEN=LEN+1
70	CONTINUE
C
C	BEGIN LIBRARY LOADING
C
 128	CALL UNFORM (0,IERR,ITABLE,BFILE1,0,3,1)
	IF (IERR.EQ.0) GO TO 129
	WRITE (5,126) BFILE1
126	FORMAT ('0Bad library: ',40A1)
	STOP
129	N1 = 1
	NLEFT = NWEXTL
C
C	LOAD NEXT RECORD
C
 124	NWORD = NLEFT
	ITEMPB = LIBR(N1)
	NBYTE = 2*NWORD
	CALL UNFORM (1,IERR,ITABLE,LIBR(N1),NBYTE)
	IF (IERR.LE.-1) GO TO 125
	NWORD = NBYTE/2
	LIBR(N1) = ITEMPB
	N1 = N1 + NWORD - 1
	NTBYTE = 2*N1
	NLEFT = NLEFT - NWORD + 1
	IF (NLEFT.GT.1) GO TO 124
 125	CALL UNFORM (2,IERR,ITABLE)
	IF (IERR.LE.0) GO TO 100
	WRITE (5,127) IERR
127	FORMAT ('0Error in UNFORM close:',I7)
C
C	GET TEXT FILE
C
100	WRITE (5,101)
101	FORMAT ('$Text file: ')
	READ (5,10) LEN,BFILE1
	BFILE1(LEN+1) = 0
	OPEN(UNIT=2,NAME=BFILE1,TYPE='OLD')
C
C	GET PARAMETERS
C
150	WRITE (5,160)
160	FORMAT ('$Character width, height, vertical distance, nibs: ')
	READ (5,165) WIDTH,HEIGHT,VDIST,NIBS
165	FORMAT (3E15.0,I7)
C	WRITE (5,170)
C170	FORMAT ('$Vertical distance, min. horizontal space: ')
C	READ (5,165) VDIST,HSPACE
	HSPACE = 0.0
	WRITE (5,180)
180	FORMAT ('$Left margin, maximum line width: ')
	READ (5,165)HOFF,ZWIDTH
C
C	SET UP TEMPORARY FILE FOR NOW
C
	OPEN (UNIT=3,NAME='MPOUT.TMP',CARRIAGECONTROL='LIST',
	1TYPE='SCRATCH')
C
C	SET INITIAL VALUES
C
	QEND = .FALSE.
	QSPACE = .FALSE.
C	INITIAL POINT
	VOFF = 0.
C	LAST SPACE
	LASTSP = 0
	HLAST = 0.
C	CURRENT PARAMETERS
	LENBUF = 0
	IPOINT = 0
	HPOS = -HSPACE
C
C	APPEND LINE TO BUFFER
C
1000	READ (2,10,END=1149,ERR=1149) LEN,BSTRNG
	IF (LENBUF + LEN .LE. 350) GOTO 1005
	WRITE (5,1004)
1004	FORMAT ('0Internal buffer overflow')
	GOTO 10000
1005	IF(LENBUF.EQ.0)GO TO 1007
	LENBUF = LENBUF + 1
	BUFFER(LENBUF) = "40
1007	DO 1010 I=1,LEN
	IF (BSTRNG(I) .LT. "40) GOTO 1010
	LENBUF = LENBUF + 1
	BUFFER(LENBUF) = BSTRNG(I)
1010	CONTINUE
C
C	GET A CHARACTER, CHECK FOR SPACE, GET WIDTH
C
1100	IPT1 = IPOINT + 1
	IF (IPT1 .GT. LENBUF) GOTO 1000
	IF (IPT1 .LE. 250) GOTO 1110
	WRITE (5,1105)
1105	FORMAT ('0Overflow of MULPLT buffer')
	GOTO 10000
1110	CHAR = BUFFER(IPT1)
	IF (CHAR .EQ. "40 .AND. QSPACE) GOTO 1120
	QSPACE = .FALSE.
	IF (CHAR .NE. "40) GOTO 1120
	QSPACE = .TRUE.
	LASTSP = IPOINT
	HLAST = HPOS
1120	IF (QSPACE) CHAR = "127
	CALL SYMGET(0,IERR,CHAR,IRASTX,IRASTY,IXTRM,IPT1)
	IF (QSPACE) CHAR = "40
	IF (IERR .NE. 0) WRITE (5,1125) CHAR
1125	FORMAT ('0Illegal character: "',A1,'"')
	HSIZE = (IXTRM(2) - IXTRM(1))*1.0/IRASTX * WIDTH
	VSIZE = (IXTRM(4) - IXTRM(3))*1.0/IRASTY * HEIGHT
C
C	ADD WIDTH, CHECK LINE LENGTH
C
	HTEMP = HPOS + HSPACE + HSIZE
	IF (HTEMP .GT. ZWIDTH) GOTO 1200
	HPOS = HTEMP
	IPOINT = IPT1
	GOTO 1100
C
C	FINISH LAST LINE OF FILE
C
1149	QEND = .TRUE.
1150	LASTSP = IPOINT
	HTEMP = HSPACE
	GOTO 1208
C
C	MODIFY HSPACE FOR RIGHT JUSTIFICATION, PRINT CONTROL CARDS
C
1200	IF (LASTSP .NE. 0) GOTO 1205
	WRITE (5,1202)
1202	FORMAT ('0Cannot justify line')
	GOTO 1150
1205	HLEFT = ZWIDTH - HLAST
	HPLUS = HLEFT / (LASTSP - 1)
	HTEMP = HSPACE + HPLUS
1208	WRITE (3,1210) WIDTH,HEIGHT,VDIST,HTEMP
1210	FORMAT ('..SYSP',4(F12.5,:,','))
	WRITE (3,1220) HOFF,VOFF
1220	FORMAT ('..SYCO',F12.5,'/PH,',F12.5)
C
C	SEND THE LINE OUT
C
	DO 1260 I=0,4
	IST = I * 50 + 1
	IEND = (I+1) * 50
	IEND2 = LASTSP - I*50
	IEN = IEND
	IF (IEND2 .LT. 50) IEN =LASTSP
	IF (I .EQ. 0) WRITE (3,1240) (BUFFER(J),J=IST,IEN)
	IF (I .NE. 0) WRITE (3,1250) (BUFFER(J),J=IST,IEN)
1240	FORMAT ('..SYNS',50A1)
1250	FORMAT ('..SYSS',50A1)
	IF (IEND2 .LE. 50) GOTO 1270
1260	CONTINUE
C
C	CLEAN UP FOR ANOTHER LINE
C
1270	WRITE (3,1280)
1280	FORMAT ('..SYDR')
	DO 1290 I=1,LENBUF-LASTSP
1290	BUFFER(I) = BUFFER(I+LASTSP)
	LENBUF = LENBUF - LASTSP
	DO 1300 I=1,LENBUF
	IF (BUFFER(I) .NE. "40) GOTO 1310
1300	CONTINUE
	GOTO 1330
1310	DO 1320 J=1,LENBUF-I+1
1320	BUFFER(J)=BUFFER(J+I-1)
	LENBUF=LENBUF-I+1
1330	LASTSP = 0
	HLAST = 0.
	HPOS = -HSPACE
	IPOINT = 0
	VOFF = VOFF - VDIST
	IF (QEND) GOTO 9000
	GOTO 1100
C
C	NOW REWIND FILE AND RECALCULATE THE VERTICAL OFFSETS INTO REAL INCHES
C
9000	REWIND 3
	CLOSE(UNIT=2)
C
C	GET OUTPUT SPECS
C
	WRITE (5,200)
200	FORMAT ('$File to create: ')
	READ (5,10) LEN,BFILE1
	BFILE1(LEN+1) = 0
	OPEN(UNIT=2,NAME=BFILE1,TYPE='NEW',CARRIAGECONTROL='LIST')
	BFILE1(LEN+1) = "40
	WRITE (2,210)BFILE1,BFILE,NIBS
210	FORMAT (';'/'; ',40A1/';'/'..SY1S@@',1H',40A1,1H',
	1/'..SYSM0,0,0,',I5)
9100	HOFF=HOFF+ZWIDTH
	VOFF = -VOFF
	WRITE(5,9103)VOFF,HOFF
9103	FORMAT('0The MULPLT special features text file being created'/
	1' will require at least ',F12.5,' inches vertically'/
	1' and ',F12.5,' inches horizontally to plot correctly')
9200	READ(3,10,END=9300)LEN,BSTRNG
	IF(.NOT.(BSTRNG(5).EQ.'C'.AND.BSTRNG(6).EQ.'O'))GO TO 9250
C
C	DECODE THE VERTICAL POSITION PARAMETER ON EVERY ..SYCO LINE
C	AND RECOMPUTE A NEW VERTICAL OFFSET TERM
C
	DECODE(12,9210,BSTRNG(23))TEMP
9210	FORMAT(F12.5)
	TEMP=TEMP+VOFF
	ENCODE(12,9210,BSTRNG(23))TEMP
9250	WRITE(2,9251)(BSTRNG(I),I=1,LEN)
9251	FORMAT(80A1)
	GO TO 9200
9300	CONTINUE
C
C	LEAVE, IF TOLD TO DO SO.
C
10000	CLOSE (UNIT=2)
	CLOSE (UNIT=3)
	CALL EXIT
	END