C Primitive plotting routine interface to the Hershey character set. C This provides the standard SYMBOL and SYMBOC subroutines which C then use the Hershey character set routines to draw characters. C The output of these routines is in the form of calls to PLOT, C which plots the pen strokes for each character. This subroutine C PLOT must be provided for the appropriate output device. C In addition PLOTS must be called before and PLOTF after plotting. C SUBROUTINE SYMBOL (X, Y, HEIGHT, TEXT, ANGLE, NCHARS) C C This draws the character string TEXT using the Hershey character set. C Note that programs using this must be built overlaid to work. C CALL SYMBOC (X, Y, HEIGHT, TEXT, ANGLE, NCHARS, -1) RETURN END SUBROUTINE SYMBOC (X, Y, HEIGHT, TEXT, ANGLE, NCHARS, ICENTR) C C This draws the character string TEXT using the Hershey character set. C It just translates the parameters to HCSGEN. C ICENTR is the usual centering parameter, -1 for left, 0 for center, C and +1 for right justified. In addition, for this routine only, C if given a larger number on a call with nchars=0, it will use that C code for the new default character set (usually 3). C DATA KSETD /3/ !DEFAULT CHARACTER SET C IF (NCHARS .EQ. 0 .AND. ICENTR .GT. 1) KSETD = ICENTR IF (NCHARS .EQ. 0) RETURN IF (NCHARS .GT. 0) GO TO 100 C C DRAW PLOTTING SYMBOLS VIA SYMBOS C IF (NCHARS .EQ. -2) CALL PLOT (X, Y, 2) !DRAW LINE TO SYMBOL CALL SYMBOS (X, Y, HEIGHT, TEXT) !DRAW SPECIAL SYMBOL IF (NCHARS .EQ. -2) CALL PLOT (X, Y, 3) !MOVE TO CENTER OF SYMBOL RETURN C C DRAW REGULAR CHARACTERS VIA HCSGEN C 100 CALL HCSGEN (TEXT, NCHARS, X, Y, HEIGHT, ANGLE, KSETD, ICENTR) RETURN END SUBROUTINE HCSGEN (STRING, NCHRS, XIN, YIN, 1 HEIGHT, ANGLE, KSET, ICENTR) C C This is a modified version of HCSGEN, the fortran program which C generates characters from the Hershey character set. It has been C modified from the 1980 Symposium distribution to be directly C callable, and to perform centering in one call instead of two. C C David Villeneuve, Feb 1985. C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-9975 C C STRING is ascii string of characters to plot, C NCHARS is number of characters, C XIN,YIN are coordinates of start in inches, C ANGLE is angle in degrees ccw from horizontal C HEIGHT is character height in inches, C KSET is default character set to use. C ICENTR=-1 for left justified, 0 for centred and +1 for right justified. C C These variables are in common block ENTRY: C XMAX, YMAX, YMIN are returned as the maximum extent of the string C in inches from the starting point. C C C This subroutine decodes a string of characters and C generates the appropriate information or graphics. C C Commands are: C C { Shift to superscript level or back to normal level C } Shift to subscript level or back to normal level C (e.g. 6.2 x 10{23} or x}sub{) C C When preceded by the control character ($) these characters C produce the following results. C C A Shift up to above division line. C B Shift down to below divison line. C C Advance to the next line, single spacing. C D Shift down to first level subscript. C E Shift up to exponent level (smaller than superscript) C G Change to GREEK character set for next character only. C (Also chooses between simplex or complex depending on entry set) C H Advance to next line, one and a Half spacing. C I Shift down to index level (smaller than subscript). C J Jump back to last level command position. C L Shift down to second level subscript. C M Change to Math character set. C N Shift to normal level. C R Restore position. C S Save position. C T Advance to next line, double spacing. C U Shift up to superscript level. C V Generate a vector/mean value bar between occurences, ($V...$V). C W Change to script character set. C X Return to entry character set. C Generates a half-space. C n Change to character set n, n=3,4,...,29. C . Generate a "Bullet". C * Generate a five pointed star "Bullet". C / Generate a division line between occurences, ($/...$/). C \ End of text. C - Underline between occurences, ("$-...$-"). C = Double underline between occurences, ("$=...$="). C $ $ C C N. B. If switched to character set 9, the program will switch back C to the entry character set after any character is referenced, i.e. C to get an integral sign from character set 9 and then return to the C entry character set, you need only type: $9I not $9I$X. C Ditto for $G. C+ COMMON /ENTRY/ XENTRY, YENTRY, DIMEN, XMAX, YMAX, YMIN COMMON /HCDB/ ICASE, NVEC, IWIDTH, LL0, LL0D, SCALE, SCALED, 1 COSUPC, SINUPC, COSUPD, SINUPD, COSUPT, SINUPT, DES, DEF COMMON /HCS/ XLINE, YLINE, XBASE, YBASE, MAJLVL, MINLVL, 1 XLL, YLL, SIZEF, COSUPF, SINUPF, SIZEC, XDIV, YDIV, 1 XSAVE, YSAVE, MAJSAV, MINSAV, 1 XSNGLE, YSNGLE, MAJSNG, MINSNG, 1 XDBLE, YDBLE, MAJDBL, MINDBL, 1 XVEX, YVEX, MAJVEX, MINVEX COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax, 1 Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3, 1 CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj INTEGER DES, DEF LOGICAL DIMEN LOGICAL*1 BUFS LOGICAL GREEK, SHIFTD C- DIMENSION DISLIN(3), WLINE(40) LOGICAL CNTRL, DIVIDE, SINGLE, DOUBLE, VEXBAR LOGICAL*1 STRING(1) DATA DISLIN/ -2., -2.75, -3.25/, DTR/.0174533/ C C COPY PARAMETERS INTO COMMON VARIABLES C XENTRY = XIN YENTRY = YIN CSIZE = HEIGHT UPSILN = ANGLE C C SET SOME CONSTANTS IN COMMON THAT WE DON'T USE MUCH C CNVRSN = 1.0 CNVMAG = 1.0 CMAG = 1.0 WidAdj = 1.0 C C DECIDE IF A DIMENSIONING PASS IS REQUIRED BEFORE PLOTTING C DIMEN = .FALSE. IF (ICENTR .GE. 0) DIMEN = .TRUE. C C - LOCATE BEGINING OF TEXT AND START OF LINE. C 50 XLINE = XENTRY YLINE = YENTRY XBASE = XENTRY YBASE = YENTRY KENTRY = KSET C C - CALCULATE TRANSFORMATION. CALL HCSETR( KSET ) SIZEF = CSIZE*CMAG UP = UPSILN*DTR IF( DIMEN ) UP = 0. COSUP = COS( UP ) SINUP = SIN( UP ) COSUPF = COSUP*SIZEF SINUPF = SINUP*SIZEF C C - SET DEFAULT AND ENTRY CONDITIONS. MAJLVL = 0 MINLVL = 0 CALL NEWLVL( MAJLVL, MINLVL ) ICASE = 0 DIVIDE = .FALSE. SINGLE = .FALSE. DOUBLE = .FALSE. VEXBAR = .FALSE. CNTRL = .FALSE. XSAVE = XBASE YSAVE = YBASE MAJSAV = 0 MINSAV = 0 XJUMP = XBASE YJUMP = YBASE MAJJMP = 0 MINJMP = 0 XMAX = 0. YMAX = 0. YMIN = 0. SHIFTD = .FALSE. GREEK = .FALSE. L = 1 IF( DIMEN ) GO TO 1 WJUST = (ICENTR+1) * WLINE( L )/2. XBASE = XBASE - WJUST*COSUP YBASE = YBASE - WJUST*SINUP CALL NEWLVL( MAJLVL, MINLVL ) GO TO 2 1 WLINE( L ) = 0. C C - EXECUTE STRING. 2 I = 0 100 I = I + 1 IF( I .GT. NCHRS .OR. STRING(I) .EQ. 0 ) GO TO 2300 C IF( .NOT. CNTRL ) GO TO 200 CNTRL = .FALSE. C C - DECODE CHARACTER AND EXECUTE COMMAND. CALL ITWAS( STRING(I), 1 'AUNDLBEI12O3456789MGWSRCHT.*/\-=JVX <>$', 38, ITIS ) GO TO ( 101,101,101,101,101,101, 102,102, 1 103,103,103,103,103,103,103,103,103,103,103,103,103, 1 104, 105, 106,106,106, 107, 108, 109, 2300, 110, 111, 1 112, 113, 114, 115, 300,300,300, 100 ) ITIS C C - SET NEW MAJOR LEVEL, AUNDLB 101 MAJLVL = 3-ITIS MINLVL = 0 CALL NEWLVL( MAJLVL, MINLVL ) XJUMP = XBASE YJUMP = YBASE MAJJMP = MAJLVL MINJMP = MINLVL SHIFTD = .FALSE. IF (MAJLVL .NE. 0) SHIFTD = .TRUE. GO TO 100 C C - SET NEW MINOR LEVEL, EI 102 MINLVL = 15-2*ITIS CALL NEWLVL( MAJLVL, MINLVL ) XJUMP = XBASE YJUMP = YBASE MAJJMP = MAJLVL MINJMP = MINLVL GO TO 100 C C - SET NEW CHARACTER SET, 123456789MGW 103 IF (ITIS .EQ. 20) GO TO 1035 ITSET = ITIS-8 IF( ITSET .GE. 4 ) GO TO 1031 I = I + 1 CALL ITWAS( STRING(I), '0123456789', 10, ITIS ) ITSET = 10*ITSET + ITIS 1031 CALL HCSETR( ITSET-1 ) SIZEF = CSIZE*CMAG COSUPF = COSUP*SIZEF SINUPF = SINUP*SIZEF CALL NEWLVL( MAJLVL, MINLVL ) GO TO 100 1035 ITSET = 8 !COMPLEX GREEK IF (KSET .EQ. 3) ITSET = 5 !SIMPLEX GREEK GREEK = .TRUE. !ITS GREEK TO ME GO TO 1031 C C - SAVE POSITION, S 104 XSAVE = XBASE YSAVE = YBASE MAJSAV = MAJLVL MINSAV = MINLVL GO TO 100 C C - RESTORE POSITION, R 105 XMAX = AMAX1( XMAX, XBASE-XLINE ) WLINE( L ) = AMAX1( WLINE(L), XBASE-XLINE ) XBASE = XSAVE YBASE = YSAVE MAJLVL = MAJSAV MINLVL = MINSAV CALL NEWLVL( MAJLVL, MINLVL ) GO TO 100 C C - ADVANCE LINE, COT 106 ILINE = ITIS-23 IF( DIVIDE ) CALL HORLIN( XDIV, YDIV, 0, 0, .5 ) IF( SINGLE ) CALL HORLIN( XSNGLE, YSNGLE, MAJSNG, MINSNG, -.5 ) IF( VEXBAR ) CALL HORLIN( XVEX, YVEX, MAJVEX, MINVEX, 1.25 ) IF( .NOT. DOUBLE ) GO TO 1061 CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.45 ) CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.55 ) 1061 XMAX = AMAX1( XMAX, XBASE-XLINE ) IF( DIMEN ) WLINE( L ) = AMAX1( WLINE(L), XBASE-XLINE ) XLINE = XLINE - DISLIN( ILINE )*SINUPF YLINE = YLINE + DISLIN( ILINE )*COSUPF XBASE = XLINE YBASE = YLINE IF( DIMEN ) GO TO 1063 WJUST = (ICENTR+1)*WLINE( L+1 )/2. XBASE = XBASE - WJUST*COSUP YBASE = YBASE - WJUST*SINUP 1063 MAJLVL = 0 MINLVL = 0 CALL NEWLVL( MAJLVL, MINLVL ) XJUMP = XBASE YJUMP = YBASE MAJJMP = MAJLVL MINJMP = MINLVL XSAVE = XBASE YSAVE = YBASE XDIV = XBASE YDIV = YBASE XSNGLE = XBASE YSNGLE = YBASE XDBLE = XBASE YDBLE = YBASE XVEX = XBASE YVEX = YBASE L = L + 1 IF( DIMEN ) WLINE( L ) = 0. GO TO 100 C C - CONSTRUCT "BULLET", . 107 CALL BULLET GO TO 100 C C - CONSTRUCT FIVE POINTED STAR "BULLET", * 108 CALL STAR GO TO 100 C C - CONSTRUCT DIVISION LINE, / 109 IF( DIVIDE ) GO TO 1091 DIVIDE = .TRUE. XDIV = XBASE YDIV = YBASE GO TO 100 1091 DIVIDE = .FALSE. CALL HORLIN( XDIV, YDIV, 0, 0, .5 ) GO TO 100 C C - CONSTRUCT SINGLE UNDERLINE, - 110 IF( SINGLE ) GO TO 1101 SINGLE = .TRUE. XSNGLE = XBASE YSNGLE = YBASE MAJSNG = MAJLVL MINSNG = MINLVL GO TO 100 1101 SINGLE = .FALSE. CALL HORLIN( XSNGLE, YSNGLE, MAJSNG, MINSNG, -.5 ) GO TO 100 C C - CONSTRUCT DOUBLE UNDERLINE, = 111 IF( DOUBLE ) GO TO 1111 DOUBLE = .TRUE. XDBLE = XBASE YDBLE = YBASE MAJDBL = MAJLVL MINDBL = MINLVL GO TO 100 1111 DOUBLE = .FALSE. CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.45 ) CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.55 ) GO TO 100 C C - JUMP BACK TO LAST LEVEL CHANGE, J 112 XMAX = AMAX1( XMAX, XBASE-XLINE ) WLINE( L ) = AMAX1( WLINE( L ), XBASE-XLINE ) XBASE = XJUMP YBASE = YJUMP MAJLVL = MAJJMP MINLVL = MINJMP CALL NEWLVL( MAJLVL, MINLVL ) GO TO 100 C C - CONSTRUCT VECTOR/MEAN LINE BAR, V 113 IF( VEXBAR ) GO TO 1131 VEXBAR = .TRUE. XVEX = XBASE YVEX = YBASE MAJVEX = MAJLVL MINVEX = MINLVL GO TO 100 1131 VEXBAR = .FALSE. CALL HORLIN( XVEX, YVEX, MAJVEX, MINVEX, 1.25 ) GO TO 100 C C - RETURN TO ENTRY CHARACTER SET. 114 CALL HCSETR( KENTRY ) SIZEF = CSIZE*CMAG COSUPF = COSUP*SIZEF SINUPF = SINUP*SIZEF CALL NEWLVL( MAJLVL, MINLVL ) GREEK = .FALSE. GO TO 100 C C - GENERATE A HALF-SPACE. 115 CALL POINTR( STRING(I) ) IWIDTH = IWIDTH/2 GO TO 400 C C - CHECK FOR COMMAND CHARACTERS. 200 CALL ITWAS( STRING(I), '{}$', 3, ITIS ) GO TO ( 201, 201, 203, 300 ) ITIS C C - SHIFT UP OR DOWN CODE, { OR } 201 ITIS = ITIS*2 !2 FOR $U, 4 FOR $D IF (SHIFTD) ITIS = 3 !3 FOR $N TO REVERT TO NORMAL LEVEL GO TO 101 C C - SET COMMAND CHARACTER, $ 203 CNTRL = .TRUE. GO TO 100 C C ********************************************************************** C - CONSTRUCT CHARACTER. C ********************************************************************** C 300 CALL POINTR( STRING(I) ) C WRITE (5,310) STRING(I), NVEC, IWIDTH, DES, DEF, ICASE, LL0, LL0D C310 FORMAT (' HCSGEN - after POINTR ', A1,7I5) C C - DIMENSIONING OR PLOTTING? 400 IF( DIMEN ) GO TO 1200 C C - GENERATE THE CHARACTER. C IF( NVEC .EQ. 0 ) GO TO 2100 COSF = COSUPT*CNVMAG SINF = SINUPT*CNVMAG XLC = XLL*CNVMAG YLC = YLL*CNVMAG DO 1000 J=1,NVEC CALL VECTOR(IX,IY,IPEN) X = IX Y = IY XP = XLC + X*COSF - Y*SINF XP = XP + IX0 YP = YLC + X*SINF + Y*COSF YP = YP + IY0 C WRITE (5,99) IX, IY, IPEN, XP, YP C99 FORMAT (' VECTOR', 3I5 / ' PLOT', 2F7.2) CALL PLOT (XP, YP, IPEN) 1000 CONTINUE 1100 GO TO 2200 C C - DIMENSION THE CHARACTER. 1200 MAXIY = 0 MINIY = 0 IF( NVEC .EQ. 0 ) GO TO 2100 C DO 2000 J=1,NVEC CALL VECTOR(IX,IY,IPEN) MAXIY = MAX0( MAXIY, IY ) 2000 MINIY = MIN0( MINIY, IY ) C 2100 YMAX = AMAX1( YMAX, YLL + MAXIY*COSUPT ) YMIN = AMIN1( YMIN, YLL + MINIY*COSUPT ) C C - SET WIDTH. 2200 XWIDTH = IWIDTH*COSUPT*WidAdj YWIDTH = IWIDTH*SINUPT*WidAdj XLL = XLL + XWIDTH YLL = YLL + YWIDTH XBASE = XBASE + XWIDTH YBASE = YBASE + YWIDTH C C - CHANGE BACK TO ENTRY SET IF PRESENT SET IS #09. OR $G GREEK IF( (KSetNo .EQ. 9) .OR. GREEK ) GO TO 114 GO TO 100 C C************************************************************************** C END OF INPUT STRING, FINISH UP C************************************************************************** C 2300 IF( DIVIDE ) CALL HORLIN( XDIV, YDIV, 0, 0, .5 ) IF( SINGLE ) CALL HORLIN( XSNGLE, YSNGLE, MAJSNG, MINSNG, -.5 ) IF( VEXBAR ) CALL HORLIN( XVEX, YVEX, MAJVEX, MINVEX, 1.25 ) IF( .NOT. DOUBLE ) GO TO 2400 CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.45 ) CALL HORLIN( XDBLE, YDBLE, MAJDBL, MINDBL, -.55 ) C C - IF ONLY DIMENSIONING, RETURN TO ENTRY CONDITIONS. C 2400 IF( .NOT. DIMEN ) RETURN XMAX = AMAX1( XMAX, XBASE-XLINE ) WLINE( L ) = AMAX1( WLINE( L ), XBASE-XLINE ) CALL HCSETR( KENTRY ) DIMEN = .FALSE. GO TO 50 !DO SECOND PASS END