DEFINE(DIG0,48)			# ASCII '0'
   PROGRAM DRIVER
#
#     AUTHOR: DON LEDFORD
#
#     DECEMBER 1978	JOHN LUTCH	ADDED CLOAKING
#     DECEMBER 1978	DON LEDFORD	ADDED ANTI-MATTER
#     MARCH 1979	RAY FRENCH	ADDED CONTINUOUS DISPLAY
#     OCTOBER 1979	DON LEDFORD	ADDED ROBOT SHIPS
#     MAY 1980	BILL CAEL AND BILL WOOD	RECODED IN RATFOR
#     MAY 1980		BILL WOOD	ADDED ENERGY NETS
#     JUN 1980		BILL WOOD	ADDED RANDOM SHIP SERVICING ORDER
#     DEC 1980		BILL WOOD	ADDED TRACTOR BEAMS
#
   INCLUDE COMMON.RAT
   COMMON /ACCUM/ ACCUME
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   LOGICAL*1 ACCUME
   BYTE CHAR
#
   CALL MARK(2,UPRATE,1,IDS)
   ACCUME=.TRUE.
   DO I = 1, 8
     SHIPS(I) = I
   THRU=.FALSE.
#
#     * HERE STARTS THE ACTUAL GAME PLAYING
#
   REPEAT [
#
#	THE PLAYER TASKS NEED SOME CPU TIME TOO !
     CALL WAITFR(2,IDS)
     CALL MARK(2,UPRATE,1,IDS)
#
#     * FIRE TORPEDOES
     CALL TORPI
#     * FIRE PHASERS
     CALL PHASER
#     * HANDLE ALL ANTI-MATTER TRANSACTIONS
     CALL MANTI
#     * MOVE ACTIVE TORPEDOES
     CALL MTORPS
#     * MOVE HOMERS
     CALL MHOMER
#     * MOVE SHIPS
     CALL MSHIPS
#     * MOVE THE "BLACK HOLE"
     CALL MHOLE
#
#     THE FOLLOWING CODE (IF UNCOMMENTED) WILL CHECK TO SEE
#     IF THERE ARE STILL ANY PLAYERS.  IF NOT, IT WILL WAIT
#     30 SECONDS AND THEN EXIT IF NO NEW PLAYERS HAVE STARTED.
#
     DO J = 1,6 [
       DO I = 1, 8
         IF (XSHIP(I))
           GOTO 10
       CALL WAIT(5,2,M)
       ]
     THRU = .TRUE.
10   CONTINUE
     ] UNTIL (THRU)
   CALL EXIT
   END
 
 
 
   SUBROUTINE MSHIPS
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8),HSPLOC(2,6)
#
   BYTE CHAR,SHIP,TRAIL
   DATA HSPLOC/20,75, 50,70, 80,75, 20,25, 50,30, 80,25/
#
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     IF (XSHIP(I)) [
       IF (CLOAK(I)) [
#     * CAN'T MOVE IF YOU'RE CLOAKED
         WARP(I)=0.
         ENERGY(I)=ENERGY(I)-CDRAIN
         ]
       SHIP = I + DIG0
       ENERGY(I)=ENERGY(I)-WARP(I)/2
       IF (NET(I)) [
         TRAIL = -I
         ENERGY(I) = ENERGY(I) - NDRAIN*WARP(I)/10.
         ]
       ELSE [
         TRAIL = EMPTY
         ]
       TRUDIR = DIR(I)
       TRUWRP = WARP(I)
       IF (TRBEAM(I) != 0  &  XSHIP(TRBEAM(I))) [
         ENERGY(I) = ENERGY(I) - TDRAIN
#$         CALL DIRDIS(XCORD(I),YCORD(I),
#$                     XCORD(TRBEAM(I)),YCORD(TRBEAM(I)),TDIR,TDIS)
#$         CALL POLADD(TRUDIR, TRUWRP, TDIR, 4./SQRT(AMAX1(1., TDIS-4.)),
#$                     TRUDIR, TRUWRP)
         ]
       DO ITRAC = 1, 8
         IF (XSHIP(ITRAC) & TRBEAM(ITRAC) == I & ITRAC != I) [
           CALL DIRDIS(XCORD(I),YCORD(I),XCORD(ITRAC),YCORD(ITRAC),TDIR,TDIS)
           CALL POLADD(TRUDIR, TRUWRP, TDIR, 8./SQRT(AMAX1(1., TDIS-4.)),
                       TRUDIR, TRUWRP)
           ]
       IF (TRUWRP > 10.)
         TRUWRP = 10.
       IX=XCORD(I)
       IY=YCORD(I)
       CALL MOVE(XCORD(I),YCORD(I),X,Y,TRUDIR,TRUWRP,CHAR,UNIV,EMPTY)
       KX=X
       KY=Y
       IF (CHAR <= '8' & CHAR >= '1') [
#     * WE HAVE RAMMED A SHIP
	 K = CHAR-DIG0
         ENERGY(I)=ENERGY(I)-100.
         IF (XSHIP(K)) [
           ENERGY(K)=ENERGY(K)-100.
           CALL SENT(K,10)
           ]
         WARP(I)=0.
         WARP(K)=0.
         CALL SENT(I,9)
#
         ]
       ELSE IF (CHAR == 'B') [
#     * RAMMED (DOCKED) A BASE
         CALL SENT(I,1)
         TORPS(I)=10
         WARP(I)=0.
         ENERGY(I)=10000.
         SHIELD(I)=0.
         IPOD(I)=0
         SCAN(I)=9
         NHOM(I)=4
         DO II=1, 4 [
           WHOM(I,II)=0
           ]
         TRBEAM(I) = 0
#
         ]
       ELSE IF (CHAR == '*') [
#     * HIT A STAR
         CALL SENT(I,2)
         ENERGY(I)=ENERGY(I)-200.
         WARP(I)=0.
#
         ]
       ELSE IF ((CHAR == '+' ) | (CHAR == '^')) [
#     * HIT A TORPEDO
         CALL SENT(I,4)
         IF (CHAR == '^') [
           V=300.
           ]
         ELSE [
           V=500.
           ]
         CALL DAMAGE(I,V,500.)
         CALL TFIND(K,KX,KY)
         UNIV(KX,KY)=EMPTY
         IF (K != 0 & (K != I)) [
           CALL SENT(K,5)
           SCORE(K)=SCORE(K)+V
           IF (ENERGY(I) <= 0) [
             CALL SENT(K,22)
#$             SCORE(K)=SCORE(K)+2000.
             ]
           ]
         IF (ENERGY(I) <= 0)
           CALL RESET(I)
#
         ]
       ELSE IF (CHAR == 'H') [
#     * HIT A HYPERSPACE PORT
10       CONTINUE
         CALL SENT(I,17)
	 KX = HSPLOC(1,HYPER(I))
	 KY = HSPLOC(2,HYPER(I))
#
#     * PUT THE SHIP NEAR THE DESTINATION PORT IF POSSIBLE
#
         DO II=(KX-1), (KX+1) [
           DO IJ=(KY-1), (KY+1) [
             IF (UNIV(II,IJ) == EMPTY) [
               UNIV(II,IJ)=SHIP
               UNIV(IX,IY)=TRAIL
               XCORD(I)=II
               YCORD(I)=IJ
               XCORD(I)=XCORD(I)+.5
               YCORD(I)=YCORD(I)+.5
               GOTO 102
               ]
             ]
           ]
#     * IF WE ARE HERE WE DIDN'T FIND AN EMPTY SPOT ( VERY UNLIKELY)
         CALL SENT(I,18)
      102 WARP(I)=0.
#
         ]
       ELSE IF (CHAR == BHOLE) [
#     * RUN INTO THE "BLACK HOLE" ( NICE FLYING)
20       CONTINUE
         CALL SENT(I,15)
         CALL RESET(I)
#
         ]
       ELSE IF (CHAR == 'R') [
#     * HIT A RANDOM HYPERSPACE PORT
30       CONTINUE
         CALL SENT(I,19)
#     * FIND A NEW EMPTY LOCATION
         REPEAT [
           KX=RAN(I1,I2)*100.+1.
           KY=RAN(I1,I2)*100.+1.
           ] UNTIL (UNIV(KX,KY) == EMPTY)
         XCORD(I)=KX
         YCORD(I)=KY
         XCORD(I)=XCORD(I)+.5
         YCORD(I)=YCORD(I)+.5
         WARP(I)=0.
         UNIV(IX,IY)=TRAIL
         UNIV(KX,KY)=SHIP
         ]
 
       ELSE IF (CHAR == '@') [
#     * BUMPED INTO AN ANTI-MATTER POD
         CALL SENT(I,27)
         CALL DAMAGE(I,250.,500.)
         ]
 
       ELSE IF (CHAR < 0) [
#     * BUMPED INTO ENERGY NET
         ENERGY(I) = ENERGY(I) - 200
         IF (CHAR == -I) [
           REPEAT [
             X2 = X
             Y2 = Y
             CALL MOVE(X2,Y2,X,Y,TRUDIR,8.,CHAR,UNIV,EMPTY)
             ] UNTIL (UNIV(IFIX(X), IFIX(Y)) != -I)
           KX = X
           KY = Y
           CHAR = UNIV(KX, KY)
           IF (CHAR == 'H')
             GOTO 10
 
           IF (CHAR == BHOLE)
             GOTO 20
 
           IF (CHAR == 'R')
             GOTO 30
 
           IF (CHAR == EMPTY) [
             XCORD(I) = X
             YCORD(I) = Y
             UNIV(IX,IY) = TRAIL
             UNIV(KX, KY) = SHIP
             ]
 
           ELSE [
             CALL SENT(I, 36)
             WARP(I) = 0.
             ]
           ]
         ELSE [
           CALL SENT(I, 33)
           DIR(I) = TRUDIR - 180.
           IF (DIR(I) < 0.)
             DIR(I) = DIR(I) + 360.
           ]
         ]
 
       ELSE [
         XCORD(I)=X
         YCORD(I)=Y
         IF (UNIV(IX,IY) != -I)
           UNIV(IX,IY)=TRAIL
         UNIV(KX,KY)=SHIP
         ]
       IF (ENERGY(I) <= 0.) [
         CALL SENT(I,16)
         CALL RESET(I)
         ]
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE RESET(K)
#
#     * RE-INCARNATE DESTROYED SHIPS
#
   INCLUDE COMMON.RAT
   COMMON /ACCUM/ ACCUME
   LOGICAL*1 ACCUME
   XSHIP(K)=.FALSE.
   ENERGY(K)=10000.
   WARP(K)=0.
   TORPS(K)=10.
   SHIELD(K)=0.
   IPOD(K)=0
   SCAN(K)=9
   NHOM(K)=4
   DO I=1, 4 [
     WHOM(K,I)=0
     ]
   CLOAK(K) = .FALSE.
   NET(K) = .FALSE.
   TRBEAM(K) = 0
   DO I = 1, 8
     IF (TRBEAM(I) == K)
       TRBEAM(I) = 0
   IF ( ACCUME) [
     SCORE(K)=SCORE(K)-1000.
     ]
   ELSE [
     SCORE(K)=0.
     ]
   CALL SENT(K,3)
   KX=XCORD(K)
   KY=YCORD(K)
   UNIV(KX,KY)=EMPTY
   DO I = 1, 100
     DO J = 1, 100
       IF (UNIV(J, I) == -K)
         UNIV(J, I) = EMPTY
   REPEAT [
     IX=RAN(I1,I2)*100.+1.
     IY=RAN(I1,I2)*100.+1.
     ] UNTIL (UNIV(IX,IY) == EMPTY)
   UNIV(IX, IY) = K + DIG0
   XCORD(K)=IX
   YCORD(K)=IY
   XCORD(K)=XCORD(K)+.5
   YCORD(K)=YCORD(K)+.5
   RETURN
   END
 
 
 
   SUBROUTINE THIT(I,IX,IY,CHAR,D,E)
#
#     * HANDLE TORPEDO HITS
#
   INCLUDE COMMON.RAT
   BYTE CHAR
   IF ((CHAR == 'H') | (CHAR == 'R')) [
#     * TORPEDO HIT ON HYPER SPACE PORT
     CONTINUE
#
     ]
   ELSE IF ((CHAR >= '1') & (CHAR <= '8')) [
#     * TORPEDO HIT ON SHIP
     K = CHAR-DIG0
     IF (XSHIP(K)) [
       CALL DAMAGE (K,E,D)
       IF (K != I) [
	 SCORE(I)=SCORE(I)+E
	 CALL SENT(I,5)
         IF (ENERGY(K) <= 0) [
           CALL SENT(I,22)
#$           SCORE(I)=SCORE(I)+2000.
           ]
	 ]
       CALL SENT(K,4)
       IF (ENERGY (K) <= 0.)
         CALL RESET(K)
       ]
     ELSE [
       CALL SENT(I,21)
       ]
     ]
 
   ELSE IF (CHAR == BHOLE)
#     * TORPEDO HIT ON BLACK HOLE - THE HOLE PREVAILS!
     ;
 
   ELSE IF (CHAR == '*') [
#     * TORPEDO HIT ON STAR
     CALL SENT(I,13)
#
     ]
   ELSE IF (CHAR == 'B') [
#     * TORPEDO HIT ON BASE
     CALL SENT(I,12)
     SCORE(I)=SCORE(I)-200.
#
     ]
   ELSE IF ((CHAR == '+' ) | (CHAR == '^')) [
#     * TORPEDO HIT ON TORPEDO
     CALL SENT(I,20)
     UNIV(IX,IY)=EMPTY
#
     ]
   ELSE IF (CHAR == '@') [
#     * TORPEDO HIT ON ANTI-MATTER POD
     CALL SENT(I,26)
     UNIV(IX,IY)=EMPTY
     ]
 
   ELSE IF (CHAR < 0) [
#     * TORPEDO HIT ON ENERGY NET
     CALL SENT(I, 34)
     UNIV(IX, IY) = EMPTY
     ]
 
   ELSE [
#     * ANYTHING ELSE GETS DESTROYED
     UNIV (IX,IY) = EMPTY
     ]
   RETURN
   END
 
 
 
   SUBROUTINE PHASER
#
#     * FIRE PHASERS
#
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   REAL DX(3),DY(3)
   BYTE CHAR
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     IF (PHA(I) >= 0.) [
#
#     * FIRE 3 BAND WIDE BEAM (NOTE EACH BAND HAS ITS OWN HIT OR MISS MESSAGE)
#
       DX(2)=XCORD(I)
       DY(2)=YCORD(I)
       IF (((PHA(I) >= 45.) & (PHA(I) < 135.)) |
         ((PHA(I) >= 225.) & (PHA(I) < 315.))) [
         DX(1)=DX(2)-1.
         DX(3)=DX(2)+1.
         DY(1)=DY(2)
         DY(3)=DY(2)
         ]
       ELSE [
         DX(1)=DX(2)
         DX(3)=DX(2)
         DY(1)=DY(2)-1.
         DY(3)=DY(2)+1.
         ]
       DO IZ=1, 3, 2 [
         IF (DX(IZ) >= 101.) [
           DX(IZ)=DX(IZ)-100.
           ]
         ELSE IF (DX(IZ) < 1.) [
           DX(IZ)=DX(IZ)+100.
           ]
         IF (DY(IZ) >= 101.) [
           DY(IZ)=DY(IZ)-100.
           ]
         ELSE IF (DY(IZ) < 1.) [
           DY(IZ)=DY(IZ)+100.
           ]
         ]
       KX = XCORD(I)
       KY = YCORD(I)
       NMISS = 0
       DO IZ=1, 3 [
         X1=DX(IZ)
         Y1=DY(IZ)
         DO IIT=1, 10 [
           CALL MOVE(X1,Y1,X,Y,PHA(I),10.,CHAR,UNIV,EMPTY)
           IX = X
           IY = Y
           IF ((CHAR != EMPTY) & ((KX != IX) | (KY != IY))) [
             BREAK
             ]
           ELSE [
             X1=X
             Y1=Y
             ]
           ]
         IF ((CHAR >= '1') & (CHAR <= '8')) [
#     * HIT ON SHIP
	   K = CHAR-DIG0
           IF (XSHIP(K)) [
#$             DIST=((XCORD(I)-X)**2+(YCORD(I)-Y)**2)**.5
             DIST = DSTNCE(XCORD(I),YCORD(I),X,Y)
             EN=900./(4.+DIST)
#     * MAKE SURE WE DON'T SHOOT OURSELVES
             IF (K != I) [
               CALL DAMAGE(K,EN,PHA(I))
               SCORE(I)=SCORE(I)+EN
               CALL SENT(I,6)
               CALL SENT(K,14)
               IF (ENERGY(K) <= 0.) [
#$                 SCORE(I)=SCORE(I)+2000.
                 CALL SENT(I,22)
                 CALL RESET(K)
                 ]
               ]
             ]
           ELSE [
             CALL SENT(I,21)
             ]
#
           ]
         ELSE IF ((CHAR == '+' ) ) [
#     * PHASER HIT ON TORPEDO
           CALL SENT(I,7)
#
           ]
         ELSE IF ((CHAR == '^')) [
#     * PHASER HIT ON SEEKER
           CALL SENT(I,7)
           IF (RAN(I1,I2) > .5) [
             UNIV(IX,IY)=EMPTY
             ]
#
           ]
         ELSE IF (CHAR == '*') [
#     * PHASER HIT ON STAR
           CALL SENT(I,11)
#
           ]
         ELSE IF (CHAR == 'B') [
#     * PHASER HIT ON BASE
           CALL SENT(I,12)
#
           ]
         ELSE IF (CHAR == '@') [
#     * PHASER HIT ON ANTI-MATTER POD
           CALL SENT(I,25)
           ]
 
         ELSE IF (CHAR < 0) [
#     * PHASER HIT ON ENERGY NET
           CALL SENT(I, 35)
           ]
 
         ELSE [
#     * MISSED
#$           CALL SENT(I,8)
           NMISS = NMISS+1
           ]
         ]
       PHA(I)=-1.
       IF (NMISS == 3)
         CALL SENT(I, 8)
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE TORPI
#
#     * FIRE TORPEDOES
#
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   BYTE CHAR
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     IF (LAUNCH(I) >= 0.) [
       CALL MOVE(XCORD(I),YCORD(I),X1,Y1,LAUNCH(I),10.,CHAR,UNIV,EMPTY)
       IX=X1
       IY=Y1
       KX=XCORD(I)
       KY=YCORD(I)
#     * MAKE SURE IT MOVED OUT OF THE FIRER'S SQUARE
       IF ((KX == IX) & (KY == IY)) [
         CALL MOVE(X1,Y1,X,Y,LAUNCH(I),10.,CHAR,UNIV,EMPTY)
         ]
       ELSE [
         X=X1
         Y=Y1
         ]
       IX=X
       IY=Y
       IF (CHAR == EMPTY) [
         UNIV(IX,IY)='+'
         IF (TDIR(I,IT(I)) >= 0.) [
           KX=TLOCS(I,IT(I),1)
           KY=TLOCS(I,IT(I),2)
           IF (UNIV(KX,KY) == '+') [
             UNIV(KX,KY)=EMPTY
             ]
           ]
         TLOCS(I,IT(I),1)=X
         TLOCS(I,IT(I),2)=Y
         TDIR(I,IT(I))=LAUNCH(I)
         IT(I)=IT(I)+1
         IF (IT(I) > 10) [
           IT(I)=1
           ]
         ]
       ELSE [
#     * HIT SOMETHING
         CALL THIT(I,IX,IY,CHAR,LAUNCH(I),500.)
         ]
       LAUNCH(I)=-1.
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE DAMAGE(K,EN,D)
#
#     * CALCULATE DAMAGE DONE
#
   INCLUDE COMMON.RAT
   SABS=SHIELD(K)/1000.
   IF (SABS > 1.) [
     SABS=1.
     ]
#
#     * CALCULATE FACTOR FOR DIRECTIONAL SHIELDING
#
   IF (D > 360.) [
     DEL=180.
     ]
   ELSE [
     DEL=ABS(DIR(K)-D)
     IF (DEL > 180.) [
       DEL=360. - DEL
       ]
     ]
   SABS = SABS *(.5 + DEL/360.)
   ENERGY(K)=ENERGY(K)-(1.2-SABS)*EN*6.
   SHIELD(K)=SHIELD(K)-SABS*EN
   IF (SHIELD(K) < 0.) [
     SHIELD(K)=0.
     ]
   RETURN
   END
 
 
 
   SUBROUTINE MOVE(XI,YI,XN,YN,D,W,CHAR,UNIV,EMPTY)
#
#     * MOVE OBJECTS WITH WRAP AROUND
#
   BYTE CHAR,EMPTY
   BYTE UNIV(100,100)
   YN=YI+SIN(D/57.29577951)/10.*W
   XN=XI+COS(D/57.29577951)/10.*W
   IXI=XI
   IYI=YI
   IF (XN >= 101.) [
     XN=XN-100.
     ]
   ELSE IF (XN < 1.) [
     XN=XN+100.
     ]
   IF (YN >= 101.) [
     YN=YN-100.
     ]
   ELSE IF (YN < 1.) [
     YN=YN+100.
     ]
   IXN=XN
   IYN=YN
   IF ((IXI != IXN) | (IYI != IYN)) [
     CHAR=UNIV(IXN,IYN)
     ]
   ELSE [
#
#     * IF THEY DIDN'T MOVE OUT OF THE SQUARE THEY WERE IN JUST INDICATE
#     THAT THE PLACE THEY ENDED UP WAS EMPTY
#
     CHAR=EMPTY
     ]
   RETURN
   END
 
 
 
   SUBROUTINE TFIND(I,IX,IY)
   INCLUDE COMMON.RAT
#
#     * FIND OUT WHO SHOULD GET THE CREDIT IF SOME ONE RUNS INTO A TORPEDO
#
   DO I = 1, 8 [
     DO K=1, 10 [
       IF (TDIR(I,K) >= 0.) [
         KX=TLOCS(I,K,1)
         KY=TLOCS(I,K,2)
         IF ((IX == KX) & (IY == KY)) [
           GOTO 102
           ]
         ]
       ]
     DO K=1, 4 [
       IF (WHOM(I,K) != 0) [
         KX=XHOM(I,K)
         KY=YHOM(I,K)
         IF ((IX == KX) & (IY == KY)) [
           GOTO 102
           ]
         ]
       ]
     ]
   I=0
102 RETURN
   END
 
 
 
   SUBROUTINE MTORPS
#
#     * MOVE ALL ACTIVE TORPEDOES
#
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   BYTE CHAR
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     DO K=1, 10 [
       IX=TLOCS(I,K,1)
       IY=TLOCS(I,K,2)
#
#     * MAKE SURE THE TORPEDO IS STILL THERE AND ACTIVE
#
       IF ((UNIV(IX,IY) == '+') & (TDIR(I,K) >= 0.)) [
         CALL MOVE(TLOCS(I,K,1),TLOCS(I,K,2),X,Y,TDIR(I,K),10.,CHAR,UNIV,EMPTY)
         KX=X
         KY=Y
         IF (CHAR != EMPTY) [
           CALL THIT(I,KX,KY,CHAR,TDIR(I,K),500.)
           UNIV(IX,IY)=EMPTY
           TDIR(I,K)=-1.
           ]
         ELSE [
           UNIV(IX,IY)=EMPTY
           UNIV(KX,KY)='+'
           TLOCS(I,K,1)=X
           TLOCS(I,K,2)=Y
           ]
         ]
       ELSE [
         TDIR(I,K)=-1.
         ]
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE SENT(I,NUM)
#
#     * SEND MESSAGES TO THE PLAYERS
#
   INCLUDE COMMON.RAT
 
   DO K=1 , 10 [
     IF (ISENT(I,K) == 0) [
       ISENT(I,K)=NUM
       GOTO 202
       ]
     ]
#     * MESSAGE BUFFER IS FULL SO COPY IT UP TO KEEP MOST RECENT
   DO K=1, 9 [
     ISENT(I,K)=ISENT(I,K+1)
     ]
   ISENT(I,10)=NUM
202 RETURN
   END
 
 
 
   SUBROUTINE MHOMER
#
#     MOVE HOMING TORPEDOES
#
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   BYTE CHAR
#
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     DO II=4, 1, -1 [	# BACKWARDS SO THEY DON'T PILE UP ON EACH OTHER
       IF (WHOM(I,II) == 0) [
         CONTINUE
         ]
 
       ELSE IF (WHOM(I,II) < 0) [
#
#     * LAUNCH
#
         TWHOM= -WHOM(I,II)
         XH=XCORD(I)
         YH=YCORD(I)
         D=ATAN3((YCORD(TWHOM)-YH),(XCORD(TWHOM)-
           XH)) * 180./3.14159
         CALL MOVE(XH,YH,X,Y,D,10.,CHAR,UNIV,EMPTY)
         KX=X
         KY=Y
         IX=XCORD(I)
         IY=YCORD(I)
         IF ((IX == KX) & (IY == KY)) [
           CALL MOVE(X,Y,X1,Y1,D,10.,CHAR,UNIV,EMPTY)
           X=X1
           Y=Y1
           ]
         KX=X
         KY=Y
         IF (CHAR != EMPTY) [
           CALL THIT(I,KX,KY,CHAR,D,300.)
           WHOM(I,II)=0
           ]
         ELSE [
           UNIV(KX,KY)='^'
           XHOM(I,II)=X
           YHOM(I,II)=Y
           WHOM(I, II) = -WHOM(I, II)
           ]
         ]
 
       IF (WHOM(I,II) > 0) [
#
#     * CHECK TO SEE IF ACTIVE
#
         IX=XHOM(I,II)
         IY=YHOM(I,II)
         IF (UNIV(IX,IY) == '^') [
#
#     * CALCULATE COURSE
#
           D=ATAN3((YCORD(WHOM(I,II))-YHOM(I,II)),(XCORD(WHOM(I,II))-
             XHOM(I,II))) * 180./3.14159
           CALL MOVE(XHOM(I,II),YHOM(I,II),X,Y,D,10.,CHAR,UNIV,EMPTY)
           KX=X
           KY=Y
           IF (CHAR != EMPTY) [
             CALL THIT(I,KX,KY,CHAR,D,300.)
             UNIV(IX,IY)=EMPTY
             WHOM(I,II)=0
             ]
           ELSE [
             UNIV(IX,IY)=EMPTY
             UNIV(KX,KY)='^'
             XHOM(I,II)=X
             YHOM(I,II)=Y
             ]
           ]
         ELSE [
           WHOM(I,II)=0
           ]
         ]
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE MHOLE
#
#     * MOVE THE "BLACK HOLE" TOWARD THE NEAREST ACTIVE SHIP
#
   INCLUDE COMMON.RAT
   BYTE CHAR
#
#     * FIND CLOSEST SHIP
#
   DM=1.6E37
   K=0
   DO I=1, 8 [
     IF (XSHIP(I)) [
       D=((HX-XCORD(I))**2 + (HY-YCORD(I))**2)**.5
       IF (D < DM) [
         DM=D
         K=I
         ]
       ]
     ]
#
#    *FIND DIRECTION OF CLOSEST SHIP
#
   IF (K != 0) [
     D=ATAN3((YCORD(K)-HY),(XCORD(K)-HX))*180./3.14159
#
     CALL MOVE(HX,HY,X,Y,D,HW,CHAR,UNIV,EMPTY)
     IF ((CHAR == EMPTY) | (CHAR == '+')  | (CHAR == '@')
       | (CHAR == '^')) [
#     * JUST MUNCH THIS JUNK DOWN
       IX=HX
       IY=HY
       UNIV(IX,IY)=EMPTY
       IX=X
       IY=Y
       UNIV(IX,IY)=BHOLE
       HX=X
       HY=Y
       ]
 
     ELSE IF ((CHAR >= '1') & (CHAR <= '8')) [
#     * CAUGHT A SHIP
       I = CHAR-DIG0
       IF (XSHIP(I)) [
         CALL SENT(I,15)
         CALL RESET(I)
         ]
       ]
 
     ELSE IF (CHAR < 0)
#     * CAN'T EAT ENERGY NET!
       ;
 
     ELSE [
#     * 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)=BHOLE
       ]
     ]
   RETURN
   END
 
 
 
   SUBROUTINE MANTI
#
#     * DEAL WITH ANTI-MATTER
#
#
#     MOVE ANTI-MATTER PODS
#
   INCLUDE COMMON.RAT
   COMMON /DOLOOP/ SHIPS
   INTEGER SHIPS(8)
   BYTE CHAR
   INTEGER IPX(21),IPY(21)
#
#     * THE FOLLOWING DATA DESCIBES THE EXPLOSION PATTERN FOR
#     ANTI-MATTER PODS
#
   DATA IPX/-3,-2,-2,-2,-1,-1,-1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 0/
   DATA IPY/ 0, 2, 0,-2, 1, 0,-1, 3, 2, 1,-1,-2,-3, 1, 0,-1, 2, 0,-2, 0, 0/
   CALL PERM(SHIPS, I1, I2)
   DO ISHP = 1, 8 [
     I = SHIPS(ISHP)
     IF (IPOD(I) == 1) [
#     * LAUNCH POD
       CALL MOVE(XCORD(I),YCORD(I),X1,Y1,DPOD(I),10.,CHAR,UNIV,EMPTY)
       IX=X1
       IY=Y1
       KX=XCORD(I)
       KY=YCORD(I)
#     * MAKE SURE IT CLEARS THE SHIP
       IF ((KX == IX) & (KY == IY)) [
         CALL MOVE(X1,Y1,X,Y,DPOD(I),10.,CHAR,UNIV,EMPTY)
         ]
       ELSE [
         X=X1
         Y=Y1
         ]
       IX=X
       IY=Y
       IF (CHAR == EMPTY) [
#     * SUCCESSUL LAUNCH
         UNIV(IX,IY)='@'
         XPOD(I)=X
         YPOD(I)=Y
         IPOD(I)=2
         WPOD(I)=5.
         CALL SENT(I,28)
         ]
       ELSE [
         CALL SENT(I,23)
         IPOD(I)=0
         ]
       ]
 
     IF (IPOD(I) == 2) [
#     * POD IS ON THE MOVE
       IX=XPOD(I)
       IY=YPOD(I)
       IF (UNIV(IX,IY) == '@') [
         CALL MOVE(XPOD(I),YPOD(I),X,Y,DPOD(I),WPOD(I),CHAR,UNIV,EMPTY)
         IF ((CHAR == EMPTY) | (CHAR == '+' ) | (CHAR == '^')) [
           UNIV(IX,IY)=EMPTY
           IX=X
           IY=Y
           UNIV(IX,IY)='@'
           XPOD(I)=X
           YPOD(I)=Y
           ]
 
         ELSE IF (CHAR == 'H') [
           IF (HYPER(I) == 1) [
             KX=20
             KY=75
             ]
           ELSE IF (HYPER(I) == 2) [
             KX=50
             KY=70
             ]
           ELSE IF (HYPER(I) == 3) [
             KX=80
             KY=75
             ]
           ELSE IF (HYPER(I) == 4) [
             KX=20
             KY=25
             ]
           ELSE IF (HYPER(I) == 5) [
             KX=50
             KY=30
             ]
           ELSE IF (HYPER(I) == 6) [
             KX=80
             KY=25
             ]
           ELSE [
             STOP 52
             ]
           DO II=(KX-1), (KX+1) [
             DO IJ=(KY-1), (KY+1) [
               IF (UNIV(II,IJ) == EMPTY) [
                 UNIV(II,IJ)='@'
                 UNIV(IX,IY)=EMPTY
                 XPOD(I)=II
                 YPOD(I)=IJ
                 XPOD(I)=XPOD(I)+.5
                 YPOD(I)=YPOD(I)+.5
                 IPOD(I) = 3
                 BREAK 2
                 ]
               ]
             ]
           ]
 
         ELSE IF (CHAR == 'R') [
           REPEAT [
             KX=RAN(I1,I2)*100.+1.
             KY=RAN(I1,I2)*100.+1.
             ] UNTIL (UNIV(KX,KY) == EMPTY)
           XPOD(I)=KX
           YPOD(I)=KY
           XPOD(I)=XPOD(I)+.5
           YPOD(I)=YPOD(I)+.5
           UNIV(IX,IY)=EMPTY
           UNIV(KX,KY)='@'
           IPOD(I) = 3
           ]
 
         ELSE [
           IF (RAN(I1,I2) > .5) [
             DPOD(I)=DPOD(I)+90.
             ]
           ELSE [
             DPOD(I)=DPOD(I)-90.
             ]
           ]
         ]
       ELSE [
         CALL SENT(I,24)
         IPOD(I)=4
         ]
       ]
 
     IF (IPOD(I) == 3) [
#     * DETONATE POD
       IX=XPOD(I)
       IY=YPOD(I)
       IF (UNIV(IX,IY) == '@') [
         IPOD(I)=4
         CALL SENT(I,29)
         DO L1=1, 21 [
           KX=IX+IPX(L1)
           IF (KX >= 101) [
             KX=KX-100
             ]
           IF (KX < 1) [
             KX=KX+100
             ]
           KY=IY+IPY(L1)
           IF (KY >= 101) [
             KY=KY-100
             ]
           IF (KY < 1) [
             KY=KY+100
             ]
           CHAR=UNIV(KX,KY)
           IF ((CHAR >= '1' ) & ( CHAR <= '8')) [
             CONTINUE
#
             ]
           ELSE IF (CHAR == 'H') [
             CONTINUE
#
             ]
           ELSE IF (CHAR == 'B') [
             CONTINUE
#
             ]
           ELSE IF (CHAR == BHOLE) [
             CALL SENT(I,31)
#$             SCORE(I)=SCORE(I)+1000.
             UNIV(KX,KY)=EMPTY
             REPEAT [
               IIX=RAN(I1,I2)*100.+1.
               IIY=RAN(I1,I2)*100.+1.
               ] UNTIL (UNIV(IIX, IIY) == EMPTY)
             HX=IIX
             HY=IIY
             UNIV(IIX,IIY)=BHOLE
             ]
           ELSE [
             UNIV(KX,KY)=EMPTY
             ]
           ]
#
#     * FIGURE SHIP DAMAGE
#
         DO IZ = 1, 8 [
#$           D=((XCORD(IZ)-XPOD(I))**2 + (YCORD(IZ)-YPOD(I))**2 ) **.5
           D = DSTNCE(XCORD(IZ),YCORD(IZ),XPOD(I),YPOD(I))
           IF (D <= 4) [
             IS=7.-D
             E=1500. - D* 300.
             IF (XSHIP(IZ)) [
               CALL SENT(IZ,30)
               CALL DAMAGE(IZ,E,500.)
               SCAN(IZ)=SCAN(IZ)-IS
               IF (SCAN(IZ) < 0) [
                 SCAN(IZ)=0
                 ]
               IF (ENERGY(IZ) <= 0.) [
                 IF (I != IZ) [
                   CALL SENT(I,22)
#$                   SCORE(I)=SCORE(I)+2000.
                   ]
                 CALL RESET(IZ)
                 ]
               IF (I != IZ) [
                 SCORE(I)=SCORE(I)+E
                 CALL SENT(I,32)
                 ]
               ]
             ELSE [
               CALL SENT(I,21)
               ]
             ]
           ]
         ]
       ELSE [
         CALL SENT(I,24)
         IPOD(I)=4
         ]
       ]
 
     ELSE [
       CONTINUE
       ]
     ]
   RETURN
   END
 
 
 
   REAL FUNCTION DSTNCE(XX,YY,X1,Y1)
   CALL DIRDIS(XX, YY, X1, Y1, DIR, DIS)
   DSTNCE = DIS
   RETURN
   END
 
 
 
   SUBROUTINE PERM(SHIPS, I1, I2)
#
# PERM - SHUFFLE SHIPS
#
#  DUE TO L. E. MOSES AND R. V. OAKFORD, AND
#  R. DURSTENFELD
#  TAKEN FROM KNUTH VOL 2, SEMINUMERICAL ALGORITHMS, P. 125
#
   INTEGER SHIPS(8), J, K, I1, I2, TMP
 
   DO J = 8, 2, -1 [
     K = IFIX(FLOAT(J)*RAN(I1,I2)) + 1
     TMP = SHIPS(K); SHIPS(K) = SHIPS(J); SHIPS(J) = TMP
     ]
   RETURN
   END
 
# POLADD - ADD POLAR COORDINATES: D3, R3 = D1, R1 + D2, R2	# WPW 12/7/80
SUBROUTINE POLADD(D1, R1, D2, R2, D3, R3)
XT = R1*COS(D1*3.141592654/180.) + R2*COS(D2*3.141592654/180.)
YT = R1*SIN(D1*3.141592654/180.) + R2*SIN(D2*3.141592654/180.)
D3 = ATAN3(YT, XT)*180./3.141592654
R3 = SQRT(XT*XT + YT*YT)
RETURN
END
 
# DIRDIS - FIND SHORTEST DIR AND DIS IN UNIV W/ WRAP-AROUND	# WPW 12/8/80
SUBROUTINE DIRDIS(XX, YY, X1, Y1, DIR, DIS)
REAL D1(4)
IF (X1 < 51.) [
  X2=X1+100.
  ]
ELSE [
  X2=X1-100.
  ]
IF (Y1 < 51.) [
  Y2=Y1+100.
  ]
ELSE [
  Y2=Y1-100.
  ]
D1(1)=((XX-X1)**2 + (YY-Y1)**2)**.5
D1(2)=((XX-X1)**2 + (YY-Y2)**2)**.5
D1(3)=((XX-X2)**2 + (YY-Y1)**2)**.5
D1(4)=((XX-X2)**2 + (YY-Y2)**2)**.5
IIT=1
DO J=2,4
  IF (D1(J) < D1(IIT))
    IIT=J
IF (IIT == 1) [
  YD=Y1
  XD=X1
  ]
ELSE IF (IIT == 2) [
  YD=Y2
  XD=X1
  ]
ELSE IF (IIT == 3) [
  YD=Y1
  XD=X2
  ]
ELSE [
  YD=Y2
  XD=X2
  ]
DIR=ATAN3((YD-YY),(XD-XX))*57.29577951
DIS=D1(IIT)
RETURN
END