Subroutine Wrtit(Curent,Nlettr) c *********************************************************************** c * * c * Subroutine Wrtit - Writes out the text in filled lines. * c * * c *********************************************************************** c Character*255 Curent,Char0*1,Chr Character*255 Line,Sprtxt*100 Byte Lineb(400),Byt Equivalence (Lineb,Line),(Chr,Byt) Dimension Word(100),Sum(100),Ipos(100),Iusew(100),Ipropw(100), $ Iboldw(100),Ifontw(100),Itallw(100),Sumbl(100), $ Ihyp(15),Loop(100),Blank(100),Iloc(100) Common/Size/Alenth(16,126),Chrsiz,Ileft,Iright,Idefft Common/Font/Iuse,Ifont,Ibold,Iprop,Italic,Lasfnt Common/Marg/Ileftm,Irigtm,Ihypfl,Layout, $ Maroff,Justfl Common/Pgrphc/Sprtxt Common/Pgrphn/Indent,Nspr,Iautop c c Start a paragraph by indenting "INDENT" spaces if the c first character in Curent is a blank and c autoparagraph is enabled c Byt = 0 Char0 = Chr If (Nlettr .EQ. 0) Return Amax = ((Irigtm-Ileftm) - Ileft+Iright) * $ Chrsiz Nleft = 132 - Chrsiz/Alenth(Idefft,32) * $ (Ileft + Ileftm) Istart = (Ileftm+Ileft) * Chrsiz + Maroff c If (Curent(1:1) .EQ. Char0) Then I = 1 16 Continue I = I + 1 If (Curent(I:I) .EQ. ' ') Go To 16 c Curent(2:Nlettr-I+2) = Curent(I:Nlettr) Nlettr = Nlettr-I+2 Else If (((Curent(1:1) .EQ. ' ' .AND. Indent .GT. 0) .OR. $ (Curent(1:1) .GT. ' ' .AND. Indent .LT. 0)) .AND. $ Iautop .EQ. 1) Then I = 0 18 Continue I = I + 1 If (Curent(I:I) .EQ. ' ') Go To 18 c In = Iabs(Indent) Curent(In+1:Nlettr+In+1-I) = Curent(I:Nlettr) Do 19 J=1,In Curent(J:J) = ' ' 19 Continue Nlettr = Nlettr+In+1-I End If c c Compute the length of the words and spaces c Ihyflg = 0 If (Ihypfl .EQ. 1) Ihyflg = -1 c 20 Continue c Isci = 0 Iword = 0 New = 0 Kflag = 0 N = 0 !Counting the number of printable characters Blank(1)= 0.0 c Do 30 I=1,Nlettr c c Loop over the blanks c If (Curent(I:I) .EQ. ' ') Then New = 1 + New N = N + 1 Go To 30 End If c c Start of a word; c If (New .GE. 1 .OR. Iword .EQ. 0) Then Iword = Iword + 1 Summ = New * Alenth(Iuse,32) New = 0 If (Iword .GT. 1) Then Sumbl(Iword) = Sumbl(Iword-1) + Summ Blank(Iword) = Summ Summ = Summ + Sum(Iword-1) Else Sumbl(1) = Summ End If c If (Justfl .EQ. 1) Sumbl(Iword) = 0.0 Word(Iword) = 0.0 Sum(Iword) = Summ Iloc(Iword) = I c c Save the font flags prior to the word c Iboldw(Iword) = Ibold Ifontw(Iword) = Ifont Ipropw(Iword) = Iprop Itallw(Iword) = Italic Iusew(Iword) = Iuse Loop(Iword) = 0 End If c Kflag = Max0(0,Kflag-1) c c Looking for escape sequences in the line c If (Curent(I:I) .EQ. '^' .OR. Curent(I:I) .EQ. '\') Then Kflag = 2 If (I .GT. 1) Then If (Curent(I-1:I-1) .EQ. '_') Kflag = 0 End If c If (Kflag .NE. 0 .AND. Nlettr .GT. I) Then Call Setfon(Curent(I:I)) End If End If c If (Curent(I:I) .EQ. '`' .OR. Curent(I:I) .EQ. '~' .OR. $ Curent(I:I) .EQ. '&') Then Kflag = 1 If (I .GT. 1) Then If (Curent(I-1:I-1) .EQ. '_') Then Kflag = 0 Else If (Curent(I:I) .EQ. '`') Then Isci = 1 End If End If End If c c Summing up the lengths of the words c Ipos(Iword) = I If (Kflag .EQ. 0) Then If (Isci .EQ. 2) Then Word(Iword) = Word(Iword) + 60 - Alenth(Iuse, $ Ichar(Curent(I:I))) Isci = 0 End If Isci = Isci * 2 Word(Iword) =Word(Iword)+Alenth(Iuse,Ichar(Curent(I:I))) Sum(Iword) = Word(Iword) + Summ N = N + 1 Loop(Iword) = N End If 30 Continue c c See the cutoff point c If (Sum(Iword) .LT. Amax) Then Ibold = Iboldw(1) Ifont = Ifontw(1) Iprop = Ipropw(1) Iuse = Iusew(1) Italic = Itallw(1) Return End If c Do 40 I=2,Iword If (Sum(I) .LT. Amax .AND. Loop(I) .LE. Nleft) Go To 40 If ((Sum(I)-Sumbl(I)*0.05 .LT. Amax .AND. I .NE. $ Iword) .AND. Loop(I) .LE. Nleft) Go To 40 N = Amin1(Amax1((I-1)*0.7,1.0),5.0) Alens = Amax1(Amax * 0.1,Alenth(Idefft,32)*N) c c See if it is worth hyphenating c If (Amax - Sum(I-1) .GT. Alens .AND. Ihyflg $ .GE. 0) Then If (Ihyflg .EQ. 0) Then Ip = Ipos(I-1)+1 Call Hyword(Curent(Ip:Ip), $ Ipos(I)-Ipos(I-1),Ihyp,Nhyp) Ihyflg = 1 Else Curent(Ihyphn:Nlettr-2) = $ Curent(Ihyphn+2:Nlettr) Nlettr = Nlettr - 2 Ihyflg = Ihyflg + 1 End If If (Ihyflg .GE. Nhyp) Then Ihyflg = -1 Else Ihyphn = Ihyp(Ihyflg)+Ip Curent(Ihyphn+2:Nlettr+2) = $ Curent(Ihyphn:Nlettr) Curent(Ihyphn:Ihyphn+1) = '- ' Nlettr = Nlettr + 2 End If Ibold = Iboldw(1) Ifont = Ifontw(1) Iprop = Ipropw(1) Iuse = Iusew(1) Italic = Itallw(1) Go To 20 End If c c Inserting the variable spacing commands c Delta = Amax - Sum(I-1) Delt1 = Amax - Sum(I-1) If (Abs(Delta) .GT. 0.5 .AND. Justfl .EQ. 0) Then Line(1:Ipos(1)) = Curent(1:Ipos(1)) Lpos = Ipos(1) Bsum = 0.0 Do 35 J=2,I-1 Bsum = Bsum + Blank(J) 35 Continue c Do 60 L=2,I-1 If (Bsum .GT. 0.0001) Then Igap = Blank(L) + 0.5 + Delta * Blank(L) / Bsum Else Igap = Blank(L) End If Delta = Delta - (Igap - Blank(L)) Igap = Delt1-Delta + Sum(L-1) + Blank(L) + Istart Bsum = Bsum - Blank(L) M = Isize(Igap) Encode(Lpos+M+4,'(2H^7,I,2H_`)',Lineb(Lpos+1)) Igap Nchrs = Ipos(L) - Iloc(L) + 1 c K = 0 Do 55 J=Lpos+M+5,Lpos+Nchrs+M+4 Chr = Curent(Iloc(L)+K:Iloc(L)+K) Lineb(J) = Byt K = K + 1 55 Continue c c Line(Lpos+M+5:Lpos+Nchrs+M+4) = c $ Curent(Iloc(L):Ipos(L)) Lpos = Lpos+Nchrs+M+4 60 Continue Else Line(1:Ipos(I-1)) = Curent(1:Ipos(I-1)) Lpos = Ipos(I-1) End If c Do 65 K=1,Lpos If (Lineb(K) .EQ. 31) Lineb(K) = 32 65 Continue c Is = 1 Byt = 0 If (Line(1:1) .EQ. Chr) Is = 2 c If (Lpos .LE. 240) Then If (Ifontw(I) .NE. 3) Then Write(16,200) Lasfnt,(Lineb(J),J=Is,Lpos) Else Write(16,250) Lasfnt,(Lineb(J),J=Is,Lpos) End If 200 Format('^',I1,A1,'^3') 250 Format('^',I1,A1) Else Ln = Lpos - 230 If (Ifontw(I) .NE. 3) Then Write(16,100) Lasfnt,(Lineb(J),J=Is,Lpos) Else Write(16,150) Lasfnt,(Lineb(J),J=Is,Lpos) End If 100 Format('^',I1,230A1,A1,'^3') 150 Format('^',I1,230A1,A1) End If Ihyflg = 0 c c Move the unwritten text to the start c of the character string, and reset pointers c Len = Nlettr-Ipos(I-1) Curent(1:Len) = Curent(Ipos(I-1)+1:Nlettr) J = 0 39 Continue J = J + 1 If (Curent(J:J) .EQ. ' ') Go To 39 c Nlettr = Len-J+1 If (Indent .GE. 0) Then Curent(1:Nlettr) = Curent(J:Len) Else Nlettr = Nlettr - Indent Curent(-Indent+1:Nlettr) = Curent(J:Len) Do 37 J=1,-Indent Curent(J:J) = ' ' 37 Continue End If c c Reset the font flags to values after c the last word printed out c Ibold = Iboldw(I) Ifont = Ifontw(I) Iprop = Ipropw(I) Iuse = Iusew(I) Italic = Itallw(I) Lasfnt = Ifont c Go To 20 40 Continue Go To 20 End