PROGRAM PLAYER C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER CREW,HYPER,TORPS LOGICAL*1 XSHIP,CLOAK BYTE THRU,UNIV,MESSAG C END TEXT EQUIVALENCE (A,COMMND) LOGICAL*1 OK,DONE,YES,WARN BYTE BLANK(80),BUFF(22,22),ISPOT(25),COMMND INTEGER WHO DATA BLANK/80*' '/ DATA OK/.FALSE./ C CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) WRITE(5,10000) 10000 FORMAT('0WELCOME TO MULTI-TREK') C UNTIL OK DO GO TO 10003 10001 IF(OK ) GO TO 10002 10003 CONTINUE WRITE(5,10004) 10004 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') C FOR I=1 UNTIL 8 DO I=1 GO TO 10007 10005 I = I+(1) 10007 IF(I.GT.8) GO TO 10006 C IF .NOT. XSHIP(I) THEN IF(.NOT. XSHIP(I) ) GO TO 10010 GO TO 10008 10010 CONTINUE WRITE(5,10011) I 10011 FORMAT(' SHIP ',I1) C END IF 10008 CONTINUE C END DO GO TO 10005 10006 CONTINUE WRITE(5,10012) 10012 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND :' $) CALL GETINT(WHO,OK,1,8) C IF XSHIP(WHO) THEN IF(XSHIP(WHO) ) GO TO 10015 GO TO 10013 10015 CONTINUE WRITE(5,10016) 10016 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER') WRITE(5,10017) 10017 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND ?') CALL YESNO(OK) GO TO 10014 C ELSE 10013 CONTINUE SCORE(WHO)=0. C END IF 10014 CONTINUE C END DO GO TO 10001 10002 CONTINUE XSHIP(WHO)=.TRUE. CREW(WHO)=CREW(WHO)+1 C C INCREMENT PLAYER COUNT C IF THRU.GT.0 THEN IF( THRU.GT.0 ) GO TO 10020 GO TO 10018 10020 CONTINUE THRU=THRU+1 GO TO 10019 C ELSE 10018 CONTINUE THRU=1 C END IF 10019 CONTINUE C C UNTIL DONE DO GO TO 10023 10021 IF(DONE ) GO TO 10022 10023 CONTINUE WRITE(5,10024) 10024 FORMAT('$',15X,'COMMAND :') READ(5,10025,END=100) A 10025 FORMAT(A4) GOTO 110 100 CLOSE(UNIT=5) 110 CONTINUE C SELECT C C WARP FACTOR COMMAND C C WHEN COMMND .EQ. 'W' THEN 10028 IF(COMMND .EQ. 'W') GO TO 10031 GO TO 10030 10031 CONTINUE WRITE(5,10032) 10032 FORMAT('0WARP FACTOR SIR ?') CALL GETREL(WARP(WHO),OK,0.,8.) C IF .NOT. OK THEN IF(.NOT. OK ) GO TO 10035 GO TO 10033 10035 CONTINUE WARP(WHO)=0. C END IF 10033 CONTINUE WRITE(5,10036) WARP(WHO) 10036 FORMAT('0 WARP FACTOR ',F5.2,' SIR.') C C COURSE COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'C' THEN 10030 IF(COMMND .EQ. 'C') GO TO 10038 GO TO 10037 10038 CONTINUE WRITE(5,10039) 10039 FORMAT('0COURSE SIR ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10042 GO TO 10040 10042 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10045 GO TO 10043 10045 CONTINUE DIR(WHO)=(15.-VALUE)*30. GO TO 10044 C ELSE 10043 CONTINUE DIR(WHO)=(3.-VALUE)*30. C END IF 10044 CONTINUE WRITE(5,10046) VALUE 10046 FORMAT('0 HEADING ',F5.2,' SIR.') C END IF 10040 CONTINUE C C HYPERSPACE COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'H' THEN 10037 IF(COMMND .EQ. 'H') GO TO 10048 GO TO 10047 10048 CONTINUE C IF KOMSTR(A,1,4,'HELP',1).EQ.0 THEN IF( KOMSTR(A,1,4,'HELP',1).EQ.0 ) GO TO 10051 GO TO 10049 10051 CONTINUE WRITE(5,1000) 1000 FORMAT('0A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAGE',T51, $ 'T FIRE TORPEDOES'/' C COURSE HEADING',T30,'P FIRE PHASERS', $ T51,'W SET WARP SPEED'/' F FADE (CLOAKING ON)',T30, $ 'Q QUIT',T51,'X DETONATE ANTI-MATTER'/ $ ' H HYPERSPACE SETTING',T30,'R STATUS REPORT',T51, $ 'Z LAUNCH ANTI-MATTER'/' L LOCATE SHIP',T30, $ 'S SHIELD CHANGE',T51,'HELP DISPLAY HELP MESSAGE'/ $ ' DISPLAY IMMEDIATE AREA'/) GO TO 10050 C ELSE 10049 CONTINUE WRITE(5,10052) HYPER(WHO) 10052 FORMAT('0CURRENT HYPERSPACE JUMP SETTING IS ',I1,' SIR $.') WRITE(5,10053) 10053 FORMAT('$NEW SETTING ?') CALL GETINT(II,OK,1,6) C IF OK THEN IF(OK ) GO TO 10056 GO TO 10054 10056 CONTINUE HYPER(WHO)=II C END IF 10054 CONTINUE C END IF 10050 CONTINUE C C SHIELD COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'S' THEN 10047 IF(COMMND .EQ. 'S') GO TO 10058 GO TO 10057 10058 CONTINUE WRITE(5,10059) 10059 FORMAT('0ENGINEERING TO BRIDGE, HOW MUCH ENERGY SIR ?') CALL GETREL(VALUE,OK,-1.E36,1.E36) C IF OK THEN IF(OK ) GO TO 10062 GO TO 10060 10062 CONTINUE C IF ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE . C GE. 0. THEN IF(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE . $GE. 0. ) GO TO 10065 GO TO 10063 10065 CONTINUE ENERGY(WHO)=ENERGY(WHO)-VALUE SHIELD(WHO)=SHIELD(WHO)+VALUE WRITE(5,10066) 10066 FORMAT('0AYE, CAPTAIN.') GO TO 10064 C ELSE 10063 CONTINUE WRITE(5,10067) 10067 FORMAT('0I AM SORRY CAPTAIN, BUT THAT IS IMPOSSIBL $E.') C END IF 10064 CONTINUE C END IF 10060 CONTINUE WRITE(5,10068) SHIELD(WHO) 10068 FORMAT('0DEFLECTOR SHIELDS ARE NOW AT ',F7.2,' UNITS SIR.' $) C C LOCAL SCAN COMMAND C GO TO 10029 C WHEN COMMND .EQ. ' ' THEN 10057 IF(COMMND .EQ. ' ') GO TO 10070 GO TO 10069 10070 CONTINUE CALL CLEAR IX1=XCORD(WHO)-10. C IF IX1 .LT. 1 THEN IF(IX1 .LT. 1 ) GO TO 10073 GO TO 10071 10073 CONTINUE IX1=1 C END IF 10071 CONTINUE IX2=XCORD(WHO)+10. C IF IX2 .GT. 100 THEN IF(IX2 .GT. 100 ) GO TO 10076 GO TO 10074 10076 CONTINUE IX2=100 C END IF 10074 CONTINUE IY1=YCORD(WHO)-10. C IF IY1 .LT. 1 THEN IF(IY1 .LT. 1 ) GO TO 10079 GO TO 10077 10079 CONTINUE IY1=1 C END IF 10077 CONTINUE IY2=YCORD(WHO)+10. C IF IY2 .GT. 100 THEN IF(IY2 .GT. 100 ) GO TO 10082 GO TO 10080 10082 CONTINUE IY2=100 C END IF 10080 CONTINUE IBY=0 C FOR IY=IY1 UNTIL IY2 DO IY=IY1 GO TO 10085 10083 IY = IY+(1) 10085 IF(IY.GT.IY2) GO TO 10084 IBY=IBY+1 IBX=1 C FOR IX=IX1 UNTIL IX2 DO IX=IX1 GO TO 10088 10086 IX = IX+(1) 10088 IF(IX.GT.IX2) GO TO 10087 BUFF(IBX,IBY)=UNIV(IX,IY) IBX=IBX+1 C END DO GO TO 10086 10087 CONTINUE C END DO GO TO 10083 10084 CONTINUE IX=IX2-IX1+1 IY=IY2-IY1+1 DO 10 IBY=IY,1,-1 ISC=0 DO 9 IBX=1,IX ISC=ISC+1 ISPOT(ISC)=BUFF(IBX,IBY) C IF (ISPOT(ISC) .GE. 49) .AND. (ISPOT(ISC) .LE. 56) .AND. C CLOAK(ISPOT(ISC)-48) THEN IF((ISPOT(ISC) .GE. 49) .AND. (ISPOT(ISC) .LE. 56) .AND. $ CLOAK(ISPOT(ISC)-48) ) GO TO 10091 GO TO 10089 10091 CONTINUE ISPOT(ISC)=46 C END IF 10089 CONTINUE 9 CONTINUE WRITE(5,10092) (ISPOT(ISC),ISC=1,IX) 10092 FORMAT(20X,22(A1,1X)) 10 CONTINUE WRITE(5,10093) XCORD(WHO),YCORD(WHO) 10093 FORMAT(30X,'CURRENT POSTION IS ',F5.1,',',F5.1) C C QUIT COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'Q' THEN 10069 IF(COMMND .EQ. 'Q') GO TO 10095 GO TO 10094 10095 CONTINUE WRITE(5,10096) SCORE(WHO) 10096 FORMAT('0YOUR CURRENT SCORE IS ',F8.0) WRITE(5,10097) 10097 FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ?') CALL YESNO(DONE) C IF DONE THEN IF(DONE ) GO TO 10100 GO TO 10098 10100 CONTINUE CREW(WHO)=CREW(WHO)-1 C IF CREW(WHO) .EQ. 400 THEN IF(CREW(WHO) .EQ. 400 ) GO TO 10103 GO TO 10101 10103 CONTINUE XSHIP(WHO)=.FALSE. C END IF 10101 CONTINUE C END IF 10098 CONTINUE C C REPORT COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'R' THEN 10094 IF(COMMND .EQ. 'R') GO TO 10105 GO TO 10104 10105 CONTINUE WRITE(5,10106) 10106 FORMAT('0CURRENT STATUS REPORT, CAPTAIN.') WRITE(5,10107) XCORD(WHO),YCORD(WHO) 10107 FORMAT(/20X,'LOCATION X:',F5.1,' Y:',F5.1) WRITE(5,10108) WARP(WHO) 10108 FORMAT(20X,'WARP FACTOR :',F6.2) C IF DIR(WHO) .GT. 90. THEN IF(DIR(WHO) .GT. 90. ) GO TO 10111 GO TO 10109 10111 CONTINUE VALUE=(450.-DIR(WHO))/30. GO TO 10110 C ELSE 10109 CONTINUE VALUE=(90.-DIR(WHO))/30. C END IF 10110 CONTINUE WRITE(5,10112) VALUE 10112 FORMAT(20X,'HEADING :',F5.2) WRITE(5,10113) HYPER(WHO) 10113 FORMAT(20X,'HYPER SET :',I1) WRITE(5,10114) ENERGY(WHO) 10114 FORMAT(/20X,'ENERGY :',F7.1) WRITE(5,10115) SHIELD(WHO) 10115 FORMAT(20X,'DEFLECTORS :',F7.1) WRITE(5,10116) TORPS(WHO) 10116 FORMAT(20X,'TORPEDOES :',I3) WRITE(5,10117) CREW(WHO) 10117 FORMAT(20X,'CREW SIZE :',I3) WRITE(5,10118) SCORE(WHO) 10118 FORMAT(/20X,'RATING :',F8.0) C C TORPEDO COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'T' THEN 10104 IF(COMMND .EQ. 'T') GO TO 10120 GO TO 10119 10120 CONTINUE C IF LAUNCH(WHO) .LT. 0. THEN IF(LAUNCH(WHO) .LT. 0. ) GO TO 10123 GO TO 10121 10123 CONTINUE C IF TORPS(WHO) .GT. 0 THEN IF(TORPS(WHO) .GT. 0 ) GO TO 10126 GO TO 10124 10126 CONTINUE WRITE(5,10127) 10127 FORMAT('0PHOTON TORPEDO READY, COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10130 GO TO 10128 10130 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10133 GO TO 10131 10133 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10132 C ELSE 10131 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10132 CONTINUE GO TO 10129 C ELSE 10128 CONTINUE VALUE=DIR(WHO) C END IF 10129 CONTINUE LAUNCH(WHO)=VALUE TORPS(WHO)=TORPS(WHO)-1 C IF TORPS(WHO) .EQ. 0 THEN IF(TORPS(WHO) .EQ. 0 ) GO TO 10136 GO TO 10134 10136 CONTINUE WRITE(5,10137) 10137 FORMAT('0TORPEDO ROOM TO BRIDGE.') WRITE(5,10138) 10138 FORMAT(20X,'THIS IS OUR LAST TORPEDO SIR.') C END IF 10134 CONTINUE WRITE(5,10139) VALUE 10139 FORMAT('0TORPEDO LAUNCHED, HEADING ',F7.2,' DEGREE $S.') GO TO 10125 C ELSE 10124 CONTINUE WRITE(5,10140) 10140 FORMAT('0SO SORRY CAPTAIN, BUT WE ARE OUT OF TORPE $DOES') C END IF 10125 CONTINUE GO TO 10122 C ELSE 10121 CONTINUE WRITE(5,10141) 10141 FORMAT('0TORPEDO TUBES ARE NOT READY YET CAPTAIN !') C END IF 10122 CONTINUE C C PHASER COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'P' THEN 10119 IF(COMMND .EQ. 'P') GO TO 10143 GO TO 10142 10143 CONTINUE C IF PHA(WHO) .LT. 0. THEN IF(PHA(WHO) .LT. 0. ) GO TO 10146 GO TO 10144 10146 CONTINUE WRITE(5,10147) 10147 FORMAT('0PHASER CONTROL READY. COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10150 GO TO 10148 10150 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10153 GO TO 10151 10153 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10152 C ELSE 10151 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10152 CONTINUE GO TO 10149 C ELSE 10148 CONTINUE VALUE=DIR(WHO) C END IF 10149 CONTINUE PHA(WHO)=VALUE ENERGY(WHO)=ENERGY(WHO)-50. WRITE(5,10154) 10154 FORMAT('0PHASERS FIRED CAPTAIN') GO TO 10145 C ELSE 10144 CONTINUE WRITE(5,10155) 10155 FORMAT('0PHASER CONTROL TO BRIDGE, PHASERS ARE NOT REA $DY YET.') C END IF 10145 CONTINUE C C LONG RANGE SCAN COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'L' THEN 10142 IF(COMMND .EQ. 'L') GO TO 10157 GO TO 10156 10157 CONTINUE WRITE(5,10158) 10158 FORMAT('0SPOCK HERE CAPTAIN.') WRITE(5,10159) 10159 FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ?') CALL GETINT(II,OK,1,8) C IF OK THEN IF(OK ) GO TO 10162 GO TO 10160 10162 CONTINUE IX=XCORD(II)/10. IY=YCORD(II)/10. WRITE(5,10163) IX,IY 10163 FORMAT(' SCANNERS REPORT LIFE FORMS IN SECTOR ',I3,',' $I3) X=IX*10 Y=IY*10 D=ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180./3.14159 C IF D .GT. 90. THEN IF(D .GT. 90. ) GO TO 10166 GO TO 10164 10166 CONTINUE D=(450.-D)/30. GO TO 10165 C ELSE 10164 CONTINUE D=(90.-D)/30. C END IF 10165 CONTINUE WRITE(5,10167) 10167 FORMAT('0SPOCK HERE CAPTAIN,') WRITE(5,10168) D 10168 FORMAT(' I APPROXIMATE A COURSE OF ',F13.9,' WOULD TAK $E') WRITE(5,10169) 10169 FORMAT(' US TO THE CENTER OF THAT SECTOR.') C END IF 10160 CONTINUE C C MESSAGE COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'M' THEN 10156 IF(COMMND .EQ. 'M') GO TO 10171 GO TO 10170 10171 CONTINUE WRITE(5,10172) 10172 FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDING?') CALL GETINT(IVAL,OK,1,8) C IF .NOT. OK THEN IF(.NOT. OK ) GO TO 10175 GO TO 10173 10175 CONTINUE IVAL=WHO C END IF 10173 CONTINUE WRITE(5,10176) 10176 FORMAT('0MESSAGE CAPTAIN ?') READ(5,10177,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 10177 FORMAT(60A1) GOTO 13 12 CLOSE(UNIT=5) 13 CONTINUE ENERGY(WHO)=ENERGY(WHO)-10. ENCODE(1,10178,COMMND) WHO 10178 FORMAT(I1) CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) C C CLOAKING COMMAND C GO TO 10029 C WHEN COMMND .EQ. 'F' THEN 10170 IF(COMMND .EQ. 'F') GO TO 10180 GO TO 10179 10180 CONTINUE C IF .NOT. CLOAK(WHO) THEN IF(.NOT. CLOAK(WHO) ) GO TO 10183 GO TO 10181 10183 CONTINUE CLOAK(WHO)=.TRUE. TYPE *,' SPOCK HERE CAPTAIN.' TYPE *,' CLOAKING DEVICE COMING ON NOW!' TYPE *,' WE ARE FADING OUT.....' GO TO 10182 C ELSE 10181 CONTINUE TYPE *,' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!' C END IF 10182 CONTINUE C GO TO 10029 C WHEN COMMND .EQ. 'A' THEN 10179 IF(COMMND .EQ. 'A') GO TO 10185 GO TO 10184 10185 CONTINUE C IF CLOAK(WHO) THEN IF(CLOAK(WHO) ) GO TO 10188 GO TO 10186 10188 CONTINUE CLOAK(WHO)=.FALSE. TYPE *,' SPOCK HERE CAPTAIN.' TYPE *,' CLOAKING DEVICE DEACTIVATED.' TYPE *,' WE ARE NOW VISABLE.....' GO TO 10187 C ELSE 10186 CONTINUE TYPE *,' BUT CAPTAIN WE ARE NOT CLOAKED !' C END IF 10187 CONTINUE C C C EXPLODE ANTI-MATTER DEVICE C GO TO 10029 C WHEN COMMND .EQ. 'X' THEN 10184 IF(COMMND .EQ. 'X') GO TO 10190 GO TO 10189 10190 CONTINUE C IF IPOD(WHO) .EQ. 2 THEN IF(IPOD(WHO) .EQ. 2 ) GO TO 10193 GO TO 10191 10193 CONTINUE IPOD(WHO)=3 WRITE(5,10194) 10194 FORMAT('0ANTI-MATTER DETONATION SIGNALED, SIR!') GO TO 10192 C ELSE 10191 CONTINUE WRITE(5,10195) 10195 FORMAT('0CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER $ ', 'DEVICE.') C END IF 10192 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GO TO 10029 C WHEN COMMND .EQ. 'Z' THEN 10189 IF(COMMND .EQ. 'Z') GO TO 10197 GO TO 10196 10197 CONTINUE C IF IPOD(WHO) .EQ. 0 THEN IF(IPOD(WHO) .EQ. 0 ) GO TO 10200 GO TO 10198 10200 CONTINUE WRITE(5,10201) 10201 FORMAT('0ANTI MATTER DEVICE READY SIR, COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10204 GO TO 10202 10204 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10207 GO TO 10205 10207 CONTINUE DPOD(WHO)=(15.-VALUE)*30. GO TO 10206 C ELSE 10205 CONTINUE DPOD(WHO)=(3.-VALUE)*30. C END IF 10206 CONTINUE GO TO 10203 C ELSE 10202 CONTINUE DPOD(WHO)=DIR(WHO) C END IF 10203 CONTINUE IPOD(WHO)=1 GO TO 10199 C ELSE 10198 CONTINUE WRITE(5,10208) 10208 FORMAT('0SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MATTER $PODS') C END IF 10199 CONTINUE C OTHERWISE GO TO 10029 10196 CONTINUE WRITE(5,10210) 10210 FORMAT('0I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND THAT $.') C END SELECT 10209 CONTINUE 10029 CONTINUE C C WRITE SCORES WRITE(5,10211) (SCORE(K),K=1,8) 10211 FORMAT(' SCORES:',7(F7.0,2X),F7.0) C C * WRITE OUT MESSAGES FROM DRIVER C C FOR I=1 UNTIL 10 DO I=1 GO TO 10214 10212 I = I+(1) 10214 IF(I.GT.10) GO TO 10213 C SELECT USING ISENT(WHO,I) I10218 = ISENT(WHO,I) C WHEN 1 THEN 10217 IF(I10218.EQ.1) GO TO 10220 GO TO 10219 10220 CONTINUE TYPE *,' WE ARE NOW DOCKED CAPTAIN.' GO TO 10218 C WHEN 2 THEN 10219 IF(I10218.EQ.2) GO TO 10222 GO TO 10221 10222 CONTINUE TYPE *,' ** CAPTAIN ! WE HIT A STAR! **' GO TO 10218 C WHEN 3 THEN 10221 IF(I10218.EQ.3) GO TO 10224 GO TO 10223 10224 CONTINUE C FOR IK=1 UNTIL 3 DO IK=1 GO TO 10227 10225 IK = IK+(1) 10227 IF(IK.GT.3) GO TO 10226 CALL CLEAR WRITE(5,10228) 10228 FORMAT(////////////,25X,'*** BOOM ***') C END DO GO TO 10225 10226 CONTINUE WRITE(5,10229) 10229 FORMAT(//' YOU',1H','RE SHIP HAS BEEN DESTROYED') TYPE *,' FORTUNATELY YOU ESCAPED WITH YOUR LIFE.' TYPE *,' UNFORTUNATELY, YOU HAVE BEEN GIVEN A NEW COMMAND.' WRITE(5,10230) 10230 FORMAT(/'$ARE YOU READY TO ACCEPT THIS ASSIGNMENT ?') CALL YESNO(YES) C IF YES THEN IF(YES ) GO TO 10233 GO TO 10231 10233 CONTINUE TYPE *,' GOOD!' GO TO 10232 C ELSE 10231 CONTINUE TYPE *,' TOUGH LUCK, BUT YOU GET IT ANYWAY.' C END IF 10232 CONTINUE XSHIP(WHO)=.TRUE. GO TO 10218 C WHEN 4 THEN 10223 IF(I10218.EQ.4) GO TO 10235 GO TO 10234 10235 CONTINUE WRITE(5,10236) 10236 FORMAT(' CAPTAIN WE HAVE BEEN HIT BY A PHOTON TORPEDO' $) GO TO 10218 C WHEN 5 THEN 10234 IF(I10218.EQ.5) GO TO 10238 GO TO 10237 10238 CONTINUE TYPE *,' * TORPEDO HIT ALIEN SHIP, SIR. *' GO TO 10218 C WHEN 6 THEN 10237 IF(I10218.EQ.6) GO TO 10240 GO TO 10239 10240 CONTINUE TYPE *,' * PHASER HIT ON ALIEN VESSEL, SIR *' GO TO 10218 C WHEN 7 THEN 10239 IF(I10218.EQ.7) GO TO 10242 GO TO 10241 10242 CONTINUE TYPE *,' PHASER HIT ON TORPEDO, SIR' GO TO 10218 C WHEN 8 THEN 10241 IF(I10218.EQ.8) GO TO 10244 GO TO 10243 10244 CONTINUE TYPE *,' PHASER MISSED' GO TO 10218 C WHEN 9 THEN 10243 IF(I10218.EQ.9) GO TO 10246 GO TO 10245 10246 CONTINUE WRITE(5,10247) 10247 FORMAT(' ** SIR! WE HAVE RAMMED AN ALIEN VESSEL **') C GO TO 10218 C WHEN 10 THEN 10245 IF(I10218.EQ.10) GO TO 10249 GO TO 10248 10249 CONTINUE WRITE(5,10250) 10250 FORMAT(' * SIR! WE HAVE COLLIDED WITH AN ALIEN VESSEL $*') C GO TO 10218 C WHEN 11 THEN 10248 IF(I10218.EQ.11) GO TO 10252 GO TO 10251 10252 CONTINUE TYPE *,' PHASER HIT ON STAR SIR' C GO TO 10218 C WHEN 12 THEN 10251 IF(I10218.EQ.12) GO TO 10254 GO TO 10253 10254 CONTINUE TYPE *,' BASE REPORTS THEY ARE BEING ATTACKED SIR.' C GO TO 10218 C WHEN 13 THEN 10253 IF(I10218.EQ.13) GO TO 10256 GO TO 10255 10256 CONTINUE TYPE *,' TORPEDO HIT ON STAR SIR' C GO TO 10218 C WHEN 14 THEN 10255 IF(I10218.EQ.14) GO TO 10258 GO TO 10257 10258 CONTINUE WRITE(5,10259) 10259 FORMAT(' SIR, WE ARE UNDER PHASER ATTACK!') C GO TO 10218 C WHEN 15 THEN 10257 IF(I10218.EQ.15) GO TO 10261 GO TO 10260 10261 CONTINUE TYPE *,' SPOCK HERE CAPTAIN.' TYPE *,' WE ARE BEING DRAWN INTO SOME SORT OF BLACK HOLE,' TYPE *,' IT IS UNLIKE ANYTHING I HAVE EVER ENCOUNTERED.' TYPE *,' FACINATING.' CALL WAIT(2,2,M) C GO TO 10218 C WHEN 16 THEN 10260 IF(I10218.EQ.16) GO TO 10263 GO TO 10262 10263 CONTINUE TYPE *,' SCOTT HERE CAPTAIN' TYPE *,' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' TYPE *,' FAILING ...!' CALL WAIT(2,2,M) C GO TO 10218 C WHEN 17 THEN 10262 IF(I10218.EQ.17) GO TO 10265 GO TO 10264 10265 CONTINUE TYPE *,' CAPTAIN WE ARE GOING INTO HYPERSPACE' C GO TO 10218 C WHEN 18 THEN 10264 IF(I10218.EQ.18) GO TO 10267 GO TO 10266 10267 CONTINUE TYPE *,' HYPERSPACE JUMP BLOCKED SIR .' GO TO 10218 C WHEN 19 THEN 10266 IF(I10218.EQ.19) GO TO 10269 GO TO 10268 10269 CONTINUE TYPE *,' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' GO TO 10218 C WHEN 20 THEN 10268 IF(I10218.EQ.20) GO TO 10271 GO TO 10270 10271 CONTINUE TYPE *,' TORPEDO HIT ON TORPEDO SIR !.' GO TO 10218 C WHEN 21 THEN 10270 IF(I10218.EQ.21) GO TO 10273 GO TO 10272 10273 CONTINUE TYPE *,' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' C GO TO 10218 C WHEN 22 THEN 10272 IF(I10218.EQ.22) GO TO 10275 GO TO 10274 10275 CONTINUE TYPE *,' SULU HERE CAPTAIN,' TYPE *,' THE ALIEN VESSEL HAS BEEN DESTROYED' TYPE *,' ***********************************' C GO TO 10218 C WHEN 23 THEN 10274 IF(I10218.EQ.23) GO TO 10277 GO TO 10276 10277 CONTINUE TYPE *,' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' C GO TO 10218 C WHEN 24 THEN 10276 IF(I10218.EQ.24) GO TO 10279 GO TO 10278 10279 CONTINUE TYPE *,' ANTI-MATTER POD HAS BEEN DESTROYED' C GO TO 10218 C WHEN 25 THEN 10278 IF(I10218.EQ.25) GO TO 10281 GO TO 10280 10281 CONTINUE TYPE *,' PHASER HIT ON ANTI-MATTER POD, SIR!' C GO TO 10218 C WHEN 26 THEN 10280 IF(I10218.EQ.26) GO TO 10283 GO TO 10282 10283 CONTINUE TYPE *,' TORPEDO HIT ON ANTI-MATTER POD, SIR!' C GO TO 10218 C WHEN 27 THEN 10282 IF(I10218.EQ.27) GO TO 10285 GO TO 10284 10285 CONTINUE TYPE *,' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' C GO TO 10218 C WHEN 28 THEN 10284 IF(I10218.EQ.28) GO TO 10287 GO TO 10286 10287 CONTINUE TYPE *,' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' C GO TO 10218 C WHEN 29 THEN 10286 IF(I10218.EQ.29) GO TO 10289 GO TO 10288 10289 CONTINUE TYPE *,' ** ANTI-MATTER POD DETONATED SIR **' C GO TO 10218 C WHEN 30 THEN 10288 IF(I10218.EQ.30) GO TO 10291 GO TO 10290 10291 CONTINUE WRITE(5,10292) 10292 FORMAT(' SIR, WE ARE CAUGHT IN AN ANTI-MATTER EXPLOSIO $N!') CALL WAIT(2,2,M) C GO TO 10218 C WHEN 31 THEN 10290 IF(I10218.EQ.31) GO TO 10294 GO TO 10293 10294 CONTINUE WRITE(5,10295) 10295 FORMAT(' IIEEEEEE!') C C OTHERWISE GO TO 10218 10293 CONTINUE CONTINUE C END SELECT 10296 CONTINUE 10218 CONTINUE ISENT(WHO,I)=0 C END DO GO TO 10212 10213 CONTINUE C IF MESSAG(WHO*60-59) .NE. ' ' THEN IF(MESSAG(WHO*60-59) .NE. ' ' ) GO TO 10299 GO TO 10297 10299 CONTINUE WRITE(5,10300) 10300 FORMAT('0CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADI $O') WRITE(5,10301) MESSAG(WHO*60-59) 10301 FORMAT(' FREQUENCY ',A1,' ***') WRITE(5,10302) (MESSAG(I),I=WHO*60-58,WHO*60) 10302 FORMAT(10X,60A1) CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) CALL WAIT(2,2,M) C END IF 10297 CONTINUE C IF (ENERGY(WHO) .LT. 900.) .AND. WARN THEN IF((ENERGY(WHO) .LT. 900.) .AND. WARN ) GO TO 10305 GO TO 10303 10305 CONTINUE TYPE *,' SCOTT HERE CAPTAIN,' TYPE *,' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' WARN=.FALSE. GO TO 10304 C ELSE 10303 CONTINUE WARN=.TRUE. C END IF 10304 CONTINUE C END DO GO TO 10021 10022 CONTINUE C C DECREMENT PLAYER COUNT THRU=THRU-1 STOP END SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) C LOGICAL*1 EXIST,OK REAL VARI,LOW,HIGH BYTE INPUT(15),LEFTED(15) INTEGER NCHRS OK=.FALSE. C UNTIL OK C DO GO TO 10002 10000 IF(OK ) $GO TO 10001 10002 CONTINUE C FOR I=1 UNTIL 15 C DO I=1 GO TO 10005 10003 I = I+(1) 10005 IF(I.GT.15 ) $ GO TO 10004 LEFTED(I)=' ' C END DO GO TO 10003 10004 CONTINUE TYPE 99 99 FORMAT(1H$,'>') READ(5,100,END=800) NCHRS,(INPUT(I),I=1,15) 100 FORMAT(Q,15A1) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE C SELECT C WHEN NCHRS .EQ. 0 C THEN 10008 IF(NCHRS .EQ. 0 $ ) GO TO 10011 GO TO 10010 10011 CONTINUE OK=.TRUE. EXIST=.FALSE. GO TO 10009 C WHEN NCHRS .LE. 15 THEN 10010 IF(NCHRS .LE. 15) GO TO 10013 GO TO 10012 10013 CONTINUE C * LEFT ADJUST INPUT CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) DECODE(15,10014,LEFTED,ERR=200) VARI 10014 FORMAT(G15.0) C IF VARI .GE. LOW .AND. VARI .LE. HIGH C THEN IF(VARI .GE. LOW .AND. VARI .LE. HIGH $ ) GO TO 10017 GO TO 10015 10017 CONTINUE OK=.TRUE. EXIST=.TRUE. GO TO 10016 C ELSE 10015 CONTINUE WRITE(5,10018) 10018 FORMAT('0SORRY CAPTAIN, BUT YOUR COMMAND',1H','S PARAM $ETER') WRITE(5,150) LOW,HIGH 150 FORMAT(1H ,'MUST BE BETWEEN ',F15.4,' AND ',F15.4) C END IF 10016 CONTINUE GO TO 300 200 TYPE *,'WOULD YOU PLEASE REPEAT THAT SIR ?' 300 CONTINUE C OTHERWISE GO TO 10009 10012 CONTINUE WRITE(5,10020) 10020 FORMAT(' RUN THAT BY ME AGAIN !') C END SELECT 10019 CONTINUE 10009 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) INTEGER NUM,LOW,HIGH LOGICAL*1 OK,FLAG OK=.FALSE. C UNTIL OK DO GO TO 10002 10000 IF(OK ) GO TO 10001 10002 CONTINUE READ(5,10003,END=800,ERR=200) NCHRS,NUM 10003 FORMAT(Q,I5) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE C IF NCHRS .EQ. 0 THEN IF(NCHRS .EQ. 0 ) GO TO 10006 GO TO 10004 10006 CONTINUE FLAG=.FALSE. OK=.TRUE. GO TO 10005 C ELSE 10004 CONTINUE C IF (NUM .GE. LOW) .AND. (NUM .LE. HIGH) THEN IF((NUM .GE. LOW) .AND. (NUM .LE. HIGH) ) GO TO 10009 GO TO 10007 10009 CONTINUE OK=.TRUE. FLAG=.TRUE. GO TO 10008 C ELSE 10007 CONTINUE WRITE(5,10010) 10010 FORMAT('0WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS $') WRITE(5,10011) LOW,HIGH 10011 FORMAT(' BETWEEN ',I5,' AND ',I5) WRITE(5,10012) 10012 FORMAT(1H$,' TRY AGAIN :') C END IF 10008 CONTINUE GOTO 300 200 WRITE(5,100) 100 FORMAT(1H$,' TRY AGAIN BOZO :') 300 CONTINUE C END IF 10005 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END SUBROUTINE YESNO(FLAG) LOGICAL*1 FLAG,OK BYTE YES(4),NO(4) BYTE ANSWER(4) DATA YES/'Y','E','S',' '/ DATA NO/'N','O',' ',' '/ OK=.FALSE. C UNTIL OK DO GO TO 10002 10000 IF(OK ) GO TO 10001 10002 CONTINUE READ(5,10003,END=800) NCHRS, (ANSWER(I),I=1,4) 10003 FORMAT(Q,4A1) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE C IF (NCHRS .GT. 4) .OR. (NCHRS .LT. 1) THEN IF((NCHRS .GT. 4) .OR. (NCHRS .LT. 1) ) GO TO 10006 GO TO 10004 10006 CONTINUE NCHRS=4 C END IF 10004 CONTINUE C * CHECK FOR YES I=KOMSTR(YES,1,NCHRS,ANSWER,1) C IF I .EQ. 0 THEN IF(I .EQ. 0 ) GO TO 10009 GO TO 10007 10009 CONTINUE FLAG=.TRUE. OK=.TRUE. GO TO 10008 C ELSE 10007 CONTINUE C * CHECK FOR A NO I=KOMSTR(NO,1,NCHRS,ANSWER,1) C IF I .EQ. 0 THEN IF(I .EQ. 0 ) GO TO 10012 GO TO 10010 10012 CONTINUE FLAG=.FALSE. OK=.TRUE. GO TO 10011 C ELSE 10010 CONTINUE C * INCORRECT RESPONSE WRITE(5,10013) 10013 FORMAT('0** PLEASE ANSWER "YES" OR "NO" **') WRITE(5,10014) 10014 FORMAT('$ ANSWER ? ') C END IF 10011 CONTINUE C END IF 10008 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END