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 JUN 1982 LARRY WAKEMAN INITIALIZE USING INDIRECT C COMMAND FILE 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 LOGICAL*1DONE, OK INTEGER SCON(8) C LCW JUN-82 LOGICAL*1IND C LCW JUN-82 CHARACTER*80MCRBUF C LCW JUN-82 CHARACTER*32INDFIL CHARACTER*1CR, ESC DATA CR/13/, ESC/27/ BYTE ROBNAM(10) DATA ROBNAM/'R', 'O', 'B', 'O', 'T', 5*' '/ C C C C LCW JUN-82 IUNIT = 5 C C ALL REFERENCES TO IUNIT WERE ADDED BY # LCW JUN-82 C C LCW JUN-82 CALL GETMCR(MCRBUF, LCMDLN) C LCW JUN-82 IND = .FALSE. C C NOW WE CHECK TO SEE IF HE IS RUNNING AN # LCW JUN-82 C INDIRECT COMMAND FILE # LCW JUN-82 C C LCW JUN-82 ISAVE2 = 0 DO 2000 ICNT = 4, LCMDLN + 1 C LCW JUN-82 IF (.NOT.(MCRBUF(ICNT:ICNT) .EQ. '@')) GOTO 2020 C LCW JUN-82 C LCW JUN-82 IND = .TRUE. C LCW JUN-82 ISAVE = ICNT C LCW JUN-82 IUNIT = 1 C LCW JUN-82 GOTO 2030 2020 CONTINUE IF (.NOT.(IND)) GOTO 2040 C LCW JUN-82 C LCW JUN-82 IF (.NOT.((MCRBUF(ICNT:ICNT) .EQ. CR) .OR. (MCRBUF(ICNT:ICNT *) .EQ. ESC))) GOTO 2060 C LCW JUN-82 C LCW JUN-82 ISAVE2 = ICNT - ISAVE 2060 CONTINUE GOTO 2010 C LCW JUN-82 2040 CONTINUE 2030 CONTINUE C LCW JUN-82 2000 CONTINUE 2010 CONTINUE C LCW JUN-82 INDFIL = MCRBUF(ISAVE + 1:ISAVE2 + ISAVE - 1) NS = 0 IF (.NOT.(IND)) GOTO 2080 C LCW JUN-82 C LCW JUN-82 OPEN(UNIT = IUNIT, NAME = INDFIL, TYPE = 'OLD') C LCW JUN-82 2080 CONTINUE WRITE(5, 1) 1 FORMAT('0ENTER THE NUMBERS FOR THE SHIPS TO BE RUN') DONE = .FALSE. 2100 CONTINUE WRITE(5, 11) 11 FORMAT('0THE FOLLOWING VESSELS ARE AVAILABLE FOR USE') DO 2130 I = 1, 8 IF (.NOT.(.NOT.SHPACT(I))) GOTO 2150 WRITE(5, 21) I 21 FORMAT(' SHIP ', I1) 2150 CONTINUE 2130 CONTINUE 2140 CONTINUE WRITE(5, 31) 31 FORMAT('$SHIP NUMBER? ') CALL GETINT(IW, OK, 1, 8, IUNIT) IF (.NOT.(IND)) GOTO 2170 C LCW JUN-82 WRITE(5, 22) IW 2170 CONTINUE C LCW JUN-82 22 FORMAT(' ', I) IF (.NOT.(OK)) GOTO 2190 NS = NS + 1 SCON(NS) = IW SHPACT(IW) = .TRUE. DO 2210 I = 1, 10 SHPNAM(I, IW) = ROBNAM(I) 2210 CONTINUE 2220 CONTINUE 2190 CONTINUE 2110 IF (.NOT.(.NOT.OK .OR. (NS .GT. 7))) GOTO 2100 2120 CONTINUE IF (.NOT.(NS .EQ. 0)) GOTO 2230 CALL EXIT 2230 CONTINUE WRITE(5, 41) 41 FORMAT('$ENTER MAX SPEED OF ROBOT SHIPS (INTEGER 1-8): ') CALL GETINT(IR, OK, 1, 8, IUNIT) C LCW JUN-82 WRITE(5, 22) IR IF (.NOT.(OK)) GOTO 2250 WP = IR GOTO 2260 2250 CONTINUE WP = 8. 2260 CONTINUE WRITE(5, 51) 51 FORMAT('$ENTER REACTION TIME OF ROBOTS (1-5, 1 IS FASTEST): ') CALL GETINT(IR, OK, 1, 5, IUNIT) C LCW JUN-82 WRITE(5, 22) IR IF (.NOT.(OK)) GOTO 2270 IR = IR*20 GOTO 2280 2270 CONTINUE IR = 30 2280 CONTINUE WRITE(5, 61) 61 FORMAT('$ENTER AMOUNT OF PHASER FIRE FROM ROBOTS (1-5): ') CALL GETINT(IP, OK, 1, 5, IUNIT) C LCW JUN-82 WRITE(5, 22) IP IF (.NOT.(OK)) GOTO 2290 IP = IP + 1 GOTO 2300 2290 CONTINUE IP = 6 2300 CONTINUE WRITE(5, 71) 71 FORMAT('$ENTER AVERAGE DEGREE OF INACCURACY (0-90): ') CALL GETINT(MIS, OK, 0, 90, IUNIT) C LCW JUN-82 WRITE(5, 22) MIS IF (.NOT.(.NOT.OK)) GOTO 2310 MIS = 0 2310 CONTINUE IF (.NOT.(IND)) GOTO 2330 C LCW JUN-82 C LCW JUN-82 CLOSE(UNIT = IUNIT, DISPOSE = 'SAVE') 2330 CONTINUE 2350 CONTINUE DO 2380 IIT = 1, 6 DO 2400 I = 1, NS CALL PLAY(SCON, I, IIT, WP, IP, MIS) 2400 CONTINUE 2410 CONTINUE CALL WAIT(IR, 0, M) 2380 CONTINUE 2390 CONTINUE 2360 IF (.NOT.(DONE)) GOTO 2350 2370 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 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 INTEGER ENUM, WHO, SCON(8) BYTE ALPHA REAL D1(4) 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 2420 IX = - ID, + ID IX1 = X + IX DO 2440 IY = - ID, ID IY1 = Y + IY IF (.NOT.((IX1 .GE. 1) .AND. (IX1 .LE. 100) .AND. (IY1 .GE. 1) * .AND. (IY1 .LE. 100))) GOTO 2460 ALPHA = UNIV(IX1, IY1) IF (.NOT.(ALPHA .NE. ' ' .AND. ALPHA .NE. '*')) GOTO 2480 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 2500 IF (.NOT.(D .LT. BDIS)) GOTO 2520 BDIS = D BDIR = DUR C 2520 CONTINUE GOTO 2510 2500 CONTINUE IF (.NOT.(ALPHA .EQ. '#')) GOTO 2540 HDIS = D HDIR = DUR C GOTO 2550 2540 CONTINUE IF (.NOT.(ALPHA .EQ. '@')) GOTO 2560 IF (.NOT.(D .LT. PDIS)) GOTO 2580 PDIS = D PDIR = DUR C 2580 CONTINUE C 2560 CONTINUE 2550 CONTINUE 2510 CONTINUE 2480 CONTINUE 2460 CONTINUE 2440 CONTINUE 2450 CONTINUE C C * FIND CLOSEST ENEMY C 2420 CONTINUE 2430 CONTINUE DO 2600 I = 1, 8 IF (.NOT.(SHPACT(I) .AND. .NOT.CLOAK(I))) GOTO 2620 DO 2640 K = 1, 8 IF (.NOT.(SCON(K) .EQ. I)) GOTO 2660 GOTO 101 2660 CONTINUE 2640 CONTINUE 2650 CONTINUE X1 = XCORD(I) IF (.NOT.(X1 .LT. 50.)) GOTO 2680 X2 = X1 + 100. GOTO 2690 2680 CONTINUE X2 = X1 - 100. 2690 CONTINUE Y1 = YCORD(I) IF (.NOT.(Y1 .LT. 50.)) GOTO 2700 Y2 = Y1 + 100. GOTO 2710 2700 CONTINUE Y2 = Y1 - 100. 2710 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 2720 J = 2, 4 IF (.NOT.(D1(J) .LT. D1(IIT))) GOTO 2740 IIT = J 2740 CONTINUE 2720 CONTINUE 2730 CONTINUE D = D1(IIT) IF (.NOT.(IIT .EQ. 1)) GOTO 2760 YD = Y1 XD = X1 GOTO 2770 2760 CONTINUE IF (.NOT.(IIT .EQ. 2)) GOTO 2780 YD = Y2 XD = X1 GOTO 2790 2780 CONTINUE IF (.NOT.(IIT .EQ. 3)) GOTO 2800 YD = Y1 XD = X2 GOTO 2810 2800 CONTINUE YD = Y2 XD = X2 2810 CONTINUE 2790 CONTINUE 2770 CONTINUE IF (.NOT.(D .LT. EDIS)) GOTO 2820 EDIS = D ENUM = I EDIR = DIRNRM(ATAN3((YD - Y), (XD - X))*57.29577951, 360.) 2820 CONTINUE 101 CONTINUE 2620 CONTINUE 2600 CONTINUE 2610 CONTINUE RETURN END REAL FUNCTION DIRNRM(DIR, POSLIM) IF (.NOT.(DIR .GT. POSLIM)) GOTO 2840 DIRNRM = DIR - 360. GOTO 2850 2840 CONTINUE IF (.NOT.(DIR .LT. POSLIM-360.)) GOTO 2860 DIRNRM = DIR + 360. GOTO 2870 2860 CONTINUE DIRNRM = DIR 2870 CONTINUE 2850 CONTINUE RETURN END SUBROUTINE PLAY(SCON, IW, IIT, WP, IP, MIS) 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 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) IF (.NOT.(EDIS .GE. 5.)) GOTO 2880 NET(WHO) = .FALSE. 2880 CONTINUE IF (.NOT.(PDIS .LT. 5. .AND. (TORPS(WHO) .GT. 0) .AND. IIT .EQ. 5) *) GOTO 2900 IF (.NOT.(LAUNCH(WHO) .LT. 0.)) GOTO 2920 TORPS(WHO) = TORPS(WHO) - 1 LAUNCH(WHO) = PDIR 2920 CONTINUE GOTO 2910 2900 CONTINUE IF (.NOT.(EDIS .LT. 10.)) GOTO 2940 IF (.NOT.(R .LT. .4)) GOTO 2960 IF (.NOT.(PHA(WHO) .LT. 0. .AND. IP .GT. IIT .AND. ENERGY(WH *O) .GT. 500.)) GOTO 2980 PHA(WHO) = EDIR ENERGY(WHO) = ENERGY(WHO) - 50. 2980 CONTINUE GOTO 2970 2960 CONTINUE IF (.NOT.(LAUNCH(WHO) .LT. 0. .AND. TORPS(WHO) .GT. 0 .AND. *(IIT .EQ. 1 .OR. IIT .EQ. 4))) GOTO 3000 ANG = DIRNRM(ANG + MIS - 2*MIS*RAN(I1I, I2I), 360.) LAUNCH(WHO) = ANG TORPS(WHO) = TORPS(WHO) - 1 GOTO 3010 3000 CONTINUE IF (.NOT.(NHOM(WHO) .GT. 0 .AND. IIT .EQ. 1)) GOTO 3020 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 3020 CONTINUE 3010 CONTINUE 2970 CONTINUE GOTO 2950 2940 CONTINUE IF (.NOT.(EDIS .LT. 20. .AND. (IIT .EQ. 1) .AND. NHOM(WHO) .GT *. 2)) GOTO 3040 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 3040 CONTINUE 2950 CONTINUE 2910 CONTINUE IF (.NOT.(ENERGY(WHO) .LT. 2500.)) GOTO 3060 IF (.NOT.(BDIS .LT. 11.)) GOTO 3080 DUR = BDIR GOTO 3090 3080 CONTINUE DUR = 180. - EDIR IF (.NOT.(EDIS .LT. 20. .AND. NHOM(WHO) .GT. 0. .AND. (IIT .EQ *. 2 .OR. IIT .EQ. 4))) GOTO 3100 NHOM(WHO) = NHOM(WHO) - 1 WHOM(WHO, NHOM(WHO)) = - ENUM 3100 CONTINUE 3090 CONTINUE GOTO 3070 3060 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 312 *0 DUR = BDIR GOTO 3130 3120 CONTINUE IF (.NOT.(EDIS .GT. 10.)) GOTO 3140 DUR = ANG - 10. GOTO 3150 3140 CONTINUE IF (.NOT.(EDIS .LT. 5.)) GOTO 3160 DUR = ANG + 80. NET(WHO) = .TRUE. GOTO 3170 3160 CONTINUE IF (.NOT.(EDIS .LT. 10.)) GOTO 3180 DUR = ANG + 20. 3180 CONTINUE 3170 CONTINUE 3150 CONTINUE 3130 CONTINUE 3070 CONTINUE IF (.NOT.(HDIS .LT. 10.)) GOTO 3200 IF (.NOT.(HDIS .LT. 5.)) GOTO 3220 DUR = 180. - HDIR GOTO 3230 3220 CONTINUE IF (.NOT.(ABS(DIRNRM(HDIR-DUR, 180.)) .LT. 90.)) GOTO 3240 IF (.NOT.(DIRNRM(HDIR-DUR, 180.) .LT. 0.)) GOTO 3260 DUR = HDIR + 90. GOTO 3270 3260 CONTINUE DUR = HDIR - 90. 3270 CONTINUE 3240 CONTINUE 3230 CONTINUE C 3200 CONTINUE OK = .FALSE. 3280 CONTINUE IX = XCORD(WHO) + COS(DUR/57.29577951)*.8 IY = YCORD(WHO) + SIN(DUR/57.29577951)*.8 IF (.NOT.(IX .GT. 100)) GOTO 3310 IX = 1 3310 CONTINUE IF (.NOT.(IX .LT. 1)) GOTO 3330 IX = 100 3330 CONTINUE IF (.NOT.(IY .GT. 100)) GOTO 3350 IY = 1 3350 CONTINUE IF (.NOT.(IY .LT. 1)) GOTO 3370 IY = 100 3370 CONTINUE ALPHA = UNIV(IX, IY) IF (.NOT.((ALPHA .EQ. -WHO) .OR. (ALPHA .EQ. ' ') .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 3390 OK = .TRUE. GOTO 3400 3390 CONTINUE IF (.NOT.(R .GT. .5)) GOTO 3410 DUR = DUR + 45. GOTO 3420 3410 CONTINUE DUR = DUR - 45. 3420 CONTINUE 3400 CONTINUE 3290 IF (.NOT.(OK)) GOTO 3280 3300 CONTINUE DIR(WHO) = DIRNRM(DUR, 360.) WARP(WHO) = WP IF (.NOT.(SHIELD(WHO) .LT. 1200. .AND. ENERGY(WHO) .GT. 1500.)) GO *TO 3430 ENERGY(WHO) = ENERGY(WHO) + SHIELD(WHO) - 1200. SHIELD(WHO) = 1200. GOTO 3440 3430 CONTINUE IF (.NOT.(ENERGY(WHO) .LT. 500.)) GOTO 3450 ENERGY(WHO) = ENERGY(WHO) + SHIELD(WHO)/2. SHIELD(WHO) = SHIELD(WHO)/2. 3450 CONTINUE 3440 CONTINUE SHPACT(WHO) = .TRUE. RETURN END SUBROUTINE GETINT(NUM, FLAG, LOW, HIGH, IUNIT) C C IUNIT REFERENCE ADDED BY LCW JUN-82 C INTEGER NUM, LOW, HIGH, IUNIT LOGICAL*1OK, FLAG OK = .FALSE. 3470 CONTINUE READ(IUNIT, 12, END=805, ERR=205) NCHRS, NUM 12 FORMAT(Q, I5) GOTO 806 805 CLOSE(UNIT = IUNIT) 806 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 3500 FLAG = .FALSE. OK = .TRUE. GOTO 3510 3500 CONTINUE IF (.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GOTO 3520 OK = .TRUE. FLAG = .TRUE. GOTO 3530 3520 CONTINUE WRITE(5, 81) LOW, HIGH 81 FORMAT('0** NUMBER MUST BE BETWEEN ', I5, ' AND ', I5) WRITE(5, 91) 91 FORMAT(1H$, ' TRY AGAIN :') 3530 CONTINUE GOTO 305 205 WRITE(5, 101) 101 FORMAT(1H$, ' ** INVALID NUMERIC, TRY AGAIN :') 305 CONTINUE 3510 CONTINUE 3480 IF (.NOT.(OK)) GOTO 3470 3490 CONTINUE RETURN END