C ASCII '0' SUBROUTINE MHOLE C C * MOVE THE "BLACK HOLE" TOWARD THE NEAREST ACTIVE SHIP C C COMMON PARAMETER MAXSHP = 8, MAXHOM = 4, MAXTRP = 10 COMMON/TORPE/TLOCS(MAXSHP, MAXTRP, 2), TDIR(MAXSHP, MAXTRP), IT(MA *XSHP) COMMON/TRKDAT/ENERGY(MAXSHP), SHIELD(MAXSHP), XCORD(MAXSHP), YCORD *(MAXSHP), TORPS(MAXSHP), HOLX, HOLY, HOLW, CDRAIN, NDRAIN, TDRAIN, * SCAN(MAXSHP), PHA(MAXSHP), I1, I2, HYPER(MAXSHP), ISENT(MAXSHP, 1 *0), XPOD(MAXSHP), YPOD(MAXSHP), DPOD(MAXSHP), IPODST(MAXSHP), WPOD *(MAXSHP), XHOM(MAXSHP, MAXHOM), YHOM(MAXSHP, MAXHOM), WHOM(MAXSHP, * MAXHOM), NHOM(MAXSHP), TRBEAM(MAXSHP), SCORE(MAXSHP), CREW(MAXSHP *), DIR(MAXSHP), WARP(MAXSHP), LAUNCH(MAXSHP), UNIV(100, 100), MESS *AG(480), THRU, SHPACT(MAXSHP), CLOAK(MAXSHP), NET(MAXSHP), SHPNAM( *10, MAXSHP) REAL LAUNCH, NDRAIN INTEGER*2SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, SHPACT, CLOAK, NET BYTE UNIV, MESSAG BYTE SHPNAM C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE. C END COMMON BYTE CHAR C C * FIND CLOSEST SHIP C DM = 1.6E37 K = 0 DO 2000 I = 1, 8 IF (.NOT.(SHPACT(I))) GOTO 2020 D = DSTNCE(HOLX, HOLY, XCORD(I), YCORD(I)) IF (.NOT.(D .LT. DM)) GOTO 2040 DM = D K = I 2040 CONTINUE 2020 CONTINUE C C *FIND DIRECTION OF CLOSEST SHIP C 2000 CONTINUE 2010 CONTINUE IF (.NOT.(K .NE. 0)) GOTO 2060 CALL DIRDIS(HOLX, HOLY, XCORD(K), YCORD(K), D, DIS) C CALL MOVE(HOLX, HOLY, X, Y, D, HOLW, CHAR, UNIV, ' ') IF (.NOT.((CHAR .EQ. ' ') .OR. (CHAR .EQ. '+') .OR. (CHAR .EQ. ' *@') .OR. (CHAR .EQ. '^'))) GOTO 2080 C * JUST MUNCH THIS JUNK DOWN IX = HOLX IY = HOLY UNIV(IX, IY) = ' ' IX = X IY = Y UNIV(IX, IY) = '#' HOLX = X HOLY = Y GOTO 2090 2080 CONTINUE IF (.NOT.((CHAR .GE. '1') .AND. (CHAR .LE. '8'))) GOTO 2100 C * CAUGHT A SHIP I = CHAR - 48 IF (.NOT.(SHPACT(I))) GOTO 2120 CALL SENT(I, 15) CALL RESET(I) 2120 CONTINUE GOTO 2110 2100 CONTINUE IF (.NOT.((CHAR .LT. 0) .OR. (CHAR .EQ. 'H'))) GOTO 2140 C * CAN'T EAT ENERGY NET! OR HYPER PORTS GOTO 2150 2140 CONTINUE C * SWAP PLACES WITH BASES STARS ETC. IX = HOLX IY = HOLY UNIV(IX, IY) = CHAR HOLX = X HOLY = Y IX = HOLX IY = HOLY UNIV(IX, IY) = '#' 2150 CONTINUE 2110 CONTINUE 2090 CONTINUE 2060 CONTINUE RETURN END