justfy Subroutine

public subroutine justfy(s, height, text, ntext)

NAME

justfy(3f) - [M_pixel:TEXT] return lengths used to justify a string
             when calling hershey
(LICENSE:PD)

SYNOPSIS

definition:

subroutine justfy(s, height, text, ntext)
real,intent(out)               :: s(4)
real,intent(in)                :: height
character(len=*),intent(in)    :: text
integer,intent(in)             :: ntext

DESCRIPTION

Given the text string TEXT with NTEXT characters, height HEIGHT,
this routine gives 4 distances in inches, all from the left end of
the string -

o S(1)  to the left edge of the 1st nonblank character
o S(2)  to the center of the string, blanks removed from the ends
o S(3)  to the right edge of the last nonblank character
o S(4)  to the right edge of the last character of the string.

EXAMPLE

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
real, intent(out) :: s(4)
real, intent(in) :: height
character(len=*), intent(in) :: text
integer, intent(in) :: ntext

Contents

Source Code

justfy

Source Code

subroutine justfy(s, height, text, ntext)

! ident_9="@(#) M_pixel justfy(3f) calculate values for justifying Hershey fonts called by hershey(3f)"

!  Given the text string TEXT with NTEXT characters, height HEIGHT, this routine
!  gives 4 distances in inches, all from the left end of the string -
!  S(1)  to the left edge of the 1st nonblank character
!  s(2)  to the center of the string, blanks removed from the ends
!  s(3)  to the right edge of the last nonblank character
!  s(4)  to the right edge of the last character of the string.

      real,intent(out)               :: s(4)
      real,intent(in)                :: height
      character(len=*),intent(in)    :: text
      character(len=4096)            :: text_local
      integer,intent(in)             :: ntext

      real,parameter                 :: factor=0.75
      integer,parameter              :: ipower(3)=[1,1,-1]
      real                           :: scale
      real                           :: oldwid
      integer                        :: jquart
      integer                        :: lead
      integer                        :: i
      integer                        :: l
      integer                        :: ntxt
!
      text_local=text
      ntxt=ntext
      scale=height/21.0
      jquart=(ntext+3)/4
!  translate integer string into character variable, then get pointers
!  into the array P_ichr.
!
      call chrcod(text_local,ntxt)
!
!  count leading blanks.
      do lead=1,P_nchr
         if(P_ichr(lead).ne.1000)goto 1110
      enddo
      lead=ntxt
 1110 continue
      s(1)=20.0*scale*(lead-1)
      s(3)=s(1)
!
!  sum the widths of the remaining text, recalling that trailing blanks
!  were lopped off by chrcod.
      oldwid=0.0
      if(lead.ne.0)then
         do i=lead,P_nchr
            l=P_ichr(i)
            if (l.lt.1000) then
              oldwid=width(l)*scale
              s(3)=s(3) + oldwid
            endif
            if(l.eq.1000)s(3)=s(3)+20.0*scale
            if(l.ge.1001.and.l.le.1003)scale=scale*factor**ipower(l-1000)
            if(l.eq.1004)s(3)=s(3)-oldwid
         enddo
      endif
!
!  add on width of surplus trailing blanks.
      s(4)=s(3)+20.0*scale*(ntxt-P_nchr)
!
!  find center of nonblank text.
      s(2)=(s(1)+s(3))/2.0
      P_just2=1
end subroutine justfy