SUBROUTINE HCSGEN( STRING, NCHRS ) C C This subroutine decodes a string of characters and C generates the appropriate information or graphics. C C Commands are: C C < Lower case. C > Upper case. 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. C G Change to Gothic character set. C H Advance to next line, one and a Half spacing. C I Shift down to index level. 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 On Change to Oriental character set n, n=0,1,...,9. 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 $ $ 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+ COMMON /BUFF/ INEXT, IBYE, BUFS(256,10) 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 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 - LOCATE BEGINING OF TEXT AND START OF LINE. XLINE = XENTRY YLINE = YENTRY XBASE = XENTRY YBASE = YENTRY KENTRY = KSETNO C C - CALCULATE TRANSFORMATION. CALL HCSETR( KSETNO ) 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. L = 1 IF( DIMEN ) GO TO 1 WJUST = DIMEN*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 ) 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 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 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 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 = DIMEN*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 ) 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, 202, 203, 300 ) ITIS C C - SET LOWER CASE, < 201 ICASE = 4 GO TO 100 C C - SET UPPER CASE, > 202 ICASE = 0 GO TO 100 C C - SET COMMAND CHARACTER, $ 203 CNTRL = .TRUE. GO TO 100 C C - CONSTRUCT CHARACTER. 300 CALL POINTR( STRING(I) ) C WRITE(7,310) STRING(I), NVEC, IWIDTH, DES, DEF C310 FORMAT(1X,A1,4I8) C C - DIMENSIONING OR PLOTTING? 400 IF( DIMEN ) GO TO 1200 C C - GENERATE THE CHARACTER. IF( NVEC .EQ. 0 ) GO TO 2100 COSF = COSUPT*CNVMAG SINF = SINUPT*CNVMAG XLC = XLL*CNVMAG YLC = YLL*CNVMAG CALL WAITFR(INEXT+10) DO 1000 J=1,NVEC C CALL VECTOR(IX,IY,IPEN) X = IX Y = IY IXP = XLC + X*COSF - Y*SINF IXP = IXP + IX0 IYP = YLC + X*SINF + Y*COSF IYP = IYP + IY0 IF( ( IBYE+9 ) .LT. 256 ) GO TO 500 CALL TOUT(BUFS(1,INEXT),IBYE-1,INEXT+10) INEXT = MOD( INEXT, 10 ) + 1 CALL WAITFR(INEXT+10) IBYE = 1 500 CALL ABSP(IXP,IYP,IPEN,BUFS(IBYE,INEXT),IBYE) 1000 CONTINUE IF( IBYE .EQ. 1 ) GO TO 1100 CALL TOUT(BUFS(1,INEXT),IBYE-1,INEXT+10) IBYE = 1 INEXT = MOD( INEXT, 10 ) + 1 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. IF( KSetNo .EQ. 9 ) GO TO 114 GO TO 100 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. 2400 IF( .NOT. DIMEN ) RETURN XMAX = AMAX1( XMAX, XBASE-XLINE ) WLINE( L ) = AMAX1( WLINE( L ), XBASE-XLINE ) CALL HCSETR( KENTRY ) RETURN END