C ASCII '0' SUBROUTINE PHASER C C * FIRE PHASERS 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) REAL DX(3), DY(3) BYTE CHAR CALL PERM(SHIPS, I1, I2) DO 2000 ISHP = 1, 8 I = SHIPS(ISHP) IF (.NOT.(PHA(I) .GE. 0.)) GOTO 2020 C C * FIRE 3 BAND WIDE BEAM (NOTE EACH BAND HAS ITS OWN HIT OR MISS MESSAGE) C DX(2) = XCORD(I) DY(2) = YCORD(I) IF (.NOT.(((PHA(I) .GE. 45.) .AND. (PHA(I) .LT. 135.)) .OR. (( *PHA(I) .GE. 225.) .AND. (PHA(I) .LT. 315.)))) GOTO 2040 DX(1) = DX(2) - 1. DX(3) = DX(2) + 1. DY(1) = DY(2) DY(3) = DY(2) GOTO 2050 2040 CONTINUE DX(1) = DX(2) DX(3) = DX(2) DY(1) = DY(2) - 1. DY(3) = DY(2) + 1. 2050 CONTINUE DO 2060 IZ = 1, 3, 2 IF (.NOT.(DX(IZ) .GE. 101.)) GOTO 2080 DX(IZ) = DX(IZ) - 100. GOTO 2090 2080 CONTINUE IF (.NOT.(DX(IZ) .LT. 1.)) GOTO 2100 DX(IZ) = DX(IZ) + 100. 2100 CONTINUE 2090 CONTINUE IF (.NOT.(DY(IZ) .GE. 101.)) GOTO 2120 DY(IZ) = DY(IZ) - 100. GOTO 2130 2120 CONTINUE IF (.NOT.(DY(IZ) .LT. 1.)) GOTO 2140 DY(IZ) = DY(IZ) + 100. 2140 CONTINUE 2130 CONTINUE 2060 CONTINUE 2070 CONTINUE KX = XCORD(I) KY = YCORD(I) NMISS = 0 DO 2160 IZ = 1, 3 X1 = DX(IZ) Y1 = DY(IZ) DO 2180 IIT = 1, 10 CALL MOVE(X1, Y1, X, Y, PHA(I), 10., CHAR, UNIV, ' ') IX = X IY = Y IF (.NOT.((CHAR .NE. ' ') .AND. ((KX .NE. IX) .OR. (KY .NE *. IY)))) GOTO 2200 GOTO 2190 2200 CONTINUE X1 = X Y1 = Y 2210 CONTINUE 2180 CONTINUE 2190 CONTINUE IF (.NOT.((CHAR .GE. '1') .AND. (CHAR .LE. '8'))) GOTO 2220 C hit on ship K = CHAR - 48 IF (.NOT.(SHPACT(K))) GOTO 2240 DIST = DSTNCE(XCORD(I), YCORD(I), X, Y) EN = 900./(4. + DIST) C make sure we don't shoot ourselves IF (.NOT.(K .NE. I)) GOTO 2260 C phaser hit alien CALL SENT(I, 6) C phaser attack CALL SENT(K, 14) CALL DAMAGE(I, K, EN, PHA(I)) 2260 CONTINUE GOTO 2250 2240 CONTINUE C hit ghost ship CALL SENT(I, 21) 2250 CONTINUE GOTO 2230 2220 CONTINUE IF (.NOT.((CHAR .EQ. '+'))) GOTO 2280 C phaser hit torpedo CALL SENT(I, 7) GOTO 2290 2280 CONTINUE IF (.NOT.((CHAR .EQ. '^'))) GOTO 2300 C phaser hit torpedo (seeker) CALL SENT(I, 7) IF (.NOT.(RAN(I1, I2) .GT. .5)) GOTO 2320 UNIV(IX, IY) = ' ' 2320 CONTINUE GOTO 2310 2300 CONTINUE IF (.NOT.(CHAR .EQ. '*')) GOTO 2340 C phaser hit star CALL SENT(I, 11) GOTO 2350 2340 CONTINUE IF (.NOT.(CHAR .EQ. 'B')) GOTO 2360 C base under attack CALL SENT(I, 12) GOTO 2370 2360 CONTINUE IF (.NOT.(CHAR .EQ. '@')) GOTO 2380 C phaser hit anti-matter pod CALL SENT(I, 25) GOTO 2390 2380 CONTINUE IF (.NOT.(CHAR .LT. 0)) GOTO 2400 C phaser hit energy net CALL SENT(I, 35) GOTO 2410 2400 CONTINUE NMISS = NMISS + 1 2410 CONTINUE 2390 CONTINUE 2370 CONTINUE 2350 CONTINUE 2310 CONTINUE 2290 CONTINUE 2230 CONTINUE 2160 CONTINUE 2170 CONTINUE PHA(I) = - 1. IF (.NOT.(NMISS .EQ. 3)) GOTO 2420 C phaser missed CALL SENT(I, 8) 2420 CONTINUE 2020 CONTINUE 2000 CONTINUE 2010 CONTINUE RETURN END