SUBROUTINE HCGTRN C C This subroutine calculates the transform necessary C to obtain a point within the CHARACTER COORDINATE C SYSTEM. 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 TEMP C C - GET NEW CHARACTER ORIGIN ON TABLET. TEMP = TRNFRM TRNFRM = .FALSE. 100 CALL HCGLBL( 'Mark Origin.' ) C CALL HCGHIT IF( NEWDO .EQ. -1 ) GO TO 200 IF( NEWDO .NE. 5 ) GO TO 100 C C - FINISH ( DO NOTHING ). TRNFRM = TEMP CALL HCGLBL( 'Return.' ) RETURN C C - SET NEW CHARACTER ORIGIN. 200 XTAB0 = XC YTAB0 = YC CALL HCGLBL( 'Origin Marked.' ) C C - GET NEW CHARACTER ANGLE ON TABLET. 300 CALL HCGLBL( 'Mark Rotation.' ) C CALL HCGHIT IF( NEWDO .EQ. -1 ) GO TO 400 IF( NEWDO .NE. 5 ) GO TO 300 C C - FINISH ( TRANSLATION OF ORIGIN ONLY ). TRNFRM = TEMP CALL HCGLBL( 'Translation Only.' ) RETURN C C - SET NEW CHARACTER ANGLE. 400 TH = ATAN2( YC-YTAB0, XC-XTAB0 ) CALL HCGLBL( 'Rotation Marked.' ) C C - CHECK TO SEE IF CHARACTER HAS HEIGHT. IF( H .GT. 0. ) GO TO 600 500 CALL HCGLBL( 'Character height =? ') READ(2,510,END=700) H 510 FORMAT(F10.0) IF( H .LE. 0. ) GO TO 500 C C - COMPLETE TRANSFORMATION. 600 COSTH = COS( TH )/TABFAC SINTH = SIN( TH )/TABFAC C TRNFRM = .TRUE. RETURN C 700 CALL PLTNOS CALL CALPLT(0.,0.,999) STOP END