C ASCII "0" PROGRAM PLAYER C C MAY 1980 BILL CAEL AND BILL WOOD RECODED IN RATFOR C MAY 1980 BILL CAEL AND BILL WOOD ADDED DEFAULT SHIP AND DIRECTION C MAY 1980 BILL WOOD ADDED ENERGY NETS C MAY 1980 BILL CAEL AND BILL WOOD RECODED OUTPUT C MAY 1980 BILL CAEL, BILL WOOD, AND BOB STODOLA C RECODED COMMAND ARG PROMPTING C NOV 1980 BILL WOOD CONVERTED TO RUN ON VAX C NOV 1981 STEPHEN DOVER CONVERTED TO RUN ON RSX11M V 3.2 C ADDED SUPERNOVA CODE. C C TEXT COMMON COMMON/TORPE/TLOCS(6, 10, 2), TDIR(6, 10), IT(6) COMMON/LEDFOR/ENERGY(6), SHIELD(6), XCORD(6), YCORD(6), TORPS(6), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(6), PHA(6), I1, I2, HYPER *(6), ISENT(6, 10), XPOD(6), YPOD(6), DPOD(6), IPOD(6), WPOD(6), XH *OM(6, 4), YHOM(6, 4), WHOM(6, 4), NHOM(6), TRBEAM(6), SCORE(6), CR *EW(6), DIR(6), WARP(6), LAUNCH(6), UNIV(80, 80), TH *RU, XSHIP(6), CLOAK(6), NET(6), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, BHOLE, EMPTY C END COMMON LOGICAL*1OK, DONE, YES, WARN, REFRES, REFTOG LOGICAL QUIKUP REAL SC(9), R(9) INTEGER DEFSHP, OLDSHP REAL DEFDIR, OLDDIR COMMON/DEFLTS/DEFSHP, DEFDIR, OLDDIR, OLDSHP, DEFSHD LOGICAL CLEARF, VERBOS COMMON/MESS/CLEARF, VERBOS COMMON/INBUF/INBUF(20),IOST BYTE ALPHA, MESBUF(80) REAL D1(4) BYTE BLUNK(2) BYTE BLUNK2(2) BYTE OBUFF( - 9: + 9, - 9: + 9) BYTE JUNK, NBUFF COMMON/BNDRY/IXX, IYY, ID, MINID8, JUNK, NBUFF( -9: + 9, -9: + 9) COMMON/CURSOR/TTYPE INTEGER TTYPE BYTE COMMND INTEGER WHO EQUIVALENCE(BLUNK(2), NBUFF( - 9, - 9)) EQUIVALENCE(BLUNK2(2), OBUFF( - 9, - 9)) EQUIVALENCE (INBUF,COMMND) DATA INBUF/20*' '/ DATA BLUNK, BLUNK2/4*' '/ DATA SC/9* - 9999./ DATA R/9* - 9999./ DATA DONE/.FALSE./ DATA OK/.FALSE./ DATA DEFDIR/0.0/, DEFSHD/0.0/ DATA IAST/0/ C C QUIKUP IS SET TRUE IF TERMINAL SPEED EXCEEDS A THRESHOLD C DETERMINED IN GTCHAR. C IF QUIKUP IS TRUE, A FULL SCREEN UPDATE OCCURS EVERY 1/2 SECOND; C AT SLOWER SPEEDS, 1/2 THE SCREEN IS UPDATED EVERY SECOND ON THE C HALF SECOND, THE OTHER 1/2 IS UPDATED EVERY SECOND ON THE SECOND. C THIS ALLOWS ENJOYABLE GAMES ON TERMINALS AS SLOW AS 1200 BAUD. C CALL GTCHAR(QUIKUP) ! GET QUIKUP, INITIALIZE TERMINAL IO WRITE(1, 1001) 1001 FORMAT('0WELCOME TO MULTI-TREK.') 2000 CONTINUE WRITE(1, 1011) 1011 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') DO 2030 I = 1, 6 IF (XSHIP(I)) GOTO 2050 WRITE(1, 1021) I 1021 FORMAT(' SHIP ', I1) 2050 CONTINUE 2030 CONTINUE 2040 CONTINUE WRITE(1, 1031) 1031 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND: ') CALL GETINT(IW, OK, 1, 6, 0) IF (.NOT.(OK)) GOTO 2070 IF (IW .NE. 0) GOTO 2090 OK = .FALSE. GOTO 2010 2090 CONTINUE WHO = IW IF (.NOT.(XSHIP(WHO))) GOTO 2110 WRITE(1, 1041) 1041 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER.') WRITE(1, 1051) 1051 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND? ') CALL YESNO(OK) 2110 CONTINUE GOTO 2080 2070 CONTINUE CALL EXIT 2080 CONTINUE 2010 IF (.NOT.(OK)) GOTO 2000 2020 CONTINUE CALL GETMCR(MESBUF,I) ! GET RID OF MCR COMMAND LINE, IF ANY REFRES = .TRUE. REFTOG = .FALSE. CREW(WHO) = CREW(WHO) + 1 DEFSHP = WHO CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF C SET UP TERMINAL INPUT/OUTPUT PARAMETERS CALL RDAST(IAST,INBUF,IOST,TTYPE) IF (QUIKUP) GOTO 2130 C START 1 SECOND TIMER IF SLOW UPDATE CALL MARK(3, 60, 1) ! EVENT FLAG FOR SLOW UPDATE 2130 CONTINUE CALL MARK(2, 30, 1, IDS) ! START 1/2 SECOND TIMER 2150 CONTINUE 2180 CONTINUE REFTOG = (.NOT.REFTOG) .OR. QUIKUP IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 2200 C DON'T REFRESH IF BLOWN UP! CALL STRMOV(BLUNK, 1, 361, NBUFF, 1) ID = SCAN(WHO) MINID8 = MIN(ID, 8) IXX = XCORD(WHO) IYY = YCORD(WHO) IXLOW = MAX(2, IXX - ID) IXHI = MIN(79, IXX + ID) IYLOW = MAX(2, IYY - ID) IYHI = MIN(79, IYY + MINID8) DO 2220 IX1 = IXLOW, IXHI IX = IX1 - IXX DO 2240 IY1 = IYLOW, IYHI IY = IY1 - IYY ALPHA = UNIV(IX1, IY1) IF (.NOT.((ALPHA .GE. 48+1) .AND. (ALPHA .LE. 48+6) .AND. *(CLOAK(ALPHA-48)))) GOTO 2260 NBUFF(IX, IY) = EMPTY GOTO 2270 2260 CONTINUE IF (ALPHA .GE. 0) GOTO 2280 NBUFF(IX, IY) = '%' GOTO 2290 2280 CONTINUE NBUFF(IX, IY) = ALPHA 2290 CONTINUE 2270 CONTINUE 2240 CONTINUE 2250 CONTINUE 2220 CONTINUE 2230 CONTINUE IF (IXX-ID .GT. 1) GOTO 2300 CALL BNDRY(1, 1, MAX(1, IYY - ID), MIN(80, IYY + MINID8)) GOTO 2310 2300 CONTINUE IF (IXX+ID .LT. 80) GOTO 2320 CALL BNDRY(80, 80, MAX(1, IYY - ID), MIN(80, IYY + MINI *D8)) 2320 CONTINUE 2310 CONTINUE IF (IYY-ID .GT. 1) GOTO 2340 CALL BNDRY(MAX(1, IXX - ID), MIN(79, IXX + ID), 1, 1) GOTO 2350 2340 CONTINUE IF (IYY+ID .LT. 80) GOTO 2360 CALL BNDRY(MAX(1, IXX - ID), MIN(79, IXX + ID), 80, 80) 2360 CONTINUE 2350 CONTINUE IF (NBUFF(-ID, -ID) .NE. EMPTY) GOTO 2380 NBUFF( - ID, - ID) = '.' 2380 CONTINUE IF (NBUFF(-ID, MINID8) .NE. EMPTY) GOTO 2400 NBUFF( - ID, MINID8) = '.' 2400 CONTINUE IF (NBUFF(ID, MINID8) .NE. EMPTY) GOTO 2420 NBUFF(ID, MINID8) = '.' 2420 CONTINUE IF (NBUFF(ID, -ID) .NE. EMPTY) GOTO 2450 NBUFF(ID, - ID) = '.' 2450 CONTINUE DO 2460 IY = - 9, + 8 ICURSX = - 999 DO 2480 IX = - 9, + 9 IF (NBUFF(IX, IY) .EQ. OBUFF(IX, IY)) GOTO 2500 IF (ICURSX .LT. IX-2) GOTO 2520 DO 2540 III = ICURSX + 1, IX CALL OUTCH(' ', 1) CALL OUTCH(NBUFF(III, IY), 1) 2540 CONTINUE 2550 CONTINUE GOTO 2530 2520 CONTINUE CALL TPOS(9 - IY, 2*IX + 43) CALL OUTCH(NBUFF(IX, IY), 1) 2530 CONTINUE ICURSX = IX OBUFF(IX, IY) = NBUFF(IX, IY) 2500 CONTINUE 2480 CONTINUE 2490 CONTINUE 2460 CONTINUE 2470 CONTINUE CALL OUTCH(0, - 1) C C THE FOLLOWING WAIT CONTROLS THE UPDATE RATE, WHICH IS NORMALLY C SET TO A HALF SECOND (30 CLOCK TICKS). C 2200 CONTINUE IF (.NOT.(COMMND .NE. ' ' .AND. XSHIP(WHO))) GOTO 2560 IF (.NOT.(REFTOG)) GOTO 2580 CALL WFLOR(2,4) ! WAIT FOR AN EVENT TO OCCUR CALL CANMT ! CANCEL MARK TIMES CALL CLREF(2) ! CLEAR EVENT FLAG 2 CALL CLREF(4,IFLAG) ! CLEAR EVENT FLAG 4 IF (.NOT.(QUIKUP)) GOTO 2600 CALL MARK(2, 30, 1) ! RESTART 1/2 SECOND TIMER 2600 CONTINUE GOTO 2590 2580 CONTINUE CALL WAITFR(3,4) CALL CANMT ! CANCEL MARK TIMES CALL CLREF(3) ! CLEAR EVENT FLAG 2 CALL CLREF(4,IFLAG) ! CLEAR EVENT FLAG 4 CALL MARK(3, 60, 1) ! RESTART 1 SECOND TIMER CALL MARK(2, 30, 1) ! RESTART 1/2 SECOND TIMER 2590 CONTINUE 2560 CONTINUE IF(IAST .NE. 0) GOTO 2635 IASTT=0 GOTO 2665 2635 CONTINUE IAST=0 IASTT=1 IF(IOST .EQ. 0) COMMND='$' 2665 CONTINUE C C CHECK FOR NO INPUT C IF(IASTT .EQ. 0) GOTO 2650 IF (COMMND .EQ. 0) GOTO 2650 C CALL CLRLNS(19,1) ! CLEAR COMMAND AND MESSAGE AREA C LONG RANGE SCAN COMMAND C 2640 CONTINUE IF (COMMND .NE. 'L') GOTO 2660 IF(IOST .NE. 1) GOTO 2675 IF(DEFSHP .EQ. 0) WRITE(1,400) 400 FORMAT('$FREQUENCY? ') CALL GETINT(II, OK, 1, 6, DEFSHP) GOTO 2685 2675 CONTINUE CALL GETINL(II, OK, 1, 6, DEFSHP) 2685 CONTINUE IF (.NOT.(OK)) GOTO 2680 DEFSHP = II IX = XCORD(II)/10. IY = YCORD(II)/10. CALL TPOS(17, 75) ENCODE(5, 1071, MESBUF) IX, IY 1071 FORMAT(I2, ',', I2) CALL OUTCH(MESBUF, 5) XX = XCORD(WHO) YY = YCORD(WHO) X1 = XCORD(II) IF (X1 .GE. 41.) GOTO 2700 X2 = X1 + 80. GOTO 2710 2700 CONTINUE X2 = X1 - 80. 2710 CONTINUE Y1 = YCORD(II) IF (Y1 .GE. 41.) GOTO 2720 Y2 = Y1 + 80. GOTO 2730 2720 CONTINUE Y2 = Y1 - 80. 2730 CONTINUE D1(1) = ((XX - X1)**2 + (YY - Y1)**2)**.5 D1(2) = ((XX - X1)**2 + (YY - Y2)**2)**.5 D1(3) = ((XX - X2)**2 + (YY - Y1)**2)**.5 D1(4) = ((XX - X2)**2 + (YY - Y2)**2)**.5 IIT = 1 DO 2740 J = 2, 4 IF (D1(J) .GE. D1(IIT)) GOTO 2760 IIT = J 2760 CONTINUE 2740 CONTINUE 2750 CONTINUE D = D1(IIT) IF (IIT .NE. 1) GOTO 2780 YD = Y1 XD = X1 GOTO 2790 2780 CONTINUE IF (IIT .NE. 2) GOTO 2800 YD = Y2 XD = X1 GOTO 2810 2800 CONTINUE IF (IIT .NE. 3) GOTO 2820 YD = Y1 XD = X2 GOTO 2830 2820 CONTINUE YD = Y2 XD = X2 2830 CONTINUE 2810 CONTINUE 2790 CONTINUE EDIS = D EDIR = ATAN3((YD - YY), (XD - XX))*57.29577951 IF (EDIR .GE. 0.) GOTO 2840 EDIR = EDIR + 360. 2840 CONTINUE IF (EDIR .LE. 90.) GOTO 2860 EDIR = (450. - EDIR)/30. GOTO 2870 2860 CONTINUE EDIR = (90. - EDIR)/30. 2870 CONTINUE DEFDIR = EDIR CALL TPOS(16, 75) ENCODE(5, 1081, MESBUF) EDIS 1081 FORMAT(F5.2) CALL OUTCH(MESBUF, 5) CALL TPOS(15, 75) ENCODE(5, 1081, MESBUF) EDIR CALL OUTCH(MESBUF, 5) CALL TPOS(14, 79) ENCODE(1, 1101, MESBUF) DEFSHP 1101 FORMAT(I1) CALL OUTCH(MESBUF, 1) CALL OUTCH(0, - 1) 2680 CONTINUE C C TORPEDO COMMAND C GOTO 2670 2660 CONTINUE IF (COMMND .NE. 'T') GOTO 2880 IF (LAUNCH(WHO) .GE. 0.) GOTO 2900 IF (TORPS(WHO) .LE. 0) GOTO 2920 IF(IOST .NE. 1) GOTO 2935 IF(DEFSHP .EQ. 0) WRITE(1,550) 550 FORMAT('$TORPEDO COURSE? ') CALL GETREL(VALUE, OK, 0., 12., DEFDIR) GOTO 2945 2935 CALL GETRLL(VALUE, OK, 0., 12., DEFDIR) 2945 CONTINUE IF (.NOT.(OK)) GOTO 2940 DEFDIR = VALUE IF (VALUE .LT. 3.) GOTO 2960 VALUE = (15. - VALUE)*30. GOTO 2970 2960 CONTINUE VALUE = (3. - VALUE)*30. 2970 CONTINUE LAUNCH(WHO) = VALUE TORPS(WHO) = TORPS(WHO) - 1 IF (TORPS(WHO) .NE. 0) GOTO 2980 CALL MESSGE('LAST TORPEDO!') 2980 CONTINUE 2940 CONTINUE GOTO 2930 2920 CONTINUE CALL MESSGE('NO TORPEDOES!') 2930 CONTINUE GOTO 2910 2900 CONTINUE CALL MESSGE('TORPEDOES NOT READY') 2910 CONTINUE C C PHASER COMMAND C GOTO 2890 2880 CONTINUE IF (COMMND .NE. 'P') GOTO 3000 IF (PHA(WHO) .GE. 0.) GOTO 3020 IF(IOST .NE. 1) GOTO 2885 IF( DEFSHP .EQ. 0) WRITE(1,560) 560 FORMAT('$PHASER COURSE? ') CALL GETREL(VALUE, OK, 0., 12., DEFDIR) GOTO 2895 2885 CALL GETRLL(VALUE, OK, 0., 12., DEFDIR) 2895 CONTINUE IF (.NOT.(OK)) GOTO 3040 DEFDIR = VALUE IF (VALUE .LT. 3.) GOTO 3060 VALUE = (15. - VALUE)*30. GOTO 3070 3060 CONTINUE VALUE = (3. - VALUE)*30. 3070 CONTINUE PHA(WHO) = VALUE ENERGY(WHO) = ENERGY(WHO) - 50. 3040 CONTINUE GOTO 3030 3020 CONTINUE CALL MESSGE('PHASERS NOT READY') 3030 CONTINUE C C HOMING TORPEDO LAUNCH C GOTO 3010 3000 CONTINUE IF (COMMND .NE. 'K') GOTO 3080 IF (NHOM(WHO) .NE. 4) GOTO 3100 TWHOM = 0. GOTO 3110 3100 CONTINUE TWHOM = WHOM(WHO, NHOM(WHO) + 1) 3110 CONTINUE IF (TWHOM .LT. 0.) GOTO 3120 IF (NHOM(WHO) .LE. 0) GOTO 3140 IF(IOST .NE. 1) GOTO 3055 IF(DEFSHP .EQ. 0) WRITE(1,570) 570 FORMAT('$HOMING FREQUENCY? ') CALL GETINT(II, OK, 1, 6, DEFSHP) GOTO 3065 3055 CALL GETINL(II, OK, 1, 6, DEFSHP) 3065 CONTINUE IF (.NOT.(OK)) GOTO 3160 DEFSHP = II IF (II .NE. WHO) GOTO 3180 CALL MESSGE('TORPEDOES JAMMED!') NHOM(WHO) = 0 TORPS(WHO) = 0 GOTO 3190 3180 CONTINUE WHOM(WHO, NHOM(WHO)) = - II NHOM(WHO) = NHOM(WHO) - 1 3190 CONTINUE 3160 CONTINUE GOTO 3150 3140 CONTINUE CALL MESSGE('NO HOMERS!') 3150 CONTINUE GOTO 3130 3120 CONTINUE CALL MESSGE('HOMERS NOT READY') 3130 CONTINUE C C WARP FACTOR COMMAND C GOTO 3090 3080 CONTINUE IF (COMMND .NE. 'W') GOTO 3200 IF(IOST .NE. 1) GOTO 3085 WRITE(1,580) 580 FORMAT('$WARP SIR? ') CALL GETREL(VALUE, OK, 0., 8., WARP(WHO)) GOTO 3095 3085 CALL GETRLL(VALUE, OK, 0., 8., WARP(WHO)) 3095 CONTINUE IF (.NOT.(OK)) GOTO 3220 WARP(WHO) = VALUE 3220 CONTINUE C C COURSE COMMAND C GOTO 3210 3200 CONTINUE IF (COMMND .NE. 'C') GOTO 3240 IF(IOST .NE. 1) GOTO 3205 IF(DEFSHP .EQ. 0) WRITE(1,590) 590 FORMAT('$COURSE SIR? ') CALL GETREL(VALUE, OK, 0., 12., DEFDIR) GOTO 3215 3205 CALL GETRLL(VALUE, OK, 0., 12., DEFDIR) 3215 CONTINUE IF (.NOT.(OK)) GOTO 3260 IF (VALUE .LT. 3.) GOTO 3280 DIR(WHO) = (15. - VALUE)*30. GOTO 3290 3280 CONTINUE DIR(WHO) = (3. - VALUE)*30. 3290 CONTINUE 3260 CONTINUE C C EXPLODE ANTI-MATTER DEVICE C GOTO 3250 3240 CONTINUE IF (COMMND .NE. 'X') GOTO 3300 IF (IPOD(WHO) .NE. 2) GOTO 3320 IPOD(WHO) = 3 CALL MESSGE('DETONATION SIGNALED') GOTO 3330 3320 CONTINUE CALL MESSGE('NO POD!') 3330 CONTINUE C C CONVERT MOVING ANTI-MATTER POD TO A STATIC MINE C GOTO 3310 3300 CONTINUE IF (COMMND .NE. 'N') GOTO 3340 IF (IPOD(WHO) .NE. 2) GOTO 3360 WPOD(WHO) = 0. CALL MESSGE('POD POSITIONED') GOTO 3370 3360 CONTINUE CALL MESSGE('NO POD!') 3370 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GOTO 3350 3340 CONTINUE IF (COMMND .NE. 'Z') GOTO 3380 IF (IPOD(WHO) .NE. 0) GOTO 3400 IF(IOST .NE. 1) GOTO 3345 IF(DEFSHP .EQ. 0) WRITE(1,600) 600 FORMAT('$POD COURSE? ') CALL GETREL(VALUE, OK, 0., 12., DEFDIR) GOTO 3355 3345 CALL GETRLL(VALUE, OK, 0., 12., DEFDIR) 3355 CONTINUE IF (.NOT.(OK)) GOTO 3420 DEFDIR = VALUE IF (VALUE .LT. 3.) GOTO 3440 DPOD(WHO) = (15. - VALUE)*30. GOTO 3450 3440 CONTINUE DPOD(WHO) = (3. - VALUE)*30. 3450 CONTINUE IPOD(WHO) = 1 3420 CONTINUE GOTO 3410 3400 CONTINUE CALL MESSGE('NO POD!') 3410 CONTINUE C C HYPERSPACE COMMAND C GOTO 3390 3380 CONTINUE IF (COMMND .NE. 'H') GOTO 3460 IUNIQ = HYPER(WHO) IF(IOST .NE. 1) GOTO 3385 WRITE(1,610) 610 FORMAT('$HYPER PORT? ') CALL GETINT(II, OK, 1, 6, IUNIQ) GOTO 3395 3385 CALL GETINL(II, OK, 1, 6, IUNIQ) 3395 CONTINUE IF (.NOT.(OK)) GOTO 3480 HYPER(WHO) = II 3480 CONTINUE C C SHIELD COMMAND C GOTO 3470 3460 CONTINUE IF (COMMND .NE. 'S') GOTO 3500 IF(IOST .NE. 1) GOTO 3465 IF(DEFSHD .EQ. 0) WRITE(1,620) 620 FORMAT('$ENERGY CHANGE? ') CALL GETREL(VALUE, OK *, - 1.E36, 1.E36, DEFSHD) GOTO 3475 3465 CALL GETRLL(VALUE, OK, -1.E36, 1.E36, * DEFSHD) 3475 CONTINUE IF (.NOT.(OK)) GOTO 3520 IF (.NOT.(ENERGY(WHO)-VALUE .GE. 0. .A *ND. SHIELD(WHO)+VALUE .GE. 0.)) GOTO 3540 ENERGY(WHO) = ENERGY(WHO) - VALUE SHIELD(WHO) = SHIELD(WHO) + VALUE IF (VALUE.LT.0.0) GOTO 3560 DEFSHD = VALUE 3560 CONTINUE GOTO 3550 3540 CONTINUE CALL MESSGE('?! IMPOSSIBLE !?') 3550 CONTINUE 3520 CONTINUE C C FLIP ENERGY NET ON OR OFF C GOTO 3510 3500 CONTINUE IF (COMMND .NE. 'E') GOTO 3580 NET(WHO) = .NOT.NET(WHO) C C TRACTOR BEAM C GOTO 3590 3580 CONTINUE IF (COMMND .NE. 'B') GOTO 3600 IF(IOST .NE. 1) GOTO 3585 IF(DEFSHP .EQ. 0) WRITE(1,630) 630 FORMAT('$BEAM FREQUENCY? ') CALL GETINT(II, OK, 0, 8, DEFSHP) GOTO 3595 3585 CALL GETINL(II, OK, 0, 8, DEFSHP) 3595 CONTINUE IF (.NOT.(OK)) GOTO 3620 IF (II .EQ. 0) GOTO 3640 DEFSHP = II 3640 CONTINUE IF (II .NE. WHO) GOTO 3660 CALL MESSGE('? HUH ?') GOTO 3670 3660 CONTINUE TRBEAM(WHO) = II 3670 CONTINUE 3620 CONTINUE C C CLOAKING COMMAND C GOTO 3610 3600 CONTINUE IF (COMMND .NE. 'F') GOTO 3680 IF (CLOAK(WHO)) GOTO 3700 CLOAK(WHO) = .TRUE. GOTO 3710 3700 CONTINUE CALL MESSGE('ALREADY CLOAKED!') 3710 CONTINUE C C APPEAR COMMAND C GOTO 3690 3680 CONTINUE IF (COMMND .NE. 'A') GOTO 3720 IF (.NOT.(CLOAK(WHO))) GOTO 3740 CLOAK(WHO) = .FALSE. GOTO 3750 3740 CONTINUE CALL MESSGE('NOT CLOAKED!') 3750 CONTINUE C C FLIP VERBOSE MESSAGES ON OR OFF C GOTO 3730 3720 CONTINUE IF (COMMND .NE. 'V') GOTO 3760 VERBOS = .NOT.VERBOS C C REFRESH COMMAND C GOTO 3770 3760 CONTINUE IF (COMMND .NE. 'R') GOTO 3780 CALL STRMOV(BLUNK2, 1, 361, *OBUFF, 1) CALL RBUFF DO 3800 I = 1, 9 SC(I) = - 9999. R(I) = - 9999. 3800 CONTINUE 3810 CONTINUE OLDSHP = 0 OLDDIR = - 1.0 GOTO 3790 3780 CONTINUE GOTO 3820 3900 CONTINUE 3910 CONTINUE 3880 CONTINUE 3840 CONTINUE C C QUIT COMMAND C GOTO 3830 3820 CONTINUE IF (COMMND .NE. 'Q' *) GOTO 3960 IF(IOST .NE. 1) GOTO 3825 CALL YESNO(DONE) GOTO 3835 3825 CALL YESNOL(DONE) 3835 CONTINUE C C HELP COMMAND C GOTO 3970 3960 CONTINUE IF (COMMND .NE. '? *') GOTO 3980 CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'A APPEAR (CLOAKING OFF) * T FIRE TORPEDOES', .TRUE.) CALL OUTSTR(.TRUE., 'C COURSE HEADING N FREEZE ANTI-MA *TTER W SET WARP SPEED', .TRUE.) CALL OUTSTR(.TRUE., 'F FADE (CLOAKING ON) P FIRE PHASERS * X DETONATE ANTI-MATTER', .TRUE.) CALL OUTSTR(.TRUE., 'H HYPERSPACE SETTING Q QUIT * Z LAUNCH ANTI-MATTER', .TRUE.) CALL OUTSTR(.TRUE., 'K FIRE HOMING TORPEDO R RESET DISPLAY * V VERBOSE ON/OFF', .TRUE.) CALL OUTSTR(.TRUE., 'L LOCATE SHIP S SHIELD CHANGE * E ENERGY NETS ON/OFF', .TRUE.) CALL TPOS(1, 1) CALL OUTCH(0, 0) C C ERROR C GOTO 3990 3980 CONTINUE IF(COMMND .EQ. '$') GOTO 4000 CALL MESSGE('?! WHAT !?') 4000 CONTINUE 3990 CONTINUE 3970 CONTINUE 3830 CONTINUE 3790 CONTINUE 3770 CONTINUE 3730 CONTINUE 3690 CONTINUE 3610 CONTINUE 3590 CONTINUE 3510 CONTINUE 3470 CONTINUE 3390 CONTINUE 3350 CONTINUE 3310 CONTINUE 3250 CONTINUE 3210 CONTINUE 3090 CONTINUE 3010 CONTINUE 2890 CONTINUE 2670 CONTINUE COMMND=0 2650 CONTINUE IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 4020 CALL REFRSH(SC, R, WHO) 4020 CONTINUE IF(IFLAG .NE. 2) GOTO 4025 IFLAG=0 ! CLEAR FLAG CALL ENASTR ! THIS RE-ENABLES AST'S FOR THE INPUT BUFFER 4025 CONTINUE IF (.NOT.(REFRES)) GOTO 4040 XSHIP(WHO) = .TRUE. REFRES = .FALSE. REFTOG = .FALSE. C C WRITE OUT MESSAGES FROM DRIVER C 4040 CONTINUE DO 4060 I = 1, 10 IF (ISENT(WHO, I) .EQ. 0) GOTO 4080 J = ISENT(WHO, I) ISENT(WHO, I) = 0 GO TO(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, * 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 3 *3, 34, 35, 36,37), J 1 CONTINUE CALL MESSGE('DOCKED.') GOTO 4060 2 CONTINUE CALL MESSGE('- HIT A STAR!') GOTO 4060 3 CONTINUE DO 4100 IK = 1, 2 CALL CLEAR CALL OUTCH(0, 0) WRITE(1, 1131) 1131 FORMAT(//////////, 25X, '*** BOOM ***') 4100 CONTINUE 4110 CONTINUE WRITE(1, 1141) 1141 FORMAT('0YOUR SHIP HAS BEEN DESTROYED'/, ' FORTUNATELY YOU E *SCAPED WITH YOUR LIFE.'/, ' UNFORTUNATELY, YOU HAVE BEEN GIVEN A N *EW COMMAND.'//, '$ARE YOU READY TO ACCEPT THIS ASSIGNMENT? ') CALL YESNO(YES) IF (.NOT.(YES)) GOTO 4120 WRITE(1, 1142) 1142 FORMAT(' GOOD!') CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF DO 4140 K = 1, 9 SC(K) = - 9999. R(K) = - 9999. 4140 CONTINUE 4150 CONTINUE OLDDIR = - 1.0 OLDSHP = 0 REFRES = .TRUE. GOTO 4130 4120 CONTINUE DONE = .TRUE. 4130 CONTINUE GOTO 4060 4 CONTINUE CALL MESSGE('- TORPEDO HIT US!') GOTO 4060 5 CONTINUE CALL MESSGE('+ TORPEDO HIT ALIEN!') GOTO 4060 6 CONTINUE CALL MESSGE('+ PHASER HIT ALIEN!') GOTO 4060 7 CONTINUE CALL MESSGE('PHASER HIT TORPEDO') GOTO 4060 8 CONTINUE CALL MESSGE('PHASERS MISSED') GOTO 4060 9 CONTINUE CALL MESSGE('- RAMMED ALIEN!') GOTO 4060 10 CONTINUE CALL MESSGE('- COLLISION!') GOTO 4060 11 CONTINUE CALL MESSGE('PHASER HIT STAR') GOTO 4060 12 CONTINUE CALL MESSGE('- BASE UNDER ATTACK') GOTO 4060 13 CONTINUE CALL MESSGE('TORPEDO HIT STAR') GOTO 4060 14 CONTINUE CALL MESSGE('- PHASER ATTACK!') GOTO 4060 15 CONTINUE CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'SPOCK HERE CAPTAIN. ', .TRUE.) CALL OUTSTR(.TRUE., 'WE ARE BEING DRAWN INTO SOME SORT OF BL *ACK HOLE,', .TRUE.) CALL OUTSTR(.TRUE., 'IT IS UNLIKE ANYTHING I HAVE EVER ENCOU *NTERED.', .TRUE.) CALL OUTSTR(.TRUE., 'FASCINATING.', .TRUE.) CALL WAIT(1, 2, M) GOTO 4060 16 CONTINUE CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'SCOTT HERE CAPTAIN. ', .TRUE.) CALL OUTSTR(.TRUE., 'OUR DYLITHIUM CRYSTALS ARE GONE. LIFE S *UPPORT IS', .TRUE.) CALL OUTSTR(.TRUE., 'FAILING ...!', .TRUE.) CALL WAIT(1, 2, M) GOTO 4060 17 CONTINUE CALL MESSGE('HYPERSPACE!') GOTO 4060 18 CONTINUE CALL MESSGE('HYPERSPACE BLOCKED!') GOTO 4060 19 CONTINUE CALL MESSGE('RANDOM HYPERSPACE!') GOTO 4060 20 CONTINUE CALL MESSGE('TORPEDO HIT TORPEDO') GOTO 4060 21 CONTINUE CALL MESSGE('HIT GHOST SHIP') GOTO 4060 22 CONTINUE CALL MESSGE('*** ALIEN DESTROYED!') CALL MESSGE('********************') GOTO 4060 23 CONTINUE CALL MESSGE('POD BLOCKED!') GOTO 4060 24 CONTINUE CALL MESSGE('POD DESTROYED!') GOTO 4060 25 CONTINUE CALL MESSGE('PHASER HIT POD') GOTO 4060 26 CONTINUE CALL MESSGE('TORPEDO HIT POD') GOTO 4060 27 CONTINUE CALL MESSGE('- METAL OBJECT NEAR') GOTO 4060 28 CONTINUE CALL MESSGE('POD LAUNCHED') GOTO 4060 29 CONTINUE CALL MESSGE('POD DETONATED!') GOTO 4060 30 CONTINUE CALL MESSGE('- POD EXPLOSION!') GOTO 4060 31 CONTINUE CALL MESSGE('IIEEEEEE!') GOTO 4060 32 CONTINUE CALL MESSGE('+ POD HIT ALIEN!') GOTO 4060 33 CONTINUE CALL MESSGE('- HIT NET!') GOTO 4060 34 CONTINUE CALL MESSGE('TORPEDO HIT NET') GOTO 4060 35 CONTINUE CALL MESSGE('PHASER HIT NET') GOTO 4060 36 CONTINUE CALL MESSGE('NET BLOCKED!') GOTO 4060 37 CONTINUE CALL MESSGE('STAR GOING SUPERNOVA!') GOTO 4060 4080 CONTINUE 4060 CONTINUE 4070 CONTINUE IF (.NOT.((ENERGY(WHO) .LT. 900.) .AND. WARN)) GOTO 4180 CALL MESSGE('ENERGY LOW!') WARN = .FALSE. GOTO 4190 4180 CONTINUE WARN = .TRUE. 4190 CONTINUE CALL MESSGE(0) 2160 IF (.NOT.(DONE)) GOTO 2150 2170 CONTINUE CREW(WHO) = CREW(WHO) - 1 IF (CREW(WHO) .LE. 400) XSHIP(WHO) = .FALSE. CALL CLEAR CALL OUTCH(0, 0) CALL EXIT END