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