0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:03 0 LINE LEVEL C1 1 0 PROGRAM PLAYER 2 0 TEXT COMMON 3 0 BEGIN COMMON 4 0 COMMON /LEDFOR/ ENERGY(8),SHIELD(8),XCORD(8),YCORD(8),TORPS(8), 5 0 + PHA(8),I1,I2,HYPER(8),ISENT(8,10), 6 0 + XPOD(8),YPOD(8),DPOD(8),IPOD(8), 7 0 + SCORE(8),CREW(8),DIR(8),WARP(8),LAUNCH(8),UNIV(100,100), 8 0 + MESSAG(480),THRU,XSHIP(8),CLOAK(8) 9 0 REAL LAUNCH 10 0 INTEGER CREW,HYPER,TORPS 11 0 LOGICAL*1 XSHIP,CLOAK 12 0 BYTE THRU,UNIV,MESSAG 13 0 ENDTEXT 14 0 LOGICAL*1 OK,DONE,YES,WARN 15 0 BYTE BLANK(80),COMMND 16 0 DIMENSION IPRM(2),JPRM(2) 17 0 COMMON/INBUF/INBUF(50),IOST(2) 18 0 EQUIVALENCE (INBUF,COMMND) 19 0 BYTE IBUF(1000) 20 0 BYTE OLDBUF(21,17),NEWBUF(21,17),OLDREP(11,7),NEWREP(11,7) 21 0 BYTE OLDSCR(7,8),NEWSCR(7,8) 22 0 BYTE RESET 23 0 INTEGER WHO 24 0 BYTE ESCPOS(2) 25 0 C 26 0 C************************************************************************ 27 0 C * 28 0 C THE FOLLOWING PARAMETERS ARE FOR CURSOR ADDRESSING. THEY ARE * 29 0 C SPECIFICALLY FOR A BEEHIVE 100 TERMINAL AND MAY HAVE TO BE * 30 0 C MODIFIED FOR DIFFERENT TERMINALS. ESCPOS CONTAINS THE ESCAPE * 31 0 C SEQUENCE FOR CURSOR ADDRESSING AND IOFSET IS THE OFFSET TO * 32 0 C CONVERT THE LINE/COLUMN NUMBER TO THE APPROPRIATE OCTAL CODE. * 33 0 C * 34 0 DATA ESCPOS/"33,'F'/ 35 0 DATA IOFSET/"37/ 36 0 C * 37 0 C************************************************************************ 38 0 C 39 0 DATA IAST/0/ 40 0 DATA RESET/1/ 41 0 DATA BLANK/80*' '/ 42 0 DATA OK/.FALSE./ 43 0 C 44 0 CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) 45 0 WRITE(5,) 10000 46 0 FORMAT('0WELCOME TO MULTI-TREK') 47 0 UNTIL OK DO 48 1 WRITE(5,) 10004 49 1 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') 50 1 FOR I=1 UNTIL 8 DO 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:05 0 LINE LEVEL C1 51 2 IF .NOT. XSHIP(I) THEN 52 3 WRITE(5,) I 10011 53 3 FORMAT(' SHIP ',I1) 54 2 ENDIF 55 1 ENDDO 56 1 WRITE(5,) 10012 57 1 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND :') 58 1 CALL GETINT(WHO,OK,1,8) 59 1 IF XSHIP(WHO) THEN 60 2 WRITE(5,) 10016 61 2 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER') 62 2 WRITE(5,) 10017 63 2 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND ?') 64 2 CALL YESNO(OK) 65 1 ELSE 66 2 SCORE(WHO)=0. 67 1 ENDIF 68 0 ENDDO 69 0 XSHIP(WHO)=.TRUE. 70 0 CREW(WHO)=CREW(WHO)+1 71 0 DIR(WHO)=90. 72 0 WARP(WHO)=0. 73 0 C 74 0 C INCREMENT PLAYER COUNT 75 0 IF THRU.GT.0 THEN 76 1 THRU=THRU+1 77 0 ELSE 78 1 THRU=1 79 0 ENDIF 80 0 C 81 0 C SET UP TERMINAL INPUT/OUTPUT PARAMETERS 82 0 CALL RDAST(IAST) 83 0 CALL GETADR(IPRM,IBUF) 84 0 CALL GETADR(JPRM,INBUF) 85 0 JPRM(2)=50 86 0 C 87 0 UNTIL DONE DO 88 0 C 89 0 C CHECK FOR INPUTS 90 0 C 91 1 IF IAST.NE.0 THEN 92 2 CALL WTQIO("1020,5,1,,IOST,JPRM) 93 2 IF IOST(1).EQ.-10 THEN 94 3 CLOSE (UNIT=5) 95 3 COMMND=0 96 2 ELSE 97 3 IF IOST(2).EQ.0 THEN 98 4 COMMND=' ' 99 3 ENDIF 100 2 ENDIF 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 3 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:08 0 LINE LEVEL C1 101 2 IAST=IAST-1 102 1 ENDIF 103 1 C 104 1 C 105 1 C GENERATE NEW DISPLAY 106 1 IX1=XCORD(WHO)-10. 107 1 IF IX1 .LT. 1 THEN 108 2 IX1=1 109 1 ENDIF 110 1 IX2=XCORD(WHO)+10. 111 1 IF IX2 .GT. 100 THEN 112 2 IX2=100 113 1 ENDIF 114 1 IY1=YCORD(WHO)-8. 115 1 IF IY1 .LT. 1 THEN 116 2 IY1=1 117 1 ENDIF 118 1 IY2=YCORD(WHO)+8. 119 1 IF IY2 .GT. 100 THEN 120 2 IY2=100 121 1 ENDIF 122 1 FOR IX=1 UNTIL 21 DO 123 2 FOR IY=1 UNTIL 17 DO 124 3 NEWBUF(IX,IY)=' ' 125 2 ENDDO 126 1 ENDDO 127 1 IBY=0 128 1 DO 10 IY=IY2,IY1,-1 129 1 IBY=IBY+1 130 1 IBX=1 131 1 FOR IX=IX1 UNTIL IX2 DO 132 2 NEWBUF(IBX,IBY)=UNIV(IX,IY) 133 2 K=NEWBUF(IBX,IBY) 134 2 IF (K.GE.49).AND.(K.LE.56).AND.CLOAK(K-48) THEN 135 3 NEWBUF(IBX,IBY)=46 136 2 ENDIF 137 2 IBX=IBX+1 138 1 ENDDO 139 1 10 CONTINUE 140 1 IBX=IBX-1 141 1 C 142 1 C GENERATE REPORT 143 1 C 144 1 IF DIR(WHO).GT.90. THEN 145 2 VALUE=(450.-DIR(WHO))/30. 146 1 ELSE 147 2 VALUE=(90.-DIR(WHO))/30. 148 1 ENDIF 149 1 IF VALUE.EQ.0. THEN 150 2 VALUE=0. 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 4 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:25 0 LINE LEVEL C1 151 1 ENDIF 152 1 ENCODE(77,,NEWREP) VALUE,WARP(WHO),ENERGY(WHO), 10063 153 1 + SHIELD(WHO),HYPER(WHO),TORPS(WHO),CREW(WHO) 154 1 FORMAT(F5.2,6X, F4.2,7X, G11.5, G11.5, I1,10X, I2,9X, I3,8X) 155 1 C 156 1 C GENERATE SCORES 157 1 ENCODE(56,,NEWSCR) SCORE 10064 158 1 FORMAT(8F7.0) 159 1 C 160 1 C 161 1 C 162 1 C DISPLAY TITLES, LABELS,ETC. 163 1 IF RESET.NE.0 THEN 164 2 CALL CLEAR 165 2 CALL WRITE(1,6,'COORDINATES') 166 2 CALL WRITE(4,3,'HEADING :') 167 2 CALL WRITE(5,6,'WARP :') 168 2 CALL WRITE(6,4,'ENERGY :') 169 2 CALL WRITE(7,3,'SHIELDS :') 170 2 CALL WRITE(8,1,'HYPER SET :') 171 2 CALL WRITE(9,1,'TORPEDOES :') 172 2 CALL WRITE(10,1,'CREW SIZE :') 173 2 CALL WRITE(5,67,'SHIP SCORES') 174 2 FOR I=1 UNTIL 8 DO 175 3 CALL WRITE(I+5,69,I+"60) 176 2 ENDDO 177 2 FOR IY=1 UNTIL IBY DO 178 3 ENCODE(42,,IBUF) (NEWBUF(IX,IY),IX=1,IBX) 10074 179 3 FORMAT(21(A1,1X)) 180 3 CALL WRITE(IY,24,IBUF,41) 181 2 ENDDO 182 2 FOR IY=1 UNTIL 7 DO 183 3 ENCODE(11,,IBUF) (NEWREP(IX,IY),IX=1,11) 10078 184 3 FORMAT(11A1) 185 3 CALL WRITE(IY+3,12,IBUF,11) 186 2 ENDDO 187 2 FOR IY=1 UNTIL 8 DO 188 3 ENCODE(7,,IBUF) (NEWSCR(IX,IY),IX=1,7) 10082 189 3 FORMAT(7A1) 190 3 CALL WRITE(IY+5,72,IBUF,7) 191 2 ENDDO 192 2 C 193 2 C SET OLD = NEW 194 2 C 195 2 FOR IX=1 UNTIL 21 DO 196 3 FOR IY=1 UNTIL 17 DO 197 4 OLDBUF(IX,IY)=NEWBUF(IX,IY) 198 3 ENDDO 199 2 ENDDO 200 2 FOR IX=1 UNTIL 11 DO 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 5 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:39 0 LINE LEVEL C1 201 3 FOR IY=1 UNTIL 7 DO 202 4 OLDREP(IX,IY)=NEWREP(IX,IY) 203 3 ENDDO 204 2 ENDDO 205 2 FOR IX=1 UNTIL 7 DO 206 3 FOR IY=1 UNTIL 8 DO 207 4 OLDSCR(IX,IY)=NEWSCR(IX,IY) 208 3 ENDDO 209 2 ENDDO 210 2 RESET=0 211 1 ELSE 212 1 C 213 1 C COMPARE DISPLAYS 214 2 KBUF=1 215 2 FOR IY=1 UNTIL 17 DO 216 3 FOR IX=1 UNTIL 21 DO 217 4 IF NEWBUF(IX,IY).NE.OLDBUF(IX,IY) THEN 218 5 KX=2*(IX-1)+24+IOFSET 219 5 KY=IY+IOFSET 220 5 IBUF(KBUF)=ESCPOS(1) 221 5 IBUF(KBUF+1)=ESCPOS(2) 222 5 IBUF(KBUF+2)=KY 223 5 IBUF(KBUF+3)=KX 224 5 IBUF(KBUF+4)=NEWBUF(IX,IY) 225 5 KBUF=KBUF+5 226 5 OLDBUF(IX,IY)=NEWBUF(IX,IY) 227 4 ENDIF 228 3 ENDDO 229 2 ENDDO 230 2 C 231 2 C COMPARE REPORTS 232 2 FOR IY=1 UNTIL 7 DO 233 3 FOR IX=1 UNTIL 11 DO 234 4 IF OLDREP(IX,IY).NE.NEWREP(IX,IY) THEN 235 5 KX=IX+11+IOFSET 236 5 KY=IY+3+IOFSET 237 5 IBUF(KBUF)=ESCPOS(1) 238 5 IBUF(KBUF+1)=ESCPOS(2) 239 5 IBUF(KBUF+2)=KY 240 5 IBUF(KBUF+3)=KX 241 5 IBUF(KBUF+4)=NEWREP(IX,IY) 242 5 KBUF=KBUF+5 243 5 OLDREP(IX,IY)=NEWREP(IX,IY) 244 4 ENDIF 245 3 ENDDO 246 2 ENDDO 247 2 C 248 2 C COMPARE SCORES 249 2 FOR IY=1 UNTIL 8 DO 250 3 FOR IX=1 UNTIL 7 DO 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 6 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:44 0 LINE LEVEL C1 251 4 IF OLDSCR(IX,IY).NE.NEWSCR(IX,IY) THEN 252 5 KX=IX+71+IOFSET 253 5 KY=IY+5+IOFSET 254 5 IBUF(KBUF)=ESCPOS(1) 255 5 IBUF(KBUF+1)=ESCPOS(2) 256 5 IBUF(KBUF+2)=KY 257 5 IBUF(KBUF+3)=KX 258 5 IBUF(KBUF+4)=NEWSCR(IX,IY) 259 5 KBUF=KBUF+5 260 5 OLDSCR(IX,IY)=NEWSCR(IX,IY) 261 4 ENDIF 262 3 ENDDO 263 2 ENDDO 264 2 C 265 2 C UPDATE DISPLAY IF CHANGED 266 2 C 267 2 KBUF=KBUF-1 268 2 IF KBUF.GT.1 THEN 269 3 IPRM(2)=KBUF 270 3 CALL WTQIO("410,5,1,,,IPRM) 271 2 ENDIF 272 1 ENDIF 273 1 C 274 1 C UPDATE COORDINATES 275 1 C 276 1 ENCODE(16,,IBUF) XCORD(WHO),YCORD(WHO) 10131 277 1 FORMAT('X:',F5.1,' Y:',F5.1) 278 1 CALL WRITE(2,4,IBUF,16) 279 1 IF COMMND.NE.0 THEN 280 1 C 281 1 C CLEAR THE BOTTOM OF THE SCREEN 282 2 CALL CLEARS(17,1) 283 2 C 284 2 SELECT 285 2 C 286 2 C WARP FACTOR COMMAND 287 2 C 288 2 WHEN COMMND .EQ. 'W' THEN 289 3 IF IOST(2).EQ.1 THEN 290 4 WRITE(5,) 10144 291 4 FORMAT('$WARP FACTOR, SIR ?') 292 4 CALL GETREL(WARP(WHO),OK,0.,8.) 293 3 ELSE 294 4 CALL GETRLL(WARP(WHO),OK,0.,8.) 295 3 ENDIF 296 3 IF .NOT. OK THEN 297 4 WARP(WHO)=0. 298 3 ENDIF 299 3 C 300 3 C COURSE COMMAND 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 7 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:47 0 LINE LEVEL C1 301 3 C 302 2 WHEN COMMND .EQ. 'C' THEN 303 3 IF IOST(2).EQ.1 THEN 304 4 WRITE(5,) 10153 305 4 FORMAT('$COURSE, SIR ?') 306 4 CALL GETREL(VALUE,OK,0.,12.) 307 3 ELSE 308 4 CALL GETRLL(VALUE,OK,0.,12.) 309 3 ENDIF 310 3 IF OK THEN 311 4 IF VALUE .GE. 3. THEN 312 5 DIR(WHO)=(15.-VALUE)*30. 313 4 ELSE 314 5 DIR(WHO)=(3.-VALUE)*30. 315 4 ENDIF 316 3 ENDIF 317 3 C 318 3 C HYPERSPACE COMMAND 319 3 C 320 2 WHEN COMMND .EQ. 'H' THEN 321 3 IF IOST(2).EQ.1 THEN 322 4 WRITE(5,) 10165 323 4 FORMAT('$NEW HYPERSPACE JUMP SETTING ? ') 324 4 CALL GETINT(II,OK,1,6) 325 3 ELSE 326 4 CALL GETINL(II,OK,1,6) 327 3 ENDIF 328 3 IF OK THEN 329 4 HYPER(WHO)=II 330 3 ENDIF 331 3 C 332 3 C SHIELD COMMAND 333 3 C 334 2 WHEN COMMND .EQ. 'S' THEN 335 3 IF IOST(2).EQ.1 THEN 336 4 WRITE(5,) 10174 337 4 FORMAT('$ENGINEERING TO BRIDGE, HOW MUCH ENERGY SIR ? ') 338 4 CALL GETREL(VALUE,OK,-1.E36,1.E36) 339 3 ELSE 340 4 CALL GETRLL(VALUE,OK,-1.E36,1.E36) 341 3 ENDIF 342 3 IF OK THEN 343 4 IF ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE .GE. 0. 344 4 + THEN 345 5 ENERGY(WHO)=ENERGY(WHO)-VALUE 346 5 SHIELD(WHO)=SHIELD(WHO)+VALUE 347 4 ELSE 348 5 WRITE(5,) 10181 349 5 FORMAT(' I AM SORRY CAPTAIN, BUT THAT IS IMPOSSIBLE.') 350 4 ENDIF 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 8 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:56:51 0 LINE LEVEL C1 351 3 ENDIF 352 3 C 353 3 C HELP COMMAND 354 3 C 355 2 WHEN COMMND .EQ. ' ' THEN 356 3 WRITE(5,) 10184 357 3 FORMAT(' A APPEAR (CLOAKING OFF)',T30,'M SEND MESSAGE',T51, 358 3 1 'T FIRE TORPEDOES'/' C COURSE HEADING',T30,'P FIRE PHASERS', 359 3 2 T51,'W SET WARP SPEED'/' F FADE (CLOAKING ON)',T30, 360 3 3 'Q QUIT',T51,'X DETONATE ANTI-MATTER'/ 361 3 4 ' H HYPERSPACE SETTING',T30,'R RESET DISPLAY',T51, 362 3 5 'Z LAUNCH ANTI-MATTER'/' L LOCATE SHIP',T30, 363 3 6 'S SHIELD CHANGE',T51,' DISPLAY HELP MESSAGE') 364 3 C 365 3 C QUIT COMMAND 366 3 C 367 2 WHEN COMMND .EQ. 'Q' THEN 368 3 IF IOST(2).EQ.1 THEN 369 4 WRITE(5,) SCORE(WHO) 10190 370 4 FORMAT(' YOUR CURRENT SCORE IS ',F8.0) 371 4 WRITE(5,) 10191 372 4 FORMAT('$ARE YOU SURE YOU WANT TO QUIT NOW ? ') 373 4 CALL YESNO(DONE) 374 3 ELSE 375 4 CALL YESNOL(DONE) 376 3 ENDIF 377 3 IF DONE THEN 378 4 CREW(WHO)=CREW(WHO)-1 379 4 IF CREW(WHO) .EQ. 400 THEN 380 5 XSHIP(WHO)=.FALSE. 381 4 ENDIF 382 3 ENDIF 383 3 C 384 3 C RESET COMMAND 385 3 C 386 2 WHEN COMMND .EQ. 'R' THEN 387 3 RESET=1 388 3 C 389 3 C TORPEDO COMMAND 390 3 C 391 2 WHEN COMMND .EQ. 'T' THEN 392 3 IF LAUNCH(WHO) .LT. 0. THEN 393 4 IF TORPS(WHO) .GT. 0 THEN 394 5 IF IOST(2).EQ.1 THEN 395 6 WRITE(5,) 10211 396 6 FORMAT('$PHOTON TORPEDO READY, COURSE ?') 397 6 CALL GETREL(VALUE,OK,0.,12.) 398 5 ELSE 399 6 CALL GETRLL(VALUE,OK,0.,12.) 400 5 ENDIF 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 9 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:01 0 LINE LEVEL C1 401 5 IF OK THEN 402 6 IF VALUE .GE. 3. THEN 403 7 VALUE=(15.-VALUE)*30. 404 6 ELSE 405 7 VALUE=(3.-VALUE)*30. 406 6 ENDIF 407 5 ELSE 408 6 VALUE=DIR(WHO) 409 5 ENDIF 410 5 LAUNCH(WHO)=VALUE 411 5 TORPS(WHO)=TORPS(WHO)-1 412 5 IF TORPS(WHO) .EQ. 0 THEN 413 6 WRITE(5,) 10221 414 6 FORMAT('$TORPEDO ROOM TO BRIDGE. LAST TORPEDO, SIR.') 415 5 ENDIF 416 5 WRITE(5,) VALUE 10222 417 5 FORMAT(' TORPEDO LAUNCHED, HEADING ',F7.2,' DEGREES.') 418 4 ELSE 419 5 WRITE(5,) 10223 420 5 FORMAT(' SO SORRY CAPTAIN, BUT WE ARE OUT OF TORPEDOES') 421 4 ENDIF 422 3 ELSE 423 4 WRITE(5,) 10224 424 4 FORMAT(' TORPEDO TUBES ARE NOT READY YET CAPTAIN !') 425 3 ENDIF 426 3 C 427 3 C PHASER COMMAND 428 3 C 429 2 WHEN COMMND .EQ. 'P' THEN 430 3 IF PHA(WHO) .LT. 0. THEN 431 4 IF IOST(2).EQ.1 THEN 432 5 WRITE(5,) 10233 433 5 FORMAT('$PHASER CONTROL READY. COURSE ?') 434 5 CALL GETREL(VALUE,OK,0.,12.) 435 4 ELSE 436 5 CALL GETRLL(VALUE,OK,0.,12.) 437 4 ENDIF 438 4 IF OK THEN 439 5 IF VALUE .GE. 3. THEN 440 6 VALUE=(15.-VALUE)*30. 441 5 ELSE 442 6 VALUE=(3.-VALUE)*30. 443 5 ENDIF 444 4 ELSE 445 5 VALUE=DIR(WHO) 446 4 ENDIF 447 4 PHA(WHO)=VALUE 448 4 ENERGY(WHO)=ENERGY(WHO)-50. 449 4 WRITE(5,) 10240 450 4 FORMAT(' PHASERS FIRED CAPTAIN') 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 10 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:28 0 LINE LEVEL C1 451 3 ELSE 452 4 WRITE(5,) 10241 453 4 FORMAT(' PHASER CONTROL TO BRIDGE, PHASERS ARE NOT READY YET.') 454 3 ENDIF 455 3 C 456 3 C LONG RANGE SCAN COMMAND 457 3 C 458 2 WHEN COMMND .EQ. 'L' THEN 459 3 IF IOST(2).EQ.1 THEN 460 4 WRITE(5,) 10247 461 4 FORMAT(' SPOCK HERE CAPTAIN.') 462 4 WRITE(5,) 10248 463 4 FORMAT('$ON WHAT FREQUENCY SHOULD I SET THE SCAN ? ') 464 4 CALL GETINT(II,OK,1,8) 465 3 ELSE 466 4 CALL GETINL(II,OK,1,8) 467 3 ENDIF 468 3 IF OK THEN 469 4 IX=XCORD(II)/10. 470 4 IY=YCORD(II)/10. 471 4 WRITE(5,) IX,IY 10252 472 4 FORMAT(' SCANNERS REPORT LIFE FORMS IN SECTOR ',I3,','I3) 473 4 X=IX*10 474 4 Y=IY*10 475 4 D=ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180./3.14159 476 4 IF D .GT. 90. THEN 477 5 D=(450.-D)/30. 478 4 ELSE 479 5 D=(90.-D)/30. 480 4 ENDIF 481 4 WRITE(5,) D 10256 482 4 FORMAT(' I APPROXIMATE A COURSE OF ',F13.9,' SHOULD TAKE') 483 4 WRITE(5,) 10257 484 4 FORMAT(' US TO THE CENTER OF THAT SECTOR.') 485 3 ENDIF 486 3 C 487 3 C MESSAGE COMMAND 488 3 C 489 2 WHEN COMMND .EQ. 'M' THEN 490 3 IF IOST(2).EQ.1 THEN 491 4 WRITE(5,) 10263 492 4 FORMAT('$UHURA HERE CAPTAIN, TO WHOM ARE WE SENDING ? ') 493 4 CALL GETINT(IVAL,OK,1,8) 494 3 ELSE 495 4 CALL GETINL(IVAL,OK,1,8) 496 3 ENDIF 497 3 IF .NOT. OK THEN 498 4 IVAL=WHO 499 3 ENDIF 500 3 WRITE(5,) 10267 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 11 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:33 0 LINE LEVEL C1 501 3 FORMAT('$MESSAGE CAPTAIN ? ') 502 3 READ(5,,END=12) (MESSAG(I),I=IVAL*60-58,IVAL*60) 10268 503 3 FORMAT(60A1) 504 3 GOTO 13 505 3 12 CLOSE(UNIT=5) 506 3 13 CONTINUE 507 3 ENERGY(WHO)=ENERGY(WHO)-10. 508 3 ENCODE(1,,COMMND) WHO 10269 509 3 FORMAT(I1) 510 3 CALL STRMOV(COMMND,1,1,MESSAG,IVAL*60-59) 511 3 C 512 3 C CLOAKING COMMAND 513 3 C 514 2 WHEN COMMND .EQ. 'F' THEN 515 3 IF .NOT. CLOAK(WHO) THEN 516 4 CLOAK(WHO)=.TRUE. 517 4 WRITE(5,) 10275 518 4 FORMAT(' SPOCK HERE CAPTAIN. CLOAKING DEVICE COMING ON NOW!') 519 4 WRITE(5,) 10276 520 4 FORMAT(' WE ARE FADING OUT.....') 521 3 ELSE 522 4 WRITE(5,) 10277 523 4 FORMAT(' BUT CAPTAIN WE ARE ALREADY CLOAKED ?!') 524 3 ENDIF 525 3 C 526 2 WHEN COMMND .EQ. 'A' THEN 527 3 IF CLOAK(WHO) THEN 528 4 CLOAK(WHO)=.FALSE. 529 4 WRITE(5,) 10283 530 4 FORMAT(' SPOCK HERE CAPTAIN. CLOAKING DEVICE DEACTIVATED.') 531 4 WRITE(5,) 10284 532 4 FORMAT(' WE ARE NOW VISABLE.....') 533 3 ELSE 534 4 WRITE(5,) 10285 535 4 FORMAT(' BUT CAPTAIN WE ARE NOT CLOAKED !') 536 3 ENDIF 537 3 C 538 3 C 539 3 C EXPLODE ANTI-MATTER DEVICE 540 3 C 541 2 WHEN COMMND .EQ. 'X' THEN 542 3 IF IPOD(WHO) .EQ. 2 THEN 543 4 IPOD(WHO)=3 544 4 WRITE(5,) 10291 545 4 FORMAT(' ANTI-MATTER DETONATION SIGNALED, SIR!') 546 3 ELSE 547 4 WRITE(5,) 10292 548 4 FORMAT(' CAPTAIN, WE DO NOT HAVE AN ACTIVE ANTI MATTER DEVICE') 549 3 ENDIF 550 3 C 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 12 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:43 0 LINE LEVEL C1 551 3 C LAUNCH ANTI-MATTER DEVICE 552 3 C 553 2 WHEN COMMND .EQ. 'Z' THEN 554 3 IF IPOD(WHO) .EQ. 0 THEN 555 4 IF IOST(2).EQ.1 THEN 556 5 WRITE(5,) 10301 557 5 FORMAT('$ANTI MATTER DEVICE READY SIR, COURSE ? ') 558 5 CALL GETREL(VALUE,OK,0.,12.) 559 4 ELSE 560 5 CALL GETRLL(VALUE,OK,0.,12.) 561 4 ENDIF 562 4 IF OK THEN 563 5 IF VALUE .GE. 3. THEN 564 6 DPOD(WHO)=(15.-VALUE)*30. 565 5 ELSE 566 6 DPOD(WHO)=(3.-VALUE)*30. 567 5 ENDIF 568 4 ELSE 569 5 DPOD(WHO)=DIR(WHO) 570 4 ENDIF 571 4 IPOD(WHO)=1 572 3 ELSE 573 4 WRITE(5,) 10308 574 4 FORMAT(' SORRY CAPTAIN, BUT WE ARE OUT OF ANTI-MATTER PODS') 575 3 ENDIF 576 2 OTHERWISE 577 3 WRITE(5,) 10310 578 3 FORMAT(' I AM SORRY CAPTAIN, BUT I DID NOT UNDERSTAND THAT.') 579 2 ENDS 580 2 COMMND=0 581 1 ENDIF 582 1 C 583 1 C * WRITE OUT MESSAGES FROM DRIVER 584 1 C 585 1 IF ISENT(WHO,1).NE.0 THEN 586 2 CALL POSITN(18,1) 587 2 FOR I=1 UNTIL 10 DO 588 3 SELECT USING ISENT(WHO,I) 589 3 WHEN 1 THEN 590 4 TYPE *,' WE ARE NOW DOCKED CAPTAIN.' 591 3 WHEN 2 THEN 592 4 TYPE *,' ** CAPTAIN ! WE HIT A STAR! **' 593 3 WHEN 3 THEN 594 4 FOR IK=1 UNTIL 3 DO 595 5 CALL CLEAR 596 5 WRITE(5,) 10330 597 5 FORMAT(////////////,25X,'*** BOOM ***') 598 4 ENDDO 599 4 WRITE(5,) 10331 600 4 FORMAT(//' YOU',1H','RE SHIP HAS BEEN DESTROYED') 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 13 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:50 0 LINE LEVEL C1 601 4 TYPE *,' FORTUNATELY YOU ESCAPED WITH YOUR LIFE.' 602 4 TYPE *,' UNFORTUNATELY, YOU HAVE BEEN GIVEN A NEW COMMAND.' 603 4 WRITE(5,) 10332 604 4 FORMAT(/'$ARE YOU READY TO ACCEPT THIS ASSIGNMENT ?') 605 4 CALL YESNO(YES) 606 4 IF YES THEN 607 5 TYPE *,' GOOD!' 608 4 ELSE 609 5 TYPE *,' TOUGH LUCK, BUT YOU GET IT ANYWAY.' 610 4 ENDIF 611 4 XSHIP(WHO)=.TRUE. 612 4 RESET=1 613 3 WHEN 4 THEN 614 4 WRITE(5,) 10338 615 4 FORMAT(' CAPTAIN WE HAVE BEEN HIT BY A PHOTON TORPEDO') 616 3 WHEN 5 THEN 617 4 TYPE *,' * TORPEDO HIT ALIEN SHIP, SIR. *' 618 3 WHEN 6 THEN 619 4 TYPE *,' * PHASER HIT ON ALIEN VESSEL, SIR *' 620 3 WHEN 7 THEN 621 4 TYPE *,' PHASER HIT ON TORPEDO, SIR' 622 3 WHEN 8 THEN 623 4 TYPE *,' PHASER MISSED' 624 3 WHEN 9 THEN 625 4 WRITE(5,) 10349 626 4 FORMAT(' ** SIR! WE HAVE RAMMED AN ALIEN VESSEL **') 627 4 C 628 3 WHEN 10 THEN 629 4 WRITE(5,) 10352 630 4 FORMAT(' * SIR! WE HAVE COLLIDED WITH AN ALIEN VESSEL *') 631 4 C 632 3 WHEN 11 THEN 633 4 TYPE *,' PHASER HIT ON STAR SIR' 634 4 C 635 3 WHEN 12 THEN 636 4 TYPE *,' BASE REPORTS THEY ARE BEING ATTACKED SIR.' 637 4 C 638 3 WHEN 13 THEN 639 4 TYPE *,' TORPEDO HIT ON STAR SIR' 640 4 C 641 3 WHEN 14 THEN 642 4 WRITE(5,) 10361 643 4 FORMAT(' SIR, WE ARE UNDER PHASER ATTACK!') 644 4 C 645 3 WHEN 15 THEN 646 4 TYPE *,' SPOCK HERE CAPTAIN.' 647 4 TYPE *,' WE ARE BEING DRAWN INTO SOME SORT OF BLACK HOLE,' 648 4 TYPE *,' IT IS UNLIKE ANYTHING I HAVE EVER ENCOUNTERED.' 649 4 TYPE *,' FASCINATING.' 650 4 CALL WAIT(2,2,M) 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 14 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:57:59 0 LINE LEVEL C1 651 4 C 652 3 WHEN 16 THEN 653 4 TYPE *,' SCOTT HERE CAPTAIN' 654 4 TYPE *,' OUR DYLITHIUM CRYSTALS ARE GONE. LIFE SUPPORT IS ' 655 4 TYPE *,' FAILING ...!' 656 4 CALL WAIT(2,2,M) 657 4 C 658 3 WHEN 17 THEN 659 4 TYPE *,' CAPTAIN WE ARE GOING INTO HYPERSPACE' 660 4 C 661 3 WHEN 18 THEN 662 4 TYPE *,' HYPERSPACE JUMP BLOCKED SIR .' 663 3 WHEN 19 THEN 664 4 TYPE *,' SIR! WE ARE ENTERING SOME SORT OF HYPERSPACE FIELD' 665 3 WHEN 20 THEN 666 4 TYPE *,' TORPEDO HIT ON TORPEDO SIR !.' 667 3 WHEN 21 THEN 668 4 TYPE *,' HIT HAD NO EFFECT, APPARENTLY IT IS A GHOST SHIP' 669 4 C 670 3 WHEN 22 THEN 671 4 TYPE *,' SULU HERE CAPTAIN,' 672 4 TYPE *,' THE ALIEN VESSEL HAS BEEN DESTROYED' 673 4 C 674 3 WHEN 23 THEN 675 4 TYPE *,' ANTI-MATTER POD LAUNCH WAS BLOCKED SIR' 676 4 C 677 3 WHEN 24 THEN 678 4 TYPE *,' ANTI-MATTER POD HAS BEEN DESTROYED' 679 4 C 680 3 WHEN 25 THEN 681 4 TYPE *,' PHASER HIT ON ANTI-MATTER POD, SIR!' 682 4 C 683 3 WHEN 26 THEN 684 4 TYPE *,' TORPEDO HIT ON ANTI-MATTER POD, SIR!' 685 4 C 686 3 WHEN 27 THEN 687 4 TYPE *,' SIR, SENSORS REPORT A METALLIC OBJECT IS NEAR' 688 4 C 689 3 WHEN 28 THEN 690 4 TYPE *,' ANTI-MATTER POD SUCCESSFULLY LAUNCHED, SIR.' 691 4 C 692 3 WHEN 29 THEN 693 4 TYPE *,' ** ANTI-MATTER POD DETONATED SIR **' 694 4 C 695 3 WHEN 30 THEN 696 4 WRITE(5,) 10394 697 4 FORMAT(' SIR, WE ARE CAUGHT IN AN ANTI-MATTER EXPLOSION!') 698 4 CALL WAIT(2,2,M) 699 4 C 700 3 WHEN 31 THEN 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF PROGRAM PLAYER PAGE 15 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:09 0 LINE LEVEL C1 701 4 WRITE(5,) 10397 702 4 FORMAT(' IIEEEEEE!') 703 4 C 704 3 OTHERWISE 705 4 CONTINUE 706 3 ENDS 707 3 ISENT(WHO,I)=0 708 2 ENDDO 709 1 ENDIF 710 1 IF MESSAG(WHO*60-59) .NE. ' ' THEN 711 2 WRITE(5,) 10402 712 2 FORMAT('0CAPTAIN, A MESSAGE IS COMING IN ON SUB SPACE RADIO') 713 2 WRITE(5,) MESSAG(WHO*60-59) 10403 714 2 FORMAT(' FREQUENCY ',A1,' ***') 715 2 WRITE(5,) (MESSAG(I),I=WHO*60-58,WHO*60) 10404 716 2 FORMAT(10X,60A1) 717 2 CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59) 718 2 CALL WAIT(2,2,M) 719 1 ENDIF 720 1 IF (ENERGY(WHO) .LT. 900.) .AND. WARN THEN 721 2 TYPE *,' SCOTT HERE CAPTAIN,' 722 2 TYPE *,' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.' 723 2 WARN=.FALSE. 724 1 ELSE 725 2 WARN=.TRUE. 726 1 ENDIF 727 1 C 728 1 C THIS INSTRUCTION IS TO DELAY A HALF SECOND BEFORE CONTINUING 729 1 CALL WAIT(30,0,M) 730 1 C 731 0 ENDDO 732 0 C 733 0 C DECREMENT PLAYER COUNT 734 0 THRU=THRU-1 735 0 STOP 736 0 END 0 PROGRAM PLAYER 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:12 0 LINE LEVEL C1 1 0 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 2 0 C 3 0 COMMON/INBUF/INBUF(50),IOST(2) 4 0 LOGICAL*1 EXIST,OK 5 0 REAL VARI,LOW,HIGH 6 0 BYTE INPUT(15),LEFTED(15) 7 0 INTEGER NCHRS 8 0 IFLAG=0 9 0 GO TO 10 10 0 ENTRY GETRLL 11 0 IFLAG=1 12 0 10 CONTINUE 13 0 OK=.FALSE. 14 0 UNTIL OK 15 0 .DO 16 1 FOR I=1 UNTIL 15 17 1 . DO 18 2 LEFTED(I)=' ' 19 1 ENDDO 20 1 IF IFLAG.EQ.0 THEN 21 2 READ(5,100,END=800) NCHRS,(INPUT(I),I=1,15) 22 2 100 FORMAT(Q,15A1) 23 2 GOTO 810 24 2 800 CLOSE(UNIT=5) 25 2 810 CONTINUE 26 1 ELSE 27 2 NCHRS=IOST(2)-2 28 2 DECODE(17,,INBUF) INPUT 10009 29 2 FORMAT(2X,15A1) 30 2 IFLAG=0 31 1 ENDIF 32 1 SELECT 33 1 WHEN NCHRS .EQ. 0 34 1 . THEN 35 2 OK=.TRUE. 36 2 EXIST=.FALSE. 37 1 WHEN NCHRS .LE. 15 THEN 38 1 C * LEFT ADJUST INPUT 39 2 CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS) 40 2 DECODE(15,,LEFTED,ERR=200) VARI 10018 41 2 FORMAT(G15.0) 42 2 IF VARI .GE. LOW .AND. VARI .LE. HIGH 43 2 . THEN 44 3 OK=.TRUE. 45 3 EXIST=.TRUE. 46 2 ELSE 47 3 WRITE(5,) 10022 48 3 FORMAT(' SORRY CAPTAIN, BUT YOUR COMMAND''S PARAMETER MUST') 49 3 WRITE(5,) LOW,HIGH 10023 50 3 FORMAT(' BE BETWEEN ',F15.4,' AND ',F15.4) 0 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:16 0 LINE LEVEL C1 51 2 ENDIF 52 2 GO TO 300 53 2 200 CONTINUE 54 2 WRITE(5,) 10024 55 2 FORMAT('$WOULD YOU PLEASE REPEAT THAT SIR ? ') 56 2 300 CONTINUE 57 1 OTHERWISE 58 2 WRITE(5,) 10026 59 2 FORMAT('$RUN THAT BY ME AGAIN ! ') 60 1 ENDS 61 0 ENDDO 62 0 RETURN 63 0 END 0 SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH) 1 0 INDENT= 4 WARN= OFF SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:22 0 LINE LEVEL C1 1 0 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 2 0 INTEGER NUM,LOW,HIGH 3 0 COMMON/INBUF/INBUF(50),IOST(2) 4 0 LOGICAL*1 OK,FLAG 5 0 C 6 0 IFLAG=0 7 0 GO TO 10 8 0 ENTRY GETINL 9 0 IFLAG=1 10 0 10 CONTINUE 11 0 C 12 0 OK=.FALSE. 13 0 UNTIL OK DO 14 1 IF IFLAG.EQ.0 THEN 15 2 READ(5,,END=800,ERR=200) NCHRS,NUM 10006 16 2 FORMAT(Q,I5) 17 2 GOTO 810 18 2 800 CLOSE(UNIT=5) 19 2 810 CONTINUE 20 1 ELSE 21 2 NCHRS=IOST(2)-2 22 2 DECODE(7,,INBUF) NUM 10007 23 2 FORMAT(2X,I) 24 2 IFLAG=0 25 1 ENDIF 26 1 IF NCHRS .EQ. 0 THEN 27 2 FLAG=.FALSE. 28 2 OK=.TRUE. 29 1 ELSE 30 2 IF (NUM .GE. LOW) .AND. (NUM .LE. HIGH) THEN 31 3 OK=.TRUE. 32 3 FLAG=.TRUE. 33 2 ELSE 34 3 WRITE(5,) 10014 35 3 FORMAT(' WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS') 36 3 WRITE(5,) LOW,HIGH 10015 37 3 FORMAT('$BETWEEN',I5,' AND ',I5,5X,'TRY AGAIN : ') 38 2 ENDIF 39 2 GOTO 300 40 2 200 CONTINUE 41 2 WRITE(5,) 10016 42 2 FORMAT('$TRY AGAIN BOZO : ') 43 2 300 CONTINUE 44 1 ENDIF 45 0 ENDDO 46 0 RETURN 47 0 END 0 SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH) 1 0 INDENT= 4 WARN= OFF SUBROUTINE YESNO(FLAG) PAGE 1 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:25 0 LINE LEVEL C1 1 0 SUBROUTINE YESNO(FLAG) 2 0 COMMON/INBUF/INBUF(50),IOST(2) 3 0 LOGICAL*1 FLAG,OK 4 0 BYTE YES(4),NO(4) 5 0 BYTE ANSWER(4) 6 0 DATA YES/'Y','E','S',' '/ 7 0 DATA NO/'N','O',' ',' '/ 8 0 C 9 0 IFLAG=O 10 0 GO TO 10 11 0 ENTRY YESNOL 12 0 IFLAG=1 13 0 10 CONTINUE 14 0 C 15 0 OK=.FALSE. 16 0 UNTIL OK DO 17 1 IF IFLAG.EQ.0 THEN 18 2 READ(5,,END=800) NCHRS, (ANSWER(I),I=1,4) 10006 19 2 FORMAT(Q,4A1) 20 2 GOTO 810 21 2 800 CLOSE(UNIT=5) 22 2 810 CONTINUE 23 1 ELSE 24 2 NCHRS=IOST(2)-2 25 2 DECODE(6,,INBUF) ANSWER 10007 26 2 FORMAT(2X,4A1) 27 2 IFLAG=0 28 1 ENDIF 29 1 IF (NCHRS .GT. 4) .OR. (NCHRS .LT. 1) THEN 30 2 NCHRS=4 31 1 ENDIF 32 1 C * CHECK FOR YES 33 1 I=KOMSTR(YES,1,NCHRS,ANSWER,1) 34 1 IF I .EQ. 0 THEN 35 2 FLAG=.TRUE. 36 2 OK=.TRUE. 37 1 ELSE 38 1 C * CHECK FOR A NO 39 2 I=KOMSTR(NO,1,NCHRS,ANSWER,1) 40 2 IF I .EQ. 0 THEN 41 3 FLAG=.FALSE. 42 3 OK=.TRUE. 43 2 ELSE 44 2 C * INCORRECT RESPONSE 45 3 WRITE(5,) 10017 46 3 FORMAT(' ** PLEASE ANSWER "YES" OR "NO" **') 47 3 WRITE(5,) 10018 48 3 FORMAT('$ANSWER ? ') 49 2 ENDIF 50 1 ENDIF 0 SUBROUTINE YESNO(FLAG) 1 0 INDENT= 4 WARN= OFF SUBROUTINE YESNO(FLAG) PAGE 2 KEEP= ON SELECT= GO PUNCH= OFF LABEL= 10000 09-APR-79 INLIST= ON C1= P 11:58:29 0 LINE LEVEL C1 51 0 ENDDO 52 0 RETURN 53 0 END 0 SUBROUTINE YESNO(FLAG)