1C*PGWEDG -- annotate an image plot with a wedge
2C%void cpgwedg(const char *side, float disp, float width, \
3C% float fg, float bg, const char *label);
4C+
5      SUBROUTINE PGWEDG(SIDE, DISP, WIDTH, FG, BG, LABEL)
6      CHARACTER *(*) SIDE,LABEL
7      REAL DISP, WIDTH, FG, BG
8C
9C Plot an annotated grey-scale or color wedge parallel to a given axis
10C of the the current viewport. This routine is designed to provide a
11C brightness/color scale for an image drawn with PGIMAG or PGGRAY.
12C The wedge will be drawn with the transfer function set by PGSITF
13C and using the color index range set by PGSCIR.
14C
15C Arguments:
16C  SIDE   (input)  : The first character must be one of the characters
17C                    'B', 'L', 'T', or 'R' signifying the Bottom, Left,
18C                    Top, or Right edge of the viewport.
19C                    The second character should be 'I' to use PGIMAG
20C                    to draw the wedge, or 'G' to use PGGRAY.
21C  DISP   (input)  : the displacement of the wedge from the specified
22C                    edge of the viewport, measured outwards from the
23C                    viewport in units of the character height. Use a
24C                    negative value to write inside the viewport, a
25C                    positive value to write outside.
26C  WIDTH  (input)  : The total width of the wedge including annotation,
27C                    in units of the character height.
28C  FG     (input)  : The value which is to appear with shade
29C                    1 ("foreground"). Use the values of FG and BG
30C                    that were supplied to PGGRAY or PGIMAG.
31C  BG     (input)  : the value which is to appear with shade
32C                    0 ("background").
33C  LABEL  (input)  : Optional units label. If no label is required
34C                    use ' '.
35C--
36C  15-Oct-1992: New routine (MCS)
37C   2-Aug-1995: no longer needs common (TJP).
38C-----------------------------------------------------------------------
39      LOGICAL PGNOTO
40C                                        Temporary window coord storage.
41      REAL WXA,WXB,WYA,WYB, XA,XB,YA,YB
42C                                        Viewport coords of wedge.
43      REAL VXA,VXB,VYA,VYB
44C                          Original and anotation character heights.
45      REAL OLDCH, NEWCH
46C                          Size of unit character height (NDC units).
47      REAL NDCSIZ
48C                          True if wedge plotted horizontally.
49      LOGICAL HORIZ
50C                          Use PGIMAG (T) or PGGRAY (F).
51      LOGICAL IMAGE
52C                          Symbolic version of SIDE.
53      INTEGER NSIDE,BOT,TOP,LFT,RGT
54      PARAMETER (BOT=1,TOP=2,LFT=3,RGT=4)
55      INTEGER I
56      REAL WEDWID, WDGINC, VWIDTH, VDISP, XCH, YCH, LABWID, FG1, BG1
57C                          Set the fraction of WIDTH used for anotation.
58      REAL TXTFRC
59      PARAMETER (TXTFRC=0.6)
60C                          Char separation between numbers and LABEL.
61      REAL TXTSEP
62      PARAMETER (TXTSEP=2.2)
63C                          Array to draw wedge in.
64      INTEGER WDGPIX
65      PARAMETER (WDGPIX=100)
66      REAL WDGARR(WDGPIX)
67C                          Define the coordinate-mapping function.
68      REAL TR(6)
69      SAVE TR
70      DATA TR /0.0,1.0,0.0,0.0,0.0,1.0/
71C-----------------------------------------------------------------------
72      IF(PGNOTO('PGWEDG')) RETURN
73C
74C Get a numeric version of SIDE.
75C
76      IF(SIDE(1:1).EQ.'B' .OR. SIDE(1:1).EQ.'b') THEN
77        NSIDE = BOT
78        HORIZ = .TRUE.
79      ELSE IF(SIDE(1:1).EQ.'T' .OR. SIDE(1:1).EQ.'t') THEN
80        NSIDE = TOP
81        HORIZ = .TRUE.
82      ELSE IF(SIDE(1:1).EQ.'L' .OR. SIDE(1:1).EQ.'l') THEN
83        NSIDE = LFT
84        HORIZ = .FALSE.
85      ELSE IF(SIDE(1:1).EQ.'R' .OR. SIDE(1:1).EQ.'r') THEN
86        NSIDE = RGT
87        HORIZ = .FALSE.
88      ELSE
89        CALL GRWARN('Invalid "SIDE" argument in PGWEDG.')
90        RETURN
91      END IF
92C
93C Determine which routine to use.
94C
95      IF (LEN(SIDE).LT.2) THEN
96         IMAGE = .FALSE.
97      ELSE IF(SIDE(2:2).EQ.'I' .OR. SIDE(2:2).EQ.'i') THEN
98         IMAGE = .TRUE.
99      ELSE IF(SIDE(2:2).EQ.'G' .OR. SIDE(2:2).EQ.'g') THEN
100         IMAGE = .FALSE.
101      ELSE
102         CALL GRWARN('Invalid "SIDE" argument in PGWEDG.')
103      END IF
104C
105      CALL PGBBUF
106C
107C Store the current world and viewport coords and the character height.
108C
109      CALL PGQWIN(WXA, WXB, WYA, WYB)
110      CALL PGQVP(0, XA, XB, YA, YB)
111      CALL PGQCH(OLDCH)
112C
113C Determine the unit character height in NDC coords.
114C
115      CALL PGSCH(1.0)
116      CALL PGQCS(0, XCH, YCH)
117      IF(HORIZ) THEN
118        NDCSIZ = YCH
119      ELSE
120        NDCSIZ = XCH
121      END IF
122C
123C Convert 'WIDTH' and 'DISP' into viewport units.
124C
125      VWIDTH = WIDTH * NDCSIZ * OLDCH
126      VDISP  = DISP * NDCSIZ * OLDCH
127C
128C Determine the number of character heights required under the wedge.
129C
130      LABWID = TXTSEP
131      IF(LABEL.NE.' ') LABWID = LABWID + 1.0
132C
133C Determine and set the character height required to fit the wedge
134C anotation text within the area allowed for it.
135C
136      NEWCH = TXTFRC*VWIDTH / (LABWID*NDCSIZ)
137      CALL PGSCH(NEWCH)
138C
139C Determine the width of the wedge part of the plot minus the anotation.
140C (NDC units).
141C
142      WEDWID = VWIDTH * (1.0-TXTFRC)
143C
144C Use these to determine viewport coordinates for the wedge + annotation.
145C
146      VXA = XA
147      VXB = XB
148      VYA = YA
149      VYB = YB
150      IF(NSIDE.EQ.BOT) THEN
151        VYB = YA - VDISP
152        VYA = VYB - WEDWID
153      ELSE IF(NSIDE.EQ.TOP) THEN
154        VYA = YB + VDISP
155        VYB = VYA + WEDWID
156      ELSE IF(NSIDE.EQ.LFT) THEN
157        VXB = XA - VDISP
158        VXA = VXB - WEDWID
159      ELSE IF(NSIDE.EQ.RGT) THEN
160        VXA = XB + VDISP
161        VXB = VXA + WEDWID
162      END IF
163C
164C Set the viewport for the wedge.
165C
166      CALL PGSVP(VXA, VXB, VYA, VYB)
167C
168C Swap FG/BG if necessary to get axis direction right.
169C
170      FG1 = MAX(FG,BG)
171      BG1 = MIN(FG,BG)
172C
173C Create a dummy wedge array to be plotted.
174C
175      WDGINC = (FG1-BG1)/(WDGPIX-1)
176      DO 1 I=1,WDGPIX
177        WDGARR(I) = BG1 + (I-1) * WDGINC
178 1    CONTINUE
179C
180C Draw the wedge then change the world coordinates for labelling.
181C
182      IF (HORIZ) THEN
183        CALL PGSWIN(1.0, REAL(WDGPIX), 0.9, 1.1)
184        IF (IMAGE) THEN
185           CALL PGIMAG(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR)
186        ELSE
187           CALL PGGRAY(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR)
188        END IF
189        CALL PGSWIN(BG1,FG1,0.0,1.0)
190      ELSE
191        CALL PGSWIN(0.9, 1.1, 1.0, REAL(WDGPIX))
192        IF (IMAGE) THEN
193           CALL PGIMAG(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR)
194        ELSE
195           CALL PGGRAY(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR)
196        END IF
197        CALL PGSWIN(0.0, 1.0, BG1, FG1)
198      ENDIF
199C
200C Draw a labelled frame around the wedge.
201C
202      IF(NSIDE.EQ.BOT) THEN
203        CALL PGBOX('BCNST',0.0,0,'BC',0.0,0)
204      ELSE IF(NSIDE.EQ.TOP) THEN
205        CALL PGBOX('BCMST',0.0,0,'BC',0.0,0)
206      ELSE IF(NSIDE.EQ.LFT) THEN
207        CALL PGBOX('BC',0.0,0,'BCNST',0.0,0)
208      ELSE IF(NSIDE.EQ.RGT) THEN
209        CALL PGBOX('BC',0.0,0,'BCMST',0.0,0)
210      ENDIF
211C
212C Write the units label.
213C
214      IF(LABEL.NE.' ') THEN
215        CALL PGMTXT(SIDE,TXTSEP,1.0,1.0,LABEL)
216      END IF
217C
218C Reset the original viewport and world coordinates.
219C
220      CALL PGSVP(XA,XB,YA,YB)
221      CALL PGSWIN(WXA,WXB,WYA,WYB)
222      CALL PGSCH(OLDCH)
223      CALL PGEBUF
224      RETURN
225      END
226