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), 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, 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' .OR. 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 UPDATE RATE IN 60'THS OF A SECOND UPRATE = 24 C WRITE(5, 2060) 2060 FORMAT(' DEFAULTS FOR THE FOLLOWING QUESTIONS MAY BE SELECTED BY * TYPING CARRIAGE-RETURN.'/) 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 2070 DO 2090 I = 0, IABS(ISEED) RNDOM = RAN(I1, I2) C 2090 CONTINUE 2070 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 2110 STARS = 2.0 2110 CONTINUE WRITE(5, 51) 51 FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES: ') CALL GETREL(BASES, OK, 0., 50.) IF (.NOT.(.NOT.OK)) GOTO 2130 BASES = 20. 2130 CONTINUE WRITE(5, 61) 61 FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS: ') CALL GETINT(N, OK, 0, 10) IF (.NOT.(.NOT.OK)) GOTO 2150 N = 6 C C * NOW GENERATE THE UNIVERSE C 2150 CONTINUE DO 2170 I = 1, 100 DO 2190 J = 1, 100 RNDOM = RAN(I1, I2) IF (.NOT.(RNDOM .GT. (100.-STARS)/100.)) GOTO 2210 UNIV(I, J) = '*' C GOTO 2220 2210 CONTINUE IF (.NOT.(RNDOM .LE. BASES/10000.)) GOTO 2230 UNIV(I, J) = 'B' C GOTO 2220 2230 CONTINUE UNIV(I, J) = EMPTY C 2220 CONTINUE 2190 CONTINUE C C * PUT IN THE HYPERSPACE PORTS C 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 2250 I = 1, N OK = .FALSE. 2270 CONTINUE IX = RAN(I1, I2)*100. + 1. IF (.NOT.(IX .GT. 100)) GOTO 2300 IX = 100 2300 CONTINUE IY = RAN(I1, I2)*100. + 1. IF (.NOT.(IY .GT. 100)) GOTO 2320 IY = 100 2320 CONTINUE IF (.NOT.(UNIV(IX, IY) .EQ. EMPTY)) GOTO 2340 UNIV(IX, IY) = 'R' OK = .TRUE. 2340 CONTINUE 2280 IF (.NOT.(OK)) GOTO 2270 C C * PUT IN THE STAR SHIPS C 2250 CONTINUE DO 2360 I = 1, 8 OK = .FALSE. 2380 CONTINUE IX = RAN(I1, I2)*100. + 1. IF (.NOT.(IX .GT. 100)) GOTO 2410 IX = 100 2410 CONTINUE IY = RAN(I1, I2)*100. + 1. IF (.NOT.(IY .GT. 100)) GOTO 2430 IY = 100 2430 CONTINUE IF (.NOT.(UNIV(IX, IY) .EQ. EMPTY)) GOTO 2450 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. 2450 CONTINUE 2390 IF (.NOT.(OK)) GOTO 2380 C C * INITIALIZE STARTING STATUS OF THE STAR SHIPS C 2360 CONTINUE DO 2470 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 2490 II = 1, 4 WHOM(I, II) = 0 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 2510 K = 1, 10 ISENT(I, K) = 0 TDIR(I, K) = - 1. TLOCS(I, K, 1) = 1 TLOCS(I, K, 2) = 1 2510 CONTINUE C 2470 CONTINUE WRITE(5, 81) 81 FORMAT('$ENTER ENERGY DRAIN FOR CLOAKING: ') CALL GETREL(CDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2530 CDRAIN = 25. 2530 CONTINUE WRITE(5, 82) 82 FORMAT('$ENTER ENERGY DRAIN FOR ENERGY NET: ') CALL GETREL(NDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2550 NDRAIN = 75. 2550 CONTINUE WRITE(5, 83) 83 FORMAT('$ENTER ENERGY DRAIN FOR TRACTOR BEAM: ') CALL GETREL(TDRAIN, OK, 0., 2000.) IF (.NOT.(.NOT.OK)) GOTO 2570 TDRAIN = 100. 2570 CONTINUE WRITE(5, 91) 91 FORMAT('$ENTER WARP SPEED OF "BLACK HOLE": ') CALL GETREL(HW, OK, 0., 10.) IF (.NOT.(.NOT.OK)) GOTO 2590 HW = 4.5 2590 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. 2610 CONTINUE DO 2640 I = 1, 15 LEFTED(I) = ' ' 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 2660 OK = .TRUE. EXIST = .FALSE. GOTO 2670 2660 CONTINUE IF (.NOT.(NCHRS .LE. 15)) GOTO 2680 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 2700 OK = .TRUE. EXIST = .TRUE. GOTO 2710 2700 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) 2710 CONTINUE GO TO 302 202 TYPE*, 'WOULD YOU PLEASE REPEAT THAT SIR ?' 302 CONTINUE GOTO 2670 2680 CONTINUE WRITE(5, 121) 121 FORMAT(' RUN THAT BY ME AGAIN !') 2670 CONTINUE 2620 IF (.NOT.(OK)) GOTO 2610 RETURN END SUBROUTINE GETINT(NUM, FLAG, LOW, HIGH) INTEGER NUM, LOW, HIGH LOGICAL*1OK, FLAG OK = .FALSE. 2720 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 2750 FLAG = .FALSE. OK = .TRUE. GOTO 2760 2750 CONTINUE IF (.NOT.((NUM .GE. LOW) .AND. (NUM .LE. HIGH))) GOTO 2770 OK = .TRUE. FLAG = .TRUE. GOTO 2780 2770 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 :') 2780 CONTINUE 2760 CONTINUE GOTO 2730 205 WRITE(5, 102) 102 FORMAT('$TRY AGAIN BOZO :') 2730 IF (.NOT.(OK)) GOTO 2720 RETURN END