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 LOGICAL*1 OK,DONE,YES,WARN BYTE BLANK(80),COMMND DIMENSION IPRM(2),JPRM(2) COMMON/INBUF/INBUF(50),IOST(2) EQUIVALENCE (INBUF,COMMND) BYTE IBUF(1000) BYTE OLDBUF(21,17),NEWBUF(21,17),OLDREP(11,7),NEWREP(11,7) BYTE OLDSCR(7,8),NEWSCR(7,8) BYTE RESET INTEGER WHO BYTE ESCPOS(2) C C*********************************************************************** C * C THE FOLLOWING PARAMETERS ARE FOR CURSOR ADDRESSING. THEY ARE * C SPECIFICALLY FOR A BEEHIVE 100 TERMINAL AND MAY HAVE TO BE * C MODIFIED FOR DIFFERENT TERMINALS. ESCPOS CONTAINS THE ESCAPE * C SEQUENCE FOR CURSOR ADDRESSING AND IOFSET IS THE OFFSET TO * C CONVERT THE LINE/COLUMN NUMBER TO THE APPROPRIATE OCTAL CODE. * C * DATA ESCPOS/"33,'F'/ DATA IOFSET/"37/ C * C*********************************************************************** C DATA IAST/0/ DATA RESET/1/ 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 DIR(WHO)=90. WARP(WHO)=0. 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 SET UP TERMINAL INPUT/OUTPUT PARAMETERS CALL RDAST(IAST) CALL GETADR(IPRM,IBUF) CALL GETADR(JPRM,INBUF) JPRM(2)=50 C C UNTIL DONE DO GO TO 10023 10021 IF(DONE ) GO TO 10022 10023 CONTINUE C C CHECK FOR INPUTS C C IF IAST.NE.0 THEN IF(IAST.NE.0 ) GO TO 10026 GO TO 10024 10026 CONTINUE CALL WTQIO("1020,5,1,,IOST,JPRM) C IF IOST(1).EQ.-10 THEN IF( IOST(1).EQ.-10 ) GO TO 10029 GO TO 10027 10029 CONTINUE CLOSE (UNIT=5) COMMND=0 GO TO 10028 C ELSE 10027 CONTINUE C IF IOST(2).EQ.0 THEN IF( IOST(2).EQ.0 ) GO TO 10032 GO TO 10030 10032 CONTINUE COMMND=' ' C END IF 10030 CONTINUE C END IF 10028 CONTINUE IAST=IAST-1 C END IF 10024 CONTINUE C C C GENERATE NEW DISPLAY IX1=XCORD(WHO)-10. C IF IX1 .LT. 1 THEN IF(IX1 .LT. 1 ) GO TO 10035 GO TO 10033 10035 CONTINUE IX1=1 C END IF 10033 CONTINUE IX2=XCORD(WHO)+10. C IF IX2 .GT. 100 THEN IF(IX2 .GT. 100 ) GO TO 10038 GO TO 10036 10038 CONTINUE IX2=100 C END IF 10036 CONTINUE IY1=YCORD(WHO)-8. C IF IY1 .LT. 1 THEN IF(IY1 .LT. 1 ) GO TO 10041 GO TO 10039 10041 CONTINUE IY1=1 C END IF 10039 CONTINUE IY2=YCORD(WHO)+8. C IF IY2 .GT. 100 THEN IF(IY2 .GT. 100 ) GO TO 10044 GO TO 10042 10044 CONTINUE IY2=100 C END IF 10042 CONTINUE C FOR IX=1 UNTIL 21 DO IX=1 GO TO 10047 10045 IX = IX+(1) 10047 IF(IX.GT.21) GO TO 10046 C FOR IY=1 UNTIL 17 DO IY=1 GO TO 10050 10048 IY = IY+(1) 10050 IF(IY.GT.17) GO TO 10049 NEWBUF(IX,IY)=' ' C END DO GO TO 10048 10049 CONTINUE C END DO GO TO 10045 10046 CONTINUE IBY=0 DO 10 IY=IY2,IY1,-1 IBY=IBY+1 IBX=1 C FOR IX=IX1 UNTIL IX2 DO IX=IX1 GO TO 10053 10051 IX = IX+(1) 10053 IF(IX.GT.IX2) GO TO 10052 NEWBUF(IBX,IBY)=UNIV(IX,IY) K=NEWBUF(IBX,IBY) C IF (K.GE.49).AND.(K.LE.56).AND.CLOAK(K-48) THEN IF((K.GE.49).AND.(K.LE.56).AND.CLOAK(K-48) ) GO TO 10056 GO TO 10054 10056 CONTINUE NEWBUF(IBX,IBY)=46 C END IF 10054 CONTINUE IBX=IBX+1 C END DO GO TO 10051 10052 CONTINUE 10 CONTINUE IBX=IBX-1 C C GENERATE REPORT C C IF DIR(WHO).GT.90. THEN IF( DIR(WHO).GT.90. ) GO TO 10059 GO TO 10057 10059 CONTINUE VALUE=(450.-DIR(WHO))/30. GO TO 10058 C ELSE 10057 CONTINUE VALUE=(90.-DIR(WHO))/30. C END IF 10058 CONTINUE C IF VALUE.EQ.0. THEN IF(VALUE.EQ.0. ) GO TO 10062 GO TO 10060 10062 CONTINUE VALUE=0. C END IF 10060 CONTINUE ENCODE(77,10063,NEWREP) VALUE,WARP(WHO),ENERGY(WHO), $ SHIELD(WHO),HYPER(WHO),TORPS(WHO),CREW(WHO) 10063 FORMAT(F5.2,6X, F4.2,7X, G11.5, G11.5, I1,10X, I2,9X, I3,8X) C C GENERATE SCORES ENCODE(56,10064,NEWSCR) SCORE 10064 FORMAT(8F7.0) C C C C DISPLAY TITLES, LABELS,ETC. C IF RESET.NE.0 THEN IF( RESET.NE.0 ) GO TO 10067 GO TO 10065 10067 CONTINUE CALL CLEAR CALL WRITE(1,6,'COORDINATES') CALL WRITE(4,3,'HEADING :') CALL WRITE(5,6,'WARP :') CALL WRITE(6,4,'ENERGY :') CALL WRITE(7,3,'SHIELDS :') CALL WRITE(8,1,'HYPER SET :') CALL WRITE(9,1,'TORPEDOES :') CALL WRITE(10,1,'CREW SIZE :') CALL WRITE(5,67,'SHIP SCORES') C FOR I=1 UNTIL 8 DO I=1 GO TO 10070 10068 I = I+(1) 10070 IF(I.GT.8) GO TO 10069 CALL WRITE(I+5,69,I+"60) C END DO GO TO 10068 10069 CONTINUE C FOR IY=1 UNTIL IBY DO IY=1 GO TO 10073 10071 IY = IY+(1) 10073 IF(IY.GT.IBY ) GO TO 10072 ENCODE(42,10074,IBUF) (NEWBUF(IX,IY),IX=1,IBX) 10074 FORMAT(21(A1,1X)) CALL WRITE(IY,24,IBUF,41) C END DO GO TO 10071 10072 CONTINUE C FOR IY=1 UNTIL 7 DO IY=1 GO TO 10077 10075 IY = IY+(1) 10077 IF(IY.GT.7 ) GO TO 10076 ENCODE(11,10078,IBUF) (NEWREP(IX,IY),IX=1,11) 10078 FORMAT(11A1) CALL WRITE(IY+3,12,IBUF,11) C END DO GO TO 10075 10076 CONTINUE C FOR IY=1 UNTIL 8 DO IY=1 GO TO 10081 10079 IY = IY+(1) 10081 IF(IY.GT.8 ) GO TO 10080 ENCODE(7,10082,IBUF) (NEWSCR(IX,IY),IX=1,7) 10082 FORMAT(7A1) CALL WRITE(IY+5,72,IBUF,7) C END DO GO TO 10079 10080 CONTINUE C C SET OLD = NEW C C FOR IX=1 UNTIL 21 DO IX=1 GO TO 10085 10083 IX = IX+(1) 10085 IF(IX.GT.21) GO TO 10084 C FOR IY=1 UNTIL 17 DO IY=1 GO TO 10088 10086 IY = IY+(1) 10088 IF(IY.GT.17) GO TO 10087 OLDBUF(IX,IY)=NEWBUF(IX,IY) C END DO GO TO 10086 10087 CONTINUE C END DO GO TO 10083 10084 CONTINUE C FOR IX=1 UNTIL 11 DO IX=1 GO TO 10091 10089 IX = IX+(1) 10091 IF(IX.GT.11) GO TO 10090 C FOR IY=1 UNTIL 7 DO IY=1 GO TO 10094 10092 IY = IY+(1) 10094 IF(IY.GT.7) GO TO 10093 OLDREP(IX,IY)=NEWREP(IX,IY) C END DO GO TO 10092 10093 CONTINUE C END DO GO TO 10089 10090 CONTINUE C FOR IX=1 UNTIL 7 DO IX=1 GO TO 10097 10095 IX = IX+(1) 10097 IF(IX.GT.7) GO TO 10096 C FOR IY=1 UNTIL 8 DO IY=1 GO TO 10100 10098 IY = IY+(1) 10100 IF(IY.GT.8) GO TO 10099 OLDSCR(IX,IY)=NEWSCR(IX,IY) C END DO GO TO 10098 10099 CONTINUE C END DO GO TO 10095 10096 CONTINUE RESET=0 GO TO 10066 C ELSE 10065 CONTINUE C C COMPARE DISPLAYS KBUF=1 C FOR IY=1 UNTIL 17 DO IY=1 GO TO 10103 10101 IY = IY+(1) 10103 IF(IY.GT.17) GO TO 10102 C FOR IX=1 UNTIL 21 DO IX=1 GO TO 10106 10104 IX = IX+(1) 10106 IF(IX.GT.21) GO TO 10105 C IF NEWBUF(IX,IY).NE.OLDBUF(IX,IY) THEN IF( NEWBUF(IX,IY).NE.OLDBUF(IX,IY) ) GO TO 10109 GO TO 10107 10109 CONTINUE KX=2*(IX-1)+24+IOFSET KY=IY+IOFSET IBUF(KBUF)=ESCPOS(1) IBUF(KBUF+1)=ESCPOS(2) IBUF(KBUF+2)=KY IBUF(KBUF+3)=KX IBUF(KBUF+4)=NEWBUF(IX,IY) KBUF=KBUF+5 OLDBUF(IX,IY)=NEWBUF(IX,IY) C END IF 10107 CONTINUE C END DO GO TO 10104 10105 CONTINUE C END DO GO TO 10101 10102 CONTINUE C C COMPARE REPORTS C FOR IY=1 UNTIL 7 DO IY=1 GO TO 10112 10110 IY = IY+(1) 10112 IF(IY.GT.7 ) GO TO 10111 C FOR IX=1 UNTIL 11 DO IX=1 GO TO 10115 10113 IX = IX+(1) 10115 IF(IX.GT.11 ) GO TO 10114 C IF OLDREP(IX,IY).NE.NEWREP(IX,IY) THEN IF( OLDREP(IX,IY).NE.NEWREP(IX,IY) ) GO TO 10118 GO TO 10116 10118 CONTINUE KX=IX+11+IOFSET KY=IY+3+IOFSET IBUF(KBUF)=ESCPOS(1) IBUF(KBUF+1)=ESCPOS(2) IBUF(KBUF+2)=KY IBUF(KBUF+3)=KX IBUF(KBUF+4)=NEWREP(IX,IY) KBUF=KBUF+5 OLDREP(IX,IY)=NEWREP(IX,IY) C END IF 10116 CONTINUE C END DO GO TO 10113 10114 CONTINUE C END DO GO TO 10110 10111 CONTINUE C C COMPARE SCORES C FOR IY=1 UNTIL 8 DO IY=1 GO TO 10121 10119 IY = IY+(1) 10121 IF(IY.GT.8 ) GO TO 10120 C FOR IX=1 UNTIL 7 DO IX=1 GO TO 10124 10122 IX = IX+(1) 10124 IF(IX.GT.7 ) GO TO 10123 C IF OLDSCR(IX,IY).NE.NEWSCR(IX,IY) THEN IF( OLDSCR(IX,IY).NE.NEWSCR(IX,IY) ) GO TO 10127 GO TO 10125 10127 CONTINUE KX=IX+71+IOFSET KY=IY+5+IOFSET IBUF(KBUF)=ESCPOS(1) IBUF(KBUF+1)=ESCPOS(2) IBUF(KBUF+2)=KY IBUF(KBUF+3)=KX IBUF(KBUF+4)=NEWSCR(IX,IY) KBUF=KBUF+5 OLDSCR(IX,IY)=NEWSCR(IX,IY) C END IF 10125 CONTINUE C END DO GO TO 10122 10123 CONTINUE C END DO GO TO 10119 10120 CONTINUE C C UPDATE DISPLAY IF CHANGED C KBUF=KBUF-1 C IF KBUF.GT.1 THEN IF( KBUF.GT.1 ) GO TO 10130 GO TO 10128 10130 CONTINUE IPRM(2)=KBUF CALL WTQIO("410,5,1,,,IPRM) C END IF 10128 CONTINUE C END IF 10066 CONTINUE C C UPDATE COORDINATES C ENCODE(16,10131,IBUF) XCORD(WHO),YCORD(WHO) 10131 FORMAT('X:',F5.1,' Y:',F5.1) CALL WRITE(2,4,IBUF,16) C IF COMMND.NE.0 THEN IF( COMMND.NE.0 ) GO TO 10134 GO TO 10132 10134 CONTINUE C C CLEAR THE BOTTOM OF THE SCREEN CALL CLEARS(17,1) C C SELECT C C WARP FACTOR COMMAND C C WHEN COMMND .EQ. 'W' THEN 10137 IF(COMMND .EQ. 'W') GO TO 10140 GO TO 10139 10140 CONTINUE C IF IOST(2).EQ.1 THEN IF( IOST(2).EQ.1 ) GO TO 10143 GO TO 10141 10143 CONTINUE WRITE(5,10144) 10144 FORMAT('$WARP FACTOR, SIR ?') CALL GETREL(WARP(WHO),OK,0.,8.) GO TO 10142 C ELSE 10141 CONTINUE CALL GETRLL(WARP(WHO),OK,0.,8.) C END IF 10142 CONTINUE C IF .NOT. OK THEN IF(.NOT. OK ) GO TO 10147 GO TO 10145 10147 CONTINUE WARP(WHO)=0. C END IF 10145 CONTINUE C C COURSE COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'C' THEN 10139 IF(COMMND .EQ. 'C') GO TO 10149 GO TO 10148 10149 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10152 GO TO 10150 10152 CONTINUE WRITE(5,10153) 10153 FORMAT('$COURSE, SIR ?') CALL GETREL(VALUE,OK,0.,12.) GO TO 10151 C ELSE 10150 CONTINUE CALL GETRLL(VALUE,OK,0.,12.) C END IF 10151 CONTINUE C IF OK THEN IF(OK ) GO TO 10156 GO TO 10154 10156 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10159 GO TO 10157 10159 CONTINUE DIR(WHO)=(15.-VALUE)*30. GO TO 10158 C ELSE 10157 CONTINUE DIR(WHO)=(3.-VALUE)*30. C END IF 10158 CONTINUE C END IF 10154 CONTINUE C C HYPERSPACE COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'H' THEN 10148 IF(COMMND .EQ. 'H') GO TO 10161 GO TO 10160 10161 CONTINUE C IF IOST(2).EQ.1 THEN IF( IOST(2).EQ.1 ) GO TO 10164 GO TO 10162 10164 CONTINUE WRITE(5,10165) 10165 FORMAT('$NEW HYPERSPACE JUMP SETTING ? ') CALL GETINT(II,OK,1,6) GO TO 10163 C ELSE 10162 CONTINUE CALL GETINL(II,OK,1,6) C END IF 10163 CONTINUE C IF OK THEN IF(OK ) GO TO 10168 GO TO 10166 10168 CONTINUE HYPER(WHO)=II C END IF 10166 CONTINUE C C SHIELD COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'S' THEN 10160 IF(COMMND .EQ. 'S') GO TO 10170 GO TO 10169 10170 CONTINUE C IF IOST(2).EQ.1 THEN IF( IOST(2).EQ.1 ) GO TO 10173 GO TO 10171 10173 CONTINUE WRITE(5,10174) 10174 FORMAT('$ENGINEERING TO BRIDGE, HOW MUCH ENERGY SI $R ? ') CALL GETREL(VALUE,OK,-1.E36,1.E36) GO TO 10172 C ELSE 10171 CONTINUE CALL GETRLL(VALUE,OK,-1.E36,1.E36) C END IF 10172 CONTINUE C IF OK THEN IF(OK ) GO TO 10177 GO TO 10175 10177 CONTINUE C IF ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VAL C UE .GE. 0. THEN IF(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VAL $UE .GE. 0. ) GO TO 10180 GO TO 10178 10180 CONTINUE ENERGY(WHO)=ENERGY(WHO)-VALUE SHIELD(WHO)=SHIELD(WHO)+VALUE GO TO 10179 C ELSE 10178 CONTINUE WRITE(5,10181) 10181 FORMAT(' I AM SORRY CAPTAIN, BUT THAT IS IMPOS $SIBLE.') C END IF 10179 CONTINUE C END IF 10175 CONTINUE C C HELP COMMAND C GO TO 10138 C WHEN COMMND .EQ. ' ' THEN 10169 IF(COMMND .EQ. ' ') GO TO 10183 GO TO 10182 10183 CONTINUE WRITE(5,10184) 10184 FORMAT(' A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAG $E',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 RESET DISPLAY',T51, $ 'Z LAUNCH ANTI-MATTER'/' L LOCATE SHIP',T30, $ 'S SHIELD CHANGE',T51,' DISPLAY HELP MESSAGE') C C QUIT COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'Q' THEN 10182 IF(COMMND .EQ. 'Q') GO TO 10186 GO TO 10185 10186 CONTINUE C IF IOST(2).EQ.1 THEN IF( IOST(2).EQ.1 ) GO TO 10189 GO TO 10187 10189 CONTINUE WRITE(5,10190) SCORE(WHO) 10190 FORMAT(' YOUR CURRENT SCORE IS ',F8.0) WRITE(5,10191) 10191 FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ? ') CALL YESNO(DONE) GO TO 10188 C ELSE 10187 CONTINUE CALL YESNOL(DONE) C END IF 10188 CONTINUE C IF DONE THEN IF(DONE ) GO TO 10194 GO TO 10192 10194 CONTINUE CREW(WHO)=CREW(WHO)-1 C IF CREW(WHO) .EQ. 400 THEN IF(CREW(WHO) .EQ. 400 ) GO TO 10197 GO TO 10195 10197 CONTINUE XSHIP(WHO)=.FALSE. C END IF 10195 CONTINUE C END IF 10192 CONTINUE C C RESET COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'R' THEN 10185 IF(COMMND .EQ. 'R') GO TO 10199 GO TO 10198 10199 CONTINUE RESET=1 C C TORPEDO COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'T' THEN 10198 IF(COMMND .EQ. 'T') GO TO 10201 GO TO 10200 10201 CONTINUE C IF LAUNCH(WHO) .LT. 0. THEN IF(LAUNCH(WHO) .LT. 0. ) GO TO 10204 GO TO 10202 10204 CONTINUE C IF TORPS(WHO) .GT. 0 THEN IF(TORPS(WHO) .GT. 0 ) GO TO 10207 GO TO 10205 10207 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10210 GO TO 10208 10210 CONTINUE WRITE(5,10211) 10211 FORMAT('$PHOTON TORPEDO READY, COURSE ?') CALL GETREL(VALUE,OK,0.,12.) GO TO 10209 C ELSE 10208 CONTINUE CALL GETRLL(VALUE,OK,0.,12.) C END IF 10209 CONTINUE C IF OK THEN IF(OK ) GO TO 10214 GO TO 10212 10214 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10217 GO TO 10215 10217 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10216 C ELSE 10215 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10216 CONTINUE GO TO 10213 C ELSE 10212 CONTINUE VALUE=DIR(WHO) C END IF 10213 CONTINUE LAUNCH(WHO)=VALUE TORPS(WHO)=TORPS(WHO)-1 C IF TORPS(WHO) .EQ. 0 THEN IF(TORPS(WHO) .EQ. 0 ) GO TO 10220 GO TO 10218 10220 CONTINUE WRITE(5,10221) 10221 FORMAT('$TORPEDO ROOM TO BRIDGE. LAST TOR $PEDO, SIR.') C END IF 10218 CONTINUE WRITE(5,10222) VALUE 10222 FORMAT(' TORPEDO LAUNCHED, HEADING ',F7.2,' DE $GREES.') GO TO 10206 C ELSE 10205 CONTINUE WRITE(5,10223) 10223 FORMAT(' SO SORRY CAPTAIN, BUT WE ARE OUT OF T $ORPEDOES') C END IF 10206 CONTINUE GO TO 10203 C ELSE 10202 CONTINUE WRITE(5,10224) 10224 FORMAT(' TORPEDO TUBES ARE NOT READY YET CAPTAIN ! $') C END IF 10203 CONTINUE C C PHASER COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'P' THEN 10200 IF(COMMND .EQ. 'P') GO TO 10226 GO TO 10225 10226 CONTINUE C IF PHA(WHO) .LT. 0. THEN IF(PHA(WHO) .LT. 0. ) GO TO 10229 GO TO 10227 10229 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10232 GO TO 10230 10232 CONTINUE WRITE(5,10233) 10233 FORMAT('$PHASER CONTROL READY. COURSE ?') CALL GETREL(VALUE,OK,0.,12.) GO TO 10231 C ELSE 10230 CONTINUE CALL GETRLL(VALUE,OK,0.,12.) C END IF 10231 CONTINUE C IF OK THEN IF(OK ) GO TO 10236 GO TO 10234 10236 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10239 GO TO 10237 10239 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10238 C ELSE 10237 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10238 CONTINUE GO TO 10235 C ELSE 10234 CONTINUE VALUE=DIR(WHO) C END IF 10235 CONTINUE PHA(WHO)=VALUE ENERGY(WHO)=ENERGY(WHO)-50. WRITE(5,10240) 10240 FORMAT(' PHASERS FIRED CAPTAIN') GO TO 10228 C ELSE 10227 CONTINUE WRITE(5,10241) 10241 FORMAT(' PHASER CONTROL TO BRIDGE, PHASERS ARE NOT $ READY YET.') C END IF 10228 CONTINUE C C LONG RANGE SCAN COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'L' THEN 10225 IF(COMMND .EQ. 'L') GO TO 10243 GO TO 10242 10243 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10246 GO TO 10244 10246 CONTINUE WRITE(5,10247) 10247 FORMAT(' SPOCK HERE CAPTAIN.') WRITE(5,10248) 10248 FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ? $ ') CALL GETINT(II,OK,1,8) GO TO 10245 C ELSE 10244 CONTINUE CALL GETINL(II,OK,1,8) C END IF 10245 CONTINUE C IF OK THEN IF(OK ) GO TO 10251 GO TO 10249 10251 CONTINUE IX=XCORD(II)/10. IY=YCORD(II)/10. WRITE(5,10252) IX,IY 10252 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 10255 GO TO 10253 10255 CONTINUE D=(450.-D)/30. GO TO 10254 C ELSE 10253 CONTINUE D=(90.-D)/30. C END IF 10254 CONTINUE WRITE(5,10256) D 10256 FORMAT(' I APPROXIMATE A COURSE OF ',F13.9,' SHOUL $D TAKE') WRITE(5,10257) 10257 FORMAT(' US TO THE CENTER OF THAT SECTOR.') C END IF 10249 CONTINUE C C MESSAGE COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'M' THEN 10242 IF(COMMND .EQ. 'M') GO TO 10259 GO TO 10258 10259 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10262 GO TO 10260 10262 CONTINUE WRITE(5,10263) 10263 FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDIN $G ? ') CALL GETINT(IVAL,OK,1,8) GO TO 10261 C ELSE 10260 CONTINUE CALL GETINL(IVAL,OK,1,8) C END IF 10261 CONTINUE C IF .NOT. OK THEN IF(.NOT. OK ) GO TO 10266 GO TO 10264 10266 CONTINUE IVAL=WHO C END IF 10264 CONTINUE WRITE(5,10267) 10267 FORMAT('$MESSAGE CAPTAIN ? ') READ(5,10268,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 10268 FORMAT(60A1) GOTO 13 12 CLOSE(UNIT=5) 13 CONTINUE ENERGY(WHO)=ENERGY(WHO)-10. ENCODE(1,10269,COMMND) WHO 10269 FORMAT(I1) CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) C C CLOAKING COMMAND C GO TO 10138 C WHEN COMMND .EQ. 'F' THEN 10258 IF(COMMND .EQ. 'F') GO TO 10271 GO TO 10270 10271 CONTINUE C IF .NOT. CLOAK(WHO) THEN IF(.NOT. CLOAK(WHO) ) GO TO 10274 GO TO 10272 10274 CONTINUE CLOAK(WHO)=.TRUE. WRITE(5,10275) 10275 FORMAT(' SPOCK HERE CAPTAIN. CLOAKING DEVICE COMI $NG ON NOW!') WRITE(5,10276) 10276 FORMAT(' WE ARE FADING OUT.....') GO TO 10273 C ELSE 10272 CONTINUE WRITE(5,10277) 10277 FORMAT(' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!') C END IF 10273 CONTINUE C GO TO 10138 C WHEN COMMND .EQ. 'A' THEN 10270 IF(COMMND .EQ. 'A') GO TO 10279 GO TO 10278 10279 CONTINUE C IF CLOAK(WHO) THEN IF(CLOAK(WHO) ) GO TO 10282 GO TO 10280 10282 CONTINUE CLOAK(WHO)=.FALSE. WRITE(5,10283) 10283 FORMAT(' SPOCK HERE CAPTAIN. CLOAKING DEVICE DEAC $TIVATED.') WRITE(5,10284) 10284 FORMAT(' WE ARE NOW VISABLE.....') GO TO 10281 C ELSE 10280 CONTINUE WRITE(5,10285) 10285 FORMAT(' BUT CAPTAIN WE ARE NOT CLOAKED !') C END IF 10281 CONTINUE C C C EXPLODE ANTI-MATTER DEVICE C GO TO 10138 C WHEN COMMND .EQ. 'X' THEN 10278 IF(COMMND .EQ. 'X') GO TO 10287 GO TO 10286 10287 CONTINUE C IF IPOD(WHO) .EQ. 2 THEN IF(IPOD(WHO) .EQ. 2 ) GO TO 10290 GO TO 10288 10290 CONTINUE IPOD(WHO)=3 WRITE(5,10291) 10291 FORMAT(' ANTI-MATTER DETONATION SIGNALED, SIR!') GO TO 10289 C ELSE 10288 CONTINUE WRITE(5,10292) 10292 FORMAT(' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MA $TTER DEVICE') C END IF 10289 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GO TO 10138 C WHEN COMMND .EQ. 'Z' THEN 10286 IF(COMMND .EQ. 'Z') GO TO 10294 GO TO 10293 10294 CONTINUE C IF IPOD(WHO) .EQ. 0 THEN IF(IPOD(WHO) .EQ. 0 ) GO TO 10297 GO TO 10295 10297 CONTINUE C IF IOST(2).EQ.1 THEN IF(IOST(2).EQ.1 ) GO TO 10300 GO TO 10298 10300 CONTINUE WRITE(5,10301) 10301 FORMAT('$ANTI MATTER DEVICE READY SIR, COURSE $? ') CALL GETREL(VALUE,OK,0.,12.) GO TO 10299 C ELSE 10298 CONTINUE CALL GETRLL(VALUE,OK,0.,12.) C END IF 10299 CONTINUE C IF OK THEN IF(OK ) GO TO 10304 GO TO 10302 10304 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10307 GO TO 10305 10307 CONTINUE DPOD(WHO)=(15.-VALUE)*30. GO TO 10306 C ELSE 10305 CONTINUE DPOD(WHO)=(3.-VALUE)*30. C END IF 10306 CONTINUE GO TO 10303 C ELSE 10302 CONTINUE DPOD(WHO)=DIR(WHO) C END IF 10303 CONTINUE IPOD(WHO)=1 GO TO 10296 C ELSE 10295 CONTINUE WRITE(5,10308) 10308 FORMAT(' SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MAT $TER PODS') C END IF 10296 CONTINUE C OTHERWISE GO TO 10138 10293 CONTINUE WRITE(5,10310) 10310 FORMAT(' I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND $THAT.') C END SELECT 10309 CONTINUE 10138 CONTINUE COMMND=0 C END IF 10132 CONTINUE C C * WRITE OUT MESSAGES FROM DRIVER C C IF ISENT(WHO,1).NE.0 THEN IF(ISENT(WHO,1).NE.0 ) GO TO 10313 GO TO 10311 10313 CONTINUE CALL POSITN(18,1) C FOR I=1 UNTIL 10 DO I=1 GO TO 10316 10314 I = I+(1) 10316 IF(I.GT.10) GO TO 10315 C SELECT USING ISENT(WHO,I) I10320 = ISENT(WHO,I) C WHEN 1 THEN 10319 IF(I10320.EQ.1) GO TO 10322 GO TO 10321 10322 CONTINUE TYPE *,' WE ARE NOW DOCKED CAPTAIN.' GO TO 10320 C WHEN 2 THEN 10321 IF(I10320.EQ.2) GO TO 10324 GO TO 10323 10324 CONTINUE TYPE *,' ** CAPTAIN ! WE HIT A STAR! **' GO TO 10320 C WHEN 3 THEN 10323 IF(I10320.EQ.3) GO TO 10326 GO TO 10325 10326 CONTINUE C FOR IK=1 UNTIL 3 DO IK=1 GO TO 10329 10327 IK = IK+(1) 10329 IF(IK.GT.3) GO TO 10328 CALL CLEAR WRITE(5,10330) 10330 FORMAT(////////////,25X,'*** BOOM ***') C END DO GO TO 10327 10328 CONTINUE WRITE(5,10331) 10331 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,10332) 10332 FORMAT(/'$ARE YOU READY TO ACCEPT THIS ASSIGNMENT $?') CALL YESNO(YES) C IF YES THEN IF(YES ) GO TO 10335 GO TO 10333 10335 CONTINUE TYPE *,' GOOD!' GO TO 10334 C ELSE 10333 CONTINUE TYPE *,' TOUGH LUCK, BUT YOU GET IT ANYWAY.' C END IF 10334 CONTINUE XSHIP(WHO)=.TRUE. RESET=1 GO TO 10320 C WHEN 4 THEN 10325 IF(I10320.EQ.4) GO TO 10337 GO TO 10336 10337 CONTINUE WRITE(5,10338) 10338 FORMAT(' CAPTAIN WE HAVE BEEN HIT BY A PHOTON TORP $EDO') GO TO 10320 C WHEN 5 THEN 10336 IF(I10320.EQ.5) GO TO 10340 GO TO 10339 10340 CONTINUE TYPE *,' * TORPEDO HIT ALIEN SHIP, SIR. *' GO TO 10320 C WHEN 6 THEN 10339 IF(I10320.EQ.6) GO TO 10342 GO TO 10341 10342 CONTINUE TYPE *,' * PHASER HIT ON ALIEN VESSEL, SIR *' GO TO 10320 C WHEN 7 THEN 10341 IF(I10320.EQ.7) GO TO 10344 GO TO 10343 10344 CONTINUE TYPE *,' PHASER HIT ON TORPEDO, SIR' GO TO 10320 C WHEN 8 THEN 10343 IF(I10320.EQ.8) GO TO 10346 GO TO 10345 10346 CONTINUE TYPE *,' PHASER MISSED' GO TO 10320 C WHEN 9 THEN 10345 IF(I10320.EQ.9) GO TO 10348 GO TO 10347 10348 CONTINUE WRITE(5,10349) 10349 FORMAT(' ** SIR! WE HAVE RAMMED AN ALIEN VESSEL ** $') C GO TO 10320 C WHEN 10 THEN 10347 IF(I10320.EQ.10) GO TO 10351 GO TO 10350 10351 CONTINUE WRITE(5,10352) 10352 FORMAT(' * SIR! WE HAVE COLLIDED WITH AN ALIEN VES $SEL *') C GO TO 10320 C WHEN 11 THEN 10350 IF(I10320.EQ.11) GO TO 10354 GO TO 10353 10354 CONTINUE TYPE *,' PHASER HIT ON STAR SIR' C GO TO 10320 C WHEN 12 THEN 10353 IF(I10320.EQ.12) GO TO 10356 GO TO 10355 10356 CONTINUE TYPE *,' BASE REPORTS THEY ARE BEING ATTACKED SIR.' C GO TO 10320 C WHEN 13 THEN 10355 IF(I10320.EQ.13) GO TO 10358 GO TO 10357 10358 CONTINUE TYPE *,' TORPEDO HIT ON STAR SIR' C GO TO 10320 C WHEN 14 THEN 10357 IF(I10320.EQ.14) GO TO 10360 GO TO 10359 10360 CONTINUE WRITE(5,10361) 10361 FORMAT(' SIR, WE ARE UNDER PHASER ATTACK!') C GO TO 10320 C WHEN 15 THEN 10359 IF(I10320.EQ.15) GO TO 10363 GO TO 10362 10363 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 *,' FASCINATING.' CALL WAIT(2,2,M) C GO TO 10320 C WHEN 16 THEN 10362 IF(I10320.EQ.16) GO TO 10365 GO TO 10364 10365 CONTINUE TYPE *,' SCOTT HERE CAPTAIN' TYPE *,' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' TYPE *,' FAILING ...!' CALL WAIT(2,2,M) C GO TO 10320 C WHEN 17 THEN 10364 IF(I10320.EQ.17) GO TO 10367 GO TO 10366 10367 CONTINUE TYPE *,' CAPTAIN WE ARE GOING INTO HYPERSPACE' C GO TO 10320 C WHEN 18 THEN 10366 IF(I10320.EQ.18) GO TO 10369 GO TO 10368 10369 CONTINUE TYPE *,' HYPERSPACE JUMP BLOCKED SIR .' GO TO 10320 C WHEN 19 THEN 10368 IF(I10320.EQ.19) GO TO 10371 GO TO 10370 10371 CONTINUE TYPE *,' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' GO TO 10320 C WHEN 20 THEN 10370 IF(I10320.EQ.20) GO TO 10373 GO TO 10372 10373 CONTINUE TYPE *,' TORPEDO HIT ON TORPEDO SIR !.' GO TO 10320 C WHEN 21 THEN 10372 IF(I10320.EQ.21) GO TO 10375 GO TO 10374 10375 CONTINUE TYPE *,' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' C GO TO 10320 C WHEN 22 THEN 10374 IF(I10320.EQ.22) GO TO 10377 GO TO 10376 10377 CONTINUE TYPE *,' SULU HERE CAPTAIN,' TYPE *,' THE ALIEN VESSEL HAS BEEN DESTROYED' C GO TO 10320 C WHEN 23 THEN 10376 IF(I10320.EQ.23) GO TO 10379 GO TO 10378 10379 CONTINUE TYPE *,' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' C GO TO 10320 C WHEN 24 THEN 10378 IF(I10320.EQ.24) GO TO 10381 GO TO 10380 10381 CONTINUE TYPE *,' ANTI-MATTER POD HAS BEEN DESTROYED' C GO TO 10320 C WHEN 25 THEN 10380 IF(I10320.EQ.25) GO TO 10383 GO TO 10382 10383 CONTINUE TYPE *,' PHASER HIT ON ANTI-MATTER POD, SIR!' C GO TO 10320 C WHEN 26 THEN 10382 IF(I10320.EQ.26) GO TO 10385 GO TO 10384 10385 CONTINUE TYPE *,' TORPEDO HIT ON ANTI-MATTER POD, SIR!' C GO TO 10320 C WHEN 27 THEN 10384 IF(I10320.EQ.27) GO TO 10387 GO TO 10386 10387 CONTINUE TYPE *,' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' C GO TO 10320 C WHEN 28 THEN 10386 IF(I10320.EQ.28) GO TO 10389 GO TO 10388 10389 CONTINUE TYPE *,' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' C GO TO 10320 C WHEN 29 THEN 10388 IF(I10320.EQ.29) GO TO 10391 GO TO 10390 10391 CONTINUE TYPE *,' ** ANTI-MATTER POD DETONATED SIR **' C GO TO 10320 C WHEN 30 THEN 10390 IF(I10320.EQ.30) GO TO 10393 GO TO 10392 10393 CONTINUE WRITE(5,10394) 10394 FORMAT(' SIR, WE ARE CAUGHT IN AN ANTI-MATTER EXPL $OSION!') CALL WAIT(2,2,M) C GO TO 10320 C WHEN 31 THEN 10392 IF(I10320.EQ.31) GO TO 10396 GO TO 10395 10396 CONTINUE WRITE(5,10397) 10397 FORMAT(' IIEEEEEE!') C C OTHERWISE GO TO 10320 10395 CONTINUE CONTINUE C END SELECT 10398 CONTINUE 10320 CONTINUE ISENT(WHO,I)=0 C END DO GO TO 10314 10315 CONTINUE C END IF 10311 CONTINUE C IF MESSAG(WHO*60-59) .NE. ' ' THEN IF(MESSAG(WHO*60-59) .NE. ' ' ) GO TO 10401 GO TO 10399 10401 CONTINUE WRITE(5,10402) 10402 FORMAT('0CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADI $O') WRITE(5,10403) MESSAG(WHO*60-59) 10403 FORMAT(' FREQUENCY ',A1,' ***') WRITE(5,10404) (MESSAG(I),I=WHO*60-58,WHO*60) 10404 FORMAT(10X,60A1) CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) CALL WAIT(2,2,M) C END IF 10399 CONTINUE C IF (ENERGY(WHO) .LT. 900.) .AND. WARN THEN IF((ENERGY(WHO) .LT. 900.) .AND. WARN ) GO TO 10407 GO TO 10405 10407 CONTINUE TYPE *,' SCOTT HERE CAPTAIN,' TYPE *,' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' WARN=.FALSE. GO TO 10406 C ELSE 10405 CONTINUE WARN=.TRUE. C END IF 10406 CONTINUE C C THIS INSTRUCTION IS TO DELAY A HALF SECOND BEFORE CONTINUING CALL WAIT(30,0,M) C 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 COMMON/INBUF/INBUF(50),IOST(2) LOGICAL*1 EXIST,OK REAL VARI,LOW,HIGH BYTE INPUT(15),LEFTED(15) INTEGER NCHRS IFLAG=0 GO TO 10 ENTRY GETRLL IFLAG=1 10 CONTINUE 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 C IF IFLAG.EQ.0 THEN IF(IFLAG.EQ.0 ) GO TO 10008 GO TO 10006 10008 CONTINUE READ(5,100,END=800) NCHRS,(INPUT(I),I=1,15) 100 FORMAT(Q,15A1) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE GO TO 10007 C ELSE 10006 CONTINUE NCHRS=IOST(2)-2 DECODE(17,10009,INBUF) INPUT 10009 FORMAT(2X,15A1) IFLAG=0 C END IF 10007 CONTINUE C SELECT C WHEN NCHRS .EQ. 0 C THEN 10012 IF(NCHRS .EQ. 0 $ ) GO TO 10015 GO TO 10014 10015 CONTINUE OK=.TRUE. EXIST=.FALSE. GO TO 10013 C WHEN NCHRS .LE. 15 THEN 10014 IF(NCHRS .LE. 15) GO TO 10017 GO TO 10016 10017 CONTINUE C * LEFT ADJUST INPUT CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) DECODE(15,10018,LEFTED,ERR=200) VARI 10018 FORMAT(G15.0) C IF VARI .GE. LOW .AND. VARI .LE. HIGH C THEN IF(VARI .GE. LOW .AND. VARI .LE. HIGH $ ) GO TO 10021 GO TO 10019 10021 CONTINUE OK=.TRUE. EXIST=.TRUE. GO TO 10020 C ELSE 10019 CONTINUE WRITE(5,10022) 10022 FORMAT(' SORRY CAPTAIN, BUT YOUR COMMAND''S PARAMETER $MUST') WRITE(5,10023) LOW,HIGH 10023 FORMAT(' BE BETWEEN ',F15.4,' AND ',F15.4) C END IF 10020 CONTINUE GO TO 300 200 CONTINUE WRITE(5,10024) 10024 FORMAT('$WOULD YOU PLEASE REPEAT THAT SIR ? ') 300 CONTINUE C OTHERWISE GO TO 10013 10016 CONTINUE WRITE(5,10026) 10026 FORMAT('$RUN THAT BY ME AGAIN ! ') C END SELECT 10025 CONTINUE 10013 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) INTEGER NUM,LOW,HIGH COMMON/INBUF/INBUF(50),IOST(2) LOGICAL*1 OK,FLAG C IFLAG=0 GO TO 10 ENTRY GETINL IFLAG=1 10 CONTINUE C OK=.FALSE. C UNTIL OK DO GO TO 10002 10000 IF(OK ) GO TO 10001 10002 CONTINUE C IF IFLAG.EQ.0 THEN IF(IFLAG.EQ.0 ) GO TO 10005 GO TO 10003 10005 CONTINUE READ(5,10006,END=800,ERR=200) NCHRS,NUM 10006 FORMAT(Q,I5) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE GO TO 10004 C ELSE 10003 CONTINUE NCHRS=IOST(2)-2 DECODE(7,10007,INBUF) NUM 10007 FORMAT(2X,I) IFLAG=0 C END IF 10004 CONTINUE C IF NCHRS .EQ. 0 THEN IF(NCHRS .EQ. 0 ) GO TO 10010 GO TO 10008 10010 CONTINUE FLAG=.FALSE. OK=.TRUE. GO TO 10009 C ELSE 10008 CONTINUE C IF (NUM .GE. LOW) .AND. (NUM .LE. HIGH) THEN IF((NUM .GE. LOW) .AND. (NUM .LE. HIGH) ) GO TO 10013 GO TO 10011 10013 CONTINUE OK=.TRUE. FLAG=.TRUE. GO TO 10012 C ELSE 10011 CONTINUE WRITE(5,10014) 10014 FORMAT(' WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS $') WRITE(5,10015) LOW,HIGH 10015 FORMAT('$BETWEEN',I5,' AND ',I5,5X,'TRY AGAIN : ') C END IF 10012 CONTINUE GOTO 300 200 CONTINUE WRITE(5,10016) 10016 FORMAT('$TRY AGAIN BOZO : ') 300 CONTINUE C END IF 10009 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END SUBROUTINE YESNO(FLAG) COMMON/INBUF/INBUF(50),IOST(2) LOGICAL*1 FLAG,OK BYTE YES(4),NO(4) BYTE ANSWER(4) DATA YES/'Y','E','S',' '/ DATA NO/'N','O',' ',' '/ C IFLAG=O GO TO 10 ENTRY YESNOL IFLAG=1 10 CONTINUE C OK=.FALSE. C UNTIL OK DO GO TO 10002 10000 IF(OK ) GO TO 10001 10002 CONTINUE C IF IFLAG.EQ.0 THEN IF(IFLAG.EQ.0 ) GO TO 10005 GO TO 10003 10005 CONTINUE READ(5,10006,END=800) NCHRS, (ANSWER(I),I=1,4) 10006 FORMAT(Q,4A1) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE GO TO 10004 C ELSE 10003 CONTINUE NCHRS=IOST(2)-2 DECODE(6,10007,INBUF) ANSWER 10007 FORMAT(2X,4A1) IFLAG=0 C END IF 10004 CONTINUE C IF (NCHRS .GT. 4) .OR. (NCHRS .LT. 1) THEN IF((NCHRS .GT. 4) .OR. (NCHRS .LT. 1) ) GO TO 10010 GO TO 10008 10010 CONTINUE NCHRS=4 C END IF 10008 CONTINUE C * CHECK FOR YES I=KOMSTR(YES,1,NCHRS,ANSWER,1) C IF I .EQ. 0 THEN IF(I .EQ. 0 ) GO TO 10013 GO TO 10011 10013 CONTINUE FLAG=.TRUE. OK=.TRUE. GO TO 10012 C ELSE 10011 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 10016 GO TO 10014 10016 CONTINUE FLAG=.FALSE. OK=.TRUE. GO TO 10015 C ELSE 10014 CONTINUE C * INCORRECT RESPONSE WRITE(5,10017) 10017 FORMAT(' ** PLEASE ANSWER "YES" OR "NO" **') WRITE(5,10018) 10018 FORMAT('$ANSWER ? ') C END IF 10015 CONTINUE C END IF 10012 CONTINUE C END DO GO TO 10000 10001 CONTINUE RETURN END