1C*PGMTXT -- write text at position relative to viewport
2C%void cpgmtxt(const char *side, float disp, float coord, \
3C% float fjust, const char *text);
4C+
5      SUBROUTINE PGMTXT (SIDE, DISP, COORD, FJUST, TEXT)
6      CHARACTER*(*) SIDE, TEXT
7      REAL DISP, COORD, FJUST
8C
9C Write text at a position specified relative to the viewport (outside
10C or inside).  This routine is useful for annotating graphs. It is used
11C by routine PGLAB.  The text is written using the current values of
12C attributes color-index, line-width, character-height, and
13C character-font.
14C
15C Arguments:
16C  SIDE   (input)  : must include one of the characters 'B', 'L', 'T',
17C                    or 'R' signifying the Bottom, Left, Top, or Right
18C                    margin of the viewport. If it includes 'LV' or
19C                    'RV', the string is written perpendicular to the
20C                    frame rather than parallel to it.
21C  DISP   (input)  : the displacement of the character string from the
22C                    specified edge of the viewport, measured outwards
23C                    from the viewport in units of the character
24C                    height. Use a negative value to write inside the
25C                    viewport, a positive value to write outside.
26C  COORD  (input)  : the location of the character string along the
27C                    specified edge of the viewport, as a fraction of
28C                    the length of the edge.
29C  FJUST  (input)  : controls justification of the string parallel to
30C                    the specified edge of the viewport. If
31C                    FJUST = 0.0, the left-hand end of the string will
32C                    be placed at COORD; if JUST = 0.5, the center of
33C                    the string will be placed at COORD; if JUST = 1.0,
34C                    the right-hand end of the string will be placed at
35C                    at COORD. Other values between 0 and 1 give inter-
36C                    mediate placing, but they are not very useful.
37C  TEXT   (input) :  the text string to be plotted. Trailing spaces are
38C                    ignored when justifying the string, but leading
39C                    spaces are significant.
40C
41C--
42C 18-Apr-1983
43C 15-Aug-1987 - fix BBUF/EBUF error.
44C 27-Aug-1987 - fix justification error if XPERIN.ne.YPERIN.
45C 05-Sep-1989 - change so that DISP has some effect for 'RV' and
46C               'LV' options [nebk]
47C 16-Oct-1993 - erase background of opaque text.
48C-----------------------------------------------------------------------
49      INCLUDE 'pgplot.inc'
50      LOGICAL PGNOTO
51      REAL ANGLE, D, X, Y, RATIO, XBOX(4), YBOX(4)
52      INTEGER CI, I, L, GRTRIM
53      CHARACTER*20 TEST
54C
55      IF (PGNOTO('PGMTXT')) RETURN
56C
57      L = GRTRIM(TEXT)
58      IF (L.LT.1) RETURN
59      D = 0.0
60      IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D)
61      D = D*FJUST
62      RATIO = PGYPIN(PGID)/PGXPIN(PGID)
63      CALL GRTOUP(TEST,SIDE)
64      IF (INDEX(TEST,'B').NE.0) THEN
65          ANGLE = 0.0
66          X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D
67          Y = PGYOFF(PGID) - PGYSP(PGID)*DISP
68      ELSE IF (INDEX(TEST,'LV').NE.0) THEN
69          ANGLE = 0.0
70          X = PGXOFF(PGID) - PGYSP(PGID)*DISP - D
71          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID)
72      ELSE IF (INDEX(TEST,'L').NE.0) THEN
73          ANGLE = 90.0
74          X = PGXOFF(PGID) - PGYSP(PGID)*DISP
75          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO
76      ELSE IF (INDEX(TEST,'T').NE.0) THEN
77          ANGLE = 0.0
78          X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D
79          Y = PGYOFF(PGID) + PGYLEN(PGID) + PGYSP(PGID)*DISP
80      ELSE IF (INDEX(TEST,'RV').NE.0) THEN
81          ANGLE = 0.0
82          X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP - D
83          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID)
84      ELSE IF (INDEX(TEST,'R').NE.0) THEN
85          ANGLE = 90.0
86          X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP
87          Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO
88      ELSE
89          CALL GRWARN('Invalid "SIDE" argument in PGMTXT.')
90          RETURN
91      END IF
92      CALL PGBBUF
93      IF (PGTBCI(PGID).GE.0) THEN
94          CALL GRQTXT (ANGLE, X, Y, TEXT(1:L), XBOX, YBOX)
95          DO 25 I=1,4
96              XBOX(I) = (XBOX(I)-PGXORG(PGID))/PGXSCL(PGID)
97              YBOX(I) = (YBOX(I)-PGYORG(PGID))/PGYSCL(PGID)
98   25     CONTINUE
99          CALL PGQCI(CI)
100          CALL PGSCI(PGTBCI(PGID))
101          CALL GRFA(4, XBOX, YBOX)
102          CALL PGSCI(CI)
103      END IF
104      CALL GRTEXT(.FALSE.,ANGLE,.TRUE., X, Y, TEXT(1:L))
105      CALL PGEBUF
106      END
107