Program Runpro c *********************************************************************** c * * c * Program RUNPRO - To modify a user's runoff file to take * c * advantage of a LNO3 proportional fonts. This program * c * modifies the paragraphs so that the right number of words * c * will be on each line. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Character*255 Curent,Char0*1 Character*200 Line,Linlow,Chr*1,Sprtxt*100,Literl*10 Dimension Ipos(15),Itmp(5) Common/Size/Alenth(16,126),Chrsiz,Ileft,Iright,Idefft Common/Font/Iuse,Ifont,Ibold,Iprop,Italic,Lasfnt Character*60 Dissub,Dissbt,Distit, $ Disnum,Titles*80,Subtit*80 Common/Displn/Dissub,Distit,Dissbt,Disnum,Titles,Subtit Common/Displc/Nsub,Ltitle,Lstitl,Lennum,Lentit,Lensub c Common/Marg/Ileftm,Irigtm,Ihypfl,Layout, $ Maroff,Justfl Common/Pgrphc/Sprtxt Common/Pgrphn/Indent,Nspr,Iautop Character*20 Perids Common/Period/Nperid Common/Peridc/Perids Data Char0/0/ c Write(7,120) 120 Format(/' Program RUNPRO - By Steven C. Fisher'/) c c Get the character font size data and initialize c using font number three c Open(Unit=10,Name='Fnt:',Type='OLD',Form='UNFORMATTED') Do 5 J=1,16 Read(10) (Alenth(J,I),I=32,126) Alenth(J,31) = Alenth(J,32) 5 Continue Close(Unit=10) c Iprop = 1 Call Setfon('^3') Lasfnt = Ifont c c Set misc. flags and initial values; c Chrsiz = 60.0 ! sixty decipoints per character cell Idefft = 3 ! set the default font type to #3 Irigtm = 89 Ileftm = 9 Ileft = 0 Iright = 0 Iflag = 0 Filflg = 1 Irtflg = 0 Ihypfl = 0 Ipffil = 1 Justfl = 0 Iflspa = 0 Perids(1:3) = '.?!' Nperid = 3 c c Set up the skip paragraph stuff c Line = '.spr 5,1,2,2' Nchars = 12 Call Sprset(Line,Nchars) c c Set up the default .Display xxxxxx commands c Distit = '.display title "",""' Dissbt = '.display subtitle "",""' Disnum = '.display number "",D,""' Ltitle = 20 Lstitl = 23 Lennum = 23 Titles = '.t; ' Subtit = '.st; ' Lentit = 4 Lensub = 5 c c Open the input and output files, and write in c various default runoff commands to the output. c Open(Unit=12,Name='In:',Type='OLD') Open(Unit=16,Name='Out:',Type='NEW',Carriagecontrol= $ 'LIST') Layout = 2 Call Disp(Distit,Ltitle) Call Disp(Dissbt,Lstitl) Call Disp(Disnum,Lennum) Write(16,200) '.nf','.st; ','.t; ','.lo 2,1','.headers' Write(16,200) '.period ".?!"' c c Start main loop over the user's file to read c 10 Continue c Read(12,100,END=15) Nchars,Line(1:Nchars) 100 Format(Q,A) Go To 20 15 Continue Iflag = 1 Nchars = 0 20 Continue c c For blank lines or runoff commands; write c out all text held for filling. c If (Nchars .EQ. 0 .OR. Line(1:1) .EQ. '.') Then Call Wrtit(Curent,Nlettr) Call Getlen(Curent,Nlettr,Alen) If (Nlettr .GT. 0) Then Call Wrtout(Curent,Nlettr) L = 132 - Irigtm Write(16,125) L 125 Format('.rm'/'.rm+',I2) End If Lasfnt = Ifont 150 Format('^',I1,A,'^3') 175 Format('^',I1,A) 200 Format(A) Nlettr = 0 Iparbr = 0 If (Iflag .EQ. 1) Go To 90 If (Nchars .EQ. 0) Go To 10 End If c c Check for RUNOFF commands that will have to c be responded to. c If (Line(1:1) .EQ. '.') Then c c Get the lowercase version of the input line; c Call Lowerc(Line,Nchars,Linlow) Nchars = Nchars + 1 21 Continue Nchars = Nchars - 1 If (Line(Nchars:Nchars) .EQ. ' ') Go To 21 c Linlow(Nchars+1:Nchars+1) = ' ' c If (Litflg .EQ. 1 .AND. Linlow(2:4) .NE. 'eli') Then Write(16,201) Literl(1:Litlen),Line(1:Nchars) 201 Format(A,A) c c Checking for the left and right margin commands c Else If (Linlow(2:3) .EQ. 'lm') Then If (Nchars .EQ. 3) Then Jleft = Chrsiz/Alenth(Idefft,32) * $ Ileftm L = 1 If (Jleft .GT. 9) L = 2 If (Jleft .GT. 99) L = 3 Write(16,'(3H.lm,I)') Jleft Ileft = 0 Else Line(Nchars+1:Nchars+2) = ', ' Call Readr(Line(4:4),Nchars-3,1,Ileftt) c Kflag = 0 Do 30 I=4,Nchars If (Line(I:I) .EQ. '+' .OR. Line(I:I) .EQ. '-')Kflag=1 30 Continue If (Kflag .EQ. 0) Then Ileft = Ileftt Else Ileft = Ileft + Ileftt End If If (-Ileft .GE. Ileftm) Ileft = -Ileftm + 1 c Jleft = Max0(Int(Chrsiz/Alenth(Idefft,32) * (Ileft+ $ Ileftm)),1) L = 1 If (Jleft .GT. 9) L = 2 If (Jleft .GT. 99) L = 3 c Write(16,'(3H.lm,I)') Jleft End If Else If (Linlow(2:3) .EQ. 'rm') Then If (Nchars .EQ. 3) Then Iright = 0 Else Line(Nchars+1:Nchars+2) = ', ' Call Readr(Line(4:4),Nchars-3,1,Irghtt) Kflag = 1 Do 31 I=4,Nchars If (Line(I:I) .EQ. '+' .OR. Line(I:I) .EQ. '-')Kflag=1 31 Continue If (Kflag .EQ. 1) Then Iright = Iright + Irghtt Else Iright = Irghtt End If End If c c Fill And No Fill; set flags and don't write the c commands back out since we are doing the fill ourselves. c Else If (Linlow(2:3) .EQ. 'f ' .OR. $ Linlow(2:5) .EQ. 'fil') Then Filflg = 1 Else If (Linlow(2:4) .EQ. 'nf ' $ .OR. Linlow(2:8) .EQ. 'no fil') Then Filflg = 0 c c Justify And No justify; set flags and don't write the c commands back out since we are doing the justify ourselves. c Else If (Linlow(2:3) .EQ. 'j ' .OR. $ Linlow(2:5) .EQ. 'just') Then Justfl = 0 Else If (Linlow(2:4) .EQ. 'nj ' $ .OR. Linlow(2:8) .EQ. 'no just') Then Justfl = 1 c c Literl; set the literal flag. Also, we are modifying the c .display subtitle command so that the letter size & font c will be correct if the literal takes up multiple pages c after the title and subtitle are written c Else If (Linlow(2:4) .EQ. 'lt ')Then Litflg = 1 Write(16,350) Dissub(1:Nsub),Ifont, $ Subtit(1:Lensub),Ifont, $ Line(1:3) 350 Format(A,'^',I1,'"'/A/'^',I1,'^9'/A) c L = Alenth(Iuse,32) Litlen = Isize(L) + 2 Write(Literl(1:Litlen),'(I,2H G)') L c Else If (Linlow(2:5) .EQ. 'eli ' .AND. Litflg .EQ. $ 1) Then Litflg = 0 Write(16,400) Line(1:4),Dissub(1:Nsub) 400 Format(A4/'\9^3'/A,'"') Write(16,204) Subtit(1:Lensub) c Else If (Linlow(2:3) .EQ. 'ps') Then c c Set the page size parameters c Line(Nchars+1:Nchars+21) = ',-99,-99,-99,-99,-99' Call Readr(Line(4:4),Nchars-3+21,5,Itmp) Ipage = Itmp(1) Irigtm = Itmp(2) Ileftm = Itmp(3) Itop = Itmp(4) Ispace = Itmp(5) c Read(Line(4:Nchars+21),*) Ipage,Irigtm,Ileftm, c $ Itop,Ispace If (Itop .EQ. -99) Itop = 0 If (Ispace .EQ. -99) Ispace = 1 If (Irigtm .EQ. -99) Irigtm = 89 If (Ileftm .EQ. -99) Ileftm = 9 If (Ipage .EQ. -99) Ipage = 58 Ileft = 0 Iright = 0 Jleft = Chrsiz/Alenth(Idefft,32) * $ Ileftm c L = 1 If (Iabs(Jleft) .GT. 9) L = 2 If (Iabs(Jleft) .GT. 99) L = 3 Lr = 132 - Irigtm Write(16,450) Ipage,Irigtm,Ileftm,Itop, $ Ispace,Jleft,Lr 450 Format('.ps ',4(I3,','),I3/'.lm',I/'.rm+',I2) Else If (Nchars .GT. 3 .AND. (Linlow(2:2) .EQ. 'c' .AND. $ Linlow(3:3) .LT. 'a')) Then c c Centering the text c Call Center(Line,Nchars) Else If (Nchars .LE. 4 .AND. Linlow(2:3) .EQ. 'st') Then c c Subtitle; If the subtitle is of zero length, c write out a blank subtitle instead. c Write(16,200) '.st; ' Subtit(1:5) = '.st; ' Lensub = 5 Else If ((Nchars .EQ. 2 .AND. Linlow(2:2) .EQ. 't') .OR. $ (Nchars .EQ. 3 .AND. Linlow(2:3) .EQ. 'st')) Then Write(16,200) '.t; ' Titles = '.t; ' Lentit = 4 Else If (Linlow(2:6) .EQ. 'nopro' $ .OR. Linlow(2:4) .EQ. 'uni') Then c c Command to set proportional and nonproportional c text spacing - a fisher added command c Write(16,200) '^}' Call Setfon('^}') Else If (Linlow(1:4) .EQ. '.pro') Then Write(16,200) '\}' Call Setfon('\}') Else If (Linlow(1:4) .EQ. '.col') Then c c Command .col - To set the text at certain columns. c This is useful for creating tables with pro- c portional text spacing. A Fisher added command. c c Form: .col "char" N1,N2,N3,...N15 c c Where char is a single character to indicate c the column position, and N1,...N15 are the column c numbers to start the columns at. c c Fill is disabled while this is in use. To turn it off, c use .nocol c If (Nchars .GT. 4) Call Strtcl(Line,Nchars,Ipos,Npos,Chr) Colflg = 1 Else If (Linlow(2:5) .EQ. 'noco') Then Colflg = 0 Else If (Linlow(2:5) .EQ. 'disp') Then c c Modify the ".display numbers" and c ".display subtitle" commands c Call Disp(Line,Nchars) Else If ((Linlow(2:3) .EQ. 't;' .OR. Linlow(2:3) .EQ. $ 't ') .AND. Nchars .GT. 3) Then Call Title(Line,Nchars) Else If ((Linlow(2:4) .EQ. 'st;' .OR. Linlow(2:4) .EQ. $ 'st ') .AND. Nchars .GT. 4) Then Call Title(Line,Nchars) Else If ((Linlow(2:4) .EQ. 'ft;' .OR. Linlow(2:4) .EQ. $ 'ft ') .AND. Nchars .GT. 4) Then Call Title(Line,Nchars) Else If (Linlow(2:4) .EQ. 'ehy' .OR. Line(2:11) .EQ. $ 'enable hyp') Then c c Set the hyphenation flags c Ihypfl = 0 Else If (Linlow(2:4) .EQ. 'dhy' .OR. Line(2:12) .EQ. $ 'disable hyp') Then Ihypfl = 1 Else If (Linlow(2:3) .EQ. 'r ') Then Irtflg = 1 Else If (Linlow(2:3) .EQ. 'er') Then Irtflg = 0 Else If (Linlow(2:4) .EQ. 'pfn' .OR. Linlow(2:3) $ .EQ. 'fn') Then c c Setups for permament footnotes and footnotes c Irigth = Iright Ilefth = Ileft Filflh = Filflg Litflh = Litflg Colflh = Colflg Irtflh = Irtflg Ihypfh = Ihypfl c Write(16,207) Line(1:Nchars) If (Linlow(2:4) .EQ. 'pfn') Then Ipfflg = 1 Else If (Ipfflg .NE. 0) Then Filflg = Filflp Litflg = Litflp Colflg = Colflp Irtflg = Irtflp Ihypfl = Ihypfp Iright = Irigtp Ileft = Ileftp End If Else If (Linlow(2:4) .EQ. 'efn') Then If (Ipfflg .EQ. 1) Then Filflp = Filflg Litflp = Litflg Colflp = Colflg Irtflp = Irtflg Ihypfp = Ihypfl Ipfflg = -1 Irigtp = Iright Ileftp = Ileft End If c Filflg = Filflh Litflg = Litflh Colflg = Colflh Irtflg = Irtflh Ihypfl = Ihypfh c Write(16,207) Line(1:Nchars) Iright = Irigth Ileft = Ilefth Else If (Linlow(2:14) .EQ. 'headers no pa') Then c Else If (Linlow(2:4) .EQ. 'lo ' .OR. Linlow(2:6) $ .EQ. 'layout') Then I = 2 77 Continue I = I + 1 If (Linlow(I:I) .NE. ' ') Go To 77 c Call Readr(Linlow(I:I),Nchars-I+1,1,Layout) c Read(Linlow(I:Nchars),*) Layout Call Disp('.display subtitle "",""',23) Call Disp('.display number "",D,""',23) Write(16,207) Line(1:Nchars) Write(16,203) Titles(1:Lentit) 203 Format(A) Write(16,204) Subtit(1:Lensub) 204 Format(A) Else If (Linlow(2:5) .EQ. 'spr' .OR. (Linlow(2:7) $ .EQ. 'set pa' .AND. Nchars .GT. 7)) Then Call Sprset(Line,Nchars) Else If (Linlow(2:4) .EQ. 'ap ' .OR. Line(2:6) .EQ. $ 'autop') Then Iautop = 1 Else If (Linlow(2:5) .EQ. 'nap ' .OR. Line(2:8) .EQ. $ 'no autop') Then Iautop = 0 Else If (Linlow(2:6) .EQ. 'margi') Then Call Margin(Line,Nchars) Else If (Linlow(2:13) .EQ. 'no flags spa') Then Iflspa = 1 Write(16,200) Line(1:Nchars) Else If (Linlow(2:10) .EQ. 'flags spa') Then Iflspa = 0 Write(16,200) Line(1:Nchars) Else If (Linlow(2:3) .EQ. 'pr' .OR. Linlow(2:5) .EQ. $ 'peri') Then Call Setper(Linlow,Nchars) Write(16,200) Line(1:Nchars) Else If (Linlow(2:4) .EQ. 'npr' .OR. Linlow(2:8) .EQ. $ 'no peri') Then Nperid = 0 Write(16,200) Line(1:Nchars) Else Write(16,200) Line(1:Nchars) 207 Format(A) End If Iparbr = 0 Go To 10 End If c c See what we can do with this text c If (Filflg .EQ. 1 .AND. Litflg .EQ. 0 .AND. Colflg $ .EQ. 0 .AND. Irtflg .EQ. 0) Then If (Nlettr .EQ. 0) Write(16,200) '.rm400' If (Line(1:1) .EQ. ' ' .AND. Iautop .EQ. 1) Then c c If new paragraph, finish last paragraph; c If (Indent .LT. 0) Line(1:1) = Char0 Call Wrtit(Curent,Nlettr) Call Getlen(Curent,Nlettr,Alen) If (Nlettr .GT. 0) Call Wrtout(Curent,Nlettr) Lasfnt = Ifont Nlettr = 0 If (Iautop .EQ. 1) Write(16,200) Sprtxt(1:Nspr) End If c c Curent paragraph - add the new line of text to c the remaining (unprinted) text. c If (Nlettr .EQ. 0) Nlettr = -1 Call Space(Line,Nchars,Iflspa) If (Nchars .GT. 0 .AND. Nlettr .GT. 0) Then Call Chkper(Curent,Nlettr,Iflags) If (Iflags .EQ. 1) Then Curent(Nlettr+1:Nlettr+1) = ' ' Nlettr = Nlettr + 1 End If End If Curent(Nlettr+2:Nlettr+Nchars+1) = Line(1:Nchars) If (Nlettr .GT. 0) Curent(Nlettr+1:Nlettr+1) = ' ' Nlettr = Nlettr + Nchars + 1 Call Wrtit(Curent,Nlettr) If (Nlettr .EQ. 0) Then L = 132 - Irigtm Write(16,125) L End If Iparbr = 1 c Else If ((Colflg .EQ. 0 .AND. Irtflg .EQ. 0) .OR. $ Litflg .EQ. 1) Then c c No fill; so just write out text c If (Nchars .GT. 0 .AND. Litflg .EQ. 0) Then Call Getlen(Line,Nchars,Alen) If (Ifont .NE. 3) Then Write(16,150) Lasfnt,Line(1:Nchars) Else Write(16,175) Lasfnt,Line(1:Nchars) End If Lasfnt = Ifont Else If (Nchars .GT. 0) Then Write(16,201) Literl(1:Litlen),Line(1:Nchars) End If Else If (Irtflg .EQ. 0) Then c c Writing out when .col is enabled. Set the c Call Column(Line,Nchars,Ipos,Npos,Chr) Call Getlen(Line,Nchars,Alen) If (Ifont .NE. 3) Then Write(16,150) Lasfnt,Line(1:Nchars) Else Write(16,175) Lasfnt,Line(1:Nchars) End If Lasfnt = Ifont Else c c Right justification of the text c Aright = (Irigtm + Iright) * Chrsiz Call Getlen(Line,Nchars,Alen) Iposn = Aright - Alen + Maroff If (Ifont .NE. 3) Then Write(16,500) Iposn,Lasfnt,Line(1:Nchars) 500 Format('^7',I,'_`^',I1,A,'^3') Else Write(16,550) Iposn,Lasfnt,Line(1:Nchars) 550 Format('^7',I,'_`^',I1,A) End If Lasfnt = Ifont End If Go To 10 c 90 Continue Close(Unit=12) Close(Unit=16) Call Exit End