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), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM 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 2040 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 2020 CONTINUE 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*20 GOTO 2140 2130 CONTINUE IR = 30 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 2250 CONTINUE CALL WAIT(IR, 0, M) 2220 CONTINUE 2230 CONTINUE 2200 IF (.NOT.(DONE)) GOTO 2190 2210 CONTINUE 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), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM 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 2390 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 2390 CONTINUE 2350 CONTINUE 2320 CONTINUE 2300 CONTINUE 2280 CONTINUE 2290 CONTINUE C C * FIND CLOSEST ENEMY C 2260 CONTINUE 2270 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 2490 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 2570 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 2630 2620 CONTINUE IF (.NOT.(IIT .EQ. 3)) GOTO 2640 YD = Y1 XD = X2 GOTO 2650 2640 CONTINUE YD = Y2 XD = X2 2650 CONTINUE 2630 CONTINUE 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 2450 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 2710 2700 CONTINUE DIRNRM = DIR 2710 CONTINUE 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), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM 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(WH *O) .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. *(IIT .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 2770 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 2770 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 294 *0 DUR = BDIR GOTO 2950 2940 CONTINUE IF (.NOT.(EDIS .GT. 10.)) GOTO 2960 DUR = ANG - 10. GOTO 2970 2960 CONTINUE IF (.NOT.(EDIS .LT. 5.)) GOTO 2980 DUR = ANG + 80. C$ NET(WHO) = .TRUE. GOTO 2990 2980 CONTINUE IF (.NOT.(EDIS .LT. 10.)) GOTO 3000 C$ DUR=ANG + 90. - 180.*RAN(I1I,I2I) DUR = ANG + 20. 3000 CONTINUE 2990 CONTINUE 2970 CONTINUE 2950 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 3120 CONTINUE 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 3310 CONTINUE RETURN END