1C*PGQTXT -- find bounding box of text string
2C%void cpgqtxt(float x, float y, float angle, float fjust, \
3C% const char *text, float *xbox, float *ybox);
4C+
5      SUBROUTINE PGQTXT (X, Y, ANGLE, FJUST, TEXT, XBOX, YBOX)
6      REAL X, Y, ANGLE, FJUST
7      CHARACTER*(*) TEXT
8      REAL XBOX(4), YBOX(4)
9C
10C This routine returns a bounding box for a text string. Instead
11C of drawing the string as routine PGPTXT does, it returns in XBOX
12C and YBOX the coordinates of the corners of a rectangle parallel
13C to the string baseline that just encloses the string. The four
14C corners are in the order: lower left, upper left, upper right,
15C lower right (where left and right refer to the first and last
16C characters in the string).
17C
18C If the string is blank or contains no drawable characters, all
19C four elements of XBOX and YBOX are assigned the starting point
20C of the string, (X,Y).
21C
22C Arguments:
23C  X, Y, ANGLE, FJUST, TEXT (input) : these arguments are the same as
24C                    the corrresponding arguments in PGPTXT.
25C  XBOX, YBOX (output) : arrays of dimension 4; on output, they
26C                    contain the world coordinates of the bounding
27C                    box in (XBOX(1), YBOX(1)), ..., (XBOX(4), YBOX(4)).
28C--
29C 12-Sep-1993 - new routine [TJP].
30C  8-Nov-1994 - return something for blank string [TJP].
31C 14-Jan-1997 - additional explanation [TJP].
32C-----------------------------------------------------------------------
33      INCLUDE 'pgplot.inc'
34      LOGICAL PGNOTO
35      INTEGER I, L, GRTRIM
36      REAL D, XP, YP, XPBOX(4), YPBOX(4), XOFFS, YOFFS
37C
38      IF (PGNOTO('PGQTXT')) RETURN
39C
40      L = GRTRIM(TEXT)
41      IF (L.LE.0) THEN
42         DO 15 I=1,4
43            XBOX(I) = X
44            YBOX(I) = Y
45 15      CONTINUE
46      ELSE
47         D = 0.0
48         IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D)
49         XOFFS = PGXORG(PGID) - D*FJUST*COS(ANGLE/57.29578)
50         YOFFS = PGYORG(PGID) - D*FJUST*SIN(ANGLE/57.29578)
51         XP = X*PGXSCL(PGID) + XOFFS
52         YP = Y*PGYSCL(PGID) + YOFFS
53         CALL GRQTXT(ANGLE, XP, YP, TEXT(1:L), XPBOX, YPBOX)
54         DO 25 I=1,4
55            XBOX(I) = (XPBOX(I) - PGXORG(PGID))/PGXSCL(PGID)
56            YBOX(I) = (YPBOX(I) - PGYORG(PGID))/PGYSCL(PGID)
57 25      CONTINUE
58      END IF
59      END
60