SUBROUTINE SYMBOL(XZ,YZ,HGT,ITEXT,ANGLE,NC) C C NAME: SYMBOL C C LANGUAGE: FORTRAN C C OPERATING SYSTEM: UNIVERSAL C C ORDER NUMBER: 5428-SE C C PART NUMBER: 000-026366 NOVEMBER 1985 C C PRODUCT: UNIVERSAL VERSAPLOT COLOR RANDOM 2.0 C C VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051 C A XEROX COMPANY C C Copyright (C) 1985 by Xerox Corporation. All rights reserved. C C "NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC, C INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED C LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO C PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE C REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE C THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF C VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE C AGREEMENT. THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER C THE COPYRIGHT ACT OF 1976." C C C REVISION HISTORY: C REV. B 5/ 8/84 STORE ADJUSTED HEIGHT OF CENTERED C SYMBOL IN HTC C C 10/12/84 SUPPORT DATA STANDARDS COPY COUNT C C REV. C 2/05/85 INCLUDED CODE FOR CHARACTER COUNT AND C BYTE COUNT NEEDED FOR PRISM C C 2/21/85 BOUNDING RECTANGLE COMPUTED DIFFERENTLY. C IT NOW WORKS EVEN IF THE USER'S PLOT C IS MIRRORED. C C CODE TO DO Y-STRIPPING HAS BEEN INCLUDED C XTEXT IS CALLED IF THE STRING CROSSES A C PAGE BOUNDARY. C C CODE TO DO DEFINED PENS HAS BEEN ADDED. C IF THE CURRENT PEN IS DEFINED AS ON-OFF- C ON-OFF THEN XTEXT IS CALLED. C C 7/02/85 BOUNDING RECTANGLE COMPUTED DIFFERENTLY. C IT NOW WORKS EVEN IF THE USER'S PLOT C IS SCALED (DISTORTED) DIFFERENTLY IN THE C X AND Y DIRECTIONS. C C C SYMBOL - OUTPUT TEXT C C SUBROUTINE SYMBOL CONFORMS TO CONVENTIONAL PEN PLOTTER C DESCRIPTIONS AND MAY BE USED TO PLOT ALPHANUMERIC C ANNOTATIONS AT VARIOUS ANGLES AND SIZES. SPECIAL C CHARACTERS NOT INCLUDED IN THE STANDARD CHARACTER C SET OF THE COMPUTER MAY ALSO BE PRODUCED. C C C THIS VERSION OF SUBROUTINE SYMBOL HAS SPECIAL CODE TO ENABLE C VERSAPLOT RANDOM TO PLOT BEYOND 13.65' WITH A MODEL 710/780 REP. C IF THE USER HAS SPECIFIED A PLOT GREATER THAN 13.65' AND THE C REP IS THE TARGET OUTPUT DEVICE, EACH SYMBOL CALL CHECKED TO C SEE IF IT CROSSES A 13.65' (OR MULTIPLES OF 13.65') BOUNDARY. C SUBROUTINE XTEXT IS CALLED TO PROCESS ANY CALLS THAT CROSS C A PAGE BOUNDARY. C C ENTRY: CALL SYMBOL(X,Y,HGT,ITEXT,ANGLE,NC) C C X,Y - THE STARTING COORDINATE FOR THE LOWER LEFT-HAND C CORNER OF THE FIRST CHARACTER TO BE PRODUCED. C THE X AND Y PARAMETERS MAY CONTAIN THE SPECIAL C VALUE 999.0. IN THIS CASE, THE ANNOTATION IS C CONTINUED AT THE NEXT AVAILABLE CHARACTER C POSITION AFTER THE LAST CALL TO SYMBOL. NOTE C THAT BOTH THE NUMBER AND LINE SUBROUTINES MAKE C INTERNAL CALLS TO SYMBOL AND MAY LEAVE THE NEXT C CHARACTER POSITION AT AN UNEXPECTED LOCATION. C THE 999.0 VALUE MAY BE APPLIED TO EITHER X OR Y C PARAMETER SEPERATELY. NOTE, HOWEVER, THAT THIS C MAY GENERATE UNEXPECTED RESULTS, ESPECIALLY IF C A NEW ANGLE IS SPECIFIED. C HGT - IS THE CHARACTER HEIGHT SPECIFICATION (IN INCHES). C ITEXT - IS THE ALPHANUMERIC TEXT TO BE GENERATED. C +NC - ITEXT CONTAINS THE ALPHANUMERIC TEXT STRING C TO BE PLOTTED IN COMPUTER DEPENDENT C INTERNAL FORMAT(ASCII, EBCDIC, DISPLAY C CODE AND SO FORTH). THE CHARACTERS MUST C BE CONTIGUOUS IN ITEXT AND LEFT JUSTIFIED. C NC=0 - ITEXT CONTAINS A SINGLE, RIGHT JUSTIFIED C ALPHANUMERIC CHARACTER TO BE PLOTTED. C -NC - ITEXT DEFINES THE INTEGER SYMBOL NUMBER TO C BE PLOTTED. IF ITEXT IS ONE OF THE C SPECIAL CENTERED SYMBOLS (0-13) IT IS C PLOTTED WITH THE X,Y REFERENCE POINT AS C THE GEOMETRIC CENTER OF THE SYMBOL. C ITEXT MAY BE AN ARRAY. C ANGLE - THE ANGLE, IN DEGREES THAT THE TEXT IS ROTATED C ABOUT THE REFERENCE POINT BEFORE IT IS PLOTTED, C MEASURED COUNTERCLOCKWISE FROM THE HORIZONTAL C (0.0 IS HORIZONTAL, 90.0 IS VERTICAL). C C NC - THE NUMBER OF CHARACTERS TO BE PLOTTED FROM THE C TEXT STRING ITEXT. MAXIMUM OF 508 CHARACTERS C MAY BE INCLUDED IN A SINGLE STRING. C C NC>0 ALPHA TEXT, NUMBER OF CHARACTER TO BE PLOTTED C NC=0 INDICATES THAT ITEXT CONTAINS A SINGLE, C RIGHT-JUSTIFIED CHARACTER TO BE PLOTTED. C NC=-1 SPECIFIES THAT THE 'PEN' IS TO BE UP DURING C INITIAL MOVE FROM THE PRESENT PEN POSITION C TO (X,Y). C NC<-1 SPECIFIES THAT THE 'PEN' IS TO BE DOWN C DURING THE INITIAL MOVE FROM THE PRESENT C POSITION TO (X,Y). C C NOTE: IF THE STARTING COORDINATES (XZ,YZ) ARE NOT IN THE C CLIPPING WINDOW, THE NUMBER OF CLIPPED ELEMENTS IS C INCREMENTED AND THE CALL IS IGNORED. C C VERSAPLOT RANDOM DOES NOT CLIP TEXT STRINGS TO THE C CLIPPING WINDOW. C C EXIT: RETURN C C CALLS: MSGLG1,OCHUNK,OCODE,IRAM,PLOT,XTEXT C C CALLED BY: AXIS,NUMBER,USER C C COMMON USED: C /DVCOM/ C I ANC - HOLD PREVIOUS SYMBOL CALL ANGLE VALUE C L DASHPN - .TRUE. IFF THE CURRENT PEN IS DEFINED AS C AN ON-OFF-ON-OFF PATTERN C I HTC - HOLD PREVIOUS SYMBOL CALL HEIGHT VALUE C I ILWP - (LINE WIDTH - 1)/2 C L IPDEF() - .TRUE. IF PEN HAS BEEN DEFINED C I JFONT - CURRENT FONT INDEX C I JPEN - THE CURRENT PEN NUMBER C I MSB - WORD TO SET HIGH ORDER BIT DETERMINED BY C PRECISION (16/32) SELECTED. C I NCLIP - NUMBER OF CLIPPED VECTORS C I PFONT - INDEX FOR RPM STROKE COUNT FOR CURRENT FONT C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C I RADN - DEGREES TO RADIAN ANGLE CONVERSION FACTOR C R RORG() - AN X,Y PAIR WHICH DEFINES THE CURRENT C SOFTWARE ORIGIN. SET BY REORIGIN CALL C TO *PLOT* C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C R SXC - PREVIOUS SYMBOL CALL X COORDINATE C R SYC - PREVIOUS SYMBOL CALL Y COORDINATE C R TCOSA - PREVIOUS SYMBOL CALL COSINE OF ANGLE C R TSINA - PREVIOUS SYMBOL CALL SINE OF ANGLE C R VCP() - CURRENT POINT IN COMPUTATIONAL COORDINATES C R WTV() - WINDOW TRANSFORMATION VARIABLES. USED TO C TRANSFORM COORDINATES FROM THE VIEW WINDOW C SYSTEM TO THE VIEWPORT SYSTEM C I XNIPS - NUMBER OF NIBS PER PAGE IN THE X-DIRECTION C I YNIPS - NIBS PER SCAN C /VRFCOM/ C R BYTKNT()- BYTE COUNT FOR EACH COLOR C R DRWKNT - BYTE COUNT FOR A DRAW COMMAND C I IBXMAX - MAXIMUM X VALUE (USED FOR BANDING) C R VRFKNT()- COUNTER FOR RANDOM ELEMENTS C I ICOMD() - INTEGER ARRAY TO HOLD 16/32 BIT VRF C COMMANDS, INITIALIZED IN PLOTS C R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT C OBJKNT(1) - VECTORS C OBJKNT(2) - POLYGONS C OBJKNT(3) - CIRCLES C OBJKNT(4) - CHARACTERS C C /MSGCOM/ C I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS C R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS C C /CLRCOM/ C I ITNSEQ()- TONING SEQUENCE FOR OUTPUT C I IVCFLG - FLAG TO INDICATE COLOR MODE SET C I NCPASS - NUMBER OF COLOR PASSES C L PENCHG - FLAG TO INDICATE PEN COLOR CHANGED C C /PRMCOM/ C I IFONT - DEFAULT FONT PATTERN NUMBER. C I KREP - TARGET OUTPUT CONTROLLER C = 0 - UNKNOWN C = 1 - REP CONTROLLER C = 4 - RPM CONTROLLER C L VSTRP - .TRUE. IFF Y-STRIPPING ENABLED C /KLCOM/ C L KFLAG - FLAG INDICATING REP OUTPUT AND .GT. 13.65' C PLOTTING REQUIRED. C I KSIZE - VARIABLE DEFINING 13.65' IN SCANS, USED TO C DETERMINE IF ELEMENT CROSSES A 13.65' PAGE C BOUNDARY. C C LOCAL VARIABLES USED: C R COUNT - BYTE COUNT FOR THE CHARACTER STRING C R CHRKNT - ARRAY WITH COUNT OF CHARACTER STROKES C I ICURPN - INDEX INTO DEFINED PEN ARRAY C I MASKS - MASK FOR OBTAINING THE CHARACTER VALUE C L SAME - ANGLE/HEIGHT SAME AS PREVIOUS CALL C I ICHAR - CHARACTER TO OUTPUT C I IX,IY - CURRENT NIB COORDINATES C I NCC - WORKING CHARACTER COUNT C I NIBX - BASE-LINE COORDINATES C I NIBY - BASE-LINE COORDINATES C R X - WORKING X COORDINATE C R Y - WORKING Y COORDINATE C R CHT - COMPOSITE CHARACTER HEIGHT C R HT - WORKING CHARACTER HEIGHT C R AN - WORKING CHARACTER ANGLE C R ANGL - TEMPORARY ANGLE IN RADIANS C R TLINE - LENGTH OF CHARACTER STRING C I ITCHAR - TEMPORARY TEXT VARIABLE C I INDXC - CHARACTER VALUE USED AS AN INDEX TO CHRKNT C R STROKS - THE STROKES IT TAKES TO DRAW A CHARACTER C LOGICAL SAME C LOGICAL ROT90,PMOVE,IPDEF,DASHPN,XMAJOR,VSFLAG INTEGER PWIDTH,XNIPS,YNIPS,PENPAT,VSMAX,PFONT C... COMMON /DVCOM/ PHASE I COMMON VARIABLES C COMMON /DVCOM/ * ANC, DASHPN, FACT, HTC, ICUT, ICWTV, ICXPTS, * IEOJ, ILWM, ILWP, IOPEN, ISORT, ITFLAG, IX1, * IX2, IY1, IY2, JFONT, JPEN, KPAT, KWIDTH, * LASTX, LASTY, MAXPAT, MSB, MSKALL, NCH, NCLIP, * NIBSX, NLPAT, NPLOT, PFONT, PMOVE, PXMIN, PXMAX, * PYMIN, PYMAX, RADN, ROT90, SXC, SYC, TSINA, * TCOSA, XDEN, XFAC, XNIPS, XOFF, YDEN, YFAC, * YOFF, YNIPS, VSFLAG, VSMAX, XMAJOR, * IPAT(16,256), IEOP(4), IHBUF(2), IPDEF(64), * NPAT(255), PENPAT(4,64), PWIDTH(64), * RORG(2), VCP(2), VP(4), WIN(4), WTV(4), WX(4), WY(4), * IAUTXT(15) C C C C... COMMON /VRFCOM/ - VRF COMMON VARIABLES C INTEGER PRECIS INTEGER OBUF COMMON /VRFCOM/ * DRWELM, DRWMAX, DRWMIN, DRWKNT, ICOPY, * ICNSTX, IBXMAX, IHDCNT, MIN, * NBYTS, NCHUNK, NHEAD, NREC, PRECIS, * RMXELM, VRFMAX, * BYTKNT(4), IBEGIN(4), ICOMD(2), IOCODE(2), IREC(4), * MAX(4), NEXTO(4), OBJKNT(4), VRFKNT(4), OBUF(640) C C... COMMON /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) C C C... COMMON /CLRCOM/ - COLOR VARIABLES C INTEGER PCOLOR, CURPEN LOGICAL PENCHG COMMON /CLRCOM/ * ICLMAX, ITNCLR, ITNFLG, IVCFLG, NCPASS, PENCHG, * CURPEN(4), ICLRDF(4,512), IDASRT(4), ITNSEQ(4), * PCOLOR(64) C C... COMMON /PRMCOM/ - DEFAULT PLOTTING PARAMETERS C INTEGER PENTBL,BMODEL,BBYTES,CMODEL,CBYTES LOGICAL VSTRP COMMON /PRMCOM/ * IBYTES, IDISK, IFFAP, LASTFF, * IJPEN, INHNCE, INITFF, INVERS, * IRDT, ISPACE, ISPEED, ISFLAG, * IUSER, JBYTES(75), KREP, IFONT, * MIRROR, MODEL, MODL(75), MXPEN, * NCOPY, NMODL, PENTBL(64,2), RDEN, * RDENS(75), SCALE, UNITS, XFACT, * YFACT, XSTART, YSTART, * VXMIN, VXMAX, VYMIN, VYMAX, * WXMIN, WXMAX, WYMIN, WYMAX, * BMODEL, BDEN, BBYTES, * CMODEL, CDEN, CBYTES, * IDEFLG(256), IUCLR, MODE1, IPRISM(61), * MUXOUT, PMSIZE, MAXPEN, KTWO, * LTNFLG, LTNCLR, MTAPE, VSTRP, * JSORT, JCPCMD, JCUT, KDISK C C... COMMON /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C DIMENSION IXBR(4),IYBR(4) DIMENSION CHRKNT(128,6) DIMENSION CH1KNT(128),CH2KNT(128),CH3KNT(128) DIMENSION CH4KNT(128),CH5KNT(128),CH6KNT(128) EQUIVALENCE (CHRKNT(1,1),CH1KNT(1)) EQUIVALENCE (CHRKNT(1,2),CH2KNT(1)) EQUIVALENCE (CHRKNT(1,3),CH3KNT(1)) EQUIVALENCE (CHRKNT(1,4),CH4KNT(1)) EQUIVALENCE (CHRKNT(1,5),CH5KNT(1)) EQUIVALENCE (CHRKNT(1,6),CH6KNT(1)) DIMENSION VCPSAV(2) C DIMENSION ITEXT(1) C C... TEXT COMMAND (X'8901') DATA ICMD/35073/ C C TABLE OF THE NUMBER OF STROKES IT TAKES TO DRAW C EACH CHARACTER IN THE CHARACTER TABLE. C DATA MASKS /127/ C C THIS TABLE IS FOR THE DEFAULT FONT. C DATA CH1KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3., + 9., 6., 5., 3., 7., 1., 1., 0., 2., 3., + 4., 0., 3., 3., 1., 0., 1., 7., 5., 2., + 5.,10., 0., 4., 6.,10.,11., 9., 9., 3., + 3., 3., 4., 2., 5., 1., 4., 1., 8., 3., + 8.,12., 3., 9.,10., 4.,15.,10., 8., 9., + 2., 2., 2.,11.,15., 7.,11., 7., 6., 5., + 4.,10., 3., 3., 5., 3., 2., 4., 3., 9., + 6., 9., 7.,12., 2., 5., 2., 4., 2., 3., + 4., 3., 1., 3., 2., 1., 8., 8., 8., 3., + 9., 9., 7., 0., 8., 4.,13.,11., 0., 0., + 0., 0., 4., 9., 3., 3., 3., 3., 3., 1., + 5., 4., 0., 0., 4., 2., 4., 4./ C C 2ND FONT - SIMPLEX C DATA CH2KNT /0., 0., 0., 0., 0., 0., 0., 0., 0., 0., + 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., + 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., + 0., 0., 0., 5., 2., 4.,21.,26.,33., 1., + 9., 9., 3., 2., 7., 1., 4., 1.,16., 3., + 13.,14., 3.,16.,22., 2.,28.,22., 8.,11., + 2., 2., 2.,17.,25., 3.,18.,17.,12., 4., + 3.,19., 3., 1., 9., 3., 2., 4., 3.,20., + 10.,21.,11.,19., 2., 9., 2., 4., 2., 3., + 3., 4., 1., 4., 7., 1., 3.,14.,14.,13., + 14.,16., 5.,19., 7., 5., 8., 3., 1.,13., + 7.,16.,14.,14., 5.,16., 5., 7., 2., 4., + 2., 6., 3.,34., 1.,34.,12., 0./ C C 3RD FONT - FRENCH C DATA CH3KNT /0., 0., 0., 0., 0., 0., 0., 0., 0., 0., + 0., 0., 0., 0., 0., 0.,16.,15.,15.,30., + 18.,17.,17.,32.,18., 3.,17.,18.,32., 9., + 8.,23., 0., 5., 2., 4.,21.,26.,33., 1., + 9., 9., 3., 2., 7., 1., 4., 1.,16., 3., + 13.,14., 3.,16.,22., 2.,28.,22., 8.,11., + 2., 2., 2.,17.,25., 3.,18.,17.,12., 4., + 3.,19., 3., 1., 9., 3., 2., 4., 3.,20., + 10.,21.,11.,19., 2., 9., 2., 4., 2., 3., + 3., 4., 1., 4., 7., 1., 3.,14.,14.,13., + 14.,16., 5.,19., 7., 5., 8., 3., 1.,13., + 7.,16.,14.,14., 5.,16., 5., 7., 2., 4., + 2., 6., 3.,34., 1.,34.,12., 0./ C C 4TH FONT - SWEDISH C DATA CH4KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3., + 9., 6., 5., 3., 7., 1., 1., 0., 2., 3., + 4., 0., 3., 3., 1., 0., 1., 7., 5., 2., + 5.,10., 0., 4., 6.,10.,11., 9., 9., 3., + 3., 3., 4., 2., 5., 1., 4., 1., 8., 3., + 8.,12., 3., 9.,10., 4.,15.,10., 8., 9., + 2., 2., 2.,11.,15., 7.,11., 7., 6., 5., + 4.,10., 3., 3., 5., 3., 2., 4., 3., 9., + 6., 9., 7.,12., 2., 5., 2., 4., 2., 3., + 4.,15.,16.,11.,13., 1., 8., 8., 8., 3., + 9., 9., 7., 0., 8., 4.,13.,11., 0., 0., + 0., 0., 4., 9., 3., 3., 3., 3., 3., 1., + 5., 4., 0., 0., 4., 2., 4., 4./ C C 5TH FONT - GERMAN C DATA CH5KNT /5., 9., 4., 2., 2., 5., 4., 3., 4., 3., + 8., 4., 4., 1., 7., 1., 1., 0., 8., 3., + 19., 0., 3., 3., 8., 0., 6., 3., 3., 1., + 10., 6., 0., 5., 2., 4.,12.,17.,14., 1., + 5., 5., 4., 2., 2., 1., 4., 1.,12., 2., + 8.,13., 3., 9.,13., 3.,23.,13., 8., 6., + 2., 2., 2.,11.,18., 3.,13., 7., 8., 4., + 3., 9., 3., 1., 4., 3., 2., 4., 3.,12., + 8.,13., 9.,13., 2., 7., 2., 4., 2., 3., + 3.,11.,20.,15., 2., 1., 1., 9., 8., 7., + 8.,11., 4.,11., 5., 5., 7., 3., 1., 6., + 5.,12., 8., 8., 4.,11., 2., 5., 2., 4., + 2., 3., 3.,17.,20.,13.,10., 7./ C C 6TH FONT - NORWEGIAN C DATA CH6KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3., + 9., 6., 5., 3., 7., 1., 1., 0., 2., 3., + 4., 0., 3., 3., 1., 0., 1., 7., 5., 2., + 5.,10., 0., 4., 6.,10.,11., 9., 9., 3., + 3., 3., 4., 2., 5., 1., 4., 1., 8., 3., + 8.,12., 3., 9.,10., 4.,15.,10., 8., 9., + 2., 2., 2.,11.,15., 7.,11., 7., 6., 5., + 4.,10., 3., 3., 5., 3., 2., 4., 3., 9., + 6., 9., 7.,12., 2., 5., 2., 4., 2., 3., + 4., 6., 9.,11., 2., 1., 8., 8., 8., 3., + 9., 9., 7., 0., 8., 4.,13.,11., 0., 0., + 0., 0., 4., 9., 3., 3., 3., 3., 3., 1., + 5., 4., 0., 0., 4., 2., 4., 4./ C C C-D DEBUG MESSAGE C RELARG(1)=XZ C RELARG(2)=YZ C RELARG(3)=HGT C INTARG(1)=ITEXT(1) C RELARG(4)=ANGLE C INTARG(2)=NC C CALL MSGLG1(87) C-D C C C C C... CHECK FOR SPECIAL X,Y=999 CALL X = XZ Y = YZ IF (X.EQ.999.0) X = SXC IF (Y.EQ.999.0) Y = SYC C C... READ USER-SUPPLIED HEIGHT AND ANGLE HT = HGT AN = ANGLE C C... ADJUST HEIGHT IF CENTERED SYMBOL IF (ITEXT(1).LE.13.AND.ITEXT(1).GE.0) HT = HT/0.57 C C... CHECK HEIGHT FOR HT=0 SPECIAL CALL IF (HT.GT.0.0) GO TO 20 HT = HTC AN = ANC C C... SET FLAG IF ANGLE/HEIGHT SAME AS PREVIOUS CALL. C (CHECK WHETHER SET-FONT-BASELINE COMMAND NEEDS TO BE C OUTPUT AGAIN.) 20 SAME = .FALSE. IF (ANC .EQ. AN .AND. HTC .EQ. HT .AND. (.NOT. PENCHG)) * SAME = .TRUE. PENCHG = .FALSE. C C... SAVE CALLERS VALUES HTC = HT ANC = AN SXC = X SYC = Y C C... ADJUST FOR REORIGIN X = X + RORG(1) Y = Y + RORG(2) C ANGL = AN C C... ADJUST FOR ROTATION IF (.NOT.ROT90) GO TO 25 TMP = X X = -Y Y = TMP ANGL = ANGL + 90.0 25 CONTINUE C C... CHECK FOR ANGLE > 360. OR ANGLE < 0. DEGREES ANGL = AMOD(ANGL,360.0) IF (ANGL.LT.0.0) ANGL = ANGL + 360.0 C C... CONVERT TO RADIANS, COMPUTE TRIG FUNCTIONS ANGL = ANGL * RADN TSINA = SIN(ANGL) TCOSA = COS(ANGL) C C... GET CHARACTER COUNT NCC = NC C C... CHECK IF SINGLE-SYMBOL CALL IF (NCC.LE.0) NCC = 1 C C... CHECK FOR MAXIMUM CHARACTER COUNT EXCEEDED IF (NCC.GT.508) NCC = 508 C C... COMPUTE THE ENDPOINT OF THE STRING. C C THE RESULT OF THIS COMPUTATION IS WHAT WOULD BE THE ENDPOINT OF C THE STRING IF IT WERE SCALED AND MIRRORED CORRECTLY. C IF THE USER CHANGES HIS WINDOW, VIEWPORT, OR SCALING FACTORS, C THEN RANDOM MAY NOT PLOT THE STRING WITH THE CORRECT C ORIENTATION. THE STARTING POINT OF THE STRING WILL ALWAYS BE C CORRECT, BUT THE STRING MAY NOT BE MIRRORED OR SCALED CORRECTLY. C THEREFORE, THE POINT CALCULATED HERE MAY NOT ALWAYS CORRESPOND C TO THE ACTUAL ENDPOINT OF THE STRING THAT IS PLOTTED. C C IF THE USER DOES NOT MIRROR OR SCALE HIS PLOT, OR IF THE STRING C IS PLOTTED BY CALLING XTEXT, THEN THE ENDPOINT COMPUTED HERE C CORRESPONDS TO THE ENDPOINT OF THE STRING THAT IS PLOTTED. C VCPSAV(1) = X VCPSAV(2) = Y IF (ITEXT(1).LE.13.AND.ITEXT(1).GE.0) GO TO 26 VCPSAV(1) = VCPSAV(1) + HT * NCC * TCOSA VCPSAV(2) = VCPSAV(2) + HT * NCC * TSINA 26 CONTINUE C C******************************************************************* C C... COMPUTE COMPOSITE HEIGHT TMP = TSINA * ABS(WTV(1)) * TSINA * ABS(WTV(1)) TMP = TMP + (TCOSA * ABS(WTV(3)) * TCOSA * ABS(WTV(3))) C***** C THE CURRENT VRF DATA STANDARDS DO NOT SUPPORT AN ASPECT C RATIO TO BE SPECIFIED FOR TEXT OUTPUT. IF THE USER CHANGES C THE PLOT SCALING FACTORS (XFACT,YFACT,VIEWPORT,WINDOW) TO C A NON ONE-TO-ONE RATIO, THE TEXT OUTPUT MAY APPEAR TO BE C PLOTTED IN THE WRONG POSITION. ACTUALLY THE TEXT STARTING C POSITION IS CORRECT, HOWEVER THE ENDING POINT IS INCORRECT C DUE TO THE TEXT BEING PLOTTED ON A ONE-TO-ONE RATIO (HEIGHT C AND WIDTH SAME DIMENSION). C C THE PREVIOUS TWO LINES OF CODE CAN BE REPLACED WITH THE C FOLLOWING TWO LINES TO COMPUTE THE CORRECT COMPOSITE WIDTH C FOR THE CHARACTER STRING. THIS WILL NOW PLOT THE TEXT TO C THE CORRECT LENGTH AND ENDING POINT, HOWEVER THE TEXT HEIGHT C WILL BE LARGER OR SMALLER THAN SPECIFIED. C C TMP = TSINA * ABS(WTV(3)) * TSINA * ABS(WTV(3)) C TMP = TMP + (TCOSA * ABS(WTV(1)) * TCOSA * ABS(WTV(1))) C***** CHT = HT * SQRT (TMP) C C... COMPUTE NEW ANGLE ANGL = ATAN2 ((TSINA*ABS(WTV(3))),(TCOSA*ABS(WTV(1)))) TSINA = SIN(ANGL) TCOSA = COS(ANGL) C C... COMPUTE BASE LINE VECTOR NIBX = (CHT * 8.0 * TCOSA) NIBY = (CHT * 8.0 * TSINA) C C... CHECK IF BASELINE TOO LARGE IF (KREP .EQ. 4 .AND. PRECIS .EQ. 32) GO TO 27 IF (NIBX .LE. 32767 .AND. NIBY .LE. 32767 .AND. * NIBX .GE. -32768 .AND. NIBY .GE. -32768) GO TO 27 IF (JFONT .EQ. 0) GO TO 900 CALL MSGLG1(131) GO TO 998 C 27 CONTINUE C C... CHECK IF BASELINE SAME AS PREVIOUS CALL IF (SAME) GO TO 29 C C... OUTPUT SET-FONT BASELINE COMMAND CALL OCHUNK (ICOMD(2),0) C C... OUTPUT BASELINE COORDINATES CALL OCHUNK (NIBX,-1) CALL OCHUNK (NIBY,-1) C C... CHECK IF OUTSIDE PLOTTING WINDOW 29 CALL OCODE (X,Y,KCODE) IF (KCODE .EQ. 0) GO TO 30 C C... OUTSIDE WINDOW, IGNORE CALL NCLIP = NCLIP + 1 C-D C... DEBUG MESSAGE - UNPLOTTABLE TEXT C RELARG(1)=XZ C RELARG(2)=YZ C CALL MSGLG1(88) C-D GO TO 998 C 30 CONTINUE C C... CHECK IF TEXT IS DRAWN WITH A DASHED PEN IF (.NOT. DASHPN) GO TO 31 IF (JFONT .EQ. 0) GO TO 900 CALL MSGLG1(132) C C... COMPUTE NIB COORDINATES 31 IX = X * WTV(1) + WTV(2) IY = Y * WTV(3) + WTV(4) C C... COMPUTE VALUES USED TO CALCULATE THE BOUNDING RECTANGLE IDX = (41*NIBX+167)/168 IDY = (41*NIBY+167)/168 C C... INITIALIZE OFFSETS FOR STRIPPED TEXT IXOFF = 0 IYOFF = 0 C C... IS Y-STRIPPING CHECK REQUIRED? IF (.NOT. VSTRP) GO TO 40 C C... COMPUTE Y-VALUES OF THE BOUNDING RECTANGLE IYBR(1) = IY - ( (8*(NIBX+NIBY)+167) / 168 ) IYBR(2) = IYBR(1) + (NCC-1)*((NIBY+7)/8) + IDY IYBR(3) = IYBR(2) + IDX IYBR(4) = IYBR(1) + IDX C C... DETERMINE MAXIMUM AND MINIMUM Y-VALUES IYMIN = MIN0 (IYBR(1),IYBR(2),IYBR(3),IYBR(4)) IYMAX = MAX0 (IYBR(1),IYBR(2),IYBR(3),IYBR(4)) C C... ADJUST FOR PEN WIDTH IYMIN = IYMIN - ILWM IYMAX = IYMAX + ILWP C C... CHECK IF THE TEXT LIES IN THE FIRST STRIP IF (IYMIN .LT. YNIPS .AND. IYMAX .LT. YNIPS) GO TO 40 C C... CHECK IF THE TEXT CROSSES A STRIPPING BOUNDARY IPAGE1 = IYMIN / YNIPS IPAGE2 = IYMAX / YNIPS IF (IPAGE1 .EQ. IPAGE2) GO TO 39 IF (JFONT .EQ. 0) GO TO 900 CALL MSGLG1(133) C C... THE TEXT LIES WITHIN A STRIP, BUT NOT THE FIRST STRIP. C COMPUTE THE OFFSETS FOR THE PROPER STRIP. 39 IXOFF = IPAGE1 * XNIPS IYOFF = IPAGE1 * YNIPS C 40 CONTINUE C C C... COMPUTE X-VALUES OF THE BOUNDING RECTANGLE IXBR(1) = IX + IXOFF + ( (8*(NIBY-NIBX)+167) / 168 ) IXBR(2) = IXBR(1) + (NCC-1)*((NIBX+7)/8) + IDX IXBR(3) = IXBR(2) - IDY IXBR(4) = IXBR(1) - IDY C C... DETERMINE MAXIMUM X-VALUE IXMAX = MAX0 (IXBR(1),IXBR(2),IXBR(3),IXBR(4)) C C... ADJUST FOR PEN WIDTH IXMAX = IXMAX + ILWP C C... IS X-STRIPPING CHECK REQUIRED? IF (.NOT. KFLAG) GO TO 50 C C... IF PRISM, CHECK THE LENGTH OF THE LONGEST POSSIBLE STROKE IF (KREP .NE. 4) GO TO 45 IF ( (IABS(IDX)+IABS(IDY)) .LT. KSIZE) GO TO 50 IF (JFONT .EQ. 0) GO TO 900 CALL MSGLG1(131) GO TO 998 C C... DETERMINE MINIMUM X-VALUE 45 IXMIN = MIN0 (IXBR(1),IXBR(2),IXBR(3),IXBR(4)) IXMIN = IXMIN - ILWM C C... COMPUTE PAGE BOUNDARIES IPAGE1 = (IXMIN + 8)/KSIZE IF (IPAGE1 .LT. 0) IPAGE1 = 0 IPAGE2 = (IXMAX + 8)/KSIZE C C... CHECK IF TEXT CROSSES PAGE BOUNDARY IF (IPAGE1.NE.IPAGE2) GO TO 900 C 50 CONTINUE C C... CHECK IF PEN-DOWN INITIAL DRAW IF (NC .GT. -2) GO TO 55 C C... INITIAL DRAW CALL PLOT (XZ,YZ,+2) GO TO 60 C C... OUTPUT MOVE COMMAND 55 CALL OCHUNK (IX+IXOFF,-1) CALL OCHUNK (IY-IYOFF,-1) C C... COMPUTE NUMBER OF 16 BIT WORDS TO OUTPUT 60 KNT = (NCC+1)/2 C C... OUTPUT TEXT COMMAND JCMD = ICMD + KNT CALL OCHUNK(JCMD,0) C C... OUTPUT CHARACTER COUNT CALL OCHUNK(NCC,0) I = 0 IF (NC .GT. 0) GO TO 70 C C... HANDLE SINGLE CHARACTER/INTEGER NUMBER ICHAR = IRAM (ITEXT(1),-8,MSKALL) CALL OCHUNK (ICHAR,0) GO TO 100 70 I = I + 1 ICHAR = IRAM(ITEXT(I),16,MSKALL) CALL OCHUNK(ICHAR,0) KNT = KNT - 1 IF (KNT .EQ. 0) GO TO 100 CALL OCHUNK(ITEXT(I),0) KNT = KNT - 1 IF (KNT .EQ. 0) GO TO 100 GO TO 70 C C... UPDATE IBXMAX 100 IF (IXMAX.GT.IBXMAX) IBXMAX = IXMAX C C TAKE EACH CHARACTER AND MASK OUT THE VALUE OF THE C CHARACTER. THIS VALUE IS THE INDEX INTO CHRKNT. THIS C VALUE TIMES DRWKNT IS THE COUNT VALUE USED TO DETERMINE C... THE BYTE COUNT. INDXC IS INCREMENTED BECAUSE SYMBOLS C... GO FROM 0 TO 127. COUNT = 0. C C... CHECK FOR SINGLE RIGHT-JUSTIFIED/INTEGER CALL IF (NC .LE. 0) GO TO 116 C K = 0 KNT = 1 110 K = K + 1 KSHFT = 32 115 KSHFT = KSHFT - 8 INDXC = IRAM (ITEXT(K),KSHFT,MASKS) STROKS = CHRKNT(INDXC+1,PFONT) COUNT = COUNT + STROKS*DRWKNT IF (KNT .EQ. NCC) GO TO 118 KNT = KNT + 1 IF (KSHFT .EQ. 0) GO TO 110 GO TO 115 C 116 INDXC = AND (ITEXT(1),MASKS) COUNT = CHRKNT(INDXC+1,PFONT)*DRWKNT 118 CONTINUE C C... UPDATE ELEMENT COUNT, 1 FOR EVERY 4 CHARS. + 1 DO 120 IBND = 1,NCPASS IF (ITNSEQ(IBND) .GE. 0) GO TO 120 VRFKNT(IBND) = VRFKNT(IBND) + FLOAT((NCC-1)/4 + 4) BYTKNT(IBND) = BYTKNT(IBND) + COUNT 120 CONTINUE C C... COUNT THE CHARACTERS OBJKNT(4) = OBJKNT(4) + FLOAT(NCC) C GO TO 998 C C... CALL XTEXT TO STROKE OUT THE STRING 900 CALL XTEXT (SXC,SYC,HT,ITEXT,AN,NC) C C... UPDATE THE CURRENT POSITION 998 VCP(1) = VCPSAV(1) VCP(2) = VCPSAV(2) PMOVE = .TRUE. C C... SAVE CURRENT POSITION SXC = VCP(1) SYC = VCP(2) C C... CONVERT POSITION TO USER'S COORDINATE SYSTEM IF (.NOT.ROT90) GO TO 999 TMP = SYC SYC = -SXC SXC = TMP C 999 SXC = SXC - RORG(1) SYC = SYC - RORG(2) C RETURN END