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), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE 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/ IF (.NOT.(UPRATE .LE. 0)) GOTO 2000 WRITE(5, 2020) 2020 FORMAT('0MTREK HAS NOT BEEN INITIALIZED; RUN MTREKINI.'/) CALL EXIT 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 "UPRATE" CLOCK TICKS; C AT SLOWER SPEEDS, 1/2 THE SCREEN IS UPDATED EVERY UPRATE*2 CLOCK TICKS C AND THE OTHER 1/2 IS UPDATED ALTERNATELY WITH THE FIRST HALF. C THIS ALLOWS ENJOYABLE GAMES ON TERMINALS AS SLOW AS 1200 BAUD. C 2000 CONTINUE C GET QUIKUP, INITIALIZE TERMINAL IO CALL GTCHAR(QUIKUP) WRITE(5, 1001) 1001 FORMAT('0WELCOME TO ICR MULTI-TREK.') 2030 CONTINUE WRITE(5, 1011) 1011 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') DO 2060 I = 1, 8 IF (.NOT.(.NOT.XSHIP(I))) GOTO 2080 WRITE(5, 1021) I 1021 FORMAT(' SHIP ', I1) 2080 CONTINUE 2060 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 2100 IF (.NOT.(IW .EQ. 0)) GOTO 2120 OK = .FALSE. GOTO 2040 2120 CONTINUE WHO = IW IF (.NOT.(XSHIP(WHO))) GOTO 2140 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) 2140 CONTINUE GOTO 2110 2100 CONTINUE CALL EXIT 2110 CONTINUE 2040 IF (.NOT.(OK)) GOTO 2030 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 2160 C START SLOW TIMER IF SLOW UPDATE CALL MARK(3, 2*UPRATE, 1, IDS) 2160 CONTINUE C START FAST TIMER CALL MARK(2, UPRATE, 1, IDS) 2180 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 2210 C THEN MTREKD ISN'T RUNNING CALL RUNMTR C C PLACE LOCAL SCAN ON TERMINAL C 2210 CONTINUE REFTOG = (.NOT.REFTOG) .OR. QUIKUP IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 2230 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 2250 IX1 = IXLOW, IXHI IX = IX1 - IXX DO 2270 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 2290 NBUFF(IX, IY) = EMPTY GOTO 2300 2290 CONTINUE IF (.NOT.(ALPHA .LT. 0)) GOTO 2310 NBUFF(IX, IY) = '%' GOTO 2300 2310 CONTINUE NBUFF(IX, IY) = ALPHA 2300 CONTINUE 2270 CONTINUE 2250 CONTINUE IF (.NOT.(IXX-ID .LE. 1)) GOTO 2330 CALL BNDRY(1, 1, MAX(1, IYY - ID), MIN(100, IYY + MINID8)) GOTO 2340 2330 CONTINUE IF (.NOT.(IXX+ID .GE. 100)) GOTO 2350 CALL BNDRY(100, 100, MAX(1, IYY - ID), MIN(100, IYY + MINID8 *)) 2350 CONTINUE 2340 CONTINUE IF (.NOT.(IYY-ID .LE. 1)) GOTO 2370 CALL BNDRY(MAX(1, IXX - ID), MIN(99, IXX + ID), 1, 1) GOTO 2380 2370 CONTINUE IF (.NOT.(IYY+ID .GE. 100)) GOTO 2390 CALL BNDRY(MAX(1, IXX - ID), MIN(99, IXX + ID), 100, 100) 2390 CONTINUE 2380 CONTINUE IF (.NOT.(NBUFF(-ID, -ID) .EQ. EMPTY)) GOTO 2410 NBUFF( - ID, - ID) = '.' 2410 CONTINUE IF (.NOT.(NBUFF(-ID, MINID8) .EQ. EMPTY)) GOTO 2430 NBUFF( - ID, MINID8) = '.' 2430 CONTINUE IF (.NOT.(NBUFF(ID, MINID8) .EQ. EMPTY)) GOTO 2450 NBUFF(ID, MINID8) = '.' 2450 CONTINUE IF (.NOT.(NBUFF(ID, -ID) .EQ. EMPTY)) GOTO 2470 NBUFF(ID, - ID) = '.' 2470 CONTINUE DO 2490 IY = - 9, + 8 ICURSX = - 999 DO 2510 IX = - 9, + 9 IF (.NOT.(NBUFF(IX, IY) .NE. OBUFF(IX, IY))) GOTO 2530 IF (.NOT.(ICURSX .GE. IX-2)) GOTO 2550 DO 2570 III = ICURSX + 1, IX CALL OUTCH(' ', 1) CALL OUTCH(NBUFF(III, IY), 1) 2570 CONTINUE GOTO 2560 2550 CONTINUE CALL TPOS(9 - IY, 2*IX + 43) CALL OUTCH(NBUFF(IX, IY), 1) 2560 CONTINUE ICURSX = IX OBUFF(IX, IY) = NBUFF(IX, IY) 2530 CONTINUE 2510 CONTINUE 2490 CONTINUE CALL OUTCH(0, - 1) C C THE FOLLOWING WAIT CONTROLS THE UPDATE RATE, WHICH MAY BE C SLOW OR FAST, DEPENDING ON THE SPEED OF THE TERMINAL C 2230 CONTINUE IF (.NOT.(COMMND .NE. ' ' .AND. XSHIP(WHO))) GOTO 2590 IF (.NOT.(REFTOG)) GOTO 2610 CALL WAITFR(2, IDS) IF (.NOT.(QUIKUP)) GOTO 2630 C RESTART FAST TIMER CALL MARK(2, UPRATE, 1, IDS) 2630 CONTINUE GOTO 2620 2610 CONTINUE CALL WAITFR(3, IDS) C RESTART SLOW TIMER CALL MARK(3, 2*UPRATE, 1, IDS) C RESTART FAST TIMER CALL MARK(2, UPRATE, 1, IDS) 2620 CONTINUE 2590 CONTINUE NC = 1 COMMND = '0 ' IF (.NOT.(XSHIP(WHO))) GOTO 2650 CALL TREAD(COMMND, NC) C C CHECK FOR NO INPUT C 2650 CONTINUE IF (.NOT.(COMMND .EQ. '0 ')) GOTO 2670 C C LONG RANGE SCAN COMMAND C GOTO 2680 2670 CONTINUE IF (.NOT.(COMMND .EQ. 'L ')) GOTO 2690 CALL GETINT('FREQUENCY? ', II, OK, 1, 8, DEFSHP) IF (.NOT.(OK)) GOTO 2710 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 2730 X2 = X1 + 100. GOTO 2740 2730 CONTINUE X2 = X1 - 100. 2740 CONTINUE Y1 = YCORD(II) IF (.NOT.(Y1 .LT. 51.)) GOTO 2750 Y2 = Y1 + 100. GOTO 2760 2750 CONTINUE Y2 = Y1 - 100. 2760 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 2770 J = 2, 4 IF (.NOT.(D1(J) .LT. D1(IIT))) GOTO 2790 IIT = J 2790 CONTINUE 2770 CONTINUE D = D1(IIT) IF (.NOT.(IIT .EQ. 1)) GOTO 2810 YD = Y1 XD = X1 GOTO 2820 2810 CONTINUE IF (.NOT.(IIT .EQ. 2)) GOTO 2830 YD = Y2 XD = X1 GOTO 2820 2830 CONTINUE IF (.NOT.(IIT .EQ. 3)) GOTO 2850 YD = Y1 XD = X2 GOTO 2820 2850 CONTINUE YD = Y2 XD = X2 2820 CONTINUE EDIS = D EDIR = ATAN3((YD - YY), (XD - XX))*57.29577951 IF (.NOT.(EDIR .LT. 0.)) GOTO 2870 EDIR = EDIR + 360. 2870 CONTINUE IF (.NOT.(EDIR .GT. 90.)) GOTO 2890 EDIR = (450. - EDIR)/30. GOTO 2900 2890 CONTINUE EDIR = (90. - EDIR)/30. 2900 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) 2710 CONTINUE C C TORPEDO COMMAND C GOTO 2680 2690 CONTINUE IF (.NOT.(COMMND .EQ. 'T ')) GOTO 2910 IF (.NOT.(LAUNCH(WHO) .LT. 0.)) GOTO 2930 IF (.NOT.(TORPS(WHO) .GT. 0)) GOTO 2950 CALL GETREL('TORPEDO COURSE? ', VALUE, OK, 0., 12., DEFDIR *) IF (.NOT.(OK)) GOTO 2970 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.)) GOTO 2990 VALUE = (15. - VALUE)*30. GOTO 3000 2990 CONTINUE VALUE = (3. - VALUE)*30. 3000 CONTINUE LAUNCH(WHO) = VALUE TORPS(WHO) = TORPS(WHO) - 1 IF (.NOT.(TORPS(WHO) .EQ. 0)) GOTO 3010 CALL MESSGE('LAST TORPEDO!') 3010 CONTINUE 2970 CONTINUE GOTO 2960 2950 CONTINUE CALL MESSGE('NO TORPEDOES!') 2960 CONTINUE GOTO 2940 2930 CONTINUE CALL MESSGE('TORPEDOES NOT READY') 2940 CONTINUE C C PHASER COMMAND C GOTO 2680 2910 CONTINUE IF (.NOT.(COMMND .EQ. 'P ')) GOTO 3030 IF (.NOT.(PHA(WHO) .LT. 0.)) GOTO 3050 CALL GETREL('PHASER COURSE? ', VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3070 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.)) GOTO 3090 VALUE = (15. - VALUE)*30. GOTO 3100 3090 CONTINUE VALUE = (3. - VALUE)*30. 3100 CONTINUE PHA(WHO) = VALUE ENERGY(WHO) = ENERGY(WHO) - 50. 3070 CONTINUE GOTO 3060 3050 CONTINUE CALL MESSGE('PHASERS NOT READY') 3060 CONTINUE C C HOMING TORPEDO LAUNCH C GOTO 2680 3030 CONTINUE IF (.NOT.(COMMND .EQ. 'K ')) GOTO 3110 IF (.NOT.(NHOM(WHO) .EQ. 4)) GOTO 3130 TWHOM = 0. GOTO 3140 3130 CONTINUE TWHOM = WHOM(WHO, NHOM(WHO) + 1) 3140 CONTINUE IF (.NOT.(TWHOM .GE. 0.)) GOTO 3150 IF (.NOT.(NHOM(WHO) .GT. 0)) GOTO 3170 CALL GETINT('HOMING FREQUENCY? ', II, OK, 1, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3190 DEFSHP = II IF (.NOT.(II .EQ. WHO)) GOTO 3210 CALL MESSGE('TORPEDOES JAMMED!') NHOM(WHO) = 0 TORPS(WHO) = 0 GOTO 3220 3210 CONTINUE WHOM(WHO, NHOM(WHO)) = - II NHOM(WHO) = NHOM(WHO) - 1 3220 CONTINUE 3190 CONTINUE GOTO 3180 3170 CONTINUE CALL MESSGE('NO HOMERS!') 3180 CONTINUE GOTO 3160 3150 CONTINUE CALL MESSGE('HOMERS NOT READY') 3160 CONTINUE C C WARP FACTOR COMMAND C GOTO 2680 3110 CONTINUE IF (.NOT.(COMMND .EQ. 'W ')) GOTO 3230 CALL GETREL('WARP SIR? ', VALUE, OK, 0., 8., WARP(WHO)) IF (.NOT.(OK)) GOTO 3250 WARP(WHO) = VALUE 3250 CONTINUE C C COURSE COMMAND C GOTO 2680 3230 CONTINUE IF (.NOT.(COMMND .EQ. 'C ')) GOTO 3270 CALL GETREL('COURSE SIR? ', VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3290 IF (.NOT.(VALUE .GE. 3.)) GOTO 3310 DIR(WHO) = (15. - VALUE)*30. GOTO 3320 3310 CONTINUE DIR(WHO) = (3. - VALUE)*30. 3320 CONTINUE 3290 CONTINUE C C EXPLODE ANTI-MATTER DEVICE C GOTO 2680 3270 CONTINUE IF (.NOT.(COMMND .EQ. 'X ')) GOTO 3330 IF (.NOT.(IPOD(WHO) .EQ. 2)) GOTO 3350 IPOD(WHO) = 3 CALL MESSGE('DETONATION SIGNALED') GOTO 3360 3350 CONTINUE CALL MESSGE('NO POD!') 3360 CONTINUE C C CONVERT MOVING ANTI-MATTER POD TO A STATIC MINE C GOTO 2680 3330 CONTINUE IF (.NOT.(COMMND .EQ. 'N ')) GOTO 3370 IF (.NOT.(IPOD(WHO) .EQ. 2)) GOTO 3390 WPOD(WHO) = 0. CALL MESSGE('POD POSITIONED') GOTO 3400 3390 CONTINUE CALL MESSGE('NO POD!') 3400 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GOTO 2680 3370 CONTINUE IF (.NOT.(COMMND .EQ. 'Z ')) GOTO 3410 IF (.NOT.(IPOD(WHO) .EQ. 0)) GOTO 3430 CALL GETREL('POD COURSE? ', VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3450 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.)) GOTO 3470 DPOD(WHO) = (15. - VALUE)*30. GOTO 3480 3470 CONTINUE DPOD(WHO) = (3. - VALUE)*30. 3480 CONTINUE IPOD(WHO) = 1 3450 CONTINUE GOTO 3440 3430 CONTINUE CALL MESSGE('NO POD!') 3440 CONTINUE C C HYPERSPACE COMMAND C GOTO 2680 3410 CONTINUE IF (.NOT.(COMMND .EQ. 'H ')) GOTO 3490 IUNIQ = HYPER(WHO) CALL GETINT('HYPER PORT? ', II, OK, 1, 6, IUNIQ) IF (.NOT.(OK)) GOTO 3510 HYPER(WHO) = II 3510 CONTINUE C C SHIELD COMMAND C GOTO 2680 3490 CONTINUE IF (.NOT.(COMMND .EQ. 'S ')) GOTO 3530 CALL GETREL('ENERGY CHANGE? ', VALUE, OK, - 1.E36, 1.E36, DEF *SHD) IF (.NOT.(OK)) GOTO 3550 IF (.NOT.(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(WHO)+VALUE *.GE. 0.)) GOTO 3570 ENERGY(WHO) = ENERGY(WHO) - VALUE SHIELD(WHO) = SHIELD(WHO) + VALUE IF (.NOT.(VALUE.GE.0.0)) GOTO 3590 DEFSHD = VALUE 3590 CONTINUE GOTO 3580 3570 CONTINUE CALL MESSGE('?! IMPOSSIBLE !?') 3580 CONTINUE 3550 CONTINUE C C FLIP ENERGY NET ON OR OFF C GOTO 2680 3530 CONTINUE IF (.NOT.(COMMND .EQ. 'E ')) GOTO 3610 NET(WHO) = .NOT.NET(WHO) C C TRACTOR BEAM C GOTO 2680 3610 CONTINUE IF (.NOT.(COMMND .EQ. 'B ')) GOTO 3630 CALL GETINT('BEAM FREQUENCY? ', II, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3650 IF (.NOT.(II .NE. 0)) GOTO 3670 DEFSHP = II 3670 CONTINUE IF (.NOT.(II .EQ. WHO)) GOTO 3690 CALL MESSGE('? HUH ?') GOTO 3700 3690 CONTINUE TRBEAM(WHO) = II 3700 CONTINUE 3650 CONTINUE C C CLOAKING COMMAND C GOTO 2680 3630 CONTINUE IF (.NOT.(COMMND .EQ. 'F ')) GOTO 3710 IF (.NOT.(.NOT.CLOAK(WHO))) GOTO 3730 CLOAK(WHO) = .TRUE. GOTO 3740 3730 CONTINUE CLOAK(WHO) = .FALSE. 3740 CONTINUE C C APPEAR COMMAND - LEFT IN FOR COMPATIBILITY C GOTO 2680 3710 CONTINUE IF (.NOT.(COMMND .EQ. 'A ')) GOTO 3750 IF (.NOT.(CLOAK(WHO))) GOTO 3770 CLOAK(WHO) = .FALSE. GOTO 3780 3770 CONTINUE CALL MESSGE('NOT CLOAKED!') 3780 CONTINUE C C FLIP VERBOSE MESSAGES ON OR OFF C GOTO 2680 3750 CONTINUE IF (.NOT.(COMMND .EQ. 'V ')) GOTO 3790 VERBOS = .NOT.VERBOS C C REFRESH COMMAND C GOTO 2680 3790 CONTINUE IF (.NOT.(COMMND .EQ. 'R ')) GOTO 3810 CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF DO 3830 I = 1, 9 SC(I) = - 9999. R(I) = - 9999. 3830 CONTINUE OLDSHP = 0 OLDDIR = - 1.0 C C MESSAGE COMMAND C GOTO 2680 3810 CONTINUE IF (.NOT.(COMMND .EQ. 'M ')) GOTO 3850 CALL GETINT('UHURA HERE, TO WHOM? ', IVAL, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3870 IF (.NOT.(IVAL .NE. 0)) GOTO 3890 IL = IVAL IH = IVAL GOTO 3900 3890 CONTINUE IL = 1 IH = 8 3900 CONTINUE CALL TPOS(24, 1) CALL OUTCH(BLANK, 79) CALL TPOS(24, 1) CALL OUTSTR(.FALSE., 'MESSAGE CAPTAIN? ', .FALSE.) CALL INCHAR(MESBUF(2), 59, .TRUE., - 1, NC, IERR) CALL TPOS(1, 1) CALL OUTCH(0, 0) IF (.NOT.(IERR .GE. 0 .AND. NC .GT. 0)) GOTO 3910 MESBUF(1) = WHO + 48 DO 3930 I = IL, IH IF (.NOT.(XSHIP(I))) GOTO 3950 IF (.NOT.(I .NE. WHO)) GOTO 3970 ENERGY(WHO) = ENERGY(WHO) - 10. 3970 CONTINUE CALL STRMOV(MESBUF, 1, NC + 1, MESSAG, I*60 - 59) 3950 CONTINUE 3930 CONTINUE 3910 CONTINUE 3870 CONTINUE C C QUIT COMMAND C GOTO 2680 3850 CONTINUE IF (.NOT.(COMMND .EQ. 'Q ')) GOTO 3990 CALL YESNO('QUIT NOW? ', DONE) C C HELP COMMAND C GOTO 2680 3990 CONTINUE IF (.NOT.(COMMND .EQ. '? ')) GOTO 4010 CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'B BEAMS M SEND MESS *AGE T FIRE TORPEDOES', .TRUE.) CALL OUTSTR(.TRUE., 'C COURSE HEADING N FREEZE ANT *I-MATTER W SET WARP SPEED', .TRUE.) CALL OUTSTR(.TRUE., 'F FADE/APPEAR (CLOAKING) P FIRE PHASE *RS 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 DISP *LAY V VERBOSE ON/OFF', .TRUE.) CALL OUTSTR(.TRUE., 'L LOCATE SHIP S SHIELD CHA *NGE E ENERGY NETS ON/OFF', .TRUE.) CALL TPOS(1, 1) CALL OUTCH(0, 0) C C ERROR C GOTO 2680 4010 CONTINUE IF (.NOT.(COMMND .NE. ' ')) GOTO 4030 CALL MESSGE('?! WHAT !?') 4030 CONTINUE 2680 CONTINUE IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 4050 CALL REFRSH(SC, R, WHO) 4050 CONTINUE IF (.NOT.(REFRES)) GOTO 4070 XSHIP(WHO) = .TRUE. REFRES = .FALSE. REFTOG = .FALSE. C C WRITE OUT MESSAGES FROM DRIVER C 4070 CONTINUE DO 4090 I = 1, 10 IF (.NOT.(ISENT(WHO, I) .NE. 0)) GOTO 4110 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 4090 2 CONTINUE CALL MESSGE('- HIT A STAR!') GOTO 4090 3 CONTINUE DO 4130 IK = 1, 3 CALL CLEAR CALL OUTCH(0, 0) WRITE(5, 1131) 1131 FORMAT(////////////, 25X, '*** BOOM ***') 4130 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 4150 WRITE(5, 1142) 1142 FORMAT(' GOOD!') CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF DO 4170 K = 1, 9 SC(K) = - 9999. R(K) = - 9999. 4170 CONTINUE OLDDIR = - 1.0 OLDSHP = 0 REFRES = .TRUE. GOTO 4160 4150 CONTINUE DONE = .TRUE. 4160 CONTINUE GOTO 4090 4 CONTINUE CALL MESSGE('- TORPEDO HIT US!') GOTO 4090 5 CONTINUE CALL MESSGE('+ TORPEDO HIT ALIEN!') GOTO 4090 6 CONTINUE CALL MESSGE('+ PHASER HIT ALIEN!') GOTO 4090 7 CONTINUE CALL MESSGE('PHASER HIT TORPEDO') GOTO 4090 8 CONTINUE CALL MESSGE('PHASERS MISSED') GOTO 4090 9 CONTINUE CALL MESSGE('- RAMMED ALIEN!') GOTO 4090 10 CONTINUE CALL MESSGE('- COLLISION!') GOTO 4090 11 CONTINUE CALL MESSGE('PHASER HIT STAR') GOTO 4090 12 CONTINUE CALL MESSGE('- BASE UNDER ATTACK') GOTO 4090 13 CONTINUE CALL MESSGE('TORPEDO HIT STAR') GOTO 4090 14 CONTINUE CALL MESSGE('- PHASER ATTACK!') GOTO 4090 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 4090 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 4090 17 CONTINUE CALL MESSGE('HYPERSPACE!') GOTO 4090 18 CONTINUE CALL MESSGE('HYPERSPACE BLOCKED!') GOTO 4090 19 CONTINUE CALL MESSGE('RANDOM HYPERSPACE!') GOTO 4090 20 CONTINUE CALL MESSGE('TORPEDO HIT TORPEDO') GOTO 4090 21 CONTINUE CALL MESSGE('HIT GHOST SHIP') GOTO 4090 22 CONTINUE CALL MESSGE('*** ALIEN DESTROYED!') CALL MESSGE('********************') GOTO 4090 23 CONTINUE CALL MESSGE('POD BLOCKED!') GOTO 4090 24 CONTINUE CALL MESSGE('POD DESTROYED!') GOTO 4090 25 CONTINUE CALL MESSGE('PHASER HIT POD') GOTO 4090 26 CONTINUE CALL MESSGE('TORPEDO HIT POD') GOTO 4090 27 CONTINUE CALL MESSGE('- METAL OBJECT NEAR') GOTO 4090 28 CONTINUE CALL MESSGE('POD LAUNCHED') GOTO 4090 29 CONTINUE CALL MESSGE('POD DETONATED!') GOTO 4090 30 CONTINUE CALL MESSGE('- POD EXPLOSION!') GOTO 4090 31 CONTINUE CALL MESSGE('IIEEEEEE!') GOTO 4090 32 CONTINUE CALL MESSGE('+ POD HIT ALIEN!') GOTO 4090 33 CONTINUE CALL MESSGE('- HIT NET!') GOTO 4090 34 CONTINUE CALL MESSGE('TORPEDO HIT NET') GOTO 4090 35 CONTINUE CALL MESSGE('PHASER HIT NET') GOTO 4090 36 CONTINUE CALL MESSGE('NET BLOCKED!') GOTO 4090 4110 CONTINUE 4090 CONTINUE IF (.NOT.(MESSAG(WHO*60-59) .NE. ' ')) GOTO 4190 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) 4190 CONTINUE IF (.NOT.((ENERGY(WHO) .LT. 900.) .AND. WARN)) GOTO 4210 CALL MESSGE('ENERGY LOW!') WARN = .FALSE. GOTO 4220 4210 CONTINUE WARN = .TRUE. 4220 CONTINUE CALL MESSGE(0) 2190 IF (.NOT.(DONE)) GOTO 2180 CREW(WHO) = CREW(WHO) - 1 IF (.NOT.(CREW(WHO) .LE. 400)) GOTO 4230 XSHIP(WHO) = .FALSE. GOTO 4240 4230 CONTINUE XSHIP(WHO) = .TRUE. 4240 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 4250 STR = ' ' GOTO 4260 4250 CONTINUE IF (.NOT.(STR .GE. 'a' .AND. STR .LE. 'z')) GOTO 4270 STR = (STR - 'a') + 'A' 4270 CONTINUE 4260 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 4290 V = DEFVAL EXIST = .TRUE. GOTO 4300 4290 CONTINUE IF (.NOT.(NCHRS .LT. 0)) GOTO 4310 EXIST = .FALSE. GOTO 4300 4310 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 4330 DECODE(NCHRS, 1001, INPUT, ERR=201) V 1001 FORMAT(G15.0) IF (.NOT.(V .GE. LOW .AND. V .LE. HIGH)) GOTO 4350 EXIST = .TRUE. GOTO 4360 4350 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4360 CONTINUE 4330 CONTINUE 4300 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), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE 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 4370 R(1) = ENERGY(I) ENCODE(7, 1001, STRNG) R(1) 1001 FORMAT(F7.1) CALL BUFFIL(2, 15, STRNG, 7) 4370 CONTINUE IF (.NOT.(R(2) .NE. SHIELD(I))) GOTO 4390 R(2) = SHIELD(I) ENCODE(7, 1011, STRNG) R(2) 1011 FORMAT(F7.1) CALL BUFFIL(3, 15, STRNG, 7) 4390 CONTINUE IF (.NOT.(R(3) .NE. WARP(I))) GOTO 4410 R(3) = WARP(I) ENCODE(4, 1021, STRNG) R(3) 1021 FORMAT(F4.2) CALL BUFFIL(5, 18, STRNG, 4) 4410 CONTINUE IF (.NOT.(R(4) .NE. DIR(I))) GOTO 4430 R(4) = DIR(I) IF (.NOT.(R(4) .GT. 90.)) GOTO 4450 V = (450. - R(4))/30. GOTO 4460 4450 CONTINUE V = (90. - R(4))/30. 4460 CONTINUE ENCODE(5, 1031, STRNG) V 1031 FORMAT(F5.2) CALL BUFFIL(6, 17, STRNG, 5) 4430 CONTINUE IF (.NOT.(R(5) .NE. XCORD(I))) GOTO 4470 R(5) = XCORD(I) ENCODE(5, 1041, STRNG) R(5) 1041 FORMAT(F5.1) CALL BUFFIL(8, 17, STRNG, 5) 4470 CONTINUE IF (.NOT.(R(6) .NE. YCORD(I))) GOTO 4490 R(6) = YCORD(I) ENCODE(5, 1051, STRNG) R(6) 1051 FORMAT(F5.1) CALL BUFFIL(9, 17, STRNG, 5) 4490 CONTINUE IR = R(7) IF (.NOT.(IR .NE. TORPS(I))) GOTO 4510 R(7) = TORPS(I) ENCODE(2, 1061, STRNG) TORPS(I) 1061 FORMAT(I2) CALL BUFFIL(11, 20, STRNG, 2) 4510 CONTINUE IR = R(8) IF (.NOT.(IR .NE. NHOM(I))) GOTO 4530 R(8) = NHOM(I) ENCODE(2, 1071, STRNG) NHOM(I) 1071 FORMAT(I2) CALL BUFFIL(12, 20, STRNG, 2) 4530 CONTINUE IR = R(9) IF (.NOT.(IR .NE. HYPER(I))) GOTO 4550 R(9) = HYPER(I) ENCODE(1, 1081, STRNG) HYPER(I) 1081 FORMAT(I1) CALL BUFFIL(13, 21, STRNG, 1) 4550 CONTINUE IF (.NOT.(OLDSHP .NE. DEFSHP)) GOTO 4570 OLDSHP = DEFSHP ENCODE(1, 1091, STRNG) OLDSHP 1091 FORMAT(I1) CALL BUFFIL(15, 21, STRNG, 1) 4570 CONTINUE IF (.NOT.(OLDDIR .NE. DEFDIR)) GOTO 4590 OLDDIR = DEFDIR ENCODE(5, 1101, STRNG) DEFDIR 1101 FORMAT(F5.2) CALL BUFFIL(16, 17, STRNG, 5) 4590 CONTINUE DO 4610 J = 1, 8 IF (.NOT.((SC(J) .NE. SCORE(J)) .OR. (XSHIP(J).XOR.(ACT(J) .EQ. *'*')))) GOTO 4630 IF (.NOT.(XSHIP(J))) GOTO 4650 ACT(J) = '*' GOTO 4660 4650 CONTINUE ACT(J) = ' ' 4660 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) 4630 CONTINUE 4610 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 4670 FLAG = .FALSE. GOTO 4680 4670 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4690 FLAG = .TRUE. N = DEFVAL GOTO 4680 4690 CONTINUE DECODE(NCHRS, 1011, INPUT, ERR=201) N 1011 FORMAT(I5) IF (.NOT.((N .GE. LOW) .AND. (N .LE. HIGH))) GOTO 4710 FLAG = .TRUE. GOTO 4720 4710 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4720 CONTINUE 4680 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 4730 C IF PROMPT IS NOT NULL... C GET TYPE AHEAD CALL INCHAR(INPUT, NINPUT, .FALSE., 0, NC, IERR) IF (.NOT.(IERR .EQ. -1)) GOTO 4750 C EOF? GO TO 999 4750 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4770 C DONE? RETURN 4770 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 4790 C EOF? GO TO 999 4790 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4810 C DONE? RETURN 4810 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4830 C THEN ISSUE PROMPT LEN = 1 4850 IF (.NOT.(LEN .LE. MAXPRM .AND. PROMPT(LEN) .NE. 0)) GOTO 4870 4860 LEN = LEN + 1 GOTO 4850 4870 CONTINUE CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(PROMPT, LEN - 1) GOTO 4840 4830 CONTINUE ECHO = .FALSE. 4840 CONTINUE 4730 CONTINUE CALL INCHAR(INPUT(NCHRS + 1), NINPUT - NCHRS, ECHO, - 1, NC, IERR *) IF (.NOT.(PROMPT(1) .NE. 0 .AND. NCHRS .EQ. 0)) GOTO 4880 C THEN ERASE PROMPT STRNG CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(BLANKS, PRMPTL) 4880 CONTINUE IF (.NOT.(IERR .EQ. -1)) GOTO 4900 C EOF? GO TO 999 4900 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) 4920 CONTINUE IF (.NOT.(NCHRS .LE. 0)) GOTO 4950 NCHRS = 1 ANSWER(1) = 0 4950 CONTINUE IF (.NOT.(ANSWER(1) .GE. 'a' .AND. ANSWER(1) .LE. 'z')) GOTO 497 *0 ANSWER(1) = (ANSWER(1) - 'a') + 'A' C * CHECK FOR YES 4970 CONTINUE IF (.NOT.(ANSWER(1) .EQ. 'Y')) GOTO 4990 FLAG = .TRUE. OK = .TRUE. C * CHECK FOR A NO GOTO 5000 4990 CONTINUE IF (.NOT.(ANSWER(1) .EQ. 'N')) GOTO 5010 FLAG = .FALSE. OK = .TRUE. C * INCORRECT RESPONSE GOTO 5000 5010 CONTINUE IF (.NOT.(PROMPT(1) .EQ. 0)) GOTO 5030 CALL OUTCH(13, 1) CALL OUTSTR(.TRUE., 'ANSWER YES OR NO? ', .FALSE.) CALL INCHAR(ANSWER, 4, .TRUE., - 1, NCHRS, IER) GOTO 5040 5030 CONTINUE CALL REDPMT('ANSWER YES OR NO? ', ANSWER, 4, NCHRS) 5040 CONTINUE 5000 CONTINUE 4930 IF (.NOT.(OK)) GOTO 4920 RETURN END SUBROUTINE OUTSTR(LFFLAG, STRNG, CRFLAG) LOGICAL LFFLAG, CRFLAG BYTE STRNG(1) LEN = 0 5050 IF (.NOT.(STRNG(LEN+1) .NE. 0)) GOTO 5070 5060 LEN = LEN + 1 GOTO 5050 5070 CONTINUE IF (.NOT.(LFFLAG)) GOTO 5080 CALL OUTCH(10, 1) 5080 CONTINUE CALL OUTCH(STRNG, LEN) IF (.NOT.(CRFLAG)) GOTO 5100 CALL OUTCH(0, - 1) GOTO 5110 5100 CONTINUE CALL OUTCH(0, 0) 5110 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), UPRATE, UNIV(100, 100), MESSAG( *480), THRU, XSHIP(8), CLOAK(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM, UPRATE 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 5120 IX1 = IXLOW, IXHI IX = IX1 - IXX DO 5140 IY1 = IYLOW, IYHI IY = IY1 - IYY ALPHA = UNIV(IX1, IY1) IF (.NOT.(ALPHA .EQ. EMPTY)) GOTO 5160 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 5180 NBUFF(IX, IY) = '-' 5180 CONTINUE GOTO 5170 5160 CONTINUE IF (.NOT.((ALPHA .GE. 48+1) .AND. (ALPHA .LE. 48+8) .AND. (CLO *AK(ALPHA-48)))) GOTO 5200 NBUFF(IX, IY) = EMPTY GOTO 5170 5200 CONTINUE IF (.NOT.(ALPHA .LT. 0)) GOTO 5220 NBUFF(IX, IY) = '%' GOTO 5170 5220 CONTINUE NBUFF(IX, IY) = ALPHA 5170 CONTINUE 5140 CONTINUE 5120 CONTINUE RETURN END