C C CODE WHICH REQUIRES SPECIAL SUPPORT FROM THE ICR INSTALLATION IS C COMMENTED OUT USING THE FOLLOWING DEFINES. THE SECOND DEFINE C OVERRIDES THE FIRST UNLESS IT IS COMMENTED OUT. C C NOTE THE ORDER OF THE NEXT 4 DEFINES IS SIGNIFICANT! C CDEFINE(ICR,) # COMMENT THIS OUT FOR EXPORT VERSION C ICR ONLY DEFINE(NOTICR,# NOT ICR) 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 MESSAGE OUTPUT C MAY 1980 BILL CAEL, BILL WOOD, AND BOB STODOLA C RECODED COMMAND ARG PROMPTING 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, SCAN(8), PHA(8), I1, I2, HYPER(8), ISE *NT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XHOM(8, 4) *, YHOM(8, 4), WHOM(8, 4), NHOM(8), SCORE(8), CREW(8), DIR(8), WARP *(8), LAUNCH(8), UNIV(100, 100), MESSAG(480), THRU, XSHIP(8), CLOAK *(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS 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, REC96 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) C C NOTE, THE SEQUENCE OF THE NEXT 4 STATEMENTS IS SIGNIFICANT C BYTE BLUNK BYTE NBUFF( - 9: + 9, - 9: + 9) BYTE BLUNK2 BYTE OBUFF( - 9: + 9, - 9: + 9) INTEGER COMMND INTEGER WHO C ICR ONLY INTEGER IOP(4) C ICR ONLY INTEGER*4 RUNTSK C ICR ONLY DATA RUNTSK/6R...RUN/ DATA BLANK/80*' '/ DATA BLUNK, BLUNK2/' ', ' '/ DATA SC/9* - 9999./ DATA R/9* - 9999./ DATA DONE/.FALSE./ DATA OK/.FALSE./ DATA DEFDIR/0.0/, DEFSHD/0.0/ CALL ERRSET(63, .TRUE., .FALSE., .TRUE., .FALSE., ) CALL ERRSET(64, .TRUE., .FALSE., .TRUE., .FALSE., ) WRITE(5, 2000) 2000 FORMAT('0WELCOME TO MULTI-TREK.') 2010 CONTINUE WRITE(5, 2040) 2040 FORMAT('0THE FOLLOWING VESSELS ARE AVAILIABLE FOR USE.') DO 2050 I = 1, 8 IF (.NOT.(.NOT.XSHIP(I))) GOTO 2070 WRITE(5, 2090) I 2090 FORMAT(' SHIP ',I1) 2070 CONTINUE 2050 CONTINUE 2060 CONTINUE WRITE(5, 2100) 2100 FORMAT('$ENTER THE NUMBER OF THE VESSEL YOU WISH TO COMMAND: ' *) CALL GETINT(0, IW, OK, 1, 8, 0) IF (.NOT.(OK)) GOTO 2110 IF (.NOT.(IW .EQ. 0)) GOTO 2130 OK = .FALSE. GOTO 2020 2130 CONTINUE WHO = IW IF (.NOT.(XSHIP(WHO))) GOTO 2150 WRITE(5, 2170) 2170 FORMAT('0THIS SHIP ALREADY HAS A COMMANDER.') WRITE(5, 2180) 2180 FORMAT('$DO YOU WISH TO SHARE THIS COMMAND? ') CALL YESNO(0, OK) 2150 CONTINUE GOTO 2120 2110 CONTINUE CALL EXIT 2120 CONTINUE 2020 IF (.NOT.(OK)) GOTO 2010 2030 CONTINUE REFRES = .TRUE. REFTOG = .FALSE. CREW(WHO) = CREW(WHO) + 1 DEFSHP = WHO C C REC96 IS SET TRUE IF TERMINAL SPEED IS 9600 BAUD. C IF REC96 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 REC96, INITIALIZE TERMINAL IO CALL GTCHAR(REC96) CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF IF (.NOT.(.NOT.REC96)) GOTO 2190 C START 1 SECOND TIMER IF NOT 9600 CALL MARK(3, 60, 1, IDS) 2190 CONTINUE C START 1/2 SECOND TIMER CALL MARK(2, 30, 1, IDS) 2210 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 C ICR ONLY IF (THRU) [ # THEN MTREKD ISN'T RUNNING C ICR ONLY CALL SPWNNL(RUNTSK,IOP,'RUN MTR/TI=TT0',14,IDS) C ICR ONLY ] C C PLACE LOCAL SCAN ON TERMINAL C REFTOG = (.NOT.REFTOG) .OR. REC96 IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 2240 C DON'T REFRESH IF BLOWN UP! CALL STRMOV(BLUNK, 1, 361, NBUFF, 1) ID = SCAN(WHO) XX = XCORD(WHO) YY = YCORD(WHO) DO 2260 IX = - ID, + ID IX1 = XX + IX DO 2280 IY = - ID, MIN(8, + ID) IY1 = YY + IY IF (.NOT.((IX1 .LT. 100) .AND. (IX1 .GT. 1) .AND. (IY1 .LT *. 100) .AND. (IY1 .GT. 1))) GOTO 2300 ALPHA = UNIV(IX1, IY1) GOTO 2310 2300 CONTINUE IF (.NOT.(((IX1 .EQ. 100) .OR. (IX1 .EQ. 1) .OR. (IY1 .E *Q. 100) .OR. (IY1 .EQ. 1)) .AND. (((IX1 .LT. 100) .AND. (IX1 .GT. *1)) .OR. ((IY1 .LT. 100) .AND. (IY1 .GT. 1))))) GOTO 2320 ALPHA = UNIV(IX1, IY1) IF (.NOT.(ALPHA .EQ. EMPTY)) GOTO 2340 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. MIN(8, ID) .OR. IY .EQ. 0) .AND. (IX1 .EQ. 100 .OR. IX1 .E *Q. 1)))) GOTO 2360 ALPHA = '-' 2360 CONTINUE 2340 CONTINUE GOTO 2330 2320 CONTINUE ALPHA = EMPTY 2330 CONTINUE 2310 CONTINUE IF (.NOT.((ALPHA .GE. 48+1) .AND. (ALPHA .LE. 48+8) .AND. *(CLOAK(ALPHA-48)))) GOTO 2380 NBUFF(IX, IY) = EMPTY GOTO 2390 2380 CONTINUE IF (.NOT.(ALPHA .LT. 0)) GOTO 2400 NBUFF(IX, IY) = '%' GOTO 2410 2400 CONTINUE NBUFF(IX, IY) = ALPHA 2410 CONTINUE 2390 CONTINUE 2280 CONTINUE 2290 CONTINUE 2260 CONTINUE 2270 CONTINUE IF (.NOT.(NBUFF(-ID, -ID) .EQ. EMPTY)) GOTO 2420 NBUFF( - ID, - ID) = '.' 2420 CONTINUE IF (.NOT.(NBUFF(-ID, MIN(ID, 8)) .EQ. EMPTY)) GOTO 2440 NBUFF( - ID, MIN(ID, 8)) = '.' 2440 CONTINUE IF (.NOT.(NBUFF(ID, MIN(ID, 8)) .EQ. EMPTY)) GOTO 2460 NBUFF(ID, MIN(ID, 8)) = '.' 2460 CONTINUE IF (.NOT.(NBUFF(ID, -ID) .EQ. EMPTY)) GOTO 2480 NBUFF(ID, - ID) = '.' 2480 CONTINUE DO 2500 IY = - 9, + 8 ICURSX = - 999 DO 2520 IX = - 9, + 9 IF (.NOT.(NBUFF(IX, IY) .NE. OBUFF(IX, IY))) GOTO 2540 IF (.NOT.(ICURSX .GE. IX-2)) GOTO 2560 DO 2580 III = ICURSX + 1, IX CALL OUTCH(' ', 1) CALL OUTCH(NBUFF(III, IY), 1) 2580 CONTINUE 2590 CONTINUE GOTO 2570 2560 CONTINUE CALL TPOS(9 - IY, 2*IX + 43) CALL OUTCH(NBUFF(IX, IY), 1) 2570 CONTINUE ICURSX = IX OBUFF(IX, IY) = NBUFF(IX, IY) 2540 CONTINUE 2520 CONTINUE 2530 CONTINUE 2500 CONTINUE 2510 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 2240 CONTINUE IF (.NOT.(COMMND .NE. ' ' .AND. XSHIP(WHO))) GOTO 2600 IF (.NOT.(REFTOG)) GOTO 2620 CALL WAITFR(2, IDS) IF (.NOT.(REC96)) GOTO 2640 C RESTART 1/2 SECOND TIMER CALL MARK(2, 30, 1, IDS) 2640 CONTINUE GOTO 2630 2620 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) 2630 CONTINUE 2600 CONTINUE NC = 1 COMMND = '0 ' IF (.NOT.(XSHIP(WHO))) GOTO 2660 CALL TREAD(COMMND, NC) C C CHECK FOR NO INPUT C 2660 CONTINUE IF (.NOT.(COMMND .EQ. '0 ')) GOTO 2680 C C HELP COMMAND C GOTO 2690 2680 CONTINUE IF (.NOT.(COMMND .EQ. '? ')) GOTO 2700 CALL POSITN(18, 1) WRITE(5, 1001) 1001 FORMAT(' A APPEAR (CLOAKING OFF)'T30'M SEND MESSAGE'T55'T * FIRE TORPEDOES'/, ' C COURSE HEADING'T30'N FREEZE ANTI-MATTER'T *55'W SET WARP SPEED'/, ' F FADE (CLOAKING ON)'T30'P FIRE PHASER *S'T55'X DETONATE ANTI-MATTER'/, ' H HYPERSPACE SETTING'T30'Q QU *IT'T55'Z LAUNCH ANTI-MATTER'/, ' K FIRE HOMING TORPEDO'T30'R RE *SET DISPLAY'T55'? HELP MESSAGE'/, ' L LOCATE SHIP'T30'S SHIELD *CHANGE'T55'E ENERGY NET') CALL POSITN(1, 1) C C WARP FACTOR COMMAND C GOTO 2710 2700 CONTINUE IF (.NOT.(COMMND .EQ. 'W ')) GOTO 2720 CALL GETREL('WARP SIR? ', VALUE, OK, 0., 8., WARP(WHO)) IF (.NOT.(OK)) GOTO 2740 WARP(WHO) = VALUE 2740 CONTINUE C C COURSE COMMAND C GOTO 2730 2720 CONTINUE IF (.NOT.(COMMND .EQ. 'C ')) GOTO 2760 CALL GETREL('COURSE SIR? ', VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 2780 IF (.NOT.(VALUE .GE. 3.)) GOTO 2800 DIR(WHO) = (15. - VALUE)*30. GOTO 2810 2800 CONTINUE DIR(WHO) = (3. - VALUE)*30. 2810 CONTINUE 2780 CONTINUE C C HYPERSPACE COMMAND C GOTO 2770 2760 CONTINUE IF (.NOT.(COMMND .EQ. 'H ')) GOTO 2820 IUNIQ = HYPER(WHO) CALL GETINT('HYPER PORT? ', II, OK, 1, 6, IUNIQ) IF (.NOT.(OK)) GOTO 2840 HYPER(WHO) = II 2840 CONTINUE C C SHIELD COMMAND C GOTO 2830 2820 CONTINUE IF (.NOT.(COMMND .EQ. 'S ')) GOTO 2860 CALL GETREL('ENERGY CHANGE? ', VALUE, OK, - 1.E36, *1.E36, DEFSHD) IF (.NOT.(OK)) GOTO 2880 IF (.NOT.(ENERGY(WHO)-VALUE .GE. 0. .AND. SHIELD(W *HO)+VALUE .GE. 0.)) GOTO 2900 ENERGY(WHO) = ENERGY(WHO) - VALUE SHIELD(WHO) = SHIELD(WHO) + VALUE IF (.NOT.(VALUE.GE.0.0)) GOTO 2920 DEFSHD = VALUE 2920 CONTINUE GOTO 2910 2900 CONTINUE CALL MESSGE('?! IMPOSSIBLE !?') 2910 CONTINUE 2880 CONTINUE C C QUIT COMMAND C GOTO 2870 2860 CONTINUE IF (.NOT.(COMMND .EQ. 'Q ')) GOTO 2940 CALL YESNO('QUIT NOW? ', DONE) C C HOMING TORPEDO LAUNCH C GOTO 2950 2940 CONTINUE IF (.NOT.(COMMND .EQ. 'K ')) GOTO 2960 IF (.NOT.(NHOM(WHO) .EQ. 4)) GOTO 2980 TWHOM = 0. GOTO 2990 2980 CONTINUE TWHOM = WHOM(WHO, NHOM(WHO) + 1) 2990 CONTINUE IF (.NOT.(TWHOM .GE. 0.)) GOTO 3000 IF (.NOT.(NHOM(WHO) .GT. 0)) GOTO 3020 CALL GETINT('HOMING FREQUENCY? ', II, OK, 1, * 8, DEFSHP) IF (.NOT.(OK)) GOTO 3040 DEFSHP = II IF (.NOT.(II .EQ. WHO)) GOTO 3060 CALL MESSGE('TORPEDOES JAMMED!') NHOM(WHO) = 0 TORPS(WHO) = 0 GOTO 3070 3060 CONTINUE WHOM(WHO, NHOM(WHO)) = - II NHOM(WHO) = NHOM(WHO) - 1 3070 CONTINUE 3040 CONTINUE GOTO 3030 3020 CONTINUE CALL MESSGE('NO HOMERS!') 3030 CONTINUE GOTO 3010 3000 CONTINUE CALL MESSGE('HOMERS NOT READY') 3010 CONTINUE C C REFRESH COMMAND C GOTO 2970 2960 CONTINUE IF (.NOT.(COMMND .EQ. 'R ')) GOTO 3080 CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF DO 3100 I = 1, 9 SC(I) = - 9999. R(I) = - 9999. 3100 CONTINUE 3110 CONTINUE OLDSHP = 0 OLDDIR = - 1.0 C C TORPEDO COMMAND C GOTO 3090 3080 CONTINUE IF (.NOT.(COMMND .EQ. 'T ')) GOTO 3120 IF (.NOT.(LAUNCH(WHO) .LT. 0.)) GOTO 3140 IF (.NOT.(TORPS(WHO) .GT. 0)) GOTO 3160 CALL GETREL('TORPEDO COURSE? ', VALUE, O *K, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3180 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.)) GOTO 3200 VALUE = (15. - VALUE)*30. GOTO 3210 3200 CONTINUE VALUE = (3. - VALUE)*30. 3210 CONTINUE LAUNCH(WHO) = VALUE TORPS(WHO) = TORPS(WHO) - 1 IF (.NOT.(TORPS(WHO) .EQ. 0)) GOTO 322 *0 CALL MESSGE('LAST TORPEDO!') 3220 CONTINUE 3180 CONTINUE GOTO 3170 3160 CONTINUE CALL MESSGE('NO TORPEDOES!') 3170 CONTINUE GOTO 3150 3140 CONTINUE CALL MESSGE('TORPEDOES NOT READY') 3150 CONTINUE C C PHASER COMMAND C GOTO 3130 3120 CONTINUE IF (.NOT.(COMMND .EQ. 'P ')) GOTO 3240 IF (.NOT.(PHA(WHO) .LT. 0.)) GOTO 3260 CALL GETREL('PHASER COURSE? ', VALUE, OK *, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3280 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.)) GOTO 3300 VALUE = (15. - VALUE)*30. GOTO 3310 3300 CONTINUE VALUE = (3. - VALUE)*30. 3310 CONTINUE PHA(WHO) = VALUE ENERGY(WHO) = ENERGY(WHO) - 50. 3280 CONTINUE GOTO 3270 3260 CONTINUE CALL MESSGE('PHASERS NOT READY') 3270 CONTINUE C C LONG RANGE SCAN COMMAND C GOTO 3250 3240 CONTINUE IF (.NOT.(COMMND .EQ. 'L ')) GOTO 3320 CALL GETINT('FREQUENCY? ', II, OK, 1, 8, * DEFSHP) IF (.NOT.(OK)) GOTO 3340 DEFSHP = II IX = XCORD(II)/10. IY = YCORD(II)/10. CALL POSITN(16, 75) WRITE(5, 3360) IX, IY 3360 FORMAT(1X,I2,',',I2) XX = XCORD(WHO) YY = YCORD(WHO) X1 = XCORD(II) IF (.NOT.(X1 .LT. 50.)) GOTO 3370 X2 = X1 + 100. GOTO 3380 3370 CONTINUE X2 = X1 - 100. 3380 CONTINUE Y1 = YCORD(II) IF (.NOT.(Y1 .LT. 50.)) GOTO 3390 Y2 = Y1 + 100. GOTO 3400 3390 CONTINUE Y2 = Y1 - 100. 3400 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 3410 J = 2, 4 IF (.NOT.(D1(J) .LT. D1(IIT))) GOTO *3430 IIT = J 3430 CONTINUE 3410 CONTINUE 3420 CONTINUE D = D1(IIT) IF (.NOT.(IIT .EQ. 1)) GOTO 3450 YD = Y1 XD = X1 GOTO 3460 3450 CONTINUE IF (.NOT.(IIT .EQ. 2)) GOTO 3470 YD = Y2 XD = X1 GOTO 3480 3470 CONTINUE IF (.NOT.(IIT .EQ. 3)) GOTO 3490 YD = Y1 XD = X2 GOTO 3500 3490 CONTINUE YD = Y2 XD = X2 3500 CONTINUE 3480 CONTINUE 3460 CONTINUE EDIS = D EDIR = ATAN3((YD - YY), (XD - XX))*57. *2952 IF (.NOT.(EDIR .LT. 0.)) GOTO 3510 EDIR = EDIR + 360. 3510 CONTINUE IF (.NOT.(EDIR .GT. 90.)) GOTO 3530 EDIR = (450. - EDIR)/30. GOTO 3540 3530 CONTINUE EDIR = (90. - EDIR)/30. 3540 CONTINUE DEFDIR = EDIR CALL POSITN(15, 75) WRITE(5, 3550) EDIS 3550 FORMAT(1X,F5.2) CALL POSITN(14, 75) WRITE(5, 3560) EDIR 3560 FORMAT(1X,F5.2) CALL POSITN(13, 79) WRITE(5, 3570) DEFSHP 3570 FORMAT(1X,I1) 3340 CONTINUE C C MESSAGE COMMAND C GOTO 3330 3320 CONTINUE IF (.NOT.(COMMND .EQ. 'M ')) GOTO 3580 CALL GETINT('UHURA HERE, TO WHOM? ', I *VAL, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3600 IF (.NOT.(IVAL .NE. 0)) GOTO 3620 IL = IVAL IH = IVAL GOTO 3630 3620 CONTINUE IL = 1 IH = 8 3630 CONTINUE CALL POSITN(23, 1) WRITE(5, 3640) 3640 FORMAT(80(' ')) CALL POSITN(23, 1) WRITE(5, 3650) 3650 FORMAT('$MESSAGE CAPTAIN? ') READ(5, 3660, END=1012) (MESBUF(I), *I = 2, 60) 3660 FORMAT(59A1) GOTO 1013 1012 CLOSE(UNIT = 5) 1013 CONTINUE CALL POSITN(1, 1) MESBUF(1) = WHO + 48 DO 3670 I = IL, IH IF (.NOT.(XSHIP(I) .AND. I .NE. WH *O)) GOTO 3690 ENERGY(WHO) = ENERGY(WHO) - 10. CALL STRMOV(MESBUF, 1, 60, MESSA *G, I*60 - 59) 3690 CONTINUE 3670 CONTINUE 3680 CONTINUE 3600 CONTINUE C C CLOAKING COMMAND C GOTO 3590 3580 CONTINUE IF (.NOT.(COMMND .EQ. 'F ')) GOTO 3710 IF (.NOT.(.NOT.CLOAK(WHO))) GOTO 373 *0 CLOAK(WHO) = .TRUE. GOTO 3740 3730 CONTINUE CALL MESSGE('ALREADY CLOAKED!') 3740 CONTINUE C C APPEAR COMMAND C GOTO 3720 3710 CONTINUE IF (.NOT.(COMMND .EQ. 'A ')) GOTO 37 *50 IF (.NOT.(CLOAK(WHO))) GOTO 3770 CLOAK(WHO) = .FALSE. GOTO 3780 3770 CONTINUE CALL MESSGE('NOT CLOAKED!') 3780 CONTINUE C C EXPLODE ANTI-MATTER DEVICE C GOTO 3760 3750 CONTINUE IF (.NOT.(COMMND .EQ. 'X ')) GOTO *3790 IF (.NOT.(IPOD(WHO) .EQ. 2)) GOT *O 3810 IPOD(WHO) = 3 CALL MESSGE('DETONATION SIGNAL *ED') GOTO 3820 3810 CONTINUE CALL MESSGE('NO POD!') 3820 CONTINUE C C CONVERT MOVING ANTI-MATTER POD TO A STATIC MINE C GOTO 3800 3790 CONTINUE IF (.NOT.(COMMND .EQ. 'N ')) GOT *O 3830 IF (.NOT.(IPOD(WHO) .EQ. 2)) G *OTO 3850 WPOD(WHO) = 0. CALL MESSGE('POD POSITIONED' *) GOTO 3860 3850 CONTINUE CALL MESSGE('NO POD!') 3860 CONTINUE C C LAUNCH ANTI-MATTER DEVICE C GOTO 3840 3830 CONTINUE IF (.NOT.(COMMND .EQ. 'Z ')) G *OTO 3870 IF (.NOT.(IPOD(WHO) .EQ. 0)) * GOTO 3890 CALL GETREL('POD COURSE? ' *, VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 3910 DEFDIR = VALUE IF (.NOT.(VALUE .GE. 3.) *) GOTO 3930 DPOD(WHO) = (15. - VALUE)*30. GOTO 3940 3930 CONTINUE DPOD(WHO) = (3. - VALUE)*30. 3940 CONTINUE IPOD(WHO) = 1 3910 CONTINUE GOTO 3900 3890 CONTINUE CALL MESSGE('NO POD!') 3900 CONTINUE C C FLIP ENERGY NET ON OR OFF C GOTO 3880 3870 CONTINUE IF (.NOT.(COMMND .EQ. 'E ')) * GOTO 3950 NET(WHO) = .NOT.NET(WHO) C C FLIP VERBOSE MESSAGES ON OR OFF C GOTO 3960 3950 CONTINUE IF (.NOT.(COMMND .EQ. 'V ' *)) GOTO 3970 VERBOS = .NOT.VERBOS C C ERROR C GOTO 3980 3970 CONTINUE IF (.NOT.(COMMND .NE. ' * ')) GOTO 3990 CALL MESSGE('?! WHAT !?') 3990 CONTINUE 3980 CONTINUE 3960 CONTINUE 3880 CONTINUE 3840 CONTINUE 3800 CONTINUE 3760 CONTINUE 3720 CONTINUE 3590 CONTINUE 3330 CONTINUE 3250 CONTINUE 3130 CONTINUE 3090 CONTINUE 2970 CONTINUE 2950 CONTINUE 2870 CONTINUE 2830 CONTINUE 2770 CONTINUE 2730 CONTINUE 2710 CONTINUE 2690 CONTINUE IF (.NOT.((XSHIP(WHO) .AND. REFTOG) .OR. REFRES)) GOTO 4010 CALL REFRSH(SC, R, WHO) 4010 CONTINUE IF (.NOT.(REFRES)) GOTO 4030 XSHIP(WHO) = .TRUE. REFRES = .FALSE. REFTOG = .FALSE. C C WRITE OUT MESSAGES FROM DRIVER C 4030 CONTINUE DO 4050 I = 1, 10 IF (.NOT.(ISENT(WHO, I) .NE. 0)) GOTO 4070 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 4050 2 CONTINUE CALL MESSGE('- HIT A STAR!') GOTO 4050 3 CONTINUE DO 4090 IK = 1, 3 CALL CLEAR CALL OUTCH(0, 0) WRITE(5, 4110) 4110 FORMAT(////////////,25X,'*** BOOM ***') 4090 CONTINUE 4100 CONTINUE WRITE(5, 4120) 4120 FORMAT('0YOUR SHIP HAS BEEN DESTROYED'/' FORTUNATELY YOU E *SCAPED WITH YOUR LIFE.'/' UNFORTUNATELY, YOU HAVE BEEN GIVEN A NEW * COMMAND.'//'$ARE YOU READY TO ACCEPT THIS ASSIGNMENT? ') CALL YESNO(0, YES) IF (.NOT.(YES)) GOTO 4130 WRITE(5, 4150) 4150 FORMAT(' GOOD!') CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF DO 4160 K = 1, 9 SC(K) = - 9999. R(K) = - 9999. 4160 CONTINUE 4170 CONTINUE OLDDIR = - 1.0 OLDSHP = 0 REFRES = .TRUE. GOTO 4140 4130 CONTINUE DONE = .TRUE. 4140 CONTINUE GOTO 4050 4 CONTINUE CALL MESSGE('- TORPEDO HIT US!') GOTO 4050 5 CONTINUE CALL MESSGE('+ TORPEDO HIT ALIEN!') GOTO 4050 6 CONTINUE CALL MESSGE('+ PHASER HIT ALIEN!') GOTO 4050 7 CONTINUE CALL MESSGE('PHASER HIT TORPEDO') GOTO 4050 8 CONTINUE CALL MESSGE('PHASERS MISSED') GOTO 4050 9 CONTINUE CALL MESSGE('- RAMMED ALIEN!') GOTO 4050 10 CONTINUE CALL MESSGE('- COLLISION!') GOTO 4050 11 CONTINUE CALL MESSGE('PHASER HIT STAR') GOTO 4050 12 CONTINUE CALL MESSGE('- BASE UNDER ATTACK') GOTO 4050 13 CONTINUE CALL MESSGE('TORPEDO HIT STAR') GOTO 4050 14 CONTINUE CALL MESSGE('- PHASER ATTACK!') GOTO 4050 15 CONTINUE CALL POSITN(17, 1) WRITE(5, 4180) 4180 FORMAT(' SPOCK HERE CAPTAIN. '/' WE ARE BEING DRAWN IN *TO SOME SORT OF BLACK HOLE,'/' IT IS UNLIKE ANYTHING I HAVE EVER E *NCOUNTERED.'/' FASCINATING.') CALL WAIT(1, 2, M) GOTO 4050 16 CONTINUE CALL POSITN(17, 1) WRITE(5, 4190) 4190 FORMAT(' SCOTT HERE CAPTAIN. '/' OUR DYLITHIUM CRYSTAL *S ARE GONE. LIFE SUPPORT IS '/' FAILING ...!') CALL WAIT(1, 2, M) GOTO 4050 17 CONTINUE CALL MESSGE('HYPERSPACE!') GOTO 4050 18 CONTINUE CALL MESSGE('HYPERSPACE BLOCKED!') GOTO 4050 19 CONTINUE CALL MESSGE('RANDOM HYPERSPACE!') GOTO 4050 20 CONTINUE CALL MESSGE('TORPEDO HIT TORPEDO') GOTO 4050 21 CONTINUE CALL MESSGE('HIT GHOST SHIP') GOTO 4050 22 CONTINUE CALL MESSGE('*** ALIEN DESTROYED!') CALL MESSGE('********************') GOTO 4050 23 CONTINUE CALL MESSGE('POD BLOCKED!') GOTO 4050 24 CONTINUE CALL MESSGE('POD DESTROYED!') GOTO 4050 25 CONTINUE CALL MESSGE('PHASER HIT POD') GOTO 4050 26 CONTINUE CALL MESSGE('TORPEDO HIT POD') GOTO 4050 27 CONTINUE CALL MESSGE('- METAL OBJECT NEAR') GOTO 4050 28 CONTINUE CALL MESSGE('POD LAUNCHED') GOTO 4050 29 CONTINUE CALL MESSGE('POD DETONATED!') GOTO 4050 30 CONTINUE CALL MESSGE('- POD EXPLOSION!') GOTO 4050 31 CONTINUE CALL MESSGE('IIEEEEEE!') GOTO 4050 32 CONTINUE CALL MESSGE('+ POD HIT ALIEN!') GOTO 4050 33 CONTINUE CALL MESSGE('- HIT NET!') GOTO 4050 34 CONTINUE CALL MESSGE('TORPEDO HIT NET') GOTO 4050 35 CONTINUE CALL MESSGE('PHASER HIT NET') GOTO 4050 36 CONTINUE CALL MESSGE('NET BLOCKED!') GOTO 4050 4070 CONTINUE 4050 CONTINUE 4060 CONTINUE IF (.NOT.(MESSAG(WHO*60-59) .NE. ' ')) GOTO 4200 CALL POSITN(23, 1) WRITE(5, 4220) (MESSAG(I), I = WHO*60 - 59, WHO*60) 4220 FORMAT(' MESSAGE FROM 'A1': '60A1) CALL STRMOV(BLANK, 1, 60, MESSAG, WHO*60 - 59) CALL POSITN(1, 1) 4200 CONTINUE IF (.NOT.((ENERGY(WHO) .LT. 900.) .AND. WARN)) GOTO 4230 CALL MESSGE('ENERGY LOW!') WARN = .FALSE. GOTO 4240 4230 CONTINUE WARN = .TRUE. 4240 CONTINUE CALL MESSGE(0) 2220 IF (.NOT.(DONE)) GOTO 2210 2230 CONTINUE CREW(WHO) = CREW(WHO) - 1 IF (.NOT.(CREW(WHO) .LE. 400)) GOTO 4250 XSHIP(WHO) = .FALSE. GOTO 4260 4250 CONTINUE XSHIP(WHO) = .TRUE. 4260 CONTINUE CALL CLEAR CALL OUTCH(0, 0) CALL EXIT END SUBROUTINE TREAD(STRING, NC) BYTE STRING CALL INCHAR(STRING, NC, .FALSE., 0, LINE, NC, IERR) IF (.NOT.(NC .EQ. 0 .AND. IERR .NE. -2)) GOTO 4270 STRING = ' ' 4270 CONTINUE RETURN END SUBROUTINE RBUFF COMMON/MESS/CLEARF LOGICAL CLEARF CALL CLEAR CLEARF = .FALSE. C C DRAW NEW SCREEN C CALL BUFFIL(1, 3, 'ENERGY :', 10) CALL BUFFIL(2, 3, 'SHIELDS :', 10) CALL BUFFIL(4, 3, 'WARP :', 10) CALL BUFFIL(5, 3, 'COURSE :', 10) CALL BUFFIL(7, 3, 'X CO-ORD :', 10) CALL BUFFIL(8, 3, 'Y CO-ORD :', 10) CALL BUFFIL(10, 3, 'TORPS :', 10) CALL BUFFIL(11, 3, 'SEEKERS :', 10) CALL BUFFIL(12, 3, 'HYPER :', 10) CALL BUFFIL(14, 3, 'DEF SHIP :', 10) CALL BUFFIL(15, 3, 'DEF DIREC:', 10) CALL BUFFIL(1, 70, 'SCORES', 6) CALL BUFFIL(3, 68, '1', 1) CALL BUFFIL(4, 68, '2', 1) CALL BUFFIL(5, 68, '3', 1) CALL BUFFIL(6, 68, '4', 1) CALL BUFFIL(7, 68, '5', 1) CALL BUFFIL(8, 68, '6', 1) CALL BUFFIL(9, 68, '7', 1) CALL BUFFIL(10, 68, '8', 1) CALL BUFFIL(13, 68, 'SCAN:', 5) CALL BUFFIL(14, 68, 'DIR :', 5) CALL BUFFIL(15, 68, 'DIST:', 5) CALL BUFFIL(16, 68, '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, 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 4320 4310 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 4330 DECODE(NCHRS, 4350, INPUT, ERR=201) V 4350 FORMAT(G15.0) IF (.NOT.(V .GE. LOW .AND. V .LE. HIGH)) GOTO 4360 EXIST = .TRUE. GOTO 4370 4360 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4370 CONTINUE 4330 CONTINUE 4320 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, SCAN(8), PHA(8), I1, I2, HYPER(8), ISE *NT(8, 10), XPOD(8), YPOD(8), DPOD(8), IPOD(8), WPOD(8), XHOM(8, 4) *, YHOM(8, 4), WHOM(8, 4), NHOM(8), SCORE(8), CREW(8), DIR(8), WARP *(8), LAUNCH(8), UNIV(100, 100), MESSAG(480), THRU, XSHIP(8), CLOAK *(8), NET(8), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS 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 STRING(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 4380 R(1) = ENERGY(I) ENCODE(7, 4400, STRING) R(1) 4400 FORMAT(F7.1) CALL BUFFIL(1, 14, STRING, 7) 4380 CONTINUE IF (.NOT.(R(2) .NE. SHIELDS(I))) GOTO 4410 R(2) = SHIELDS(I) ENCODE(7, 4430, STRING) R(2) 4430 FORMAT(F7.1) CALL BUFFIL(2, 14, STRING, 7) 4410 CONTINUE IF (.NOT.(R(3) .NE. WARP(I))) GOTO 4440 R(3) = WARP(I) ENCODE(4, 4460, STRING) R(3) 4460 FORMAT(F4.2) CALL BUFFIL(4, 17, STRING, 4) 4440 CONTINUE IF (.NOT.(R(4) .NE. DIR(I))) GOTO 4470 R(4) = DIR(I) IF (.NOT.(R(4) .GT. 90.)) GOTO 4490 V = (450. - R(4))/30. GOTO 4500 4490 CONTINUE V = (90. - R(4))/30. 4500 CONTINUE ENCODE(5, 4510, STRING) V 4510 FORMAT(F5.2) CALL BUFFIL(5, 16, STRING, 5) 4470 CONTINUE IF (.NOT.(R(5) .NE. XCORD(I))) GOTO 4520 R(5) = XCORD(I) ENCODE(5, 4540, STRING) R(5) 4540 FORMAT(F5.1) CALL BUFFIL(7, 16, STRING, 5) 4520 CONTINUE IF (.NOT.(R(6) .NE. YCORD(I))) GOTO 4550 R(6) = YCORD(I) ENCODE(5, 4570, STRING) R(6) 4570 FORMAT(F5.1) CALL BUFFIL(8, 16, STRING, 5) 4550 CONTINUE IR = R(7) IF (.NOT.(IR .NE. TORPS(I))) GOTO 4580 R(7) = TORPS(I) ENCODE(2, 4600, STRING) TORPS(I) 4600 FORMAT(I2) CALL BUFFIL(10, 19, STRING, 2) 4580 CONTINUE IR = R(8) IF (.NOT.(IR .NE. NHOM(I))) GOTO 4610 R(8) = NHOM(I) ENCODE(2, 4630, STRING) NHOM(I) 4630 FORMAT(I2) CALL BUFFIL(11, 19, STRING, 2) 4610 CONTINUE IR = R(9) IF (.NOT.(IR .NE. HYPER(I))) GOTO 4640 R(9) = HYPER(I) ENCODE(1, 4660, STRING) HYPER(I) 4660 FORMAT(I1) CALL BUFFIL(12, 20, STRING, 1) 4640 CONTINUE IF (.NOT.(OLDSHP .NE. DEFSHP)) GOTO 4670 OLDSHP = DEFSHP ENCODE(1, 4690, STRING) OLDSHP 4690 FORMAT(I1) CALL BUFFIL(14, 20, STRING, 1) 4670 CONTINUE IF (.NOT.(OLDDIR .NE. DEFDIR)) GOTO 4700 OLDDIR = DEFDIR ENCODE(5, 4720, STRING) DEFDIR 4720 FORMAT(F5.2) CALL BUFFIL(15, 16, STRING, 5) 4700 CONTINUE DO 4730 J = 1, 8 IF (.NOT.((SC(J) .NE. SCORE(J)) .OR. (XSHIP(J).XOR.(ACT(J) .EQ. *'*')))) GOTO 4750 IF (.NOT.(XSHIP(J))) GOTO 4770 ACT(J) = '*' GOTO 4780 4770 CONTINUE ACT(J) = ' ' 4780 CONTINUE SC(J) = SCORE(J) ENCODE(10, 4790, STRING) SC(J), ACT(J) 4790 FORMAT(F8.0,1X,A1) CALL BUFFIL(J + 2, 70, STRING, 10) 4750 CONTINUE 4730 CONTINUE 4740 CONTINUE CALL OUTCH(0, - 1) RETURN END SUBROUTINE BUFFIL(IY, IX, ST, L) BYTE ST(1) CALL TPOS(IY + 1, IX + 1) 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, NCHRS) IF (.NOT.(NCHRS .LT. 0)) GOTO 4800 FLAG = .FALSE. GOTO 4810 4800 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4820 FLAG = .TRUE. N = DEFVAL GOTO 4830 4820 CONTINUE DECODE(NCHRS, 4840, INPUT, ERR=201) N 4840 FORMAT(I5) IF (.NOT.((N .GE. LOW) .AND. (N .LE. HIGH))) GOTO 4850 FLAG = .TRUE. GOTO 4860 4850 CONTINUE 201 CONTINUE CALL MESSGE('?! RANGE ERROR !?') 4860 CONTINUE 4830 CONTINUE 4810 CONTINUE RETURN END SUBROUTINE REDPMT(PROMPT, INPUT, 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(1), BLANKS(PRMPTL) LOGICAL ECHO DATA BLANKS/PRMPTL*' '/ NCHRS = 0 ECHO = .TRUE. IF (.NOT.(PROMPT(1) .NE. 0)) GOTO 4870 C IF PROMPT IS NOT NULL... C GET TYPE AHEAD CALL INCHAR(INPUT, 15, .FALSE., 0, .TRUE., NC, IERR) IF (.NOT.(IERR .EQ. -1)) GOTO 4890 C EOF? GO TO 999 4890 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4910 C DONE? RETURN 4910 CONTINUE C WAIT 1/2 SEC, THEN READ AGAIN CALL WAIT(30, 0, DSW) CALL INCHAR(INPUT(NCHRS + 1), 15 - NCHRS, .FALSE., 0, .TRUE., NC *, IERR) IF (.NOT.(IERR .EQ. -1)) GOTO 4930 C EOF? GO TO 999 4930 CONTINUE NCHRS = NCHRS + NC IF (.NOT.(IERR .EQ. CR)) GOTO 4950 C DONE? RETURN 4950 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 4970 C THEN ISSUE PROMPT LEN = 1 4990 IF (.NOT.(LEN .LE. MAXPRM .AND. PROMPT(LEN) .NE. 0)) GOTO 5010 5000 LEN = LEN + 1 GOTO 4990 5010 CONTINUE CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(PROMPT, LEN - 1) GOTO 4980 4970 CONTINUE ECHO = .FALSE. 4980 CONTINUE 4870 CONTINUE CALL INCHAR(INPUT(NCHRS + 1), 15 - NCHRS, ECHO, - 1, .TRUE., NC, C FINAL READ *IERR) IF (.NOT.(PROMPT(1) .NE. 0 .AND. NCHRS .EQ. 0)) GOTO 5020 C THEN ERASE PROMPT STRING CALL TPOS(PRMPTY, PRMPTX) CALL OUTCH(BLANKS, PRMPTL) 5020 CONTINUE IF (.NOT.(IERR .EQ. -1)) GOTO 5040 C EOF? GO TO 999 5040 CONTINUE NCHRS = NCHRS + NC RETURN 999 CONTINUE NCHRS = - 1 RETURN END SUBROUTINE YESNO(PROMPT, FLAG) LOGICAL*1FLAG, OK BYTE YES(4), NO(4), PROMPT(1) BYTE ANSWER(4) DATA YES/'Y', 'E', 'S', ' '/ DATA NO/'N', 'O', ' ', ' '/ C OK = .FALSE. ANSWER(1) = 0 CALL REDPMT(PROMPT, ANSWER, NCHRS) 5060 CONTINUE IF (.NOT.((NCHRS .GT. 4) .OR. (NCHRS .LE. 0))) GOTO 5090 NCHRS = 4 C * CHECK FOR YES 5090 CONTINUE I = KOMSTR(YES, 1, NCHRS, ANSWER, 1) IF (.NOT.(I .EQ. 0)) GOTO 5110 FLAG = .TRUE. OK = .TRUE. GOTO 5120 5110 CONTINUE C * CHECK FOR A NO I = KOMSTR(NO, 1, NCHRS, ANSWER, 1) IF (.NOT.(I .EQ. 0)) GOTO 5130 FLAG = .FALSE. OK = .TRUE. GOTO 5140 5130 CONTINUE C * INCORRECT RESPONSE IF (.NOT.(PROMPT(1) .EQ. 0)) GOTO 5150 WRITE(5, 5170) 5170 FORMAT('$ANSWER YES OR NO? ') READ(5, 5180, END=3) NCHRS, ANSWER 5180 FORMAT(Q,4A1) GOTO 5070 3 CONTINUE CLOSE(UNIT = 5) GOTO 5160 5150 CONTINUE CALL REDPMT('ANSWER YES OR NO? ', ANSWER, NCHRS) 5160 CONTINUE 5140 CONTINUE 5120 CONTINUE 5070 IF (.NOT.(OK)) GOTO 5060 5080 CONTINUE RETURN END C POSITN - POSITION CURSOR C WPW 9/19/80 SUBROUTINE POSITN(IROW, ICOL) CALL TPOS(IROW, ICOL) CALL OUTCH(0, 0) RETURN END