home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilsp / pgplot / SYS_ARC / f77 / GRsyxd < prev    next >
Encoding:
Text File  |  1994-02-27  |  3.5 KB  |  102 lines
  1. C*GRSYXD -- obtain the polyline representation of a given symbol
  2. C+
  3.       SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED)
  4.       INTEGER SYMBOL
  5.       INTEGER XYGRID(300)
  6.       LOGICAL UNUSED
  7. C
  8. C February 1994: INTEGER*2 removed to allow compilation on the Acorn
  9. C                Archimedes compiler where this is not allowed.
  10. C                Here an INTEGER FUNCTION BUFFER(INDEX) unpacks the 
  11. C                16-bit word from the INTEGER*4 array BUFFPK(13500)
  12. C                rather than the INTEGER*2 BUFFER(27000) of 
  13. C                the original code.
  14. C                                   D.J. Crennell (Fortran Friends)
  15. C
  16. C Return the digitization coordinates of a character. Each character is
  17. C defined on a grid with X and Y coordinates in the range (-49,49), 
  18. C with the origin (0,0) at the center of the character.  The coordinate
  19. C system is right-handed, with X positive to the right, and Y positive
  20. C upward.  
  21. C
  22. C Arguments:
  23. C  SYMBOL (input)  : symbol number in range (1..3000).
  24. C  XYGRID (output) : height range, width range, and pairs of (x,y)
  25. C                    coordinates returned.  Height range = (XYGRID(1),
  26. C                    XYGRID(3)).  Width range = (XYGRID(4),XYGRID(5)).
  27. C                    (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...).
  28. C  UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol
  29. C                    number. A character of normal height and zero width
  30. C                    is returned. Receives .FALSE. if SYMBOL is a 
  31. C                    valid symbol number.
  32. C 
  33. C The height range consists of 3 values: (minimum Y, baseline Y,
  34. C maximum Y).  The first is reached by descenders on lower-case g, p,
  35. C q, and y.  The second is the bottom of upper-case letters.  The third
  36. C is the top of upper-case letters.  A coordinate pair (-64,0) requests
  37. C a pen raise, and a pair (-64,-64) terminates the coordinate list. It
  38. C is assumed that movement to the first coordinate position will be
  39. C done with the pen raised - no raise command is explicitly included to
  40. C do this. 
  41. C--
  42. C  7-Mar-1983.
  43. C 15-Dec-1988 - standardize.
  44. C-----------------------------------------------------------------------
  45.       INTEGER      BUFFPK(13500),BUFFER
  46.       INTEGER      INDEX(3000), IX, IY, K, L, LOCBUF
  47.       INTEGER      NC1, NC2
  48.       COMMON       /GRSYMB/ NC1, NC2, INDEX, BUFFPK
  49. C
  50. C Extract digitization.
  51. C
  52.       IF (SYMBOL.LT.NC1 .OR. SYMBOL.GT.NC2) GOTO 3000
  53.       L = SYMBOL - NC1 + 1
  54.       LOCBUF = INDEX(L)
  55.       IF (LOCBUF .EQ. 0) GOTO 3000
  56.       XYGRID(1) = BUFFER(LOCBUF)
  57.       LOCBUF = LOCBUF + 1
  58.       K = 2
  59.       IY = -1
  60. C     -- DO WHILE (IY.NE.-64)
  61.   100 IF (IY.NE.-64) THEN
  62.           IX = BUFFER(LOCBUF)/128
  63.           IY = BUFFER(LOCBUF) - 128*IX - 64
  64.           XYGRID(K) = IX - 64
  65.           XYGRID(K+1) = IY
  66.           K = K + 2
  67.           LOCBUF = LOCBUF + 1
  68.       GOTO 100
  69.       END IF
  70. C     -- end DO WHILE
  71.       UNUSED = .FALSE.
  72.       RETURN
  73. C
  74. C Unimplemented character.
  75. C
  76. 3000  XYGRID(1) = -16
  77.       XYGRID(2) =  -9
  78.       XYGRID(3) = +12
  79.       XYGRID(4) =   0
  80.       XYGRID(5) =   0
  81.       XYGRID(6) = -64
  82.       XYGRID(7) = -64
  83.       UNUSED = .TRUE.
  84.       RETURN
  85.       END
  86. C
  87.       INTEGER FUNCTION BUFFER(K)
  88.       INTEGER      BUFFPK(13500), INDEX(3000)
  89.       COMMON       /GRSYMB/ NC1, NC2, INDEX, BUFFPK
  90.       LOGICAL BTEST
  91. C           unpack buffer as INTEGER*2 from BUFFPK
  92.       K1 = ISHFT(K+1,-1)
  93.       IF(K1+K1 .EQ. K) THEN
  94.         BUFFER = ISHFT(BUFFPK(K1),-16)
  95.       ELSE
  96.         BUFFER = IAND(BUFFPK(K1),65535)
  97.       ENDIF
  98. C               correct for negative word
  99.       IF(BTEST(BUFFER,15)) BUFFER = IOR(BUFFER, ?IFFFF0000)
  100.       RETURN
  101.       END
  102.