0 INDENT= 4 WARN= OFF PROGRAM DRIVER PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:27 0 LINE LEVEL C1 1 0 PROGRAM DRIVER 2 0 C 3 0 C AUTHOR: DON LEDFORD THE BOEING COMPANY NOVEMBER 1978 4 0 C DECEMBER 1978 JOHN LUTCH ADDED CLOAKING 5 0 C DECEMBER 1978 DON LEDFORD ADDED ANTI-MATTER 6 0 C MARCH 1979 RAY FRENCH ADDED CONTINUOUS DISPLAY 7 0 C 8 0 TEXT COMMON 9 0 BEGIN COMMON 10 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 11 0 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 12 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 13 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 14 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 15 0 REAL LAUNCH 16 0 INTEGER CREW,HYPER,TORPS 17 0 LOGICAL*1 XSHIP,CLOAK 18 0 BYTE THRU,UNIV,MESSAG 19 0 ENDTEXT 20 0 COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8) 21 0 LOGICAL*1 OK,YES 22 0 BYTE CHAR 23 0 DATA HX/30./ 24 0 DATA HY/60./ 25 0 C 26 0 WRITE(5,) 10000 27 0 FORMAT('0 WELCOME TO MULTI-TREK') 28 0 WRITE(5,) 10001 29 0 FORMAT('$ARE YOU CONTINUING AN EXISTING GAME ? ') 30 0 CALL YESNO(YES) 31 0 IF .NOT. YES THEN 32 0 C 33 0 C * INITIALIZE SHIPS AS UNOWNED AND NOT CLOAKED 34 0 C 35 1 FOR I=1 UNTIL 8 DO 36 2 XSHIP(I)=.FALSE. 37 2 CLOAK(I)=.FALSE. 38 1 ENDDO 39 1 WRITE(5,) 10008 40 1 FORMAT('$ENTER STAR DENSITY OF UNIVERSE PARTS PER 100 : ') 41 1 CALL GETREL(STARS,OK,0.,15.) 42 1 IF .NOT. OK THEN 43 2 STARS=2.5 44 1 ENDIF 45 1 WRITE(5,) 10012 46 1 FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES : ') 47 1 CALL GETREL(BASES,OK,0.,50.) 48 1 IF .NOT. OK THEN 49 2 BASES=20. 50 1 ENDIF 0 PROGRAM DRIVER 1 0 INDENT= 4 WARN= OFF PROGRAM DRIVER PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:29 0 LINE LEVEL C1 51 1 WRITE(5,) 10016 52 1 FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS : ') 53 1 CALL GETINT(N,OK,0,10) 54 1 IF .NOT. OK THEN 55 2 N=3 56 1 ENDIF 57 1 WRITE(5,) 10020 58 1 FORMAT('$ENTER A RANDOM INTEGER : ') 59 1 CALL GETINT(I1,OK,-32000,32000) 60 1 C 61 1 C * GET THE COMPUTER TIME AND MAKE IT INTO AN INTEGER < 32 K 62 1 C 63 1 T1=SECNDS(0.0) 64 1 UNTIL T1 .LE. 32000 DO 65 2 T1=T1/13. 66 1 ENDDO 67 1 I2=T1 68 1 C 69 1 C * NOW GENERATE THE UNIVERSE 70 1 C 71 1 FOR I=1 UNTIL 100 DO 72 2 FOR J=1 UNTIL 100 DO 73 3 RNDOM=RAN(I1,I2) 74 3 SELECT 75 3 WHEN RNDOM .GT. (100.-STARS)/100. THEN 76 4 UNIV(I,J)='*' 77 4 C 78 3 WHEN RNDOM .LE. BASES/10000. THEN 79 4 UNIV(I,J)='B' 80 4 C 81 3 OTHERWISE 82 4 UNIV(I,J)='.' 83 4 C 84 3 ENDS 85 2 ENDDO 86 1 ENDDO 87 1 C 88 1 C * PUT IN THE HYPERSPACE PORTS 89 1 C 90 1 UNIV(20,25)='H' 91 1 UNIV(20,75)='H' 92 1 UNIV(50,30)='H' 93 1 UNIV(50,70)='H' 94 1 UNIV(80,25)='H' 95 1 UNIV(80,75)='H' 96 1 C 97 1 C * PUT IN THE MOBILE "BLACK HOLE" 98 1 C 99 1 UNIV(30,60)='#' 100 1 HX=30. 0 PROGRAM DRIVER 1 0 INDENT= 4 WARN= OFF PROGRAM DRIVER PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:31 0 LINE LEVEL C1 101 1 HY=60. 102 1 C 103 1 C * PUT IN THE RANDOM HYPER-SPACE PORTS 104 1 C 105 1 FOR I=1 UNTIL N DO 106 2 OK=.FALSE. 107 2 UNTIL OK DO 108 3 IX=RAN(I1,I2)*100.+1. 109 3 IF IX .GT. 100 THEN 110 4 IX=100 111 3 ENDIF 112 3 IY=RAN(I1,I2)*100.+1. 113 3 IF IY .GT. 100 THEN 114 4 IY=100 115 3 ENDIF 116 3 IF UNIV(IX,IY) .EQ. '.' THEN 117 4 UNIV(IX,IY)='R' 118 4 OK=.TRUE. 119 3 ENDIF 120 2 ENDDO 121 1 ENDDO 122 1 C 123 1 C * PUT IN THE STAR SHIPS 124 1 C 125 1 FOR I=1 UNTIL 8 DO 126 2 OK=.FALSE. 127 2 UNTIL OK DO 128 3 IX=RAN(I1,I2)*100.+1. 129 3 IF IX .GT. 100 THEN 130 4 IX=100 131 3 ENDIF 132 3 IY=RAN(I1,I2)*100.+1. 133 3 IF IY .GT. 100 THEN 134 4 IY=100 135 3 ENDIF 136 3 IF UNIV(IX,IY) .EQ. '.' THEN 137 4 ENCODE(1,,CHAR) I 10069 138 4 FORMAT(I1) 139 4 UNIV(IX,IY)=CHAR 140 4 XCORD(I)=IX 141 4 YCORD(I)=IY 142 4 XCORD(I)=XCORD(I)+.5 143 4 YCORD(I)=YCORD(I)+.5 144 4 OK=.TRUE. 145 3 ENDIF 146 2 ENDDO 147 1 ENDDO 148 1 C 149 1 C * INITIALIZE STARTING STATUS OF THE STAR SHIPS 150 1 C 0 PROGRAM DRIVER 1 0 INDENT= 4 WARN= OFF PROGRAM DRIVER PAGE 4 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:33 0 LINE LEVEL C1 151 1 FOR I=1 UNTIL 8 DO 152 2 ENERGY(I)=10000. 153 2 SHIELD(I)=0. 154 2 TORPS(I)=10. 155 2 IPOD(I)=0 156 2 CREW(I)=400 157 2 WARP(I)=0. 158 2 MESSAG(I*60-59)=' ' 159 2 SCORE(I)=0. 160 2 IT(I)=1 161 2 HYPER(I)=3 162 2 FOR K=1 UNTIL 10 DO 163 3 ISENT(I,K)=0 164 3 TDIR(I,K)=-1. 165 3 TLOCS(I,K,1)=1 166 3 TLOCS(I,K,2)=1 167 2 ENDDO 168 1 ENDDO 169 1 C 170 1 WRITE(5,) 10076 171 1 FORMAT('$ENTER ENERGY DRAIN FOR CLOAKING : ') 172 1 CALL GETREL(CDRAIN,OK,0.,2000.) 173 1 IF .NOT. OK THEN 174 2 CDRAIN=25. 175 1 ENDIF 176 1 WRITE(5,) 10080 177 1 FORMAT('$ENTER WARP SPEED OF "BLACK HOLE" : ') 178 1 CALL GETREL(HW,OK,0.,10.) 179 1 IF .NOT. OK THEN 180 2 HW=5. 181 1 ENDIF 182 0 ENDIF 183 0 WRITE(5,) 10084 184 0 FORMAT('0MULTI-TREK INITIALIZED') 185 0 THRU=-1 186 0 C 187 0 C * HERE STARTS THE ACTUAL GAME PLAYING 188 0 C 189 0 WHILE THRU.GE.-1 DO 190 1 UNTIL THRU.EQ.0 DO 191 2 CALL WAIT(40,0,M) 192 2 C * FIRE TORPEDOES 193 2 CALL TORPI 194 2 C * FIRE PHASERS 195 2 CALL PHASER 196 2 C * MOVE ACTIVE TORPEDOES 197 2 CALL MTORPS 198 2 C * MOVE SHIPS 199 2 CALL MSHIPS(CDRAIN) 200 2 C * MOVE THE "BLACK HOLE" 0 PROGRAM DRIVER 1 0 INDENT= 4 WARN= OFF PROGRAM DRIVER PAGE 5 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:34 0 LINE LEVEL C1 201 2 CALL MHOLE(HX,HY,HW) 202 2 C * HANDLE ALL ANTI-MATTER TRANSACTIONS 203 2 CALL MANTI(HX,HY) 204 1 ENDDO 205 1 C 206 1 C ALL PLAYERS ARE GONE - BUT WAIT 15 SECONDS BEFORE LEAVING 207 1 C 208 1 THRU=-2 209 1 K=0 210 1 UNTIL K.GE.15 DO 211 2 CALL WAIT(1,2,M) 212 2 IF THRU.GT.0 THEN 213 3 K=15 214 2 ELSE 215 3 K=K+1 216 2 ENDIF 217 1 ENDDO 218 0 ENDDO 219 0 CALL EXIT 220 0 END 0 PROGRAM DRIVER 1 0 INDENT= 4 WARN= OFF SUBROUTINE MSHIPS(CDRAIN) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:35 0 LINE LEVEL C1 1 0 SUBROUTINE MSHIPS(CDRAIN) 2 0 TEXT COMMON 3 0 BEGIN COMMON 4 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 5 0 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 6 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 7 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 8 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 9 0 REAL LAUNCH 10 0 INTEGER CREW,HYPER,TORPS 11 0 LOGICAL*1 XSHIP,CLOAK 12 0 BYTE THRU,UNIV,MESSAG 13 0 ENDTEXT 14 0 C 15 0 BYTE CHAR,SHIP 16 0 LOGICAL*1 OK 17 0 C 18 0 FOR I=1 UNTIL 8 DO 19 1 IF XSHIP(I) THEN 20 2 IF CLOAK(I) THEN 21 2 C * CAN'T MOVE IF YOUR CLOAKED 22 3 WARP(I)=0. 23 3 ENERGY(I)=ENERGY(I)-CDRAIN 24 2 ENDIF 25 2 IX=XCORD(I) 26 2 IY=YCORD(I) 27 2 ENCODE(1,,SHIP) I 10009 28 2 FORMAT(I1) 29 2 ENERGY(I)=ENERGY(I)-WARP(I)/2 30 2 CALL MOVE(XCORD(I),YCORD(I),X,Y,DIR(I),WARP(I),CHAR,UNIV) 31 2 KX=X 32 2 KY=Y 33 2 SELECT 34 2 WHEN CHAR .LE. '8' .AND. CHAR .GE. '1' THEN 35 2 C * WE HAVE RAMMED A SHIP 36 3 DECODE(1,,CHAR) K 10016 37 3 FORMAT(I1) 38 3 ENERGY(I)=ENERGY(I)-100. 39 3 IF XSHIP(K) THEN 40 4 ENERGY(K)=ENERGY(K)-100. 41 4 CALL SENT(K,10) 42 3 ENDIF 43 3 WARP(I)=0. 44 3 WARP(K)=0. 45 3 CALL SENT(I,9) 46 3 C 47 2 WHEN CHAR .EQ. 'B' THEN 48 2 C * RAMMED (DOCKED) A BASE 49 3 CALL SENT(I,1) 50 3 TORPS(I)=10 0 SUBROUTINE MSHIPS(CDRAIN) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MSHIPS(CDRAIN) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:37 0 LINE LEVEL C1 51 3 WARP(I)=0. 52 3 ENERGY(I)=10000. 53 3 SHIELD(I)=0. 54 3 IPOD(I)=0 55 3 C 56 2 WHEN CHAR .EQ. '*' THEN 57 2 C * HIT A STAR 58 3 CALL SENT(I,2) 59 3 ENERGY(I)=ENERGY(I)-200. 60 3 WARP(I)=0. 61 3 C 62 2 WHEN CHAR .EQ. '+' THEN 63 2 C * HIT A TORPEDO 64 3 CALL SENT(I,4) 65 3 CALL DAMAGE(I,500.) 66 3 CALL TFIND(K,KX,KY) 67 3 IF K .NE. 0 THEN 68 4 CALL SENT(K,5) 69 4 SCORE(K)=SCORE(K)+500. 70 4 IF ENERGY(I) .LE. 0 THEN 71 5 CALL SENT(K,22) 72 5 SCORE(K)=SCORE(K)+2000. 73 5 CALL RESET(I) 74 4 ENDIF 75 3 ENDIF 76 3 C 77 2 WHEN CHAR .EQ. 'H' THEN 78 2 C * HIT A HYPERSPACE PORT 79 3 CALL SENT(I,17) 80 3 SELECT USING HYPER(I) 81 3 WHEN 1 THEN 82 4 KX=20 83 4 KY=75 84 3 WHEN 2 THEN 85 4 KX=50 86 4 KY=70 87 3 WHEN 3 THEN 88 4 KX=80 89 4 KY=75 90 3 WHEN 4 THEN 91 4 KX=20 92 4 KY=25 93 3 WHEN 5 THEN 94 4 KX=50 95 4 KY=30 96 3 WHEN 6 THEN 97 4 KX=80 98 4 KY=25 99 3 OTHERWISE 100 4 STOP 50 0 SUBROUTINE MSHIPS(CDRAIN) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MSHIPS(CDRAIN) PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:39 0 LINE LEVEL C1 101 3 ENDS 102 3 C 103 3 C * PUT THE SHIP NEAR THE DESTINATION PORT IF POSSIBLE 104 3 C 105 3 FOR II=(KX-1) UNTIL (KX+1) DO 106 4 FOR IJ=(KY-1) UNTIL (KY+1) DO 107 5 IF UNIV(II,IJ) .EQ. '.' THEN 108 6 UNIV(II,IJ)=SHIP 109 6 UNIV(IX,IY)='.' 110 6 XCORD(I)=II 111 6 YCORD(I)=IJ 112 6 XCORD(I)=XCORD(I)+.5 113 6 YCORD(I)=YCORD(I)+.5 114 6 GOTO 100 115 5 ENDIF 116 4 ENDDO 117 3 ENDDO 118 3 C * IF WE ARE HERE WE DIDN'T FIND AN EMPTY SPOT ( VERY UNLIKELY) 119 3 CALL SENT(I,18) 120 3 100 WARP(I)=0. 121 3 C 122 2 WHEN CHAR .EQ. '#' THEN 123 2 C * RUN INTO THE "BLACK HOLE" ( NICE FLYING) 124 3 CALL SENT(I,15) 125 3 CALL RESET(I) 126 3 C 127 2 WHEN CHAR .EQ. 'R' THEN 128 2 C * HIT A RANDOM HYPERSPACE PORT 129 3 CALL SENT(I,19) 130 3 OK=.FALSE. 131 3 C * FIND A NEW EMPTY LOCATION 132 3 UNTIL OK DO 133 4 KX=RAN(I1,I2)*100.+1. 134 4 IF KX .GT. 100 THEN 135 5 KX=100 136 4 ENDIF 137 4 KY=RAN(I1,I2)*100.+1. 138 4 IF KY .GT. 100 THEN 139 5 KY=100 140 4 ENDIF 141 4 IF UNIV(KX,KY) .EQ. '.' THEN 142 5 OK=.TRUE. 143 5 XCORD(I)=KX 144 5 YCORD(I)=KY 145 5 XCORD(I)=XCORD(I)+.5 146 5 YCORD(I)=YCORD(I)+.5 147 5 WARP(I)=0. 148 5 UNIV(IX,IY)='.' 149 5 UNIV(KX,KY)=SHIP 150 4 ENDIF 0 SUBROUTINE MSHIPS(CDRAIN) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MSHIPS(CDRAIN) PAGE 4 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:41 0 LINE LEVEL C1 151 3 ENDDO 152 3 C 153 2 WHEN CHAR .EQ. '@' THEN 154 2 C * BUMPED INTO AN ANTI-MATTER POD 155 3 CALL SENT(I,27) 156 3 C 157 2 OTHERWISE 158 3 XCORD(I)=X 159 3 YCORD(I)=Y 160 3 UNIV(IX,IY)='.' 161 3 UNIV(KX,KY)=SHIP 162 2 ENDS 163 2 IF ENERGY(I) .LE. 0. THEN 164 3 CALL SENT(I,16) 165 3 CALL RESET(I) 166 2 ENDIF 167 1 ENDIF 168 0 ENDDO 169 0 RETURN 170 0 END 0 SUBROUTINE MSHIPS(CDRAIN) 1 0 INDENT= 4 WARN= OFF SUBROUTINE RESET(K) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:42 0 LINE LEVEL C1 1 0 SUBROUTINE RESET(K) 2 0 C 3 0 C * RE-INCARNATE DESTROYED SHIPS 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 BYTE CHAR 18 0 XSHIP(K)=.FALSE. 19 0 ENERGY(K)=10000. 20 0 WARP(K)=0. 21 0 TORPS(K)=10. 22 0 SHIELD(K)=0. 23 0 IPOD(K)=0 24 0 CALL SENT(K,3) 25 0 SCORE(K)=SCORE(K)-1000. 26 0 KX=XCORD(K) 27 0 KY=YCORD(K) 28 0 UNIV(KX,KY)='.' 29 0 CHAR='X' 30 0 UNTIL CHAR .EQ. '.' DO 31 1 IX=RAN(I1,I2)*100.+1. 32 1 IF IX .GT. 100 THEN 33 2 IX=100 34 1 ENDIF 35 1 IY=RAN(I1,I2)*100.+1. 36 1 IF IY .GT. 100 THEN 37 2 IY=100 38 1 ENDIF 39 1 CHAR=UNIV(IX,IY) 40 0 ENDDO 41 0 ENCODE(1,,CHAR) K 10009 42 0 FORMAT(I1) 43 0 UNIV(IX,IY)=CHAR 44 0 XCORD(K)=IX 45 0 YCORD(K)=IY 46 0 RETURN 47 0 END 0 SUBROUTINE RESET(K) 1 0 INDENT= 4 WARN= OFF SUBROUTINE THIT(I,IX,IY,CHAR) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:44 0 LINE LEVEL C1 1 0 SUBROUTINE THIT(I,IX,IY,CHAR) 2 0 C 3 0 C * HANDLE TORPEDO HITS 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 BYTE CHAR 18 0 SELECT 19 0 WHEN (CHAR .EQ. 'H') .OR. (CHAR .EQ. 'R') THEN 20 0 C * TORPEDO HIT ON HYPER SPACE PORT 21 1 CONTINUE 22 1 C 23 0 WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN 24 0 C * TORPEDO HIT ON SHIP 25 1 DECODE (1,,CHAR) K 10008 26 1 FORMAT (I1) 27 1 IF XSHIP(K) THEN 28 2 CALL DAMAGE (K,500.) 29 2 SCORE(I)=SCORE(I)+500. 30 2 CALL SENT(K,4) 31 2 CALL SENT(I,5) 32 2 IF ENERGY (K) .LE. 0. THEN 33 3 CALL RESET(K) 34 3 CALL SENT(I,22) 35 3 SCORE(I)=SCORE(I)+2000. 36 2 ENDIF 37 1 ELSE 38 2 CALL SENT(I,21) 39 1 ENDIF 40 1 C 41 0 WHEN CHAR .EQ. '*' THEN 42 0 C * TORPEDO HIT ON STAR 43 1 CALL SENT(I,13) 44 1 C 45 0 WHEN CHAR .EQ. 'B' THEN 46 0 C * TORPEDO HIT ON BASE 47 1 CALL SENT(I,12) 48 1 SCORE(I)=SCORE(I)-200. 49 1 C 50 0 WHEN CHAR .EQ. '+' THEN 0 SUBROUTINE THIT(I,IX,IY,CHAR) 1 0 INDENT= 4 WARN= OFF SUBROUTINE THIT(I,IX,IY,CHAR) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:46 0 LINE LEVEL C1 51 0 C * TORPEDO HIT ON TORPEDO 52 1 CALL SENT(I,20) 53 1 UNIV(IX,IY)='.' 54 1 C 55 0 WHEN CHAR .EQ. '@' THEN 56 0 C * TORPEDO HIT ON ANTI-MATTER POD 57 1 CALL SENT(I,26) 58 1 C 59 0 OTHERWISE 60 0 C * ANYTHING ELSE GETS DESTROYED 61 1 UNIV (IX,IY) = '.' 62 0 ENDS 63 0 RETURN 64 0 END 0 SUBROUTINE THIT(I,IX,IY,CHAR) 1 0 INDENT= 4 WARN= OFF SUBROUTINE PHASER PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:46 0 LINE LEVEL C1 1 0 SUBROUTINE PHASER 2 0 C 3 0 C * FIRE PHASERS 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 REAL DX(3),DY(3) 18 0 BYTE CHAR 19 0 FOR I=1 UNTIL 8 DO 20 1 IF PHA(I) .GE. 0. THEN 21 1 C 22 1 C * FIRE 3 BAND WIDE BEAM (NOTE EACH BAND HAS ITS OWN HIT OR MISS MESSAGE) 23 1 C 24 2 DX(1)=XCORD(I) 25 2 DY(1)=YCORD(I) 26 2 IF ((PHA(I) .GE. 45.) .AND. (PHA(I) .LT. 135.)) .OR. 27 2 + ((PHA(I) .GE. 225.) .AND. (PHA(I) .LT. 315.)) THEN 28 3 DX(2)=DX(1)-1. 29 3 DX(3)=DX(1)+1. 30 3 DY(2)=DY(1) 31 3 DY(3)=DY(1) 32 2 ELSE 33 3 DX(2)=DX(1) 34 3 DX(3)=DX(1) 35 3 DY(2)=DY(1)-1. 36 3 DY(3)=DY(1)+1. 37 2 ENDIF 38 2 FOR IZ=2 UNTIL 3 DO 39 3 IF (DX(IZ) .GT. 100.) .OR. (DX(IZ) .LT. 1.) THEN 40 4 DX(IZ)=DX(1) 41 3 ENDIF 42 3 IF (DY(IZ) .GT. 100.) .OR. (DY(IZ) .LT. 1.) THEN 43 4 DY(IZ)=DY(1) 44 3 ENDIF 45 2 ENDDO 46 2 FOR IZ=1 UNTIL 3 DO 47 3 X1=DX(IZ) 48 3 Y1=DY(IZ) 49 3 FOR IT=1 UNTIL 10 DO 50 4 CALL MOVE(X1,Y1,X,Y,PHA(I),10.,CHAR,UNIV) 0 SUBROUTINE PHASER 1 0 INDENT= 4 WARN= OFF SUBROUTINE PHASER PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:49 0 LINE LEVEL C1 51 4 IF CHAR .NE. '.' THEN 52 5 EXITDO 53 4 ELSE 54 5 X1=X 55 5 Y1=Y 56 4 ENDIF 57 3 ENDDO 58 3 IX=X 59 3 IY=Y 60 3 DIST=((XCORD(I)-X)**2+(YCORD(I)-Y)**2)**.5 61 3 EN=900./(4.+DIST) 62 3 SELECT 63 3 WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN 64 3 C * HIT ON SHIP 65 4 DECODE(1,,CHAR)K 10033 66 4 FORMAT(I1) 67 4 IF XSHIP(K) THEN 68 4 C * MAKE SURE WE DON'T SHOOT OURSELVES 69 5 IF K .NE. I THEN 70 6 CALL DAMAGE(K,EN) 71 6 SCORE(I)=SCORE(I)+EN 72 6 CALL SENT(I,6) 73 6 CALL SENT(K,14) 74 6 IF ENERGY(K) .LE. 0. THEN 75 7 SCORE(I)=SCORE(I)+2000. 76 7 CALL SENT(I,22) 77 7 CALL RESET(K) 78 6 ENDIF 79 5 ENDIF 80 4 ELSE 81 5 CALL SENT(I,21) 82 4 ENDIF 83 4 C 84 3 WHEN CHAR .EQ. '+' THEN 85 3 C * PHASE HIT ON TORPEDO 86 4 CALL SENT(I,7) 87 4 C 88 3 WHEN CHAR .EQ. '*' THEN 89 3 C * PHASER HIT ON STAR 90 4 CALL SENT(I,11) 91 4 C 92 3 WHEN CHAR .EQ. 'B' THEN 93 3 C * PHASER HIT ON BASE 94 4 CALL SENT(I,12) 95 4 C 96 3 WHEN CHAR .EQ. '@' THEN 97 3 C * PHASER HIT ON ANTI-MATTER POD 98 4 CALL SENT(I,25) 99 4 C 100 3 OTHERWISE 0 SUBROUTINE PHASER 1 0 INDENT= 4 WARN= OFF SUBROUTINE PHASER PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:51 0 LINE LEVEL C1 101 3 C * MISSED 102 4 CALL SENT(I,8) 103 3 ENDS 104 2 ENDDO 105 2 PHA(I)=-1. 106 1 ENDIF 107 0 ENDDO 108 0 RETURN 109 0 END 0 SUBROUTINE PHASER 1 0 INDENT= 4 WARN= OFF SUBROUTINE TORPI PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:51 0 LINE LEVEL C1 1 0 SUBROUTINE TORPI 2 0 C 3 0 C * FIRE TORPEDOES 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8) 18 0 BYTE CHAR 19 0 FOR I=1 UNTIL 8 DO 20 1 IF LAUNCH(I) .GE. 0. THEN 21 2 CALL MOVE(XCORD(I),YCORD(I),X1,Y1,LAUNCH(I),10.,CHAR,UNIV) 22 2 IX=X1 23 2 IY=Y1 24 2 KX=XCORD(I) 25 2 KY=YCORD(I) 26 2 C * MAKE SURE IT MOVED OUT OF THE FIRER'S SQUARE 27 2 IF (KX .EQ. IX) .AND. (KY .EQ. IY) THEN 28 3 CALL MOVE(X1,Y1,X,Y,LAUNCH(I),10.,CHAR,UNIV) 29 2 ELSE 30 3 X=X1 31 3 Y=Y1 32 2 ENDIF 33 2 IX=X 34 2 IY=Y 35 2 IF CHAR .EQ. '.' THEN 36 3 UNIV(IX,IY)='+' 37 3 IF TDIR(I,IT(I)) .GE. 0. THEN 38 4 KX=TLOCS(I,IT(I),1) 39 4 KY=TLOCS(I,IT(I),2) 40 4 IF UNIV(KX,KY) .EQ. '+' THEN 41 5 UNIV(KX,KY)='.' 42 4 ENDIF 43 3 ENDIF 44 3 TLOCS(I,IT(I),1)=X 45 3 TLOCS(I,IT(I),2)=Y 46 3 TDIR(I,IT(I))=LAUNCH(I) 47 3 IT(I)=IT(I)+1 48 3 IF IT(I) .GT. 10 THEN 49 4 IT(I)=1 50 3 ENDIF 0 SUBROUTINE TORPI 1 0 INDENT= 4 WARN= OFF SUBROUTINE TORPI PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:54 0 LINE LEVEL C1 51 2 ELSE 52 2 C * HIT SOMETHING 53 3 CALL THIT(I,IX,IY,CHAR) 54 2 ENDIF 55 2 LAUNCH(I)=-1. 56 1 ENDIF 57 0 ENDDO 58 0 RETURN 59 0 END 0 SUBROUTINE TORPI 1 0 INDENT= 4 WARN= OFF SUBROUTINE DAMAGE(K,EN) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:54 0 LINE LEVEL C1 1 0 SUBROUTINE DAMAGE(K,EN) 2 0 C 3 0 C * CALCULATE DAMAGE DONE 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 SABS=SHIELD(K)/1000. 18 0 IF SABS .GT. 1. THEN 19 1 SABS=1. 20 0 ENDIF 21 0 ENERGY(K)=ENERGY(K)-(1.2-SABS)*EN*8. 22 0 SHIELD(K)=SHIELD(K)-SABS*EN 23 0 IF SHIELD(K) .LT. 0. THEN 24 1 SHIELD(K)=0. 25 0 ENDIF 26 0 RETURN 27 0 END 0 SUBROUTINE DAMAGE(K,EN) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MOVE(XI,YI,XN,YN,D,W,CHAR,UNIV) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:55 0 LINE LEVEL C1 1 0 SUBROUTINE MOVE(XI,YI,XN,YN,D,W,CHAR,UNIV) 2 0 C 3 0 C * MOVE OBJECTS WITH WRAP AROUND 4 0 C 5 0 BYTE CHAR 6 0 BYTE UNIV(100,100) 7 0 YN=YI+SIN(D/180*3.14159)/10.*W 8 0 XN=XI+COS(D/180*3.14159)/10.*W 9 0 IXI=XI 10 0 IYI=YI 11 0 IXN=XN 12 0 IYN=YN 13 0 IF IXN .GE. 101 THEN 14 1 XN=IXN-100 15 0 ENDIF 16 0 IF IXN .LT. 1 THEN 17 1 XN=IXN+100 18 0 ENDIF 19 0 IF IYN .GE. 101 THEN 20 1 YN=IYN-100 21 0 ENDIF 22 0 IF IYN .LT. 1 THEN 23 1 YN=IYN+100 24 0 ENDIF 25 0 IXN=XN 26 0 IYN=YN 27 0 IF (IXI .NE. IXN) .OR. (IYI .NE. IYN) THEN 28 1 CHAR=UNIV(IXN,IYN) 29 0 ELSE 30 0 C 31 0 C * IF THEY DIDN'T MOVE OUT OF THE SQUARE THEY WERE IN JUST INDICATE 32 0 C THAT THE PLACE THEY ENDED UP WAS EMPTY 33 0 C 34 1 CHAR='.' 35 0 ENDIF 36 0 RETURN 37 0 END 0 SUBROUTINE MOVE(XI,YI,XN,YN,D,W,CHAR,UNIV) 1 0 INDENT= 4 WARN= OFF SUBROUTINE TFIND(I,IX,IY) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:57 0 LINE LEVEL C1 1 0 SUBROUTINE TFIND(I,IX,IY) 2 0 C 3 0 C * FIND OUT WHO SHOULD GET THE CREDIT IF SOME ONE RUNS INTO A TORPEDO 4 0 C 5 0 COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8) 6 0 FOR I=1 UNTIL 8 DO 7 1 FOR K=1 UNTIL 10 DO 8 2 IF TDIR(I,K) .GE. 0. THEN 9 3 KX=TLOCS(I,K,1) 10 3 KY=TLOCS(I,K,2) 11 3 IF (IX .EQ. KX) .AND. (IY .EQ. KY) THEN 12 4 GOTO 100 13 3 ENDIF 14 2 ENDIF 15 1 ENDDO 16 0 ENDDO 17 0 I=0 18 0 100 RETURN 19 0 END 0 SUBROUTINE TFIND(I,IX,IY) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MTORPS PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:45:58 0 LINE LEVEL C1 1 0 SUBROUTINE MTORPS 2 0 C 3 0 C * MOVE ALL ACTIVE TORPEDOES 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 COMMON /TORPE/ TLOCS(8,10,2),TDIR(8,10),IT(8) 18 0 BYTE CHAR 19 0 FOR I=1 UNTIL 8 DO 20 1 FOR K=1 UNTIL 10 DO 21 2 IX=TLOCS(I,K,1) 22 2 IY=TLOCS(I,K,2) 23 2 C 24 2 C * MAKE SURE THE TORPEDO IS STILL THERE AND ACTIVE 25 2 C 26 2 IF (UNIV(IX,IY) .EQ. '+') .AND. (TDIR(I,K) .GE. 0.) THEN 27 3 CALL MOVE(TLOCS(I,K,1),TLOCS(I,K,2),X,Y,TDIR(I,K),10.,CHAR,UNIV) 28 3 KX=X 29 3 KY=Y 30 3 IF CHAR .NE. '.' THEN 31 4 CALL THIT(I,KX,KY,CHAR) 32 4 UNIV(IX,IY)='.' 33 4 TDIR(I,K)=-1. 34 3 ELSE 35 4 UNIV(IX,IY)='.' 36 4 UNIV(KX,KY)='+' 37 4 TLOCS(I,K,1)=X 38 4 TLOCS(I,K,2)=Y 39 3 ENDIF 40 2 ELSE 41 3 TDIR(I,K)=-1. 42 2 ENDIF 43 1 ENDDO 44 0 ENDDO 45 0 RETURN 46 0 END 0 SUBROUTINE MTORPS 1 0 INDENT= 4 WARN= OFF SUBROUTINE SENT(I,NUM) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:01 0 LINE LEVEL C1 1 0 SUBROUTINE SENT(I,NUM) 2 0 C 3 0 C * SEND MESSAGES TO THE PLAYERS 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 FOR K=1 UNTIL 10 DO 18 1 IF ISENT(I,K) .EQ. 0 THEN 19 2 ISENT(I,K)=NUM 20 2 GOTO 200 21 1 ENDIF 22 0 ENDDO 23 0 C * MESSAGE BUFFER IS FULL SO COPY IT UP TO KEEP MOST RECENT 24 0 FOR K=1 UNTIL 9 DO 25 1 ISENT(I,K)=ISENT(I,K+1) 26 0 ENDDO 27 0 ISENT(I,10)=NUM 28 0 200 RETURN 29 0 END 0 SUBROUTINE SENT(I,NUM) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MHOLE(HX,HY,HW) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:02 0 LINE LEVEL C1 1 0 SUBROUTINE MHOLE(HX,HY,HW) 2 0 C 3 0 C * MOVE THE "BLACK HOLE" TOWARD THE NEAREST ACTIVE SHIP 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 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 9 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 10 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 11 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 12 0 REAL LAUNCH 13 0 INTEGER CREW,HYPER,TORPS 14 0 LOGICAL*1 XSHIP,CLOAK 15 0 BYTE THRU,UNIV,MESSAG 16 0 ENDTEXT 17 0 BYTE CHAR 18 0 C 19 0 C * FIND CLOSEST SHIP 20 0 C 21 0 DM=1.6E37 22 0 K=0 23 0 FOR I=1 UNTIL 8 DO 24 1 IF XSHIP(I) THEN 25 2 D=((HX-XCORD(I))**2 + (HY-YCORD(I))**2)**.5 26 2 IF D .LT. DM THEN 27 3 DM=D 28 3 K=I 29 2 ENDIF 30 1 ENDIF 31 0 ENDDO 32 0 C 33 0 C * FIND DIRECTION OF CLOSEST SHIP 34 0 C 35 0 IF K .NE. 0 THEN 36 1 D=ATAN2((YCORD(K)-HY),(XCORD(K)-HX))*180./3.14159 37 1 C 38 1 CALL MOVE(HX,HY,X,Y,D,HW,CHAR,UNIV) 39 1 SELECT 40 1 C * JUST MUNCH THIS JUNK DOWN 41 1 WHEN (CHAR .EQ. '.') .OR. (CHAR .EQ. '+') .OR. (CHAR .EQ. '@') 42 1 + THEN 43 2 IX=HX 44 2 IY=HY 45 2 UNIV(IX,IY)='.' 46 2 IX=X 47 2 IY=Y 48 2 UNIV(IX,IY)='#' 49 2 HX=X 50 2 HY=Y 0 SUBROUTINE MHOLE(HX,HY,HW) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MHOLE(HX,HY,HW) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:04 0 LINE LEVEL C1 51 2 C 52 1 WHEN (CHAR .GE. '1') .AND. (CHAR .LE. '8') THEN 53 1 C * CAUGHT A SHIP 54 2 DECODE(1,,CHAR) I 10020 55 2 FORMAT(I1) 56 2 IF XSHIP(I) THEN 57 3 CALL SENT(I,15) 58 3 CALL RESET(I) 59 2 ENDIF 60 2 C 61 1 OTHERWISE 62 1 C * SWAP PLACES WITH BASES STARS ETC. 63 2 IX=HX 64 2 IY=HY 65 2 UNIV(IX,IY)=CHAR 66 2 HX=X 67 2 HY=Y 68 2 IX=HX 69 2 IY=HY 70 2 UNIV(IX,IY)='#' 71 1 ENDS 72 0 ENDIF 73 0 RETURN 74 0 END 0 SUBROUTINE MHOLE(HX,HY,HW) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MANTI(HX,HY) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:06 0 LINE LEVEL C1 1 0 SUBROUTINE MANTI(HX,HY) 2 0 C 3 0 C * DEAL WITH ANTI-MATTER 4 0 C 5 0 C 6 0 C MOVE ANTI-MATTER PODS 7 0 C 8 0 TEXT COMMON 9 0 BEGIN COMMON 10 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 11 0 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 12 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 13 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 14 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 15 0 REAL LAUNCH 16 0 INTEGER CREW,HYPER,TORPS 17 0 LOGICAL*1 XSHIP,CLOAK 18 0 BYTE THRU,UNIV,MESSAG 19 0 ENDTEXT 20 0 BYTE CHAR 21 0 INTEGER IPX(22),IPY(22) 22 0 LOGICAL*1 OK 23 0 C 24 0 C * THE FOLLOWING DATA DESCIBES THE EXPLOSION PATTERN FOR 25 0 C ANTI-MATTER PODS 26 0 C 27 0 DATA IPX/0,-1,0,1,-2,-1,0,1,2,-1,0,1,0,0,0,-3,3,2,2,-2,-2,0/ 28 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/ 29 0 FOR I=1 UNTIL 8 DO 30 1 SELECT USING IPOD(I) 31 1 WHEN 1 THEN 32 1 C * LAUNCH POD 33 2 CALL MOVE(XCORD(I),YCORD(I),X1,Y1,DPOD(I),10.,CHAR,UNIV) 34 2 IX=X1 35 2 IY=Y1 36 2 KX=XCORD(I) 37 2 KY=YCORD(I) 38 2 C * MAKE SURE IT CLEARS THE SHIP 39 2 IF (KX .EQ. IX) .AND. (KY .EQ. IY) THEN 40 3 CALL MOVE(X1,Y1,X,Y,DPOD(I),10.,CHAR,UNIV) 41 2 ELSE 42 3 X=X1 43 3 Y=Y1 44 2 ENDIF 45 2 IX=X 46 2 IY=Y 47 2 IF CHAR .EQ. '.' THEN 48 2 C * SUCCESSUL LAUNCH 49 3 UNIV(IX,IY)='@' 50 3 XPOD(I)=X 0 SUBROUTINE MANTI(HX,HY) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MANTI(HX,HY) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:09 0 LINE LEVEL C1 51 3 YPOD(I)=Y 52 3 IPOD(I)=2 53 3 CALL SENT(I,28) 54 2 ELSE 55 3 CALL SENT(I,23) 56 3 IPOD(I)=0 57 2 ENDIF 58 2 C 59 1 WHEN 2 THEN 60 1 C * POD IS ON THE MOVE 61 2 IX=XPOD(I) 62 2 IY=YPOD(I) 63 2 IF UNIV(IX,IY) .EQ. '@' THEN 64 3 CALL MOVE(XPOD(I),YPOD(I),X,Y,DPOD(I),5.,CHAR,UNIV) 65 3 IF CHAR .EQ. '.' .OR. CHAR .EQ. '+' THEN 66 4 UNIV(IX,IY)='.' 67 4 IX=X 68 4 IY=Y 69 4 UNIV(IX,IY)='@' 70 4 XPOD(I)=X 71 4 YPOD(I)=Y 72 3 ELSE 73 4 IF RAN(I1,I2) .GT. .5 THEN 74 5 DPOD(I)=DPOD(I)+90. 75 4 ELSE 76 5 DPOD(I)=DPOD(I)-90. 77 4 ENDIF 78 3 ENDIF 79 2 ELSE 80 3 CALL SENT(I,24) 81 3 IPOD(I)=4 82 2 ENDIF 83 2 C 84 1 WHEN 3 THEN 85 1 C * DETONATE POD 86 2 IX=XPOD(I) 87 2 IY=YPOD(I) 88 2 IF UNIV(IX,IY) .EQ. '@' THEN 89 3 IPOD(I)=4 90 3 CALL SENT(I,29) 91 3 DO 9 L1=1,22 92 3 KX=IX+IPX(L1) 93 3 IF KX .GE. 101 THEN 94 4 KX=KX-100 95 3 ENDIF 96 3 IF KX .LT. 1 THEN 97 4 KX=KX+100 98 3 ENDIF 99 3 KY=IY+IPY(L1) 100 3 IF KY .GE. 101 THEN 0 SUBROUTINE MANTI(HX,HY) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MANTI(HX,HY) PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:13 0 LINE LEVEL C1 101 4 KY=KY-100 102 3 ENDIF 103 3 IF KY .LT. 1 THEN 104 4 KY=KY+100 105 3 ENDIF 106 3 CHAR=UNIV(KX,KY) 107 3 SELECT 108 3 WHEN (CHAR .GE. '1' ) .AND. ( CHAR .LE. '8') THEN 109 4 DECODE(1,,CHAR) IZ 10049 110 4 FORMAT(I1) 111 4 IF XSHIP(IZ) THEN 112 5 CALL SENT(IZ,30) 113 5 CALL RESET(IZ) 114 5 IF IZ .NE. I THEN 115 6 SCORE(I)=SCORE(I)+2000. 116 6 CALL SENT(I,22) 117 5 ENDIF 118 4 ELSE 119 5 CALL SENT(I,21) 120 4 ENDIF 121 4 C 122 3 WHEN CHAR .EQ. 'H' THEN 123 4 CONTINUE 124 4 C 125 3 WHEN CHAR .EQ. 'B' THEN 126 4 CONTINUE 127 4 C 128 3 WHEN CHAR .EQ. '#' THEN 129 4 CALL SENT(I,31) 130 4 SCORE(I)=SCORE(I)+1000. 131 4 UNIV(KX,KY)='.' 132 4 OK=.FALSE. 133 4 UNTIL OK DO 134 5 IX=RAN(I1,I2)*100.+1. 135 5 IF IX .GT. 100 THEN 136 6 IX=100 137 5 ENDIF 138 5 IY=RAN(I1,I2)*100.+1. 139 5 IF IY .GT. 100 THEN 140 6 IY=100 141 5 ENDIF 142 5 IF UNIV(IX,IY) .EQ. '.' THEN 143 6 HX=IX 144 6 HY=IY 145 6 UNIV(IX,IY)='#' 146 6 OK=.TRUE. 147 5 ENDIF 148 4 ENDDO 149 3 OTHERWISE 150 4 UNIV(KX,KY)='.' 0 SUBROUTINE MANTI(HX,HY) 1 0 INDENT= 4 WARN= OFF SUBROUTINE MANTI(HX,HY) PAGE 4 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:21 0 LINE LEVEL C1 151 3 ENDS 152 3 9 CONTINUE 153 2 ELSE 154 3 CALL SENT(I,24) 155 3 IPOD(I)=4 156 2 ENDIF 157 2 C 158 1 OTHERWISE 159 2 CONTINUE 160 1 ENDS 161 1 C 162 0 ENDDO 163 0 RETURN 164 0 END 0 SUBROUTINE MANTI(HX,HY) 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:21 0 LINE LEVEL C1 1 0 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 2 0 C 3 0 LOGICAL*1 EXIST,OK 4 0 REAL VARI,LOW,HIGH 5 0 BYTE INPUT(15),LEFTED(15) 6 0 INTEGER NCHRS 7 0 OK=.FALSE. 8 0 UNTIL OK 9 0 .DO 10 1 FOR I=1 UNTIL 15 11 1 . DO 12 2 LEFTED(I)=' ' 13 1 ENDDO 14 1 READ(5,100,END=800) NCHRS,(INPUT(I),I=1,15) 15 1 100 FORMAT(Q,15A1) 16 1 GOTO 810 17 1 800 CLOSE(UNIT=5) 18 1 810 CONTINUE 19 1 SELECT 20 1 WHEN NCHRS .EQ. 0 21 1 . THEN 22 2 OK=.TRUE. 23 2 EXIST=.FALSE. 24 1 WHEN NCHRS .LE. 15 THEN 25 1 C * LEFT ADJUST INPUT 26 2 CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) 27 2 DECODE(15,,LEFTED,ERR=200) VARI 10014 28 2 FORMAT(G15.0) 29 2 IF VARI .GE. LOW .AND. VARI .LE. HIGH 30 2 . THEN 31 3 OK=.TRUE. 32 3 EXIST=.TRUE. 33 2 ELSE 34 3 WRITE(5,) 10018 35 3 FORMAT('0SORRY CAPTAIN, BUT YOUR COMMAND',1H','S PARAMETER') 36 3 WRITE(5,150) LOW,HIGH 37 3 150 FORMAT(1H ,'MUST BE BETWEEN ',F15.4,' AND ',F15.4) 38 2 ENDIF 39 2 GO TO 300 40 2 200 TYPE *,'WOULD YOU PLEASE REPEAT THAT SIR ?' 41 2 300 CONTINUE 42 1 OTHERWISE 43 2 WRITE(5,) 10020 44 2 FORMAT(' RUN THAT BY ME AGAIN !') 45 1 ENDS 46 0 ENDDO 47 0 RETURN 48 0 END 0 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:26 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,) 10010 20 3 FORMAT('0WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS') 21 3 WRITE(5,) LOW,HIGH 10011 22 3 FORMAT(' BETWEEN ',I5,' AND ',I5) 23 3 WRITE(5,) 10012 24 3 FORMAT(1H$,' TRY AGAIN :') 25 2 ENDIF 26 2 GOTO 300 27 2 200 WRITE(5,100) 28 2 100 FORMAT(1H$,' TRY AGAIN BOZO :') 29 2 300 CONTINUE 30 1 ENDIF 31 0 ENDDO 32 0 RETURN 33 0 END 0 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 1 0 INDENT= 4 WARN= OFF SUBROUTINE YESNO(FLAG) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 10-APR-79 INLIST= ON C1= P 08:46:30 0 LINE LEVEL C1 1 0 SUBROUTINE YESNO(FLAG) 2 0 LOGICAL*1 FLAG,OK 3 0 BYTE YES(4),NO(4) 4 0 BYTE ANSWER(4) 5 0 DATA YES/'Y','E','S',' '/ 6 0 DATA NO/'N','O',' ',' '/ 7 0 OK=.FALSE. 8 0 UNTIL OK DO 9 1 READ(5,,END=800) NCHRS, (ANSWER(I),I=1,4) 10003 10 1 FORMAT(Q,4A1) 11 1 GOTO 810 12 1 800 CLOSE(UNIT=5) 13 1 810 CONTINUE 14 1 IF (NCHRS .GT. 4) .OR. (NCHRS .LT. 1) THEN 15 2 NCHRS=4 16 1 ENDIF 17 1 C * CHECK FOR YES 18 1 I=KOMSTR(YES,1,NCHRS,ANSWER,1) 19 1 IF I .EQ. 0 THEN 20 2 FLAG=.TRUE. 21 2 OK=.TRUE. 22 1 ELSE 23 1 C * CHECK FOR A NO 24 2 I=KOMSTR(NO,1,NCHRS,ANSWER,1) 25 2 IF I .EQ. 0 THEN 26 3 FLAG=.FALSE. 27 3 OK=.TRUE. 28 2 ELSE 29 2 C * INCORRECT RESPONSE 30 3 WRITE(5,) 10013 31 3 FORMAT('0** PLEASE ANSWER "YES" OR "NO" **') 32 3 WRITE(5,) 10014 33 3 FORMAT('$ ANSWER ? ') 34 2 ENDIF 35 1 ENDIF 36 0 ENDDO 37 0 RETURN 38 0 END 0 SUBROUTINE YESNO(FLAG)