C ASCII "0" PROGRAM PLAYEM C C AUTHOR: DON LEDFORD OCTOBER 1979 C MAY 1980 BILL CAEL AND BILL WOOD RECODED IN RATFOR C AUG 1980 BILL CAEL AND BILL WOOD IMPROVED ROBOT STRATEGIES C C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, MESSAG, BHOLE, EMPTY C END COMMON LOGICAL*1DONE, OK INTEGER SCON(8) C C C NS = 0 WRITE(5, 1) 1 FORMAT('0ENTER THE NUMBERS FOR THE SHIPS TO BE RUN') DONE = .FALSE. 2000 CONTINUE WRITE(5, 11) 11 FORMAT('0THE FOLLOWING VESSELS ARE AVAILABLE FOR USE') DO 2030 I = 1, 8 IF (.NOT.(.NOT.XSHIP(I))) GOTO 2050 WRITE(5, 21) I 21 FORMAT(' SHIP ', I1) 2050 CONTINUE 2030 CONTINUE WRITE(5, 31) 31 FORMAT('$SHIP NUMBER? ') CALL GETINT(IW, OK, 1, 8) IF (.NOT.(OK)) GOTO 2070 NS = NS + 1 SCON(NS) = IW XSHIP(IW) = .TRUE. 2070 CONTINUE 2010 IF (.NOT.(.NOT.OK .OR. (NS .GT. 7))) GOTO 2000 IF (.NOT.(NS .EQ. 0)) GOTO 2090 CALL EXIT 2090 CONTINUE WRITE(5, 41) 41 FORMAT('$ENTER MAX SPEED OF ROBOT SHIPS (INTEGER 1-8): ') CALL GETINT(IR, OK, 1, 8) IF (.NOT.(OK)) GOTO 2110 WP = IR GOTO 2120 2110 CONTINUE WP = 8. 2120 CONTINUE WRITE(5, 51) 51 FORMAT('$ENTER REACTION TIME OF ROBOTS (1-5, 1 IS FASTEST): ') CALL GETINT(IR, OK, 1, 5) IF (.NOT.(OK)) GOTO 2130 IR = (IR*2*UPRATE)/3 GOTO 2140 2130 CONTINUE IR = UPRATE 2140 CONTINUE WRITE(5, 61) 61 FORMAT('$ENTER AMOUNT OF PHASER FIRE FROM ROBOTS (1-5): ') CALL GETINT(IP, OK, 1, 5) IF (.NOT.(OK)) GOTO 2150 IP = IP + 1 GOTO 2160 2150 CONTINUE IP = 6 2160 CONTINUE WRITE(5, 71) 71 FORMAT('$ENTER AVERAGE DEGREE OF INACCURACY (0-90): ') CALL GETINT(MIS, OK, 0, 90) IF (.NOT.(.NOT.OK)) GOTO 2170 MIS = 0 2170 CONTINUE 2190 CONTINUE DO 2220 IIT = 1, 6 DO 2240 I = 1, NS CALL PLAY(SCON, I, IIT, WP, IP, MIS) 2240 CONTINUE CALL WAIT(IR, 0, M) 2220 CONTINUE 2200 IF (.NOT.(DONE)) GOTO 2190 CALL EXIT END SUBROUTINE INTERS(TDIR, DIRT, WT, WP, ANG) C C COMPUTE INTERSECTION C A1 = TDIR/57.29577951 A2 = DIRT/57.29577951 ANG = ASIN(SIN(A2 - A1)*WT/WP)*57.29577951 + TDIR RETURN END SUBROUTINE SCANER(SCON, IW, ENUM, EDIS, PDIS, BDIS, HDIS, EDIR, PD *IR, BDIR, HDIR) C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, MESSAG, BHOLE, EMPTY C END COMMON INTEGER ENUM, WHO, SCON(8) BYTE ALPHA REAL D1(4) C C C C BDIS = 1.6E37 EDIS = 1.6E37 PDIS = 1.6E37 HDIS = 1.6E37 WHO = SCON(IW) ID = SCAN(WHO) X = XCORD(WHO) Y = YCORD(WHO) C DO 2260 IX = - ID, + ID IX1 = X + IX DO 2280 IY = - ID, ID IY1 = Y + IY IF (.NOT.((IX1 .GE. 1) .AND. (IX1 .LE. 100) .AND. (IY1 .GE. 1) * .AND. (IY1 .LE. 100))) GOTO 2300 ALPHA = UNIV(IX1, IY1) IF (.NOT.(ALPHA .NE. EMPTY .AND. ALPHA .NE. '*')) GOTO 2320 D = ((X - IX1)**2 + (Y - IY1)**2)**.5 RY = IY1 RX = IX1 DUR = DIRNRM(ATAN3((RY + .5 - Y), (RX + .5 - X))*57.295779 *51, 360.) IF (.NOT.(ALPHA .EQ. 'B')) GOTO 2340 IF (.NOT.(D .LT. BDIS)) GOTO 2360 BDIS = D BDIR = DUR C 2360 CONTINUE GOTO 2350 2340 CONTINUE IF (.NOT.(ALPHA .EQ. BHOLE)) GOTO 2380 HDIS = D HDIR = DUR C GOTO 2350 2380 CONTINUE IF (.NOT.(ALPHA .EQ. '@')) GOTO 2400 IF (.NOT.(D .LT. PDIS)) GOTO 2420 PDIS = D PDIR = DUR C 2420 CONTINUE C 2400 CONTINUE 2350 CONTINUE 2320 CONTINUE 2300 CONTINUE 2280 CONTINUE C C * FIND CLOSEST ENEMY C 2260 CONTINUE DO 2440 I = 1, 8 IF (.NOT.(XSHIP(I))) GOTO 2460 DO 2480 K = 1, 8 IF (.NOT.(SCON(K) .EQ. I)) GOTO 2500 GOTO 101 2500 CONTINUE 2480 CONTINUE X1 = XCORD(I) IF (.NOT.(X1 .LT. 50.)) GOTO 2520 X2 = X1 + 100. GOTO 2530 2520 CONTINUE X2 = X1 - 100. 2530 CONTINUE Y1 = YCORD(I) IF (.NOT.(Y1 .LT. 50.)) GOTO 2540 Y2 = Y1 + 100. GOTO 2550 2540 CONTINUE Y2 = Y1 - 100. 2550 CONTINUE D1(1) = ((X - X1)**2 + (Y - Y1)**2)**.5 D1(2) = ((X - X1)**2 + (Y - Y2)**2)**.5 D1(3) = ((X - X2)**2 + (Y - Y1)**2)**.5 D1(4) = ((X - X2)**2 + (Y - Y2)**2)**.5 IIT = 1 DO 2560 J = 2, 4 IF (.NOT.(D1(J) .LT. D1(IIT))) GOTO 2580 IIT = J 2580 CONTINUE 2560 CONTINUE D = D1(IIT) IF (.NOT.(IIT .EQ. 1)) GOTO 2600 YD = Y1 XD = X1 GOTO 2610 2600 CONTINUE IF (.NOT.(IIT .EQ. 2)) GOTO 2620 YD = Y2 XD = X1 GOTO 2610 2620 CONTINUE IF (.NOT.(IIT .EQ. 3)) GOTO 2640 YD = Y1 XD = X2 GOTO 2610 2640 CONTINUE YD = Y2 XD = X2 2610 CONTINUE IF (.NOT.(D .LT. EDIS)) GOTO 2660 EDIS = D ENUM = I EDIR = DIRNRM(ATAN3((YD - Y), (XD - X))*57.29577951, 360.) 2660 CONTINUE 101 CONTINUE 2460 CONTINUE 2440 CONTINUE RETURN END REAL FUNCTION DIRNRM(DIR, POSLIM) IF (.NOT.(DIR .GT. POSLIM)) GOTO 2680 DIRNRM = DIR - 360. GOTO 2690 2680 CONTINUE IF (.NOT.(DIR .LT. POSLIM-360.)) GOTO 2700 DIRNRM = DIR + 360. GOTO 2690 2700 CONTINUE DIRNRM = DIR 2690 CONTINUE RETURN END SUBROUTINE PLAY(SCON, IW, IIT, WP, IP, MIS) C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, MESSAG, BHOLE, EMPTY C END COMMON INTEGER WHO INTEGER ENUM INTEGER SCON(8) BYTE ALPHA LOGICAL*1OK C WHO = SCON(IW) R = RAN(I1I, I2I) CALL SCANER(SCON, IW, ENUM, EDIS, PDIS, BDIS, HDIS, EDIR, PDIR, BD *IR, HDIR) CALL INTERS(EDIR, DIR(ENUM), WARP(ENUM), 10., ANG) C$ IF (EDIS >= 5.) C$ NET(WHO) = .FALSE. IF (.NOT.(PDIS .LT. 5. .AND. (TORPS(WHO) .GT. 0) .AND. IIT .EQ. 5) *) GOTO 2720 IF (.NOT.(LAUNCH(WHO) .LT. 0.)) GOTO 2740 TORPS(WHO) = TORPS(WHO) - 1 LAUNCH(WHO) = PDIR C 2740 CONTINUE GOTO 2730 2720 CONTINUE IF (.NOT.(EDIS .LT. 10.)) GOTO 2760 IF (.NOT.(R .LT. .4)) GOTO 2780 IF (.NOT.(PHA(WHO) .LT. 0. .AND. IP .GT. IIT .AND. ENERGY(WHO) * .GT. 500.)) GOTO 2800 PHA(WHO) = EDIR ENERGY(WHO) = ENERGY(WHO) - 50. C 2800 CONTINUE GOTO 2790 2780 CONTINUE IF (.NOT.(LAUNCH(WHO) .LT. 0. .AND. TORPS(WHO) .GT. 0 .AND. (I *IT .EQ. 1 .OR. IIT .EQ. 4))) GOTO 2820 ANG = DIRNRM(ANG + MIS - 2*MIS*RAN(I1I, I2I), 360.) LAUNCH(WHO) = ANG TORPS(WHO) = TORPS(WHO) - 1 GOTO 2830 2820 CONTINUE IF (.NOT.(NHOM(WHO) .GT. 0 .AND. IIT .EQ. 1)) GOTO 2840 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 2840 CONTINUE 2830 CONTINUE 2790 CONTINUE GOTO 2730 2760 CONTINUE IF (.NOT.(EDIS .LT. 20. .AND. (IIT .EQ. 1) .AND. NHOM(WHO) .GT. 2) *) GOTO 2860 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 2860 CONTINUE 2730 CONTINUE IF (.NOT.(ENERGY(WHO) .LT. 2500.)) GOTO 2880 IF (.NOT.(BDIS .LT. 11.)) GOTO 2900 DUR = BDIR GOTO 2910 2900 CONTINUE DUR = 180. - EDIR IF (.NOT.(EDIS .LT. 20. .AND. NHOM(WHO) .GT. 0. .AND. (IIT .EQ *. 2 .OR. IIT .EQ. 4))) GOTO 2920 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 2920 CONTINUE 2910 CONTINUE GOTO 2890 2880 CONTINUE IF (.NOT.(EDIS .GT. 10. .AND. BDIS .LT. 11. .AND. (NHOM(WHO) .LE. *1 .OR. TORPS(WHO) .LE. 6 .OR. ENERGY(WHO) .LT. 4000.))) GOTO 2940 DUR = BDIR GOTO 2890 2940 CONTINUE IF (.NOT.(EDIS .GT. 10.)) GOTO 2960 DUR = ANG - 10. GOTO 2890 2960 CONTINUE IF (.NOT.(EDIS .LT. 5.)) GOTO 2980 DUR = ANG + 80. C$ NET(WHO) = .TRUE. GOTO 2890 2980 CONTINUE IF (.NOT.(EDIS .LT. 10.)) GOTO 3000 C$ DUR=ANG + 90. - 180.*RAN(I1I,I2I) DUR = ANG + 20. 3000 CONTINUE 2890 CONTINUE IF (.NOT.(HDIS .LT. 10.)) GOTO 3020 IF (.NOT.(HDIS .LT. 5.)) GOTO 3040 DUR = 180. - HDIR GOTO 3050 3040 CONTINUE IF (.NOT.(ABS(DIRNRM(HDIR-DUR, 180.)) .LT. 90.)) GOTO 3060 IF (.NOT.(DIRNRM(HDIR-DUR, 180.) .LT. 0.)) GOTO 3080 DUR = HDIR + 90. GOTO 3090 3080 CONTINUE DUR = HDIR - 90. 3090 CONTINUE 3060 CONTINUE 3050 CONTINUE C 3020 CONTINUE OK = .FALSE. 3100 CONTINUE IX = XCORD(WHO) + COS(DUR/57.29577951)*.8 IY = YCORD(WHO) + SIN(DUR/57.29577951)*.8 IF (.NOT.(IX .GT. 100)) GOTO 3130 IX = 1 3130 CONTINUE IF (.NOT.(IX .LT. 1)) GOTO 3150 IX = 100 3150 CONTINUE IF (.NOT.(IY .GT. 100)) GOTO 3170 IY = 1 3170 CONTINUE IF (.NOT.(IY .LT. 1)) GOTO 3190 IY = 100 3190 CONTINUE ALPHA = UNIV(IX, IY) IF (.NOT.((ALPHA .EQ. -WHO) .OR. (ALPHA .EQ. EMPTY) .OR. ((ALPHA * .EQ. 'B') .AND. (ENERGY(WHO) .LT. 8000. .OR. NHOM(WHO) .LE. 1 .OR *. TORPS(WHO) .LE. 6)) .OR. (ALPHA .EQ. WHO+48))) GOTO 3210 OK = .TRUE. GOTO 3220 3210 CONTINUE IF (.NOT.(R .GT. .5)) GOTO 3230 DUR = DUR + 45. GOTO 3240 3230 CONTINUE DUR = DUR - 45. 3240 CONTINUE 3220 CONTINUE 3110 IF (.NOT.(OK)) GOTO 3100 DIR(WHO) = DIRNRM(DUR, 360.) WARP(WHO) = WP IF (.NOT.(SHIELD(WHO) .LT. 1200. .AND. ENERGY(WHO) .GT. 1500.)) GO *TO 3250 ENERGY(WHO) = ENERGY(WHO) + SHIELD(WHO) - 1200. SHIELD(WHO) = 1200. GOTO 3260 3250 CONTINUE IF (.NOT.(ENERGY(WHO) .LT. 500.)) GOTO 3270 ENERGY(WHO) = ENERGY(WHO) + SHIELD(WHO)/2. SHIELD(WHO) = SHIELD(WHO)/2. 3270 CONTINUE 3260 CONTINUE XSHIP(WHO) = .TRUE. RETURN END SUBROUTINE GETINT(NUM, FLAG, LOW, HIGH) INTEGER NUM, LOW, HIGH LOGICAL*1OK, FLAG OK = .FALSE. 3290 CONTINUE READ(5, 12, END=805, ERR=205) NCHRS, NUM 12 FORMAT(Q, I5) GOTO 806 805 CLOSE(UNIT = 5) 806 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 3320 FLAG = .FALSE. OK = .TRUE. GOTO 3330 3320 CONTINUE IF (.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GOTO 3340 OK = .TRUE. FLAG = .TRUE. GOTO 3350 3340 CONTINUE WRITE(5, 81) LOW, HIGH 81 FORMAT('0** NUMBER MUST BE BETWEEN ', I5, ' AND ', I5) WRITE(5, 91) 91 FORMAT(1H$, ' TRY AGAIN :') 3350 CONTINUE GOTO 305 205 WRITE(5, 101) 101 FORMAT(1H$, ' ** INVALID NUMERIC, TRY AGAIN :') 305 CONTINUE 3330 CONTINUE 3300 IF (.NOT.(OK)) GOTO 3290 RETURN END