PROGRAM PLAYER C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), $ XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS LOGICAL*1 THRU,XSHIP,CLOAK BYTE UNIV,MESSAG C END TEXT LOGICAL*1 OK,XXX,DONE,YES,WARN REAL SC(9),R(9) BYTE BLANK(80),OBUFF(19,19),ALPHA REAL D1(4) C C NOTE, THE SEQUENCE OF THE NEXT TWO STATEMENTS IS SIGNIFICANT C BYTE BLUNK BYTE NBUFF(19,19) C C BYTE SBUFF(2000) INTEGER COMMND INTEGER IPRM(2) INTEGER WHO 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 COMMON/CURSOR/ESCPOS,IOFSET BYTE ESCPOS(2) DATA ESCPOS/"33,'F'/ DATA IOFSET/"37/ C C*********************************************************************** C DATA BLANK/80*' '/ DATA BLUNK/' '/ DATA SC/9*-9999./ DATA R/9*-9999./ DATA DONE/.FALSE./ DATA OK/.FALSE./ DATA I5/5/ C C CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) CALL GETADR(IPRM,SBUFF) L=17 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(IW,OK,1,8) C IF OK THEN IF(OK ) GO TO 10015 GO TO 10013 10015 CONTINUE WHO=IW C IF XSHIP(WHO) THEN IF(XSHIP(WHO) ) GO TO 10018 GO TO 10016 10018 CONTINUE WRITE(5,10019) 10019 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER') WRITE(5,10020) 10020 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND ?') CALL YESNO(OK) C END IF 10016 CONTINUE C END IF 10013 CONTINUE C END DO GO TO 10001 10002 CONTINUE XSHIP(WHO)=.TRUE. CREW(WHO)=CREW(WHO)+1 C CALL RBUFF(OBUFF) IRC=0 C UNTIL DONE DO GO TO 10023 10021 IF(DONE ) GO TO 10022 10023 CONTINUE C C THE FOLLOWING WAIT CONTROLS THE UPDATE RATE, WHICH IS NORMALLY C SET TO A HALF SECOND (30 CLOCK TICKS). C CALL WAIT(30,0,M) NC=1 COMMND='0 ' CALL TREAD(COMMND,NC,I5) C C PLACE LOCAL SCAN ON TERMINAL C CALL STRMOV(BLUNK,1,361,NBUFF,1) ID=SCAN(WHO) C IF ID .GT. 9 THEN IF(ID .GT. 9 ) GO TO 10026 GO TO 10024 10026 CONTINUE ID=9 C END IF 10024 CONTINUE C XX=XCORD(WHO) YY=YCORD(WHO) C FOR IX=-ID UNTIL ID DO IX=-ID GO TO 10029 10027 IX = IX+(1) 10029 IF(IX.GT.ID) GO TO 10028 IX1=XX+IX C FOR IY=-ID UNTIL ID DO IY=-ID GO TO 10032 10030 IY = IY+(1) 10032 IF(IY.GT.ID) GO TO 10031 IY1=YY+IY C SELECT C WHEN (IX1 .LT. 100) .AND. (IX1 .GT. 1) .AND. (IY1 .LT. C 100) .AND. (IY1 .GT. 1 ) THEN 10035 IF((IX1 .LT. 100) .AND. (IX1 .GT. 1) .AND. (IY1 .LT. 1 $00) .AND. (IY1 .GT. 1 )) GO TO 10038 GO TO 10037 10038 CONTINUE ALPHA=UNIV(IX1,IY1) GO TO 10036 C WHEN ((IX1 .EQ. 100) .OR. (IX1 .EQ. 1) .OR. (IY1 .EQ. C 100) .OR. (IY1 .EQ. 1) ) .AND. C (((IX1 .LT. 100) .AND. (IX1 .G C T. 1)) .OR. ((IY1 .LT. 100) .A C ND. (IY1 .GT. 1))) THEN 10037 IF(((IX1 .EQ. 100) .OR. (IX1 .EQ. 1) .OR. (IY1 .EQ. 10 $0) .OR. (IY1 .EQ. 1) ) .AND. $ (((IX1 .LT. 100) .AND. (IX1 .GT. 1)) .OR. $ ((IY1 .LT. 100) .AND. (IY1 .GT. 1)))) GO TO 10040 GO TO 10039 10040 CONTINUE C IF UNIV(IX1,IY1) .EQ. '.' THEN IF(UNIV(IX1,IY1) .EQ. '.' ) GO TO 10043 GO TO 10041 10043 CONTINUE ALPHA='-' GO TO 10042 C ELSE 10041 CONTINUE ALPHA=UNIV(IX1,IY1) C END IF 10042 CONTINUE C OTHERWISE GO TO 10036 10039 CONTINUE ALPHA='.' C END SELECT 10044 CONTINUE 10036 CONTINUE C IF (ALPHA .GE. 49) .AND. (ALPHA .LE. 56) .AND. C (CLOAK(ALPHA-48)) THEN IF((ALPHA .GE. 49) .AND. (ALPHA .LE. 56) .AND. $ (CLOAK(ALPHA-48)) ) GO TO 10047 GO TO 10045 10047 CONTINUE NBUFF(10+IX,10+IY)='.' GO TO 10046 C ELSE 10045 CONTINUE NBUFF(10+IX,10+IY)=ALPHA C END IF 10046 CONTINUE C END DO GO TO 10030 10031 CONTINUE C END DO GO TO 10027 10028 CONTINUE NOUT=0 C FOR IX=1 UNTIL 19 DO IX=1 GO TO 10050 10048 IX = IX+(1) 10050 IF(IX.GT.19) GO TO 10049 C FOR IY=1 UNTIL 18 DO IY=1 GO TO 10053 10051 IY = IY+(1) 10053 IF(IY.GT.18 ) GO TO 10052 C IF NBUFF(IX,IY) .NE. OBUFF(IX,IY) THEN IF(NBUFF(IX,IY) .NE. OBUFF(IX,IY) ) GO TO 10056 GO TO 10054 10056 CONTINUE SBUFF(NOUT+1)=ESCPOS(1) SBUFF(NOUT+2)=ESCPOS(2) SBUFF(NOUT+3)=IOFSET+19-IY SBUFF(NOUT+4)=2*IX+IOFSET+23 SBUFF(NOUT+5)=NBUFF(IX,IY) NOUT=NOUT+5 OBUFF(IX,IY)=NBUFF(IX,IY) C END IF 10054 CONTINUE C END DO GO TO 10051 10052 CONTINUE C END DO GO TO 10048 10049 CONTINUE C C C IF NOUT .GT. 0 THEN IF(NOUT .GT. 0 ) GO TO 10059 GO TO 10057 10059 CONTINUE IPRM(2)=NOUT CALL WTQIO("410,5,1,,,IPRM) C END IF 10057 CONTINUE C C C L=17 C SELECT USING COMMND I10063 = COMMND C C CHECK FOR NO INPUT C C WHEN '0 ' THEN 10062 IF(I10063.EQ.'0 ' ) GO TO 10065 GO TO 10064 10065 CONTINUE CONTINUE C C HELP COMMAND C GO TO 10063 C WHEN ' ' THEN 10064 IF(I10063.EQ.' ' ) GO TO 10067 GO TO 10066 10067 CONTINUE C CALL CPOS(L) WRITE(5,10068) 10068 FORMAT(' A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAGE',T $55, 'T FIRE TORPEDOES'/' C COURSE HEADING',T30, $ 'N FREEZE ANTI-MATTER', $ T55,'W SET WARP SPEED'/' F FADE (CLOAKING ON)',T30, $ 'P FIRE PHASERS',T55,'X DETONATE ANTI-MATTER'/ $ ' H HYPERSPACE SETTING',T30,'Q QUIT',T55, $ 'Z LAUNCH ANTI-MATTER'/' K FIRE HOMING TORPEDO',T30, $ 'R RESET DISPLAY',T53,' DISPLAY HELP MESSAGE'/ $ ' L LOCATE SHIP',T30,'S SHIELD CHANGE') C C QUIT COMMAND C C C WARP FACTOR COMMAND C GO TO 10063 C WHEN 'W ' THEN 10066 IF(I10063.EQ.'W ') GO TO 10070 GO TO 10069 10070 CONTINUE CALL CPOS(L) WRITE(5,10071) 10071 FORMAT('$WARP FACTOR SIR ?') CALL GETREL(VALUE,OK,0.,8.) C IF OK THEN IF( OK ) GO TO 10074 GO TO 10072 10074 CONTINUE WARP(WHO)=VALUE CALL CPOS(L) WRITE(5,10075) WARP(WHO) 10075 FORMAT(' WARP FACTOR ',F5.2,' SIR.') C END IF 10072 CONTINUE C C COURSE COMMAND C GO TO 10063 C WHEN 'C ' THEN 10069 IF(I10063.EQ.'C ') GO TO 10077 GO TO 10076 10077 CONTINUE CALL CPOS(L) WRITE(5,10078) 10078 FORMAT('$COURSE SIR ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10081 GO TO 10079 10081 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10084 GO TO 10082 10084 CONTINUE DIR(WHO)=(15.-VALUE)*30. GO TO 10083 C ELSE 10082 CONTINUE DIR(WHO)=(3.-VALUE)*30. C END IF 10083 CONTINUE CALL CPOS(L) WRITE(5,10085) VALUE 10085 FORMAT(' HEADING ',F5.2,' SIR.') C END IF 10079 CONTINUE C C HYPERSPACE COMMAND C GO TO 10063 C WHEN 'H ' THEN 10076 IF(I10063.EQ.'H ') GO TO 10087 GO TO 10086 10087 CONTINUE CALL CPOS(L) WRITE(5,10088) HYPER(WHO) 10088 FORMAT(' CURRENT HYPERSET = ',I1) C FORMAT(' CURRENT HYPERSPACE JUMP SETTING IS ',I1,' SIR.') WRITE(5,10089) 10089 FORMAT('$NEW SETTING ?') CALL GETINT(II,OK,1,6) C IF OK THEN IF(OK ) GO TO 10092 GO TO 10090 10092 CONTINUE HYPER(WHO)=II C END IF 10090 CONTINUE C C SHIELD COMMAND C GO TO 10063 C WHEN 'S ' THEN 10086 IF(I10063.EQ.'S ') GO TO 10094 GO TO 10093 10094 CONTINUE CALL CPOS(L) WRITE(5,10095) 10095 FORMAT('$ENERGY CHANGE ?') C FORMAT('$ENGINEERING TO BRIDGE, HOW MUCH ENERGY SIR ?') CALL GETREL(VALUE,OK,-1.E36,1.E36) C IF OK THEN IF(OK ) GO TO 10098 GO TO 10096 10098 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 10101 GO TO 10099 10101 CONTINUE ENERGY(WHO)=ENERGY(WHO)-VALUE SHIELD(WHO)=SHIELD(WHO)+VALUE WRITE(5,10102) 10102 FORMAT(' AYE, CAPTAIN.') GO TO 10100 C ELSE 10099 CONTINUE WRITE(5,10103) 10103 FORMAT(' I AM SORRY CAPTAIN, BUT THAT IS IMPOSSIBL $E.') C END IF 10100 CONTINUE C END IF 10096 CONTINUE C C QUIT COMMAND C GO TO 10063 C WHEN 'Q ' THEN 10093 IF(I10063.EQ.'Q ') GO TO 10105 GO TO 10104 10105 CONTINUE CALL CPOS(L) WRITE(5,10106) 10106 FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ?') CALL YESNO(DONE) C IF DONE THEN IF(DONE ) GO TO 10109 GO TO 10107 10109 CONTINUE CREW(WHO)=CREW(WHO)-1 C IF CREW(WHO) .EQ. 400 THEN IF(CREW(WHO) .EQ. 400 ) GO TO 10112 GO TO 10110 10112 CONTINUE XSHIP(WHO)=.FALSE. C END IF 10110 CONTINUE C END IF 10107 CONTINUE C C C * HOMING TORPEDOE LAUNCH C GO TO 10063 C WHEN 'K ' THEN 10104 IF(I10063.EQ.'K ') GO TO 10114 GO TO 10113 10114 CONTINUE CALL CPOS(L) C IF NHOM(WHO) .GT. 0 THEN IF(NHOM(WHO) .GT. 0 ) GO TO 10117 GO TO 10115 10117 CONTINUE WRITE(5,10118) 10118 FORMAT('$HOMING FREQUENCY SIR ?') CALL GETINT(II,OK,1,8) C IF OK THEN IF(OK ) GO TO 10121 GO TO 10119 10121 CONTINUE C IF II .EQ. WHO THEN IF(II .EQ. WHO ) GO TO 10124 GO TO 10122 10124 CONTINUE WRITE(5,10125) 10125 FORMAT(' ** SIR!, OUR TORPEDOE TUBES ARE JAMME $D') NHOM(WHO)=0 TORPS(WHO)=0 GO TO 10123 C ELSE 10122 CONTINUE WHOM(WHO,NHOM(WHO))=-II NHOM(WHO)=NHOM(WHO)-1 C END IF 10123 CONTINUE C END IF 10119 CONTINUE GO TO 10116 C ELSE 10115 CONTINUE WRITE(5,10126) 10126 FORMAT(' SORRY SKIPPER, WE ARE OUT OF HOMERS') C END IF 10116 CONTINUE C C REPORT COMMAND C GO TO 10063 C WHEN 'R ' THEN 10113 IF(I10063.EQ.'R ') GO TO 10128 GO TO 10127 10128 CONTINUE CALL RBUFF(OBUFF) C FOR I=1 UNTIL 8 DO I=1 GO TO 10131 10129 I = I+(1) 10131 IF(I.GT.8) GO TO 10130 SC(I)=-9999. R(I)=-9999. C END DO GO TO 10129 10130 CONTINUE CALL REFRSH(SC,R,WHO,SBUFF,IPRM) C C TORPEDO COMMAND C GO TO 10063 C WHEN 'T ' THEN 10127 IF(I10063.EQ.'T ') GO TO 10133 GO TO 10132 10133 CONTINUE CALL CPOS(L) C IF LAUNCH(WHO) .LT. 0. THEN IF(LAUNCH(WHO) .LT. 0. ) GO TO 10136 GO TO 10134 10136 CONTINUE C IF TORPS(WHO) .GT. 0 THEN IF(TORPS(WHO) .GT. 0 ) GO TO 10139 GO TO 10137 10139 CONTINUE WRITE(5,10140) 10140 FORMAT('$TORPEDO READY, COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10143 GO TO 10141 10143 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10146 GO TO 10144 10146 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10145 C ELSE 10144 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10145 CONTINUE LAUNCH(WHO)=VALUE TORPS(WHO)=TORPS(WHO)-1 C IF TORPS(WHO) .EQ. 0 THEN IF(TORPS(WHO) .EQ. 0 ) GO TO 10149 GO TO 10147 10149 CONTINUE CALL CPOS(L) WRITE(5,10150) 10150 FORMAT(' TORPEDO ROOM TO BRIDGE.') WRITE(5,10151) 10151 FORMAT(20X,'THIS IS OUR LAST TORPEDO SIR.' $) C END IF 10147 CONTINUE C CALL CPOS(L) C WRITE(5,) VALUE C FORMAT(' TORPEDO LAUNCHED, HEADING ',F7.2,' DEGREES.') C END IF 10141 CONTINUE GO TO 10138 C ELSE 10137 CONTINUE WRITE(5,10152) 10152 FORMAT(' SO SORRY CAPTAIN, BUT WE ARE OUT OF TORPE $DOES') C END IF 10138 CONTINUE GO TO 10135 C ELSE 10134 CONTINUE WRITE(5,10153) 10153 FORMAT(' TORPEDO TUBES ARE NOT READY YET CAPTAIN !') C END IF 10135 CONTINUE C C PHASER COMMAND C GO TO 10063 C WHEN 'P ' THEN 10132 IF(I10063.EQ.'P ') GO TO 10155 GO TO 10154 10155 CONTINUE CALL CPOS(L) C IF PHA(WHO) .LT. 0. THEN IF(PHA(WHO) .LT. 0. ) GO TO 10158 GO TO 10156 10158 CONTINUE WRITE(5,10159) 10159 FORMAT('$PHASER COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10162 GO TO 10160 10162 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10165 GO TO 10163 10165 CONTINUE VALUE=(15.-VALUE)*30. GO TO 10164 C ELSE 10163 CONTINUE VALUE=(3.-VALUE)*30. C END IF 10164 CONTINUE PHA(WHO)=VALUE ENERGY(WHO)=ENERGY(WHO)-50. C WRITE(5,) C FORMAT(' PHASERS FIRED CAPTAIN') C END IF 10160 CONTINUE GO TO 10157 C ELSE 10156 CONTINUE WRITE(5,10166) 10166 FORMAT(' PHASER CONTROL TO BRIDGE, PHASERS ARE NOT REA $DY YET.') C END IF 10157 CONTINUE C C LONG RANGE SCAN COMMAND C GO TO 10063 C WHEN 'L ' THEN 10154 IF(I10063.EQ.'L ') GO TO 10168 GO TO 10167 10168 CONTINUE CALL CPOS(L) C WRITE(5,) C FORMAT(' SPOCK HERE CAPTAIN.') C WRITE(5,) C FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ?') WRITE(5,10169) 10169 FORMAT('$FREQUENCY ? ') CALL GETINT(II,OK,1,8) C IF OK THEN IF(OK ) GO TO 10172 GO TO 10170 10172 CONTINUE IX=XCORD(II)/10. IY=YCORD(II)/10. CALL CPOS(L) WRITE(5,10173) IX,IY 10173 FORMAT(' SECTOR ',I3,',',I3) C FORMAT(' SCANNERS REPORT LIFE FORMS IN SECTOR ',I3,','I3) X1=XCORD(II) C IF X1 .LT. 50. THEN IF(X1 .LT. 50. ) GO TO 10176 GO TO 10174 10176 CONTINUE X2=X1+100. GO TO 10175 C ELSE 10174 CONTINUE X2=X1-100. C END IF 10175 CONTINUE Y1=YCORD(II) C IF Y1 .LT. 50. THEN IF(Y1 .LT. 50. ) GO TO 10179 GO TO 10177 10179 CONTINUE Y2=Y1+100. GO TO 10178 C ELSE 10177 CONTINUE Y2=Y1-100. C END IF 10178 CONTINUE D1(1)=((XX-X1)**2 + (YY-Y1)**2)**.5 D1(2)=((XX-X1)**2 + (YY-Y2)**2)**.5 D1(3)=((XX-X2)**2 + (YY-Y1)**2)**.5 D1(4)=((XX-X2)**2 + (YY-Y2)**2)**.5 IT=1 C FOR J=2 UNTIL 4 DO J=2 GO TO 10182 10180 J = J+(1) 10182 IF(J.GT.4) GO TO 10181 C IF D1(J) .LT. D1(IT) THEN IF(D1(J) .LT. D1(IT) ) GO TO 10185 GO TO 10183 10185 CONTINUE IT=J C END IF 10183 CONTINUE C END DO GO TO 10180 10181 CONTINUE D=D1(IT) C SELECT C WHEN IT .EQ. 1 THEN 10188 IF(IT .EQ. 1) GO TO 10191 GO TO 10190 10191 CONTINUE YD=Y1 XD=X1 GO TO 10189 C WHEN IT .EQ. 2 THEN 10190 IF(IT .EQ. 2) GO TO 10193 GO TO 10192 10193 CONTINUE YD=Y2 XD=X1 GO TO 10189 C WHEN IT .EQ. 3 THEN 10192 IF(IT .EQ. 3) GO TO 10195 GO TO 10194 10195 CONTINUE YD=Y1 XD=X2 C OTHERWISE GO TO 10189 10194 CONTINUE YD=Y2 XD=X2 C END SELECT 10196 CONTINUE 10189 CONTINUE EDIS=D EDIR=ATAN2((YD-YY),(XD-XX))*57.2952 C IF EDIR .LT. 0. THEN IF(EDIR .LT. 0. ) GO TO 10199 GO TO 10197 10199 CONTINUE EDIR=EDIR+360. C END IF 10197 CONTINUE C IF EDIR .GT. 90. THEN IF(EDIR .GT. 90. ) GO TO 10202 GO TO 10200 10202 CONTINUE EDIR=(450.-EDIR)/30. GO TO 10201 C ELSE 10200 CONTINUE EDIR=(90.-EDIR)/30. C END IF 10201 CONTINUE WRITE(5,10203) EDIR,EDIS 10203 FORMAT(' COURSE ',F5.2,' DISTANCE ',F5.2,' PARSECS') C FORMAT(' I APPROXIMATE A COURSE OF ',F13.9,' WOULD TAKE') C WRITE(5,) C FORMAT(' US TO THE CENTER OF THEM.') C END IF 10170 CONTINUE C C MESSAGE COMMAND C GO TO 10063 C WHEN 'M ' THEN 10167 IF(I10063.EQ.'M ') GO TO 10205 GO TO 10204 10205 CONTINUE CALL CPOS(L) WRITE(5,10206) 10206 FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDING?') CALL GETINT(IVAL,OK,1,8) C IF OK THEN IF(OK ) GO TO 10209 GO TO 10207 10209 CONTINUE CALL CPOS(L) WRITE(5,10210) 10210 FORMAT('$MESSAGE CAPTAIN ?') READ(5,10211,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 10211 FORMAT(60A1) GOTO 13 12 CLOSE(UNIT=5) 13 CONTINUE ENERGY(WHO)=ENERGY(WHO)-10. ENCODE(1,10212,COMMND) WHO 10212 FORMAT(I1) CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) C END IF 10207 CONTINUE C C CLOAKING COMMAND C GO TO 10063 C WHEN 'F ' THEN 10204 IF(I10063.EQ.'F ') GO TO 10214 GO TO 10213 10214 CONTINUE CALL CPOS(L) C IF .NOT. CLOAK(WHO) THEN IF(.NOT. CLOAK(WHO) ) GO TO 10217 GO TO 10215 10217 CONTINUE CLOAK(WHO)=.TRUE. TYPE *,' SPOCK HERE CAPTAIN.' TYPE *,' CLOAKING DEVICE COMING ON NOW!' GO TO 10216 C ELSE 10215 CONTINUE TYPE *,' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!' C END IF 10216 CONTINUE C GO TO 10063 C WHEN 'A ' THEN 10213 IF(I10063.EQ.'A ') GO TO 10219 GO TO 10218 10219 CONTINUE CALL CPOS(L) C IF CLOAK(WHO) THEN IF(CLOAK(WHO) ) GO TO 10222 GO TO 10220 10222 CONTINUE CLOAK(WHO)=.FALSE. TYPE *,' SPOCK HERE CAPTAIN.' TYPE *,' CLOAKING DEVICE DEACTIVATED.' GO TO 10221 C ELSE 10220 CONTINUE TYPE *,' BUT CAPTAIN WE ARE NOT CLOAKED !' C END IF 10221 CONTINUE C C C EXPLODE ANTI-MATTER DEVICE C GO TO 10063 C WHEN 'X ' THEN 10218 IF(I10063.EQ.'X ') GO TO 10224 GO TO 10223 10224 CONTINUE CALL CPOS(L) C IF IPOD(WHO) .EQ. 2 THEN IF(IPOD(WHO) .EQ. 2 ) GO TO 10227 GO TO 10225 10227 CONTINUE IPOD(WHO)=3 WRITE(5,10228) 10228 FORMAT(' DETONATION SIGNALED, SIR!') GO TO 10226 C ELSE 10225 CONTINUE WRITE(5,10229) 10229 FORMAT(' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER $ ', 'DEVICE.') C END IF 10226 CONTINUE C C CONVERT MOVING ANTI-MATTER POD TO A STATIC MINE C GO TO 10063 C WHEN 'N ' THEN 10223 IF(I10063.EQ.'N ') GO TO 10231 GO TO 10230 10231 CONTINUE CALL CPOS(L) C IF IPOD(WHO) .EQ. 2 THEN IF(IPOD(WHO) .EQ. 2 ) GO TO 10234 GO TO 10232 10234 CONTINUE WPOD(WHO)=0. WRITE(5,10235) 10235 FORMAT(' ANTI-MATTER MINE IN POSITION, SIR!') GO TO 10233 C ELSE 10232 CONTINUE WRITE(5,10236) 10236 FORMAT(' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER $ ', 'DEVICE.') C END IF 10233 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GO TO 10063 C WHEN 'Z ' THEN 10230 IF(I10063.EQ.'Z ') GO TO 10238 GO TO 10237 10238 CONTINUE CALL CPOS(L) C IF (IPOD(WHO) .EQ. 0) .OR. (WPOD(WHO).EQ.0) THEN IF((IPOD(WHO) .EQ. 0) .OR. (WPOD(WHO).EQ.0) ) GO TO 1024 $1 GO TO 10239 10241 CONTINUE WRITE(5,10242) 10242 FORMAT('$ANTI MATTER DEVICE READY SIR, COURSE ?') CALL GETREL(VALUE,OK,0.,12.) C IF OK THEN IF(OK ) GO TO 10245 GO TO 10243 10245 CONTINUE C IF VALUE .GE. 3. THEN IF(VALUE .GE. 3. ) GO TO 10248 GO TO 10246 10248 CONTINUE DPOD(WHO)=(15.-VALUE)*30. GO TO 10247 C ELSE 10246 CONTINUE DPOD(WHO)=(3.-VALUE)*30. C END IF 10247 CONTINUE IPOD(WHO)=1 C END IF 10243 CONTINUE GO TO 10240 C ELSE 10239 CONTINUE WRITE(5,10249) 10249 FORMAT(' SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MATTER $PODS') C END IF 10240 CONTINUE C C C OTHERWISE GO TO 10063 10237 CONTINUE CALL CPOS(L) WRITE(5,10251) 10251 FORMAT(' I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND THAT $.') C END SELECT 10250 CONTINUE 10063 CONTINUE C CALL REFRSH(SC,R,WHO,SBUFF,IPRM) C C * WRITE OUT MESSAGES FROM DRIVER C C FOR I=1 UNTIL 10 DO I=1 GO TO 10254 10252 I = I+(1) 10254 IF(I.GT.10) GO TO 10253 C IF ISENT(WHO,I) .NE. 0 THEN IF(ISENT(WHO,I) .NE. 0 ) GO TO 10257 GO TO 10255 10257 CONTINUE C IF L .GT. 21 THEN IF(L .GT. 21 ) GO TO 10260 GO TO 10258 10260 CONTINUE L=17 CALL CPOS(L) GO TO 10259 C ELSE 10258 CONTINUE CALL CURWRT(L,1,' ',1,5) C END IF 10259 CONTINUE C SELECT USING ISENT(WHO,I) I10264 = ISENT(WHO,I) C WHEN 1 THEN 10263 IF(I10264.EQ.1) GO TO 10266 GO TO 10265 10266 CONTINUE TYPE *,' DOCKED CAPTAIN.' L=L+1 GO TO 10264 C WHEN 2 THEN 10265 IF(I10264.EQ.2) GO TO 10268 GO TO 10267 10268 CONTINUE TYPE *,' ** CAPTAIN ! WE HIT A STAR! ** ' L=L+1 GO TO 10264 C WHEN 3 THEN 10267 IF(I10264.EQ.3) GO TO 10270 GO TO 10269 10270 CONTINUE 190 CONTINUE C FOR IK=1 UNTIL 3 DO IK=1 GO TO 10273 10271 IK = IK+(1) 10273 IF(IK.GT.3) GO TO 10272 CALL CLEAR(5) WRITE(5,10274) 10274 FORMAT(////////////,25X,'*** BOOM ***') C END DO GO TO 10271 10272 CONTINUE WRITE(5,10275) 10275 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,10276) 10276 FORMAT(/'$ARE YOU READY TO ACCEPT THIS ASSIGNMENT $?') CALL YESNO(YES) C IF YES THEN IF(YES ) GO TO 10279 GO TO 10277 10279 CONTINUE TYPE *,' GOOD!' GO TO 10278 C ELSE 10277 CONTINUE TYPE *,' TOUGH LUCK, BUT YOU GET IT ANYWAY.' CALL WAIT(3,2,M) C END IF 10278 CONTINUE XSHIP(WHO)=.TRUE. CALL RBUFF(OBUFF) C FOR K=1 UNTIL 8 DO K=1 GO TO 10282 10280 K = K+(1) 10282 IF(K.GT.8) GO TO 10281 SC(K)=-9999. R(K)=-9999. C END DO GO TO 10280 10281 CONTINUE L=17 CALL CPOS(L) C GO TO 10264 C WHEN 4 THEN 10269 IF(I10264.EQ.4) GO TO 10284 GO TO 10283 10284 CONTINUE WRITE(5,10285) 10285 FORMAT(1X,'CAPTAIN WE HAVE BEEN HIT BY A PHOTON TO $RPEDO') L=L+1 GO TO 10264 C WHEN 5 THEN 10283 IF(I10264.EQ.5) GO TO 10287 GO TO 10286 10287 CONTINUE TYPE *,' * TORPEDO HIT ALIEN SHIP, SIR. *' L=L+1 GO TO 10264 C WHEN 6 THEN 10286 IF(I10264.EQ.6) GO TO 10289 GO TO 10288 10289 CONTINUE TYPE *,' * PHASER HIT ON ALIEN VESSEL, SIR *' L=L+1 GO TO 10264 C WHEN 7 THEN 10288 IF(I10264.EQ.7) GO TO 10291 GO TO 10290 10291 CONTINUE TYPE *,' PHASER HIT ON TORPEDO, SIR' L=L+1 GO TO 10264 C WHEN 8 THEN 10290 IF(I10264.EQ.8) GO TO 10293 GO TO 10292 10293 CONTINUE TYPE *,' PHASER MISSED' L=L+1 GO TO 10264 C WHEN 9 THEN 10292 IF(I10264.EQ.9) GO TO 10295 GO TO 10294 10295 CONTINUE WRITE(5,10296) 10296 FORMAT(1X,'** SIR! WE HAVE RAMMED AN ALIEN VESSEL $**') L=L+1 C GO TO 10264 C WHEN 10 THEN 10294 IF(I10264.EQ.10) GO TO 10298 GO TO 10297 10298 CONTINUE WRITE(5,10299) 10299 FORMAT(1X,'* SIR! WE HAVE COLLIDED WITH AN ALIEN V $ESSEL *') L=L+1 C GO TO 10264 C WHEN 11 THEN 10297 IF(I10264.EQ.11) GO TO 10301 GO TO 10300 10301 CONTINUE TYPE *,' PHASER HIT ON STAR SIR' L=L+1 C GO TO 10264 C WHEN 12 THEN 10300 IF(I10264.EQ.12) GO TO 10303 GO TO 10302 10303 CONTINUE TYPE *,' BASE REPORTS THEY ARE BEING ATTACKED SIR.' L=L+1 C GO TO 10264 C WHEN 13 THEN 10302 IF(I10264.EQ.13) GO TO 10305 GO TO 10304 10305 CONTINUE TYPE *,' TORPEDO HIT ON STAR SIR' L=L+1 C GO TO 10264 C WHEN 14 THEN 10304 IF(I10264.EQ.14) GO TO 10307 GO TO 10306 10307 CONTINUE WRITE(5,10308) 10308 FORMAT(1X,'SIR, WE ARE UNDER PHASER ATTACK!') L=L+1 C GO TO 10264 C WHEN 15 THEN 10306 IF(I10264.EQ.15) GO TO 10310 GO TO 10309 10310 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(1,2,M) C GO TO 10264 C WHEN 16 THEN 10309 IF(I10264.EQ.16) GO TO 10312 GO TO 10311 10312 CONTINUE TYPE *,' SCOTT HERE CAPTAIN' TYPE *,' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' TYPE *,' FAILING ...!' CALL WAIT(1,2,M) C GO TO 10264 C WHEN 17 THEN 10311 IF(I10264.EQ.17) GO TO 10314 GO TO 10313 10314 CONTINUE TYPE *,' CAPTAIN WE ARE GOING INTO HYPERSPACE' L=L+1 C GO TO 10264 C WHEN 18 THEN 10313 IF(I10264.EQ.18) GO TO 10316 GO TO 10315 10316 CONTINUE TYPE *,' HYPERSPACE JUMP BLOCKED SIR .' L=L+1 GO TO 10264 C WHEN 19 THEN 10315 IF(I10264.EQ.19) GO TO 10318 GO TO 10317 10318 CONTINUE TYPE *,' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' L=L+1 GO TO 10264 C WHEN 20 THEN 10317 IF(I10264.EQ.20) GO TO 10320 GO TO 10319 10320 CONTINUE TYPE *,' TORPEDO HIT ON TORPEDO SIR !.' L=L+1 GO TO 10264 C WHEN 21 THEN 10319 IF(I10264.EQ.21) GO TO 10322 GO TO 10321 10322 CONTINUE TYPE *,' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' L=L+1 C GO TO 10264 C WHEN 22 THEN 10321 IF(I10264.EQ.22) GO TO 10324 GO TO 10323 10324 CONTINUE TYPE *,' SULU HERE SKIPPER, THE ALIEN VESSEL HAS BEEN DESTROYED' TYPE *,' ***********************************************' L=L+2 C GO TO 10264 C WHEN 23 THEN 10323 IF(I10264.EQ.23) GO TO 10326 GO TO 10325 10326 CONTINUE TYPE *,' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' L=L+1 C GO TO 10264 C WHEN 24 THEN 10325 IF(I10264.EQ.24) GO TO 10328 GO TO 10327 10328 CONTINUE TYPE *,' ANTI-MATTER POD HAS BEEN DESTROYED' L=L+1 C GO TO 10264 C WHEN 25 THEN 10327 IF(I10264.EQ.25) GO TO 10330 GO TO 10329 10330 CONTINUE TYPE *,' PHASER HIT ON ANTI-MATTER POD, SIR!' L=L+1 C GO TO 10264 C WHEN 26 THEN 10329 IF(I10264.EQ.26) GO TO 10332 GO TO 10331 10332 CONTINUE TYPE *,' TORPEDO HIT ON ANTI-MATTER POD, SIR!' L=L+1 C GO TO 10264 C WHEN 27 THEN 10331 IF(I10264.EQ.27) GO TO 10334 GO TO 10333 10334 CONTINUE TYPE *,' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' L=L+1 C GO TO 10264 C WHEN 28 THEN 10333 IF(I10264.EQ.28) GO TO 10336 GO TO 10335 10336 CONTINUE TYPE *,' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' L=L+1 C GO TO 10264 C WHEN 29 THEN 10335 IF(I10264.EQ.29) GO TO 10338 GO TO 10337 10338 CONTINUE TYPE *,' ** ANTI-MATTER POD DETONATED SIR **' L=L+1 C GO TO 10264 C WHEN 30 THEN 10337 IF(I10264.EQ.30) GO TO 10340 GO TO 10339 10340 CONTINUE WRITE(5,10341) 10341 FORMAT(1H ,'SIR, WE ARE CAUGHT IN AN ANTI-MATTER E $XPLOSION!') L=L+1 C GO TO 10264 C WHEN 31 THEN 10339 IF(I10264.EQ.31) GO TO 10343 GO TO 10342 10343 CONTINUE WRITE(5,10344) 10344 FORMAT(' IIEEEEEE!') L=L+1 C GO TO 10264 C WHEN 32 THEN 10342 IF(I10264.EQ.32) GO TO 10346 GO TO 10345 10346 CONTINUE WRITE(5,10347) 10347 FORMAT(' ** ANTI-MATTER HIT ON ALIEN VESSEL SIR !' $) L=L+1 C C OTHERWISE GO TO 10264 10345 CONTINUE CONTINUE C END SELECT 10348 CONTINUE 10264 CONTINUE ISENT(WHO,I)=0 C END IF 10255 CONTINUE C END DO GO TO 10252 10253 CONTINUE C IF MESSAG(WHO*60-59) .NE. ' ' THEN IF(MESSAG(WHO*60-59) .NE. ' ' ) GO TO 10351 GO TO 10349 10351 CONTINUE CALL CPOS(L) WRITE(5,10352) 10352 FORMAT(' CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADI $O') WRITE(5,10353) MESSAG(WHO*60-59) 10353 FORMAT(' FREQUENCY ',A1,' ***') C WRITE(5,10354) (MESSAG(I),I=WHO*60-58,WHO*60) 10354 FORMAT(10X,60A1) CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) CALL WAIT(1,2,M) C END IF 10349 CONTINUE C IF (ENERGY(WHO) .LT. 900.) .AND. WARN THEN IF((ENERGY(WHO) .LT. 900.) .AND. WARN ) GO TO 10357 GO TO 10355 10357 CONTINUE CALL CPOS(L) TYPE *,' SCOTT HERE CAPTAIN,' TYPE *,' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' WARN=.FALSE. GO TO 10356 C ELSE 10355 CONTINUE WARN=.TRUE. C END IF 10356 CONTINUE C END DO GO TO 10021 10022 CONTINUE STOP END SUBROUTINE TREAD(STRING,NC,LUN) DIMENSION ISTAT(2),IPRM(3) BYTE STRING DATA IRVB/O10620/ DATA IEF/11/ C CALL GETADR(IPRM,STRING) IPRM(2)=NC IPRM(3)=0 C CALL WTQIO(IRVB,LUN,IEF,,ISTAT,IPRM) C NC=ISTAT(2) C IF (NC.EQ.0.AND.ISTAT(1).NE.2) STRING=' ' C RETURN END SUBROUTINE CURWRT(LINE,ICHAR,ISTR,N,LUN) C C FORTRAN CALLABLE ROUTINE TO WRITE A TEXT STRING AT A C SPECIFIED LOCATION ON A BEEHIVE 100 TERMINAL. C C CALLING SEQUENCE C C LINE = LINE ON WHICH CURSOR IS TO BE POSITIONED (1 TO 24) C CHAR = CHARACTER POSITION FOR CURSOR ON LINE. (1 TO 80) C ISTR = ARRAY OF TEXT CHARACTERS TO BE WRITTEN TO TERMINAL C N = NUMBER OF CHARACTERS IN ISTR ARRAY (1 TO 80) C LUN = LUN NUMBER WHICH IS ASSIGNED TO TERMINAL C DIMENSION ISTAT(6),IPRM(2) BYTE ISTR(1) DATA IWVB/O11010/ DATA IEF/11/ DATA IPRM,ISTAT/8*0/ CALL POSITN(LINE,ICHAR,LUN) CALL GETADR(IPRM,ISTR) IPRM(2)=N CALL WTQIO(IWVB,LUN,IEF,,ISTAT,IPRM,ISW) RETURN END SUBROUTINE CPOS(L) CALL CLEARS(17,1,5) L=17 RETURN END SUBROUTINE RBUFF(OBUFF) BYTE OBUFF(19,19) C FOR IX=1 UNTIL 19 DO IX=1 GO TO 10002 10000 IX = IX+(1) 10002 IF(IX.GT.19) GO TO 10001 C FOR IY=1 UNTIL 19 DO IY=1 GO TO 10005 10003 IY = IY+(1) 10005 IF(IY.GT.19) GO TO 10004 OBUFF(IX,IY)="0 C END DO GO TO 10003 10004 CONTINUE C END DO GO TO 10000 10001 CONTINUE CALL CLEAR C C * DRAW NEW SCREEN C CALL CURWRT(2,3,'ENERGY :',10,5) CALL CURWRT(3,3,'SHIELDS :',10,5) CALL CURWRT(5,3,'WARP :',10,5) CALL CURWRT(6,3,'HEADING :',10,5) CALL CURWRT(8,3,'X CO-ORD :',10,5) CALL CURWRT(9,3,'Y CO-ORD :',10,5) CALL CURWRT(11,3,'TORPS :',10,5) CALL CURWRT(12,3,'SEEKERS :',10,5) CALL CURWRT(13,3,'HYPER :',10,5) CALL CURWRT(5,70,'SCORES',6,5) CALL CURWRT(6,70,'------',6,5) CALL CURWRT(8,68,'1',1,5) CALL CURWRT(9,68,'2',1,5) CALL CURWRT(10,68,'3',1,5) CALL CURWRT(11,68,'4',1,5) CALL CURWRT(12,68,'5',1,5) CALL CURWRT(13,68,'6',1,5) CALL CURWRT(14,68,'7',1,5) CALL CURWRT(15,68,'8',1,5) RETURN END SUBROUTINE GETREL(V,EXIST,LOW,HIGH) C LOGICAL*1 EXIST,OK REAL V,LOW,HIGH BYTE INPUT(15),LEFTED(15) INTEGER NCHRS C EXIST=.FALSE. C FOR I=1 UNTIL 15 C DO I=1 GO TO 10002 10000 I = I+(1) 10002 IF(I.GT.15 ) GO T $O 10001 LEFTED(I)=' ' C END DO GO TO 10000 10001 CONTINUE 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 10005 IF(NCHRS .EQ. 0 ) $GO TO 10008 GO TO 10007 10008 CONTINUE EXIST=.FALSE. GO TO 10006 C WHEN NCHRS .LE. 15 THEN 10007 IF(NCHRS .LE. 15) GO TO 10010 GO TO 10009 10010 CONTINUE C * LEFT ADJUST INPUT CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) DECODE(15,10011,LEFTED,ERR=200) V 10011 FORMAT(G15.0) C IF V .GE. LOW .AND. V .LE. HIGH C THEN IF(V .GE. LOW .AND. V .LE. HIGH $ ) GO TO 10014 GO TO 10012 10014 CONTINUE EXIST=.TRUE. GO TO 10013 C ELSE 10012 CONTINUE CALL CURWRT(18,1,' ',1,5) WRITE(5,10015) 10015 FORMAT(' SORRY CAPTAIN, BUT YOUR COMMAND',1H','S PARAMETER $') WRITE(5,150) LOW,HIGH 150 FORMAT(1H ,'MUST BE BETWEEN ',F15.4,' AND ',F15.4) C END IF 10013 CONTINUE GO TO 300 200 CALL CURWRT(18,1,' ',1,5) TYPE *,'WOULD YOU PLEASE REPEAT THAT SIR ?' 300 CONTINUE C OTHERWISE GO TO 10006 10009 CONTINUE CALL CURWRT(18,1,' ',1,5) WRITE(5,10017) 10017 FORMAT(' RUN THAT BY ME AGAIN !') C END SELECT 10016 CONTINUE 10006 CONTINUE RETURN END SUBROUTINE REFRSH(SC,R,I,SBUFF,IPRM) C TEXT COMMON COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), $ SCAN(8),PHA(8),I1,I2,HYPER(8),ISENT(8,10), $ XPOD(8),YPOD(8),DPOD(8),IPOD(8),WPOD(8), $ XHOM(8,4),YHOM(8,4),WHOM(8,4),NHOM(8), $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), $ MESSAG(480),THRU,XSHIP(8),CLOAK(8) REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS LOGICAL*1 THRU,XSHIP,CLOAK BYTE UNIV,MESSAG C END TEXT REAL SC(8),R(9) INTEGER IPRM(2) BYTE SBUFF(2000) BYTE STRING(10) NOUT=0 C IF R(1) .NE. ENERGY(I) THEN IF(R(1) .NE. ENERGY(I) ) GO TO 10002 GO TO 10000 10002 CONTINUE R(1)=ENERGY(I) ENCODE(7,10003,STRING) R(1) 10003 FORMAT(F7.1) CALL BUFFIL(2,14,STRING,7,NOUT,SBUFF) C END IF 10000 CONTINUE C IF R(2) .NE. SHIELDS(I) THEN IF(R(2) .NE. SHIELDS(I) ) GO TO 10006 GO TO 10004 10006 CONTINUE R(2)=SHIELDS(I) ENCODE(7,10007,STRING) R(2) 10007 FORMAT(F7.1) CALL BUFFIL(3,14,STRING,7,NOUT,SBUFF) C END IF 10004 CONTINUE C IF R(3) .NE. WARP(I) THEN IF(R(3) .NE. WARP(I) ) GO TO 10010 GO TO 10008 10010 CONTINUE R(3)=WARP(I) ENCODE(6,10011,STRING) R(3) 10011 FORMAT(F6.2) CALL BUFFIL(5,14,STRING,6,NOUT,SBUFF) C END IF 10008 CONTINUE C IF R(4) .NE. DIR(I) THEN IF(R(4) .NE. DIR(I) ) GO TO 10014 GO TO 10012 10014 CONTINUE R(4)=DIR(I) C IF R(4) .GT. 90. THEN IF(R(4) .GT. 90. ) GO TO 10017 GO TO 10015 10017 CONTINUE V=(450.-R(4))/30. GO TO 10016 C ELSE 10015 CONTINUE V=(90.-R(4))/30. C END IF 10016 CONTINUE ENCODE(5,10018,STRING) V 10018 FORMAT(F5.2) CALL BUFFIL(6,14,STRING,5,NOUT,SBUFF) C END IF 10012 CONTINUE C IF R(5) .NE. XCORD(I) THEN IF(R(5) .NE. XCORD(I) ) GO TO 10021 GO TO 10019 10021 CONTINUE R(5)=XCORD(I) ENCODE(5,10022,STRING) R(5) 10022 FORMAT(F5.1) CALL BUFFIL(8,14,STRING,5,NOUT,SBUFF) C END IF 10019 CONTINUE C IF R(6) .NE. YCORD(I) THEN IF(R(6) .NE. YCORD(I) ) GO TO 10025 GO TO 10023 10025 CONTINUE R(6)=YCORD(I) ENCODE(5,10026,STRING) R(6) 10026 FORMAT(F5.1) CALL BUFFIL(9,14,STRING,5,NOUT,SBUFF) C END IF 10023 CONTINUE IR=R(7) C IF IR .NE. TORPS(I) THEN IF(IR .NE. TORPS(I) ) GO TO 10029 GO TO 10027 10029 CONTINUE R(7)=TORPS(I) ENCODE(3,10030,STRING) TORPS(I) 10030 FORMAT(I3) CALL BUFFIL(11,14,STRING,3,NOUT,SBUFF) C END IF 10027 CONTINUE IR=R(8) C IF IR .NE. NHOM(I) THEN IF(IR .NE. NHOM(I) ) GO TO 10033 GO TO 10031 10033 CONTINUE R(8)=NHOM(I) ENCODE(3,10034,STRING) NHOM(I) 10034 FORMAT(I3) CALL BUFFIL(12,14,STRING,3,NOUT,SBUFF) C END IF 10031 CONTINUE IR=R(9) C IF IR .NE. HYPER(I) THEN IF(IR .NE. HYPER(I) ) GO TO 10037 GO TO 10035 10037 CONTINUE R(9)=HYPER(I) ENCODE(1,10038,STRING) HYPER(I) 10038 FORMAT(I1) CALL BUFFIL(13,14,STRING,1,NOUT,SBUFF) C END IF 10035 CONTINUE C FOR J=1 UNTIL 8 DO J=1 GO TO 10041 10039 J = J+(1) 10041 IF(J.GT.8) GO TO 10040 C IF SC(J) .NE. SCORE(J) THEN IF(SC(J) .NE. SCORE(J) ) GO TO 10044 GO TO 10042 10044 CONTINUE SC(J)=SCORE(J) ENCODE(8,10045,STRING) SC(J) 10045 FORMAT(F8.0) CALL BUFFIL(J+7,70,STRING,8,NOUT,SBUFF) C END IF 10042 CONTINUE C END DO GO TO 10039 10040 CONTINUE C IF NOUT .GT. 0 THEN IF(NOUT .GT. 0 ) GO TO 10048 GO TO 10046 10048 CONTINUE IPRM(2)=NOUT CALL WTQIO("410,5,1,,,IPRM) C END IF 10046 CONTINUE RETURN END SUBROUTINE BUFFIL(IY,IX,ST,L,N,BUFF) COMMON/CURSOR/ESCPOS,IOFSET BYTE ST(L),BUFF(2000) BYTE ESCPOS(2) C BUFF(N+1)=ESCPOS(1) BUFF(N+2)=ESCPOS(2) BUFF(N+3)=IY+IOFSET+1 BUFF(N+4)=IX+IOFSET+1 CALL STRMOV(ST,1,L,BUFF,N+5) N=N+4+L RETURN END SUBROUTINE GETINT(N,FLAG,LOW,HIGH) INTEGER N,LOW,HIGH LOGICAL*1 OK,FLAG C FLAG=.FALSE. READ(5,10000,END=800,ERR=200) NCHRS,N 10000 FORMAT(Q,I5) GOTO 810 800 CLOSE(UNIT=5) 810 CONTINUE C IF NCHRS .EQ. 0 THEN IF(NCHRS .EQ. 0 ) GO TO 10003 GO TO 10001 10003 CONTINUE FLAG=.FALSE. GO TO 10002 C ELSE 10001 CONTINUE C IF (N .GE. LOW) .AND. (N .LE. HIGH) THEN IF((N .GE. LOW) .AND. (N .LE. HIGH) ) GO TO 10006 GO TO 10004 10006 CONTINUE FLAG=.TRUE. GO TO 10005 C ELSE 10004 CONTINUE CALL CURWRT(18,1,' ',1,5) WRITE(5,10007) 10007 FORMAT(' WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS') WRITE(5,10008) LOW,HIGH 10008 FORMAT(' BETWEEN ',I5,' AND ',I5) CALL CURWRT(18,1,' ',1,5) WRITE(5,10009) 10009 FORMAT(1H$,' TRY AGAIN :') C END IF 10005 CONTINUE GOTO 300 200 CALL CURWRT(18,1,' ',1,5) WRITE(5,100) 100 FORMAT(1H$,' TRY AGAIN BOZO :') 300 CONTINUE C END IF 10002 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 CALL CURWRT(18,1,' ',1,5) 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