C ASCII '0' SUBROUTINE MTORPS C C * MOVE ALL ACTIVE TORPEDOES 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 COMMON/DOLOOP/SHIPS INTEGER SHIPS(8) BYTE CHAR LOGICAL*1MYTORP CALL PERM(SHIPS, I1, I2) DO 2000 ISHP = 1, 8 I = SHIPS(ISHP) DO 2020 K = 1, 10 IX = TLOCS(I, K, 1) IY = TLOCS(I, K, 2) C C * MAKE SURE THE TORPEDO IS STILL THERE AND ACTIVE C IF (.NOT.((UNIV(IX, IY) .EQ. '+') .AND. (TDIR(I, K) .GE. 0.))) * GOTO 2040 CALL MOVE(TLOCS(I, K, 1), TLOCS(I, K, 2), X, Y, TDIR(I, K), *10., CHAR, UNIV, ' ') KX = X KY = Y IF (.NOT.(CHAR .NE. ' ')) GOTO 2060 IF (.NOT.(.NOT.MYTORP(I, KX, KY, CHAR))) GOTO 2080 CALL THIT(I, KX, KY, CHAR, TDIR(I, K), 500.) UNIV(IX, IY) = ' ' TDIR(I, K) = - 1. 2080 CONTINUE GOTO 2070 2060 CONTINUE UNIV(IX, IY) = ' ' UNIV(KX, KY) = '+' TLOCS(I, K, 1) = X TLOCS(I, K, 2) = Y 2070 CONTINUE GOTO 2050 2040 CONTINUE TDIR(I, K) = - 1. 2050 CONTINUE 2020 CONTINUE 2030 CONTINUE 2000 CONTINUE 2010 CONTINUE RETURN END LOGICAL*1 FUNCTION MYTORP(MYSHP, IX, IY, CHAR) C IS "CHAR" AT SQUARE "IX,IY" A TORP THAT BELONGS TO "MYSHP"? INTEGER*2MYSHP, IX, IY BYTE CHAR 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 IF (.NOT.(CHAR .EQ. '^')) GOTO 2100 CCHECK IF IT'S MYSHP'S HOMER DO 2120 J = 1, MAXHOM IF (.NOT.(WHOM(MYSHP, J) .LE. 0)) GOTO 2140 CHOMER J ISN'T ACTIVE GOTO 2120 2140 CONTINUE JX = XHOM(MYSHP, J) JY = YHOM(MYSHP, J) IF (.NOT.((JX .EQ. IX) .AND. (JY .EQ. IY))) GOTO 2160 MYTORP = .TRUE. RETURN 2160 CONTINUE 2120 CONTINUE 2130 CONTINUE GOTO 2110 2100 CONTINUE IF (.NOT.(CHAR .EQ. '+')) GOTO 2180 CCHECK IF IT'S MYSHP'S TORP DO 2200 J = 1, MAXTRP IF (.NOT.(TDIR(MYSHP, J) .LT. 0)) GOTO 2220 CTORP J ISN'T ACTIVE GOTO 2200 2220 CONTINUE JX = TLOCS(MYSHP, J, 1) JY = TLOCS(MYSHP, J, 2) IF (.NOT.((JX .EQ. IX) .AND. (JY .EQ. IY))) GOTO 2240 MYTORP = .TRUE. RETURN 2240 CONTINUE 2200 CONTINUE 2210 CONTINUE 2180 CONTINUE 2110 CONTINUE MYTORP = .FALSE. RETURN END SUBROUTINE TORPI C C * FIRE TORPEDOES 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 COMMON/DOLOOP/SHIPS INTEGER SHIPS(8) BYTE CHAR LOGICAL*1MYTORP CALL PERM(SHIPS, I1, I2) DO 2260 ISHP = 1, 8 I = SHIPS(ISHP) IF (.NOT.(LAUNCH(I) .GE. 0.)) GOTO 2280 CALL MOVE(XCORD(I), YCORD(I), X1, Y1, LAUNCH(I), 10., CHAR, UN *IV, ' ') IX = X1 IY = Y1 KX = XCORD(I) KY = YCORD(I) C * MAKE SURE IT MOVED OUT OF THE FIRER'S SQUARE IF (.NOT.((KX .EQ. IX) .AND. (KY .EQ. IY))) GOTO 2300 CALL MOVE(X1, Y1, X, Y, LAUNCH(I), 10., CHAR, UNIV, ' ') GOTO 2310 2300 CONTINUE X = X1 Y = Y1 2310 CONTINUE IX = X IY = Y IF (.NOT.(CHAR .EQ. ' ')) GOTO 2320 UNIV(IX, IY) = '+' ITORP = IT(I) IF (.NOT.(TDIR(I, ITORP) .GE. 0.)) GOTO 2340 C ERASE OLD TORP THAT WAS STILL ACTIVE KX = TLOCS(I, ITORP, 1) KY = TLOCS(I, ITORP, 2) IF (.NOT.(UNIV(KX, KY) .EQ. '+')) GOTO 2360 UNIV(KX, KY) = ' ' 2360 CONTINUE 2340 CONTINUE TLOCS(I, ITORP, 1) = X TLOCS(I, ITORP, 2) = Y TDIR(I, ITORP) = LAUNCH(I) IT(I) = ITORP + 1 IF (.NOT.(IT(I) .GT. 10)) GOTO 2380 IT(I) = 1 2380 CONTINUE LAUNCH(I) = - 1. GOTO 2330 2320 CONTINUE C * HIT SOMETHING IF (.NOT.(.NOT.MYTORP(I, IX, IY, CHAR))) GOTO 2400 CALL THIT(I, IX, IY, CHAR, LAUNCH(I), 500.) LAUNCH(I) = - 1. 2400 CONTINUE 2330 CONTINUE 2280 CONTINUE 2260 CONTINUE 2270 CONTINUE RETURN END SUBROUTINE THIT(ISHP, IX, IY, CHAR, DIREC, ENER) C C * HANDLE TORPEDO HITS 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 IF (.NOT.((CHAR .EQ. 'H') .OR. (CHAR .EQ. 'R'))) GOTO 2420 C * TORPEDO HIT ON HYPER SPACE PORT CONTINUE C GOTO 2430 2420 CONTINUE IF (.NOT.((CHAR .GE. '1') .AND. (CHAR .LE. '8'))) GOTO 2440 C * TORPEDO HIT ON SHIP KHSHP = CHAR - 48 IF (.NOT.(SHPACT(KHSHP))) GOTO 2460 IF (.NOT.(KHSHP .NE. ISHP)) GOTO 2480 Ctorp hit alien CALL SENT(ISHP, 5) 2480 CONTINUE Ctorp hit us CALL SENT(KHSHP, 4) CALL DAMAGE(ISHP, KHSHP, ENER, DIREC) GOTO 2470 2460 CONTINUE Ctorp hit ghost CALL SENT(ISHP, 21) 2470 CONTINUE GOTO 2450 2440 CONTINUE IF (.NOT.(CHAR .EQ. '#')) GOTO 2500 C * TORPEDO HIT ON BLACK HOLE - THE HOLE PREVAILS! GOTO 2510 2500 CONTINUE IF (.NOT.(CHAR .EQ. '*')) GOTO 2520 C torpedo hit star CALL SENT(ISHP, 13) GOTO 2530 2520 CONTINUE IF (.NOT.(CHAR .EQ. 'B')) GOTO 2540 C base under attack CALL SENT(ISHP, 12) SCORE(ISHP) = SCORE(ISHP) - 200. GOTO 2550 2540 CONTINUE IF (.NOT.((CHAR .EQ. '+') .OR. (CHAR .EQ. '^'))) GOTO 25 *60 C torpedo hit torpedo CALL SENT(ISHP, 20) UNIV(IX, IY) = ' ' GOTO 2570 2560 CONTINUE IF (.NOT.(CHAR .EQ. '@')) GOTO 2580 C torpedo hit anti-matter pod CALL SENT(ISHP, 26) CWHICH POD? CALL PFIND(IP, IX, IY) IF (.NOT.(IP .NE. 0)) GOTO 2600 CREQUEST DETONATION IPODST(IP) = 3 2600 CONTINUE GOTO 2590 2580 CONTINUE IF (.NOT.(CHAR .LT. 0)) GOTO 2620 C torpedo hit energy net CALL SENT(ISHP, 34) UNIV(IX, IY) = ' ' GOTO 2630 2620 CONTINUE C * ANYTHING ELSE GETS DESTROYED UNIV(IX, IY) = ' ' 2630 CONTINUE 2590 CONTINUE 2570 CONTINUE 2550 CONTINUE 2530 CONTINUE 2510 CONTINUE 2450 CONTINUE 2430 CONTINUE RETURN END SUBROUTINE TFIND(IOWNR, ITRPX, ITRPY) 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 C C * FIND OUT WHO OWNS THE TORPEDO AT A GIVEN X, Y C DO 2640 ISHP = 1, 8 DO 2660 ITRP = 1, MAXTRP IF (.NOT.(TDIR(ISHP, ITRP) .GE. 0.)) GOTO 2680 IX = TLOCS(ISHP, ITRP, 1) IY = TLOCS(ISHP, ITRP, 2) IF (.NOT.((IX .EQ. ITRPX) .AND. (IY .EQ. ITRPY))) GOTO 2700 IOWNR = ISHP RETURN 2700 CONTINUE 2680 CONTINUE 2660 CONTINUE 2670 CONTINUE DO 2720 ITRP = 1, MAXHOM IF (.NOT.(WHOM(ISHP, ITRP) .NE. 0)) GOTO 2740 IX = XHOM(ISHP, ITRP) IY = YHOM(ISHP, ITRP) IF (.NOT.((IX .EQ. ITRPX) .AND. (IY .EQ. ITRPY))) GOTO 2760 IOWNR = ISHP RETURN 2760 CONTINUE 2740 CONTINUE 2720 CONTINUE 2730 CONTINUE 2640 CONTINUE 2650 CONTINUE CGHOST TORP? IOWNR = 0 RETURN END