PROGRAM PLAYEM C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), $ XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS LOGICAL*1 THRU,XSHIP,CLOAK BYTE UNIV,MESSAG C END TEXT LOGICAL*1 DONE,OK INTEGER SCON(8) C C C NS=0 WRITE(5,10000) 10000 FORMAT('0ENTER THE NUMBERS FOR THE SHIPS TO BE RUN') DONE=.FALSE. C UNTIL .NOT. OK .OR. (NS .GT. 7) DO GO TO 10003 10001 IF(.NOT. OK .OR. (NS .GT. 7) ) GO TO 10002 10003 CONTINUE WRITE(5,10004) 10004 FORMAT('0THE FOLLOWING VESSELS ARE AVAILABLE FOR USE') C FOR I=1 UNTIL 8 DO I=1 GO TO 10007 10005 I = I+(1) 10007 IF(I.GT.8) GO TO 10006 C IF .NOT. XSHIP(I) THEN IF(.NOT. XSHIP(I) ) GO TO 10010 GO TO 10008 10010 CONTINUE WRITE(5,10011) I 10011 FORMAT(' SHIP ',I1) C END IF 10008 CONTINUE C END DO GO TO 10005 10006 CONTINUE WRITE(5,10012) 10012 FORMAT('$SHIP NUMBER ? ') CALL GETINT(IW,OK,1,8) C IF OK THEN IF(OK ) GO TO 10015 GO TO 10013 10015 CONTINUE NS=NS+1 SCON(NS)=IW XSHIP(IW)=.TRUE. C END IF 10013 CONTINUE C END DO GO TO 10001 10002 CONTINUE WRITE(5,10016) 10016 FORMAT('$ENTER MAX SPEED OF ROBOT SHIPS (INTEGER 1-8) >') CALL GETINT(IR,OK,1,8) C IF OK THEN IF(OK ) GO TO 10019 GO TO 10017 10019 CONTINUE WP=IR GO TO 10018 C ELSE 10017 CONTINUE WP=8. C END IF 10018 CONTINUE WRITE(5,10020) 10020 FORMAT('$ENTER REACTION TIME OF ROBOTS (1-5, 1 IS FASTEST) >') CALL GETINT(IR,OK,1,5) C IF OK THEN IF(OK ) GO TO 10023 GO TO 10021 10023 CONTINUE IR=IR*20 GO TO 10022 C ELSE 10021 CONTINUE IR=30 C END IF 10022 CONTINUE WRITE(5,10024) 10024 FORMAT('$ENTER AMOUNT OF PHASER FIRE FROM ROBOTS (1-5) >') CALL GETINT(IP,OK,1,5) C IF OK THEN IF(OK ) GO TO 10027 GO TO 10025 10027 CONTINUE IP=IP+1 GO TO 10026 C ELSE 10025 CONTINUE IP=6 C END IF 10026 CONTINUE WRITE(5,10028) 10028 FORMAT('$ENTER AVERAGE DEGREE OF INACCURACY (0-90) >') CALL GETINT(MIS,OK,0,90) C IF .NOT. OK THEN IF(.NOT. OK ) GO TO 10031 GO TO 10029 10031 CONTINUE MIS=0 C END IF 10029 CONTINUE C UNTIL DONE DO GO TO 10034 10032 IF(DONE ) GO TO 10033 10034 CONTINUE C FOR IT=1 UNTIL 6 DO IT=1 GO TO 10037 10035 IT = IT+(1) 10037 IF(IT.GT.6) GO TO 10036 C FOR I=1 UNTIL NS DO I=1 GO TO 10040 10038 I = I+(1) 10040 IF(I.GT.NS) GO TO 10039 CALL PLAY(SCON,I,IT,WP,IP,MIS) C END DO GO TO 10038 10039 CONTINUE CALL WAIT(IR,0,M) C END DO GO TO 10035 10036 CONTINUE C END DO GO TO 10032 10033 CONTINUE STOP END SUBROUTINE INTERS(TDIR,DIRT,WT,WP,I1,I2,ANG) C C COMPUTE INTERSECTION C A1=TDIR/57.2952 A2=DIRT/57.2952 ANG=ASIN(SIN(A2-A1)*WT/WP)*57.2952 + TDIR RETURN END SUBROUTINE SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, $EDIR,PDIR,BDIR,HDIR) C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), $ XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS LOGICAL*1 THRU,XSHIP,CLOAK BYTE UNIV,MESSAG C END TEXT 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 C FOR IX= -ID UNTIL + ID DO IX= -ID GO TO 10002 10000 IX = IX+(1) 10002 IF(IX.GT.+ ID) GO TO 10001 IX1=X + IX C FOR IY= -ID UNTIL ID DO IY= -ID GO TO 10005 10003 IY = IY+(1) 10005 IF(IY.GT.ID) GO TO 10004 IY1=Y + IY C IF (IX1 .GE. 1) .AND. (IX1 .LE. 100) .AND. (IY1 .GE. 1) .A C ND. (IY1 .LE. 100) THEN IF((IX1 .GE. 1) .AND. (IX1 .LE. 100) .AND. (IY1 .GE. 1) .A $ND. (IY1 .LE. 100) ) GO TO 10008 GO TO 10006 10008 CONTINUE ALPHA= UNIV(IX1,IY1) C IF ALPHA .NE. '.' .AND. ALPHA .NE. '*' THEN IF(ALPHA .NE. '.' .AND. ALPHA .NE. '*' ) GO TO 10011 GO TO 10009 10011 CONTINUE D=( (X-IX1)**2 + (Y-IY1)**2)**.5 RY=IY1 RX=IX1 DUR=ATAN2((RY+.5-Y),(RX+.5-X))*57.2952 C IF DUR .LT. 0. THEN IF(DUR .LT. 0. ) GO TO 10014 GO TO 10012 10014 CONTINUE DUR=DUR+360. C END IF 10012 CONTINUE C SELECT C C WHEN ALPHA .EQ. 'B' THEN 10017 IF(ALPHA .EQ. 'B') GO TO 10020 GO TO 10019 10020 CONTINUE C IF D .LT. BDIS THEN IF(D .LT. BDIS ) GO TO 10023 GO TO 10021 10023 CONTINUE BDIS=D BDIR=DUR C END IF 10021 CONTINUE C GO TO 10018 C WHEN ALPHA .EQ. '#' THEN 10019 IF(ALPHA .EQ. '#') GO TO 10025 GO TO 10024 10025 CONTINUE HDIS=D HDIR=DUR C GO TO 10018 C WHEN ALPHA .EQ. '@' THEN 10024 IF(ALPHA .EQ. '@') GO TO 10027 GO TO 10026 10027 CONTINUE C IF D .LT. PDIS THEN IF(D .LT. PDIS ) GO TO 10030 GO TO 10028 10030 CONTINUE PDIS=D PDIR=DUR C END IF 10028 CONTINUE C C END SELECT 10026 CONTINUE 10018 CONTINUE C C END IF 10009 CONTINUE C END IF 10006 CONTINUE C END DO GO TO 10003 10004 CONTINUE C END DO GO TO 10000 10001 CONTINUE C C * FIND CLOSEST ENEMY C C FOR I=1 UNTIL 8 DO I=1 GO TO 10033 10031 I = I+(1) 10033 IF(I.GT.8) GO TO 10032 C IF XSHIP(I) THEN IF(XSHIP(I) ) GO TO 10036 GO TO 10034 10036 CONTINUE C FOR K=1 UNTIL 8 DO K=1 GO TO 10039 10037 K = K+(1) 10039 IF(K.GT.8) GO TO 10038 C IF SCON(K) .EQ. I THEN IF(SCON(K) .EQ. I ) GO TO 10042 GO TO 10040 10042 CONTINUE GOTO 100 C END IF 10040 CONTINUE C END DO GO TO 10037 10038 CONTINUE X1=XCORD(I) C IF X1 .LT. 50. THEN IF(X1 .LT. 50. ) GO TO 10045 GO TO 10043 10045 CONTINUE X2=X1+100. GO TO 10044 C ELSE 10043 CONTINUE X2=X1-100. C END IF 10044 CONTINUE Y1=YCORD(I) C IF Y1 .LT. 50. THEN IF(Y1 .LT. 50. ) GO TO 10048 GO TO 10046 10048 CONTINUE Y2=Y1+100. GO TO 10047 C ELSE 10046 CONTINUE Y2=Y1-100. C END IF 10047 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 IT=1 C FOR J=2 UNTIL 4 DO J=2 GO TO 10051 10049 J = J+(1) 10051 IF(J.GT.4) GO TO 10050 C IF D1(J) .LT. D1(IT) THEN IF(D1(J) .LT. D1(IT) ) GO TO 10054 GO TO 10052 10054 CONTINUE IT=J C END IF 10052 CONTINUE C END DO GO TO 10049 10050 CONTINUE D=D1(IT) C SELECT C WHEN IT .EQ. 1 THEN 10057 IF(IT .EQ. 1) GO TO 10060 GO TO 10059 10060 CONTINUE YD=Y1 XD=X1 GO TO 10058 C WHEN IT .EQ. 2 THEN 10059 IF(IT .EQ. 2) GO TO 10062 GO TO 10061 10062 CONTINUE YD=Y2 XD=X1 GO TO 10058 C WHEN IT .EQ. 3 THEN 10061 IF(IT .EQ. 3) GO TO 10064 GO TO 10063 10064 CONTINUE YD=Y1 XD=X2 C OTHERWISE GO TO 10058 10063 CONTINUE YD=Y2 XD=X2 C END SELECT 10065 CONTINUE 10058 CONTINUE C IF D .LT. EDIS THEN IF(D .LT. EDIS ) GO TO 10068 GO TO 10066 10068 CONTINUE EDIS=D ENUM=I EDIR=ATAN2((YD-Y),(XD-X))*57.2952 C IF EDIR .LT. 0. THEN IF(EDIR .LT. 0. ) GO TO 10071 GO TO 10069 10071 CONTINUE EDIR=EDIR+360. C END IF 10069 CONTINUE C END IF 10066 CONTINUE 100 CONTINUE C END IF 10034 CONTINUE C END DO GO TO 10031 10032 CONTINUE RETURN END SUBROUTINE PLAY(SCON,IW,IT,WP,IP,MIS) C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), $ XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS LOGICAL*1 THRU,XSHIP,CLOAK BYTE UNIV,MESSAG C END TEXT INTEGER WHO INTEGER ENUM INTEGER SCON(8) BYTE ALPHA LOGICAL*1 OK C WHO=SCON(IW) R=RAN(I1,I2) CALL SCANER(SCON,IW,ENUM,EDIS,PDIS,BDIS,HDIS, $EDIR,PDIR,BDIR,HDIR) CALL INTERS(EDIR,DIR(ENUM),WARP(ENUM),10.,I1,I2,ANG) C SELECT C WHEN PDIS .LT. 5. .AND. (TORPS(WHO) .GT. 0) .AND. C IT .EQ. 5 THEN 10002 IF(PDIS .LT. 5. .AND. (TORPS(WHO) .GT. 0) .AND. IT $ .EQ. 5) GO TO 10005 GO TO 10004 10005 CONTINUE C IF LAUNCH(WHO) .LT. 0. THEN IF(LAUNCH(WHO) .LT. 0. ) GO TO 10008 GO TO 10006 10008 CONTINUE TORPS(WHO)=TORPS(WHO)-1 LAUNCH(WHO)=PDIR C END IF 10006 CONTINUE C GO TO 10003 C WHEN EDIS .LT. 10. THEN 10004 IF(EDIS .LT. 10.) GO TO 10010 GO TO 10009 10010 CONTINUE C SELECT C WHEN R .LT. .4 THEN 10013 IF(R .LT. .4) GO TO 10016 GO TO 10015 10016 CONTINUE C IF PHA(WHO) .LT. 0. .AND. IP .GT. IT .AND. C ENERGY(WHO) .GT. 500. THEN IF(PHA(WHO) .LT. 0. .AND. IP .GT. IT .AND. $ ENERGY(WHO) .GT. 500. ) GO TO 10019 GO TO 10017 10019 CONTINUE PHA(WHO)=EDIR ENERGY(WHO)=ENERGY(WHO)-50. C END IF 10017 CONTINUE C C OTHERWISE GO TO 10014 10015 CONTINUE C IF LAUNCH(WHO) .LT. 0. .AND. TORPS(WHO) .GT. 0 .AND. C (IT .EQ. 1 .OR. IT .EQ. 4 ) THEN IF(LAUNCH(WHO) .LT. 0. .AND. TORPS(WHO) .GT. 0 .AND. $ (IT .EQ. 1 .OR. IT .EQ. 4 ) ) GO TO 10023 GO TO 10021 10023 CONTINUE ANG=ANG + MIS-2*MIS*RAN(I1,I2) C IF ANG .LT. 0. THEN IF(ANG .LT. 0. ) GO TO 10026 GO TO 10024 10026 CONTINUE ANG=ANG+360. C END IF 10024 CONTINUE LAUNCH(WHO)=ANG TORPS(WHO)=TORPS(WHO)-1 C END IF 10021 CONTINUE C C END SELECT 10020 CONTINUE 10014 CONTINUE C END SELECT 10009 CONTINUE 10003 CONTINUE C SELECT C WHEN HDIS .LE. 10. THEN 10029 IF(HDIS .LE. 10.) GO TO 10032 GO TO 10031 10032 CONTINUE DUR=-HDIR C GO TO 10030 C WHEN ENERGY(WHO) .LT. 2500. THEN 10031 IF(ENERGY(WHO) .LT. 2500.) GO TO 10034 GO TO 10033 10034 CONTINUE C IF BDIS .LT. 11. THEN IF(BDIS .LT. 11. ) GO TO 10037 GO TO 10035 10037 CONTINUE DUR=BDIR GO TO 10036 C ELSE 10035 CONTINUE DUR=-EDIR C IF EDIS .LT. 10. .AND. NHOM(WHO) .GT. 0. .AND. C (IT .EQ. 2 .OR. IT .EQ. 4) THEN IF(EDIS .LT. 10. .AND. NHOM(WHO) .GT. 0. .AND. $ (IT .EQ. 2 .OR. IT .EQ. 4) ) GO TO 10040 GO TO 10038 10040 CONTINUE NHOM(WHO)=NHOM(WHO)-1 WHOM(WHO,NHOM(WHO))=-ENUM C END IF 10038 CONTINUE C END IF 10036 CONTINUE C GO TO 10030 C WHEN EDIS .GT. 10. THEN 10033 IF(EDIS .GT. 10.) GO TO 10042 GO TO 10041 10042 CONTINUE DUR=ANG GO TO 10030 C WHEN EDIS .LT. 10. .AND. IT .EQ. 1 THEN 10041 IF(EDIS .LT. 10. .AND. IT .EQ. 1) GO TO 10044 GO TO 10043 10044 CONTINUE DUR=ANG + 90. - 180.*RAN(I1,I2) C C OTHERWISE GO TO 10030 10043 CONTINUE CONTINUE C END SELECT 10045 CONTINUE 10030 CONTINUE C OK =.FALSE. C UNTIL OK DO GO TO 10048 10046 IF(OK ) GO TO 10047 10048 CONTINUE IX=XCORD(WHO) + COS(DUR/57.2592)*.8 IY=YCORD(WHO) + SIN(DUR/57.2952)*.8 C IF IX .GT. 100 THEN IF(IX .GT. 100 ) GO TO 10051 GO TO 10049 10051 CONTINUE IX=1 C END IF 10049 CONTINUE C IF IX .LT. 1 THEN IF(IX .LT. 1 ) GO TO 10054 GO TO 10052 10054 CONTINUE IX=100 C END IF 10052 CONTINUE C IF IY .GT. 100 THEN IF(IY .GT. 100 ) GO TO 10057 GO TO 10055 10057 CONTINUE IY=1 C END IF 10055 CONTINUE C IF IY .LT. 1 THEN IF(IY .LT. 1 ) GO TO 10060 GO TO 10058 10060 CONTINUE IY=100 C END IF 10058 CONTINUE ALPHA=UNIV(IX,IY) C IF (ALPHA .EQ. '.') .OR. ((ALPHA .EQ. 'B') .AND. C (ENERGY(WHO) .LT. 4000.)) THEN IF((ALPHA .EQ. '.') .OR. ((ALPHA .EQ. 'B') .AND. $ (ENERGY(WHO) .LT. 4000.)) ) GO TO 10063 GO TO 10061 10063 CONTINUE OK=.TRUE. GO TO 10062 C ELSE 10061 CONTINUE C IF R .GT. .5 THEN IF(R .GT. .5 ) GO TO 10066 GO TO 10064 10066 CONTINUE DUR=DUR + 45. GO TO 10065 C ELSE 10064 CONTINUE DUR=DUR - 45. C END IF 10065 CONTINUE C END IF 10062 CONTINUE C END DO GO TO 10046 10047 CONTINUE DIR(WHO)=DUR WARP(WHO)=WP C IF SHIELD(WHO) .LT. 1200. .AND. ENERGY(WHO) .GT. 1500. THEN IF(SHIELD(WHO) .LT. 1200. .AND. ENERGY(WHO) .GT. 1500. ) GO TO 10 $069 GO TO 10067 10069 CONTINUE ENERGY(WHO)=ENERGY(WHO)+SHIELD(WHO)-1200. SHIELD(WHO)=1200. C END IF 10067 CONTINUE XSHIP(WHO)=.TRUE. RETURN END SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) INTEGER NUM,LOW,HIGH LOGICAL*1 OK,FLAG OK=.FALSE. C UNTIL OK DO GO TO 10002 10000 IF(OK ) GO TO 10001 10002 CONTINUE READ(5,10003,END=800,ERR=200) NCHRS,NUM 10003 FORMAT(Q,I5) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE C IF NCHRS .EQ. 0 THEN IF(NCHRS .EQ. 0 ) GO TO 10006 GO TO 10004 10006 CONTINUE FLAG=.FALSE. OK=.TRUE. GO TO 10005 C ELSE 10004 CONTINUE C IF (NUM .GE. LOW) .AND. (NUM .LE. HIGH) THEN IF((NUM .GE. LOW) .AND. (NUM .LE. HIGH) ) GO TO 10009 GO TO 10007 10009 CONTINUE OK=.TRUE. FLAG=.TRUE. GO TO 10008 C ELSE 10007 CONTINUE WRITE(5,10010) LOW,HIGH 10010 FORMAT('0** NUMBER MUST BE BETWEEN ',I5,' AND ',I5) WRITE(5,10011) 10011 FORMAT(1H$,' TRY AGAIN :') C END IF 10008 CONTINUE GOTO 300 200 WRITE(5,100) 100 FORMAT(1H$,' ** INVALID NUMERIC, TRY AGAIN :') 300 CONTINUE C END IF 10005 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END