home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilsp / pgplot / SYS_ARC / f77 / PGDchar < prev    next >
Encoding:
Text File  |  1994-02-24  |  2.5 KB  |  103 lines
  1.       PROGRAM DCHAR
  2. C----------------------------------------------------------------------
  3. C Display construction of Hershey character.
  4. C This program uses the PGPLOT internal routine GRSYXD and must
  5. C therefore be linked with the non-shareable library.
  6. C                              T. J. Pearson  1983 Feb 12
  7. C----------------------------------------------------------------------
  8.       INTEGER PGBEG, HEIGHT, DEPTH, WIDTH
  9.       INTEGER          XYGRID(300),I,N,M
  10.       REAL             XC,YC,X(5),BASE
  11.       LOGICAL          UNUSED,MOVE
  12.       CHARACTER*4      TEXT
  13. C-----------------------------------------------------------------------
  14.       IF (PGBEG(0,'?',1,1).NE.1) STOP
  15.       CALL PGASK(.FALSE.)
  16.    20 WRITE (*,'(A,$)') ' Symbol number: '
  17.       M = N
  18.       READ (*,*,END=30) N
  19.       IF (N.EQ.0) N = M+1
  20.       CALL GRSYXD(N,XYGRID,UNUSED)
  21.       IF (UNUSED) THEN
  22.           WRITE (*,'(A)') ' Symbol not defined'
  23.           GOTO 20
  24.       END IF
  25. C
  26. C Call PGENV to initialize the viewport and window; the
  27. C AXIS argument is -2, so no frame or labels will be drawn.
  28. C
  29.       CALL PGBBUF
  30.       CALL PGENV(-50.,50.,-50.,50.0,1,-2)
  31. C
  32. C Call PGBOX to draw a grid at low brightness.
  33. C
  34.       CALL PGSCI(15)
  35.       CALL PGSLW(1)
  36.       CALL PGBOX('G',10.0,0,'G',10.0,0)
  37.       CALL PGSCI(5)
  38. C
  39.       DO 15 I=1,5
  40.          X(I) = XYGRID(I)
  41.    15 CONTINUE
  42. C
  43. C Shift coordinates so baseline is y=0; center is (0,-BASE)
  44. C
  45.       BASE = X(2)
  46.       X(1) = X(1)-BASE
  47.       X(3) = X(3)-BASE
  48.       HEIGHT=X(3)
  49.       DEPTH = X(1)
  50.       WIDTH =X(5)-X(4)
  51.       WRITE(*,*) N, HEIGHT, DEPTH, WIDTH
  52. C
  53. C Draw the `bounding box'.
  54. C
  55.       CALL PGMOVE(X(4),X(1))
  56.       CALL PGDRAW(X(5),X(1))
  57.       CALL PGDRAW(X(5),X(3))
  58.       CALL PGDRAW(X(4),X(3))
  59.       CALL PGDRAW(X(4),X(1))
  60. C
  61. C Draw the baseline.
  62. C
  63.       CALL PGMOVE(-50.0, 0.0)
  64.       CALL PGDRAW(50.0, 0.0)
  65. C
  66. C Mark the `center' of the character.
  67. C
  68.       CALL PGPT(1, 0.0, -BASE, 9)
  69. C
  70. C Write the Hershey number in lower left corner.
  71. C
  72.       WRITE (TEXT,'(I4)') N
  73.       CALL PGTEXT(-49.0, -49.0, TEXT)
  74. C
  75.       CALL PGSCI(3)
  76.       CALL PGSLW(3)
  77.       I = 6
  78.       MOVE = .TRUE.
  79.    26 XC = XYGRID(I)
  80.       I = I+1
  81.       IF (XYGRID(I).EQ.-64) THEN
  82.           CALL PGEBUF
  83.           GOTO 20
  84.       END IF
  85.       YC = XYGRID(I)-BASE
  86.       I = I+1
  87.       IF (XYGRID(I-2).EQ.-64) THEN
  88.           MOVE = .TRUE.
  89.           GOTO 26
  90.       END IF
  91.       IF (MOVE) THEN
  92.           CALL PGMOVE(XC,YC)
  93.           MOVE = .FALSE.
  94.       ELSE
  95.           CALL PGDRAW(XC,YC)
  96.       END IF
  97.       GOTO 26
  98. C
  99. C Don't forget to call PGEND!
  100. C
  101.    30 CALL PGEND
  102.       END
  103.