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, 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, 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 = ' ' C 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 2060 DO 2080 I = 0, IABS(ISEED) RNDOM = RAN(I1, I2) C 2080 CONTINUE 2090 CONTINUE 2060 CONTINUE WRITE(5, 41) 41 FORMAT('$ENTER STAR DENSITY OF UNIVERSE PARTS PER 100: ') CALL GETREL(STARS, OK, 0., 15.) IF (.NOT.(.NOT.OK)) GOTO 2100 STARS = 2.0 2100 CONTINUE WRITE(5, 51) 51 FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES: ') CALL GETREL(BASES, OK, 0., 50.) IF (.NOT.(.NOT.OK)) GOTO 2120 BASES = 20. 2120 CONTINUE WRITE(5, 61) 61 FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS: ') CALL GETINT(N, OK, 0, 10) IF (.NOT.(.NOT.OK)) GOTO 2140 N = 6 C C * NOW GENERATE THE UNIVERSE C 2140 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. TRBEAM(I) = 0 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, 83) 83 FORMAT('$ENTER ENERGY DRAIN FOR TRACTOR BEAM: ') CALL GETREL(TDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2560 TDRAIN = 100. 2560 CONTINUE WRITE(5, 91) 91 FORMAT('$ENTER WARP SPEED OF "BLACK HOLE": ') CALL GETREL(HW, OK, 0., 10.) IF (.NOT.(.NOT.OK)) GOTO 2580 HW = 4.5 2580 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. 2600 CONTINUE DO 2630 I = 1, 15 LEFTED(I) = ' ' 2630 CONTINUE 2640 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 2650 OK = .TRUE. EXIST = .FALSE. GOTO 2660 2650 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 2670 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 2690 OK = .TRUE. EXIST = .TRUE. GOTO 2700 2690 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) 2700 CONTINUE GO TO 302 202 TYPE*, 'WOULD YOU PLEASE REPEAT THAT SIR ?' 302 CONTINUE GOTO 2680 2670 CONTINUE WRITE(5, 121) 121 FORMAT(' RUN THAT BY ME AGAIN !') 2680 CONTINUE 2660 CONTINUE 2610 IF (.NOT.(OK)) GOTO 2600 2620 CONTINUE RETURN END SUBROUTINE GETINT(NUM, FLAG, LOW, HIGH) INTEGER NUM, LOW, HIGH LOGICAL*1OK, FLAG OK = .FALSE. 2710 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 2740 FLAG = .FALSE. OK = .TRUE. GOTO 2750 2740 CONTINUE IF (.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GOTO 2760 OK = .TRUE. FLAG = .TRUE. GOTO 2770 2760 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 :') 2770 CONTINUE 2750 CONTINUE GOTO 2720 205 WRITE(5, 102) 102 FORMAT('$TRY AGAIN BOZO :') 2720 IF (.NOT.(OK)) GOTO 2710 2730 CONTINUE RETURN END