SUBROUTINE HCGHIT C C This subroutine obtains a pen hit from the tablet C and decodes it into either the proper MENU selection C or a point in the CHARACTER COORDINATE SYSTEM (CCS). C+ COMMON /PLTR/ ILun,IDev,IsTerm,IMode,IXMax,IYmax, 1 Cnvrsn,CMag,CnvMag,IX0,IY0,KSetNo,IFancy,IBfDv3, 1 CSize,DeltaH,DeltaV,Upsiln,CosUP,SinUP COMMON /HCDB/ ICASE, NVEC, IWIDTH, LL0, LL0D, SCALE, SCALED, 1 COSUPC, SINUPC, COSUPD, SINUPD, COSUPT, SINUPT, DES, DEF COMMON /ETC/ NEWDO, OLDDO, DFAULT, MAPIN(128), SCALEF, 1 NVCTRS(90), NCHAR, IVCTRS(800), ITIS, H, HD, TABFAC, 2 ISETAV, TRNFRM, TABON, YWRITE, CHMIN, CHMAX, XMENU, YMENU, 3 XC, YC, XCH, YCH, IPEN, COSTH, SINTH, XTAB0, YTAB0, 4 IXTAB, IYTAB, ICHAR, ISET(2) DIMENSION ISCALE(2) INTEGER OLDDO LOGICAL DFAULT, TRNFRM, TABON LOGICAL*1 ICHAR, ISET EQUIVALENCE ( SCALE, ISCALE ) C- LOGICAL*1 IANS INTEGER GINDO(11) DATA GINDO/ 1, 2, 4, 5, 5, 6, 7, 8, 9, 12, 13/ C C - USE GIN? IF(( IsTerm .NE. 6 ).OR.(.NOT.TABON)) GO TO 800 C C - GET PEN HIT. 100 NHIT = 1 CALL TABLET( XTAB, YTAB, NHIT ) IF( NHIT .EQ. 1 ) GO TO 200 C C - INTERPRET NO HIT AS FINISH. NEWDO = 5 RETURN C C - CONVERT INTO SCREEN UNITS. 200 XS = XTAB/3. YS = YTAB/3. C C - MENU SELECTION? IF( XS .LT. XMENU ) GO TO 300 IF( YS .GT. YMENU + 2.5 ) GO TO 300 IF( ( XS .GT. XMENU + 3 ) .OR. 1 ( YS .LT. YMENU ) .OR. 1 ( YS .GT. YMENU + 2.5 ) ) GO TO 100 C C - OBTAIN MENU CODE. NEWDO = 5*IFIX( ( XS-XMENU )/1. ) + 1 5 - IFIX( ( YS-YMENU )/.5 ) RETURN C C - CONVERT TO CCS UNITS. 300 IF( TABON ) GO TO 400 XC = XS - XCH YC = YS - YCH IXTAB = XC/SCALEF + SIGN( .5, XC ) IYTAB = YC/SCALEF + SIGN( .5, YC ) GO TO 500 C C - DON'T CONVERT IF TRANSFORM NOT DEFINED. 400 IF( .NOT. TRNFRM ) GO TO 700 XC = ( COSTH*( XTAB-XTAB0 ) + SINTH*( YTAB-YTAB0 ) )/H YC = ( -SINTH*( XTAB-XTAB0 ) + COSTH*( YTAB-YTAB0 ) )/H IXTAB = XC/SCALE + SIGN( .5, XC ) IYTAB = YC/SCALE + SIGN( .5, YC ) C C - REJECT IF NOT WITHIN BOUNDS OF CCS. 500 IF( ( IXTAB .LE. -(LL0+64) ) .OR. 1 ( IYTAB .LE. -(LL0+64) ) .OR. 1 ( IYTAB .GE. 128-(LL0+64) ) ) GO TO 100 C C - ALLOW OUTSIDE TO RIGHT IF SETTING WIDTH. IF( IXTAB .GT. 128-(LL0+64) ) GO TO 600 NEWDO = 0 RETURN C C - SETTING WIDTH? 600 IF( NEWDO .NE. 15 ) GO TO 100 NEWDO = 0 RETURN C C - RETURN SCREEN CONVERTED HIT COORDINATES. 700 XC = XTAB YC = YTAB NEWDO = -1 RETURN C C - GET GIN INPUT. 800 CALL GIN( XS, YS, IANS ) C C - KEYED IN MENU SELECTION? CALL ITWAS( IANS, 'ACDEFIMPRSTW', 12, NEWDO ) IF( NEWDO .EQ. 12 ) GO TO 1000 IF( NEWDO .EQ. 13 ) GO TO 900 NEWDO = GINDO( NEWDO ) RETURN C C - MENU SELECTION? 900 IF( XS .LT. XMENU ) GO TO 1000 IF( ( XS .GT. XMENU+3. ) .OR. 1 ( YS .LT. YMENU ) .OR. 1 ( YS .GT. YMENU+2.5 ) ) GO TO 800 C C - OBTAIN MENU CODE. NEWDO = 5*IFIX( ( XS-XMENU )/1. ) + 1 5 - IFIX( ( YS-YMENU )/.5 ) RETURN C C - CONVERT TO CCS UNITS. 1000 XC = XS - XCH YC = YS - YCH IXTAB = XC/SCALEF + SIGN( .5, XC ) IYTAB = YC/SCALEF + SIGN( .5, YC ) C C - REJECT IF NOT WITHIN BOUNDS OF CCS. IF( ( XC .LT. CHMIN ) .OR. 1 ( YC .GT. CHMAX ) .OR. 1 ( YC .LT. CHMIN ) ) GO TO 800 C C - ALLOW OUTSIDE TO RIGHT IF SETTING WIDTH. IF( XC .GT. CHMAX ) GO TO 1100 NEWDO = 0 RETURN C C - SETTING WIDTH? 1100 IF( NEWDO .NE. 15 ) GO TO 800 NEWDO = 0 RETURN END