C ASCII '0' PROGRAM DRIVER 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 JUN 1980 BILL WOOD ADDED RANDOM SHIP SERVICING ORDER C DEC 1980 BILL WOOD ADDED TRACTOR BEAMS C C COMMON PARAMETER MAXSHP = 8, MAXHOM = 4, MAXTRP = 10 COMMON/TORPE/TLOCS(MAXSHP, MAXTRP, 2), TDIR(MAXSHP, MAXTRP), IT(MA *XSHP) COMMON/TRKDAT/ENERGY(MAXSHP), SHIELD(MAXSHP), XCORD(MAXSHP), YCORD *(MAXSHP), TORPS(MAXSHP), HOLX, HOLY, HOLW, CDRAIN, NDRAIN, TDRAIN, * SCAN(MAXSHP), PHA(MAXSHP), I1, I2, HYPER(MAXSHP), ISENT(MAXSHP, 1 *0), XPOD(MAXSHP), YPOD(MAXSHP), DPOD(MAXSHP), IPODST(MAXSHP), WPOD *(MAXSHP), XHOM(MAXSHP, MAXHOM), YHOM(MAXSHP, MAXHOM), WHOM(MAXSHP, * MAXHOM), NHOM(MAXSHP), TRBEAM(MAXSHP), SCORE(MAXSHP), CREW(MAXSHP *), DIR(MAXSHP), WARP(MAXSHP), LAUNCH(MAXSHP), UNIV(100, 100), MESS *AG(480), THRU, SHPACT(MAXSHP), CLOAK(MAXSHP), NET(MAXSHP), SHPNAM( *10, MAXSHP) REAL LAUNCH, NDRAIN INTEGER*2SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, SHPACT, CLOAK, NET BYTE UNIV, MESSAG BYTE SHPNAM C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE. C END COMMON COMMON/ACCUM/ACCUME COMMON/DOLOOP/SHIPS INTEGER SHIPS(8) LOGICAL*1ACCUME BYTE CHAR C CALL MARK(2, 30, 1, IDS) ACCUME = .TRUE. DO 2000 I = 1, 8 SHIPS(I) = I 2000 CONTINUE 2010 CONTINUE THRU = .FALSE. C C * HERE STARTS THE ACTUAL GAME PLAYING C 2020 CONTINUE C C THE PLAYER TASKS NEED SOME CPU TIME TOO ! CALL WAITFR(2, IDS) CALL MARK(2, 30, 1, IDS) C C * FIRE TORPEDOES CALL TORPI C * FIRE PHASERS CALL PHASER C * HANDLE ALL ANTI-MATTER TRANSACTIONS CALL MANTI C * MOVE ACTIVE TORPEDOES CALL MTORPS C * MOVE HOMERS CALL MHOMER C * MOVE SHIPS CALL MSHIPS C * MOVE THE "BLACK HOLE" CALL MHOLE C C THE FOLLOWING CODE (IF UNCOMMENTED) WILL CHECK TO SEE C IF THERE ARE STILL ANY PLAYERS. IF NOT, IT WILL WAIT C 30 SECONDS AND THEN EXIT IF NO NEW PLAYERS HAVE STARTED. C DO 2050 J = 1, 6 DO 2070 I = 1, 8 IF (.NOT.(SHPACT(I))) GOTO 2090 GOTO 10 2090 CONTINUE 2070 CONTINUE 2080 CONTINUE CALL WAIT(5, 2, M) 2050 CONTINUE 2060 CONTINUE THRU = .TRUE. 10 CONTINUE 2030 IF (.NOT.(THRU)) GOTO 2020 2040 CONTINUE CALL EXIT END SUBROUTINE MOVE(XI, YI, XN, YN, D, W, CHAR, UNIV, EMPTCH) C C * MOVE OBJECTS WITH WRAP AROUND C BYTE CHAR, EMPTCH BYTE UNIV(100, 100) YN = YI + SIN(D/57.29577951)/10.*W XN = XI + COS(D/57.29577951)/10.*W IXI = XI IYI = YI IF (.NOT.(XN .GE. 101.)) GOTO 2110 XN = XN - 100. GOTO 2120 2110 CONTINUE IF (.NOT.(XN .LT. 1.)) GOTO 2130 XN = XN + 100. 2130 CONTINUE 2120 CONTINUE IF (.NOT.(YN .GE. 101.)) GOTO 2150 YN = YN - 100. GOTO 2160 2150 CONTINUE IF (.NOT.(YN .LT. 1.)) GOTO 2170 YN = YN + 100. 2170 CONTINUE 2160 CONTINUE IXN = XN IYN = YN IF (.NOT.((IXI .NE. IXN) .OR. (IYI .NE. IYN))) GOTO 2190 CHAR = UNIV(IXN, IYN) GOTO 2200 2190 CONTINUE C C * IF THEY DIDN'T MOVE OUT OF THE SQUARE THEY WERE IN JUST INDICATE C THAT THE PLACE THEY ENDED UP WAS EMPTY C CHAR = EMPTCH 2200 CONTINUE RETURN END SUBROUTINE SENT(I, NUM) C C * SEND MESSAGES TO THE PLAYERS C C COMMON PARAMETER MAXSHP = 8, MAXHOM = 4, MAXTRP = 10 COMMON/TORPE/TLOCS(MAXSHP, MAXTRP, 2), TDIR(MAXSHP, MAXTRP), IT(MA *XSHP) COMMON/TRKDAT/ENERGY(MAXSHP), SHIELD(MAXSHP), XCORD(MAXSHP), YCORD *(MAXSHP), TORPS(MAXSHP), HOLX, HOLY, HOLW, CDRAIN, NDRAIN, TDRAIN, * SCAN(MAXSHP), PHA(MAXSHP), I1, I2, HYPER(MAXSHP), ISENT(MAXSHP, 1 *0), XPOD(MAXSHP), YPOD(MAXSHP), DPOD(MAXSHP), IPODST(MAXSHP), WPOD *(MAXSHP), XHOM(MAXSHP, MAXHOM), YHOM(MAXSHP, MAXHOM), WHOM(MAXSHP, * MAXHOM), NHOM(MAXSHP), TRBEAM(MAXSHP), SCORE(MAXSHP), CREW(MAXSHP *), DIR(MAXSHP), WARP(MAXSHP), LAUNCH(MAXSHP), UNIV(100, 100), MESS *AG(480), THRU, SHPACT(MAXSHP), CLOAK(MAXSHP), NET(MAXSHP), SHPNAM( *10, MAXSHP) REAL LAUNCH, NDRAIN INTEGER*2SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, SHPACT, CLOAK, NET BYTE UNIV, MESSAG BYTE SHPNAM C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE. C END COMMON DO 2210 K = 1, 10 IF (.NOT.(ISENT(I, K) .EQ. 0)) GOTO 2230 ISENT(I, K) = NUM GOTO 202 2230 CONTINUE C * MESSAGE BUFFER IS FULL SO COPY IT UP TO KEEP MOST RECENT 2210 CONTINUE 2220 CONTINUE DO 2250 K = 1, 9 ISENT(I, K) = ISENT(I, K + 1) 2250 CONTINUE 2260 CONTINUE ISENT(I, 10) = NUM 202 RETURN END SUBROUTINE PERM(SHIPS, I1, I2) C C PERM - SHUFFLE SHIPS C C DUE TO L. E. MOSES AND R. V. OAKFORD, AND C R. DURSTENFELD C TAKEN FROM KNUTH VOL 2, SEMINUMERICAL ALGORITHMS, P. 125 C INTEGER SHIPS(8), J, K, I1, I2, TMP DO 2270 J = 8, 2, - 1 K = IFIX(FLOAT(J)*RAN(I1, I2)) + 1 TMP = SHIPS(K) SHIPS(K) = SHIPS(J) SHIPS(J) = TMP 2270 CONTINUE 2280 CONTINUE RETURN END C POLADD - ADD POLAR COORDINATES: D3, R3 = D1, R1 + D2, R2 # WPW 12/7/80 SUBROUTINE POLADD(D1, R1, D2, R2, D3, R3) PARAMETER PI = 3.141592654 CCONVERT DEGREES TO RADIANS RADD1 = D1*(PI/180.) RADD2 = D2*(PI/180.) XT = R1*COS(RADD1) + R2*COS(RADD2) YT = R1*SIN(RADD1) + R2*SIN(RADD2) D3 = ATAN3(YT, XT)*(180./PI) R3 = SQRT(XT*XT + YT*YT) RETURN END