c     .. display all of the Hershey font data
c
c     .. By James Hurt when with
c     ..    Deere and Company
c     ..    John Deere Road
c     ..    Moline, IL 61265
c
c     .. Author now with Cognition, Inc.
c     ..                 900 Technology Park Drive
c     ..                 Billerica, MA 01821
c
c     .. graphics subroutines
c     .. identy - initialize graphics
c     .. vwport - set where to display image on screen
c     ..        - full screen is 0.0 to 100.0 in vertical (y) direction
c     ..        -                0.0 to ???.? in horizontal (x) direction
c     ..        - origin is lower left corner of screen
c     .. window - set window limits in world coordinates
c     .. newpag - if action left to be take on existing screen, take it
c     ..        - then take actions to start with a blank screen
c     .. jnumbr - display an integer (code included)
c     .. move   - set current cursor position to (x,y)
c     .. draw   - draw from current cursor position to (x,y)
c     ..        - then set current cursor position to (x,y)
c     ..        - The point (x,y) is always in world coordinates
c     .. skip   - Make the next draw really be a move
c     .. waitcr - finish all graphics actions then let the user look at
c     ..        - the image.  User signals (usually by pressing RETURN)
c     ..        - when it is safe to continue.
c     .. grstop - finish all graphics routines (no more graphics to follow)
c
     external identy,vwport,window,newpag,jnumbr,move ,draw ,skip,
    x         waitcr,grstop
c     .. local variables
     real deltac, deltar, colmax
     parameter (deltac = 6.25, deltar = 6.25, colmax = 100.0)
c     .. font data file name
     character*80 name
c     .. font data
     character*1 line(2,256)
c     .. co-ordinates
     real x,y,col,row
c     .. which data point and which character
     integer ipnt,ich,nch,i
     intrinsic ichar
cexecutable code begins
c     .. file unit number
     kfile=1
c     .. get hershey file name
     write(*,'(a)') ' packed hershey font file name'
     read(*,'(a)') name
     open(unit=kfile,file=name,status='old')
c     .. initialize graphics
     call identy
c     .. want square picture for each character
c     .. Note: most but not all Hershey font characters fit inside this window
     call window(-15.0, 15.0,-15.0, 15.0)
c     .. loop per screen
5     continue
c     .. start with a clean sheet
     call newpag
c     .. where to display this character
     col = 0.0
     row = 100.0
c     .. loop per character
10    continue
c     .. read character number and data
     read(unit=kfile,'(i5,i3,64a1/(72a1))',end=90) ich,nch,
    x     (line(1,i),line(2,i),i=1,nch)
c     .. select view port (place character on screen)
     call vwport(col,col+deltac,row-deltar,row)
c     .. identify character
     call jnumbr(ich,4,-15.0,9.0,5.0)
c     .. draw character limits
c     .. Note: this data can be used for proportional spacing
     x=ichar(line(1,1))-ichar('R')
     y=ichar(line(2,1))-ichar('R')
     call move(x,-10.0)
     call draw(x,10.0)
     call move(y,-10.0)
     call draw(y,10.0)
c     .. first data point is a move
     call skip
c     .. loop per line of data
     do 20 ipnt = 2, nch
c     .. process vector number ipnt
     if(line(1,ipnt).eq.' ') then
c        .. next data point is a move
        call skip
     else
c        .. draw (or move) to this data point
        x=ichar(line(1,ipnt))-ichar('R')
        y=ichar(line(2,ipnt))-ichar('R')
c        .. Note that Hershey Font data is in TV coordinate system
        call draw(x,-y)
     endif
20    continue
c     .. end of this character
     col = col + deltac
     if( col .lt. colmax ) go to 10
     col = 0.0
     row = row - deltar
     if( row .ge. deltar ) go to 10
     call waitcr
     go to 5
90    continue
     call waitcr
c     .. all done
     call grstop
     end
     subroutine jnumbr( number, iwidth, x0, y0, height )
     integer number, iwidth
     real x0, y0, height
c     .. draw one of the decimal digits
c     .. number = the integer to be displayed
c     .. iwidth = the number of characters
c     .. (x0, y0) = the lower left corner
c     .. height = height of the characters
c
c
c     .. By James Hurt when with
c     ..    Deere and Company
c     ..    John Deere Road
c     ..    Moline, IL 61265
c
c     .. Author now with Cognition, Inc.
c     ..                 900 Technology Park Drive
c     ..                 Billerica, MA 01821
c
c     .. graphics (graphics) routines called
     external skip,draw
c     .. local variables used
     integer ipnt, ipos, ival, idigit
     real x, y, scale
     real xleft, ylower
c     .. character data for the ten decimal digit characters
c     .. data extracted from one of the Hershey fonts
     integer start(0:10), power(0:9)
     character*1 line(2,104)
     data power/ 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000,
    x 100000000, 1000000000 /
     data start/0,11,14,22,36,42,55,68,73,91,104/
c 0:poly(4 9,2 8,1 6,1 3,2 1,4 0,6 1,7 3,7 6,6 8,4 9)
c 1:poly(2 7,4 9,4 0)
c 2:poly(1 8,3 9,5 9,7 8,7 6,6 4,1 0,7 0)
c 3:poly(1 8,3 9,5 9,7 8,7 6,5 5)
c   poly(4 5,5 5,7 4,7 1,5 0,3 0,1 1)
c 4:poly(5 9,5 0)
c   poly(5 9,0 3,8 3)
c 5:poly(2 9,1 5,3 6,4 6,6 5,7 3,6 1,4 0,3 0,1 1)
c   poly(2 9,6 9)
c 6:poly(6 9,4 9,2 8,1 6,1 3,2 1,4 0,6 1,7 3,6 5,4 6,2 5,1 3)
c 7:poly(7 9,3 0)
c   poly(1 9,7 9)
c 8:poly(3 9,1 8,1 6,3 5,5 5,7 6,7 8,5 9,3 9)
c   poly(3 5,1 4,1 1,3 0,5 0,7 1,7 4,5 5)
c 9:poly(7 6,6 4,4 3,2 4,1 6,2 8,4 9,6 8,7 6,7 3,6 1,4 0,2 0)
c
     data line/'R','M','P','N','O','P','O','S','P','U','R','V','T','U',
    A'U','S','U','P','T','N','R','M','P','O','R','M','R
    B','V','O','N','Q','M','S','M','U','N','U','P','T','R','O',
    C'V','U','V','O','N','Q','M','S','M','U','N','U','P','S','Q
    D',' ','R','R','Q','S','Q','U','R','U','U','S','V','Q','V','O','U',
    E'S','M','S','V',' ','R','S','M','N','S','V','S','P
    F','M','O','Q','Q','P','R','P','T','Q','U','S','T','U','R','V','Q',
    G'V','O','U',' ','R','P','M','T','M','T','M','R','M','P','N
    H','O','P','O','S','P','U','R','V','T','U','U','S','T','Q','R','P',
    I'P','Q','O','S','U','M','Q','V',' ','R','O','M','U','M',
    J'Q','M','O','N','O','P','Q','Q','S','Q','U','P','U','N','S',
    K'M','Q','M',' ','R','Q','Q','O','R','O','U','Q','V','S','V','U','U
    L','U','R','S','Q','U','P','T','R','R','S','P','R','O','P',
    M'P','N','R','M','T','N','U','P','U','S','T','U','R','V','P','V'/
c     .. compute scale factor and lower left of first digit
     scale = height/10.0
     xleft = x0
     ylower = y0
     ival = number
c     .. loop for each position
     do 30 ipos = iwidth,1,-1
        idigit = mod( ival/power(ipos-1), 10 )
c        .. first data point is a move
        call skip
c        .. loop over data for this digit
        do 20 ipnt=start(idigit)+1,start(idigit+1)
           if(line(1,ipnt).eq.' ') then
c              .. next data point is a move
              call skip
           else
c              .. draw (or move) to this data point
              x=ichar(line(1,ipnt))-ichar('N')
              y=ichar(line(2,ipnt))-ichar('V')
              call draw(xleft+scale*x,ylower-scale*y)
           endif
20       continue
c        .. move for next digit
        xleft = xleft + height
30    continue
     end

You are viewing proxied material from sdf.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.