home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume4 / hershey / part1 / hershey.f77 < prev    next >
Encoding:
Text File  |  1986-11-30  |  7.2 KB  |  200 lines
  1. c     .. display all of the Hershey font data
  2. c
  3. c     .. By James Hurt when with
  4. c     ..    Deere and Company
  5. c     ..    John Deere Road
  6. c     ..    Moline, IL 61265
  7. c
  8. c     .. Author now with Cognition, Inc.
  9. c     ..                 900 Technology Park Drive
  10. c     ..                 Billerica, MA 01821
  11. c
  12. c     .. graphics subroutines
  13. c     .. identy - initialize graphics
  14. c     .. vwport - set where to display image on screen
  15. c     ..        - full screen is 0.0 to 100.0 in vertical (y) direction
  16. c     ..        -                0.0 to ???.? in horizontal (x) direction
  17. c     ..        - origin is lower left corner of screen
  18. c     .. window - set window limits in world coordinates
  19. c     .. newpag - if action left to be take on existing screen, take it
  20. c     ..        - then take actions to start with a blank screen
  21. c     .. jnumbr - display an integer (code included)
  22. c     .. move   - set current cursor position to (x,y)
  23. c     .. draw   - draw from current cursor position to (x,y)
  24. c     ..        - then set current cursor position to (x,y)
  25. c     ..        - The point (x,y) is always in world coordinates
  26. c     .. skip   - Make the next draw really be a move
  27. c     .. waitcr - finish all graphics actions then let the user look at
  28. c     ..        - the image.  User signals (usually by pressing RETURN)
  29. c     ..        - when it is safe to continue.
  30. c     .. grstop - finish all graphics routines (no more graphics to follow)
  31. c
  32.       external identy,vwport,window,newpag,jnumbr,move ,draw ,skip,
  33.      x         waitcr,grstop
  34. c     .. local variables
  35.       real deltac, deltar, colmax
  36.       parameter (deltac = 6.25, deltar = 6.25, colmax = 100.0)
  37. c     .. font data file name
  38.       character*80 name
  39. c     .. font data
  40.       character*1 line(2,256)
  41. c     .. co-ordinates
  42.       real x,y,col,row
  43. c     .. which data point and which character
  44.       integer ipnt,ich,nch,i
  45.       intrinsic ichar
  46. cexecutable code begins
  47. c     .. file unit number
  48.       kfile=1
  49. c     .. get hershey file name
  50.       write(*,'(a)') ' packed hershey font file name'
  51.       read(*,'(a)') name
  52.       open(unit=kfile,file=name,status='old')
  53. c     .. initialize graphics
  54.       call identy
  55. c     .. want square picture for each character
  56. c     .. Note: most but not all Hershey font characters fit inside this window
  57.       call window(-15.0, 15.0,-15.0, 15.0)
  58. c     .. loop per screen
  59. 5     continue
  60. c     .. start with a clean sheet
  61.       call newpag
  62. c     .. where to display this character
  63.       col = 0.0
  64.       row = 100.0
  65. c     .. loop per character
  66. 10    continue
  67. c     .. read character number and data
  68.       read(unit=kfile,'(i5,i3,64a1/(72a1))',end=90) ich,nch,
  69.      x     (line(1,i),line(2,i),i=1,nch)
  70. c     .. select view port (place character on screen)
  71.       call vwport(col,col+deltac,row-deltar,row)
  72. c     .. identify character
  73.       call jnumbr(ich,4,-15.0,9.0,5.0)
  74. c     .. draw character limits
  75. c     .. Note: this data can be used for proportional spacing
  76.       x=ichar(line(1,1))-ichar('R')
  77.       y=ichar(line(2,1))-ichar('R')
  78.       call move(x,-10.0)
  79.       call draw(x,10.0)
  80.       call move(y,-10.0)
  81.       call draw(y,10.0)
  82. c     .. first data point is a move
  83.       call skip
  84. c     .. loop per line of data
  85.       do 20 ipnt = 2, nch
  86. c     .. process vector number ipnt
  87.       if(line(1,ipnt).eq.' ') then
  88. c        .. next data point is a move
  89.          call skip
  90.       else
  91. c        .. draw (or move) to this data point
  92.          x=ichar(line(1,ipnt))-ichar('R')
  93.          y=ichar(line(2,ipnt))-ichar('R')
  94. c        .. Note that Hershey Font data is in TV coordinate system
  95.          call draw(x,-y)
  96.       endif
  97. 20    continue
  98. c     .. end of this character
  99.       col = col + deltac
  100.       if( col .lt. colmax ) go to 10
  101.       col = 0.0
  102.       row = row - deltar
  103.       if( row .ge. deltar ) go to 10
  104.       call waitcr
  105.       go to 5
  106. 90    continue
  107.       call waitcr
  108. c     .. all done
  109.       call grstop
  110.       end
  111.       subroutine jnumbr( number, iwidth, x0, y0, height )
  112.       integer number, iwidth
  113.       real x0, y0, height
  114. c     .. draw one of the decimal digits
  115. c     .. number = the integer to be displayed
  116. c     .. iwidth = the number of characters
  117. c     .. (x0, y0) = the lower left corner
  118. c     .. height = height of the characters
  119. c
  120. c
  121. c     .. By James Hurt when with
  122. c     ..    Deere and Company
  123. c     ..    John Deere Road
  124. c     ..    Moline, IL 61265
  125. c
  126. c     .. Author now with Cognition, Inc.
  127. c     ..                 900 Technology Park Drive
  128. c     ..                 Billerica, MA 01821
  129. c
  130. c     .. graphics (graphics) routines called
  131.       external skip,draw
  132. c     .. local variables used
  133.       integer ipnt, ipos, ival, idigit
  134.       real x, y, scale
  135.       real xleft, ylower
  136. c     .. character data for the ten decimal digit characters
  137. c     .. data extracted from one of the Hershey fonts
  138.       integer start(0:10), power(0:9)
  139.       character*1 line(2,104)
  140.       data power/ 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000,
  141.      x 100000000, 1000000000 /
  142.       data start/0,11,14,22,36,42,55,68,73,91,104/
  143. 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)
  144. c 1:poly(2 7,4 9,4 0)
  145. c 2:poly(1 8,3 9,5 9,7 8,7 6,6 4,1 0,7 0)
  146. c 3:poly(1 8,3 9,5 9,7 8,7 6,5 5)
  147. c   poly(4 5,5 5,7 4,7 1,5 0,3 0,1 1)
  148. c 4:poly(5 9,5 0)
  149. c   poly(5 9,0 3,8 3)
  150. c 5:poly(2 9,1 5,3 6,4 6,6 5,7 3,6 1,4 0,3 0,1 1)
  151. c   poly(2 9,6 9)
  152. 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)
  153. c 7:poly(7 9,3 0)
  154. c   poly(1 9,7 9)
  155. c 8:poly(3 9,1 8,1 6,3 5,5 5,7 6,7 8,5 9,3 9)
  156. c   poly(3 5,1 4,1 1,3 0,5 0,7 1,7 4,5 5)
  157. 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)
  158. c
  159.       data line/'R','M','P','N','O','P','O','S','P','U','R','V','T','U',
  160.      A'U','S','U','P','T','N','R','M','P','O','R','M','R
  161.      B','V','O','N','Q','M','S','M','U','N','U','P','T','R','O',
  162.      C'V','U','V','O','N','Q','M','S','M','U','N','U','P','S','Q
  163.      D',' ','R','R','Q','S','Q','U','R','U','U','S','V','Q','V','O','U',
  164.      E'S','M','S','V',' ','R','S','M','N','S','V','S','P
  165.      F','M','O','Q','Q','P','R','P','T','Q','U','S','T','U','R','V','Q',
  166.      G'V','O','U',' ','R','P','M','T','M','T','M','R','M','P','N
  167.      H','O','P','O','S','P','U','R','V','T','U','U','S','T','Q','R','P',
  168.      I'P','Q','O','S','U','M','Q','V',' ','R','O','M','U','M',
  169.      J'Q','M','O','N','O','P','Q','Q','S','Q','U','P','U','N','S',
  170.      K'M','Q','M',' ','R','Q','Q','O','R','O','U','Q','V','S','V','U','U
  171.      L','U','R','S','Q','U','P','T','R','R','S','P','R','O','P',
  172.      M'P','N','R','M','T','N','U','P','U','S','T','U','R','V','P','V'/
  173. c     .. compute scale factor and lower left of first digit
  174.       scale = height/10.0
  175.       xleft = x0
  176.       ylower = y0
  177.       ival = number
  178. c     .. loop for each position
  179.       do 30 ipos = iwidth,1,-1
  180.          idigit = mod( ival/power(ipos-1), 10 )
  181. c        .. first data point is a move
  182.          call skip
  183. c        .. loop over data for this digit
  184.          do 20 ipnt=start(idigit)+1,start(idigit+1)
  185.             if(line(1,ipnt).eq.' ') then
  186. c              .. next data point is a move
  187.                call skip
  188.             else
  189. c              .. draw (or move) to this data point
  190.                x=ichar(line(1,ipnt))-ichar('N')
  191.                y=ichar(line(2,ipnt))-ichar('V')
  192.                call draw(xleft+scale*x,ylower-scale*y)
  193.             endif
  194. 20       continue
  195. c        .. move for next digit
  196.          xleft = xleft + height
  197. 30    continue
  198.       end
  199.  
  200.