PROGRAM DRIVER
C
C	AUTHOR: DON LEDFORD	THE BOEING COMPANY	NOVEMBER 1978
C	DECEMBER 1978	JOHN LUTCH	ADDED CLOAKING
C	DECEMBER 1978	DON LEDFORD	ADDED ANTI-MATTER
C	MARCH 1979	RAY FRENCH	ADDED CONTINUOUS DISPLAY
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8)
      LOGICAL*1 OK,YES
      BYTE CHAR
      DATA HX/30./
      DATA HY/60./
C
      WRITE(5,10000)
10000 FORMAT('0 WELCOME TO MULTI-TREK')
      WRITE(5,10001)
10001 FORMAT('$ARE YOU CONTINUING AN EXISTING GAME ? ')
      CALL YESNO(YES)
C     IF .NOT. YES THEN
      IF(.NOT. YES )  GO TO 10004
      GO TO  10002
10004 CONTINUE
C
C      * INITIALIZE SHIPS AS UNOWNED AND NOT CLOAKED
C
C         FOR I=1 UNTIL 8 DO
          I=1
          GO TO  10007
10005     I = I+(1)
10007     IF(I.GT.8)  GO TO 10006
      XSHIP(I)=.FALSE.
      CLOAK(I)=.FALSE.
C         END DO
          GO TO  10005
10006     CONTINUE
          WRITE(5,10008)
10008     FORMAT('$ENTER STAR DENSITY OF UNIVERSE PARTS PER 100 : ')
      CALL GETREL(STARS,OK,0.,15.)
C         IF .NOT. OK THEN
          IF(.NOT. OK )  GO TO 10011
          GO TO  10009
10011     CONTINUE
      STARS=2.5
C         END IF
10009     CONTINUE
          WRITE(5,10012)
10012     FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES : ')
      CALL GETREL(BASES,OK,0.,50.)
C         IF .NOT. OK THEN
          IF(.NOT. OK )  GO TO 10015
          GO TO  10013
10015     CONTINUE
      BASES=20.
C         END IF
10013     CONTINUE
          WRITE(5,10016)
10016     FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS : ')
      CALL GETINT(N,OK,0,10)
C         IF .NOT. OK THEN
          IF(.NOT. OK )  GO TO 10019
          GO TO  10017
10019     CONTINUE
      N=3
C         END IF
10017     CONTINUE
          WRITE(5,10020)
10020     FORMAT('$ENTER A RANDOM INTEGER : ')
      CALL GETINT(I1,OK,-32000,32000)
C
C     * GET THE COMPUTER TIME AND MAKE IT INTO AN INTEGER < 32 K
C
      T1=SECNDS(0.0)
C         UNTIL T1 .LE. 32000 DO
          GO TO  10023
10021     IF(T1 .LE. 32000 )  GO TO 10022
10023     CONTINUE
      T1=T1/13.
C         END DO
          GO TO  10021
10022     CONTINUE
      I2=T1
C
C     * NOW GENERATE THE UNIVERSE
C
C         FOR I=1 UNTIL 100 DO
          I=1
          GO TO  10026
10024     I = I+(1)
10026     IF(I.GT.100)  GO TO 10025
C             FOR J=1 UNTIL 100 DO
              J=1
              GO TO  10029
10027         J = J+(1)
10029         IF(J.GT.100)  GO TO 10028
      RNDOM=RAN(I1,I2)
C                 SELECT
C                 WHEN RNDOM .GT. (100.-STARS)/100. THEN
10032             IF(RNDOM .GT. (100.-STARS)/100.)  GO TO 10035
                  GO TO  10034
10035             CONTINUE
      UNIV(I,J)='*'
C
                  GO TO  10033
C                 WHEN RNDOM .LE. BASES/10000. THEN
10034             IF(RNDOM .LE. BASES/10000.)  GO TO 10037
                  GO TO  10036
10037             CONTINUE
      UNIV(I,J)='B'
C
C                 OTHERWISE
                  GO TO  10033
10036             CONTINUE
      UNIV(I,J)='.'
C
C                 END SELECT
10038             CONTINUE
10033             CONTINUE
C             END DO
              GO TO  10027
10028         CONTINUE
C         END DO
          GO TO  10024
10025     CONTINUE
C
C     * PUT IN THE HYPERSPACE PORTS
C
      UNIV(20,25)='H'
      UNIV(20,75)='H'
      UNIV(50,30)='H'
      UNIV(50,70)='H'
      UNIV(80,25)='H'
      UNIV(80,75)='H'
C
C     * PUT IN THE MOBILE "BLACK HOLE"
C
      UNIV(30,60)='#'
      HX=30.
      HY=60.
C
C     * PUT IN THE RANDOM HYPER-SPACE PORTS
C
C         FOR I=1 UNTIL N DO
          I=1
          GO TO  10041
10039     I = I+(1)
10041     IF(I.GT.N)  GO TO 10040
      OK=.FALSE.
C             UNTIL OK DO
              GO TO  10044
10042         IF(OK )  GO TO 10043
10044         CONTINUE
      IX=RAN(I1,I2)*100.+1.
C                 IF IX .GT. 100 THEN
                  IF(IX .GT. 100 )  GO TO 10047
                  GO TO  10045
10047             CONTINUE
      IX=100
C                 END IF
10045             CONTINUE
      IY=RAN(I1,I2)*100.+1.
C                 IF IY .GT. 100 THEN
                  IF(IY .GT. 100 )  GO TO 10050
                  GO TO  10048
10050             CONTINUE
      IY=100
C                 END IF
10048             CONTINUE
C                 IF UNIV(IX,IY) .EQ. '.' THEN
                  IF(UNIV(IX,IY) .EQ. '.' )  GO TO 10053
                  GO TO  10051
10053             CONTINUE
      UNIV(IX,IY)='R'
      OK=.TRUE.
C                 END IF
10051             CONTINUE
C             END DO
              GO TO  10042
10043         CONTINUE
C         END DO
          GO TO  10039
10040     CONTINUE
C
C      * PUT IN THE STAR SHIPS
C
C         FOR I=1 UNTIL 8 DO
          I=1
          GO TO  10056
10054     I = I+(1)
10056     IF(I.GT.8)  GO TO 10055
      OK=.FALSE.
C             UNTIL OK DO
              GO TO  10059
10057         IF(OK )  GO TO 10058
10059         CONTINUE
      IX=RAN(I1,I2)*100.+1.
C                 IF IX .GT. 100 THEN
                  IF(IX .GT. 100 )  GO TO 10062
                  GO TO  10060
10062             CONTINUE
      IX=100
C                 END IF
10060             CONTINUE
      IY=RAN(I1,I2)*100.+1.
C                 IF IY .GT. 100 THEN
                  IF(IY .GT. 100 )  GO TO 10065
                  GO TO  10063
10065             CONTINUE
      IY=100
C                 END IF
10063             CONTINUE
C                 IF UNIV(IX,IY) .EQ. '.' THEN
                  IF(UNIV(IX,IY) .EQ. '.' )  GO TO 10068
                  GO TO  10066
10068             CONTINUE
                      ENCODE(1,10069,CHAR) I
10069                 FORMAT(I1)
      UNIV(IX,IY)=CHAR
      XCORD(I)=IX
      YCORD(I)=IY
      XCORD(I)=XCORD(I)+.5
      YCORD(I)=YCORD(I)+.5
      OK=.TRUE.
C                 END IF
10066             CONTINUE
C             END DO
              GO TO  10057
10058         CONTINUE
C         END DO
          GO TO  10054
10055     CONTINUE
C
C     * INITIALIZE STARTING STATUS OF THE STAR SHIPS
C
C         FOR I=1 UNTIL 8 DO
          I=1
          GO TO  10072
10070     I = I+(1)
10072     IF(I.GT.8)  GO TO 10071
      ENERGY(I)=10000.
      SHIELD(I)=0.
      TORPS(I)=10.
      IPOD(I)=0
      CREW(I)=400
      WARP(I)=0.
      MESSAG(I*60-59)=' '
      SCORE(I)=0.
      IT(I)=1
      HYPER(I)=3
C             FOR K=1 UNTIL 10 DO
              K=1
              GO TO  10075
10073         K = K+(1)
10075         IF(K.GT.10)  GO TO 10074
      ISENT(I,K)=0
      TDIR(I,K)=-1.
      TLOCS(I,K,1)=1
      TLOCS(I,K,2)=1
C             END DO
              GO TO  10073
10074         CONTINUE
C         END DO
          GO TO  10070
10071     CONTINUE
C
          WRITE(5,10076)
10076     FORMAT('$ENTER ENERGY DRAIN FOR CLOAKING : ')
      CALL GETREL(CDRAIN,OK,0.,2000.)
C         IF .NOT. OK THEN
          IF(.NOT. OK )  GO TO 10079
          GO TO  10077
10079     CONTINUE
      CDRAIN=25.
C         END IF
10077     CONTINUE
          WRITE(5,10080)
10080     FORMAT('$ENTER WARP SPEED OF "BLACK HOLE" : ')
      CALL GETREL(HW,OK,0.,10.)
C         IF .NOT. OK THEN
          IF(.NOT. OK )  GO TO 10083
          GO TO  10081
10083     CONTINUE
      HW=5.
C         END IF
10081     CONTINUE
C     END IF
10002 CONTINUE
      WRITE(5,10084)
10084 FORMAT('0MULTI-TREK INITIALIZED')
      THRU=-1
C
C     * HERE STARTS THE ACTUAL GAME PLAYING
C
C     WHILE THRU.GE.-1 DO
10085 IF(THRU.GE.-1 )  GO TO 10087
      GO TO  10086
10087 CONTINUE
C         UNTIL  THRU.EQ.0  DO
          GO TO  10090
10088     IF( THRU.EQ.0  )  GO TO 10089
10090     CONTINUE
      CALL WAIT(40,0,M)
C      * FIRE TORPEDOES
      CALL TORPI
C      * FIRE PHASERS
      CALL PHASER
C      * MOVE ACTIVE TORPEDOES
      CALL MTORPS
C      * MOVE SHIPS
      CALL MSHIPS(CDRAIN)
C      * MOVE THE "BLACK HOLE"
      CALL MHOLE(HX,HY,HW)
C      * HANDLE ALL ANTI-MATTER TRANSACTIONS
      CALL MANTI(HX,HY)
C         END DO
          GO TO  10088
10089     CONTINUE
C
C       ALL PLAYERS ARE GONE - BUT WAIT 15 SECONDS BEFORE LEAVING
C
      THRU=-2
      K=0
C         UNTIL K.GE.15 DO
          GO TO  10093
10091     IF(K.GE.15 )  GO TO 10092
10093     CONTINUE
      CALL WAIT(1,2,M)
C             IF THRU.GT.0 THEN
              IF(THRU.GT.0 )  GO TO 10096
              GO TO  10094
10096         CONTINUE
      K=15
              GO TO  10095
C             ELSE
10094         CONTINUE
      K=K+1
C             END IF
10095         CONTINUE
C         END DO
          GO TO  10091
10092     CONTINUE
C     END DO
      GO TO  10085
10086 CONTINUE
      CALL EXIT
      END
      SUBROUTINE MSHIPS(CDRAIN)
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
C
      BYTE CHAR,SHIP
      LOGICAL*1 OK
C
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         IF XSHIP(I) THEN
          IF(XSHIP(I) )  GO TO 10005
          GO TO  10003
10005     CONTINUE
C             IF CLOAK(I) THEN
              IF(CLOAK(I) )  GO TO 10008
              GO TO  10006
10008         CONTINUE
C      * CAN'T MOVE IF YOUR CLOAKED
      WARP(I)=0.
      ENERGY(I)=ENERGY(I)-CDRAIN
C             END IF
10006         CONTINUE
      IX=XCORD(I)
      IY=YCORD(I)
              ENCODE(1,10009,SHIP) I
10009         FORMAT(I1)
      ENERGY(I)=ENERGY(I)-WARP(I)/2
      CALL MOVE(XCORD(I),YCORD(I),X,Y,DIR(I),WARP(I),CHAR,UNIV)
      KX=X
      KY=Y
C             SELECT
C             WHEN CHAR .LE. '8' .AND. CHAR .GE. '1' THEN
10012         IF(CHAR .LE. '8' .AND. CHAR .GE. '1')  GO TO 10015
              GO TO  10014
10015         CONTINUE
C        * WE HAVE RAMMED A SHIP
                  DECODE(1,10016,CHAR) K
10016             FORMAT(I1)
      ENERGY(I)=ENERGY(I)-100.
C                 IF XSHIP(K) THEN
                  IF(XSHIP(K) )  GO TO 10019
                  GO TO  10017
10019             CONTINUE
      ENERGY(K)=ENERGY(K)-100.
      CALL SENT(K,10)
C                 END IF
10017             CONTINUE
      WARP(I)=0.
      WARP(K)=0.
      CALL SENT(I,9)
C
              GO TO  10013
C             WHEN CHAR .EQ. 'B' THEN
10014         IF(CHAR .EQ. 'B')  GO TO 10021
              GO TO  10020
10021         CONTINUE
C         * RAMMED (DOCKED) A BASE
      CALL SENT(I,1)
      TORPS(I)=10
      WARP(I)=0.
      ENERGY(I)=10000.
      SHIELD(I)=0.
      IPOD(I)=0
C
              GO TO  10013
C             WHEN CHAR .EQ. '*' THEN
10020         IF(CHAR .EQ. '*')  GO TO 10023
              GO TO  10022
10023         CONTINUE
C          * HIT A STAR
      CALL SENT(I,2)
      ENERGY(I)=ENERGY(I)-200.
      WARP(I)=0.
C
              GO TO  10013
C             WHEN CHAR .EQ. '+' THEN
10022         IF(CHAR .EQ. '+')  GO TO 10025
              GO TO  10024
10025         CONTINUE
C         * HIT A TORPEDO
      CALL SENT(I,4)
      CALL DAMAGE(I,500.)
      CALL TFIND(K,KX,KY)
C                 IF K .NE. 0 THEN
                  IF(K .NE. 0 )  GO TO 10028
                  GO TO  10026
10028             CONTINUE
      CALL SENT(K,5)
      SCORE(K)=SCORE(K)+500.
C                     IF ENERGY(I) .LE. 0 THEN
                      IF(ENERGY(I) .LE. 0 )  GO TO 10031
                      GO TO  10029
10031                 CONTINUE
      CALL SENT(K,22)
      SCORE(K)=SCORE(K)+2000.
      CALL RESET(I)
C                     END IF
10029                 CONTINUE
C                 END IF
10026             CONTINUE
C
              GO TO  10013
C             WHEN CHAR .EQ. 'H' THEN
10024         IF(CHAR .EQ. 'H')  GO TO 10033
              GO TO  10032
10033         CONTINUE
C         * HIT A HYPERSPACE PORT
      CALL SENT(I,17)
C                 SELECT USING HYPER(I)
                  I10037 =  HYPER(I)
C                 WHEN 1 THEN
10036             IF(I10037.EQ.1)  GO TO 10039
                  GO TO  10038
10039             CONTINUE
      KX=20
      KY=75
                  GO TO  10037
C                 WHEN 2 THEN
10038             IF(I10037.EQ.2)  GO TO 10041
                  GO TO  10040
10041             CONTINUE
      KX=50
      KY=70
                  GO TO  10037
C                 WHEN 3 THEN
10040             IF(I10037.EQ.3)  GO TO 10043
                  GO TO  10042
10043             CONTINUE
      KX=80
      KY=75
                  GO TO  10037
C                 WHEN 4 THEN
10042             IF(I10037.EQ.4)  GO TO 10045
                  GO TO  10044
10045             CONTINUE
      KX=20
      KY=25
                  GO TO  10037
C                 WHEN 5 THEN
10044             IF(I10037.EQ.5)  GO TO 10047
                  GO TO  10046
10047             CONTINUE
      KX=50
      KY=30
                  GO TO  10037
C                 WHEN 6 THEN
10046             IF(I10037.EQ.6)  GO TO 10049
                  GO TO  10048
10049             CONTINUE
      KX=80
      KY=25
C                 OTHERWISE
                  GO TO  10037
10048             CONTINUE
      STOP 50
C                 END SELECT
10050             CONTINUE
10037             CONTINUE
C
C          * PUT THE SHIP NEAR THE DESTINATION PORT IF POSSIBLE
C
C                 FOR II=(KX-1) UNTIL (KX+1) DO
                  II=(KX-1)
                  GO TO  10053
10051             II = II+(1)
10053             IF(II.GT.(KX+1))  GO TO 10052
C                     FOR IJ=(KY-1) UNTIL (KY+1) DO
                      IJ=(KY-1)
                      GO TO  10056
10054                 IJ = IJ+(1)
10056                 IF(IJ.GT.(KY+1))  GO TO 10055
C                         IF UNIV(II,IJ) .EQ. '.' THEN
                          IF(UNIV(II,IJ) .EQ. '.' )  GO TO 10059
                          GO TO  10057
10059                     CONTINUE
      UNIV(II,IJ)=SHIP
      UNIV(IX,IY)='.'
      XCORD(I)=II
      YCORD(I)=IJ
      XCORD(I)=XCORD(I)+.5
      YCORD(I)=YCORD(I)+.5
      GOTO 100
C                         END IF
10057                     CONTINUE
C                     END DO
                      GO TO  10054
10055                 CONTINUE
C                 END DO
                  GO TO  10051
10052             CONTINUE
C          * IF WE ARE HERE WE DIDN'T FIND AN EMPTY SPOT ( VERY UNLIKELY
      CALL SENT(I,18)
 100  WARP(I)=0.
C
              GO TO  10013
C             WHEN CHAR .EQ. '#' THEN
10032         IF(CHAR .EQ. '#')  GO TO 10061
              GO TO  10060
10061         CONTINUE
C         * RUN INTO THE "BLACK HOLE" ( NICE FLYING)
      CALL SENT(I,15)
      CALL RESET(I)
C
              GO TO  10013
C             WHEN CHAR .EQ. 'R' THEN
10060         IF(CHAR .EQ. 'R')  GO TO 10063
              GO TO  10062
10063         CONTINUE
C         * HIT A RANDOM HYPERSPACE PORT
      CALL SENT(I,19)
      OK=.FALSE.
C         * FIND A NEW EMPTY LOCATION
C                 UNTIL OK DO
                  GO TO  10066
10064             IF(OK )  GO TO 10065
10066             CONTINUE
      KX=RAN(I1,I2)*100.+1.
C                     IF KX .GT. 100 THEN
                      IF(KX .GT. 100 )  GO TO 10069
                      GO TO  10067
10069                 CONTINUE
      KX=100
C                     END IF
10067                 CONTINUE
      KY=RAN(I1,I2)*100.+1.
C                     IF KY .GT. 100 THEN
                      IF(KY .GT. 100 )  GO TO 10072
                      GO TO  10070
10072                 CONTINUE
      KY=100
C                     END IF
10070                 CONTINUE
C                     IF UNIV(KX,KY) .EQ. '.' THEN
                      IF(UNIV(KX,KY) .EQ. '.' )  GO TO 10075
                      GO TO  10073
10075                 CONTINUE
      OK=.TRUE.
      XCORD(I)=KX
      YCORD(I)=KY
      XCORD(I)=XCORD(I)+.5
      YCORD(I)=YCORD(I)+.5
      WARP(I)=0.
      UNIV(IX,IY)='.'
      UNIV(KX,KY)=SHIP
C                     END IF
10073                 CONTINUE
C                 END DO
                  GO TO  10064
10065             CONTINUE
C
              GO TO  10013
C             WHEN CHAR .EQ. '@' THEN
10062         IF(CHAR .EQ. '@')  GO TO 10077
              GO TO  10076
10077         CONTINUE
C       * BUMPED INTO AN ANTI-MATTER POD
      CALL SENT(I,27)
C
C             OTHERWISE
              GO TO  10013
10076         CONTINUE
      XCORD(I)=X
      YCORD(I)=Y
      UNIV(IX,IY)='.'
      UNIV(KX,KY)=SHIP
C             END SELECT
10078         CONTINUE
10013         CONTINUE
C             IF ENERGY(I) .LE. 0. THEN
              IF(ENERGY(I) .LE. 0. )  GO TO 10081
              GO TO  10079
10081         CONTINUE
      CALL SENT(I,16)
      CALL RESET(I)
C             END IF
10079         CONTINUE
C         END IF
10003     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE RESET(K)
C
C       * RE-INCARNATE DESTROYED SHIPS
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      BYTE CHAR
      XSHIP(K)=.FALSE.
      ENERGY(K)=10000.
      WARP(K)=0.
      TORPS(K)=10.
      SHIELD(K)=0.
      IPOD(K)=0
      CALL SENT(K,3)
      SCORE(K)=SCORE(K)-1000.
      KX=XCORD(K)
      KY=YCORD(K)
      UNIV(KX,KY)='.'
      CHAR='X'
C     UNTIL CHAR .EQ. '.' DO
      GO TO  10002
10000 IF(CHAR .EQ. '.' )  GO TO 10001
10002 CONTINUE
      IX=RAN(I1,I2)*100.+1.
C         IF IX .GT. 100 THEN
          IF(IX .GT. 100 )  GO TO 10005
          GO TO  10003
10005     CONTINUE
      IX=100
C         END IF
10003     CONTINUE
      IY=RAN(I1,I2)*100.+1.
C         IF IY .GT. 100 THEN
          IF(IY .GT. 100 )  GO TO 10008
          GO TO  10006
10008     CONTINUE
      IY=100
C         END IF
10006     CONTINUE
      CHAR=UNIV(IX,IY)
C     END DO
      GO TO  10000
10001 CONTINUE
      ENCODE(1,10009,CHAR) K
10009 FORMAT(I1)
      UNIV(IX,IY)=CHAR
      XCORD(K)=IX
      YCORD(K)=IY
      RETURN
      END
      SUBROUTINE THIT(I,IX,IY,CHAR)
C
C       * HANDLE TORPEDO HITS
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      BYTE CHAR
C     SELECT
C     WHEN (CHAR .EQ. 'H') .OR. (CHAR .EQ. 'R') THEN
10002 IF((CHAR .EQ. 'H') .OR. (CHAR .EQ. 'R'))  GO TO 10005
      GO TO  10004
10005 CONTINUE
C       * TORPEDO HIT ON HYPER SPACE PORT
      CONTINUE
C
      GO TO  10003
C     WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN
10004 IF((CHAR .GE. '1') .AND. (CHAR .LE. '8'))  GO TO 10007
      GO TO  10006
10007 CONTINUE
C       * TORPEDO HIT ON SHIP
          DECODE (1,10008,CHAR) K
10008     FORMAT (I1)
C         IF XSHIP(K) THEN
          IF(XSHIP(K) )  GO TO 10011
          GO TO  10009
10011     CONTINUE
      CALL DAMAGE (K,500.)
      SCORE(I)=SCORE(I)+500.
      CALL SENT(K,4)
      CALL SENT(I,5)
C             IF ENERGY (K) .LE. 0. THEN
              IF(ENERGY (K) .LE. 0. )  GO TO 10014
              GO TO  10012
10014         CONTINUE
      CALL RESET(K)
      CALL SENT(I,22)
      SCORE(I)=SCORE(I)+2000.
C             END IF
10012         CONTINUE
          GO TO  10010
C         ELSE
10009     CONTINUE
      CALL SENT(I,21)
C         END IF
10010     CONTINUE
C
      GO TO  10003
C     WHEN CHAR .EQ. '*' THEN
10006 IF(CHAR .EQ. '*')  GO TO 10016
      GO TO  10015
10016 CONTINUE
C       * TORPEDO HIT ON STAR
      CALL SENT(I,13)
C
      GO TO  10003
C     WHEN CHAR .EQ. 'B' THEN
10015 IF(CHAR .EQ. 'B')  GO TO 10018
      GO TO  10017
10018 CONTINUE
C       * TORPEDO HIT ON BASE
      CALL SENT(I,12)
      SCORE(I)=SCORE(I)-200.
C
      GO TO  10003
C     WHEN CHAR .EQ. '+' THEN
10017 IF(CHAR .EQ. '+')  GO TO 10020
      GO TO  10019
10020 CONTINUE
C       * TORPEDO HIT ON TORPEDO
      CALL SENT(I,20)
      UNIV(IX,IY)='.'
C
      GO TO  10003
C     WHEN CHAR .EQ. '@' THEN
10019 IF(CHAR .EQ. '@')  GO TO 10022
      GO TO  10021
10022 CONTINUE
C       * TORPEDO HIT ON ANTI-MATTER POD
      CALL SENT(I,26)
C
C     OTHERWISE
      GO TO  10003
10021 CONTINUE
C       * ANYTHING ELSE GETS DESTROYED
      UNIV (IX,IY) = '.'
C     END SELECT
10023 CONTINUE
10003 CONTINUE
      RETURN
      END
      SUBROUTINE PHASER
C
C      * FIRE PHASERS
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      REAL DX(3),DY(3)
      BYTE CHAR
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         IF PHA(I) .GE. 0. THEN
          IF(PHA(I) .GE. 0. )  GO TO 10005
          GO TO  10003
10005     CONTINUE
C
C       * FIRE 3 BAND WIDE BEAM (NOTE EACH BAND HAS ITS OWN HIT OR MISS
C
      DX(1)=XCORD(I)
      DY(1)=YCORD(I)
C             IF ((PHA(I) .GE. 45.) .AND. (PHA(I) .LT. 135.)) .OR.      
C                           ((PHA(I) .GE. 225.) .AND. (PHA(I) .LT. 315.)
C             ) THEN
              IF(((PHA(I) .GE. 45.) .AND. (PHA(I) .LT. 135.)) .OR.      
     $              ((PHA(I) .GE. 225.) .AND. (PHA(I) .LT. 315.)) )  GO 
     $TO 10008
              GO TO  10006
10008         CONTINUE
      DX(2)=DX(1)-1.
      DX(3)=DX(1)+1.
      DY(2)=DY(1)
      DY(3)=DY(1)
              GO TO  10007
C             ELSE
10006         CONTINUE
      DX(2)=DX(1)
      DX(3)=DX(1)
      DY(2)=DY(1)-1.
      DY(3)=DY(1)+1.
C             END IF
10007         CONTINUE
C             FOR IZ=2 UNTIL 3 DO
              IZ=2
              GO TO  10011
10009         IZ = IZ+(1)
10011         IF(IZ.GT.3)  GO TO 10010
C                 IF (DX(IZ) .GT. 100.) .OR. (DX(IZ) .LT. 1.) THEN
                  IF((DX(IZ) .GT. 100.) .OR. (DX(IZ) .LT. 1.) )  GO TO 1
     $0014
                  GO TO  10012
10014             CONTINUE
      DX(IZ)=DX(1)
C                 END IF
10012             CONTINUE
C                 IF (DY(IZ) .GT. 100.) .OR. (DY(IZ) .LT. 1.) THEN
                  IF((DY(IZ) .GT. 100.) .OR. (DY(IZ) .LT. 1.) )  GO TO 1
     $0017
                  GO TO  10015
10017             CONTINUE
      DY(IZ)=DY(1)
C                 END IF
10015             CONTINUE
C             END DO
              GO TO  10009
10010         CONTINUE
C             FOR IZ=1 UNTIL 3 DO
              IZ=1
              GO TO  10020
10018         IZ = IZ+(1)
10020         IF(IZ.GT.3)  GO TO 10019
      X1=DX(IZ)
      Y1=DY(IZ)
C                 FOR IT=1 UNTIL 10 DO
                  IT=1
                  GO TO  10023
10021             IT = IT+(1)
10023             IF(IT.GT.10)  GO TO 10022
      CALL MOVE(X1,Y1,X,Y,PHA(I),10.,CHAR,UNIV)
C                     IF CHAR .NE. '.' THEN
                      IF(CHAR .NE. '.' )  GO TO 10026
                      GO TO  10024
10026                 CONTINUE
C                         EXIT DO
                          GO TO  10022
C                     ELSE
10024                 CONTINUE
      X1=X
      Y1=Y
C                     END IF
10025                 CONTINUE
C                 END DO
                  GO TO  10021
10022             CONTINUE
      IX=X
      IY=Y
      DIST=((XCORD(I)-X)**2+(YCORD(I)-Y)**2)**.5
      EN=900./(4.+DIST)
C                 SELECT
C                 WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN
10029             IF((CHAR .GE. '1') .AND. (CHAR .LE. '8'))  GO TO 10032
                  GO TO  10031
10032             CONTINUE
C        * HIT ON SHIP
                      DECODE(1,10033,CHAR)K
10033                 FORMAT(I1)
C                     IF XSHIP(K) THEN
                      IF(XSHIP(K) )  GO TO 10036
                      GO TO  10034
10036                 CONTINUE
C          * MAKE SURE WE DON'T SHOOT OURSELVES
C                         IF K .NE. I THEN
                          IF(K .NE. I )  GO TO 10039
                          GO TO  10037
10039                     CONTINUE
      CALL DAMAGE(K,EN)
      SCORE(I)=SCORE(I)+EN
      CALL SENT(I,6)
      CALL SENT(K,14)
C                             IF ENERGY(K) .LE. 0. THEN
                              IF(ENERGY(K) .LE. 0. )  GO TO 10042
                              GO TO  10040
10042                         CONTINUE
      SCORE(I)=SCORE(I)+2000.
      CALL SENT(I,22)
      CALL RESET(K)
C                             END IF
10040                         CONTINUE
C                         END IF
10037                     CONTINUE
                      GO TO  10035
C                     ELSE
10034                 CONTINUE
      CALL SENT(I,21)
C                     END IF
10035                 CONTINUE
C
                  GO TO  10030
C                 WHEN CHAR .EQ. '+' THEN
10031             IF(CHAR .EQ. '+')  GO TO 10044
                  GO TO  10043
10044             CONTINUE
C          * PHASE HIT ON TORPEDO
      CALL SENT(I,7)
C
                  GO TO  10030
C                 WHEN CHAR .EQ. '*' THEN
10043             IF(CHAR .EQ. '*')  GO TO 10046
                  GO TO  10045
10046             CONTINUE
C         * PHASER HIT ON STAR
      CALL SENT(I,11)
C
                  GO TO  10030
C                 WHEN CHAR .EQ. 'B' THEN
10045             IF(CHAR .EQ. 'B')  GO TO 10048
                  GO TO  10047
10048             CONTINUE
C         * PHASER HIT ON BASE
      CALL SENT(I,12)
C
                  GO TO  10030
C                 WHEN CHAR .EQ. '@' THEN
10047             IF(CHAR .EQ. '@')  GO TO 10050
                  GO TO  10049
10050             CONTINUE
C         * PHASER HIT ON ANTI-MATTER POD
      CALL SENT(I,25)
C
C                 OTHERWISE
                  GO TO  10030
10049             CONTINUE
C         * MISSED
      CALL SENT(I,8)
C                 END SELECT
10051             CONTINUE
10030             CONTINUE
C             END DO
              GO TO  10018
10019         CONTINUE
      PHA(I)=-1.
C         END IF
10003     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE TORPI
C
C      * FIRE TORPEDOES
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8)
      BYTE CHAR
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         IF LAUNCH(I) .GE. 0. THEN
          IF(LAUNCH(I) .GE. 0. )  GO TO 10005
          GO TO  10003
10005     CONTINUE
      CALL MOVE(XCORD(I),YCORD(I),X1,Y1,LAUNCH(I),10.,CHAR,UNIV)
      IX=X1
      IY=Y1
      KX=XCORD(I)
      KY=YCORD(I)
C         * MAKE SURE IT MOVED OUT OF THE FIRER'S SQUARE
C             IF (KX .EQ. IX) .AND. (KY .EQ. IY) THEN
              IF((KX .EQ. IX) .AND. (KY .EQ. IY) )  GO TO 10008
              GO TO  10006
10008         CONTINUE
      CALL MOVE(X1,Y1,X,Y,LAUNCH(I),10.,CHAR,UNIV)
              GO TO  10007
C             ELSE
10006         CONTINUE
      X=X1
      Y=Y1
C             END IF
10007         CONTINUE
      IX=X
      IY=Y
C             IF CHAR .EQ. '.' THEN
              IF(CHAR .EQ. '.' )  GO TO 10011
              GO TO  10009
10011         CONTINUE
      UNIV(IX,IY)='+'
C                 IF TDIR(I,IT(I)) .GE. 0. THEN
                  IF(TDIR(I,IT(I)) .GE. 0. )  GO TO 10014
                  GO TO  10012
10014             CONTINUE
      KX=TLOCS(I,IT(I),1)
      KY=TLOCS(I,IT(I),2)
C                     IF UNIV(KX,KY) .EQ. '+' THEN
                      IF(UNIV(KX,KY) .EQ. '+' )  GO TO 10017
                      GO TO  10015
10017                 CONTINUE
      UNIV(KX,KY)='.'
C                     END IF
10015                 CONTINUE
C                 END IF
10012             CONTINUE
      TLOCS(I,IT(I),1)=X
      TLOCS(I,IT(I),2)=Y
      TDIR(I,IT(I))=LAUNCH(I)
      IT(I)=IT(I)+1
C                 IF IT(I) .GT. 10 THEN
                  IF(IT(I) .GT. 10 )  GO TO 10020
                  GO TO  10018
10020             CONTINUE
      IT(I)=1
C                 END IF
10018             CONTINUE
              GO TO  10010
C             ELSE
10009         CONTINUE
C          * HIT SOMETHING
      CALL THIT(I,IX,IY,CHAR)
C             END IF
10010         CONTINUE
      LAUNCH(I)=-1.
C         END IF
10003     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE DAMAGE(K,EN)
C
C      * CALCULATE DAMAGE DONE
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      SABS=SHIELD(K)/1000.
C     IF SABS .GT. 1. THEN
      IF(SABS .GT. 1. )  GO TO 10002
      GO TO  10000
10002 CONTINUE
      SABS=1.
C     END IF
10000 CONTINUE
      ENERGY(K)=ENERGY(K)-(1.2-SABS)*EN*8.
      SHIELD(K)=SHIELD(K)-SABS*EN
C     IF SHIELD(K) .LT. 0. THEN
      IF(SHIELD(K) .LT. 0. )  GO TO 10005
      GO TO  10003
10005 CONTINUE
      SHIELD(K)=0.
C     END IF
10003 CONTINUE
      RETURN
      END
      SUBROUTINE MOVE(XI,YI,XN,YN,D,W,CHAR,UNIV)
C
C      * MOVE OBJECTS WITH WRAP AROUND
C
      BYTE CHAR
      BYTE UNIV(100,100)
      YN=YI+SIN(D/180*3.14159)/10.*W
      XN=XI+COS(D/180*3.14159)/10.*W
      IXI=XI
      IYI=YI
      IXN=XN
      IYN=YN
C     IF IXN .GE. 101 THEN
      IF(IXN .GE. 101 )  GO TO 10002
      GO TO  10000
10002 CONTINUE
      XN=IXN-100
C     END IF
10000 CONTINUE
C     IF IXN .LT. 1 THEN
      IF(IXN .LT. 1 )  GO TO 10005
      GO TO  10003
10005 CONTINUE
      XN=IXN+100
C     END IF
10003 CONTINUE
C     IF IYN .GE. 101 THEN
      IF(IYN .GE. 101 )  GO TO 10008
      GO TO  10006
10008 CONTINUE
      YN=IYN-100
C     END IF
10006 CONTINUE
C     IF IYN .LT. 1 THEN
      IF(IYN .LT. 1 )  GO TO 10011
      GO TO  10009
10011 CONTINUE
      YN=IYN+100
C     END IF
10009 CONTINUE
      IXN=XN
      IYN=YN
C     IF (IXI .NE. IXN) .OR. (IYI .NE. IYN) THEN
      IF((IXI .NE. IXN) .OR. (IYI .NE. IYN) )  GO TO 10014
      GO TO  10012
10014 CONTINUE
      CHAR=UNIV(IXN,IYN)
      GO TO  10013
C     ELSE
10012 CONTINUE
C
C       * IF THEY DIDN'T MOVE OUT OF THE SQUARE THEY WERE IN JUST INDICA
C         THAT THE PLACE THEY ENDED UP WAS EMPTY
C
      CHAR='.'
C     END IF
10013 CONTINUE
      RETURN
      END
      SUBROUTINE TFIND(I,IX,IY)
C
C      * FIND OUT WHO SHOULD GET THE CREDIT IF SOME ONE RUNS INTO A TORP
C
      COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8)
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         FOR K=1 UNTIL 10 DO
          K=1
          GO TO  10005
10003     K = K+(1)
10005     IF(K.GT.10)  GO TO 10004
C             IF TDIR(I,K) .GE. 0. THEN
              IF(TDIR(I,K) .GE. 0. )  GO TO 10008
              GO TO  10006
10008         CONTINUE
      KX=TLOCS(I,K,1)
      KY=TLOCS(I,K,2)
C                 IF (IX .EQ. KX) .AND. (IY .EQ. KY) THEN
                  IF((IX .EQ. KX) .AND. (IY .EQ. KY) )  GO TO 10011
                  GO TO  10009
10011             CONTINUE
      GOTO 100
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
      I=0
 100  RETURN
      END
      SUBROUTINE MTORPS
C
C      * MOVE ALL ACTIVE TORPEDOES
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8)
      BYTE CHAR
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         FOR K=1 UNTIL 10 DO
          K=1
          GO TO  10005
10003     K = K+(1)
10005     IF(K.GT.10)  GO TO 10004
      IX=TLOCS(I,K,1)
      IY=TLOCS(I,K,2)
C
C        * MAKE SURE THE TORPEDO IS STILL THERE AND ACTIVE
C
C             IF (UNIV(IX,IY) .EQ. '+') .AND. (TDIR(I,K) .GE. 0.) THEN
              IF((UNIV(IX,IY) .EQ. '+') .AND. (TDIR(I,K) .GE. 0.) )  GO 
     $TO 10008
              GO TO  10006
10008         CONTINUE
      CALL MOVE(TLOCS(I,K,1),TLOCS(I,K,2),X,Y,TDIR(I,K),10.,CHAR,UNIV)
      KX=X
      KY=Y
C                 IF CHAR .NE. '.' THEN
                  IF(CHAR .NE. '.' )  GO TO 10011
                  GO TO  10009
10011             CONTINUE
      CALL THIT(I,KX,KY,CHAR)
      UNIV(IX,IY)='.'
      TDIR(I,K)=-1.
                  GO TO  10010
C                 ELSE
10009             CONTINUE
      UNIV(IX,IY)='.'
      UNIV(KX,KY)='+'
      TLOCS(I,K,1)=X
      TLOCS(I,K,2)=Y
C                 END IF
10010             CONTINUE
              GO TO  10007
C             ELSE
10006         CONTINUE
      TDIR(I,K)=-1.
C             END IF
10007         CONTINUE
C         END DO
          GO TO  10003
10004     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE SENT(I,NUM)
C
C     * SEND MESSAGES TO THE PLAYERS
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
C     FOR K=1  UNTIL 10 DO
      K=1 
      GO TO  10002
10000 K = K+(1)
10002 IF(K.GT.10)  GO TO 10001
C         IF ISENT(I,K) .EQ. 0 THEN
          IF(ISENT(I,K) .EQ. 0 )  GO TO 10005
          GO TO  10003
10005     CONTINUE
      ISENT(I,K)=NUM
      GOTO 200
C         END IF
10003     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
C     * MESSAGE BUFFER IS FULL SO COPY IT UP TO KEEP MOST RECENT
C     FOR K=1 UNTIL 9 DO
      K=1
      GO TO  10008
10006 K = K+(1)
10008 IF(K.GT.9)  GO TO 10007
      ISENT(I,K)=ISENT(I,K+1)
C     END DO
      GO TO  10006
10007 CONTINUE
      ISENT(I,10)=NUM
 200  RETURN
      END
      SUBROUTINE MHOLE(HX,HY,HW)
C
C     * MOVE THE "BLACK HOLE" TOWARD THE NEAREST ACTIVE SHIP
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      BYTE CHAR
C
C     * FIND CLOSEST SHIP
C
      DM=1.6E37
      K=0
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         IF XSHIP(I) THEN
          IF(XSHIP(I) )  GO TO 10005
          GO TO  10003
10005     CONTINUE
      D=((HX-XCORD(I))**2 + (HY-YCORD(I))**2)**.5
C             IF D .LT. DM THEN
              IF(D .LT. DM )  GO TO 10008
              GO TO  10006
10008         CONTINUE
      DM=D
      K=I
C             END IF
10006         CONTINUE
C         END IF
10003     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
C
C    * FIND DIRECTION OF CLOSEST SHIP
C
C     IF K .NE. 0 THEN
      IF(K .NE. 0 )  GO TO 10011
      GO TO  10009
10011 CONTINUE
      D=ATAN2((YCORD(K)-HY),(XCORD(K)-HX))*180./3.14159
C
      CALL MOVE(HX,HY,X,Y,D,HW,CHAR,UNIV)
C         SELECT
C     * JUST MUNCH THIS JUNK DOWN
C         WHEN (CHAR .EQ. '.') .OR. (CHAR .EQ. '+')  .OR. (CHAR .EQ. '@'
C         )     THEN
10014     IF((CHAR .EQ. '.') .OR. (CHAR .EQ. '+')  .OR. (CHAR .EQ. '@') 
     $   )  GO TO 10017
          GO TO  10016
10017     CONTINUE
      IX=HX
      IY=HY
      UNIV(IX,IY)='.'
      IX=X
      IY=Y
      UNIV(IX,IY)='#'
      HX=X
      HY=Y
C
          GO TO  10015
C         WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN
10016     IF((CHAR .GE. '1') .AND. (CHAR .LE. '8'))  GO TO 10019
          GO TO  10018
10019     CONTINUE
C     * CAUGHT A SHIP
              DECODE(1,10020,CHAR) I
10020         FORMAT(I1)
C             IF XSHIP(I) THEN
              IF(XSHIP(I) )  GO TO 10023
              GO TO  10021
10023         CONTINUE
      CALL SENT(I,15)
      CALL RESET(I)
C             END IF
10021         CONTINUE
C
C         OTHERWISE
          GO TO  10015
10018     CONTINUE
C      * SWAP PLACES WITH BASES STARS ETC.
      IX=HX
      IY=HY
      UNIV(IX,IY)=CHAR
      HX=X
      HY=Y
      IX=HX
      IY=HY
      UNIV(IX,IY)='#'
C         END SELECT
10024     CONTINUE
10015     CONTINUE
C     END IF
10009 CONTINUE
      RETURN
      END
      SUBROUTINE MANTI(HX,HY)
C
C     * DEAL WITH ANTI-MATTER
C
C
C      MOVE ANTI-MATTER PODS
C
C     TEXT COMMON
      COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8),   
     $        PHA(8),I1,I2,HYPER(8),ISENT(8,10),                        
     $        XPOD(8),YPOD(8),DPOD(8),IPOD(8),                          
     $        SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100),  
     $        MESSAG(480),THRU,XSHIP(8),CLOAK(8)
      REAL LAUNCH
      INTEGER CREW,HYPER,TORPS
      LOGICAL*1 XSHIP,CLOAK
      BYTE THRU,UNIV,MESSAG
C     END TEXT
      BYTE CHAR
      INTEGER IPX(22),IPY(22)
      LOGICAL*1 OK
C
C     * THE FOLLOWING DATA DESCIBES THE EXPLOSION PATTERN FOR
C       ANTI-MATTER PODS
C
      DATA IPX/0,-1,0,1,-2,-1,0,1,2,-1,0,1,0,0,0,-3,3,2,2,-2,-2,0/
      DATA IPY/2,1,1,1,0,0,0,0,0,-1,-1,-1,-2,3,-3,0,0,-2,2,2,-2,-3/
C     FOR I=1 UNTIL 8 DO
      I=1
      GO TO  10002
10000 I = I+(1)
10002 IF(I.GT.8)  GO TO 10001
C         SELECT USING IPOD(I)
          I10006 =  IPOD(I)
C         WHEN 1 THEN
10005     IF(I10006.EQ.1)  GO TO 10008
          GO TO  10007
10008     CONTINUE
C       * LAUNCH POD
      CALL MOVE(XCORD(I),YCORD(I),X1,Y1,DPOD(I),10.,CHAR,UNIV)
      IX=X1
      IY=Y1
      KX=XCORD(I)
      KY=YCORD(I)
C         * MAKE SURE IT CLEARS THE SHIP
C             IF (KX .EQ. IX) .AND. (KY .EQ. IY) THEN
              IF((KX .EQ. IX) .AND. (KY .EQ. IY) )  GO TO 10011
              GO TO  10009
10011         CONTINUE
      CALL MOVE(X1,Y1,X,Y,DPOD(I),10.,CHAR,UNIV)
              GO TO  10010
C             ELSE
10009         CONTINUE
      X=X1
      Y=Y1
C             END IF
10010         CONTINUE
      IX=X
      IY=Y
C             IF CHAR .EQ. '.' THEN
              IF(CHAR .EQ. '.' )  GO TO 10014
              GO TO  10012
10014         CONTINUE
C           * SUCCESSUL LAUNCH
      UNIV(IX,IY)='@'
      XPOD(I)=X
      YPOD(I)=Y
      IPOD(I)=2
      CALL SENT(I,28)
              GO TO  10013
C             ELSE
10012         CONTINUE
      CALL SENT(I,23)
      IPOD(I)=0
C             END IF
10013         CONTINUE
C
          GO TO  10006
C         WHEN 2 THEN
10007     IF(I10006.EQ.2)  GO TO 10016
          GO TO  10015
10016     CONTINUE
C        * POD IS ON THE MOVE
      IX=XPOD(I)
      IY=YPOD(I)
C             IF UNIV(IX,IY) .EQ. '@' THEN
              IF(UNIV(IX,IY) .EQ. '@' )  GO TO 10019
              GO TO  10017
10019         CONTINUE
      CALL MOVE(XPOD(I),YPOD(I),X,Y,DPOD(I),5.,CHAR,UNIV)
C                 IF CHAR .EQ. '.' .OR. CHAR .EQ. '+' THEN
                  IF(CHAR .EQ. '.' .OR. CHAR .EQ. '+' )  GO TO 10022
                  GO TO  10020
10022             CONTINUE
      UNIV(IX,IY)='.'
      IX=X
      IY=Y
      UNIV(IX,IY)='@'
      XPOD(I)=X
      YPOD(I)=Y
                  GO TO  10021
C                 ELSE
10020             CONTINUE
C                     IF RAN(I1,I2) .GT. .5 THEN
                      IF(RAN(I1,I2) .GT. .5 )  GO TO 10025
                      GO TO  10023
10025                 CONTINUE
      DPOD(I)=DPOD(I)+90.
                      GO TO  10024
C                     ELSE
10023                 CONTINUE
      DPOD(I)=DPOD(I)-90.
C                     END IF
10024                 CONTINUE
C                 END IF
10021             CONTINUE
              GO TO  10018
C             ELSE
10017         CONTINUE
      CALL SENT(I,24)
      IPOD(I)=4
C             END IF
10018         CONTINUE
C
          GO TO  10006
C         WHEN 3 THEN
10015     IF(I10006.EQ.3)  GO TO 10027
          GO TO  10026
10027     CONTINUE
C          * DETONATE POD
      IX=XPOD(I)
      IY=YPOD(I)
C             IF UNIV(IX,IY) .EQ. '@' THEN
              IF(UNIV(IX,IY) .EQ. '@' )  GO TO 10030
              GO TO  10028
10030         CONTINUE
      IPOD(I)=4
      CALL SENT(I,29)
      DO 9 L1=1,22
      KX=IX+IPX(L1)
C                 IF KX .GE. 101 THEN
                  IF(KX .GE. 101 )  GO TO 10033
                  GO TO  10031
10033             CONTINUE
      KX=KX-100
C                 END IF
10031             CONTINUE
C                 IF KX .LT. 1 THEN
                  IF(KX .LT. 1 )  GO TO 10036
                  GO TO  10034
10036             CONTINUE
      KX=KX+100
C                 END IF
10034             CONTINUE
      KY=IY+IPY(L1)
C                 IF KY .GE. 101 THEN
                  IF(KY .GE. 101 )  GO TO 10039
                  GO TO  10037
10039             CONTINUE
      KY=KY-100
C                 END IF
10037             CONTINUE
C                 IF KY .LT. 1 THEN
                  IF(KY .LT. 1 )  GO TO 10042
                  GO TO  10040
10042             CONTINUE
      KY=KY+100
C                 END IF
10040             CONTINUE
      CHAR=UNIV(KX,KY)
C                 SELECT
C                 WHEN (CHAR .GE. '1' ) .AND. ( CHAR .LE. '8') THEN
10045             IF((CHAR .GE. '1' ) .AND. ( CHAR .LE. '8'))  GO TO 100
     $48
                  GO TO  10047
10048             CONTINUE
                      DECODE(1,10049,CHAR) IZ
10049                 FORMAT(I1)
C                     IF XSHIP(IZ) THEN
                      IF(XSHIP(IZ) )  GO TO 10052
                      GO TO  10050
10052                 CONTINUE
      CALL SENT(IZ,30)
      CALL RESET(IZ)
C                         IF IZ .NE. I THEN
                          IF(IZ .NE. I )  GO TO 10055
                          GO TO  10053
10055                     CONTINUE
      SCORE(I)=SCORE(I)+2000.
      CALL SENT(I,22)
C                         END IF
10053                     CONTINUE
                      GO TO  10051
C                     ELSE
10050                 CONTINUE
      CALL SENT(I,21)
C                     END IF
10051                 CONTINUE
C
                  GO TO  10046
C                 WHEN CHAR .EQ. 'H' THEN
10047             IF(CHAR .EQ. 'H')  GO TO 10057
                  GO TO  10056
10057             CONTINUE
      CONTINUE
C
                  GO TO  10046
C                 WHEN CHAR .EQ. 'B' THEN
10056             IF(CHAR .EQ. 'B')  GO TO 10059
                  GO TO  10058
10059             CONTINUE
      CONTINUE
C
                  GO TO  10046
C                 WHEN CHAR .EQ. '#' THEN
10058             IF(CHAR .EQ. '#')  GO TO 10061
                  GO TO  10060
10061             CONTINUE
      CALL SENT(I,31)
      SCORE(I)=SCORE(I)+1000.
      UNIV(KX,KY)='.'
      OK=.FALSE.
C                     UNTIL OK DO
                      GO TO  10064
10062                 IF(OK )  GO TO 10063
10064                 CONTINUE
      IX=RAN(I1,I2)*100.+1.
C                         IF IX .GT. 100 THEN
                          IF(IX .GT. 100 )  GO TO 10067
                          GO TO  10065
10067                     CONTINUE
      IX=100
C                         END IF
10065                     CONTINUE
      IY=RAN(I1,I2)*100.+1.
C                         IF IY .GT. 100 THEN
                          IF(IY .GT. 100 )  GO TO 10070
                          GO TO  10068
10070                     CONTINUE
      IY=100
C                         END IF
10068                     CONTINUE
C                         IF UNIV(IX,IY) .EQ. '.' THEN
                          IF(UNIV(IX,IY) .EQ. '.' )  GO TO 10073
                          GO TO  10071
10073                     CONTINUE
      HX=IX
      HY=IY
      UNIV(IX,IY)='#'
      OK=.TRUE.
C                         END IF
10071                     CONTINUE
C                     END DO
                      GO TO  10062
10063                 CONTINUE
C                 OTHERWISE
                  GO TO  10046
10060             CONTINUE
      UNIV(KX,KY)='.'
C                 END SELECT
10074             CONTINUE
10046             CONTINUE
9     CONTINUE
              GO TO  10029
C             ELSE
10028         CONTINUE
      CALL SENT(I,24)
      IPOD(I)=4
C             END IF
10029         CONTINUE
C
C         OTHERWISE
          GO TO  10006
10026     CONTINUE
      CONTINUE
C         END SELECT
10075     CONTINUE
10006     CONTINUE
C
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH)
C
      LOGICAL*1 EXIST,OK
      REAL VARI,LOW,HIGH
      BYTE INPUT(15),LEFTED(15)
      INTEGER NCHRS
      OK=.FALSE.
C     UNTIL OK                                                          
C     DO
      GO TO  10002
10000 IF(OK                                                          )  
     $GO TO 10001
10002 CONTINUE
C         FOR I=1 UNTIL 15                                              
C               DO
          I=1
          GO TO  10005
10003     I = I+(1)
10005     IF(I.GT.15                                                   )
     $  GO TO 10004
      LEFTED(I)=' '
C         END DO
          GO TO  10003
10004     CONTINUE
      READ(5,100,END=800) NCHRS,(INPUT(I),I=1,15)
100   FORMAT(Q,15A1)
      GOTO 810
800   CLOSE(UNIT=5)
810   CONTINUE
C         SELECT
C         WHEN NCHRS .EQ. 0                                             
C               THEN
10008     IF(NCHRS .EQ. 0                                               
     $   )  GO TO 10011
          GO TO  10010
10011     CONTINUE
      OK=.TRUE.
      EXIST=.FALSE.
          GO TO  10009
C         WHEN NCHRS .LE. 15 THEN
10010     IF(NCHRS .LE. 15)  GO TO 10013
          GO TO  10012
10013     CONTINUE
C         * LEFT ADJUST INPUT
      CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS)
              DECODE(15,10014,LEFTED,ERR=200) VARI
10014         FORMAT(G15.0)
C             IF VARI .GE. LOW .AND.  VARI .LE. HIGH                    
C                         THEN
              IF(VARI .GE. LOW .AND.  VARI .LE. HIGH                    
     $            )  GO TO 10017
              GO TO  10015
10017         CONTINUE
      OK=.TRUE.
      EXIST=.TRUE.
              GO TO  10016
C             ELSE
10015         CONTINUE
                  WRITE(5,10018)
10018             FORMAT('0SORRY CAPTAIN, BUT YOUR COMMAND',1H','S PARAM
     $ETER')
      WRITE(5,150) LOW,HIGH
150   FORMAT(1H ,'MUST BE BETWEEN ',F15.4,' AND ',F15.4)
C             END IF
10016         CONTINUE
      GO TO 300
200   TYPE *,'WOULD YOU PLEASE REPEAT THAT SIR ?'
300   CONTINUE
C         OTHERWISE
          GO TO  10009
10012     CONTINUE
              WRITE(5,10020)
10020         FORMAT(' RUN THAT BY ME AGAIN !')
C         END SELECT
10019     CONTINUE
10009     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      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)
10010             FORMAT('0WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS
     $')
                  WRITE(5,10011) LOW,HIGH
10011             FORMAT(' BETWEEN ',I5,' AND ',I5)
                  WRITE(5,10012)
10012             FORMAT(1H$,' TRY AGAIN :')
C             END IF
10008         CONTINUE
      GOTO 300
200   WRITE(5,100)
100   FORMAT(1H$,' TRY AGAIN BOZO :')
300   CONTINUE
C         END IF
10005     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END
      SUBROUTINE YESNO(FLAG)
      LOGICAL*1 FLAG,OK
      BYTE YES(4),NO(4)
      BYTE ANSWER(4)
      DATA YES/'Y','E','S',' '/
      DATA NO/'N','O',' ',' '/
      OK=.FALSE.
C     UNTIL OK DO
      GO TO  10002
10000 IF(OK )  GO TO 10001
10002 CONTINUE
          READ(5,10003,END=800) NCHRS, (ANSWER(I),I=1,4)
10003     FORMAT(Q,4A1)
      GOTO 810
800   CLOSE(UNIT=5)
810   CONTINUE
C         IF (NCHRS .GT. 4) .OR. (NCHRS .LT. 1) THEN
          IF((NCHRS .GT. 4) .OR. (NCHRS .LT. 1) )  GO TO 10006
          GO TO  10004
10006     CONTINUE
      NCHRS=4
C         END IF
10004     CONTINUE
C       * CHECK FOR YES
      I=KOMSTR(YES,1,NCHRS,ANSWER,1)
C         IF I .EQ. 0 THEN
          IF(I .EQ. 0 )  GO TO 10009
          GO TO  10007
10009     CONTINUE
      FLAG=.TRUE.
      OK=.TRUE.
          GO TO  10008
C         ELSE
10007     CONTINUE
C         * CHECK FOR A NO
      I=KOMSTR(NO,1,NCHRS,ANSWER,1)
C             IF I .EQ. 0 THEN
              IF(I .EQ. 0 )  GO TO 10012
              GO TO  10010
10012         CONTINUE
      FLAG=.FALSE.
      OK=.TRUE.
              GO TO  10011
C             ELSE
10010         CONTINUE
C           * INCORRECT RESPONSE
                  WRITE(5,10013)
10013             FORMAT('0** PLEASE ANSWER "YES" OR "NO" **')
                  WRITE(5,10014)
10014             FORMAT('$      ANSWER ? ')
C             END IF
10011         CONTINUE
C         END IF
10008     CONTINUE
C     END DO
      GO TO  10000
10001 CONTINUE
      RETURN
      END