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