SUBROUTINE FDVDLD (IENTRY,IIX,IIY) C C C +-----------------------------------------------------------------+ C | | C | Copyright (C) 1986 by UCAR | C | University Corporation for Atmospheric Research | C | All Rights Reserved | C | | C | NCARGRAPHICS Version 1.00 | C | | C +-----------------------------------------------------------------+ C C C C C SOFTWARE DASHED LINE PACKAGE WITH CHARACTER CAPABILITY AND SMOOTHING C C LATEST REVISION JUNE 1984 C C PURPOSE DASHSMTH IS A SOFTWARE DASHED LINE PACKAGE WITH C SMOOTHING CAPABILITIES. DASHSMTH IS DASHCHAR C WITH SMOOTHING FEATURES ADDED. C C USAGE FIRST, EITHER C CALL DASHDB (IPAT) C WHERE IPAT IS A 16-BIT DASH PATTERN AS C DESCRIBED IN THE SUBROUTINE DASHDB (SEE C DASHLINE DOCUMENTATION), OR C CALL DASHDC (IPAT,JCRT,JSIZE) C AS DESCRIBED BELOW. C C THEN, CALL ANY OF THE FOLLOWING: C CALL CURVED (X,Y,N) C CALL FRSTD (X,Y) C CALL VECTD (X,Y) C CALL LASTD C C LASTD IS CALLED ONLY AFTER THE LAST C POINT OF A LINE HAS BEEN PROCESSED IN VECTD. C C THE FOLLOWING MAY ALSO BE CALLED, BUT NO C SMOOTHING WILL RESULT: C CALL LINED (XA,YA,XB,YB) C C C ARGUMENTS IPAT C ON INPUT A CHARACTER STRING OF ARBITRARY LENGTH C TO DASHDC (60 CHARACTERS SEEMS TO BE A PRACTICAL C LIMIT) WHICH SPECIFIES THE DASH PATTERN C TO BE USED. A DOLLAR SIGN IN IPAT C INDICATES SOLID; AN APOSTROPHE INDICATES C A GAP; BLANKS ARE IGNORED. ANY CHARACTER C IN IPAT WHICH IS NOT A DOLLAR SIGN, C APOSTROPHE, OR BLANK IS CONSIDERED TO BE C PART OF A LINE LABEL. EACH LINE LABEL C CAN BE AT MOST 15 CHARACTERS IN LENGTH. C SUFFICIENT WHITE SPACE IS RESERVED IN THE C DASHED LINE FOR WRITING LINE LABELS. C C JCRT C THE LENGTH IN PLOTTER ADDRESS UNITS PER C $ OR APOSTROPHE. C C JSIZE C IS THE SIZE OF THE PLOTTED CHARACTERS: C . IF BETWEEN 0 AND 3 , IT IS 1., 1.5, 2. C AND 3. TIMES AN 8 PLOTTER ADDRESS UNIT C WIDTH. C . IF GREATER THAN 3, IT IS THE CHARACTER C WIDTH IN PLOTTER ADDRESS UNITS. C C C ARGUMENTS TO CURVED(X,Y,N) C OTHER LINE-DRAWING X AND Y ARE ARRAYS OF WORLD COORDINATE VALUES C ROUTINES OF LENGTH N OR GREATER. LINE SEGMENTS OBEYING C THE SPECIFIED DASH PATTERN ARE DRAWN TO C CONNECT THE N POINTS. C C FRSTD(X,Y) C THE CURRENT PEN POSITION IS SET TO C THE WORLD COORDINATE VALUE (X,Y) C C VECTD(X,Y) C A LINE SEGMENT IS DRAWN BETWEEN THE C WORLD COORDINATE VALUE (X,Y) AND THE C MOST RECENT PEN POSITION. (X,Y) THEN C BECOMES THE MOST RECENT PEN POSITION. C C LINED(XA,XB,YA,YB) C A LINE IS DRAWN BETWEEN WORLD COORDINATE C VALUES (XA,YA) AND (XB,YB). C C ON OUTPUT ALL ARGUMENTS ARE UNCHANGED FOR ALL ROUTINES. C C NOTE WHEN USING FRSTD AND VECTD, LASTD MUST BE C CALLED (NO ARGUMENTS NEEDED). LASTD SETS UP C THE CALLS TO THE SMOOTHING ROUTINES KURV1S AND C KURV2S. C C WHEN SWITCHING FROM THE REGULAR PLOTTING C ROUTINES TO A DASHED LINE PACKAGE THE FIRST C CALL SHOULD NOT BE TO VECTD. C C ENTRY POINTS DASHDB, DASHDC, CURVED, FRSTD, VECTD, LINED, C RESET, LASTD, KURV1S, KURV2S, CFVLD, FDVDLD, C DRAWPV, DASHBD C C COMMON BLOCKS INTPR, DASHD1, DASHD2, DDFLAG, DCFLAG, DSAVE1, C DSAVE2, DSAVE3, DSAVE5, CFFLAG, SMFLAG, DFFLAG, C FDFLAG C C REQUIRED LIBRARY THE ERPRT77 PACKAGE AND THE SPPS. C ROUTINES C C I/O PLOTS SOLID OR DASHED LINES, POSSIBLY WITH C CHARACTERS AT INTERVALS IN THE LINE. C THE LINES MAY ALSO BE SMOOTHED. C C PRECISION SINGLE C C LANGUAGE FORTRAN C C HISTORY WRITTEN IN OCTOBER 1973. C MADE PORTABLE IN SEPTEMBER 1977 FOR USE C WITH ALL MACHINES WHICH C SUPPORT PLOTTERS WITH UP TO 15 BIT RESOLUTION. C CONVERTED TO FORTRAN77 AND GKS IN JUNE, 1984. C C ALGORITHM POINTS FOR EACH LINE C SEGMENT ARE PROCESSED AND PASSED TO THE C ROUTINES, KURV1S AND KURV2S, WHICH COMPUTE C SPLINES UNDER TENSION PASSING THROUGH THESE C POINTS. NEW POINTS ARE GENERATED BETWEEN THE C GIVEN POINTS, RESULTING IN SMOOTH LINES. C C ACCURACY PLUS OR MINUS .5 PLOTTER ADDRESS UNITS PER CALL. C THERE IS NO CUMULATIVE ERROR. C C TIMING ABOUT THREE TIMES AS LONG AS DASHCHAR. C C C C C C C C C*********************************************************************** C C FDVDLD RECEIVES IN ITS ARGUMENTS THE POINTS TO BE PROCESSED FOR A C LINE SEGMENT. IT PASSES THESE POINTS TO THE ROUTINES KURV1S AND KURV2S C WHICH COMPUTE SPLINES UNDER TENSION PASSING THROUGH THESE POINTS. C FDVDLD THEN CALLS CFVLD TO CONNECT THE POINTS GENERATED IN KURV2S. C DIMENSION XP(70), YP(70), TEMP(70) C C THE VARIABLES IN DSAVE5 HAVE TO BE SAVED FOR THE NEXT CALL TO FDVDLD. C COMMON /DSAVE5/ XSAVE(70), YSAVE(70), XSVN, YSVN, XSV1, YSV1, 1 SLP1, SLPN, SSLP1, SSLPN, N, NSEG C C IOFFS IS AN INTERNAL PARAMETER. IT IS INITIALIZED IN DASHBD AND C REFERENCED IN FDVDLD AND DRAWPV. C COMMON /SMFLAG/ IOFFS C C IFSTF2 IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS C CALLED. C COMMON /DFFLAG/ IFSTF2 C C IFLAG CONTROLS IF LASTD CAN BE CALLED DIRECTLY OR IF IT WAS JUST C CALLED FROM BY VECTD SO THAT THIS CALL CAN BE IGNORED. C COMMON /FDFLAG/ IFLAG C C NOTE THAT THIS IFSTF2 FLAG CANNOT BE IDENTICAL TO THE IFSTFL FLAG C IN THE ROUTINE CFVLD, BECAUSE A CALL TO THE FRSTD ENTRY OF FDVDLD DOES C NOT ELIMINATE THE NECESSITY OF A CALL TO THE FRSTD ENTRY OF CFVLD, C AND REVERSE. C COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE, 1 ICLOSE SAVE C C C OTHER CONSTANTS. C DATA PI /3.14159265358/ DATA IDUMMY /0/ C C GO TO (10,15,35),IENTRY C C ************************************* C C ENTRY FRSTD (XX,YY) C 10 DEG = 180./PI C MX = IIX MY = IIY IFSTF2 = 0 SSLP1 = 0.0 SSLPN = 0.0 XSVN = 0.0 YSVN = 0.0 IF (IOFFS .GE. 1) CALL CFVLD (1,MX,MY) IF (IOFFS .GE. 1) RETURN C C INITIALIZE THE POINT AND SEGMENT COUNTER C N COUNTS THE NUMBER OF POINTS/SEGMENT C N = 0 C C NSEG = 0 FIRST SEGMENT C NSEG = 1 MORE THAN ONE SEGMENT C NSEG = 0 C C SAVE THE X,Y COORDINATES OF THE FIRST POINT C XSV1 CONTAINS THE X COORDINATE OF THE FIRST POINT C OF A LINE C YSV1 CONTAINS THE Y COORDINATE OF THE FIRST POINT C OF A LINE C XSV1 = MX YSV1 = MY GO TO 30 C C ************************************* C C ENTRY VECTD (XX,YY) C 15 CONTINUE C C TEST FOR PREVIOUS FRSTD CALL C IF (IFSTF2 .EQ. 0) GO TO 20 C C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL. C CALL SETER(' FDVDLD- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.', - 1,1) GO TO 10 20 MX = IIX MY = IIY C C VECTD SAVES THE X,Y COORDINATES OF THE ACCEPTED C POINTS ON A LINE SEGMENT C IF (IOFFS .GE. 1) CALL CFVLD (2,MX,MY) IF (IOFFS .GE. 1) RETURN C C IF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT C IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT. 1 SMALL) RETURN IFLAG = 0 30 N = N+1 C C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT C XSAVE THE ARRAY OF X COORDINATES OF LINE SEGMENT C YSAVE THE ARRAY OF Y COORDINATES OF LINE SEGMENT C XSAVE(N) = MX YSAVE(N) = MY XSVN = XSAVE(N) YSVN = YSAVE(N) IF (N .GE. L1-1) GO TO 40 RETURN C C ************************************* C C ENTRY LASTD C 35 CONTINUE IF (IFSTF2 .NE. 0) RETURN IFSTF2 = 1 C C LASTD CHECKS FOR PERIODIC LINES AND SETS UP C THE CALLS TO KURV1S AND KURV2S C IF (IOFFS .GE. 1) CALL CFVLD (3,IDUMMY,IDUMMY) IF (IOFFS .GE. 1) RETURN C C IFLAG = 0 OK TO CALL LASTD DIRECTLY C IFLAG = 1 LASTD WAS JUST CALLED FROM BY VECTD C IGNORE CALL TO LASTD C IF (IFLAG .EQ. 1) RETURN C C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE C 40 IFLAG = 1 C C IPRD = 0 PERIODIC LINE C IPRD = 1 NON-PERIODIC LINE C IPRD = 1 IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0 C C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE C IF (NSEG .GE. 1) GO TO 60 IF (N-2) 150,140,50 50 IF (N .GE. 4) GO TO 60 C IF (IPRD .NE. 0) GO TO 60 DX = XSAVE(2)-XSAVE(1) DY = YSAVE(2)-YSAVE(1) SLOPE = ATAN2(DY,DX)*DEG+90. IF (SLOPE .GE. 360.) SLOPE = SLOPE-360. IF (SLOPE .LE. 0.) SLOPE = SLOPE+360. SLP1 = SLOPE SLPN = SLOPE ISLPSW = 0 SIGMA = TENSN GO TO 100 60 SIGMA = TENSN IF (IPRD .GE. 1) GO TO 80 IF (NSEG .GE. 1) GO TO 70 C C SET UP FLAGS FOR A 1 SEGMENT, PERIODIC LINE C ISLPSW = 4 XSAVE(N) = XSV1 YSAVE(N) = YSV1 GO TO 100 C C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE C 70 SLP1 = SSLPN SLPN = SSLP1 ISLPSW = 0 GO TO 100 80 IF (NSEG .GE. 1) GO TO 90 C C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE C ISLPSW = 3 GO TO 100 C C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE C 90 SLP1 = SSLPN ISLPSW = 1 C C CALL THE SMOOTHING ROUTINES C 100 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW) C C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT C IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 110 NPRIME = FLOAT(NP)-(S*FLOAT(NP)*.5)/32767. IF (S .GE. 32767.) NPRIME = .5*FLOAT(NP) NPL = AMAX1(FLOAT(NPRIME)*S/32767.,2.5) 110 DT = 1./FLOAT(NPL) IX = IFIX (XSAVE(1)) IY = IFIX (YSAVE(1)) IF (NSEG .LE. 0) GO TO 112 CALL DRAWPV (IX,IY,0) GO TO 114 112 CONTINUE CALL CFVLD (1,IX,IY) 114 CONTINUE T = 0.0 NSLPSW = 1 IF (NSEG .GE. 1) NSLPSW = 0 NSEG = 1 CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP) C C SAVE SLOPE AT THE FIRST POINT OF THE LINE C IF (NSLPSW .GE. 1) SSLP1 = SLP NSLPSW = 0 DO 120 I=1,NPL T = T+DT TT = -T IF (I .EQ. NPL) NSLPSW = 1 CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP) C C SAVE THE LAST SLOPE OF THIS LINE SEGMENT C IF (NSLPSW .GE. 1) SSLPN = SLP C C DRAW EACH PART OF THE LINE SEGMENT C IX = IFIX(XS) IY = IFIX (YS) CALL CFVLD (2,IX,IY) 120 CONTINUE IF (IPRD .NE. 0) GO TO 130 C C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE C IX = IFIX (XSV1) IY = IFIX (YSV1) CALL CFVLD (2,IX,IY) C C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT C 130 XSAVE(1) = XS YSAVE(1) = YS N = 1 IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY) GO TO 150 C C FOR THE CASE WHEN THERE ARE ONLY 2 DISTINCT POINTS ON A LINE. C 140 IX = IFIX (XSAVE(1)) IY = IFIX (YSAVE(1)) CALL CFVLD (1,IX,IY) IX = IFIX (XSAVE(N)) IY = IFIX (YSAVE(N)) CALL CFVLD (2,IX,IY) IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY) C 150 CONTINUE RETURN END SUBROUTINE RESET C C THIS USER ENTRY POINT IS HERE ONLY FOR COMPATIBILITY WITH USE IN C THE CONREC FAMILY WHICH CALL RESET WHEN USED WITH DASHSUPR. C RETURN END SUBROUTINE DASHDC (IPAT,JCRT,JSIZE) C C C C C C COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE, 1 ICLOSE C C USER ENTRY POINT. C DASHDC GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS C SPECIFIED IN ITS ARGUMENTS. THIS INTERNAL REPRESENTATION IS PASSED C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1. C CHARACTER*(*) IPAT CHARACTER*1 IBLK, IGAP, ISOL, ICR CHARACTER*16 IPC(100) C C DASHD1 AND DASHD2 ARE USED C FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB, DASHDC AND CFVLD. C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD. C COMMON /DASHD1/ ISL, L, ISIZE, IP(100), NWDSM1, IPFLAG(100) 1 ,MNCSTR, IGP COMMON /DASHD2/ IPC C C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB AND DASHDC. C IT IS INITIALIZED IN DASHBD. C COMMON /DDFLAG/ IFCFLG C C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD) C WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED. C IT IS INITIALIZED IN DASHBD AND REFERENCED IN CFVLD. C COMMON /DCFLAG/ IFSTFL C C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED. C IT IS INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD. C COMMON /DFFLAG/ IFSTF2 C C LOCAL VARIABLES TO DASHDB AND DASHDC ARE SAVED IN DSAVE2 C FOR THE NEXT CALL C COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1 C SAVE ALL VARIABLES SAVE C C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED C C NPD IS THE NUMBER OF WORDS IN IP C DATA NPD/100/ C C INITIALIZE CHARACTER FLAGS C DATA IBLK,IGAP,ISOL/' ','''','$'/ C C +NOAO - blockdata replaced with run time initialization. C EXTERNAL DASHBD call dashbd C -NOAO C C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDC', 'VERSION 1') C C NC IS THE NUMBER OF CHARACTERS IN IPAT C NC = LEN(IPAT) IF (IFCFLG .EQ. 2) GOTO 10 C C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY C IF (MNCSTR .EQ. 15) GOTO 6 CALL SETER('DASHDC -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR 1ECTLY',1,2) 6 CONTINUE C C INITIALIZATION C MNCST1 = MNCSTR + 1 C C MASK IS AN ALL SOLID PATTERN TO BE PASSED TO OPTN (65535=177777B). C MASK=IOR(ISHIFT(32767,1),1) C C IFCFLG = 2 C C NCHRTS - NUMBER OF CHARS IN THIS HOLLERITH STRING. C L - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY. C ISL - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1). C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS C CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED. C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD C IS CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED. C 10 CONTINUE NCHRTS = 0 L = 0 ISL = 0 IFSTFL = 1 IFSTF2 = 1 C C RETRIEVE THE RESOLUTION AS SET BY THE USER. C CALL GETUSV('XF',LXSAVE) CALL GETUSV('YF',LYSAVE) C C IADJUS - TO ADJUST NUMBERS TO THE GIVEN RESOLUTION. C IADJUS = ISHIFT(1,15-LXSAVE) ICRT = JCRT*IADJUS ISIZE = JSIZE CHARW = FLOAT(ISIZE*IADJUS) IF (ISIZE .GT. 3) GO TO 30 CHARW = 256. + FLOAT(ISIZE)*128. IF (ISIZE .EQ. 3) CHARW = 768. C 30 CONTINUE IF (ICRT .LT. 1) GO TO 230 MODE = 2 C C START MAIN LOOP C C THIS LOOP GENERATES THE IP ARRAY (NEEDED BY CURVED,VECTD,ETC.) FROM C THE CHARACTER STRING IN IPAT. EACH ITERATION OF THE LOOP PROCESSES C ONE CHAR OF IPAT. A SOLID OR GAP IS CONSIDERED TO BE A TYPE 1 ENTRY, C AND A LABEL CHARACTER IS CONSIDERED TO BE A TYPE 2 ENTRY. C C IN THE CODE, L IS THE NUMBER OF CHANGES IN THE LINESTYLE (FROM GAP C TO SOLID, SOLID TO CHARACTER, ETC.) THE IP AND IPFLAG ARRAYS DESCRIBE C THE LINE TO BE DRAWN, AND THESE ARRAYS ARE INDEXED FROM 1 TO L. THE C RELATIONSHIP BETWEEN IP AND IPFLAG IS: C C IPFLAG(N) IP(N) C --------- ----- C 1 LENGTH (IN PLOTTER ADDRESS UNITS) OF SOLID LINE TO C BE DRAWN. C 0 NUMBER OF CHARACTERS TO BE PLOTTED. C -1 LENGTH (IN PLOTTER ADDRESS UNITS) OF GAP. C C THE 160 LOOP HANDLES 5 CASES: C C 1.) CONTINUE TYPE 2 ENTRY (60-80) C 2.) START TYPE 2 ENTRY (80-90) C 3.) END TYPE 2 ENTRY AND START TYPE 1 ENTRY (90-160) C 4.) START TYPE 1 ENTRY, OR SWITCH TYPE 1 ENTRY FROM SOLID TO C GAP OR FROM GAP TO SOLID (140-160) C 5.) CONTINUE TYPE 1 ENTRY (150-160) C DO 160 J=1,NC C C GET NEXT CHAR INTO ICR, RIGHT JUSTIFIED ZERO FILLED. C ICR = IPAT(J:J) C C MODE SPECIFIES WHAT THE LAST CHARACTER PROCESSED WAS: C C LAST ICR WAS $ (SOLID), MODE IS 8 C LAST ICR WAS ' (GAP), MODE IS 2 C LAST ICR WAS HOLLERITH CHAR, MODE IS 5 C C NMODE SPECIFIES WHAT THE CURRENT CHARACTER TO BE PROCESSED IS: C C ICR NMODE C --- ----- C $ 1 C CHAR 0 C ' -1 C NMODE = 0 IF (ICR .EQ. IBLK) GO TO 160 IF (ICR .EQ. IGAP) NMODE = -1 IF (ICR .EQ. ISOL) NMODE = 1 IF (L.EQ.0 .AND. NMODE.EQ.-1) MODE = 8 C C NGO DETERMINES WHERE TO BRANCH BASED ON CASE TO BE PROCESSED. C COMPUTE MODE FOR NEXT ITERATION. C NGO = NMODE+MODE MODE = NMODE*3+5 GO TO (150,80,140,90,60,90,140,80,150),NGO C C CHAR TO CHAR C C CASE 1) - CONTINUE TYPE 2 ENTRY. C 60 IF (NCHRTS .EQ. MNCSTR) GO TO 160 NCHRTS = NCHRTS + 1 IP(L) = NCHRTS IPC(L)(NCHRTS:NCHRTS) = ICR GO TO 160 C C BLANK OR SOLID TO CHAR C C CASE 2) - START STRING ENTRY. LGBSTR POINTS TO THE GAP WHICH C WILL CONTAIN THE STRING. C 80 LGBSTR = MIN0(L+1,NPD) L = MIN0(LGBSTR+1,NPD) IPFLAG(L) = 0 NCHRTS = 1 IP(L) = 1 IPC(L)(NCHRTS:NCHRTS) = ICR GO TO 160 C C CHAR TO SOLID OR GAP C C CASE 3) - END STRING ENTRY. ICR IS A $ OR '. C 90 CONTINUE IP(LGBSTR) = CHARW*(FLOAT(NCHRTS) + .5) IPFLAG(LGBSTR) = -1 IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1 C C BLANK TO SOLID OR SOLID TO BLANK C C CASE 4) - START TYPE 1 ENTRY. C 140 L = MIN0(L+1,NPD) IP(L) = 0 C C ADD TO A BLANK OR SOLID LINE C C CASE 5) - CONTINUE TYPE 1 ENTRY. ICR IS A $ OR '. C ADD ICRT UNITS TO THE PLOTTER ADDRESS UNITS IN IP(L). C NMODE INDICATES IF IT IS A GAP OR A SOLID. C 150 IP(L) = IP(L) + ICRT IPFLAG(L) = NMODE 160 CONTINUE C C IF LAST ICR PROCESSED WAS A LABEL CHARACTER, MUST END STRING C ENTRY. C IF (NGO.NE.2 .AND. NGO.NE.5 .AND. NGO.NE.8) GO TO 220 IP(LGBSTR) = CHARW*(FLOAT(NCHRTS)+.5) IPFLAG(LGBSTR) = -1 IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1 C C IF IP ARRAY HAS ONLY ONE TYPE 1 ENTRY, SET ISL FLAG. C 220 IF (L .GT. 1) RETURN IBIG = ISHIFT(1,MAX0(LXSAVE,LYSAVE)) IF (IP(L) .GE. IBIG) GO TO 230 IF (IPFLAG(L)) 240,240,230 230 ISL = 1 RETURN 240 ISL = -1 RETURN END SUBROUTINE DASHDB (IPAT) C C ARGUMENTS IPAT C ON INPUT IPAT IS A 16-BIT DASH PATTERN. BY DEFAULT C EACH BIT IN THE PATTERN REPRESENTS 3 PLOTTER C ADDRESS UNITS (1=SOLID, 0=BLANK) C C C C USER ENTRY POINT. C DASHDB GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS C SPECIFIED IN ITS ARGUMENT. THIS INTERNAL REPRESENTATION IS PASSED C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1. C DIMENSION IPAT(1) COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE, 1 ICLOSE C C DASHD1 IS FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB AND CFVLD. C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD. C COMMON /DASHD1/ ISL, L, ISIZE, IP(100), NWDSM1, IPFLAG(100) 1 ,MNCSTR, IGP C C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB. IT IS INITIALIZED IN DASHBD. C COMMON /DDFLAG/ IFCFLG C C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD) C WHENEVER DASHDB HAS BEEN CALLED. IT IS INITIALIZED IN DASHBD AND C REFERENCED IN CFVLD. C COMMON /DCFLAG/ IFSTFL C C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAS BEEN CALLED. IT IS C INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD. C COMMON /DFFLAG/ IFSTF2 C C LOCAL VARIABLES TO DASHDB ARE SAVED IN DSAVE2 FOR THE NEXT CALL TO C DASHDB. C COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1 C C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED C SAVE C C +NOAO - blockdata replaced with run time initialization. C EXTERNAL DASHBD call dashbd C -NOAO C C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDB', 'VERSION 1') IF (IFCFLG .EQ. 2) GOTO 10 C C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY C IF (MNCSTR .EQ. 15) GOTO 6 CALL SETER('DASHDB -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR 1ECTLY',1,2) 6 CONTINUE C C INITIALIZATION C MNCST1 = MNCSTR + 1 C C MASK IS AN ALL SOLID PATTERN C MASK=IOR(ISHIFT(32767,1),1) C IFCFLG = 2 C C L - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY. C ISL - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1). C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS C CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED. C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD C IS CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED. C 10 CONTINUE NCHRTS = 0 L = 0 ISL = 0 IFSTFL = 1 IFSTF2 = 1 C ICRT = IPAU*ISHIFT(1,15-10) IF (IPAT(1) .NE. 0) GO TO 260 ISL = -1 RETURN 260 IF (IPAT(1) .NE. MASK) GO TO 270 ISL = 1 RETURN 270 NMODE1 = IAND(ISHIFT(IPAT(1),-15),1) DO 290 I = 1,16 IF (NMODE1 .NE. IAND(ISHIFT(IPAT(1),I-16),1)) GO TO 280 NMODE1 = 1 - NMODE1 L = L + 1 IP(L) = 0 IPFLAG(L) = 1 - 2*NMODE1 280 IP(L) = IP(L) + ICRT 290 CONTINUE RETURN END SUBROUTINE DRAWPV (IX,IY,IND) C C DRAWPV INTERCEPTS THE CALL TO PLOTIT TO CHECK IF THE PEN HAS TO BE C MOVED OR IF IT IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION. C IF IND=2 NEVER MOVE PEN, JUST UPDATE VARIABLES IXSTOR AND IYSTOR. C C IN IXSTOR AND IYSTOR THE CURRENT POSITION OF THE PEN IS SAVED. C COMMON /DSAVE3/ IXSTOR,IYSTOR C COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE, 1 ICLOSE SAVE IIND = IND + 1 GOTO (100,90,105), IIND C 90 CONTINUE C C DRAW LINE AND SAVE POSITION OF PEN. C IXSTOR = IX IYSTOR = IY CALL PLOTIT (IXSTOR,IYSTOR,1) GOTO 110 C 100 CONTINUE C C CHECK IF PEN IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION. C DIFF = FLOAT(IABS(IXSTOR-IX)+IABS(IYSTOR-IY)) IF (DIFF .LE. FLOAT(ICLOSE)) GO TO 110 C IXSTOR = IX IYSTOR = IY CALL PLOTIT (IXSTOR,IYSTOR,0) GOTO 110 C 105 CONTINUE C C DO NOT MOVE PEN. JUST UPDATE VARIABLES IXSTOR AND IYSTOR. C IXSTOR = IX IYSTOR = IY C 110 CONTINUE C RETURN END C SUBROUTINE CFVLD (IENTRY,IIX,IIY) C C CFVLD CONNECTS POINTS WHOSE COORDINATES ARE SUPPLIED IN THE ARGUMENTS, C ACCORDING TO THE DASH PATTERN WHICH IS PASSED FROM ROUTINE DASHDB C OR DASHDC IN THE COMMON-BLOCK DASHD1. C CHARACTER*16 IPC(100) C COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE, 1 ICLOSE C C THE VARIABLES IN DASHD1 AND DASHD2 ARE USED FOR COMMUNICATION WITH C DASHDC AND DASHDB. C COMMON /DASHD1/ ISL, L, ISIZE, IP(100), NWDSM1, IPFLAG(100) 1 ,MNCSTR, IGP COMMON /DASHD2/ IPC C C THE VARIABLES IN DSAVE1 HAVE TO BE SAVED FOR THE NEXT CALL TO CFVLD. C COMMON /DSAVE1/ X,Y,X2,Y2,X3,Y3,M,BTI,IB,IX,IY C C THE FLAGS IFSTFL AND IVCTFG ARE INITIALIZED IN THE BLOCK DATA DASHBD. C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED. C IVCTFG IS A FLAG TO INDICATE IF CFVLD IS BEING CALLED FROM VECTD OR C LASTD. C COMMON /DCFLAG/ IFSTFL COMMON /CFFLAG/ IVCTFG SAVE C C C CMN IS USED TO DETERMINE WHEN TO STOP DRAWING A LINE SEGMENT C DATA CMN/1.5/ C C IMPOS IS USED AS AN IMPOSSIBLE PEN POSITION. C DATA IMPOS /-9999/ C C C ISL= -1 ALL BLANK ) FLAG TO AVOID MOST CALCULATIONS C 0 DASHED ) IF PATTERN IS ALL SOLID OR C 1 ALL SOLID ) ALL BLANK C C X,IX,Y,IY CURRENT POSITION C X1,Y1 START OF A USER LINE SEGMENT C X2,Y2 END OF A USER LINE SEGMENT C X3,Y3 START OF A GAP PATTERN SEGMENT C C SYMBOLS,IF PRESENT ARE CENTERED IN AN IMMEDIATLY PRECEEDING C GAP SEGMENT, OR DONE AT THE CURRENT POSITION OTHERWISE C C SEGMENT TYPES ARE RECOGNIZED AS FOLLOWS C SOLID - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING C ELEMENT IN IPFLAG IS 1. C GAP - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING C ELEMENT IN IPFLAG IS -1. C SYMBOL - WORD IN IP-ARRAY CONTAINS CHARACTER REPRESENTATIONS. C CORRESPONDING ELEMENT IN IPFLAG IS 0. C SYMBOL COUNT FOR CHAR STRING IN CHAR NUMBER MNCSTR+1. C THE IP ARRAY AND THE IPFLAG ARRAY ARE COMPOSED OF L ELEMENTS. C C BTI - BITS THIS INCREMENT C BPBX,BPBY BITS PER BIT X(Y) C C C BRANCH DEPENDING ON FUNCTION TO BE PERFORMED. C GO TO (330,305,350),IENTRY C C INITIALIZE VARIABLES (ENTRY FRSTD ONLY) C 30 CONTINUE X = IX Y = IY X2 = X X3 = X Y2 = Y Y3 = Y M = 1 IB = IPFLAG(1) IF (IPFLAG(1) .NE. 0) GO TO 40 IB = 0 BTI = 0 40 CONTINUE BTI = FLOAT(IP(1))*FPART GO TO 300 C C MAIN LOOP START C 50 CONTINUE X1 = X2 Y1 = Y2 MX = IIX MY = IIY X2 = MX Y2 = MY DX = X2-X1 DY = Y2-Y1 D = SQRT(DX*DX+DY*DY) IF (D .LT. CMN) GO TO 190 60 BPBX = DX/D BPBY = DY/D CALL DRAWPV (IX,IY,0) 70 BTI = BTI-D IF (BTI) 100,100,80 C C LINE SEGMENT WILL FIT IN CURRENT PATTERN ELEMENT C 80 X = X2 Y = Y2 IX = X2 IY = Y2 IF (IB) 200,160,90 90 CALL DRAWPV (IX,IY,1) GO TO 200 C C LINE SEGMENT WONT FIT IN CURRENT PATTERN ELEMENT C DO IT TO END OF ELEMENT, SAVE HOW MUCH OF SEGMENT LEFT TO DO (D) C 100 BTI = BTI+D D = D-BTI X = X+BPBX*BTI Y = Y+BPBY*BTI IX = X+.5 IY = Y+.5 IF (IB) 110,160,120 110 CALL DRAWPV (IX,IY,0) GO TO 130 120 CALL DRAWPV (IX,IY,1) C C GET THE NEXT PATTERN ELEMENT C 130 M = MOD(M,L)+1 IB = IPFLAG(M) IF (IB) 140,160,150 140 X3 = X Y3 = Y BTI = FLOAT(IP(M)) GO TO 70 150 X3 = -1. BTI = FLOAT(IP(M)) GO TO 70 C C CHARACTER GENERATION C 160 S = 0. IF (IGP .NE. 9) GO TO 162 C DX = X-X3 DY = Y-Y3 GO TO 164 C 162 CONTINUE DX = X - X1 DY = Y - Y1 164 CONTINUE C IF (DY) 170,180,170 170 S = ATAN2(DY,DX) IF (ABS(S-.00005) .GT. 1.5708) S = S-SIGN(3.14159,S) 180 IF (IGP .NE. 9) GO TO 182 C MX = X3 + DX*.5 MY = Y3 + DY*.5 LIGP = 0 GO TO 184 C 182 CONTINUE MX = X MY = Y LIGP = 1 C 184 CONTINUE IS = IFIX(S*180./3.14 + .5) IF (IS .LT. 0) IS = 360+IS CALL GETUSV('XF',LXSAVE) CALL GETUSV('YF',LYSAVE) MX = ISHIFT (MX,LXSAVE-15) MY = ISHIFT(MY,LYSAVE-15) CALL WTSTR(CPUX(MX),CPUY(MY),IPC(M)(1:IP(M)),ISIZE,IS,LIGP) CALL DRAWPV (IMPOS,IMPOS,2) CALL DRAWPV (IX,IY,0) GO TO 130 190 X2 = X1 Y2 = Y1 200 CONTINUE C C EXIT IF CALL WAS TO VECTD. C IF (IVCTFG .NE. 2) GO TO 210 IVCTFG = 1 GO TO 300 C C EXIT IF NOT PLOTTING A GAP C 210 IF (IB .GE. 0) GO TO 300 C C MUST BE IN A GAP AT END OF LASTD. EXIT IF NOT A LABEL GAP. C MO = M M = MOD(M,L) + 1 IF (IPFLAG(M) .NE. 0) GO TO 300 C C CHECK PREVIOUS PLOTTED ELEMENT. WAS IT A GAP OR A LINE. C MPREV = M - 2 IF (MPREV .LE. 0) MPREV = MPREV + L IB = IPFLAG(MPREV) IF (IB .GE. 0) GO TO 250 C C PREVIOUS ELEMENT WAS A GAP - LOOK FOR NEXT LINE. C EXIT IF NO LINES IN PATTERN. C 230 CONTINUE 240 M = MOD(M,L)+1 IF (M .EQ. MO) GO TO 300 IB = IPFLAG(M) IF (IB .EQ. 0) GOTO 245 BTI = FLOAT(IP(M)) 245 CONTINUE C C IF IP(M) NOT A LINE, CONTINUE LOOKING. C IF (IB) 240,230,280 C C PREVIOUS ELEMENT WAS A LINE - LOOK FOR NEXT GAP. C IF NO NON-LABEL GAPS IN PATTERN, GO TO 290. C 250 CONTINUE 260 M = MOD(M,L)+1 IF (M .EQ. MO) GO TO 290 IB = IPFLAG(M) IF (IB .EQ. 0) GOTO 265 BTI = FLOAT(IP(M)) 265 CONTINUE C C IF IP(M) NOT A GAP, CONTINUE LOOKING. C IF (IB) 270,250,260 C C FOUND A GAP. IF ITS A LABEL GAP, GO LOOK FOR NEXT GAP. C 270 MT = M M = MOD(M,L)+1 IF (IPFLAG(M) .EQ. 0) GO TO 250 M = MT C C M POINTS TO NEXT ELEMENT TO PLOT. SET UP AND GO PLOT. C 280 X1 = X3 Y1 = Y3 X = X3 Y = Y3 IX = X+0.5 IY = Y+0.5 DX = X2-X1 DY = Y2-Y1 D = SQRT(DX*DX+DY*DY) IF (D .GE. CMN) GO TO 60 GO TO 300 C C NO NON-LABEL GAPS IN THE PATTERN - FILL IN WITH SOLID LINE. C 290 IX = X3+0.5 IY = Y3+0.5 CALL DRAWPV (IX,IY,0) IX = X2 IY = Y2 CALL DRAWPV (IX,IY,1) 300 RETURN C C ************************************* C C ENTRY VECTD (XX,YY) C 305 CONTINUE C C TEST FOR PREVIOUS CALL TO FRSTD. C IF (IFSTFL .EQ. 2) GO TO 310 C C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL. C CALL SETER ('CFVLD -- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.', - 1,1) GO TO 330 310 K = 1 IVCTFG = 2 IF (ISL) 300,50,320 320 IX = IIX IY = IIY CALL DRAWPV (IX,IY,1) GO TO 300 C C ************************************* C C ENTRY FRSTD (FLDX,FLDY) C 330 IX = IIX IY = IIY IFSTFL = 2 C AVOID UNEXPECTED PEN POSITION IF CALLS TO SYSTEM PLOT PACKAGE C ROUTINES WERE MADE. CALL DRAWPV (IMPOS,IMPOS,2) IF (ISL) 300,30,340 340 CALL DRAWPV (IX,IY,0) GO TO 300 C C ************************************* C C ENTRY LASTD C 350 CONTINUE C C TEST FOR PREVIOUS CALL TO FRSTD C IF (IFSTFL .NE. 2) GO TO 300 IFSTFL = 1 K = 1 IF (ISL .NE. 0) GO TO 300 GO TO 210 END SUBROUTINE FRSTD (X,Y) C USER ENTRY PPINT. CALL FL2INT (X,Y,IIX,IIY) CALL FDVDLD (1,IIX,IIY) RETURN END SUBROUTINE VECTD (X,Y) C USER ENTRY POINT. CALL FL2INT (X,Y,IIX,IIY) CALL FDVDLD (2,IIX,IIY) RETURN END SUBROUTINE LASTD C USER ENTRY POINT. SEE DOCUMENTATION FOR PURPOSE. DATA IDUMMY /0/ CALL FDVDLD (3,IDUMMY,IDUMMY) C C FLUSH PLOTIT BUFFER C CALL PLOTIT(0,0,0) RETURN END SUBROUTINE CURVED (X,Y,N) C USER ENTRY POINT. C DIMENSION X(N),Y(N) C CALL FRSTD (X(1),Y(1)) DO 10 I=2,N CALL VECTD (X(I),Y(I)) 10 CONTINUE C CALL LASTD C RETURN END SUBROUTINE LINED (XA,YA,XB,YB) C USER ENTRY POINT. C DATA IDUMMY /0/ CALL FL2INT (XA,YA,IXA,IYA) CALL FL2INT (XB,YB,IXB,IYB) C CALL CFVLD (1,IXA,IYA) CALL CFVLD (2,IXB,IYB) CALL CFVLD (3,IDUMMY,IDUMMY) C RETURN C C------REVISION HISTORY C C JUNE 1984 CONVERTED TO FORTRAN77 AND GKS C C DECEMBER 1979 ADDED REVISION HISTORY AND STATISTICS C CALL C C----------------------------------------------------------------------- C END