C ASCII '0' SUBROUTINE MSHIPS 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), HSPLOC(2, 6) C BYTE CHAR, SHIP, TRAIL DATA HSPLOC/20, 75, 50, 70, 80, 75, 20, 25, 50, 30, 80, 25/ C CALL PERM(SHIPS, I1, I2) DO 2000 I = 1, 8 C move 'em in permuted order ISHP = SHIPS(I) IF (.NOT.(SHPACT(ISHP))) GOTO 2020 IF (.NOT.(CLOAK(ISHP))) GOTO 2040 C max warp restricted if you're cloaked WARP(ISHP) = MIN(WARP(ISHP), 4.) ENERGY(ISHP) = ENERGY(ISHP) - CDRAIN 2040 CONTINUE SHIP = ISHP + 48 ENERGY(ISHP) = ENERGY(ISHP) - WARP(ISHP)/2 IF (.NOT.(NET(ISHP))) GOTO 2060 TRAIL = - ISHP ENERGY(ISHP) = ENERGY(ISHP) - NDRAIN*WARP(ISHP)/10. GOTO 2070 2060 CONTINUE TRAIL = ' ' 2070 CONTINUE TRUDIR = DIR(ISHP) TRUWRP = WARP(ISHP) IF (.NOT.(TRBEAM(ISHP) .NE. 0 .AND. SHPACT(TRBEAM(ISHP)))) GOT *O 2080 ENERGY(ISHP) = ENERGY(ISHP) - TDRAIN C calc the effect of his beam on his own movement CALL DIRDIS(XCORD(ISHP), YCORD(ISHP), XCORD(TRBEAM(ISHP)), Y *CORD(TRBEAM(ISHP)), TDIR, TDIS) CALL POLADD(TRUDIR, TRUWRP, TDIR, 8./SQRT(MAX(1., TDIS - 6.) *), TRUDIR, TRUWRP) 2080 CONTINUE DO 2100 ITRAC = 1, 8 C calc effect of everyone elses beams on his movement IF (.NOT.(SHPACT(ITRAC) .AND. TRBEAM(ITRAC) .EQ. ISHP .AND. *ITRAC .NE. ISHP)) GOTO 2120 CALL DIRDIS(XCORD(ISHP), YCORD(ISHP), XCORD(ITRAC), YCORD( *ITRAC), TDIR, TDIS) CALL POLADD(TRUDIR, TRUWRP, TDIR, 8./SQRT(MAX(1., TDIS - 6 *.)), TRUDIR, TRUWRP) 2120 CONTINUE 2100 CONTINUE 2110 CONTINUE IF (.NOT.(TRUWRP .GT. 10.)) GOTO 2140 TRUWRP = 10. 2140 CONTINUE IX = XCORD(ISHP) IY = YCORD(ISHP) CALL MOVE(XCORD(ISHP), YCORD(ISHP), X, Y, TRUDIR, TRUWRP, CHAR *, UNIV, ' ') KX = X KY = Y IF (.NOT.(CHAR .LE. '8' .AND. CHAR .GE. '1')) GOTO 2160 KSHP = CHAR - 48 C we have rammed a ship (KSHP) ENERGY(ISHP) = ENERGY(ISHP) - 100. IF (.NOT.(SHPACT(KSHP))) GOTO 2180 ENERGY(KSHP) = ENERGY(KSHP) - 100. C "collision" CALL SENT(KSHP, 10) 2180 CONTINUE WARP(ISHP) = 0. WARP(KSHP) = 0. C "rammed alien" CALL SENT(ISHP, 9) C GOTO 2170 2160 CONTINUE IF (.NOT.(CHAR .EQ. 'B')) GOTO 2200 C rammed (docked) a base C "docked" CALL SENT(ISHP, 1) TORPS(ISHP) = MAXTRP WARP(ISHP) = 0. ENERGY(ISHP) = 10000. SHIELD(ISHP) = 0. C give him a new pod if old one exploded IF (.NOT.(IPODST(ISHP) .EQ. 4)) GOTO 2220 IPODST(ISHP) = 0 2220 CONTINUE SCAN(ISHP) = 9 C replentish inactive homers NHOM(ISHP) = 0 DO 2240 II = 1, MAXHOM IF (.NOT.(WHOM(ISHP, II) .EQ. 0)) GOTO 2260 NHOM(ISHP) = NHOM(ISHP) + 1 2260 CONTINUE 2240 CONTINUE 2250 CONTINUE Cturn off his tractor beam TRBEAM(ISHP) = 0 GOTO 2210 2200 CONTINUE IF (.NOT.(CHAR .EQ. '*')) GOTO 2280 C hit a star C "hit a star" CALL SENT(ISHP, 2) ENERGY(ISHP) = ENERGY(ISHP) - 200. WARP(ISHP) = 0. C GOTO 2290 2280 CONTINUE IF (.NOT.((CHAR .EQ. '+') .OR. (CHAR .EQ. '^'))) GOTO 23 *00 C hit a torpedo CALL TFIND(KSHP, KX, KY) IF (.NOT.(KSHP .NE. 0 .AND. (KSHP .NE. ISHP))) GOTO 23 *20 C "torpedo hit us" CALL SENT(ISHP, 4) IF (.NOT.(CHAR .EQ. '^')) GOTO 2340 V = 300. GOTO 2350 2340 CONTINUE V = 500. 2350 CONTINUE CALL DAMAGE(KSHP, ISHP, V, 500.) C "torpedo hit alien" CALL SENT(KSHP, 5) UNIV(KX, KY) = ' ' 2320 CONTINUE GOTO 2310 2300 CONTINUE IF (.NOT.(CHAR .EQ. 'H')) GOTO 2360 C hit a hyperspace port 10 CONTINUE C "hyperspace" CALL SENT(ISHP, 17) KX = HSPLOC(1, HYPER(ISHP)) KY = HSPLOC(2, HYPER(ISHP)) C C put the ship near the destination port if possible DO 2380 II = (KX - 1), (KX + 1) DO 2400 IJ = (KY - 1), (KY + 1) IF (.NOT.(UNIV(II, IJ) .EQ. ' ')) GOTO 2420 UNIV(II, IJ) = SHIP UNIV(IX, IY) = TRAIL XCORD(ISHP) = II YCORD(ISHP) = IJ XCORD(ISHP) = XCORD(ISHP) + .5 YCORD(ISHP) = YCORD(ISHP) + .5 GOTO 102 2420 CONTINUE 2400 CONTINUE 2410 CONTINUE C if we are here we didn't find an empty spot ( very unlikely) 2380 CONTINUE 2390 CONTINUE C "port blocked" CALL SENT(ISHP, 18) 102 WARP(ISHP) = 0. C GOTO 2370 2360 CONTINUE IF (.NOT.(CHAR .EQ. '#')) GOTO 2440 C run into the "black hole" ( nice flying) 20 CONTINUE C "we are being drawn into ..." CALL SENT(ISHP, 15) CALL RESET(ISHP) GOTO 2450 2440 CONTINUE IF (.NOT.(CHAR .EQ. 'R')) GOTO 2460 C hit a random hyperspace port 30 CONTINUE C "random hyperspace" CALL SENT(ISHP, 19) C find a new empty location 2480 CONTINUE KX = RAN(I1, I2)*100. + 1. KY = RAN(I1, I2)*100. + 1. 2490 IF (.NOT.(UNIV(KX, KY) .EQ. ' ')) GOTO 2480 2500 CONTINUE XCORD(ISHP) = KX YCORD(ISHP) = KY XCORD(ISHP) = XCORD(ISHP) + .5 YCORD(ISHP) = YCORD(ISHP) + .5 WARP(ISHP) = 0. UNIV(IX, IY) = TRAIL UNIV(KX, KY) = SHIP GOTO 2470 2460 CONTINUE IF (.NOT.(CHAR .EQ. '@')) GOTO 2510 C bumped into an anti-matter pod C "metal object near" CALL SENT(ISHP, 27) CALL DAMAGE(0, ISHP, 250., 500.) GOTO 2520 2510 CONTINUE IF (.NOT.(CHAR .LT. 0)) GOTO 2530 C bumped into energy net ENERGY(ISHP) = ENERGY(ISHP) - 200 IF (.NOT.(CHAR .EQ. -ISHP)) GOTO 2550 C it's his own net, move him thru it 2570 CONTINUE X2 = X Y2 = Y CALL MOVE(X2, Y2, X, Y, TRUDIR, 8., CHAR *, UNIV, ' ') 2580 IF (.NOT.(UNIV(IFIX(X), IFIX(Y)) .NE. -I *SHP)) GOTO 2570 2590 CONTINUE KX = X KY = Y CHAR = UNIV(KX, KY) IF (.NOT.(CHAR .EQ. 'H')) GOTO 2600 GOTO 10 2600 CONTINUE IF (.NOT.(CHAR .EQ. '#')) GOTO 2620 GOTO 20 2620 CONTINUE IF (.NOT.(CHAR .EQ. 'R')) GOTO 2640 GOTO 30 2640 CONTINUE IF (.NOT.(CHAR .EQ. ' ')) GOTO 2660 XCORD(ISHP) = X YCORD(ISHP) = Y UNIV(IX, IY) = TRAIL UNIV(KX, KY) = SHIP GOTO 2670 2660 CONTINUE C "net blocked" CALL SENT(ISHP, 36) WARP(ISHP) = 0. 2670 CONTINUE GOTO 2560 2550 CONTINUE C "hit net" CALL SENT(ISHP, 33) DIR(ISHP) = TRUDIR - 180. IF (.NOT.(DIR(ISHP) .LT. 0.)) GOTO 2680 DIR(ISHP) = DIR(ISHP) + 360. 2680 CONTINUE 2560 CONTINUE GOTO 2540 2530 CONTINUE XCORD(ISHP) = X YCORD(ISHP) = Y IF (.NOT.(UNIV(IX, IY) .NE. -ISHP)) GOTO 270 *0 UNIV(IX, IY) = TRAIL 2700 CONTINUE UNIV(KX, KY) = SHIP 2540 CONTINUE 2520 CONTINUE 2470 CONTINUE 2450 CONTINUE 2370 CONTINUE 2310 CONTINUE 2290 CONTINUE 2210 CONTINUE 2170 CONTINUE IF (.NOT.(ENERGY(ISHP) .LE. 0.)) GOTO 2720 C "dylithium crystals ..." CALL SENT(ISHP, 16) CALL RESET(ISHP) 2720 CONTINUE 2020 CONTINUE 2000 CONTINUE 2010 CONTINUE RETURN END SUBROUTINE RESET(ISHP) C C * RE-INCARNATE DESTROYED SHIPS 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/ACCUM/ACCUME LOGICAL*1ACCUME CSHIP NOT ACTIVE SHPACT(ISHP) = .FALSE. CRESET ENERGY ENERGY(ISHP) = 10000. CSTOP MOVEMENT WARP(ISHP) = 0. CREFILL TORPS TORPS(ISHP) = MAXTRP CDROP SHIELDS SHIELD(ISHP) = 0. CSET FULL SCAN VISIBILITY SCAN(ISHP) = 9 CTURN OFF CLOAKING DEVICE CLOAK(ISHP) = .FALSE. CTURN OFF ENERGY NET NET(ISHP) = .FALSE. CTURN OFF HIS TRACTOR BEAM TRBEAM(ISHP) = 0 DO 2740 I = 1, 8 IF (.NOT.(TRBEAM(I) .EQ. ISHP)) GOTO 2760 CTURN OFF OTHER'S BEAMS ON HIM TRBEAM(I) = 0 2760 CONTINUE 2740 CONTINUE 2750 CONTINUE IF (.NOT.(ACCUME)) GOTO 2780 SCORE(ISHP) = SCORE(ISHP) - 1000. GOTO 2790 2780 CONTINUE SCORE(ISHP) = 0. 2790 CONTINUE CSEND HIM THE DEATH MESSAGE CALL SENT(ISHP, 3) IX = XCORD(ISHP) IY = YCORD(ISHP) CREMOVE HIS SHIP UNIV(IX, IY) = ' ' DO 2800 I = 1, MAXHOM CCLEAN UP HIS ACTIVE HOMERS IF (.NOT.(WHOM(ISHP, I) .NE. 0)) GOTO 2820 IX = XHOM(ISHP, I) IY = YHOM(ISHP, I) IF (.NOT.(UNIV(IX, IY) .EQ. '^')) GOTO 2840 UNIV(IX, IY) = ' ' 2840 CONTINUE 2820 CONTINUE CRESET HOMERS TO IDLE WHOM(ISHP, I) = 0 2800 CONTINUE 2810 CONTINUE CREPLENTISH HOMERS NHOM(ISHP) = MAXHOM CCLEAN UP HIS ENERGY NETS DO 2860 I = 1, 100 DO 2880 J = 1, 100 IF (.NOT.(UNIV(J, I) .EQ. -ISHP)) GOTO 2900 UNIV(J, I) = ' ' C IF POD ISN'T IDLE OR DESTROYED, ERASE IT 2900 CONTINUE 2880 CONTINUE 2890 CONTINUE 2860 CONTINUE 2870 CONTINUE IF (.NOT.((IPODST(ISHP) .NE. 0) .AND. (IPODST(ISHP) .NE. 4))) GOTO * 2920 CCLEAN UP HIS ANTI-MATTER POD IX = XPOD(ISHP) IY = YPOD(ISHP) IF (.NOT.(UNIV(IX, IY) .EQ. '@')) GOTO 2940 UNIV(IX, IY) = ' ' 2940 CONTINUE 2920 CONTINUE CRESET POD STATUS TO IDLE IPODST(ISHP) = 0 C DEPOSIT HIS SHIP IN A RANDOM EMPTY SPOT 2960 CONTINUE IX = RAN(I1, I2)*100. + 1. IY = RAN(I1, I2)*100. + 1. 2970 IF (.NOT.(UNIV(IX, IY) .EQ. ' ')) GOTO 2960 2980 CONTINUE UNIV(IX, IY) = ISHP + 48 XCORD(ISHP) = IX YCORD(ISHP) = IY XCORD(ISHP) = XCORD(ISHP) + .5 YCORD(ISHP) = YCORD(ISHP) + .5 RETURN END