SUBROUTINE HCGSEL C C This subroutine takes care of the following functions: ADD, C DELETE, INSERT, MOVE and SELECT. C 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 - WHAT TO DO? TEMP = TABON IF( NEWDO .EQ. 1 ) GO TO 1400 IF( NEWDO .EQ. 3 ) GO TO 1600 IF( NEWDO .EQ. 6 ) GO TO 2200 IF( NEWDO .EQ. 7 ) GO TO 2300 C C - SELECT POINT. CALL HCGLBL( 'Select.' ) TABON = .FALSE. IF( TEMP ) CALL HCGLBL( 'Tablet Off.' ) 100 CALL HCGHIT IF( NEWDO .EQ. 5 ) GO TO 3001 IF( NEWDO .NE. 0 ) GO TO 100 C C - FIND CLOSEST POINT. ITIS = 1 CALL UNPACK( IVCTRS(ITIS), IXP, IYP, IPEN ) XP = IXP*SCALEF YP = IYP*SCALEF ROLD = SQRT( ( XP-XC )**2 + ( YP-YC )**2 ) DO 1000 I=2,NVEC CALL UNPACK( IVCTRS(I), IXP, IYP, IPEN ) XP = IXP*SCALEF YP = IYP*SCALEF RNEW = SQRT( ( XP-XC )**2 + ( YP-YC )**2 ) IF( RNEW .GE. ROLD ) GO TO 1000 ITIS = I ROLD = RNEW 1000 CONTINUE C C - MARK POINT AND WAIT FOR ACCEPTANCE. 1100 CALL PLTNOS CALL UNPACK( IVCTRS(ITIS), IXP, IYP, IPEN ) XP = XCH + IXP*SCALEF YP = YCH + IYP*SCALEF CALL CALPLT(XP,YP,3) CALL ALTPRI(,50) 1200 CALL CALPLT(XP,YP,2) CALL BREAK( IBROKE ) IF( .NOT. IBROKE ) GO TO 1200 CALL ALTPRI CALL PLTSLV C C - DO ANYTHING SPECIAL? CALL ITWAS( IBROKE, 'ABDEIMO<>G', 10, IDO ) IF( IDO .EQ. 5 ) NEWDO = 6 IF( ( IDO .EQ. 3 ) .OR. ( IDO .GT. 5 ) ) GO TO 1250 TABON = TEMP IF( TABON ) CALL HCGLBL( 'Tablet On.' ) 1250 GO TO (1400,1500,1600,2100,2200,2300,2600,3100, 1 3200,5200,1300), IDO C C - SELECTED. 1300 OLDDO = 12 CALL HCGLBL( 'Selected.' ) TABON = TEMP IF( TABON ) CALL HCGLBL( 'Tablet On.' ) RETURN C C - SET TO ADD IN. 1400 ISTART = NVEC+1 IPEN = 3 CALL HCGLBL( 'Add.' ) GO TO 3300 C C - SET TO ADD IN BEFORE. 1500 ISTART = 1 CALL UNPACK( IVCTRS(1), IXP, IYP, IPEN ) CALL PACK( IVCTRS(1), IXP, IYP, 2 ) IPEN = 3 CALL HCGLBL( 'Insert Before.' ) GO TO 3300 C C - DELETE POINT. 1600 NVEC = NVEC-1 DO 2000 I=ITIS,NVEC 2000 IVCTRS(I) = IVCTRS(I+1) OLDDO = NEWDO CALL HCGLBL( 'Deleted.' ) ITIS = MAX0( 1, MIN0( ITIS, NVEC ) ) GO TO 1100 C C - INSERT NEW POINTS. 2100 ITIS = NVEC CALL HCGLBL( 'Insert After.' ) 2200 ISTART = ITIS+1 CALL UNPACK( IVCTRS( ISTART-1 ), IXP, IYP, IPEN ) XP = XCH + IXP*SCALEF YP = YCH + IYP*SCALEF IF( NEWDO .EQ. 6 ) CALL HCGLBL( 'Insert.' ) GO TO 3300 C C - MOVE POINT. 2300 CALL UNPACK( IVCTRS(ITIS), IXP, IYP, IPEN ) XC = IXP*SCALE YC = IYP*SCALE CALL HCGLBL( 'Move.' ) TABON = .FALSE. IF( TEMP ) CALL HCGLBL( 'Tablet Off.' ) 2400 CALL HCGHIT IF( NEWDO .EQ. 5 ) GO TO 2500 IF( NEWDO .EQ. 8 ) IPEN = 3 IF( NEWDO .NE. 0 ) GO TO 2400 2500 IXP = IXTAB IYP = IYTAB CALL PACK( IVCTRS(ITIS), IXP, IYP, IPEN ) XP = XCH + IXP*SCALEF YP = YCH + IYP*SCALEF CALL CALPLT(XP,YP,3) CALL SVCTR(6) CALL CALPLT(XP,YP,2) CALL SVCTR(1) OLDDO = NEWDO CALL HCGLBL( 'Moved.' ) TABON = TEMP IF( TABON ) CALL HCGLBL( 'Tablet On.' ) RETURN C C - CHANGE ORIGIN. 2600 CALL HCGLBL( 'Set Origin.' ) TABON = .FALSE. IF( TEMP ) CALL HCGLBL( 'Tablet Off.' ) 2700 CALL HCGHIT IF( NEWDO .EQ. 5 ) GO TO 3001 IF( NEWDO .NE. 0 ) GO TO 2700 IXZERO = IXTAB IYZERO = IYTAB DO 3000 I=1,NVEC CALL UNPACK( IVCTRS(I), IXP, IYP, IPEN ) IXP = IXP - IXZERO IYP = IYP - IYZERO 3000 CALL PACK( IVCTRS(I), IXP, IYP, IPEN ) IWIDTH = IWIDTH - IXZERO CALL HCGLBL( 'Origin Set.' ) 3001 TABON = TEMP IF( TABON ) CALL HCGLBL( 'Tablet On.' ) OLDDO = NEWDO RETURN C C - SHIFT TO A NEW POINT. 3100 ITIS = MAX0( 1, ITIS-1 ) GO TO 1100 3200 ITIS = MIN0( NVEC, ITIS+1 ) GO TO 1100 C C - SHIFT STUFF AS NECESSARY FOR INCLUSION OF MORE POINTS. 3300 NMOVE = NVEC - ISTART + 1 OLDDO = NEWDO IF( NMOVE .EQ. 0 ) GO TO 4100 DO 4000 I=0,NMOVE-1 4000 IVCTRS( 800-I ) = IVCTRS( ISTART+I ) CALL HCGLBL( 'Shift Out.' ) IF( IPEN .EQ. 3 ) CALL HCGLBL( 'Pen Up.' ) 4100 CALL HCGHIT IF( NEWDO .EQ. 5 ) GO TO 4200 IF( NEWDO .EQ. 8 ) IPEN = 3 IF( IPEN .EQ. 3 ) CALL HCGLBL( 'Pen Up.' ) IF( NEWDO .NE. 0 ) GO TO 4100 C C - ADD POINT. IXP = IXTAB IYP = IYTAB CALL PACK( IVCTRS(ISTART), IXP, IYP, IPEN ) ISTART = ISTART + 1 NVEC = NVEC + 1 CALL CALPLT(XP,YP,3) XP = XCH + IXP*SCALEF YP = YCH + IYP*SCALEF CALL CALPLT(XP,YP,IPEN) IPEN = 2 IF( OLDDO .NE. 0 ) CALL HCGLBL( 'Pen Down.' ) OLDDO = 0 GO TO 4100 C C - SHIFT STUFF BACK. 4200 IF( NMOVE .EQ. 0 ) GO TO 5100 DO 5000 I=0,NMOVE-1 5000 IVCTRS( ISTART+I ) = IVCTRS( 800-I ) CALL HCGLBL( 'Shift Back.' ) C C - FINISH. 5100 NEWDO = 5 OLDDO = 5 CALL HCGLBL( 'Finished.' ) RETURN C C - GENERATE GRID AROUND POINT. 5200 IXLO = MAX0( IXP-4, -(LL0+64) ) IXHI = MIN0( IXP+4, 124-(LL0+64) ) IYLO = MAX0( IYP-4, -(LL0+64) ) IYHI = MIN0( IYP+4, 124-(LL0+64) ) DO 6000 I=IXLO,IXHI XP = XCH + I*SCALEF DO 6000 J=IYLO,IYHI YP = YCH + J*SCALEF CALL CALPLT(XP,YP,3) 6000 CALL CALPLT(XP,YP,2) GO TO 1100 END