On March 17, 2000, Johannes Wefers posted the following question:
> Assume that you are plotting two contour fields using the
> conpack package, and that you are going to use High-Low-
> Labels (HLLs) for both fields.
>
> How can one avoid the overlapping of the HLLs that
> are assigned to different contour fields? The HLO
> flag seems to avoid overlapping labels for a
> single field, and the CPLBDR routine has
> no entry for an external function that
> can be user defined and that could solve the problem.
This proved not to be easy to do, but I have worked out a possible solution.
The program appended below illustrates this. It's a modified version of the
example "cpex06". It produces two frames. On the first frame, you will
find the overlaid contours for two different contour fields. For the first
field, the contours and their labels are in red, white, and blue, with green
high and low labels; for the second field, all contours and all labels are
in yellow. As will be seen, many of the yellow labels overlap the others
and most of the labels have contour lines running through them. The second
frame is the same as the first, but my solution has been applied; yellow labels
which would have overlapped red, white, blue, or green ones have been omitted
and all contours have been prevented from passing through the labels.
The solution depends on supplying "user" versions of the routines CPCHHL and
CPCHLL that can be made to check labels under consideration against an area
map and omit any that would overlap any area with a negative identifier
(i.e., where some previous label exists). Two different area maps are used;
in the commenting, these are referred to as area maps A and B. One first
generates an area map A which contains label boxes for both fields and copies
that to area map B; then, one generates and draws the contour lines and
labels, masking (clipping) the lines against area map B.
This code was tricky to write and required knowledge of the inner workings
of CONPACK. (A good bit of the time was spent refamiliarizing myself with
those inner workings and involved a lot of puzzled head-scratching as things
went wrong.) Those who are interested in this should go through the example
in some detail and read the comments, which I have tried to make as helpful
as possible. If you have other questions and/or if you try to modify this
solution for your own purposes and something goes wrong, please write me ...
So ... I hope this is useful ...
Dave Kennison
Program follows:
----------------
PROGRAM EXMPL6
C
C Declare required data arrays.
C
DIMENSION ZDT1(27,23),ZDT2(27,23)
C
C Declare required real and integer workspace arrays for CONPACK.
C
DIMENSION RWRK(5000),IWRK(1000)
C
C Declare a couple of arrays to hold area maps A and B. The first of
C these is put in a labeled common block so that the routines CPCHHL
C and CPCHLL can get at it, while the second is stored locally. The
C labelled common block also contains a flag which can be set to
C determine how the routine CPCHHL and CPCHLL are to behave.
C
COMMON /CB0001/ IAMA(10000),IACT
C
DIMENSION IAMB(10000)
C
C Declare the routine which will draw contour lines, avoiding labels.
C
EXTERNAL DRAWCL
C
C Open GKS.
C
CALL OPNGKS
C
C Turn off the clipping indicator.
C
CALL GSCLIP (0)
C
C Define color indices.
C
CALL GSCR (1,0,0.00,0.00,0.00) ! 0 => black
CALL GSCR (1,1,1.00,1.00,1.00) ! 1 => white
CALL GSCR (1,2,0.00,0.00,1.00) ! 2 => 1, minor neg.
CALL GSCR (1,3,0.85,0.85,1.00) ! 3 => 1, major neg.
CALL GSCR (1,4,1.00,0.00,0.00) ! 4 => 1, minor pos.
CALL GSCR (1,5,1.00,0.85,0.85) ! 5 => 1, major pos.
CALL GSCR (1,6,0.00,1.00,0.00) ! 6 => 1, labels
CALL GSCR (1,7,1.00,1.00,0.00) ! 7 => 2, all
C
C Generate two arrays of test data. Note that the routine GENDAT uses
C a function FRAN, which generates "random" numbers. I have replaced
C that function with one that generates a particular sequence of 200
C numbers to be used by these calls. This is to ensure that everyone
C running the example will get the same picture. If the calls to GENDAT
C are changed, the results may be peculiar.
C
CALL GENDAT (ZDT1,27,27,23,25,25,-3.62362,4.51834)
CALL GENDAT (ZDT2,27,27,23,25,25,-36.2362,45.1834)
C
C Increase the approximate number of contour levels used.
C
CALL CPSETI ('CLS - CONTOUR LEVEL SELECTION',25)
C
C Turn on the positioning of labels by the penalty scheme.
C
CALL CPSETI ('LLP - LINE LABEL POSITIONING',3)
C
C Tell CONPACK to label highs and low with just the number and box them.
C
CALL CPSETC ('HLT - HIGH/LOW TEXT','H:B:$ZDV$:E:''L:B:$ZDV$:E:')
CALL CPSETI ('HLB - HIGH/LOW LABEL BOX FLAG',1)
C
C Tell CONPACK to delete high/low labels which overlap the informational
C label, another high/low label, or the edge.
C
CALL CPSETI ('HLO - HIGH/LOW LABEL OVERLAP FLAG',7)
C
C Tell CONPACK to draw the grid edge ("contour line number -1"), thicken
C it somewhat, and make it white.
C
CALL CPSETI ('PAI - PARAMETER ARRAY INDEX',-1)
CALL CPSETI ('CLU - CONTOUR LEVEL USE FLAG',1)
CALL CPSETR ('CLL - CONTOUR LEVEL LINE WIDTH',2.)
CALL CPSETI ('CLC - CONTOUR LINE COLOR',1)
C
C+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
C Do the first of two plots.
C+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
C
C Tell the routines CPCHHL and CPCHLL to do nothing, so that the two
C contour plots will just be superimposed.
C
IACT=0
C
C Initialize area map A.
C
CALL ARINAM (IAMA,10000)
C
C Initialize CONPACK for the first contour field. (The routine CPIN01
C is not a part of CONPACK; it occurs later in this file.)
C
CALL CPIN01 (ZDT1,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the first contour field into area map A.
C
CALL CPLBAM (ZDT1,RWRK,IWRK,IAMA)
C
C Draw contour lines for the first field, avoiding drawing through label
C boxes (as defined by area map A).
C
CALL CPCLDM (ZDT1,RWRK,IWRK,IAMA,DRAWCL)
C
C Fill in the labels for the first field.
C
CALL CPLBDR (ZDT1,RWRK,IWRK)
C
C Re-initialize area map A.
C
CALL ARINAM (IAMA,10000)
C
C Initialize CONPACK for the second contour field. (The routine CPIN02
C is not a part of CONPACK; it occurs later in this file.)
C
CALL CPIN02 (ZDT2,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the second contour field into area map A.
C
CALL CPLBAM (ZDT2,RWRK,IWRK,IAMA)
C
C Draw contour lines for the second field, avoiding drawing through
C label boxes (as defined by area map A).
C
CALL CPCLDM (ZDT2,RWRK,IWRK,IAMA,DRAWCL)
C
C Fill in the labels for the second field.
C
CALL CPLBDR (ZDT2,RWRK,IWRK)
C
C Put a boundary line at the edge of the plotter frame.
C
CALL BNDARY
C
C Advance the frame.
C
CALL FRAME
C
C+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
C Do the second of two plots.
C+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
C
C Tell the routines CPCHHL and CPCHLL to modify the selection of label
C positions as directed by the contents of area map A.
C
IACT=1
C
C Initialize area map A.
C
CALL ARINAM (IAMA,10000)
C
C Initialize CONPACK for the first contour field.
C
CALL CPIN01 (ZDT1,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the first contour field into area map A.
C
CALL CPLBAM (ZDT1,RWRK,IWRK,IAMA)
C
C Initialize CONPACK for the second contour field.
C
CALL CPIN02 (ZDT2,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the second contour field into area map A.
C
CALL CPLBAM (ZDT2,RWRK,IWRK,IAMA)
C
C Area map A now contains label boxes for both of the contour fields.
C Copy it to area map B.
C
CALL ARMVAM (IAMA,IAMB,10000)
C
C Re-initialize area map A.
C
CALL ARINAM (IAMA,10000)
C
C Re-initialize CONPACK for the first contour field.
C
CALL CPIN01 (ZDT1,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the first contour field into area map A.
C
CALL CPLBAM (ZDT1,RWRK,IWRK,IAMA)
C
C Draw contour lines, avoiding drawing through label boxes (as defined
C by area map B, which includes label boxes for both contour fields).
C
CALL CPCLDM (ZDT1,RWRK,IWRK,IAMB,DRAWCL)
C
C Fill in the labels for the first contour field.
C
CALL CPLBDR (ZDT1,RWRK,IWRK)
C
C Initialize CONPACK for the second contour field.
C
CALL CPIN02 (ZDT2,27,23,RWRK,5000,IWRK,1000)
C
C Put label boxes for the second contour field into area map A.
C
CALL CPLBAM (ZDT2,RWRK,IWRK,IAMA)
C
C Draw contour lines, avoiding drawing through label boxes (as defined
C by area map B, which includes label boxes for both contour fields).
C
CALL CPCLDM (ZDT2,RWRK,IWRK,IAMB,DRAWCL)
C
C Fill in the labels for contour field B.
C
CALL CPLBDR (ZDT2,RWRK,IWRK)
C
C Put a boundary line at the edge of the plotter frame.
C
CALL BNDARY
C
C Advance the frame.
C
CALL FRAME
C
C+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
C
C Close GKS.
C
CALL CLSGKS
C
C Done.
C
STOP
C
END
SUBROUTINE GENDAT (DATA,IDIM,M,N,MLOW,MHGH,DLOW,DHGH)
C
C This is a routine to generate test data for two-dimensional graphics
C routines. Given an array "DATA", dimensioned "IDIM x 1", it fills
C the sub-array ((DATA(I,J),I=1,M),J=1,N) with a two-dimensional field
C of data having approximately "MLOW" lows and "MHGH" highs, a minimum
C value of exactly "DLOW" and a maximum value of exactly "DHGH".
C
C "MLOW" and "MHGH" are each forced to be greater than or equal to 1
C and less than or equal to 25.
C
C The function used is a sum of exponentials.
C
DIMENSION DATA(IDIM,1),CCNT(3,50)
C
FOVM=9./FLOAT(M)
FOVN=9./FLOAT(N)
C
NLOW=MAX0(1,MIN0(25,MLOW))
NHGH=MAX0(1,MIN0(25,MHGH))
NCNT=NLOW+NHGH
C
DO 101 K=1,NCNT
CCNT(1,K)=1.+(FLOAT(M)-1.)*FRAN()
CCNT(2,K)=1.+(FLOAT(N)-1.)*FRAN()
IF (K.LE.NLOW) THEN
CCNT(3,K)=-1.
ELSE
CCNT(3,K)=+1.
END IF
101 CONTINUE
C
DMIN=+1.E36
DMAX=-1.E36
DO 104 J=1,N
DO 103 I=1,M
DATA(I,J)=.5*(DLOW+DHGH)
DO 102 K=1,NCNT
TEMP=-((FOVM*(FLOAT(I)-CCNT(1,K)))**2+
+ (FOVN*(FLOAT(J)-CCNT(2,K)))**2)
IF (TEMP.GE.-20.) DATA(I,J)=DATA(I,J)+
+ .5*(DHGH-DLOW)*CCNT(3,K)*EXP(TEMP)
102 CONTINUE
DMIN=AMIN1(DMIN,DATA(I,J))
DMAX=AMAX1(DMAX,DATA(I,J))
103 CONTINUE
104 CONTINUE
C
DO 106 J=1,N
DO 105 I=1,M
DATA(I,J)=(DATA(I,J)-DMIN)/(DMAX-DMIN)*(DHGH-DLOW)+DLOW
105 CONTINUE
106 CONTINUE
C
RETURN
C
END
FUNCTION FRAN()
C
C Pseudo-random-number generator that will generate a predictable result
C on any machine.
C
DIMENSION RNMB(200)
C
SAVE INUM
C
DATA INUM / 0 /
C
DATA RNMB /
+ .4571,.0218,.1026,.8750,.8423,.1976,.9453,.7667,.3589,.0577,
+ .3444,.1803,.4341,.8786,.4344,.1613,.6976,.7358,.0767,.5208,
+ .3096,.2425,.9269,.6223,.5285,.1822,.4349,.0835,.7080,.7835,
+ .0469,.8916,.9980,.7174,.5781,.4447,.7520,.8969,.0753,.5788,
+ .0298,.9391,.3199,.9937,.9107,.8971,.3307,.5484,.4674,.3505,
+ .3954,.6486,.4143,.4833,.5458,.3485,.1932,.1347,.5497,.1094,
+ .6099,.2510,.0227,.4707,.9281,.8583,.9918,.3631,.0938,.7306,
+ .2724,.4204,.3281,.0852,.9855,.9153,.0135,.8025,.2789,.7839,
+ .8599,.7573,.7065,.1203,.8503,.4494,.9211,.4525,.9775,.5652,
+ .7768,.4248,.8950,.6280,.2225,.5879,.2899,.2888,.5222,.7722,
+ .3021,.2453,.5566,.9211,.7253,.6082,.0321,.7341,.1636,.3139,
+ .9520,.8614,.1694,.2709,.2725,.0134,.2090,.3925,.0640,.5249,
+ .4956,.7996,.9311,.0278,.2702,.1416,.2179,.1328,.4943,.2824,
+ .4379,.5911,.0413,.4960,.5642,.9815,.8028,.3611,.6596,.0192,
+ .7362,.6617,.8750,.9631,.7501,.8020,.9586,.0960,.7480,.1370,
+ .9269,.5383,.5086,.4756,.6579,.0989,.3939,.4113,.1877,.2763,
+ .6763,.5459,.7462,.1506,.6684,.0108,.2968,.9505,.9802,.8533,
+ .0523,.0992,.2014,.1269,.8081,.2272,.5941,.2883,.5248,.2777,
+ .7209,.5220,.5978,.1655,.8967,.7834,.0984,.9517,.6510,.5517,
+ .1096,.8964,.4601,.6344,.3783,.6493,.7339,.2253,.0621,.4365/
C
INUM=MOD(INUM,200)+1
FRAN=RNMB(INUM)
C
RETURN
C
END
SUBROUTINE CPIN01 (ZDAT,IDIM,JDIM,RWRK,LRWK,IWRK,LIWK)
C
C Initialize CONPACK for the first of two contour fields.
C
DIMENSION ZDAT(IDIM,JDIM),RWRK(LRWK),IWRK(LIWK)
C
C Make the high and low labels green.
C
CALL CPSETI ('HLC - HIGH/LOW LABEL COLOR INDEX',6)
C
C Move the informational label to a different place and make it a
C different color.
C
CALL CPSETI ('ILC - INFORMATIONAL LABEL X POSITION', 1)
CALL CPSETI ('ILP - INFORMATIONAL LABEL X POSITION', 2)
CALL CPSETR ('ILX - INFORMATIONAL LABEL X POSITION', .02)
CALL CPSETR ('ILY - INFORMATIONAL LABEL Y POSITION',-.02)
C
C Initialize the drawing of the first contour plot.
C
CALL CPRECT (ZDAT,IDIM,IDIM,JDIM,RWRK,LRWK,IWRK,LIWK)
C
C Force the selection of contour levels by CONPACK.
C
CALL CPPKCL (ZDAT,RWRK,IWRK)
C
C Force the color of the negative contours to blue, the color of the
C positive contours to red, and the color of the zero contour to white.
C If a positive or negative contour is labelled, use a darker shade and
C make the color of the label match.
C
CALL CPGETI ('NCL - NUMBER OF CONTOUR LEVELS',NCLV)
C
DO 102 ICLV=1,NCLV
CALL CPSETI ('PAI - PARAMETER ARRAY INDEX',ICLV)
CALL CPGETR ('CLV - CONTOUR LEVEL',CLEV)
CALL CPGETI ('CLU - CONTOUR LEVEL USE',ICLU)
IF (CLEV.LT.0.) THEN
IF (ICLU.EQ.1) THEN
CALL CPSETI ('CLC - CONTOUR LINE COLOR',2)
ELSE
CALL CPSETI ('CLC - CONTOUR LINE COLOR',3)
CALL CPSETI ('LLC - LINE LABEL COLOR',3)
END IF
ELSE IF (CLEV.EQ.0.) THEN
CALL CPSETI ('CLC - CONTOUR LINE COLOR',1)
CALL CPSETI ('LLC - LINE LABEL COLOR',1)
ELSE
IF (ICLU.EQ.1) THEN
CALL CPSETI ('CLC - CONTOUR LINE COLOR',4)
ELSE
CALL CPSETI ('CLC - CONTOUR LINE COLOR',5)
CALL CPSETI ('LLC - LINE LABEL COLOR',5)
END IF
END IF
102 CONTINUE
C
C Done.
C
RETURN
C
END
SUBROUTINE CPIN02 (ZDAT,IDIM,JDIM,RWRK,LRWK,IWRK,LIWK)
C
C Initialize CONPACK for the second of two contour fields.
C
DIMENSION ZDAT(IDIM,JDIM),RWRK(LRWK),IWRK(LIWK)
C
C Make the high and low labels yellow.
C
CALL CPSETI ('HLC - HIGH/LOW LABEL COLOR INDEX',7)
C
C Move the informational label to a different place and make it a
C different color.
C
CALL CPSETI ('ILC - INFORMATIONAL LABEL X POSITION', 7)
CALL CPSETI ('ILP - INFORMATIONAL LABEL X POSITION', 4)
CALL CPSETR ('ILX - INFORMATIONAL LABEL X POSITION', .98)
CALL CPSETR ('ILY - INFORMATIONAL LABEL Y POSITION',-.02)
C
C Initialize the drawing of the second contour plot.
C
CALL CPRECT (ZDAT,IDIM,IDIM,JDIM,RWRK,LRWK,IWRK,LIWK)
C
C Force the selection of contour levels by CONPACK.
C
CALL CPPKCL (ZDT2,RWRK,IWRK)
C
C Make all contours yellow.
C
CALL CPGETI ('NCL - NUMBER OF CONTOUR LEVELS',NCLV)
C
DO 101 ICLV=1,NCLV
CALL CPSETI ('PAI - PARAMETER ARRAY INDEX',ICLV)
CALL CPGETR ('CLV - CONTOUR LEVEL',CLEV)
CALL CPSETI ('CLC - CONTOUR LINE COLOR',7)
CALL CPSETI ('LLC - LINE LABEL COLOR',7)
101 CONTINUE
C
C Done.
C
RETURN
C
END
SUBROUTINE DRAWCL (XCS,YCS,NCS,IAI,IAG,NAI)
C
C This version of DRAWCL draws the polyline defined by the points
C ((XCS(I),YCS(I)),I=1,NCS) if and only if none of the area identifiers
C for the area containing the polyline are negative. The dash package
C routine CURVED is called to do the drawing.
C
DIMENSION XCS(*),YCS(*),IAI(*),IAG(*)
C
C Turn on drawing.
C
IDR=1
C
C If any area identifier is negative, turn off drawing.
C
DO 101 I=1,NAI
IF (IAI(I).LT.0) IDR=0
101 CONTINUE
C
C If drawing is turned on, draw the polyline.
C
IF (IDR.NE.0) CALL CURVED (XCS,YCS,NCS)
C
C Done.
C
RETURN
C
END
SUBROUTINE BNDARY
C
C Draw a line showing where the edge of the plotter frame is.
C
CALL PLOTIF (0.,0.,0)
CALL PLOTIF (1.,0.,1)
CALL PLOTIF (1.,1.,1)
CALL PLOTIF (0.,1.,1)
CALL PLOTIF (0.,0.,1)
CALL PLOTIF (0.,0.,2)
C
C Done.
C
RETURN
C
END
SUBROUTINE CPCHHL (IFLG)
C
C This routine is called by CONPACK while it is positioning high/low
C labels. IFLG=1/5 implies that it's deciding whether or not to put
C a label at ('LBX','LBY'); if we set 'CTM' = ' ', it suppresses the
C label there. IFLG=2/6 implies that the box around a label is being
C pre-filled, IFLG=3/7 that the label is being drawn, and IFLG=4/8 that
C the box around the label is being drawn. The negatives of these
C values imply that the associated action has just been finished.
C
C Declare a common block containing the area map being used by the
C main program to contain label boxes (so we can check to see for
C certain kinds of overlap).
C
COMMON /CB0001/ IAMA(10000),IACT
C
CHARACTER*64 CTMP
DIMENSION IAAI(3),IAGI(3)
C
IF (IACT.EQ.0) RETURN
C
IF (IAMA(5).NE.27.AND.(IFLG.EQ.1.OR.IFLG.EQ.5)) THEN
CALL CPGETC ('CTM - CHARACTER TEMPORARY',CTMP)
CALL CPGETR ('CWM - CHARACTER WIDTH MULTIPLIER',CHWM)
CALL CPGETR ('HLS - HIGH/LOW LABEL SIZE',WCHL)
CALL CPGETR ('VPL - VIEWPORT LEFT EDGE',XVPL)
CALL CPGETR ('VPR - VIEWPORT RIGHT EDGE',XVPR)
WCFS=CHWM*WCHL*(XVPR-XVPL)
CALL CPGETR ('LBX - X COORDINATE OF LABEL',XLBC)
CALL CPGETR ('LBY - Y COORDINATE OF LABEL',YLBC)
CALL PCGETI ('TE - TEXT EXTENT FLAG',ISTE)
CALL PCSETI ('TE - TEXT EXTENT FLAG',1)
CALL PLCHHQ (XLBC,YLBC,CTMP(1:IOLNBC(CTMP)),WCFS,360.,0.)
CALL PCSETI ('TE - TEXT EXTENT FLAG',ISTE)
CALL PCGETR ('DL',DSTL)
CALL PCGETR ('DR',DSTR)
CALL PCGETR ('DB',DSTB)
CALL PCGETR ('DT',DSTT)
DO 102 ICOR=1,8
IF (ICOR.EQ.1) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.2) THEN
XCRD=CUFX(XLBC)-DSTL/2.+DSTR/2.
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.3) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.4) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)-DSTB/2.+DSTT/2.
ELSE IF (ICOR.EQ.5) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.6) THEN
XCRD=CUFX(XLBC)-DSTL/2.+DSTR/2.
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.7) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.8) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)-DSTB/2.+DSTT/2.
END IF
CALL ARGTAI (IAMA,CFUX(XCRD),CFUY(YCRD),IAAI,IAGI,3,NGRP,1)
DO 101 IGRP=1,NGRP
IF (IAAI(IGRP).LT.0) THEN
CALL CPSETC ('CTM - CHARACTER TEMPORARY',' ')
RETURN
END IF
101 CONTINUE
102 CONTINUE
END IF
C
RETURN
C
END
SUBROUTINE CPCHLL (IFLG)
C
C This routine is called by CONPACK while it is positioning line
C labels. IFLG=1 implies that it's deciding whether or not to put
C a label at ('LBX','LBY'); if we set 'CTM' = ' ', it suppresses the
C label there. IFLG=2 implies that the box around a label is being
C pre-filled, IFLG=3 that the label is being drawn, and IFLG=4 that
C the box around the label is being drawn. The negatives of these
C values imply that the associated action has just been finished.
C
C Declare a common block containing the area map being used by the
C main program to contain label boxes (so we can check to see for
C certain kinds of overlap).
C
COMMON /CB0001/ IAMA(10000),IACT
C
CHARACTER*64 CTMP
DIMENSION IAAI(3),IAGI(3)
C
IF (IACT.EQ.0) RETURN
C
IF (IAMA(5).NE.27.AND.IFLG.EQ.1) THEN
CALL CPGETC ('CTM - CHARACTER TEMPORARY',CTMP)
CALL CPGETR ('CWM - CHARACTER WIDTH MULTIPLIER',CHWM)
CALL CPGETR ('LLS - LINE LABEL SIZE',WCLL)
CALL CPGETR ('VPL - VIEWPORT LEFT EDGE',XVPL)
CALL CPGETR ('VPR - VIEWPORT RIGHT EDGE',XVPR)
WCFS=CHWM*WCLL*(XVPR-XVPL)
CALL CPGETR ('LBX - X COORDINATE OF LABEL',XLBC)
CALL CPGETR ('LBY - Y COORDINATE OF LABEL',YLBC)
CALL PCGETI ('TE - TEXT EXTENT FLAG',ISTE)
CALL PCSETI ('TE - TEXT EXTENT FLAG',1)
CALL PLCHHQ (XLBC,YLBC,CTMP(1:IOLNBC(CTMP)),WCFS,360.,0.)
CALL PCSETI ('TE - TEXT EXTENT FLAG',ISTE)
CALL PCGETR ('DL',DSTL)
CALL PCGETR ('DR',DSTR)
CALL PCGETR ('DB',DSTB)
CALL PCGETR ('DT',DSTT)
DO 102 ICOR=1,8
IF (ICOR.EQ.1) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.2) THEN
XCRD=CUFX(XLBC)-DSTL/2.+DSTR/2.
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.3) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)-DSTB
ELSE IF (ICOR.EQ.4) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)-DSTB/2.+DSTT/2.
ELSE IF (ICOR.EQ.5) THEN
XCRD=CUFX(XLBC)+DSTR
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.6) THEN
XCRD=CUFX(XLBC)-DSTL/2.+DSTR/2.
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.7) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)+DSTT
ELSE IF (ICOR.EQ.8) THEN
XCRD=CUFX(XLBC)-DSTL
YCRD=CUFY(YLBC)-DSTB/2.+DSTT/2.
END IF
CALL ARGTAI (IAMA,CFUX(XCRD),CFUY(YCRD),IAAI,IAGI,3,NGRP,1)
DO 101 IGRP=1,NGRP
IF (IAAI(IGRP).LT.0) THEN
CALL CPSETC ('CTM - CHARACTER TEMPORARY',' ')
RETURN
END IF
101 CONTINUE
102 CONTINUE
END IF
C
RETURN
C
END
FUNCTION IOLNBC (CTMP)
C
C The value of IOLNBC(CTMP), where CTMP is a variable of type character,
C is the index of the last non-blank character in CTMP.
C
CHARACTER*(*) CTMP
C
DO 101 I=LEN(CTMP),1,-1
IF (CTMP(I:I).NE.' ') THEN
IOLNBC=I
RETURN
END IF
101 CONTINUE
IOLNBC=1
RETURN
END
This archive was generated by hypermail 2b29 : Wed Jun 28 2000 - 09:45:45 MDT