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 C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), 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, MESSAG, 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 BYTE BLANK(80), ALPHA, MESBUF(60) 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) INTEGER COMMND INTEGER WHO EQUIVALENCE(BLUNK(2), NBUFF( - 9, - 9)) EQUIVALENCE(BLUNK2(2), OBUFF( - 9, - 9)) DATA BLANK/80*' '/ 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/ 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 C GET QUIKUP, INITIALIZE TERMINAL IO CALL GTCHAR(QUIKUP) WRITE(5, 1001) 1001 FORMAT('0WELCOME TO MULTI-TREK.') 2000 CONTINUE WRITE(5, 1011) 1011 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') DO 2030 I = 1, 8 IF (.NOT.(.NOT.XSHIP(I))) GOTO 2050 WRITE(5, 1021) I 1021 FORMAT(' SHIP ', I1) 2050 CONTINUE 2030 CONTINUE 2040 CONTINUE WRITE(5, 1031) 1031 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND: ') CALL GETINT(0, IW, OK, 1, 8, 0) IF (.NOT.(OK)) GOTO 2070 IF (.NOT.(IW .EQ. 0)) GOTO 2090 OK = .FALSE. GOTO 2010 2090 CONTINUE WHO = IW IF (.NOT.(XSHIP(WHO))) GOTO 2110 WRITE(5, 1041) 1041 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER.') WRITE(5, 1051) 1051 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND? ') CALL YESNO(0, OK) 2110 CONTINUE GOTO 2080 2070 CONTINUE CALL EXIT 2080 CONTINUE 2010 IF (.NOT.(OK)) GOTO 2000 2020 CONTINUE REFRES = .TRUE. REFTOG = .FALSE. CREW(WHO) = CREW(WHO) + 1 DEFSHP = WHO CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF IF (.NOT.(.NOT.QUIKUP)) GOTO 2130 C START 1 SECOND TIMER IF SLOW UPDATE CALL MARK(3, 60, 1, IDS) 2130 CONTINUE C START 1/2 SECOND TIMER CALL MARK(2, 30, 1, IDS) 2150 CONTINUE C C THE FOLLOWING CALL SPAWNS THE MTREKD UNIVERSE MANAGER TASK ON TT0:. C IF YOU CANNOT DO SOMETHING SIMILAR, YOU MUST START MTREKD YOURSELF C BEFORE PLAYING EACH GAME. C IF (.NOT.(THRU)) GOTO 2180 C THEN MTREKD ISN'T RUNNING CALL RUNMTR C C PLACE LOCAL SCAN ON TERMINAL C 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(99, IXX + ID) IYLOW = MAX(2, IYY - ID) IYHI = MIN(99, 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+8) .AND. *(CLOAK(ALPHA-48)))) GOTO 2260 NBUFF(IX, IY) = EMPTY GOTO 2270 2260 CONTINUE IF (.NOT.(ALPHA .LT. 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 (.NOT.(IXX-ID .LE. 1)) GOTO 2300 CALL BNDRY(1, 1, MAX(1, IYY - ID), MIN(100, IYY + MINID8)) GOTO 2310 2300 CONTINUE IF (.NOT.(IXX+ID .GE. 100)) GOTO 2320 CALL BNDRY(100, 100, MAX(1, IYY - ID), MIN(100, IYY + MINI *D8)) 2320 CONTINUE 2310 CONTINUE IF (.NOT.(IYY-ID .LE. 1)) GOTO 2340 CALL BNDRY(MAX(1, IXX - ID), MIN(99, IXX + ID), 1, 1) GOTO 2350 2340 CONTINUE IF (.NOT.(IYY+ID .GE. 100)) GOTO 2360 CALL BNDRY(MAX(1, IXX - ID), MIN(99, IXX + ID), 100, 100) 2360 CONTINUE 2350 CONTINUE IF (.NOT.(NBUFF(-ID, -ID) .EQ. EMPTY)) GOTO 2380 NBUFF( - ID, - ID) = '.' 2380 CONTINUE IF (.NOT.(NBUFF(-ID, MINID8) .EQ. EMPTY)) GOTO 2400 NBUFF( - ID, MINID8) = '.' 2400 CONTINUE IF (.NOT.(NBUFF(ID, MINID8) .EQ. EMPTY)) GOTO 2420 NBUFF(ID, MINID8) = '.' 2420 CONTINUE IF (.NOT.(NBUFF(ID, -ID) .EQ. EMPTY)) GOTO 2440 NBUFF(ID, - ID) = '.' 2440 CONTINUE DO 2460 IY = - 9, + 8 ICURSX = - 999 DO 2480 IX = - 9, + 9 IF (.NOT.(NBUFF(IX, IY) .NE. OBUFF(IX, IY))) GOTO 2500 IF (.NOT.(ICURSX .GE. 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 WAITFR(2, IDS) IF (.NOT.(QUIKUP)) GOTO 2600 C RESTART 1/2 SECOND TIMER CALL MARK(2, 30, 1, IDS) 2600 CONTINUE GOTO 2590 2580 CONTINUE CALL WAITFR(3, IDS) C RESTART 1 SECOND TIMER CALL MARK(3, 60, 1, IDS) C RESTART 1/2 SECOND TIMER CALL MARK(2, 30, 1, IDS) 2590 CONTINUE 2560 CONTINUE NC = 1 COMMND = '0 ' IF (.NOT.(XSHIP(WHO))) GOTO 2620 CALL TREAD(COMMND, NC) C C CHECK FOR NO INPUT C 2620 CONTINUE IF (.NOT.(COMMND .EQ. '0 ')) GOTO 2640 C C LONG RANGE SCAN COMMAND C GOTO 2650 2640 CONTINUE IF (.NOT.(COMMND .EQ. 'L ')) GOTO 2660 CALL GETINT('FREQUENCY? ', II, OK, 1, 8, DEFSHP) 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 (.NOT.(X1 .LT. 51.)) GOTO 2700 X2 = X1 + 100. GOTO 2710 2700 CONTINUE X2 = X1 - 100. 2710 CONTINUE Y1 = YCORD(II) IF (.NOT.(Y1 .LT. 51.)) GOTO 2720 Y2 = Y1 + 100. GOTO 2730 2720 CONTINUE Y2 = Y1 - 100. 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 (.NOT.(D1(J) .LT. D1(IIT))) GOTO 2760 IIT = J 2760 CONTINUE 2740 CONTINUE 2750 CONTINUE D = D1(IIT) IF (.NOT.(IIT .EQ. 1)) GOTO 2780 YD = Y1 XD = X1 GOTO 2790 2780 CONTINUE IF (.NOT.(IIT .EQ. 2)) GOTO 2800 YD = Y2 XD = X1 GOTO 2810 2800 CONTINUE IF (.NOT.(IIT .EQ. 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 (.NOT.(EDIR .LT. 0.)) GOTO 2840 EDIR = EDIR + 360. 2840 CONTINUE IF (.NOT.(EDIR .GT. 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, 1091, MESBUF) EDIR 1091 FORMAT(F5.2) 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 (.NOT.(COMMND .EQ. 'T ')) GOTO 2880 IF (.NOT.(LAUNCH(WHO) .LT. 0.)) GOTO 2900 IF (.NOT.(TORPS(WHO) .GT. 0)) GOTO 2920 CALL GETREL('TORPEDO COURSE? ', VALUE, OK, 0., 12., DE *FDIR) IF (.NOT.(OK)) GOTO 2940 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 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 (.NOT.(TORPS(WHO) .EQ. 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 (.NOT.(COMMND .EQ. 'P ')) GOTO 3000 IF (.NOT.(PHA(WHO) .LT. 0.)) GOTO 3020 CALL GETREL('PHASER COURSE? ', VALUE, OK, 0., 12., DEF *DIR) IF (.NOT.(OK)) GOTO 3040 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 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 (.NOT.(COMMND .EQ. 'K ')) GOTO 3080 IF (.NOT.(NHOM(WHO) .EQ. 4)) GOTO 3100 TWHOM = 0. GOTO 3110 3100 CONTINUE TWHOM = WHOM(WHO, NHOM(WHO) + 1) 3110 CONTINUE IF (.NOT.(TWHOM .GE. 0.)) GOTO 3120 IF (.NOT.(NHOM(WHO) .GT. 0)) GOTO 3140 CALL GETINT('HOMING FREQUENCY? ', II, OK, 1, 8, DE *FSHP) IF (.NOT.(OK)) GOTO 3160 DEFSHP = II IF (.NOT.(II .EQ. 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 (.NOT.(COMMND .EQ. 'W ')) GOTO 3200 CALL GETREL('WARP SIR? ', VALUE, OK, 0., 8., WARP(WH *O)) IF (.NOT.(OK)) GOTO 3220 WARP(WHO) = VALUE 3220 CONTINUE C C COURSE COMMAND C GOTO 3210 3200 CONTINUE IF (.NOT.(COMMND .EQ. 'C ')) GOTO 3240 CALL GETREL('COURSE SIR? ', VALUE, OK, 0., 12., DE *FDIR) IF (.NOT.(OK)) GOTO 3260 IF (.NOT.(VALUE .GE. 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 (.NOT.(COMMND .EQ. 'X ')) GOTO 3300 IF (.NOT.(IPOD(WHO) .EQ. 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 (.NOT.(COMMND .EQ. 'N ')) GOTO 3340 IF (.NOT.(IPOD(WHO) .EQ. 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 (.NOT.(COMMND .EQ. 'Z ')) GOTO 3380 IF (.NOT.(IPOD(WHO) .EQ. 0)) GOTO 3400 CALL GETREL('POD COURSE? ', VALUE, OK, 0., * 12., DEFDIR) IF (.NOT.(OK)) GOTO 3420 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 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 (.NOT.(COMMND .EQ. 'H ')) GOTO 3460 IUNIQ = HYPER(WHO) CALL GETINT('HYPER PORT? ', II, OK, 1, 6, *IUNIQ) IF (.NOT.(OK)) GOTO 3480 HYPER(WHO) = II 3480 CONTINUE C C SHIELD COMMAND C GOTO 3470 3460 CONTINUE IF (.NOT.(COMMND .EQ. 'S ')) GOTO 3500 CALL GETREL('ENERGY CHANGE? ', VALUE, OK *, - 1.E36, 1.E36, DEFSHD) 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 (.NOT.(VALUE.GE.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 (.NOT.(COMMND .EQ. 'E ')) GOTO 3580 NET(WHO) = .NOT.NET(WHO) C C TRACTOR BEAM C GOTO 3590 3580 CONTINUE IF (.NOT.(COMMND .EQ. 'B ')) GOTO 3600 CALL GETINT('BEAM FREQUENCY? ', II, *OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3620 IF (.NOT.(II .NE. 0)) GOTO 3640 DEFSHP = II 3640 CONTINUE IF (.NOT.(II .EQ. 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 (.NOT.(COMMND .EQ. 'F ')) GOTO 36 *80 IF (.NOT.(.NOT.CLOAK(WHO))) GOTO 3 *700 CLOAK(WHO) = .TRUE. GOTO 3710 3700 CONTINUE CALL MESSGE('ALREADY CLOAKED!') 3710 CONTINUE C C APPEAR COMMAND C GOTO 3690 3680 CONTINUE IF (.NOT.(COMMND .EQ. '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 (.NOT.(COMMND .EQ. 'V ')) GOT *O 3760 VERBOS = .NOT.VERBOS C C REFRESH COMMAND C GOTO 3770 3760 CONTINUE IF (.NOT.(COMMND .EQ. 'R ')) G *OTO 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 C C MESSAGE COMMAND C GOTO 3790 3780 CONTINUE IF (.NOT.(COMMND .EQ. 'M ')) * GOTO 3820 CALL GETINT('UHURA HERE, T *O WHOM? ', IVAL, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3840 IF (.NOT.(IVAL .NE. 0)) *GOTO 3860 IL = IVAL IH = IVAL GOTO 3870 3860 CONTINUE IL = 1 IH = 8 3870 CONTINUE CALL TPOS(24, 1) CALL OUTCH(BLANK, 79) CALL TPOS(24, 1) CALL OUTSTR(.FALSE., 'ME *SSAGE CAPTAIN? ', .FALSE.) CALL INCHAR(MESBUF(2), 5 *9, .TRUE., - 1, NC, IERR) CALL TPOS(1, 1) CALL OUTCH(0, 0) IF (.NOT.(IERR .GE. 0 .A *ND. NC .GT. 0)) GOTO 3880 MESBUF(1) = WHO + 48 DO 3900 I = IL, IH IF (.NOT.(XSHIP(I))) GOTO 3920 IF (.NOT.(I .NE. WHO)) GOTO 3940 ENERGY(WHO) = ENERGY(WHO) - 10. 3940 CONTINUE CALL STRMOV(MESBUF, 1, NC + 1, MESSAG, I*60 - 59) 3920 CONTINUE 3900 CONTINUE 3910 CONTINUE 3880 CONTINUE 3840 CONTINUE C C QUIT COMMAND C GOTO 3830 3820 CONTINUE IF (.NOT.(COMMND .EQ. 'Q ' *)) GOTO 3960 CALL YESNO('QUIT NOW? ', * DONE) C C HELP COMMAND C GOTO 3970 3960 CONTINUE IF (.NOT.(COMMND .EQ. '? * ')) GOTO 3980 CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'A APPEAR (CLOAKING OFF) M SEND MESSAGE * 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 (.NOT.(COMMND .NE. ' ')) 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 2650 CONTINUE IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 4020 CALL REFRSH(SC, R, WHO) 4020 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 (.NOT.(ISENT(WHO, I) .NE. 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), J 1 CONTINUE CALL MESSGE('DOCKED.') GOTO 4060 2 CONTINUE CALL MESSGE('- HIT A STAR!') GOTO 4060 3 CONTINUE DO 4100 IK = 1, 3 CALL CLEAR CALL OUTCH(0, 0) WRITE(5, 1131) 1131 FORMAT(////////////, 25X, '*** BOOM ***') 4100 CONTINUE 4110 CONTINUE WRITE(5, 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(0, YES) IF (.NOT.(YES)) GOTO 4120 WRITE(5, 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(18, 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(18, 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 4080 CONTINUE 4060 CONTINUE 4070 CONTINUE IF (.NOT.(MESSAG(WHO*60-59) .NE. ' ')) GOTO 4160 CALL TPOS(24, 1) CALL OUTCH('MESSAGE FROM ', 13) MIND = WHO*60 - 59 CALL OUTCH(MESSAG(MIND), 1) CALL OUTCH(': ', 2) CALL OUTCH(MESSAG(MIND + 1), 59) CALL TPOS(1, 1) CALL OUTCH(0, 0) CALL STRMOV(BLANK, 1, 60, MESSAG, MIND) 4160 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 (.NOT.(CREW(WHO) .LE. 400)) GOTO 4200 XSHIP(WHO) = .FALSE. GOTO 4210 4200 CONTINUE XSHIP(WHO) = .TRUE. 4210 CONTINUE CALL CLEAR CALL OUTCH(0, 0) CALL EXIT END SUBROUTINE TREAD(STR, NC) BYTE STR CALL INCHAR(STR, NC, .FALSE., 0, NC, IERR) IF (.NOT.(NC .EQ. 0 .AND. IERR .NE. -2)) GOTO 4220 STR = ' ' GOTO 4230 4220 CONTINUE IF (.NOT.(STR .GE. 'a' .AND. STR .LE. 'z')) GOTO 4240 STR = (STR - 'a') + 'A' 4240 CONTINUE 4230 CONTINUE RETURN END SUBROUTINE RBUFF COMMON/MESS/CLEARF LOGICAL CLEARF CALL CLEAR CLEARF = .FALSE. C C DRAW NEW SCREEN C CALL BUFFIL(2, 4, 'Energy :', 10) CALL BUFFIL(3, 4, 'Shields :', 10) CALL BUFFIL(5, 4, 'Warp :', 10) CALL BUFFIL(6, 4, 'Course :', 10) CALL BUFFIL(8, 4, 'X co-ord :', 10) CALL BUFFIL(9, 4, 'Y co-ord :', 10) CALL BUFFIL(11, 4, 'Torps :', 10) CALL BUFFIL(12, 4, 'Seekers :', 10) CALL BUFFIL(13, 4, 'Hyper :', 10) CALL BUFFIL(15, 4, 'Def Ship :', 10) CALL BUFFIL(16, 4, 'Def Direc:', 10) CALL BUFFIL(2, 71, 'Scores', 6) CALL BUFFIL(4, 69, '1', 1) CALL BUFFIL(5, 69, '2', 1) CALL BUFFIL(6, 69, '3', 1) CALL BUFFIL(7, 69, '4', 1) CALL BUFFIL(8, 69, '5', 1) CALL BUFFIL(9, 69, '6', 1) CALL BUFFIL(10, 69, '7', 1) CALL BUFFIL(11, 69, '8', 1) CALL BUFFIL(14, 69, 'Scan:', 5) CALL BUFFIL(15, 69, 'Dir :', 5) CALL BUFFIL(16, 69, 'Dist:', 5) CALL BUFFIL(17, 69, 'Sect:', 5) CALL OUTCH(0, 0) RETURN END SUBROUTINE GETREL(PROMPT, V, EXIST, LOW, HIGH, DEFVAL) LOGICAL*1EXIST, OK REAL V, LOW, HIGH, DEFVAL BYTE INPUT(15) INTEGER NCHRS EXIST = .FALSE. CALL REDPMT(PROMPT, INPUT, 15, NCHRS) IF (.NOT.(NCHRS .EQ. 0)) GOTO 4260 V = DEFVAL EXIST = .TRUE. GOTO 4270 4260 CONTINUE IF (.NOT.(NCHRS .LT. 0)) GOTO 4280 EXIST = .FALSE. GOTO 4290 4280 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 4300 DECODE(NCHRS, 1001, INPUT, ERR=201) V 1001 FORMAT(G15.0) IF (.NOT.(V .GE. LOW .AND. V .LE. HIGH)) GOTO 4320 EXIST = .TRUE. GOTO 4330 4320 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4330 CONTINUE 4300 CONTINUE 4290 CONTINUE 4270 CONTINUE RETURN END SUBROUTINE REFRSH(SC, R, I) C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), 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, MESSAG, BHOLE, EMPTY C END COMMON REAL SC(8), R(9) BYTE STRNG(10) BYTE ACT(8) INTEGER DEFSHP, OLDSHP REAL DEFDIR, OLDDIR COMMON/DEFLTS/DEFSHP, DEFDIR, OLDDIR, OLDSHP DATA ACT/8*' '/, OLDSHP/0/, OLDDIR/ - 1.0/ IF (.NOT.(R(1) .NE. ENERGY(I))) GOTO 4340 R(1) = ENERGY(I) ENCODE(7, 1001, STRNG) R(1) 1001 FORMAT(F7.1) CALL BUFFIL(2, 15, STRNG, 7) 4340 CONTINUE IF (.NOT.(R(2) .NE. SHIELD(I))) GOTO 4360 R(2) = SHIELD(I) ENCODE(7, 1011, STRNG) R(2) 1011 FORMAT(F7.1) CALL BUFFIL(3, 15, STRNG, 7) 4360 CONTINUE IF (.NOT.(R(3) .NE. WARP(I))) GOTO 4380 R(3) = WARP(I) ENCODE(4, 1021, STRNG) R(3) 1021 FORMAT(F4.2) CALL BUFFIL(5, 18, STRNG, 4) 4380 CONTINUE IF (.NOT.(R(4) .NE. DIR(I))) GOTO 4400 R(4) = DIR(I) IF (.NOT.(R(4) .GT. 90.)) GOTO 4420 V = (450. - R(4))/30. GOTO 4430 4420 CONTINUE V = (90. - R(4))/30. 4430 CONTINUE ENCODE(5, 1031, STRNG) V 1031 FORMAT(F5.2) CALL BUFFIL(6, 17, STRNG, 5) 4400 CONTINUE IF (.NOT.(R(5) .NE. XCORD(I))) GOTO 4440 R(5) = XCORD(I) ENCODE(5, 1041, STRNG) R(5) 1041 FORMAT(F5.1) CALL BUFFIL(8, 17, STRNG, 5) 4440 CONTINUE IF (.NOT.(R(6) .NE. YCORD(I))) GOTO 4460 R(6) = YCORD(I) ENCODE(5, 1051, STRNG) R(6) 1051 FORMAT(F5.1) CALL BUFFIL(9, 17, STRNG, 5) 4460 CONTINUE IR = R(7) IF (.NOT.(IR .NE. TORPS(I))) GOTO 4480 R(7) = TORPS(I) ENCODE(2, 1061, STRNG) TORPS(I) 1061 FORMAT(I2) CALL BUFFIL(11, 20, STRNG, 2) 4480 CONTINUE IR = R(8) IF (.NOT.(IR .NE. NHOM(I))) GOTO 4500 R(8) = NHOM(I) ENCODE(2, 1071, STRNG) NHOM(I) 1071 FORMAT(I2) CALL BUFFIL(12, 20, STRNG, 2) 4500 CONTINUE IR = R(9) IF (.NOT.(IR .NE. HYPER(I))) GOTO 4520 R(9) = HYPER(I) ENCODE(1, 1081, STRNG) HYPER(I) 1081 FORMAT(I1) CALL BUFFIL(13, 21, STRNG, 1) 4520 CONTINUE IF (.NOT.(OLDSHP .NE. DEFSHP)) GOTO 4540 OLDSHP = DEFSHP ENCODE(1, 1091, STRNG) OLDSHP 1091 FORMAT(I1) CALL BUFFIL(15, 21, STRNG, 1) 4540 CONTINUE IF (.NOT.(OLDDIR .NE. DEFDIR)) GOTO 4560 OLDDIR = DEFDIR ENCODE(5, 1101, STRNG) DEFDIR 1101 FORMAT(F5.2) CALL BUFFIL(16, 17, STRNG, 5) 4560 CONTINUE DO 4580 J = 1, 8 IF (.NOT.((SC(J) .NE. SCORE(J)) .OR. (XSHIP(J).XOR.(ACT(J) .EQ. *'*')))) GOTO 4600 IF (.NOT.(XSHIP(J))) GOTO 4620 ACT(J) = '*' GOTO 4630 4620 CONTINUE ACT(J) = ' ' 4630 CONTINUE SC(J) = SCORE(J) ENCODE(10, 1111, STRNG) SC(J), ACT(J) 1111 FORMAT(F8.0, 1X, A1) CALL BUFFIL(J + 3, 71, STRNG, 10) 4600 CONTINUE 4580 CONTINUE 4590 CONTINUE CALL OUTCH(0, - 1) RETURN END SUBROUTINE BUFFIL(IY, IX, ST, L) BYTE ST(1) CALL TPOS(IY, IX) CALL OUTCH(ST, L) RETURN END SUBROUTINE GETINT(PROMPT, N, FLAG, LOW, HIGH, DEFVAL) INTEGER N, LOW, HIGH, DEFVAL LOGICAL*1OK, FLAG BYTE INPUT(15) FLAG = .FALSE. CALL REDPMT(PROMPT, INPUT, 15, NCHRS) IF (.NOT.(NCHRS .LT. 0)) GOTO 4640 FLAG = .FALSE. GOTO 4650 4640 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4660 FLAG = .TRUE. N = DEFVAL GOTO 4670 4660 CONTINUE DECODE(NCHRS, 1011, INPUT, ERR=201) N 1011 FORMAT(I5) IF (.NOT.((N .GE. LOW) .AND. (N .LE. HIGH))) GOTO 4680 FLAG = .TRUE. GOTO 4690 4680 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4690 CONTINUE 4670 CONTINUE 4650 CONTINUE RETURN END SUBROUTINE REDPMT(PROMPT, INPUT, NINPUT, NCHRS) C C DO A READ WITHOUT PROMPT AND WITHOUT ECHO; IF NO INPUT IS RECEIVED AFTER 1/2 C SECOND, ISSUE THE PROMPT, THEN READ WITH NO TIMEOUT AND WITH ECHO. C IF A PROMPT IS ISSUED, IT AND THE INPUT IS ERASED TO BLANKS AFTER C THE READ. C C THIS ROUTINE COULD DO A SIMPLE PROMPT AND READ AFTER POSITIONING C TO (PRMPTY, PRMPTX), FOLLOWED BY ERASING THE PROMPT AND INPUT C TO BLANKS, IF NECCESSARY ON YOUR SYSTEM. C IMPLICIT INTEGER(A - Z) PARAMETER MAXPRM = 20 PARAMETER PRMPTY = 18, PRMPTX = 1, PRMPTL = 24, CR = 13 BYTE PROMPT(1), INPUT(NINPUT), BLANKS(PRMPTL) LOGICAL ECHO DATA BLANKS/PRMPTL*' '/ NCHRS = 0 ECHO = .TRUE. IF (.NOT.(PROMPT(1) .NE. 0)) GOTO 4700 C IF PROMPT IS NOT NULL... C GET TYPE AHEAD CALL INCHAR(INPUT, NINPUT, .FALSE., 0, NC, IERR) IF (.NOT.(IERR .EQ. -1)) GOTO 4720 C EOF? GO TO 999 4720 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4740 C DONE? RETURN 4740 CONTINUE C WAIT 1/2 SEC, THEN READ AGAIN CALL WAIT(30, 0, DSW) CALL INCHAR(INPUT(NCHRS + 1), NINPUT - NCHRS, .FALSE., 0, NC, IE *RR) IF (.NOT.(IERR .EQ. -1)) GOTO 4760 C EOF? GO TO 999 4760 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4780 C DONE? RETURN 4780 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4800 C THEN ISSUE PROMPT LEN = 1 4820 IF (.NOT.(LEN .LE. MAXPRM .AND. PROMPT(LEN) .NE. 0)) GOTO 4840 4830 LEN = LEN + 1 GOTO 4820 4840 CONTINUE CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(PROMPT, LEN - 1) GOTO 4810 4800 CONTINUE ECHO = .FALSE. 4810 CONTINUE 4700 CONTINUE CALL INCHAR(INPUT(NCHRS + 1), NINPUT - NCHRS, ECHO, - 1, NC, IERR C FINAL READ *) IF (.NOT.(PROMPT(1) .NE. 0 .AND. NCHRS .EQ. 0)) GOTO 4850 C THEN ERASE PROMPT STRNG CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(BLANKS, PRMPTL) 4850 CONTINUE IF (.NOT.(IERR .EQ. -1)) GOTO 4870 C EOF? GO TO 999 4870 CONTINUE NCHRS = NCHRS + NC RETURN 999 CONTINUE NCHRS = - 1 RETURN END SUBROUTINE YESNO(PROMPT, FLAG) LOGICAL*1FLAG, OK BYTE PROMPT(1) BYTE ANSWER(4) C OK = .FALSE. ANSWER(1) = 0 CALL REDPMT(PROMPT, ANSWER, 4, NCHRS) 4890 CONTINUE IF (.NOT.(NCHRS .LE. 0)) GOTO 4920 NCHRS = 1 ANSWER(1) = 0 4920 CONTINUE IF (.NOT.(ANSWER(1) .GE. 'a' .AND. ANSWER(1) .LE. 'z')) GOTO 494 *0 ANSWER(1) = (ANSWER(1) - 'a') + 'A' C * CHECK FOR YES 4940 CONTINUE IF (.NOT.(ANSWER(1) .EQ. 'Y')) GOTO 4960 FLAG = .TRUE. OK = .TRUE. C * CHECK FOR A NO GOTO 4970 4960 CONTINUE IF (.NOT.(ANSWER(1) .EQ. 'N')) GOTO 4980 FLAG = .FALSE. OK = .TRUE. C * INCORRECT RESPONSE GOTO 4990 4980 CONTINUE IF (.NOT.(PROMPT(1) .EQ. 0)) GOTO 5000 CALL OUTCH(13, 1) CALL OUTSTR(.TRUE., 'ANSWER YES OR NO? ', .FALSE.) CALL INCHAR(ANSWER, 4, .TRUE., - 1, NCHRS, IER) GOTO 5010 5000 CONTINUE CALL REDPMT('ANSWER YES OR NO? ', ANSWER, 4, NCHRS) 5010 CONTINUE 4990 CONTINUE 4970 CONTINUE 4900 IF (.NOT.(OK)) GOTO 4890 4910 CONTINUE RETURN END SUBROUTINE OUTSTR(LFFLAG, STRNG, CRFLAG) LOGICAL LFFLAG, CRFLAG BYTE STRNG(1) LEN = 0 5020 IF (.NOT.(STRNG(LEN+1) .NE. 0)) GOTO 5040 5030 LEN = LEN + 1 GOTO 5020 5040 CONTINUE IF (.NOT.(LFFLAG)) GOTO 5050 CALL OUTCH(10, 1) 5050 CONTINUE CALL OUTCH(STRNG, LEN) IF (.NOT.(CRFLAG)) GOTO 5070 CALL OUTCH(0, - 1) GOTO 5080 5070 CONTINUE CALL OUTCH(0, 0) 5080 CONTINUE RETURN END SUBROUTINE BNDRY(IXLOW, IXHI, IYLOW, IYHI) C TEXT COMMON COMMON/TORPE/TLOCS(8, 10, 2), TDIR(8, 10), IT(8) COMMON/LEDFOR/ENERGY(8), SHIELD(8), XCORD(8), YCORD(8), TORPS(8), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(8), PHA(8), I1, I2, HYPER *(8), ISENT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XH *OM(8, 4), YHOM(8, 4), WHOM(8, 4), NHOM(8), TRBEAM(8), SCORE(8), CR *EW(8), DIR(8), WARP(8), LAUNCH(8), UNIV(100, 100), MESSAG(480), TH *RU, XSHIP(8), CLOAK(8), NET(8), 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, MESSAG, BHOLE, EMPTY C END COMMON BYTE ALPHA BYTE JUNK, NBUFF COMMON/BNDRY/IXX, IYY, ID, MINID8, JUNK, NBUFF( - 9: + 9, - 9: + *9) DO 5090 IX1 = IXLOW, IXHI IX = IX1 - IXX DO 5110 IY1 = IYLOW, IYHI IY = IY1 - IYY ALPHA = UNIV(IX1, IY1) IF (.NOT.(ALPHA .EQ. EMPTY)) GOTO 5130 IF (.NOT.(((IX .EQ. -ID .OR. IX .EQ. ID .OR. IX .EQ. 0) .AND *. (IY1 .EQ. 100 .OR. IY1 .EQ. 1)) .OR. ((IY .EQ. -ID .OR. IY .EQ. *MINID8 .OR. IY .EQ. 0) .AND. (IX1 .EQ. 100 .OR. IX1 .EQ. 1)))) GOT *O 5150 NBUFF(IX, IY) = '-' 5150 CONTINUE GOTO 5140 5130 CONTINUE IF (.NOT.((ALPHA .GE. 48+1) .AND. (ALPHA .LE. 48+8) .AND. (C *LOAK(ALPHA-48)))) GOTO 5170 NBUFF(IX, IY) = EMPTY GOTO 5180 5170 CONTINUE IF (.NOT.(ALPHA .LT. 0)) GOTO 5190 NBUFF(IX, IY) = '%' GOTO 5200 5190 CONTINUE NBUFF(IX, IY) = ALPHA 5200 CONTINUE 5180 CONTINUE 5140 CONTINUE 5110 CONTINUE 5120 CONTINUE 5090 CONTINUE 5100 CONTINUE RETURN END