(FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00001 ---------------------------------------- C CHANGED TO USE THE FLECS STRUCTURED FORTRAN BY M.R. BROWN C TARLUG 27-OCT-79 C 00001 PROGRAM PLAYER 00002 COMMON /DFILE/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 00003 $ 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 00004 INTEGER CREW,HYPER,TORPS 00005 LOGICAL*1 XSHIP,CLOAK,SCAN 00006 BYTE THRU,UNIV,MESSAG 00007 LOGICAL*1 OK,DONE,YES,WARN,RESET 00008 BYTE BLANK(80),COMMND 00009 DIMENSION IPRM(2),JPRM(2) 00010 COMMON/INBUF/INBUF(50),IOST(2) 00011 EQUIVALENCE (INBUF,COMMND) 00012 BYTE IBUF(1000) C THE NEXT TWO LINES ARE TO IMPROVE SPEED BY REDUCING THE NUMBER OF C LOOPS TO RESET EWBUF FROM 21X17 TO 44 00013 REAL*8 DUMMY(44) 00014 EQUIVALENCE (NEWBUF,DUMMY) 00015 BYTE OLDBUF(21,17),NEWBUF(22,17),OLDREP(11,8),NEWREP(11,8) 00016 BYTE OLDSCR(7,8),NEWSCR(7,8) 00017 INTEGER WHO 00018 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 C CHANGED TO VT52 M.R. BROWN 27-OCT-79 00019 DATA ESCPOS/"33,"131/ 00020 DATA IOFSET/"40/ C C*********************************************************************** C 00021 DATA IAST/0/ 00022 DATA RESET/.TRUE./ 00023 DATA BLANK/80*' '/ 00024 DATA OK/.FALSE./ C 00025 CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) 00026 WRITE(1,*)' WELCOME TO MULTI-TREK' 00027 REPEAT UNTIL (OK) 00029 . WRITE(1,*) ' THE FOLLOWING VESSELS ARE AVAILABLE FOR USE.' 00030 . DO(I=1,8) 00031 . . IF (.NOT. XSHIP(I)) 00032 . . . WRITE(1,*)' SHIP ',I 00033 . . ...FIN 00033 . ...FIN 00035 . WRITE(1,1201) 00036 1201 . FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND :') 00037 . CALL GETINT(WHO,OK,1,8) (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00002 00038 . WHEN(XSHIP(WHO)) 00039 . . WRITE(1,*)' THIS SHIP ALREADY HAS A COMMANDER' 00040 . . WRITE(1,1002) 00041 1002 . . FORMAT('$DO YOU WISH TO SHARE THIS COMMAND ?') 00042 . . CALL YESNO(OK) 00043 . ...FIN 00044 . ELSE 00044 . . SCORE(WHO)=0. 00045 . ...FIN 00045 ...FIN 00046 XSHIP(WHO)=.TRUE. 00047 CREW(WHO)=CREW(WHO)+1 00048 DIR(WHO)=90. 00049 WARP(WHO)=0. C C INCREMENT PLAYER COUNT 00050 WHEN( THRU.GT.0 ) 00051 . THRU=THRU+1 00052 ...FIN 00053 ELSE 00053 . THRU=1 00054 ...FIN C C SET UP TERMINAL INPUT/OUTPUT PARAMETERS 00054 CALL RDAST(IAST) 00055 CALL GETADR(IPRM,IBUF) C CALL GETADR(JPRM,INBUF(2)) C JPRM(2)=49 C 00056 REPEAT UNTIL (DONE) C . C . CHECK FOR INPUTS C . 00058 . IF(IAST.NE.0) C . . INBUF(1)=ICHAR() C . . WHEN(INBUF(1).LE.26)IOST(2)=0 C . . ELSE C . . CALL WTQIO("1020,1,1,,IOST,JPRM) C . . IOST(2)=IOST(2)+1 C . . FIN C . . WHEN( IOST(1).EQ.-10) C . . CLOSE (UNIT=1) C . . COMMND=0 C . . FIN C . . ELSE C . . IF (IOST(2).EQ.0 ) C . . COMMND=' ' C . . FIN C . . FIN C . . IAST=0 C . . IAST=IAST-1 00059 . . CALL GETLIN(IOST(2),INBUF) 00060 . . IF(IOST(2).EQ.0)COMMND=' ' 00061 . ...FIN C . C . C . GENERATE NEW DISPLAY 00061 . IX1=XCORD(WHO)-10. 00062 . IF( IX1 .LT. 1)IX1=1 00063 . IX2=XCORD(WHO)+10. 00064 . IF (IX2 .GT. 100)IX2=100 00065 . IY1=YCORD(WHO)-8. (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00003 00066 . IF (IY1 .LT. 1) IY1=1 00067 . IY2=YCORD(WHO)+8. 00068 . IF (IY2 .GT. 100) IY2=100 C . C . DO(IX=1,21) C . DO(IY=1,17) C . NEWBUF(IX,IY)=' ' C . FIN C . FIN C . C . THE ABOVE LOOPS ARE REPLACE BY THE FOLLOWING: MRB C . 00069 . DO (ID=1,44) DUMMY(ID)=' ' C . 00072 . IBY=0 00073 . DO(IY=IY2,IY1,-1) 00074 . . IBY=IBY+1 00075 . . IBX=1 00076 . . DO(IX=IX1,IX2) 00077 . . . NEWBUF(IBX,IBY)=UNIV(IX,IY) 00078 . . . K=NEWBUF(IBX,IBY) 00079 . . . IF ((K.GE.49).AND.(K.LE.56).AND.CLOAK(K-48) ) 00080 . . . . NEWBUF(IBX,IBY)=46 00081 . . . ...FIN 00081 . . . IBX=IBX+1 00082 . . ...FIN 00083 10 . . CONTINUE 00084 . ...FIN 00085 . IBX=IBX-1 C . C . GENERATE REPORT C . 00086 . WHEN( DIR(WHO).GT.90. ) 00087 . . VALUE=(450.-DIR(WHO))/30. 00088 . ...FIN 00089 . ELSE 00089 . . VALUE=(90.-DIR(WHO))/30. 00090 . ...FIN 00090 . IF (VALUE.EQ.0.) 00091 . . VALUE=0. 00092 . ...FIN 00092 . ENCODE(88,101,NEWREP) VALUE,WARP(WHO),ENERGY(WHO), 00093 +. 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, 00094 +. I3,8X) C . C . GENERATE SCORES 00094 . ENCODE(56,102,NEWSCR) SCORE 00095 102 . FORMAT(8F7.0) C . C . C . C . DISPLAY TITLES, LABELS,ETC. 00096 . WHEN( RESET) 00097 . . CALL CLEAR 00098 . . CALL WRITE(1,6,'COORDINATES') 00099 . . CALL WRITE(4,3,'HEADING :') 00100 . . CALL WRITE(5,6,'WARP :') 00101 . . CALL WRITE(6,4,'ENERGY :') 00102 . . CALL WRITE(7,3,'SHIELDS :') 00103 . . CALL WRITE(8,1,'HYPER SET :') 00104 . . CALL WRITE(9,1,'TORPEDOES :') (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00004 00105 . . CALL WRITE(10,1,'CREW SIZE :') 00106 . . CALL WRITE(11,3,'PLAYERS :') 00107 . . CALL WRITE(1,67,'SHIP SCORES') 00108 . . DO(IY=1,IBY ) 00109 . . . ENCODE(42,103,IBUF) (NEWBUF(IX,IY),IX=1,IBX) 00110 103 . . . FORMAT(21(A1,1X)) 00111 . . . CALL WRITE(IY,24,IBUF,41) 00112 . . ...FIN C . . C . . SET OLD = NEW C . . 00113 . . DO(IX=1,21) 00114 . . . DO(IY=1,17) 00115 . . . . OLDBUF(IX,IY)=NEWBUF(IX,IY) 00116 . . . ...FIN 00117 . . ...FIN 00118 . . DO(IY=1,8 ) 00119 . . . ENCODE(11,104,IBUF) (NEWREP(IX,IY),IX=1,11) 00120 104 . . . FORMAT(11A1) 00121 . . . CALL WRITE(IY+3,12,IBUF,11) 00122 . . . ENCODE(7,105,IBUF) (NEWSCR(IX,IY),IX=1,7) 00123 105 . . . FORMAT(7A1) 00124 . . . CALL WRITE(IY+5,72,IBUF,7) 00125 . . . CALL WRITE(IY+5,69,IY+"60) 00126 . . . DO(IX=1,11) 00127 . . . . OLDREP(IX,IY)=NEWREP(IX,IY) 00128 . . . ...FIN 00129 . . . DO(IX=1,7) 00130 . . . . OLDSCR(IX,IY)=NEWSCR(IX,IY) 00131 . . . ...FIN 00132 . . ...FIN 00133 . . RESET=.FALSE. 00134 . ...FIN 00135 . ELSE C . . C . . COMPARE DISPLAYS 00135 . . KBUF=1 00136 . . DO(IY=1,17) 00137 . . . DO(IX=1,21) 00138 . . . . IF( NEWBUF(IX,IY).NE.OLDBUF(IX,IY) ) 00139 . . . . . KX=2*(IX-1)+24+IOFSET 00140 . . . . . KY=IY+IOFSET 00141 . . . . . IBUF(KBUF)=ESCPOS(1) 00142 . . . . . IBUF(KBUF+1)=ESCPOS(2) 00143 . . . . . IBUF(KBUF+2)=KY 00144 . . . . . IBUF(KBUF+3)=KX 00145 . . . . . IBUF(KBUF+4)=NEWBUF(IX,IY) 00146 . . . . . KBUF=KBUF+5 00147 . . . . . OLDBUF(IX,IY)=NEWBUF(IX,IY) 00148 . . . . ...FIN 00148 . . . ...FIN 00150 . . ...FIN C . . C . . COMPARE REPORTS 00151 . . DO(IY=1,8) 00152 . . . DO(IX=1,11 ) 00153 . . . . IF ( OLDREP(IX,IY).NE.NEWREP(IX,IY) ) 00154 . . . . . KX=IX+11+IOFSET 00155 . . . . . KY=IY+3+IOFSET 00156 . . . . . IBUF(KBUF)=ESCPOS(1) 00157 . . . . . IBUF(KBUF+1)=ESCPOS(2) 00158 . . . . . IBUF(KBUF+2)=KY (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00005 00159 . . . . . IBUF(KBUF+3)=KX 00160 . . . . . IBUF(KBUF+4)=NEWREP(IX,IY) 00161 . . . . . KBUF=KBUF+5 00162 . . . . . OLDREP(IX,IY)=NEWREP(IX,IY) 00163 . . . . ...FIN 00163 . . . ...FIN C . . . C . . . COMPARE SCORES 00165 . . . DO(IX=1,7 ) 00166 . . . . IF ( OLDSCR(IX,IY).NE.NEWSCR(IX,IY) ) 00167 . . . . . KX=IX+71+IOFSET 00168 . . . . . KY=IY+5+IOFSET 00169 . . . . . IBUF(KBUF)=ESCPOS(1) 00170 . . . . . IBUF(KBUF+1)=ESCPOS(2) 00171 . . . . . IBUF(KBUF+2)=KY 00172 . . . . . IBUF(KBUF+3)=KX 00173 . . . . . IBUF(KBUF+4)=NEWSCR(IX,IY) 00174 . . . . . KBUF=KBUF+5 00175 . . . . . OLDSCR(IX,IY)=NEWSCR(IX,IY) 00176 . . . . ...FIN 00176 . . . ...FIN 00178 . . ...FIN C . . C . . UPDATE DISPLAY IF CHANGED C . . 00179 . . KBUF=KBUF-1 00180 . . IF ( KBUF.GT.1 ) 00181 . . . IPRM(2)=KBUF 00182 . . . CALL WTQIO("410,1,1,,,IPRM) 00183 . . ...FIN 00183 . ...FIN C . C . UPDATE COORDINATES C . 00184 . ENCODE(16,106,IBUF) XCORD(WHO),YCORD(WHO) 00185 106 . FORMAT('X:',F5.1,' Y:',F5.1) 00186 . CALL WRITE(2,4,IBUF,16) C . 00187 . IF( COMMND.NE.0 ) C . . CLEAR THE BOTTOM OF THE SCREEN 00188 . . CALL CLEARS(17,1) C . . 00189 . . SELECT(COMMND) C . . . C . . . COURSE COMMAND C . . . 00189 . . . ('C') 00190 . . . . WHEN(IOST(2).EQ.1) 00191 . . . . . WRITE(1,1004) 00192 1004 . . . . . FORMAT('$COURSE, SIR ?') 00193 . . . . . CALL GETREL(VALUE,OK,0.,12.) 00194 . . . . ...FIN 00195 . . . . ELSE 00195 . . . . . CALL GETRLL(VALUE,OK,0.,12.) 00196 . . . . ...FIN 00196 . . . . IF (OK) 00197 . . . . . WHEN(VALUE .GE. 3.) 00198 . . . . . . DIR(WHO)=(15.-VALUE)*30. 00199 . . . . . ...FIN 00200 . . . . . ELSE 00200 . . . . . . DIR(WHO)=(3.-VALUE)*30. 00201 . . . . . ...FIN (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00006 00201 . . . . ...FIN 00202 . . . ...FIN C . . . C . . . HYPERSPACE COMMAND C . . . 00202 . . . ('H') 00204 . . . . WHEN( IOST(2).EQ.1) 00205 . . . . . WRITE(1,1005) 00206 1005 . . . . . FORMAT('$NEW HYPERSPACE JUMP SETTING ? ') 00207 . . . . . CALL GETINT(II,OK,1,6) 00208 . . . . ...FIN 00209 . . . . ELSE 00209 . . . . . CALL GETINL(II,OK,1,6) 00210 . . . . ...FIN 00210 . . . . IF (OK) HYPER(WHO)=II 00211 . . . ...FIN C . . . C . . . HELP COMMAND C . . . 00211 . . . (' ') 00213 . . . . WRITE(1,100) 00214 100 . . . . FORMAT(' A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAGE',T51, 00215 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 . . . ...FIN C . . . C . . . QUIT COMMAND C . . . 00215 . . . ('Q') 00217 . . . . WHEN( IOST(2).EQ.1) 00218 . . . . . WRITE(1,*) ' YOUR CURRENT SCORE IS ',SCORE(WHO) 00219 . . . . . WRITE(1,1007) 00220 1007 . . . . . FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ? ') 00221 . . . . . CALL YESNO(DONE) 00222 . . . . ...FIN 00223 . . . . ELSE 00223 . . . . . CALL YESNOL(DONE) 00224 . . . . ...FIN 00224 . . . . IF (DONE) 00225 . . . . . CREW(WHO)=CREW(WHO)-1 00226 . . . . . IF (CREW(WHO) .EQ. 400) 00227 . . . . . . XSHIP(WHO)=.FALSE. 00228 . . . . . ...FIN 00228 . . . . ...FIN 00229 . . . ...FIN C . . . C . . . RESET COMMAND C . . . 00229 . . . ('R') 00231 . . . . RESET=.TRUE. 00232 . . . ...FIN C . . . C . . . SHIELD COMMAND C . . . 00232 . . . ('S') 00234 . . . . WHEN( IOST(2).EQ.1) 00235 . . . . . WRITE(1,1006) 00236 1006 . . . . . FORMAT('$ENGINEERING TO BRIDGE, HOW MUCH ENERGY SIR ? ') (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00007 00237 . . . . . CALL GETREL(VALUE,OK,-1.E36,1.E36) 00238 . . . . ...FIN 00239 . . . . ELSE 00239 . . . . . CALL GETRLL(VALUE,OK,-1.E36,1.E36) 00240 . . . . ...FIN 00240 . . . . IF (OK) 00241 . . . . . WHEN(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE .GE. 0.) 00242 . . . . . . ENERGY(WHO)=ENERGY(WHO)-VALUE 00243 . . . . . . SHIELD(WHO)=SHIELD(WHO)+VALUE 00244 . . . . . ...FIN 00245 . . . . . ELSE 00245 . . . . . . WRITE(1,*)' I AM SORRY CAPTAIN, BUT THAT IS IMPOSSIBLE.' 00246 . . . . . ...FIN 00246 . . . . ...FIN 00247 . . . ...FIN C . . . C . . . TORPEDO COMMAND C . . . 00247 . . . ('T') 00249 . . . . WHEN(LAUNCH(WHO) .LT. 0.) 00250 . . . . . WHEN(TORPS(WHO) .GT. 0) 00251 . . . . . . WHEN(IOST(2).EQ.1) 00252 . . . . . . . WRITE(1,1008) 00253 1008 . . . . . . . FORMAT('$PHOTON TORPEDO READY, COURSE ?') 00254 . . . . . . . CALL GETREL(VALUE,OK,0.,12.) 00255 . . . . . . ...FIN 00256 . . . . . . ELSE 00256 . . . . . . . CALL GETRLL(VALUE,OK,0.,12.) 00257 . . . . . . ...FIN 00257 . . . . . . WHEN (OK) 00258 . . . . . . . WHEN(VALUE .GE. 3.) 00259 . . . . . . . . VALUE=(15.-VALUE)*30. 00260 . . . . . . . ...FIN 00261 . . . . . . . ELSE 00261 . . . . . . . . VALUE=(3.-VALUE)*30. 00262 . . . . . . . ...FIN 00262 . . . . . . ...FIN 00263 . . . . . . ELSE 00263 . . . . . . . VALUE=DIR(WHO) 00264 . . . . . . ...FIN 00264 . . . . . . LAUNCH(WHO)=VALUE 00265 . . . . . . TORPS(WHO)=TORPS(WHO)-1 00266 . . . . . . IF(TORPS(WHO) .EQ. 0) 00267 . . . . . . . WRITE(1,1009) 00268 1009 . . . . . . . FORMAT('$TORPEDO ROOM TO BRIDGE. LAST TORPEDO, SIR.') 00269 . . . . . . ...FIN 00269 . . . . . . WRITE(1,*)' TORPEDO LAUNCHED, HEADING ',VALUE,' DEGREES.' 00270 . . . . . ...FIN 00271 . . . . . ELSE 00271 . . . . . . WRITE(1,*)' SO SORRY CAPTAIN, BUT WE ARE OUT OF TORPEDOES' 00272 . . . . . ...FIN 00272 . . . . ...FIN 00273 . . . . ELSE 00273 . . . . . WRITE(1,*)' TORPEDO TUBES ARE NOT READY YET CAPTAIN !' 00274 . . . . ...FIN 00274 . . . ...FIN C . . . C . . . C . . . PHASER COMMAND C . . . 00274 . . . ('P') 00276 . . . . WHEN (PHA(WHO) .LT. 0.) (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00008 00277 . . . . . WHEN(IOST(2).EQ.1) 00278 . . . . . . WRITE(1,1010) 00279 1010 . . . . . . FORMAT('$PHASER CONTROL READY. COURSE ?') 00280 . . . . . . CALL GETREL(VALUE,OK,0.,12.) 00281 . . . . . ...FIN 00282 . . . . . ELSE 00282 . . . . . . CALL GETRLL(VALUE,OK,0.,12.) 00283 . . . . . ...FIN 00283 . . . . . WHEN(OK) 00284 . . . . . . WHEN(VALUE .GE. 3.) 00285 . . . . . . . VALUE=(15.-VALUE)*30. 00286 . . . . . . ...FIN 00287 . . . . . . ELSE 00287 . . . . . . . VALUE=(3.-VALUE)*30. 00288 . . . . . . ...FIN 00288 . . . . . ...FIN 00289 . . . . . ELSE 00289 . . . . . . VALUE=DIR(WHO) 00290 . . . . . ...FIN 00290 . . . . . PHA(WHO)=VALUE 00291 . . . . . ENERGY(WHO)=ENERGY(WHO)-50. 00292 . . . . . WRITE(1,*)' PHASERS FIRED CAPTAIN' 00293 . . . . ...FIN 00294 . . . . ELSE 00294 . . . . . WRITE(1,*)' PHASER CONTROL TO BRIDGE, PHASERS ARE NOT READY YET.' 00295 . . . . ...FIN 00295 . . . ...FIN C . . . C . . . LONG RANGE SCAN COMMAND C . . . 00295 . . . ('L') 00297 . . . . WHEN(IOST(2).EQ.1) 00298 . . . . . WRITE(1,*)' SPOCK HERE CAPTAIN.' 00299 . . . . . WRITE(1,1011) 00300 1011 . . . . . FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ? ') 00301 . . . . . CALL GETINT(II,OK,1,8) 00302 . . . . ...FIN 00303 . . . . ELSE 00303 . . . . . CALL GETINL(II,OK,1,8) 00304 . . . . ...FIN 00304 . . . . IF (OK) 00305 . . . . . SCAN(II)=.TRUE. 00306 . . . . . IX=XCORD(II)/10. 00307 . . . . . IY=YCORD(II)/10. 00308 . . . . . WRITE(1,*)' SCANNERS REPORT LIFE FORMS IN SECTOR ',IX,',',IY 00309 . . . . . X=IX*10 00310 . . . . . Y=IY*10 00311 . . . . . D=ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180./3.14159 00312 . . . . . WHEN(D .GT. 90.) 00313 . . . . . . D=(450.-D)/30. 00314 . . . . . ...FIN 00315 . . . . . ELSE 00315 . . . . . . D=(90.-D)/30. 00316 . . . . . ...FIN 00316 . . . . . WRITE(1,*)' I APPROXIMATE A COURSE OF ',D,' SHOULD TAKE' 00317 . . . . . WRITE(1,*)' US TO THE CENTER OF THAT SECTOR.' 00318 . . . . ...FIN 00318 . . . ...FIN C . . . C . . . MESSAGE COMMAND C . . . 00318 . . . ('M') (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00009 00320 . . . . WHEN(IOST(2).EQ.1) 00321 . . . . . WRITE(1,1012) 00322 1012 . . . . . FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDING ? ') 00323 . . . . . CALL GETINT(IVAL,OK,1,8) 00324 . . . . ...FIN 00325 . . . . ELSE 00325 . . . . . CALL GETINL(IVAL,OK,1,8) 00326 . . . . ...FIN 00326 . . . . IF (.NOT. OK) 00327 . . . . . IVAL=WHO 00328 . . . . ...FIN 00328 . . . . WRITE(1,1013) 00329 1013 . . . . FORMAT('$MESSAGE CAPTAIN ? ') 00330 . . . . READ(1,300,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 00331 300 . . . . FORMAT(60A1) 00332 . . . . GOTO 13 00333 12 . . . . CLOSE(UNIT=1) 00334 13 . . . . CONTINUE 00335 . . . . ENERGY(WHO)=ENERGY(WHO)-10. 00336 . . . . ENCODE(1,107,COMMND) WHO 00337 107 . . . . FORMAT(I1) 00338 . . . . CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) 00339 . . . ...FIN C . . . C . . . CLOAKING COMMAND C . . . 00339 . . . ('F') 00341 . . . . WHEN(.NOT. CLOAK(WHO)) 00342 . . . . . CLOAK(WHO)=.TRUE. 00343 . . . . . WRITE(1,*)' SPOCK HERE CAPTAIN. CLOAKING DEVICE COMING ON NOW!' 00344 . . . . . WRITE(1,*)' WE ARE FADING OUT.....' 00345 . . . . ...FIN 00346 . . . . ELSE 00346 . . . . . WRITE(1,*)' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!' 00347 . . . . ...FIN 00347 . . . ...FIN C . . . 00347 . . . ('A') 00349 . . . . WHEN(CLOAK(WHO)) 00350 . . . . . CLOAK(WHO)=.FALSE. 00351 . . . . . WRITE(1,*)' SPOCK HERE CAPTAIN. CLOAKING DEVICE DEACTIVATED.' 00352 . . . . . WRITE(1,*)' WE ARE NOW VISIBLE.....' 00353 . . . . ...FIN 00354 . . . . ELSE 00354 . . . . . WRITE(1,*)' BUT CAPTAIN WE ARE NOT CLOAKED !' 00355 . . . . ...FIN 00355 . . . ...FIN C . . . C . . . WARP FACTOR COMMAND C . . . 00355 . . . ('W') 00357 . . . . WHEN( IOST(2).EQ.1) 00358 . . . . . WRITE(1,1003) 00359 1003 . . . . . FORMAT('$WARP FACTOR, SIR ?') 00360 . . . . . CALL GETREL(WARP(WHO),OK,0.,8.) 00361 . . . . ...FIN 00362 . . . . ELSE 00362 . . . . . CALL GETRLL(WARP(WHO),OK,0.,8.) 00363 . . . . ...FIN 00363 . . . . IF (.NOT. OK)WARP(WHO)=0. 00364 . . . ...FIN C . . . (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00010 C . . . C . . . EXPLODE ANTI-MATTER DEVICE C . . . 00364 . . . ('X') 00366 . . . . WHEN(IPOD(WHO) .EQ. 2) 00367 . . . . . IPOD(WHO)=3 00368 . . . . . WRITE(1,*)' ANTI-MATTER DETONATION SIGNALED, SIR!' 00369 . . . . ...FIN 00370 . . . . ELSE 00370 . . . . . WRITE(1,*)' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER DEVICE' 00371 . . . . ...FIN 00371 . . . ...FIN C . . . C . . . LAUNCH ANTI-MATTER DEVICE C . . . 00371 . . . ('Z') 00373 . . . . WHEN(IPOD(WHO) .EQ. 0) 00374 . . . . . WHEN(IOST(2).EQ.1) 00375 . . . . . . WRITE(1,1014) 00376 1014 . . . . . . FORMAT('$ANTI MATTER DEVICE READY SIR, COURSE ? ') 00377 . . . . . . CALL GETREL(VALUE,OK,0.,12.) 00378 . . . . . ...FIN 00379 . . . . . ELSE 00379 . . . . . . CALL GETRLL(VALUE,OK,0.,12.) 00380 . . . . . ...FIN 00380 . . . . . WHEN(OK) 00381 . . . . . . WHEN(VALUE .GE. 3.) 00382 . . . . . . . DPOD(WHO)=(15.-VALUE)*30. 00383 . . . . . . ...FIN 00384 . . . . . . ELSE 00384 . . . . . . . DPOD(WHO)=(3.-VALUE)*30. 00385 . . . . . . ...FIN 00385 . . . . . ...FIN 00386 . . . . . ELSE 00386 . . . . . . DPOD(WHO)=DIR(WHO) 00387 . . . . . ...FIN 00387 . . . . . IPOD(WHO)=1 00388 . . . . ...FIN 00389 . . . . ELSE 00389 . . . . . WRITE(1,*)' SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MATTER PODS' 00390 . . . . ...FIN 00390 . . . ...FIN 00390 . . . (OTHERWISE) 00391 . . . . WRITE(1,*)' I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND THAT.' 00392 . . . ...FIN 00392 . . ...FIN 00392 . . COMMND=0 00393 . ...FIN C . C . * WRITE OUT MESSAGES FROM DRIVER C . 00393 . CALL POSITN(18,1) 00394 . IF (ISENT(WHO,1).NE.0) 00395 . . DO(I=1,10) 00396 . . . SELECT(ISENT(WHO,I)) 00396 . . . . (1) WRITE(1,*)' WE ARE NOW DOCKED CAPTAIN.' 00398 . . . . (2) WRITE(1,*)' ** CAPTAIN ! WE HIT A STAR! **' 00401 . . . . (3) 00403 . . . . . DO(IK=1,3) 00404 . . . . . . CALL CLEAR 00405 . . . . . . WRITE(1,99) 00406 99 . . . . . . FORMAT( ////////////,25X,'*** BOOM ***') (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00011 00407 . . . . . ...FIN 00408 . . . . . WRITE(1,*)' YOU',1H','RE SHIP HAS BEEN DESTROYED' 00409 . . . . . WRITE(1,*)' FORTUNATELY YOU ESCAPED WITH YOUR LIFE.' 00410 . . . . . WRITE(1,*)' UNFORTUNATELY, YOU HAVE BEEN GIVEN A NEW COMMAND.' 00411 . . . . . WRITE(1,1015) 00412 1015 . . . . . FORMAT('$ARE YOU READY TO ACCEPT THIS ASSIGNMENT ?') 00413 . . . . . CALL YESNO(YES) 00414 . . . . . WHEN(YES ) 00415 . . . . . . WRITE(1,*)' GOOD!' 00416 . . . . . ...FIN 00417 . . . . . ELSE 00417 . . . . . . WRITE(1,*)' TOUGH LUCK, BUT YOU GET IT ANYWAY.' 00418 . . . . . ...FIN 00418 . . . . . XSHIP(WHO)=.TRUE. 00419 . . . . . RESET=.TRUE. 00420 . . . . ...FIN 00420 . . . . (4) 00422 . . . . . WRITE(1,*) ' CAPTAIN WE HAVE BEEN HIT BY A PHOTON TORPEDO' 00423 . . . . ...FIN 00423 . . . . (5) WRITE(1,*)' * TORPEDO HIT ALIEN SHIP, SIR. *' 00426 . . . . (6) WRITE(1,*)' * PHASER HIT ON ALIEN VESSEL, SIR *' 00429 . . . . (7) WRITE(1,*)' PHASER HIT ON TORPEDO, SIR' 00432 . . . . (8) WRITE(1,*)' PHASER MISSED' 00435 . . . . (9) 00437 . . . . . WRITE(1,*) ' ** SIR! WE HAVE RAMMED AN ALIEN VESSEL **' 00438 . . . . ...FIN 00438 . . . . (10) 00440 . . . . . WRITE(1,*) ' * SIR! WE HAVE COLLIDED WITH AN ALIEN VESSEL *' 00441 . . . . ...FIN 00441 . . . . (11) WRITE(1,*)' PHASER HIT ON STAR SIR' 00444 . . . . (12) WRITE(1,*)' BASE REPORTS THEY ARE BEING ATTACKED SIR.' 00447 . . . . (13) WRITE(1,*)' TORPEDO HIT ON STAR SIR' 00450 . . . . (14) 00452 . . . . . WRITE(1,*) ' SIR, WE ARE UNDER PHASER ATTACK!' 00453 . . . . ...FIN 00453 . . . . (15) 00455 . . . . . WRITE(1,*)' SPOCK HERE CAPTAIN.' 00456 . . . . . WRITE(1,*)' WE ARE BEING DRAWN INTO SOME SORT OF BLACK HOLE,' 00457 . . . . . WRITE(1,*)' IT IS UNLIKE ANYTHING I HAVE EVER ENCOUNTERED.' 00458 . . . . . WRITE(1,*)' FASCINATING.' 00459 . . . . . CALL WAIT(2,2,M) 00460 . . . . ...FIN 00460 . . . . (16) 00462 . . . . . WRITE(1,*)' SCOTT HERE CAPTAIN' 00463 . . . . . WRITE(1,*)' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' 00464 . . . . . WRITE(1,*)' FAILING ...!' 00465 . . . . . CALL WAIT(2,2,M) 00466 . . . . ...FIN 00466 . . . . (17) WRITE(1,*)' CAPTAIN WE ARE GOING INTO HYPERSPACE' 00469 . . . . (18) WRITE(1,*)' HYPERSPACE JUMP BLOCKED SIR .' 00472 . . . . (19) WRITE(1,*)' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' 00475 . . . . (20) WRITE(1,*)' TORPEDO HIT ON TORPEDO SIR !.' 00478 . . . . (21) WRITE(1,*)' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' 00481 . . . . (22) 00483 . . . . . WRITE(1,*)' SULU HERE CAPTAIN,' 00484 . . . . . WRITE(1,*)' THE ALIEN VESSEL HAS BEEN DESTROYED' 00485 . . . . ...FIN 00485 . . . . (23) WRITE(1,*)' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' 00488 . . . . (24) WRITE(1,*)' ANTI-MATTER POD HAS BEEN DESTROYED' 00491 . . . . (25) WRITE(1,*)' PHASER HIT ON ANTI-MATTER POD, SIR!' 00494 . . . . (26) WRITE(1,*)' TORPEDO HIT ON ANTI-MATTER POD, SIR!' 00497 . . . . (27) WRITE(1,*)' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00012 00500 . . . . (28) WRITE(1,*)' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' 00503 . . . . (29) WRITE(1,*)' ** ANTI-MATTER POD DETONATED SIR **' 00506 . . . . (30) 00508 . . . . . WRITE(1,*) ' SIR, WE ARE CAUGHT IN AN ANTI-MATTER EXPLOSION!' 00509 . . . . . CALL WAIT(2,2,M) 00510 . . . . ...FIN 00510 . . . . (31) 00512 . . . . . WRITE(1,*)' IIEEEEEE!' 00513 . . . . ...FIN 00513 . . . . (OTHERWISE) CONTINUE 00514 . . . ...FIN 00515 . . . ISENT(WHO,I)=0 00516 . . ...FIN 00517 . ...FIN 00517 . IF(SCAN(WHO)) C . . CLEAR THE BOTTOM OF THE SCREEN 00518 . . CALL CLEARS(17,1) 00519 . . WRITE(1,*) ' CAPTAIN, I AM PICKING UP A STRANGE SIGNAL,' 00520 . . WRITE(1,*) ' I BELIEVE WE ARE BEING SCANNED BY AN ALIEN' 00521 . . SCAN(WHO)=.FALSE. 00522 . ...FIN 00522 . IF (MESSAG(WHO*60-59) .NE. ' ') C . . CLEAR THE BOTTOM OF THE SCREEN 00523 . . CALL CLEARS(17,1) 00524 . . WRITE(1,*)' CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADIO' 00525 . . WRITE(1,1000) MESSAG(WHO*60-59) 00526 1000 . . FORMAT(' FREQUENCY ',A1,' ***') 00527 . . WRITE(1,1001) (MESSAG(I),I=WHO*60-58,WHO*60) 00528 1001 . . FORMAT(10X,60A1) 00529 . . CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) 00530 . . CALL WAIT(2,2,M) 00531 . ...FIN 00531 . WHEN((ENERGY(WHO) .LT. 900.) .AND. WARN ) C . . CLEAR THE BOTTOM OF THE SCREEN 00532 . . CALL CLEARS(17,1) 00533 . . WRITE(1,*)' SCOTT HERE CAPTAIN,' 00534 . . WRITE(1,*)' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' 00535 . . WARN=.FALSE. 00536 . ...FIN 00537 . ELSE 00537 . . WARN=.TRUE. 00538 . ...FIN C . C . THIS INSTRUCTION IS TO DELAY A HALF SECOND BEFORE CONTINUING 00538 . CALL WAIT(30,0,M) C . 00539 ...FIN C C DECREMENT PLAYER COUNT 00540 THRU=THRU-1 00541 CALL CLEAR 00542 STOP 00543 END (FLECS VERSION 22.37) ---------------------------------------- 00001 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) C 00002 COMMON/INBUF/INBUF(50),IOST(2) 00003 LOGICAL*1 EXIST,OK (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00013 00004 REAL VARI,LOW,HIGH 00005 BYTE INPUT(15),LEFTED(15) 00006 INTEGER NCHRS 00007 IFLAG=0 00008 GO TO 10 00009 ENTRY GETRLL 00010 IFLAG=1 00011 10 CONTINUE 00012 OK=.FALSE. 00013 REPEAT UNTIL (OK) 00015 . DO(I=1,15) 00016 . . LEFTED(I)=' ' 00017 . ...FIN 00018 . WHEN(IFLAG.EQ.0) 00019 . . READ(1,100,END=800) NCHRS,(INPUT(I),I=1,15) 00020 100 . . FORMAT(Q,15A1) 00021 . . GOTO 810 00022 800 . . CLOSE(UNIT=1) 00023 810 . . CONTINUE 00024 . ...FIN 00025 . ELSE 00025 . . NCHRS=IOST(2)-2 00026 . . DECODE(17,2100,INBUF(2)) INPUT 00027 2100 . . FORMAT(2X,15A1) 00028 . . IFLAG=0 00029 . ...FIN 00029 . CONDITIONAL 00029 . . (NCHRS .EQ. 0) 00030 . . . OK=.TRUE. 00031 . . . EXIST=.FALSE. 00032 . . ...FIN 00032 . . (NCHRS .LE. 15) C . . . * LEFT ADJUST INPUT 00034 . . . CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) 00035 . . . DECODE(15,101,LEFTED,ERR=200) VARI 00036 101 . . . FORMAT(G15.0) 00037 . . . WHEN(VARI .GE. LOW .AND. VARI .LE. HIGH) 00038 . . . . OK=.TRUE. 00039 . . . . EXIST=.TRUE. 00040 . . . ...FIN 00041 . . . ELSE 00041 . . . . WRITE(1,*)' SORRY CAPTAIN, BUT YOUR COMMAND''S PARAMETER MUST' 00042 . . . . WRITE(1,*) ' BE BETWEEN ',LOW,' AND ',HIGH 00043 . . . ...FIN 00043 . . . GO TO 300 00044 200 . . . CONTINUE 00045 . . . WRITE(1,1016) 00046 1016 . . . FORMAT('$WOULD YOU PLEASE REPEAT THAT SIR ? ') 00047 300 . . . CONTINUE 00048 . . ...FIN 00048 . . (OTHERWISE) 00049 . . . WRITE(1,1017) 00050 1017 . . . FORMAT('$RUN THAT BY ME AGAIN ! ') 00051 . . ...FIN 00051 . ...FIN 00051 ...FIN 00052 RETURN 00053 END (FLECS VERSION 22.37) ---------------------------------------- (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00014 00001 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 00002 INTEGER NUM,LOW,HIGH 00003 COMMON/INBUF/INBUF(50),IOST(2) 00004 LOGICAL*1 OK,FLAG C 00005 IFLAG=0 00006 GO TO 10 00007 ENTRY GETINL 00008 IFLAG=1 00009 10 CONTINUE C 00010 OK=.FALSE. 00011 REPEAT UNTIL (OK) 00013 . WHEN( IFLAG.EQ.0 ) 00014 . . READ(1,102,END=800,ERR=200) NCHRS,NUM 00015 102 . . FORMAT(Q,I5) 00016 . . GOTO 810 00017 800 . . CLOSE(UNIT=1) 00018 810 . . CONTINUE 00019 . ...FIN 00020 . ELSE 00020 . . NCHRS=IOST(2)-2 00021 . . DECODE(7,103,INBUF(2)) NUM 00022 103 . . FORMAT(2X,I) 00023 . . IFLAG=0 00024 . ...FIN 00024 . WHEN( NCHRS .EQ. 0 ) 00025 . . FLAG=.FALSE. 00026 . . OK=.TRUE. 00027 . ...FIN 00028 . ELSE 00028 . . WHEN((NUM .GE. LOW) .AND. (NUM .LE. HIGH)) 00029 . . . OK=.TRUE. 00030 . . . FLAG=.TRUE. 00031 . . ...FIN 00032 . . ELSE 00032 . . . WRITE(1,*)' WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS' 00033 . . . WRITE(1,1018)LOW,HIGH 00034 1018 . . . FORMAT( '$BETWEEN',F8.2,' AND ',F8.2,'TRY AGAIN : ') 00035 . . ...FIN 00035 . . GOTO 300 00036 200 . . CONTINUE 00037 . . WRITE(1,1019) 00038 1019 . . FORMAT('$TRY AGAIN BOZO : ') 00039 300 . . CONTINUE 00040 . ...FIN 00040 ...FIN 00041 RETURN 00042 END (FLECS VERSION 22.37) ---------------------------------------- 00001 SUBROUTINE YESNO(FLAG) 00002 COMMON/INBUF/INBUF(50),IOST(2) 00003 LOGICAL*1 FLAG,OK 00004 BYTE YES(4),NO(4) 00005 BYTE ANSWER(4) 00006 DATA YES/'Y','E','S',' '/ 00007 DATA NO/'N','O',' ',' '/ (FLECS VERSION 22.37) 03-NOV-79 20:09:55 PAGE 00015 C 00008 IFLAG=O 00009 GO TO 10 00010 ENTRY YESNOL 00011 IFLAG=1 00012 10 CONTINUE C 00013 OK=.FALSE. 00014 REPEAT UNTIL (OK ) 00016 . WHEN(IFLAG.EQ.0) 00017 . . READ(1,104,END=800) NCHRS, (ANSWER(I),I=1,4) 00018 104 . . FORMAT(Q,4A1) 00019 . . GOTO 810 00020 800 . . CLOSE(UNIT=1) 00021 810 . . CONTINUE 00022 . ...FIN 00023 . ELSE 00023 . . NCHRS=IOST(2)-2 00024 . . DECODE(6,105,INBUF(2)) ANSWER 00025 105 . . FORMAT(2X,4A1) 00026 . . IFLAG=0 00027 . ...FIN 00027 . IF ((NCHRS .GT. 4) .OR. (NCHRS .LT. 1)) 00028 . . NCHRS=4 00029 . ...FIN C . * CHECK FOR YES 00029 . I=KOMSTR(YES,1,NCHRS,ANSWER,1) 00030 . WHEN( I .EQ. 0 ) 00031 . . FLAG=.TRUE. 00032 . . OK=.TRUE. 00033 . ...FIN 00034 . ELSE C . . * CHECK FOR A NO 00034 . . I=KOMSTR(NO,1,NCHRS,ANSWER,1) 00035 . . WHEN( I .EQ. 0 ) 00036 . . . FLAG=.FALSE. 00037 . . . OK=.TRUE. 00038 . . ...FIN 00039 . . ELSE C . . . * INCORRECT RESPONSE 00039 . . . WRITE(1,*)' ** PLEASE ANSWER "YES" OR "NO" **' 00040 . . . WRITE(1,1020) 00041 1020 . . . FORMAT('$ANSWER ? ') 00042 . . ...FIN 00042 . ...FIN 00043 ...FIN 00044 RETURN 00045 END (FLECS VERSION 22.37) ---------------------------------------- ,PLAYER=PLAYER