0 INDENT= 4 WARN= OFF PROGRAM PLAYEM PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:14 0 LINE LEVEL C1 1 0 PROGRAM PLAYEM 2 0 C 3 0 C AUTHOR: DON LEDFORD OCTOBER 1979 4 0 C 5 0 TEXT COMMON 6 0 BEGIN COMMON 7 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 8 0 + SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), 10 0 + XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), 11 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 12 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 13 0 REAL LAUNCH 14 0 INTEGER SCAN,WHOM,CREW,HYPER,TORPS 15 0 LOGICAL*1 THRU,XSHIP,CLOAK 16 0 BYTE UNIV,MESSAG 17 0 ENDTEXT 18 0 LOGICAL*1 DONE,OK 19 0 INTEGER SCON(8) 20 0 C 21 0 C 22 0 C 23 0 NS=0 24 0 WRITE(5,) 10000 25 0 FORMAT('0ENTER THE NUMBERS FOR THE SHIPS TO BE RUN') 26 0 DONE=.FALSE. 27 0 UNTIL .NOT. OK .OR. (NS .GT. 7) DO 28 1 WRITE(5,) 10004 29 1 FORMAT('0THE FOLLOWING VESSELS ARE AVAILABLE FOR USE') 30 1 FOR I=1 UNTIL 8 DO 31 2 IF .NOT. XSHIP(I) THEN 32 3 WRITE(5,) I 10011 33 3 FORMAT(' SHIP ',I1) 34 2 ENDIF 35 1 ENDDO 36 1 WRITE(5,) 10012 37 1 FORMAT('$SHIP NUMBER ? ') 38 1 CALL GETINT(IW,OK,1,8) 39 1 IF OK THEN 40 2 NS=NS+1 41 2 SCON(NS)=IW 42 2 XSHIP(IW)=.TRUE. 43 1 ENDIF 44 0 ENDDO 45 0 WRITE(5,) 10016 46 0 FORMAT('$ENTER MAX SPEED OF ROBOT SHIPS (INTEGER 1-8) >') 47 0 CALL GETINT(IR,OK,1,8) 48 0 IF OK THEN 49 1 WP=IR 50 0 ELSE 0 PROGRAM PLAYEM 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYEM PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:18 0 LINE LEVEL C1 51 1 WP=8. 52 0 ENDIF 53 0 WRITE(5,) 10020 54 0 FORMAT('$ENTER REACTION TIME OF ROBOTS (1-5, 1 IS FASTEST) >') 55 0 CALL GETINT(IR,OK,1,5) 56 0 IF OK THEN 57 1 IR=IR*20 58 0 ELSE 59 1 IR=30 60 0 ENDIF 61 0 WRITE(5,) 10024 62 0 FORMAT('$ENTER AMOUNT OF PHASER FIRE FROM ROBOTS (1-5) >') 63 0 CALL GETINT(IP,OK,1,5) 64 0 IF OK THEN 65 1 IP=IP+1 66 0 ELSE 67 1 IP=6 68 0 ENDIF 69 0 WRITE(5,) 10028 70 0 FORMAT('$ENTER AVERAGE DEGREE OF INACCURACY (0-90) >') 71 0 CALL GETINT(MIS,OK,0,90) 72 0 IF .NOT. OK THEN 73 1 MIS=0 74 0 ENDIF 75 0 UNTIL DONE DO 76 1 FOR IT=1 UNTIL 6 DO 77 2 FOR I=1 UNTIL NS DO 78 3 CALL PLAY(SCON,I,IT,WP,IP,MIS) 79 2 ENDDO 80 2 CALL WAIT(IR,0,M) 81 1 ENDDO 82 0 ENDDO 83 0 STOP 84 0 END 0 PROGRAM PLAYEM 1 0 INDENT= 4 WARN= OFF SUBROUTINE INTERS(TDIR,DIRT,WT,WP,I1,I2,ANG) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:21 0 LINE LEVEL C1 1 0 SUBROUTINE INTERS(TDIR,DIRT,WT,WP,I1,I2,ANG) 2 0 C 3 0 C COMPUTE INTERSECTION 4 0 C 5 0 A1=TDIR/57.2952 6 0 A2=DIRT/57.2952 7 0 ANG=ASIN(SIN(A2-A1)*WT/WP)*57.2952 + TDIR 8 0 RETURN 9 0 END 0 SUBROUTINE INTERS(TDIR,DIRT,WT,WP,I1,I2,ANG) 1 0 INDENT= 4 WARN= OFF SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:21 0 LINE LEVEL C1 1 0 SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, 2 0 +EDIR,PDIR,BDIR,HDIR) 3 0 TEXT COMMON 4 0 BEGIN COMMON 5 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 6 0 + SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), 7 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), 8 0 + XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), 9 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 10 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 11 0 REAL LAUNCH 12 0 INTEGER SCAN,WHOM,CREW,HYPER,TORPS 13 0 LOGICAL*1 THRU,XSHIP,CLOAK 14 0 BYTE UNIV,MESSAG 15 0 ENDTEXT 16 0 INTEGER ENUM,WHO,SCON(8) 17 0 BYTE ALPHA 18 0 REAL D1(4) 19 0 C 20 0 C 21 0 C 22 0 C 23 0 BDIS=1.6E37 24 0 EDIS=1.6E37 25 0 PDIS=1.6E37 26 0 HDIS=1.6E37 27 0 WHO=SCON(IW) 28 0 ID=SCAN(WHO) 29 0 X=XCORD(WHO) 30 0 Y=YCORD(WHO) 31 0 C 32 0 FOR IX= -ID UNTIL + ID DO 33 1 IX1=X + IX 34 1 FOR IY= -ID UNTIL ID DO 35 2 IY1=Y + IY 36 2 IF (IX1 .GE. 1) .AND. (IX1 .LE. 100) .AND. (IY1 .GE. 1) .AND. 37 2 + (IY1 .LE. 100) THEN 38 3 ALPHA= UNIV(IX1,IY1) 39 3 IF ALPHA .NE. '.' .AND. ALPHA .NE. '*' THEN 40 4 D=( (X-IX1)**2 + (Y-IY1)**2)**.5 41 4 RY=IY1 42 4 RX=IX1 43 4 DUR=ATAN2((RY+.5-Y),(RX+.5-X))*57.2952 44 4 IF DUR .LT. 0. THEN 45 5 DUR=DUR+360. 46 4 ENDIF 47 4 SELECT 48 4 C 49 4 WHEN ALPHA .EQ. 'B' THEN 50 5 IF D .LT. BDIS THEN 0 SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, 1 0 INDENT= 4 WARN= OFF SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:24 0 LINE LEVEL C1 51 6 BDIS=D 52 6 BDIR=DUR 53 5 ENDIF 54 5 C 55 4 WHEN ALPHA .EQ. '#' THEN 56 5 HDIS=D 57 5 HDIR=DUR 58 5 C 59 4 WHEN ALPHA .EQ. '@' THEN 60 5 IF D .LT. PDIS THEN 61 6 PDIS=D 62 6 PDIR=DUR 63 5 ENDIF 64 5 C 65 4 ENDS 66 4 C 67 3 ENDIF 68 2 ENDIF 69 1 ENDDO 70 0 ENDDO 71 0 C 72 0 C * FIND CLOSEST ENEMY 73 0 C 74 0 FOR I=1 UNTIL 8 DO 75 1 IF XSHIP(I) THEN 76 2 FOR K=1 UNTIL 8 DO 77 3 IF SCON(K) .EQ. I THEN 78 4 GOTO 100 79 3 ENDIF 80 2 ENDDO 81 2 X1=XCORD(I) 82 2 IF X1 .LT. 50. THEN 83 3 X2=X1+100. 84 2 ELSE 85 3 X2=X1-100. 86 2 ENDIF 87 2 Y1=YCORD(I) 88 2 IF Y1 .LT. 50. THEN 89 3 Y2=Y1+100. 90 2 ELSE 91 3 Y2=Y1-100. 92 2 ENDIF 93 2 D1(1)=((X-X1)**2 + (Y-Y1)**2)**.5 94 2 D1(2)=((X-X1)**2 + (Y-Y2)**2)**.5 95 2 D1(3)=((X-X2)**2 + (Y-Y1)**2)**.5 96 2 D1(4)=((X-X2)**2 + (Y-Y2)**2)**.5 97 2 IT=1 98 2 FOR J=2 UNTIL 4 DO 99 3 IF D1(J) .LT. D1(IT) THEN 100 4 IT=J 0 SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, 1 0 INDENT= 4 WARN= OFF SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:29 0 LINE LEVEL C1 101 3 ENDIF 102 2 ENDDO 103 2 D=D1(IT) 104 2 SELECT 105 2 WHEN IT .EQ. 1 THEN 106 3 YD=Y1 107 3 XD=X1 108 2 WHEN IT .EQ. 2 THEN 109 3 YD=Y2 110 3 XD=X1 111 2 WHEN IT .EQ. 3 THEN 112 3 YD=Y1 113 3 XD=X2 114 2 OTHERWISE 115 3 YD=Y2 116 3 XD=X2 117 2 ENDS 118 2 IF D .LT. EDIS THEN 119 3 EDIS=D 120 3 ENUM=I 121 3 EDIR=ATAN2((YD-Y),(XD-X))*57.2952 122 3 IF EDIR .LT. 0. THEN 123 4 EDIR=EDIR+360. 124 3 ENDIF 125 2 ENDIF 126 2 100 CONTINUE 127 1 ENDIF 128 0 ENDDO 129 0 RETURN 130 0 END 0 SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, 1 0 INDENT= 4 WARN= OFF SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:31 0 LINE LEVEL C1 1 0 SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) 2 0 TEXT COMMON 3 0 BEGIN COMMON 4 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 5 0 + SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), 6 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), 7 0 + XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), 8 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 9 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 10 0 REAL LAUNCH 11 0 INTEGER SCAN,WHOM,CREW,HYPER,TORPS 12 0 LOGICAL*1 THRU,XSHIP,CLOAK 13 0 BYTE UNIV,MESSAG 14 0 ENDTEXT 15 0 INTEGER WHO 16 0 INTEGER ENUM 17 0 INTEGER SCON(8) 18 0 BYTE ALPHA 19 0 LOGICAL*1 OK 20 0 C 21 0 WHO=SCON(IW) 22 0 R=RAN(I1,I2) 23 0 CALL SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, 24 0 +EDIR,PDIR,BDIR,HDIR) 25 0 CALL INTERS(EDIR,DIR(ENUM),WARP(ENUM),10.,I1,I2,ANG) 26 0 SELECT 27 0 WHEN PDIS .LT. 5. .AND. (TORPS(WHO) .GT. 0) .AND. 28 0 +IT .EQ. 5 THEN 29 1 IF LAUNCH(WHO) .LT. 0. THEN 30 2 TORPS(WHO)=TORPS(WHO)-1 31 2 LAUNCH(WHO)=PDIR 32 1 ENDIF 33 1 C 34 0 WHEN EDIS .LT. 10. THEN 35 1 SELECT 36 1 WHEN R .LT. .4 THEN 37 2 IF PHA(WHO) .LT. 0. .AND. IP .GT. IT .AND. 38 2 + ENERGY(WHO) .GT. 500. THEN 39 3 PHA(WHO)=EDIR 40 3 ENERGY(WHO)=ENERGY(WHO)-50. 41 2 ENDIF 42 2 C 43 1 OTHERWISE 44 2 IF LAUNCH(WHO) .LT. 0. .AND. TORPS(WHO) .GT. 0 .AND. 45 2 + (IT .EQ. 1 .OR. IT .EQ. 4 ) THEN 46 3 ANG=ANG + MIS-2*MIS*RAN(I1,I2) 47 3 IF ANG .LT. 0. THEN 48 4 ANG=ANG+360. 49 3 ENDIF 50 3 LAUNCH(WHO)=ANG 0 SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) 1 0 INDENT= 4 WARN= OFF SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:35 0 LINE LEVEL C1 51 3 TORPS(WHO)=TORPS(WHO)-1 52 2 ENDIF 53 2 C 54 1 ENDS 55 0 ENDS 56 0 SELECT 57 0 WHEN HDIS .LE. 10. THEN 58 1 DUR=-HDIR 59 1 C 60 0 WHEN ENERGY(WHO) .LT. 2500. THEN 61 1 IF BDIS .LT. 11. THEN 62 2 DUR=BDIR 63 1 ELSE 64 2 DUR=-EDIR 65 2 IF EDIS .LT. 10. .AND. NHOM(WHO) .GT. 0. .AND. 66 2 + (IT .EQ. 2 .OR. IT .EQ. 4) THEN 67 3 NHOM(WHO)=NHOM(WHO)-1 68 3 WHOM(WHO,NHOM(WHO))=-ENUM 69 2 ENDIF 70 1 ENDIF 71 1 C 72 0 WHEN EDIS .GT. 10. THEN 73 1 DUR=ANG 74 0 WHEN EDIS .LT. 10. .AND. IT .EQ. 1 THEN 75 1 DUR=ANG + 90. - 180.*RAN(I1,I2) 76 1 C 77 0 OTHERWISE 78 1 CONTINUE 79 0 ENDS 80 0 C 81 0 OK =.FALSE. 82 0 UNTIL OK DO 83 1 IX=XCORD(WHO) + COS(DUR/57.2592)*.8 84 1 IY=YCORD(WHO) + SIN(DUR/57.2952)*.8 85 1 IF IX .GT. 100 THEN 86 2 IX=1 87 1 ENDIF 88 1 IF IX .LT. 1 THEN 89 2 IX=100 90 1 ENDIF 91 1 IF IY .GT. 100 THEN 92 2 IY=1 93 1 ENDIF 94 1 IF IY .LT. 1 THEN 95 2 IY=100 96 1 ENDIF 97 1 ALPHA=UNIV(IX,IY) 98 1 IF (ALPHA .EQ. '.') .OR. ((ALPHA .EQ. 'B') .AND. 99 1 + (ENERGY(WHO) .LT. 4000.)) THEN 100 2 OK=.TRUE. 0 SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) 1 0 INDENT= 4 WARN= OFF SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:42 0 LINE LEVEL C1 101 1 ELSE 102 2 IF R .GT. .5 THEN 103 3 DUR=DUR + 45. 104 2 ELSE 105 3 DUR=DUR - 45. 106 2 ENDIF 107 1 ENDIF 108 0 ENDDO 109 0 DIR(WHO)=DUR 110 0 WARP(WHO)=WP 111 0 IF SHIELD(WHO) .LT. 1200. .AND. ENERGY(WHO) .GT. 1500. THEN 112 1 ENERGY(WHO)=ENERGY(WHO)+SHIELD(WHO)-1200. 113 1 SHIELD(WHO)=1200. 114 0 ENDIF 115 0 XSHIP(WHO)=.TRUE. 116 0 RETURN 117 0 END 0 SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 29-NOV-79 INLIST= ON C1= P 08:34:43 0 LINE LEVEL C1 1 0 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 2 0 INTEGER NUM,LOW,HIGH 3 0 LOGICAL*1 OK,FLAG 4 0 OK=.FALSE. 5 0 UNTIL OK DO 6 1 READ(5,,END=800,ERR=200) NCHRS,NUM 10003 7 1 FORMAT(Q,I5) 8 1 GOTO 810 9 1 800 CLOSE(UNIT=5) 10 1 810 CONTINUE 11 1 IF NCHRS .EQ. 0 THEN 12 2 FLAG=.FALSE. 13 2 OK=.TRUE. 14 1 ELSE 15 2 IF (NUM .GE. LOW) .AND. (NUM .LE. HIGH) THEN 16 3 OK=.TRUE. 17 3 FLAG=.TRUE. 18 2 ELSE 19 3 WRITE(5,) LOW,HIGH 10010 20 3 FORMAT('0** NUMBER MUST BE BETWEEN ',I5,' AND ',I5) 21 3 WRITE(5,) 10011 22 3 FORMAT(1H$,' TRY AGAIN :') 23 2 ENDIF 24 2 GOTO 300 25 2 200 WRITE(5,100) 26 2 100 FORMAT(1H$,' ** INVALID NUMERIC, TRY AGAIN :') 27 2 300 CONTINUE 28 1 ENDIF 29 0 ENDDO 30 0 RETURN 31 0 END 0 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH)