PROGRAM PLAYER 00001 COMMON /DFILE/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 00002 $ PHA(8),I1,I2,HYPER(8),ISENT(8,10), 00003 $ XPOD(8),YPOD(8),DPOD(8),IPOD(8), 00003 $ SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 00003 $ MESSAG(480),THRU,XSHIP(8),CLOAK(8),SCAN(8) 00003 REAL LAUNCH 00003 INTEGER CREW,HYPER,TORPS 00004 LOGICAL*1 XSHIP,CLOAK,SCAN 00005 BYTE THRU,UNIV,MESSAG 00006 LOGICAL*1 OK,DONE,YES,WARN,RESET 00007 BYTE BLANK(80),COMMND 00008 DIMENSION IPRM(2),JPRM(2) 00009 COMMON/INBUF/INBUF(50),IOST(2) 00010 EQUIVALENCE (INBUF,COMMND) 00011 BYTE IBUF(1000) 00012 REAL*8 DUMMY(44) 00013 EQUIVALENCE (NEWBUF,DUMMY) 00014 BYTE OLDBUF(21,17),NEWBUF(22,17),OLDREP(11,8),NEWREP(11,8) 00015 BYTE OLDSCR(7,8),NEWSCR(7,8) 00016 INTEGER WHO 00017 BYTE ESCPOS(2) 00018 DATA ESCPOS/"33,"131/ 00019 DATA IOFSET/"40/ 00020 DATA IAST/0/ 00021 DATA RESET/.TRUE./ 00022 DATA BLANK/80*' '/ 00023 DATA OK/.FALSE./ 00024 CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) 00025 WRITE(1,*)' WELCOME TO MULTI-TREK' 00026 GO TO 32757 00027 32758 IF(OK) GO TO 32756 00027 32757 WRITE(1,*) ' THE FOLLOWING VESSELS ARE AVAILABLE FOR USE.' 00029 DO 32755 I=1,8 00030 IF(.NOT.(.NOT. XSHIP(I))) GO TO 32754 00031 WRITE(1,*)' SHIP ',I 00032 32754 CONTINUE 00033 32755 CONTINUE 00033 WRITE(1,1201) 00035 1201 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND :') 00036 CALL GETINT(WHO,OK,1,8) 00037 IF(.NOT.(XSHIP(WHO))) GO TO 32752 00038 WRITE(1,*)' THIS SHIP ALREADY HAS A COMMANDER' 00039 WRITE(1,1002) 00040 1002 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND ?') 00041 CALL YESNO(OK) 00042 GO TO 32753 00043 32752 SCORE(WHO)=0. 00044 32753 GO TO 32758 00045 32756 XSHIP(WHO)=.TRUE. 00046 CREW(WHO)=CREW(WHO)+1 00047 DIR(WHO)=90. 00048 WARP(WHO)=0. 00049 IF(.NOT.( THRU.GT.0 )) GO TO 32750 00050 THRU=THRU+1 00051 GO TO 32751 00052 32750 THRU=1 00053 32751 CALL RDAST(IAST) 00054 CALL GETADR(IPRM,IBUF) 00055 GO TO 32748 00056 32749 IF(DONE) GO TO 32747 00056 32748 IF(.NOT.(IAST.NE.0)) GO TO 32746 00058 CALL GETLIN(IOST(2),INBUF) 00059 IF(IOST(2).EQ.0)COMMND=' ' 00060 32746 IX1=XCORD(WHO)-10. 00061 IF( IX1 .LT. 1)IX1=1 00062 IX2=XCORD(WHO)+10. 00063 IF (IX2 .GT. 100)IX2=100 00064 IY1=YCORD(WHO)-8. 00065 IF (IY1 .LT. 1) IY1=1 00066 IY2=YCORD(WHO)+8. 00067 IF (IY2 .GT. 100) IY2=100 00068 DO 32745 ID=1,44 00069 DUMMY(ID)=' ' 00069 32745 CONTINUE 00069 IBY=0 00072 DO 32744 IY=IY2,IY1,-1 00073 IBY=IBY+1 00074 IBX=1 00075 DO 32743 IX=IX1,IX2 00076 NEWBUF(IBX,IBY)=UNIV(IX,IY) 00077 K=NEWBUF(IBX,IBY) 00078 IF(.NOT.((K.GE.49).AND.(K.LE.56).AND.CLOAK(K-48) )) GO TO 32742 00079 NEWBUF(IBX,IBY)=46 00080 32742 IBX=IBX+1 00081 32743 CONTINUE 00082 10 CONTINUE 00083 32744 CONTINUE 00084 IBX=IBX-1 00085 IF(.NOT.( DIR(WHO).GT.90. )) GO TO 32740 00086 VALUE=(450.-DIR(WHO))/30. 00087 GO TO 32741 00088 32740 VALUE=(90.-DIR(WHO))/30. 00089 32741 IF(.NOT.(VALUE.EQ.0.)) GO TO 32739 00090 VALUE=0. 00091 32739 ENCODE(88,101,NEWREP) VALUE,WARP(WHO),ENERGY(WHO), 00092 + SHIELD(WHO),HYPER(WHO),TORPS(WHO),CREW(WHO),THRU 00093 101 FORMAT(F5.2,6X, F4.2,7X, G11.5, G11.5, I1,10X, I2,9X, I3,8X, 00093 + I3,8X) 00094 ENCODE(56,102,NEWSCR) SCORE 00094 102 FORMAT(8F7.0) 00095 IF(.NOT.( RESET)) GO TO 32737 00096 CALL CLEAR 00097 CALL WRITE(1,6,'COORDINATES') 00098 CALL WRITE(4,3,'HEADING :') 00099 CALL WRITE(5,6,'WARP :') 00100 CALL WRITE(6,4,'ENERGY :') 00101 CALL WRITE(7,3,'SHIELDS :') 00102 CALL WRITE(8,1,'HYPER SET :') 00103 CALL WRITE(9,1,'TORPEDOES :') 00104 CALL WRITE(10,1,'CREW SIZE :') 00105 CALL WRITE(11,3,'PLAYERS :') 00106 CALL WRITE(1,67,'SHIP SCORES') 00107 DO 32736 IY=1,IBY 00108 ENCODE(42,103,IBUF) (NEWBUF(IX,IY),IX=1,IBX) 00109 103 FORMAT(21(A1,1X)) 00110 CALL WRITE(IY,24,IBUF,41) 00111 32736 CONTINUE 00112 DO 32735 IX=1,21 00113 DO 32734 IY=1,17 00114 OLDBUF(IX,IY)=NEWBUF(IX,IY) 00115 32734 CONTINUE 00116 32735 CONTINUE 00117 DO 32733 IY=1,8 00118 ENCODE(11,104,IBUF) (NEWREP(IX,IY),IX=1,11) 00119 104 FORMAT(11A1) 00120 CALL WRITE(IY+3,12,IBUF,11) 00121 ENCODE(7,105,IBUF) (NEWSCR(IX,IY),IX=1,7) 00122 105 FORMAT(7A1) 00123 CALL WRITE(IY+5,72,IBUF,7) 00124 CALL WRITE(IY+5,69,IY+"60) 00125 DO 32732 IX=1,11 00126 OLDREP(IX,IY)=NEWREP(IX,IY) 00127 32732 CONTINUE 00128 DO 32731 IX=1,7 00129 OLDSCR(IX,IY)=NEWSCR(IX,IY) 00130 32731 CONTINUE 00131 32733 CONTINUE 00132 RESET=.FALSE. 00133 GO TO 32738 00134 32737 KBUF=1 00135 DO 32730 IY=1,17 00136 DO 32729 IX=1,21 00137 IF(.NOT.( NEWBUF(IX,IY).NE.OLDBUF(IX,IY) )) GO TO 32728 00138 KX=2*(IX-1)+24+IOFSET 00139 KY=IY+IOFSET 00140 IBUF(KBUF)=ESCPOS(1) 00141 IBUF(KBUF+1)=ESCPOS(2) 00142 IBUF(KBUF+2)=KY 00143 IBUF(KBUF+3)=KX 00144 IBUF(KBUF+4)=NEWBUF(IX,IY) 00145 KBUF=KBUF+5 00146 OLDBUF(IX,IY)=NEWBUF(IX,IY) 00147 32728 CONTINUE 00148 32729 CONTINUE 00148 32730 CONTINUE 00150 DO 32727 IY=1,8 00151 DO 32726 IX=1,11 00152 IF(.NOT.( OLDREP(IX,IY).NE.NEWREP(IX,IY) )) GO TO 32725 00153 KX=IX+11+IOFSET 00154 KY=IY+3+IOFSET 00155 IBUF(KBUF)=ESCPOS(1) 00156 IBUF(KBUF+1)=ESCPOS(2) 00157 IBUF(KBUF+2)=KY 00158 IBUF(KBUF+3)=KX 00159 IBUF(KBUF+4)=NEWREP(IX,IY) 00160 KBUF=KBUF+5 00161 OLDREP(IX,IY)=NEWREP(IX,IY) 00162 32725 CONTINUE 00163 32726 CONTINUE 00163 DO 32724 IX=1,7 00165 IF(.NOT.( OLDSCR(IX,IY).NE.NEWSCR(IX,IY) )) GO TO 32723 00166 KX=IX+71+IOFSET 00167 KY=IY+5+IOFSET 00168 IBUF(KBUF)=ESCPOS(1) 00169 IBUF(KBUF+1)=ESCPOS(2) 00170 IBUF(KBUF+2)=KY 00171 IBUF(KBUF+3)=KX 00172 IBUF(KBUF+4)=NEWSCR(IX,IY) 00173 KBUF=KBUF+5 00174 OLDSCR(IX,IY)=NEWSCR(IX,IY) 00175 32723 CONTINUE 00176 32724 CONTINUE 00176 32727 CONTINUE 00178 KBUF=KBUF-1 00179 IF(.NOT.( KBUF.GT.1 )) GO TO 32722 00180 IPRM(2)=KBUF 00181 CALL WTQIO("410,1,1,,,IPRM) 00182 32722 CONTINUE 00183 32738 ENCODE(16,106,IBUF) XCORD(WHO),YCORD(WHO) 00184 106 FORMAT('X:',F5.1,' Y:',F5.1) 00185 CALL WRITE(2,4,IBUF,16) 00186 IF(.NOT.( COMMND.NE.0 )) GO TO 32721 00187 CALL CLEARS(17,1) 00188 IF(('C').NE.(COMMND)) GO TO 32719 00189 IF(.NOT.(IOST(2).EQ.1)) GO TO 32717 00190 WRITE(1,1004) 00191 1004 FORMAT('$COURSE, SIR ?') 00192 CALL GETREL(VALUE,OK,0.,12.) 00193 GO TO 32718 00194 32717 CALL GETRLL(VALUE,OK,0.,12.) 00195 32718 IF(.NOT.(OK)) GO TO 32716 00196 IF(.NOT.(VALUE .GE. 3.)) GO TO 32714 00197 DIR(WHO)=(15.-VALUE)*30. 00198 GO TO 32715 00199 32714 DIR(WHO)=(3.-VALUE)*30. 00200 32715 CONTINUE 00201 32716 GO TO 32720 00202 32719 IF(('H').NE.(COMMND)) GO TO 32713 00202 IF(.NOT.( IOST(2).EQ.1)) GO TO 32711 00204 WRITE(1,1005) 00205 1005 FORMAT('$NEW HYPERSPACE JUMP SETTING ? ') 00206 CALL GETINT(II,OK,1,6) 00207 GO TO 32712 00208 32711 CALL GETINL(II,OK,1,6) 00209 32712 IF (OK) HYPER(WHO)=II 00210 GO TO 32720 00211 32713 IF((' ').NE.(COMMND)) GO TO 32710 00211 WRITE(1,100) 00213 100 FORMAT(' A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAGE',T51, 00214 1 'T FIRE TORPEDOES'/' C COURSE HEADING',T30,'P FIRE PHASERS', 00215 2 T51,'W SET WARP SPEED'/' F FADE (CLOAKING ON)',T30, 00215 3 'Q QUIT',T51,'X DETONATE ANTI-MATTER'/ 00215 4 ' H HYPERSPACE SETTING',T30,'R RESET DISPLAY',T51, 00215 5 'Z LAUNCH ANTI-MATTER'/' L LOCATE SHIP',T30, 00215 6 'S SHIELD CHANGE',T51,' DISPLAY HELP MESSAGE') 00215 GO TO 32720 00215 32710 IF(('Q').NE.(COMMND)) GO TO 32709 00215 IF(.NOT.( IOST(2).EQ.1)) GO TO 32707 00217 WRITE(1,*) ' YOUR CURRENT SCORE IS ',SCORE(WHO) 00218 WRITE(1,1007) 00219 1007 FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ? ') 00220 CALL YESNO(DONE) 00221 GO TO 32708 00222 32707 CALL YESNOL(DONE) 00223 32708 IF(.NOT.(DONE)) GO TO 32706 00224 CREW(WHO)=CREW(WHO)-1 00225 IF(.NOT.(CREW(WHO) .EQ. 400)) GO TO 32705 00226 XSHIP(WHO)=.FALSE. 00227 32705 CONTINUE 00228 32706 GO TO 32720 00229 32709 IF(('R').NE.(COMMND)) GO TO 32704 00229 RESET=.TRUE. 00231 GO TO 32720 00232 32704 IF(('S').NE.(COMMND)) GO TO 32703 00232 IF(.NOT.( IOST(2).EQ.1)) GO TO 32701 00234 WRITE(1,1006) 00235 1006 FORMAT('$ENGINEERING TO BRIDGE, HOW MUCH ENERGY SIR ? ') 00236 CALL GETREL(VALUE,OK,-1.E36,1.E36) 00237 GO TO 32702 00238 32701 CALL GETRLL(VALUE,OK,-1.E36,1.E36) 00239 32702 IF(.NOT.(OK)) GO TO 32700 00240 IF(.NOT.(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE .GE. 0. 00241 1)) GO TO 32698 00241 ENERGY(WHO)=ENERGY(WHO)-VALUE 00242 SHIELD(WHO)=SHIELD(WHO)+VALUE 00243 GO TO 32699 00244 32698 WRITE(1,*)' I AM SORRY CAPTAIN, BUT THAT IS IMPOSSIBLE.' 00245 32699 CONTINUE 00246 32700 GO TO 32720 00247 32703 IF(('T').NE.(COMMND)) GO TO 32697 00247 IF(.NOT.(LAUNCH(WHO) .LT. 0.)) GO TO 32695 00249 IF(.NOT.(TORPS(WHO) .GT. 0)) GO TO 32693 00250 IF(.NOT.(IOST(2).EQ.1)) GO TO 32691 00251 WRITE(1,1008) 00252 1008 FORMAT('$PHOTON TORPEDO READY, COURSE ?') 00253 CALL GETREL(VALUE,OK,0.,12.) 00254 GO TO 32692 00255 32691 CALL GETRLL(VALUE,OK,0.,12.) 00256 32692 IF(.NOT.(OK)) GO TO 32689 00257 IF(.NOT.(VALUE .GE. 3.)) GO TO 32687 00258 VALUE=(15.-VALUE)*30. 00259 GO TO 32688 00260 32687 VALUE=(3.-VALUE)*30. 00261 32688 GO TO 32690 00262 32689 VALUE=DIR(WHO) 00263 32690 LAUNCH(WHO)=VALUE 00264 TORPS(WHO)=TORPS(WHO)-1 00265 IF(.NOT.(TORPS(WHO) .EQ. 0)) GO TO 32686 00266 WRITE(1,1009) 00267 1009 FORMAT('$TORPEDO ROOM TO BRIDGE. LAST TORPEDO, SIR.') 00268 32686 WRITE(1,*)' TORPEDO LAUNCHED, HEADING ',VALUE,' DEGREES.' 00269 GO TO 32694 00270 32693 WRITE(1,*)' SO SORRY CAPTAIN, BUT WE ARE OUT OF TORPEDOES' 00271 32694 GO TO 32696 00272 32695 WRITE(1,*)' TORPEDO TUBES ARE NOT READY YET CAPTAIN !' 00273 32696 GO TO 32720 00274 32697 IF(('P').NE.(COMMND)) GO TO 32685 00274 IF(.NOT.(PHA(WHO) .LT. 0.)) GO TO 32683 00276 IF(.NOT.(IOST(2).EQ.1)) GO TO 32681 00277 WRITE(1,1010) 00278 1010 FORMAT('$PHASER CONTROL READY. COURSE ?') 00279 CALL GETREL(VALUE,OK,0.,12.) 00280 GO TO 32682 00281 32681 CALL GETRLL(VALUE,OK,0.,12.) 00282 32682 IF(.NOT.(OK)) GO TO 32679 00283 IF(.NOT.(VALUE .GE. 3.)) GO TO 32677 00284 VALUE=(15.-VALUE)*30. 00285 GO TO 32678 00286 32677 VALUE=(3.-VALUE)*30. 00287 32678 GO TO 32680 00288 32679 VALUE=DIR(WHO) 00289 32680 PHA(WHO)=VALUE 00290 ENERGY(WHO)=ENERGY(WHO)-50. 00291 WRITE(1,*)' PHASERS FIRED CAPTAIN' 00292 GO TO 32684 00293 32683 WRITE(1,*)' PHASER CONTROL TO BRIDGE, PHASERS ARE NOT READY YET.' 00294 32684 GO TO 32720 00295 32685 IF(('L').NE.(COMMND)) GO TO 32676 00295 IF(.NOT.(IOST(2).EQ.1)) GO TO 32674 00297 WRITE(1,*)' SPOCK HERE CAPTAIN.' 00298 WRITE(1,1011) 00299 1011 FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ? ') 00300 CALL GETINT(II,OK,1,8) 00301 GO TO 32675 00302 32674 CALL GETINL(II,OK,1,8) 00303 32675 IF(.NOT.(OK)) GO TO 32673 00304 SCAN(II)=.TRUE. 00305 IX=XCORD(II)/10. 00306 IY=YCORD(II)/10. 00307 WRITE(1,*)' SCANNERS REPORT LIFE FORMS IN SECTOR ',IX,',',IY 00308 X=IX*10 00309 Y=IY*10 00310 D=ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180./3.14159 00311 IF(.NOT.(D .GT. 90.)) GO TO 32671 00312 D=(450.-D)/30. 00313 GO TO 32672 00314 32671 D=(90.-D)/30. 00315 32672 WRITE(1,*)' I APPROXIMATE A COURSE OF ',D,' SHOULD TAKE' 00316 WRITE(1,*)' US TO THE CENTER OF THAT SECTOR.' 00317 32673 GO TO 32720 00318 32676 IF(('M').NE.(COMMND)) GO TO 32670 00318 IF(.NOT.(IOST(2).EQ.1)) GO TO 32668 00320 WRITE(1,1012) 00321 1012 FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDING ? ') 00322 CALL GETINT(IVAL,OK,1,8) 00323 GO TO 32669 00324 32668 CALL GETINL(IVAL,OK,1,8) 00325 32669 IF(.NOT.(.NOT. OK)) GO TO 32667 00326 IVAL=WHO 00327 32667 WRITE(1,1013) 00328 1013 FORMAT('$MESSAGE CAPTAIN ? ') 00329 READ(1,300,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 00330 300 FORMAT(60A1) 00331 GOTO 13 00332 12 CLOSE(UNIT=1) 00333 13 CONTINUE 00334 ENERGY(WHO)=ENERGY(WHO)-10. 00335 ENCODE(1,107,COMMND) WHO 00336 107 FORMAT(I1) 00337 CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) 00338 GO TO 32720 00339 32670 IF(('F').NE.(COMMND)) GO TO 32666 00339 IF(.NOT.(.NOT. CLOAK(WHO))) GO TO 32664 00341 CLOAK(WHO)=.TRUE. 00342 WRITE(1,*)' SPOCK HERE CAPTAIN. CLOAKING DEVICE COMING ON NOW!' 00343 WRITE(1,*)' WE ARE FADING OUT.....' 00344 GO TO 32665 00345 32664 WRITE(1,*)' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!' 00346 32665 GO TO 32720 00347 32666 IF(('A').NE.(COMMND)) GO TO 32663 00347 IF(.NOT.(CLOAK(WHO))) GO TO 32661 00349 CLOAK(WHO)=.FALSE. 00350 WRITE(1,*)' SPOCK HERE CAPTAIN. CLOAKING DEVICE DEACTIVATED.' 00351 WRITE(1,*)' WE ARE NOW VISIBLE.....' 00352 GO TO 32662 00353 32661 WRITE(1,*)' BUT CAPTAIN WE ARE NOT CLOAKED !' 00354 32662 GO TO 32720 00355 32663 IF(('W').NE.(COMMND)) GO TO 32660 00355 IF(.NOT.( IOST(2).EQ.1)) GO TO 32658 00357 WRITE(1,1003) 00358 1003 FORMAT('$WARP FACTOR, SIR ?') 00359 CALL GETREL(WARP(WHO),OK,0.,8.) 00360 GO TO 32659 00361 32658 CALL GETRLL(WARP(WHO),OK,0.,8.) 00362 32659 IF (.NOT. OK)WARP(WHO)=0. 00363 GO TO 32720 00364 32660 IF(('X').NE.(COMMND)) GO TO 32657 00364 IF(.NOT.(IPOD(WHO) .EQ. 2)) GO TO 32655 00366 IPOD(WHO)=3 00367 WRITE(1,*)' ANTI-MATTER DETONATION SIGNALED, SIR!' 00368 GO TO 32656 00369 32655 WRITE(1,*)' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER DEVICE' 00370 32656 GO TO 32720 00371 32657 IF(('Z').NE.(COMMND)) GO TO 32654 00371 IF(.NOT.(IPOD(WHO) .EQ. 0)) GO TO 32652 00373 IF(.NOT.(IOST(2).EQ.1)) GO TO 32650 00374 WRITE(1,1014) 00375 1014 FORMAT('$ANTI MATTER DEVICE READY SIR, COURSE ? ') 00376 CALL GETREL(VALUE,OK,0.,12.) 00377 GO TO 32651 00378 32650 CALL GETRLL(VALUE,OK,0.,12.) 00379 32651 IF(.NOT.(OK)) GO TO 32648 00380 IF(.NOT.(VALUE .GE. 3.)) GO TO 32646 00381 DPOD(WHO)=(15.-VALUE)*30. 00382 GO TO 32647 00383 32646 DPOD(WHO)=(3.-VALUE)*30. 00384 32647 GO TO 32649 00385 32648 DPOD(WHO)=DIR(WHO) 00386 32649 IPOD(WHO)=1 00387 GO TO 32653 00388 32652 WRITE(1,*)' SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MATTER PODS' 00389 32653 GO TO 32720 00390 32654 WRITE(1,*)' I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND THAT.' 00391 32720 COMMND=0 00392 32721 CALL POSITN(18,1) 00393 IF(.NOT.(ISENT(WHO,1).NE.0)) GO TO 32645 00394 DO 32644 I=1,10 00395 IF((1).NE.(ISENT(WHO,I))) GO TO 32642 00396 WRITE(1,*)' WE ARE NOW DOCKED CAPTAIN.' 00396 GO TO 32643 00398 32642 IF((2).NE.(ISENT(WHO,I))) GO TO 32641 00398 WRITE(1,*)' ** CAPTAIN ! WE HIT A STAR! **' 00398 GO TO 32643 00401 32641 IF((3).NE.(ISENT(WHO,I))) GO TO 32640 00401 DO 32639 IK=1,3 00403 CALL CLEAR 00404 WRITE(1,99) 00405 99 FORMAT( ////////////,25X,'*** BOOM ***') 00406 32639 CONTINUE 00407 WRITE(1,*)' YOU',1H','RE SHIP HAS BEEN DESTROYED' 00408 WRITE(1,*)' FORTUNATELY YOU ESCAPED WITH YOUR LIFE.' 00409 WRITE(1,*)' UNFORTUNATELY, YOU HAVE BEEN GIVEN A NEW COMMAND.' 00410 WRITE(1,1015) 00411 1015 FORMAT('$ARE YOU READY TO ACCEPT THIS ASSIGNMENT ?') 00412 CALL YESNO(YES) 00413 IF(.NOT.(YES )) GO TO 32637 00414 WRITE(1,*)' GOOD!' 00415 GO TO 32638 00416 32637 WRITE(1,*)' TOUGH LUCK, BUT YOU GET IT ANYWAY.' 00417 32638 XSHIP(WHO)=.TRUE. 00418 RESET=.TRUE. 00419 GO TO 32643 00420 32640 IF((4).NE.(ISENT(WHO,I))) GO TO 32636 00420 WRITE(1,*) ' CAPTAIN WE HAVE BEEN HIT BY A PHOTON TORPEDO' 00422 GO TO 32643 00423 32636 IF((5).NE.(ISENT(WHO,I))) GO TO 32635 00423 WRITE(1,*)' * TORPEDO HIT ALIEN SHIP, SIR. *' 00423 GO TO 32643 00426 32635 IF((6).NE.(ISENT(WHO,I))) GO TO 32634 00426 WRITE(1,*)' * PHASER HIT ON ALIEN VESSEL, SIR *' 00426 GO TO 32643 00429 32634 IF((7).NE.(ISENT(WHO,I))) GO TO 32633 00429 WRITE(1,*)' PHASER HIT ON TORPEDO, SIR' 00429 GO TO 32643 00432 32633 IF((8).NE.(ISENT(WHO,I))) GO TO 32632 00432 WRITE(1,*)' PHASER MISSED' 00432 GO TO 32643 00435 32632 IF((9).NE.(ISENT(WHO,I))) GO TO 32631 00435 WRITE(1,*) ' ** SIR! WE HAVE RAMMED AN ALIEN VESSEL **' 00437 GO TO 32643 00438 32631 IF((10).NE.(ISENT(WHO,I))) GO TO 32630 00438 WRITE(1,*) ' * SIR! WE HAVE COLLIDED WITH AN ALIEN VESSEL *' 00440 GO TO 32643 00441 32630 IF((11).NE.(ISENT(WHO,I))) GO TO 32629 00441 WRITE(1,*)' PHASER HIT ON STAR SIR' 00441 GO TO 32643 00444 32629 IF((12).NE.(ISENT(WHO,I))) GO TO 32628 00444 WRITE(1,*)' BASE REPORTS THEY ARE BEING ATTACKED SIR.' 00444 GO TO 32643 00447 32628 IF((13).NE.(ISENT(WHO,I))) GO TO 32627 00447 WRITE(1,*)' TORPEDO HIT ON STAR SIR' 00447 GO TO 32643 00450 32627 IF((14).NE.(ISENT(WHO,I))) GO TO 32626 00450 WRITE(1,*) ' SIR, WE ARE UNDER PHASER ATTACK!' 00452 GO TO 32643 00453 32626 IF((15).NE.(ISENT(WHO,I))) GO TO 32625 00453 WRITE(1,*)' SPOCK HERE CAPTAIN.' 00455 WRITE(1,*)' WE ARE BEING DRAWN INTO SOME SORT OF BLACK HOLE,' 00456 WRITE(1,*)' IT IS UNLIKE ANYTHING I HAVE EVER ENCOUNTERED.' 00457 WRITE(1,*)' FASCINATING.' 00458 CALL WAIT(2,2,M) 00459 GO TO 32643 00460 32625 IF((16).NE.(ISENT(WHO,I))) GO TO 32624 00460 WRITE(1,*)' SCOTT HERE CAPTAIN' 00462 WRITE(1,*)' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' 00463 WRITE(1,*)' FAILING ...!' 00464 CALL WAIT(2,2,M) 00465 GO TO 32643 00466 32624 IF((17).NE.(ISENT(WHO,I))) GO TO 32623 00466 WRITE(1,*)' CAPTAIN WE ARE GOING INTO HYPERSPACE' 00466 GO TO 32643 00469 32623 IF((18).NE.(ISENT(WHO,I))) GO TO 32622 00469 WRITE(1,*)' HYPERSPACE JUMP BLOCKED SIR .' 00469 GO TO 32643 00472 32622 IF((19).NE.(ISENT(WHO,I))) GO TO 32621 00472 WRITE(1,*)' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' 00472 GO TO 32643 00475 32621 IF((20).NE.(ISENT(WHO,I))) GO TO 32620 00475 WRITE(1,*)' TORPEDO HIT ON TORPEDO SIR !.' 00475 GO TO 32643 00478 32620 IF((21).NE.(ISENT(WHO,I))) GO TO 32619 00478 WRITE(1,*)' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' 00478 GO TO 32643 00481 32619 IF((22).NE.(ISENT(WHO,I))) GO TO 32618 00481 WRITE(1,*)' SULU HERE CAPTAIN,' 00483 WRITE(1,*)' THE ALIEN VESSEL HAS BEEN DESTROYED' 00484 GO TO 32643 00485 32618 IF((23).NE.(ISENT(WHO,I))) GO TO 32617 00485 WRITE(1,*)' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' 00485 GO TO 32643 00488 32617 IF((24).NE.(ISENT(WHO,I))) GO TO 32616 00488 WRITE(1,*)' ANTI-MATTER POD HAS BEEN DESTROYED' 00488 GO TO 32643 00491 32616 IF((25).NE.(ISENT(WHO,I))) GO TO 32615 00491 WRITE(1,*)' PHASER HIT ON ANTI-MATTER POD, SIR!' 00491 GO TO 32643 00494 32615 IF((26).NE.(ISENT(WHO,I))) GO TO 32614 00494 WRITE(1,*)' TORPEDO HIT ON ANTI-MATTER POD, SIR!' 00494 GO TO 32643 00497 32614 IF((27).NE.(ISENT(WHO,I))) GO TO 32613 00497 WRITE(1,*)' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' 00497 GO TO 32643 00500 32613 IF((28).NE.(ISENT(WHO,I))) GO TO 32612 00500 WRITE(1,*)' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' 00500 GO TO 32643 00503 32612 IF((29).NE.(ISENT(WHO,I))) GO TO 32611 00503 WRITE(1,*)' ** ANTI-MATTER POD DETONATED SIR **' 00503 GO TO 32643 00506 32611 IF((30).NE.(ISENT(WHO,I))) GO TO 32610 00506 WRITE(1,*) ' SIR, WE ARE CAUGHT IN AN ANTI-MATTER EXPLOSION!' 00508 CALL WAIT(2,2,M) 00509 GO TO 32643 00510 32610 IF((31).NE.(ISENT(WHO,I))) GO TO 32609 00510 WRITE(1,*)' IIEEEEEE!' 00512 GO TO 32643 00513 32609 CONTINUE 00514 32643 ISENT(WHO,I)=0 00515 32644 CONTINUE 00516 32645 IF(.NOT.(SCAN(WHO))) GO TO 32608 00517 CALL CLEARS(17,1) 00518 WRITE(1,*) ' CAPTAIN, I AM PICKING UP A STRANGE SIGNAL,' 00519 WRITE(1,*) ' I BELIEVE WE ARE BEING SCANNED BY AN ALIEN' 00520 SCAN(WHO)=.FALSE. 00521 32608 IF(.NOT.(MESSAG(WHO*60-59) .NE. ' ')) GO TO 32607 00522 CALL CLEARS(17,1) 00523 WRITE(1,*)' CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADIO' 00524 WRITE(1,1000) MESSAG(WHO*60-59) 00525 1000 FORMAT(' FREQUENCY ',A1,' ***') 00526 WRITE(1,1001) (MESSAG(I),I=WHO*60-58,WHO*60) 00527 1001 FORMAT(10X,60A1) 00528 CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) 00529 CALL WAIT(2,2,M) 00530 32607 IF(.NOT.((ENERGY(WHO) .LT. 900.) .AND. WARN )) GO TO 32605 00531 CALL CLEARS(17,1) 00532 WRITE(1,*)' SCOTT HERE CAPTAIN,' 00533 WRITE(1,*)' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' 00534 WARN=.FALSE. 00535 GO TO 32606 00536 32605 WARN=.TRUE. 00537 32606 CALL WAIT(30,0,M) 00538 GO TO 32749 00539 32747 THRU=THRU-1 00540 CALL CLEAR 00541 STOP 00542 END 00543 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 00001 COMMON/INBUF/INBUF(50),IOST(2) 00002 LOGICAL*1 EXIST,OK 00003 REAL VARI,LOW,HIGH 00004 BYTE INPUT(15),LEFTED(15) 00005 INTEGER NCHRS 00006 IFLAG=0 00007 GO TO 10 00008 ENTRY GETRLL 00009 IFLAG=1 00010 10 CONTINUE 00011 OK=.FALSE. 00012 GO TO 32757 00013 32758 IF(OK) GO TO 32756 00013 32757 DO 32755 I=1,15 00015 LEFTED(I)=' ' 00016 32755 CONTINUE 00017 IF(.NOT.(IFLAG.EQ.0)) GO TO 32753 00018 READ(1,100,END=800) NCHRS,(INPUT(I),I=1,15) 00019 100 FORMAT(Q,15A1) 00020 GOTO 810 00021 800 CLOSE(UNIT=1) 00022 810 CONTINUE 00023 GO TO 32754 00024 32753 NCHRS=IOST(2)-2 00025 DECODE(17,2100,INBUF(2)) INPUT 00026 2100 FORMAT(15A1) 00027 IFLAG=0 00028 32754 IF(.NOT.(NCHRS .EQ. 0)) GO TO 32751 00029 OK=.TRUE. 00030 EXIST=.FALSE. 00031 GO TO 32752 00032 32751 IF(.NOT.(NCHRS .LE. 15)) GO TO 32750 00032 CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) 00034 DECODE(15,101,LEFTED,ERR=200) VARI 00035 101 FORMAT(G15.0) 00036 IF(.NOT.(VARI .GE. LOW .AND. VARI .LE. HIGH)) GO TO 32748 00037 OK=.TRUE. 00038 EXIST=.TRUE. 00039 GO TO 32749 00040 32748 WRITE(1,*)' SORRY CAPTAIN, BUT YOUR COMMAND''S PARAMETER MUST' 00041 WRITE(1,*) ' BE BETWEEN ',LOW,' AND ',HIGH 00042 32749 GO TO 300 00043 200 CONTINUE 00044 WRITE(1,1016) 00045 1016 FORMAT('$WOULD YOU PLEASE REPEAT THAT SIR ? ') 00046 300 CONTINUE 00047 GO TO 32752 00048 32750 WRITE(1,1017) 00049 1017 FORMAT('$RUN THAT BY ME AGAIN ! ') 00050 32752 GO TO 32758 00051 32756 RETURN 00052 END 00053 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 00001 INTEGER NUM,LOW,HIGH 00002 COMMON/INBUF/INBUF(50),IOST(2) 00003 LOGICAL*1 OK,FLAG 00004 IFLAG=0 00005 GO TO 10 00006 ENTRY GETINL 00007 IFLAG=1 00008 10 CONTINUE 00009 OK=.FALSE. 00010 GO TO 32757 00011 32758 IF(OK) GO TO 32756 00011 32757 IF(.NOT.( IFLAG.EQ.0 )) GO TO 32754 00013 READ(1,102,END=800,ERR=200) NCHRS,NUM 00014 102 FORMAT(Q,I5) 00015 GOTO 810 00016 800 CLOSE(UNIT=1) 00017 810 CONTINUE 00018 GO TO 32755 00019 32754 NCHRS=IOST(2)-2 00020 DECODE(7,103,INBUF(2)) NUM 00021 103 FORMAT(I) 00022 IFLAG=0 00023 32755 IF(.NOT.( NCHRS .EQ. 0 )) GO TO 32752 00024 FLAG=.FALSE. 00025 OK=.TRUE. 00026 GO TO 32753 00027 32752 IF(.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GO TO 32750 00028 OK=.TRUE. 00029 FLAG=.TRUE. 00030 GO TO 32751 00031 32750 WRITE(1,*)' WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS' 00032 WRITE(1,1018)LOW,HIGH 00033 1018 FORMAT( '$BETWEEN',F8.2,' AND ',F8.2,'TRY AGAIN : ') 00034 32751 GOTO 300 00035 200 CONTINUE 00036 WRITE(1,1019) 00037 1019 FORMAT('$TRY AGAIN BOZO : ') 00038 300 CONTINUE 00039 32753 GO TO 32758 00040 32756 RETURN 00041 END 00042 SUBROUTINE YESNO(FLAG) 00001 COMMON/INBUF/INBUF(50),IOST(2) 00002 LOGICAL*1 FLAG,OK 00003 BYTE YES(4),NO(4) 00004 BYTE ANSWER(4) 00005 DATA YES/'Y','E','S',' '/ 00006 DATA NO/'N','O',' ',' '/ 00007 IFLAG=O 00008 GO TO 10 00009 ENTRY YESNOL 00010 IFLAG=1 00011 10 CONTINUE 00012 OK=.FALSE. 00013 GO TO 32757 00014 32758 IF(OK ) GO TO 32756 00014 32757 IF(.NOT.(IFLAG.EQ.0)) GO TO 32754 00016 READ(1,104,END=800) NCHRS, (ANSWER(I),I=1,4) 00017 104 FORMAT(Q,4A1) 00018 GOTO 810 00019 800 CLOSE(UNIT=1) 00020 810 CONTINUE 00021 GO TO 32755 00022 32754 NCHRS=IOST(2)-2 00023 DECODE(6,105,INBUF(2)) ANSWER 00024 105 FORMAT(2X,4A1) 00025 IFLAG=0 00026 32755 IF(.NOT.((NCHRS .GT. 4) .OR. (NCHRS .LT. 1))) GO TO 32753 00027 NCHRS=4 00028 32753 I=KOMSTR(YES,1,NCHRS,ANSWER,1) 00029 IF(.NOT.( I .EQ. 0 )) GO TO 32751 00030 FLAG=.TRUE. 00031 OK=.TRUE. 00032 GO TO 32752 00033 32751 I=KOMSTR(NO,1,NCHRS,ANSWER,1) 00034 IF(.NOT.( I .EQ. 0 )) GO TO 32749 00035 FLAG=.FALSE. 00036 OK=.TRUE. 00037 GO TO 32750 00038 32749 WRITE(1,*)' ** PLEASE ANSWER "YES" OR "NO" **' 00039 WRITE(1,1020) 00040 1020 FORMAT('$ANSWER ? ') 00041 32750 CONTINUE 00042 32752 GO TO 32758 00043 32756 RETURN 00044 END 00045