PROGRAM DRIINI C C AUTHOR: DON LEDFORD C C DECEMBER 1978 JOHN LUTCH ADDED CLOAKING C DECEMBER 1978 DON LEDFORD ADDED ANTI-MATTER C MARCH 1979 RAY FRENCH ADDED CONTINUOUS DISPLAY C OCTOBER 1979 DON LEDFORD ADDED ROBOT SHIPS C MAY 1980 BILL CAEL AND BILL WOOD RECODED IN RATFOR C MAY 1980 BILL WOOD ADDED ENERGY NETS 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, YES BYTE CHAR C WRITE(5, 11) 11 FORMAT('0WELCOME TO MULTI-TREK INITIALIZATION'/) DO 2000 I = 1, 8 IF (.NOT.(XSHIP(I))) GOTO 2020 WRITE(5, 1) 1 FORMAT('$BATTLE IN PROGRESS. INITIALIZE? ') READ(5, 2) CHAR 2 FORMAT(A1) IF (.NOT.(CHAR.EQ.'Y')) GOTO 2040 GOTO 2010 2040 CONTINUE CALL EXIT 2050 CONTINUE 2020 CONTINUE 2000 CONTINUE 2010 CONTINUE THRU = .TRUE. C CHARACTER FOR BLACK HOLE BHOLE = '#' C CHARACTER FOR UNIVERSE EMPTY SPACE EMPTY = ' ' WRITE(5, 41) 41 FORMAT('$ENTER STAR DENSITY OF UNIVERSE PARTS PER 100: ') CALL GETREL(STARS, OK, 0., 15.) IF (.NOT.(.NOT.OK)) GOTO 2060 STARS = 2.0 2060 CONTINUE WRITE(5, 51) 51 FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES: ') CALL GETREL(BASES, OK, 0., 50.) IF (.NOT.(.NOT.OK)) GOTO 2080 BASES = 20. 2080 CONTINUE WRITE(5, 61) 61 FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS: ') CALL GETINT(N, OK, 0, 10) IF (.NOT.(.NOT.OK)) GOTO 2100 N = 6 2100 CONTINUE WRITE(5, 71) 71 FORMAT('$ENTER A RANDOM INTEGER: ') CALL GETINT(ISEED, OK, - 32000, 32000) C C SEED THE RANDOM NUMBER GENERATOR C I1 = 0 I2 = 0 IF (.NOT.(OK .AND. ISEED .NE. 0)) GOTO 2120 DO 2140 I = 0, IABS(ISEED) RNDOM = RAN(I1, I2) C C * NOW GENERATE THE UNIVERSE C 2140 CONTINUE 2150 CONTINUE 2120 CONTINUE DO 2160 I = 1, 100 DO 2180 J = 1, 100 RNDOM = RAN(I1, I2) IF (.NOT.(RNDOM .GT. (100.-STARS)/100.)) GOTO 2200 UNIV(I, J) = '*' C GOTO 2210 2200 CONTINUE IF (.NOT.(RNDOM .LE. BASES/10000.)) GOTO 2220 UNIV(I, J) = 'B' C GOTO 2230 2220 CONTINUE UNIV(I, J) = EMPTY C 2230 CONTINUE 2210 CONTINUE 2180 CONTINUE 2190 CONTINUE C C * PUT IN THE HYPERSPACE PORTS C 2160 CONTINUE 2170 CONTINUE UNIV(20, 25) = 'H' UNIV(20, 75) = 'H' UNIV(50, 30) = 'H' UNIV(50, 70) = 'H' UNIV(80, 25) = 'H' UNIV(80, 75) = 'H' C C * PUT IN THE MOBILE "BLACK HOLE" C UNIV(30, 60) = BHOLE HX = 30. HY = 60. C C * PUT IN THE RANDOM HYPER-SPACE PORTS C DO 2240 I = 1, N OK = .FALSE. 2260 CONTINUE IX = RAN(I1, I2)*100. + 1. IF (.NOT.(IX .GT. 100)) GOTO 2290 IX = 100 2290 CONTINUE IY = RAN(I1, I2)*100. + 1. IF (.NOT.(IY .GT. 100)) GOTO 2310 IY = 100 2310 CONTINUE IF (.NOT.(UNIV(IX, IY) .EQ. EMPTY)) GOTO 2330 UNIV(IX, IY) = 'R' OK = .TRUE. 2330 CONTINUE 2270 IF (.NOT.(OK)) GOTO 2260 2280 CONTINUE C C * PUT IN THE STAR SHIPS C 2240 CONTINUE 2250 CONTINUE DO 2350 I = 1, 8 OK = .FALSE. 2370 CONTINUE IX = RAN(I1, I2)*100. + 1. IF (.NOT.(IX .GT. 100)) GOTO 2400 IX = 100 2400 CONTINUE IY = RAN(I1, I2)*100. + 1. IF (.NOT.(IY .GT. 100)) GOTO 2420 IY = 100 2420 CONTINUE IF (.NOT.(UNIV(IX, IY) .EQ. EMPTY)) GOTO 2440 ENCODE(1, 13, CHAR) I 13 FORMAT(I1) UNIV(IX, IY) = CHAR XCORD(I) = IX YCORD(I) = IY XCORD(I) = XCORD(I) + .5 YCORD(I) = YCORD(I) + .5 OK = .TRUE. 2440 CONTINUE 2380 IF (.NOT.(OK)) GOTO 2370 2390 CONTINUE C C * INITIALIZE STARTING STATUS OF THE STAR SHIPS C 2350 CONTINUE 2360 CONTINUE DO 2460 I = 1, 8 C * INITIALIZE SHIPS AS UNOWNED AND NOT CLOAKED XSHIP(I) = .FALSE. CLOAK(I) = .FALSE. NET(I) = .FALSE. SCAN(I) = 9 NHOM(I) = 4 DO 2480 II = 1, 4 WHOM(I, II) = 0 2480 CONTINUE 2490 CONTINUE LAUNCH(I) = - 1 PHA(I) = - 1 ENERGY(I) = 10000. SHIELD(I) = 0. TORPS(I) = 10. IPOD(I) = 0 CREW(I) = 400 WARP(I) = 0. DIR(I) = 0. MESSAG(I*60 - 59) = ' ' SCORE(I) = 0. IT(I) = 1 HYPER(I) = 3 DO 2500 K = 1, 10 ISENT(I, K) = 0 TDIR(I, K) = - 1. TLOCS(I, K, 1) = 1 TLOCS(I, K, 2) = 1 2500 CONTINUE 2510 CONTINUE C 2460 CONTINUE 2470 CONTINUE WRITE(5, 81) 81 FORMAT('$ENTER ENERGY DRAIN FOR CLOAKING: ') CALL GETREL(CDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2520 CDRAIN = 25. 2520 CONTINUE WRITE(5, 82) 82 FORMAT('$ENTER ENERGY DRAIN FOR ENERGY NET: ') CALL GETREL(NDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2540 NDRAIN = 75. 2540 CONTINUE WRITE(5, 91) 91 FORMAT('$ENTER WARP SPEED OF "BLACK HOLE": ') CALL GETREL(HW, OK, 0., 10.) IF (.NOT.(.NOT.OK)) GOTO 2560 HW = 4.5 2560 CONTINUE WRITE(5, 101) 101 FORMAT('0MULTI-TREK INITIALIZED'/) END SUBROUTINE GETREL(VARI, EXIST, LOW, HIGH) C LOGICAL*1EXIST, OK REAL VARI, LOW, HIGH BYTE INPUT(15), LEFTED(15) INTEGER NCHRS OK = .FALSE. 2580 CONTINUE DO 2610 I = 1, 15 LEFTED(I) = ' ' 2610 CONTINUE 2620 CONTINUE READ(5, 101, END=812) NCHRS, (INPUT(I), I = 1, 15) 101 FORMAT(Q, 15A1) GOTO 813 812 CLOSE(UNIT = 5) 813 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 2630 OK = .TRUE. EXIST = .FALSE. GOTO 2640 2630 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 2650 C * LEFT ADJUST INPUT CALL STRMOV(INPUT, 1, NCHRS, LEFTED, 16 - NCHRS) DECODE(15, 23, LEFTED, ERR=202) VARI 23 FORMAT(G15.0) IF (.NOT.(VARI .GE. LOW .AND. VARI .LE. HIGH)) GOTO 2670 OK = .TRUE. EXIST = .TRUE. GOTO 2680 2670 CONTINUE WRITE(5, 111) 111 FORMAT('0SORRY CAPTAIN, BUT YOUR COMMAND''S PARAMETER') WRITE(5, 152) LOW, HIGH 152 FORMAT(' MUST BE BETWEEN ', F15.4, ' AND ', F15.4) 2680 CONTINUE GO TO 302 202 TYPE*, 'WOULD YOU PLEASE REPEAT THAT SIR ?' 302 CONTINUE GOTO 2660 2650 CONTINUE WRITE(5, 121) 121 FORMAT(' RUN THAT BY ME AGAIN !') 2660 CONTINUE 2640 CONTINUE 2590 IF (.NOT.(OK)) GOTO 2580 2600 CONTINUE RETURN END SUBROUTINE GETINT(NUM, FLAG, LOW, HIGH) INTEGER NUM, LOW, HIGH LOGICAL*1OK, FLAG OK = .FALSE. 2690 CONTINUE READ(5, 11, END=805, ERR=205) NCHRS, NUM 11 FORMAT(Q, I5) GOTO 806 805 CLOSE(UNIT = 5) 806 CONTINUE IF (.NOT.(NCHRS .EQ. 0)) GOTO 2720 FLAG = .FALSE. OK = .TRUE. GOTO 2730 2720 CONTINUE IF (.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GOTO 2740 OK = .TRUE. FLAG = .TRUE. GOTO 2750 2740 CONTINUE WRITE(5, 131) 131 FORMAT('0WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS') WRITE(5, 141) LOW, HIGH 141 FORMAT(' BETWEEN ', I6, ' AND ', I6) WRITE(5, 151) 151 FORMAT('$TRY AGAIN :') 2750 CONTINUE 2730 CONTINUE GOTO 2700 205 WRITE(5, 102) 102 FORMAT('$TRY AGAIN BOZO :') 2700 IF (.NOT.(OK)) GOTO 2690 2710 CONTINUE RETURN END