github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-25 01:47:08 +00:00
Code Issues Releases Wiki Activity
Files
65df7f54176c3581cb9cd8e824992ffafe6770f1
PDP-10.its/src/games/trek.2

1760 lines
47 KiB
Groff
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
C THIS FILE HAS BEEN MODIFIED BY EJS@MIT-MC
C LAST UPDATE -- 4/18/79
IMPLICIT INTEGER(A-Z)
C
C SPACE--THE FINAL FRONTIER
C ----- --- ----- --------
C
C
C THESE ARE THE VOYAGES OF THE STARSHIP 'ENTERPRISE.'
C IT'S FIVE YEAR MISSION: TO EXPLORE STRANGE NEW WORLDS; TO SEEK
C OUT NEW LIFE AND NEW CIVILIZATIONS; TO BOLDLY GO WHERE NO MAN
C HAS GONE BEFORE.
C
C THIS IS 'STAR TREK'.
C
REAL RAN,XXX,R,FLOAT,WARP,X,Y,DAMAGE,COS,SIN,ALOG10,
$K5,YYY,SQRT,AMIN1,ATAN2,PIE,DELTAX,DELTAY,SIGN,AMAX1,
$ATAN,RATING,MINWRP,XWARP,YWARP,RESUSD,X2,X3,TEMP,TT
LOGICAL SAVRES,FILE
DIMENSION QDOL(6),GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),LONG(3),KNOWN(14,14),CLOAK(8,8),DAMSTR(3,11),
$LDOL(64),KLING2(9),LINE(8),LOCATE(8,14,14),RANKS(3,12),
$HITVAL(9),CDOL(2),TDATE(2),FLAGSH(3)
COMMON DAMSTR
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA BNAME,PIE,DOCKED/'-1 ',3.1415926,'DOCKE'/
DATA YES,NO/'Y ','N '/
DATA QDOL/'-','E','K','B','*','F'/
DATA DAMSTR/'WARP ','ENGIN','ES ','S.R. ','SENSO','RS ',
$'L.R. ','SENSO','RS ','PHASE','R CON','TROL ',
$'PHOTO','N TUB','ES ','DAMAG','E CON','TROL ',
$'DEFLE','CTORS',' ','COMMU','NICAT','IONS ',
$'TRANS','PORTE','R ','TRACT','OR BE','AMS ',
$'BATTL','E COM','PUTER'/
DATA LDOL/'G VIR','GO II','SOL I','II ','G DRA','CO IT',
$'RIGEL',' III ','DENEB',' VII ','ANTAR','ES II','CANOP',
$'US V ','CAPEL','LA VI','POLLU','X III','SPICA',' VIII',
$'VEGA ','VII ','ALTAI','R III','PROCY','ON I ','LALAN',
$'DE II','KRUGE','R IV ','SIRIU','S VII','HAMAL',' VII ',
$'POLAR','IS II','ALKAI','D II ','ACAMA','R VI ','AVIOR',
$' III ','CETUS',' VII ','NUNKI',' VII ','ANKAA',' III ',
$'MENKE','NT VI','DIPHD','A III','VALIO','TH VI','SUHAI',
$'L VI ','A SER','PEN I','G CAR','INA V','A AQU','ILA I',
$'CALLA','M 1X '/
DATA RANKS/'YEOMA','N ',' ',
$'ENSIG','N ',' ',
$'LIEUT','ENANT',', JG ',
$'LIEUT','ENANT',' ',
$'LT CO','MMAND','ER ',
$'COMMA','NDER ',' ',
$'CAPTA','IN ',' ',
$'COMMO','DORE ',' ',
$'REAR ','ADMIR','AL ',
$'VICE ','ADMIR','AL ',
$'ADMIR','AL ',' ',
$'FLEET',' ADMI','RAL '/
C C
NIN=5
NOUT=5
WRITE (NOUT,10)
10 FORMAT('0STREK VERSION DATED 18 APRIL 79. SEND BUGS TO EJS@MC'/)
CALL TIME(A,XXX)
XXX=XXX*(2.**5)
XXX=XXX/(2.**5)
CALL SETRAN(XXX)
RATING=500.
GAMES=0
WINS=0
FILE=.FALSE.
STAMOD=1
SHOMOD=0
LONMOD=1
TT=0
12 WRITE (NOUT,11)
11 FORMAT (' DO YOU WANT TO LOAD YOUR BATTLE RECORD?')
WRITE (NOUT, 15)
15 FORMAT (' USE CAPITAL LETTERS PLEASE. ',$)
READ (NIN,665,ERR=12) CCC
IF (CCC.EQ.YES) GO TO 1305
IF (CCC.NE.NO) GO TO 12
WRITE (NOUT,13)
13 FORMAT (' YOUR RATING IS 500 AND YOUR RANK IS ENSIGN.')
C C
C INITIALIZE A NEW GAME
C
85 IMESS=0
LSTCOM=-1
PRTY=0
DEFLCT=0
BOARD=0
EUSED=0
PUSED=0
BUSED=0
KLGMAX=200
STTORP=10
STENEG=3000
SHUSIG=0
BEGDAT=2000.*(1.+RAN(XXX))
CURDAT=BEGDAT
87 WRITE (NOUT,90)
90 FORMAT(' WHAT SIZE GALAXY DO YOU WISH TO DEFEND?(1 TO 14)',$)
READ (NIN,259,ERR=87) GALSIZ
WRITE (NOUT, 92)
92 FORMAT('0TO LIST COMMANDS, TYPE -1. DO NOT USE LETTERS.'//)
IF (GALSIZ.LT.1.OR.GALSIZ.GT.14) GO TO 87
DO 95 I=1,GALSIZ
DO 95 J=1,GALSIZ
95 KNOWN(I,J)=0
ENERGY=STENEG
TORPS=STTORP
PROBES=GALSIZ/2.
IF (2*PROBES.NE.GALSIZ) PROBES=PROBES+RAN(XXX)+.5
DO 104 I=1,11
104 DAMAGE(I)=0
QUADRW=GALSIZ*RAN(XXX)+1.
QUADCL=GALSIZ*RAN(XXX)+1.
C C
C SET UP GALAXY
C
FLAGSH(1)=0
FLAGSH(2)=0
FLAGSH(3)=1
TOTBAS=0
TOTENE=0
KQUADS=0
DO 121 I=1,GALSIZ
DO 121 J=1,GALSIZ
R=RAN(XXX)*64.
ENEMYS=XLTY(R,.08)+XLTY(R,.16)+XLTY(R,.26)+XLTY(R,.5)
ENEMYS=ENEMYS+XLTY(R,1.2)+XLTY(R,3.)+XLTY(R,7.)
ENEMYS=ENEMYS+XLTY(R,13.)+XLTY(R,25.)
IF (ENEMYS.NE.0) KQUADS=KQUADS+1
TOTENE=TOTENE+ENEMYS
BASES=0
IF (RAN(XXX).LE..96) GO TO 120
BASES=1
IF (RAN(XXX).GE..80) BASES=2
120 TOTBAS=TOTBAS+BASES
STARS=RAN(XXX)*9.+1.
121 GALAXY(I,J)=ENEMYS*100+BASES*10+STARS
IF (TOTENE.GT.0) GO TO 125
I=RAN(XXX)*GALSIZ+1.
J=RAN(XXX)*GALSIZ+1.
GALAXY(I,J)=GALAXY(I,J)+100
TOTENE=1
KQUADS=1
125 IF (TOTENE.LE.4) GO TO 127
K=RAN(XXX)*GALSIZ+1
L=RAN(XXX)*GALSIZ+1
126 DO 129 I=K,GALSIZ
DO 129 J=L,GALSIZ
IF (GALAXY(I,J)/100.EQ.0) GO TO 129
FLAGSH(1)=I
FLAGSH(2)=J
GO TO 127
129 CONTINUE
K=1
J=1
GO TO 126
127 STTOTE=TOTENE
IF (TOTBAS.GT.0) GO TO 128
I=RAN(XXX)*GALSIZ+1.
J=RAN(XXX)*GALSIZ+1.
GALAXY(I,J)=GALAXY(I,J)+10
TOTBAS=1
128 BOTTOM=KQUADS+TOTENE/2+GALSIZ*GALSIZ/KQUADS/2.
TOP=2*TOTENE
SPREAD=TOP-BOTTOM
SPREAD=SPREAD*(1.-ALOG10(FLOAT(GALSIZ))/3.)
AVADAT=10.*(SPREAD*RAN(XXX)+BOTTOM)
L=BEGDAT+AVADAT
CALL DATE(TDATE)
CALL TIME(TIMES)
WRITE (NOUT,130) TIMES,TDATE(1),TDATE(2)
130 FORMAT (' CURRENT TIME IS ',A5,' ON ',A5,A4)
IF (GAMES.EQ.0) GO TO 641
WRITE (NOUT,642) TOTENE,AVADAT
642 FORMAT (' YOUR MISSION: ',I3,' KLINGONS IN ',I4,' STARDATES.')
GO TO 643
641 WRITE (NOUT,640) CURDAT,TOTENE,AVADAT,L
640 FORMAT(' ORDERS: STARDATE = ',I4//
$' YOU ARE IN COMMAND OF THE UNITED STARSHIP ENTERPRISE.'/
$' YOUR MISSION IS TO RID THE GALAXY OF THE DEADLY'/
$' KLINGON MENACE. TO DO THIS, YOU MUST DESTROY THE'/
$' KLINGON INVASION FORCE OF ',I3,' BATTLE CRUISERS.'/
$' YOU HAVE ',I4,' STARDATES TO COMPLETE YOUR MISSION.'/
$' (I.E. UNTIL STARDATE ',I4,' ).'//)
C C
C SET UP EACH QUADRANT
C
C FIRST, FIND A PLACE TO PUT ALL THE KLINGONS
643 DO 830 I=1,GALSIZ
DO 830 J=1,GALSIZ
DO 710 R1=1,8
DO 710 R2=1,8
710 QUADRT(R1,R2)=0
L=GALAXY(I,J)
ENEMYS=L/100
L=L-100*ENEMYS
BASES=L/10
STARS=L-10*BASES
IF (ENEMYS.EQ.0) GO TO 740
DO 730 L=1,ENEMYS
720 R1=8.*RAN(XXX)+1.
R2=8.*RAN(XXX)+1.
IF (QUADRT(R1,R2).NE.0) GO TO 720
QUADRT(R1,R2)=2
730 IF (RAN(XXX).LT..3) QUADRT(R1,R2)=6
740 IF (BASES.EQ.0) GO TO 770
DO 760 L=1,BASES
750 R1=8.*RAN(XXX)+1.
R2=8.*RAN(XXX)+1.
IF (QUADRT(R1,R2).NE.0) GO TO 750
760 QUADRT(R1,R2)=3
770 IF (STARS.EQ.0) GO TO 800
DO 790 L=1,STARS
780 R1=8.*RAN(XXX)+1.
R2=8.*RAN(XXX)+1.
IF (QUADRT(R1,R2).NE.0) GO TO 780
790 QUADRT(R1,R2)=4
800 DO 820 R1=1,8
L=0
DO 810 R2=1,8
810 L=8*L+QUADRT(R1,R2)
820 LOCATE(R1,I,J)=L
830 CONTINUE
LQUADR=0
C C
C MOVE THE ENTERPRISE INTO A NEW QUADRANT
C
131 DO 900 I=1,9
KLING1(I,1)=0
KLING1(I,2)=0
900 KLING2(I)=0
L=0
DO 860 I=1,8
IF (LQUADR.EQ.0) GO TO 855
M=0
DO 850 J=1,8
850 M=8*M+QUADRT(I,J)
LOCATE(I,LQUADR,LQUADC)=M
855 M=LOCATE(I,QUADRW,QUADCL)
DO 860 J=1,8
R1=9-J
R2=M/8
QUADRT(I,R1)=M-8*R2
CLOAK(I,J)=1
IF (QUADRT(I,R1).NE.2.AND.QUADRT(I,R1).NE.6) GO TO 860
L=L+1
KLING1(L,1)=I
KLING1(L,2)=R1
KLING2(L)=KLGMAX
IF (QUADRT(I,R1).EQ.6) CLOAK(I,R1)=0
860 M=R2
M=GALAXY(QUADRW,QUADCL)
ENEMYS=M/100
M=M-100*ENEMYS
BASES=M/10
STARS=M-10*BASES
IF (L.EQ.ENEMYS) GO TO 870
865 WRITE (NOUT,950) L, ENEMYS,GALAXY(QUADRW,QUADCL),
$QUADRW,QUADCL,FLAGSH(1),FLAGSH(2),FLAGSH(3)
C SOME ENEMIES IN THIS QUADRANT HAVE DISAPPEARED
950 FORMAT(' PROGRAM ERROR 950. L = ',I3,' ENEMYS = ',I3
$/' GALAXY(QUADRW,QUADCL) = ',I4,' QUADRW = ',I3,
$' QUADCL = ',I3/' FLAGSH = ',I3,2X,I3,2X,I3)
GO TO 99999
870 SECTRW=8.*RAN(XXX)+1.
SECTCL=8.*RAN(XXX)+1.
IF (QUADRT(SECTRW,SECTCL).NE.0) GO TO 870
QUADRT(SECTRW,SECTCL)=1
IF (FLAGSH(1).NE.QUADRW.OR.FLAGSH(2).NE.QUADCL) GO TO 875
IF (ENEMYS.EQ.0) GO TO 865
FLAGSH(3)=RAN(XXX)*ENEMYS+1
KLING2(FLAGSH(3))=2*KLGMAX
875 CALL SB171(1)
LQUADR=QUADRW
LQUADC=QUADCL
162 COMAND=-1
PRTY=0
IF (ENEMYS.NE.0) CALL SB585
IF (ENERGY.LE.0) GO TO 619
161 SENFLG=1
IF (SHOMOD.EQ.0.AND.(SENFST.EQ.1.OR.LONMOD.EQ.1)) GO TO 163
IF (LONMOD.EQ.0) GO TO 363
IF (STAMOD.EQ.0) GO TO 220
GO TO 236
C C
C PERFORM SHORT RANGE SENSOR SCAN
C
163 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
KNOWN(QUADRW,QUADCL)=1
169 IF (DAMAGE(2).GE.0) GO TO 196
WRITE (NOUT,191)
191 FORMAT(' *** SHORT RANGE SENSORS ARE OUT ***')
IF (BOARD.EQ.0) GO TO 215
WRITE (NOUT,195) QUADRW,QUADCL
195 FORMAT(' SHUTTLECRAFT SHORT RANGE SENSOR SCAN FOR QUADRANT ',
$I2,',',I2/' ---------------')
GO TO 198
196 WRITE (NOUT,197) QUADRW, QUADCL
197 FORMAT (' SHORT RANGE SENSOR SCAN FOR QUADRANT ',I2,',',I2/
$' ---------------')
198 DO 217 I=1,8
DO 212 J=1,8
LINE(J)=6.*RAN(XXX)+1.
IF (DAMAGE(2).NE.0.AND.RAN(XXX).GE..98) GO TO 212
LINE(J)=QUADRT(I,J)+1
IF (LINE(J).EQ.6) LINE(J)=5
IF (LINE(J).EQ.7) LINE(J)=3
IF (FLAGSH(1).EQ.QUADRW.AND.FLAGSH(2).EQ.QUADCL.AND.
$KLING1(FLAGSH(3),1).EQ.I.AND.KLING1(FLAGSH(3),2).EQ.J) LINE(J)=6
LINE(J)=(LINE(J)-1)*CLOAK(I,J)+1
212 CONTINUE
WRITE (NOUT,211) (QDOL(LINE(J)),J=1,8)
211 FORMAT(1X,8(A1,1X))
217 CONTINUE
WRITE (NOUT,218)
218 FORMAT(' ---------------')
215 CONTINUE
IF (SENFLG.EQ.1.AND.LONMOD.EQ.0.AND.SENFST.EQ.1) GO TO 363
IF (STAMOD.EQ.0.AND.SENFLG.EQ.1) GO TO 222
GO TO 236
C C
C REPORT ON THE ENTERPRISE'S STATUS
C
220 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(11).EQ.0) GO TO 222
WRITE (NOUT,1410)
GO TO 236
222 WRITE (NOUT,221)CURDAT
221 FORMAT(' STARDATE ',I4)
WRITE (NOUT,223) CDOL
223 FORMAT(' CONDITION ',2A5)
WRITE (NOUT,225) QUADRW,QUADCL
225 FORMAT(' QUADRANT ',I2,',',I2)
WRITE (NOUT,227) SECTRW,SECTCL
227 FORMAT(' SECTOR ',I2,',',I1)
WRITE (NOUT,229) ENERGY
229 FORMAT(' ENERGY ',I4)
WRITE (NOUT,231) TORPS, PROBES
231 FORMAT(' PHOTON TORPEDOES ',I2,' /SCANNER PROBES ',I1)
L=AVADAT+BEGDAT-CURDAT
WRITE (NOUT,233) TOTENE,L
233 FORMAT(' KLINGONS LEFT ',I3,' /STARDATES LEFT ',I4)
IF (DEFLCT.GT.0) WRITE (NOUT,235) DEFLCT
235 FORMAT(' DEFLECTOR POWER ',I4)
GO TO 236
C C
C CHECK FOR PRIORITY DISTRESS SIGNALS
C
236 IF (RAN(XXX).LT..912445.OR.BOARD.NE.0.OR.BEGDAT+10.LT.CURDAT)
$ GO TO 237
WRITE (NOUT,167)
167 FORMAT(' SHUTTLECRAFT SIGNALS HAVE BEEN RECEIVED FROM THE ',
$'GALILEO')
SHUSIG=1
237 SENFLG=0
IF (PRTY.EQ.2) PRTY=1
IF (PRTY.NE.3.OR.RAN(XXX).GE..10) GO TO 164
WRITE (NOUT,165)
165 FORMAT('0PRIORITY DISTRESS SIGNAL CANCELED')
PRTY=0
164 IF (DAMAGE(1).NE.0) GO TO 257
IF (PRTY.EQ.1) GO TO 245
IF (TOTENE.EQ.ENEMYS.OR.RAN(XXX).LT..97) GO TO 257
239 PTYROW=GALSIZ*RAN(XXX)+1.
PTYCOL=GALSIZ*RAN(XXX)+1.
IF (GALAXY(PTYROW,PTYCOL).LT.100.OR.(PTYCOL.EQ.QUADCL.AND.
$PTYROW.EQ.QUADRW)) GO TO 239
I=GALAXY(PTYROW,PTYCOL)/100
PRTY=1
IF (I.GT.4) GO TO 241
PRTY=3
IF (I.EQ.1) GO TO 241
PRTY=(7-I)/2.+RAN(XXX)
IF (I.EQ.2.OR.I.EQ.4) GO TO 241
PRTY=3.*RAN(XXX)+1.
241 WRITE (NOUT,242) PRTY
242 FORMAT(' PRIORITY ',I1,' DISTRESS SIGNAL FROM '$)
R1=RAN(XXX)*32.+1.
R1=2*R1-1
WRITE (NOUT,243) LDOL(R1),LDOL(R1+1),PTYROW,PTYCOL
243 FORMAT('+',2A5,' IN QUADRANT ',I2,',',I2/)
IF (PRTY.NE.1) GO TO 257
245 DELTAY=QUADRW-PTYROW
DELTAX=PTYCOL-QUADCL
WARP=SQRT(DELTAY*DELTAY+DELTAX*DELTAX)
WRITE (NOUT,246)
246 FORMAT(' COURSE LAID AS:'/)
WRITE (NOUT,248) WARP
248 FORMAT(' WARP FACTOR: ',F4.1)
DELTAX=QUADRW-PTYROW
DELTAY=PTYCOL-QUADCL
COURSE=180.*ATAN2(DELTAY,DELTAX)/PIE+SIGN(.5,DELTAY)
IF (COURSE.LT.0) COURSE=COURSE+360
255 WRITE (NOUT,254) COURSE
254 FORMAT(' COURSE: ',I3)
GO TO 302
257 CONTINUE
C C
C COMMAND DISPATCHER
C
LSTCOM=COMAND
256 WRITE (NOUT,258)
258 FORMAT(' COMMAND?',$)
READ (NIN,259,ERR=265) COMAND
259 FORMAT(I)
IF (COMAND.LT.0) GO TO 263
IF (COMAND.GT.20) GO TO 265
261 FORMAT(' ACKNOWLEDGED')
L=COMAND+1
GO TO (282,163,363,384,420,482,497,509,530,541,544,561,
$564,902,1105,1205,1305,1405,220,619,3100),L
265 WRITE (NOUT,262)
262 FORMAT(' ILLEGAL COMMAND. (ENTER -1 FOR HELP)')
GO TO 256
263 WRITE (NOUT,264)
264 FORMAT(/' ::: COMMANDS :::'//
$' <0 = LIST THE COMMANDS(0)'/
$' 0 = ACTIVATE WARP ENGINES(2-12)*'/
$' 1 = PERFORM SHORT RANGE SENSOR SCAN(1)'/
$' 2 = PERFORM LONG RANGE SENSOR SCAN(1)'/
$' 3 = FIRE PHASERS(1)*'/
$' 4 = FIRE A PHOTON TORPEDO(1)*'/
$' 5 = OBTAIN DAMAGE CONTROL REPORT(1)'/
$' 6 = ACTIVATE DEFLECTORS(1)'/
$' 7 = OPEN COMMUNICATIONS(1)*'/
$' 8 = ENERGIZE TRANSPORTER(1)*')
WRITE (NOUT,3000)
3000 FORMAT(' 9 = DROP DEFLECTORS(1)*'/
$' 10 = ACTIVATE TRACTOR BEAMS(1)'/
$' 11 = FIRE TORPEDO SPREAD(1)*'/
$' 12 = OBTAIN COMPUTER GALAXY MAP(1)'/
$' 13 = RESET SENSOR MODES(0)'/
$' 14 = LAUNCH SUPER LONG RANGE SENSOR PROBE(1)'/
$' 15 = SAVE GAME(0)'/
$' 16 = RESTORE PREVIOUS GAME(0)'/
$' 17 = QUESTION THE BATTLE COMPUTER(1)'/
$' 18 = REPORT ENTERPRISE SITUATION(1)'/
$' 19 = SURRENDER!(0)'/
$' 20 = CANCEL PRIORITY 3 DISTRESS SIGNAL(1)'//
$' NUMBER IN PARENTHESES IS # OF STARDATES COMMAND USES.'/
$' AN * INDICATES KLINGONS MAY FIRE AFTER COMMAND USE.'/
$' -1 WITHIN A COMMAND WILL CANCEL IT.'/
$' COURSE FOR 0, 4, 11, AND 14 IS IN CLOCKWISE DEGREES'/
$' WITH 0 DEGREES BEING NORTH'/)
GO TO 236
C
C
C CANCEL PRIORITY 3 DISTRESS SIGNALS
C
3100 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (PRTY.EQ.3) GO TO 3110
WRITE (NOUT,3105)
3105 FORMAT (' NO PRIORITY 3 DISTRESS SIGNAL ACTIVE.')
GO TO 236
3110 WRITE (NOUT,3115)
3115 FORMAT (' PRIORITY 3 DISTRESS SIGNAL CANCELED.')
PRTY=0
GO TO 236
C C
C ACTIVATE WARP ENGINES
C
282 PRTY=MIN0(1,PRTY)
IF (PRTY.GT.0) GO TO 245
IF (LSTCOM.EQ.17) GO TO 287
284 WRITE (NOUT,285)
285 FORMAT(' COURSE (0-359)?',$)
READ (NIN,259,ERR=284) ENGINE
IF (ENGINE.LT.0) GO TO 236
IF (ENGINE.GT.359) GO TO 284
289 WRITE (NOUT,290)
290 FORMAT(' WARP FACTOR (0.-20.)?',$)
READ (NIN,286,ERR=289) WARP
286 FORMAT(F)
IF (WARP.LE.0.) GO TO 236
287 IF (WARP.GT.20.) GO TO 284
IF (LSTCOM.EQ.17.AND.SHOMOD.EQ.1.AND.LONMOD.EQ.1)
$WRITE (NOUT,261)
IF (DAMAGE(1).EQ.0.OR.WARP.LT..31) GO TO 302
WRITE (NOUT,297)
297 FORMAT(' WARP ENGINES ARE DAMAGED. MAXIMUM SPEED = WARP .3')
GO TO 284
302 IF (ENEMYS.EQ.0) GO TO 305
CALL SB585
IF (ENERGY.LE.0) GO TO 619
305 DO 307 I=1,11
307 DAMAGE(I)=AMIN1(DAMAGE(I)+1.,0.)
N=WARP*8.
ENERGY=MIN0(STENEG,ENERGY-2*N)
CURDAT=CURDAT+2
IF (WARP.GE.1.) CURDAT=CURDAT+(WARP+1.)/2.
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
QUADRT(SECTRW,SECTCL)=0
IF (PRTY.EQ.1) GO TO 360
YYY=ENGINE*PIE/180.
DELTAX=SIN(YYY)
DELTAY=-COS(YYY)
X=SECTRW
Y=SECTCL
DO 353 I=1,N
X=X+DELTAY
Y=Y+DELTAX
L=X+.5
M=Y+.5
IF (L.LT.1.OR.L.GT.8.OR.M.LT.1.OR.M.GT.8) GO TO 358
IF (QUADRT(L,M).EQ.0) GO TO 353
WRITE (NOUT,349) L,M
349 FORMAT(' ENTERPRISE BLOCKED BY OBJECT AT SECTOR ',I1,',',I1)
X=X-DELTAY
Y=Y-DELTAX
GO TO 354
353 CONTINUE
354 SECTRW=X+.5
SECTCL=Y+.5
QUADRT(SECTRW,SECTCL)=1
CALL SB171(1)
IF (ENEMYS.NE.0) CALL SB585
IF (ENERGY.LE.0) GO TO 619
GO TO 161
358 IF (RAN(XXX).GT..03.OR.DAMAGE(1).LT.0.) GO TO 309
QUADRW=GALSIZ*RAN(XXX)+1.
QUADCL=GALSIZ*RAN(XXX)+1.
WRITE (NOUT,310) QUADRW,QUADCL
310 FORMAT(' *** SPACE WARP, ENTERPRISE THROWN OFF COURSE ***'/
$' NOW IN QUADRANT ',I2,',',I2)
QUADRT(SECTRW,SECTCL)=0
CURDAT=CURDAT+2+5*RAN(XXX)
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
GO TO 131
309 IF (RAN(XXX).GT..3) GO TO 330
R1=11.5*RAN(XXX)
IF (R1.EQ.0) R1=2
YYY=(AVADAT/10.)/STTOTE
YYY=ATAN(YYY)/1.8+.07
L=BEGDAT+AVADAT-CURDAT
IF (RAN(XXX).GT.YYY.OR.FLOAT(L)/AVADAT.LT..15) GO TO 318
YYY=AMIN1(RAN(XXX)*2.*L/(10.*TOTENE)+1.,6.)
DAMAGE(R1)=AMAX1(DAMAGE(R1)-YYY,-10.)
WRITE (NOUT,315)
315 FORMAT(' *** SPACE STORM, ',$)
WRITE (NOUT,316) (DAMSTR(I,R1),I=1,3)
316 FORMAT('+',3A5,' DAMAGED ***')
GO TO 335
318 CALL SB320
330 IF (RAN(XXX).GT..03) GO TO 335
L=BEGDAT+AVADAT-CURDAT
I=(L/4+2)*RAN(XXX)+1
IF (RAN(XXX).GT..6) I=-I
WRITE (NOUT,331) I
331 FORMAT (' *** TIME WARP OF ',I3,' STARDATES ***')
CURDAT=CURDAT+I
L=BEGDAT+AVADAT-CURDAT
WRITE (NOUT,333) L
333 FORMAT (1X,I3,' STARDATES NOW LEFT')
335 DEFLCT=0
TRNFLG=0
COMSIG=0
SHUSIG=0
R2=DELTAX*WARP*16.
R1=DELTAY*WARP*16.
L=QUADRW*16+SECTRW*2-1
M=QUADCL*16+SECTCL*2-1
L=MAX0(16,MIN0(16*GALSIZ+15,L+R1))
M=MAX0(16,MIN0(16*GALSIZ+15,M+R2))
QUADRW=L/16
QUADCL=M/16
GO TO 131
360 QUADRW=PTYROW
QUADCL=PTYCOL
GO TO 131
C C
C PERFORM LONG RANGE SENSOR SCAN
C
363 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(3).EQ.0.) GO TO 367
WRITE (NOUT,365)
365 FORMAT(' LONG RANGE SENSORS ARE INOPERABLE')
GO TO 383
367 WRITE (NOUT,366) QUADRW,QUADCL
366 FORMAT(' LONG RANGE SENSOR SCAN FOR QUADRANT ',I2,',',I2)
368 WRITE (NOUT,218)
IIL=QUADRW-1
IIH=QUADRW+1
JJL=QUADCL-1
JJH=QUADCL+1
DO 382 I=IIL,IIH
LONG(1)=0
LONG(2)=0
LONG(3)=0
IF (I.LT.1.OR.I.GT.GALSIZ) GO TO 378
DO 379 J=JJL,JJH
IF (J.LT.1.OR.J.GT.GALSIZ) GO TO 379
LONG(J-QUADCL+2)=GALAXY(I,J)
KNOWN(I,J)=1
379 CONTINUE
378 WRITE (NOUT,380) LONG
380 FORMAT(1X,I3,' : ',I3,' : ',I3)
WRITE (NOUT,218)
382 CONTINUE
383 IF (SENFLG.EQ.1.AND.SHOMOD.EQ.0.AND.SENFST.EQ.2) GO TO 163
IF (SENFLG.EQ.1.AND.STAMOD.EQ.0) GO TO 222
GO TO 236
C C
C FIRE PHASERS
C
384 IF (DAMAGE(4).EQ.0..AND.DAMAGE(11).EQ.0.) GO TO 388
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
WRITE (NOUT,386)
386 FORMAT(' PHASERS ARE NOT OPERATIONAL')
GO TO 236
388 WRITE (NOUT,387)ENERGY
387 FORMAT(' PHASERS LOCKED ON TARGET(S). ENERGY AVAILABLE = ',
$I4)
IF (LSTCOM.EQ.17.AND.PFLAG.EQ.1) GO TO 392
391 WRITE (NOUT,389)
389 FORMAT(' NUMBER OF UNITS TO FIRE?',$)
READ (NIN,259,ERR=391) N
IF (N.LE.0) GO TO 236
392 LSTCOM=-1
IF (ENERGY.LE.N) GO TO 388
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (ENEMYS.EQ.0) GO TO 419
X=0.
DO 390 I=1,9
IF (KLING2(I).LE.0.OR.HITVAL(I).EQ.0) GO TO 390
DELTAX=KLING1(I,1)-SECTRW
DELTAY=SECTCL-KLING1(I,2)
X=X+SQRT(DELTAY*DELTAY+DELTAX*DELTAX)
390 CONTINUE
IF (X.EQ.0.) GO TO 419
IF (CDOL(1).NE.DOCKED) ENERGY=ENERGY-N
IF (CDOL(1).EQ.DOCKED) EUSED=EUSED+N
X=N/X
DO 416 I=1,9
IF (KLING2(I).LE.0.OR.HITVAL(I).EQ.0) GO TO 416
L=KLING1(I,1)
M=KLING1(I,2)
LOSS=X*(2.+RAN(XXX))
KLING2(I)=KLING2(I)-LOSS
WRITE (NOUT,407) LOSS
407 FORMAT(1X,I4,' UNIT HIT ON KLINGON AT SECTOR ',$)
IF (CLOAK(L,M).EQ.0) GO TO 411
WRITE (NOUT,409) L,M
409 FORMAT('+',I1,',',I1)
GO TO 412
411 WRITE (NOUT,410)
410 FORMAT('+UNKNOWN')
412 WRITE (NOUT,413) KLING2(I)
413 FORMAT(' (',I4,' LEFT)')
IF (KLING2(I).GT.0) GO TO 416
WRITE (NOUT,578) L,M
578 FORMAT(' KLINGON AT SECTOR ',I1,',',I1,' DESTROYED!')
ENEMYS=ENEMYS-1
TOTENE=TOTENE-1
QUADRT(L,M)=0
IF (FLAGSH(1).EQ.QUADRW.AND.FLAGSH(2).EQ.QUADCL.AND.
$KLING1(FLAGSH(3),1).EQ.L.AND.KLING1(FLAGSH(3),2).EQ.M)
$FLAGSH(1)=0
CLOAK(L,M)=1
CALL SB171(0)
416 CONTINUE
GALAXY(QUADRW,QUADCL)=ENEMYS*100+BASES*10+STARS
IF (TOTENE.EQ.0) GO TO 626
IF (ENEMYS.GT.0) CALL SB585
418 IF (ENERGY.LE.0) GO TO 619
GO TO 236
419 WRITE (NOUT,415)
415 FORMAT(' NO KLINGONS HIT')
GO TO 236
C C
C FIRE PHOTON TORPEDOES
C
420 IF (DAMAGE(5).EQ.0.) GO TO 424
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
WRITE (NOUT,422)
422 FORMAT(' PHOTON TUBES ARE NOT OPERATIONAL')
GO TO 236
424 IF (TORPS.GT.0) GO TO 428
WRITE (NOUT,425)
425 FORMAT(' ALL PHOTON TORPEDOES EXPENDED')
IF (COMAND.EQ.11) GO TO 476
GO TO 236
428 IF (COMAND.EQ.11) GO TO 432
IF (LSTCOM.EQ.17.AND.TFLAG.EQ.1) GO TO 435
427 WRITE (NOUT,429)
429 FORMAT(' TORPEDO COURSE (0-359)?',$)
READ (NIN,259,ERR=427) COURSE
GO TO 435
432 COURSE=MOD(COURSE+45,360)
COUNT=COUNT+1
IF (COUNT.GT.MAXTRP) GO TO 476
WRITE (NOUT,434) COURSE
434 FORMAT(' COURSE: ',I3/)
435 IF (COURSE.LT.0) GO TO 236
IF (COURSE.GT.359) GO TO 427
IF (CDOL(1).NE.DOCKED) TORPS=TORPS-1
IF (CDOL(1).EQ.DOCKED) PUSED=PUSED+1
L=0
CALL TRACK(COURSE,1,N,L,M)
IF (N.EQ.0) GO TO 474
IF (N.NE.2.AND.N.NE.6) GO TO 460
WRITE (NOUT,451)
451 FORMAT(/' *** KLINGON DESTROYED ***')
ENEMYS=ENEMYS-1
TOTENE=TOTENE-1
IF (TOTENE.EQ.0) GO TO 626
DO 457 I=1,9
IF (L.EQ.KLING1(I,1).AND.M.EQ.KLING1(I,2)) GO TO 458
457 CONTINUE
WRITE (NOUT,456)
C NON-KLINGON KILLED. ??
456 FORMAT(/' PROGRAM ERROR 456.')
GO TO 865
458 KLING2(I)=0
CLOAK(L,M)=1
IF (FLAGSH(1).EQ.QUADRW.AND.FLAGSH(2).EQ.QUADCL.AND.
$FLAGSH(3).EQ.I) FLAGSH(1)=0
CALL SB171(0)
GO TO 471
460 IF (N.LT.4) GO TO 468
IF (N.EQ.4) GO TO 465
WRITE (NOUT,462)
462 FORMAT(/' STAR DESTROYED')
STARS=STARS-1
GO TO 471
465 WRITE (NOUT,466)
466 FORMAT(/' TORPEDO ABSORBED')
QUADRT(L,M)=5
GO TO 475
468 IF (N.EQ.3) GO TO 470
WRITE (NOUT,469)
469 FORMAT(/' PROGRAM ERROR 469')
GO TO 99999
470 WRITE (NOUT,467)
467 FORMAT(1X)
WRITE (NOUT,464)
464 FORMAT(/' *** STARBASE DESTROYED ... CONGRATULATIONS ***')
QUADRT(L,M)=0
CALL SB171(0)
BASES=BASES-1
471 QUADRT(L,M)=0
GALAXY(QUADRW,QUADCL)=ENEMYS*100+BASES*10+STARS
GO TO 475
474 WRITE (NOUT,473)
473 FORMAT(/' TORPEDO MISSED')
475 IF (COMAND.EQ.11) GO TO 420
476 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (ENEMYS.NE.0) CALL SB585
IF (ENERGY.LE.0) GO TO 619
GO TO 236
C C
C OBTAIN DAMAGE CONTROL REPORT
C
482 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(6).EQ.0.) GO TO 486
WRITE (NOUT,484)
484 FORMAT(' DAMAGE CONTROL REPORT IS NOT AVAILABLE')
GO TO 236
486 WRITE (NOUT,487)
487 FORMAT(/' DAMAGED'/' DEVICE STATE OF REPAIR')
L=0
DO 492 I=1,11
IF (DAMAGE(I).EQ.0.) GO TO 492
WRITE (NOUT,491) (DAMSTR(J,I),J=1,3),DAMAGE(I)
491 FORMAT(1X,3A5,7X,F10.4)
L=1
492 CONTINUE
IF (L.EQ.1) GO TO 495
WRITE (NOUT,494)
494 FORMAT(' NONE')
495 WRITE (NOUT,467)
GO TO 236
C C
C ACTIVATE DEFLECTORS
C
497 IF (DEFLCT.LT.4000) GO TO 498
WRITE (NOUT,506)
506 FORMAT (' DEFLECTORS AT MAXIMUM STRENGTH')
504 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
GO TO 236
498 IF (DAMAGE(7).EQ.0.) GO TO 501
WRITE (NOUT,499)
499 FORMAT(' DEFLECTORS DAMAGED')
GO TO 504
501 IF (CDOL(1).EQ.DOCKED) GO TO 525
WRITE (NOUT,500) ENERGY
500 FORMAT(' ENERGY AVAILABLE = ',I4)
502 WRITE (NOUT,503)
503 FORMAT(' NUMBER OF UNITS TO DEFLECTORS?',$)
READ (NIN,259,ERR=502) S6
IF (S6.LT.0) GO TO 236
IF (DEFLCT+2*S6.LE.4000) GO TO 508
S6=(4000-DEFLCT)/2
WRITE (NOUT,507) S6
507 FORMAT (' MAXIMUM AMOUNT ',I4)
GO TO 502
508 IF (S6.GT.ENERGY) GO TO 501
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
DEFLCT=DEFLCT+2*S6
ENERGY=ENERGY-S6
WRITE (NOUT,505) DEFLCT,ENERGY
505 FORMAT (' DEFLECTOR POWER NOW = ',I4,
$', ENERGY UNITS LEFT = ',I4)
GO TO 525
C C
C ATTEMPT COMMUNICATIONS
C
509 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(8).EQ.0.) GO TO 513
WRITE (NOUT,511)
511 FORMAT(' COMMUNICATIONS OUT')
GO TO 236
513 K4=0
K5=0
DO 518 I=1,9
IF (KLING2(I).LE.0) GO TO 518
K5=K5+KLING2(I)
K4=K4+1
518 CONTINUE
IF (K4.EQ.0) GO TO 521
IF (COMFLG.EQ.1) GO TO 520
IF (K5/K4.LT.100..AND..3.LT.RAN(XXX)) GO TO 527
520 I=RAN(XXX)*4.
WRITE (NOUT,3260)
IF (I.EQ.0) WRITE (NOUT,3270)
IF (I.EQ.1) WRITE (NOUT,3280)
IF (I.EQ.2) WRITE (NOUT,3290)
IF (I.EQ.3) WRITE (NOUT,3300)
GO TO 523
521 WRITE (NOUT,522)
522 FORMAT(' NO KLINGONS CAN HEAR YOU')
523 COMFLG=1
524 IF (ENEMYS.NE.0) CALL SB585
525 IF (ENERGY.LE.0) GO TO 619
GO TO 236
527 WRITE (NOUT,528)
528 FORMAT(' TRUCE ACCEPTED')
CALL SB320
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
GO TO 236
3260 FORMAT (' RESPONSE FROM KLINGON COMMANDER:')
3270 FORMAT (' NOT ON YOUR LIFE!')
3280 FORMAT (' A TRUCE?... NEVER!!!')
3290 FORMAT (' DO NOT INSULT THE KLINGON EMPIRE WITH ',
$'YOUR FAKE TRUCES!')
3300 FORMAT (' NO!, A KLINGON ALWAYS FIGHTS TO THE DEATH.')
C C
C TRANSPORT TORPEDOES FROM STARBASE
C
530 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DEFLCT.NE.0.OR.DAMAGE(2).NE.0..OR.DAMAGE(9).NE.0..OR.
$MOD(GALAXY(QUADRW,QUADCL),100).LT.10.OR.TORPS.GE.10) GO TO 532
IF (TRNFLG.EQ.0) GO TO 537
WRITE (NOUT,535)
535 FORMAT(' TRANSPORTER AVAILABLE ONLY ONCE PER',
$' STAY IN QUADRANT.')
GO TO 236
532 WRITE (NOUT,533)
533 FORMAT(' TRANSPORTATIONS FROM STARBASE IMPOSSIBLE BECAUSE')
IF (DEFLCT.NE.0) WRITE (NOUT,3210)
IF (DAMAGE(2).NE.0) WRITE (NOUT,3220)
IF (DAMAGE(9).NE.0) WRITE (NOUT,3230)
IF (MOD(GALAXY(QUADRW,QUADCL),100).LT.10) WRITE (NOUT,3240)
IF (TORPS.GE.10) WRITE (NOUT,3250)
GO TO 236
537 TORPS=TORPS+(10-TORPS)*RAN(XXX)+1
WRITE (NOUT,538) TORPS
538 FORMAT(' PHOTON TORPEDOES NOW NUMBER ',I2)
TRNFLG=1
GO TO 524
3210 FORMAT (' DEFLECTORS ARE UP')
3220 FORMAT (' S. R. SENSORS NOT OPERATIONAL')
3230 FORMAT (' TRANSPORTER IS OUT')
3240 FORMAT (' NO STARBASE IN QUADRANT')
3250 FORMAT (' # OF PHOTON TORPEDOES ALREADY 10')
C C
C DROP DEFLECTORS
C
541 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
WRITE (NOUT,261)
DEFLCT=DEFLCT/4
ENERGY=ENERGY+DEFLCT
WRITE (NOUT,542) DEFLCT,ENERGY
542 FORMAT (' GAIN OF ',I4,
$' ENERGY UNITS WHICH NOW TOTALS ',I4,' UNITS.')
DEFLCT=0
GO TO 524
C C
C ACTIVATE TRACTOR BEAMS
C
544 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(10).EQ.0.) GO TO 548
WRITE (NOUT,546)
546 FORMAT(' TRACTOR BEAMS DAMAGED')
GO TO 236
548 IF (SHUSIG.NE.0) GO TO 552
WRITE (NOUT,549)
549 FORMAT(' SHUTTLECRAFT SIGNALS HAVE NOT BEEN RECEIVED FROM THIS '
$/' QUADRANT THIS STARDATE.')
GO TO 236
552 LOSS=400.*RAN(X)
IF (LOSS.LT.ENERGY.AND.SHUSIG.NE.2) GO TO 555
WRITE (NOUT,554)
554 FORMAT(' ENERGY TOO LOW FOR TRACTOR BEAM USE')
SHUSIG=2
GO TO 236
555 IF (RAN(XXX).GE..2) GO TO 557
WRITE (NOUT,556)
556 FORMAT (' SHUTTLECRAFT GALILEO LOST DUE TO TRACTOR BEAM FAILURE.')
GO TO 236
557 IF (CDOL(1).EQ.DOCKED) EUSED=EUSED+LOSS
IF (CDOL(1).NE.DOCKED) ENERGY=ENERGY-LOSS
BOARD=1
WRITE (NOUT,559)
559 FORMAT(' SHUTTLECRAFT GALILEO SAFELY ABOARD THE ENTERPRISE')
GO TO 236
C C
C FIRE TORPEDO SPREAD
C
561 IF (LSTCOM.EQ.17.AND.SFLAG.EQ.1) GO TO 568
WRITE (NOUT,562)
562 FORMAT(' FIRST TORPEDO COURSE?(0-359)',$)
READ (NIN,259,ERR=561) ANGLE
IF (ANGLE.LT.0) GO TO 236
IF (ANGLE.GT.359) GO TO 561
563 WRITE (NOUT,560)
560 FORMAT(' HOW MANY TORPEDOES ARE TO BE FIRED?(1-8)',$)
READ (NIN,259,ERR=563) MAXTRP
IF (MAXTRP.LT.1) GO TO 236
IF (MAXTRP.GT.8) GO TO 563
568 COURSE=ANGLE-45
COUNT=0
GO TO 420
C C
C OBTAIN COMPUTER GALAXY MAP
C
564 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (DAMAGE(11).EQ.0.) GO TO 567
WRITE (NOUT,1410)
GO TO 236
567 WRITE (NOUT,565)
565 FORMAT(/' KNOWN GALAXY APPEARS AS SHOWN:'/
$6X,'(ENTERPRISE INDICATED BY "*" AT RIGHT)'//)
DO 576 I=1,GALSIZ
DO 574 J=1,GALSIZ
L=KNOWN(I,J)*GALAXY(I,J)
IF (L.GE.0) GO TO 566
L=9*(GALAXY(I,J)/100)-GALAXY(I,J)/10
566 IF (QUADRW.EQ.I.AND.QUADCL.EQ.J) GO TO 572
IF (KNOWN(I,J).NE.0) GO TO 570
WRITE (NOUT,569)
569 FORMAT(' ...',2X,$)
GO TO 574
570 WRITE (NOUT,571) L
571 FORMAT(' ',I3,2X,$)
GO TO 574
572 WRITE (NOUT,573) L
573 FORMAT(' ',I3,'* ',$)
574 CONTINUE
WRITE (NOUT,575)
575 FORMAT(1X)
576 CONTINUE
GO TO 236
C C
C WIN
C
626 WINS=WINS+1
L=CURDAT-BEGDAT
X3=(CURDAT-BEGDAT-1)/1.5
WRITE (NOUT,627) CURDAT,STTOTE,L
627 FORMAT (' IT IS STARDATE ',I4,'.'/
$' THE LAST KLINGON BATTLE CRUISER HAS BEEN DESTROYED.'/
$' THE FEDERATION HAS BEEN SAVED.'/
$1X,I3,' KLINGONS IN ',I3,' STARDATES.')
GO TO 663
C
C LOSE
C
619 WRITE (NOUT,620) CURDAT, TOTENE
620 FORMAT(' IT IS STARDATE ',I4/
$' THE ENTERPRISE HAS BEEN DESTROYED -'/
$' THE FEDERATION WILL BE CONQUERED.'/
$' THERE ARE STILL ',I3,' KLINGON BATTLE CRUISERS.'/
$' YOU ARE DEAD.')
X3=STTOTE*(CURDAT-BEGDAT-1)/(STTOTE-TOTENE+1)
663 IF (X3.LT.0.5) X3=.5
GAMES=GAMES+1
X2=(STTOTE-TOTENE)*GALSIZ*1000./X3
TEMP=X2-1000.
IF (TEMP.GT.0.0) X2=X2/(SQRT(TEMP/1000.+1.))
IF (TEMP.LT.0.0) X2=X2*(SQRT(-TEMP/1000.+1.))
EUSED=EUSED+STENEG-ENERGY
PUSED=PUSED+STTORP-TORPS
WRITE (NOUT,600) EUSED,PUSED,BUSED
600 FORMAT (' YOU USED ',I5,' ENERGY UNITS, ',I2,
$' TORPEDOES, AND ',I2,' STOPS AT STARBASES.')
RESUSD=1.3/SQRT((EUSED+150.*PUSED+300.)/((STTOTE-
$TOTENE+1)*600.))
REUSED=REUSED/SQRT(SQRT((BUSED+1)*8./(STTOTE+10)))
RESUSD=RESUSD*(SQRT(GALSIZ/10.))
WRITE (NOUT,602) RESUSD,GALSIZ,GALSIZ
602 FORMAT (' RESOURCE UTILIZATION FACTOR ',F4.2,
$' IN A ',I2,' BY ',I2,' GALAXY.')
X=X2*RESUSD
WRITE (NOUT,645) X
645 FORMAT (' YOUR RATING FOR THIS BATTLE IS ',F6.1)
X=(8.5*RATING+1.5*X)/10.
IF (X.GE.2200) X=X-(X-2200.)/2.
WRITE (NOUT,644) X
644 FORMAT (' YOUR CUMULATIVE RATING IS ',F6.1)
I=X/100.
J=RATING/100.
RATING=X
IF (I.LT.5) I=4
IF (I.GE.10) I=I/2+5
I=I-3
IF (J.LT.5) J=4
IF (J.GE.10) J=J/2+5
J=J-3
IF (J.GT.12) J=12
IF (I.GT.12) I=12
IF (I.EQ.J) GO TO 675
IF (I.LT.J) WRITE (NOUT,671)
IF (I.GT.J) WRITE (NOUT,672)
671 FORMAT (' YOUR HAVE BEEN DEMOTED TO ',$)
672 FORMAT (' YOU HAVE BEEN PROMOTED TO ',$)
WRITE (NOUT,673) (RANKS(J,I), J=1,3)
673 FORMAT ('+',5A5)
675 DECODE (5,677,TIMES) HR1,MIN1
677 FORMAT (I2,1X,I2)
TT=TT-(HR1+MIN1/60.)
CALL TIME(TIMEF)
DECODE (5,677,TIMEF) HR2,MIN1
TT=TT+HR2+MIN1/60.
IF (HR2.LT.HR1) TT=TT+12.
WRITE (NOUT,678) TIMEF,TT
678 FORMAT (' IT IS NOW ',A5,'. YOU HAVE SPENT ',
$F4.2,' HOURS PLAYING STARTREK!')
WRITE (NOUT,664)
664 FORMAT(' DO YOU WANT TO PLAY AGAIN?(Y OR N)',$)
READ (NIN,665,ERR=675) CCC
665 FORMAT(A1)
IF (CCC.EQ.YES) GO TO 85
IF (CCC.NE.NO) GO TO 675
GALSIZ=0
IF (FILE) GO TO 1205
681 WRITE (NOUT,680)
680 FORMAT (' WOULD YOU LIKE TO SAVE YOUR BATTLE RECORD? ',$)
READ (NIN,665,ERR=681) CCC
IF (CCC.EQ.YES) GO TO 1205
IF (CCC.NE.NO) GO TO 681
669 WRITE (NOUT,670) WINS,GAMES
670 FORMAT (' YOU HAVE WON ',I3,' OUT OF ',I3,' BATTLES.'/)
STOP
9000 FORMAT (' STOP ON PROGRAM ERROR'/)
99999 WRITE (NOUT,9000)
STOP
C C
C RESET SENSOR MODES
C
902 WRITE (NOUT,905)
905 FORMAT(' SHORT RANGE MODE? (AUTOMATIC=0, MANUAL=1)',$)
READ (NIN,259,ERR=902) SHO2
IF (SHO2.LT.0) GO TO 236
SHOMOD=SHO2
IF (SHOMOD.NE.0.AND.SHOMOD.NE.1) GO TO 902
910 WRITE (NOUT,915)
915 FORMAT(' LONG RANGE MODE?',$)
READ (NIN,259,ERR=910) LONMOD
IF (LONMOD.NE.0.AND.LONMOD.NE.1) GO TO 910
917 WRITE (NOUT,918)
918 FORMAT (' STATUS REPORT?',$)
READ (NIN,259,ERR=917) STAMOD
IF (STAMOD.NE.0.AND.STAMOD.NE.1) GO TO 917
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (SHOMOD.NE.0.OR.LONMOD.NE.0) GO TO 236
920 WRITE (NOUT,925)
925 FORMAT(' WHICH SENSOR FIRST? (SHORT=1, LONG=2)',$)
READ (NIN,259,ERR=920) SENFST
IF (SENFST.NE.1.AND.SENFST.NE.2) GO TO 920
GO TO 236
C C
C LAUNCH SUPER LONG RANGE SENSOR PROBE
C
1105 IF (PROBES.GT.0) GO TO 1115
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
WRITE (NOUT,1110)
1110 FORMAT(' NO MORE PROBES')
GO TO 236
1115 IF (LSTCOM.EQ.17) GO TO 1123
WRITE (NOUT,1120)
1120 FORMAT(' PROBE COURSE (0-359)?',$)
READ (NIN,259,ERR=1115) ENGINE
IF (ENGINE.LT.0) GO TO 236
IF (ENGINE.GT.359) GO TO 1115
1123 CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
YYY=ENGINE*PIE/180.
DELTAX=SIN(YYY)/2.
DELTAY=-COS(YYY)/2.
X=QUADRW
Y=QUADCL
PROBES=PROBES-1
WRITE (NOUT,1125)
1125 FORMAT(' PROBE TRACK: ')
L=QUADRW
M=QUADCL
1130 X=X+DELTAY
Y=Y+DELTAX
IF (L.EQ.IFIX(X+.5).AND.M.EQ.IFIX(Y+.5)) GO TO 1130
L=X+.5
M=Y+.5
IF (L.LT.1.OR.L.GT.GALSIZ.OR.M.LT.1.OR.M.GT.GALSIZ) GO TO 1160
WRITE (NOUT,1135) L,M
1135 FORMAT(' QUADRANT ',I2,',',I2,2X,$)
I=GALAXY(L,M)
J=I/100
J=I/10-9*J
WRITE (NOUT,1140) J
1140 FORMAT('+',I2,' OBJECTS SIGHTED')
IF (KNOWN(L,M).EQ.0) KNOWN(L,M)=-1
GO TO 1130
1160 WRITE (NOUT,1165)
1165 FORMAT(' PROBE OUT OF RANGE')
GO TO 236
C C
C SAVE THE GAME
C
1205 IF (FILE) GO TO 1210
1206 WRITE (NOUT,1250)
1250 FORMAT(' FILE NAME? (1 TO 5 CHARACTERS) ',$)
READ (NIN,1260) NAME
1260 FORMAT(A5)
IF (NAME.EQ.BNAME) GO TO 236
FILE=.TRUE.
1210 IF (SAVRES(0,NAME)) GO TO 669
GO TO 669
C
C
C RESTORE AN OLD GAME
C
1305 IF (FILE) GO TO 1330
WRITE (NOUT,1250)
READ (NIN,1260) NAME
IF (NAME.EQ.BNAME) GO TO 236
IF (SAVRES(1,NAME)) GO TO 1320
WRITE (NOUT,1310)
1310 FORMAT (' I/O TROUBLE.')
GO TO 236
1320 FILE=.TRUE.
I=RATING/100.
IF (I.LT.5) I=4
IF (I.GE.10) I=I/2+5
I=I-3
IF (I.GT.12) I=12
WRITE (NOUT,1311) RATING,(RANKS(J,I),J=1,3)
1311 FORMAT (' YOUR INCOMING RATING IS ',F6.1/
$' YOUR RANK: ',5A5)
IF (GALSIZ.EQ.0) GO TO 85
CALL TIME(TIMES)
GO TO 222
C
1330 WRITE (NOUT,1335)
1335 FORMAT (' YOUR BATTLE RECORD IS ALREADY LOADED.')
GO TO 236
C C
C QUESTION THE BATTLE COMPUTER
C
1405 IF (DAMAGE(11).EQ.0.) GO TO 1415
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
WRITE (NOUT,1410)
1410 FORMAT(' BATTLE COMPUTER IS NOT OPERATIONAL')
COMAND=-1
GO TO 236
1415 TFLAG=0
PFLAG=0
SFLAG=0
WRITE (NOUT,1420)
1420 FORMAT (' TARGET QUADRANT: ',$)
READ (NIN,1425,ERR=1415) R1,R2
1425 FORMAT(2I)
IF (R1.LT.0) GO TO 1480
CURDAT=CURDAT+1
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
IF (R1.GE.1.AND.R1.LE.14.AND.R2.GE.1.AND.R2.LE.14) GO TO 1441
1440 IF (DAMAGE(5).GE.0..AND.TORPS.NE.0) TFLAG=1
1431 WRITE (NOUT,1435)
1435 FORMAT('+TARGET SECTOR: ',$)
READ (NIN,1425,ERR=1431) R1,R2
IF (R1.LT.0) GO TO 1480
IF (R1.LT.1.OR.R1.GT.8.OR.R2.LT.1.OR.R2.GT.8) GO TO 1431
1437 DELTAX=SECTRW-R1
DELTAY=R2-SECTCL
COURSE=180.*ATAN2(DELTAY,DELTAX)/PIE+SIGN(.5,DELTAY)
IF (COURSE.LT.0) COURSE=COURSE+360
WARP=(SQRT(DELTAY*DELTAY+DELTAX*DELTAX)+(2-SQRT(2.)/2))/8.
L=R1
M=R2
CALL TRACK(COURSE,0,N,L,M)
IF ((L.NE.R1.OR.M.NE.R2).AND.DAMAGE(2).GE.0) GO TO 1426
WRITE (NOUT,1452) COURSE,WARP
1452 FORMAT ('+COURSE= ',I3,10X'WARP= ',F4.1/)
ENGINE=COURSE
1443 X=0.
V5=0
JJ=0
DO 1445 I=1,9
IF (KLING2(I).LE.0.OR.HITVAL(I).EQ.0) GO TO 1445
V5=MAX0(V5,KLING2(I))
DELTAY=KLING1(I,2)-SECTCL
DELTAX=SECTRW-KLING1(I,1)
X=X+SQRT(DELTAY*DELTAY+DELTAX*DELTAX)
JJ=JJ+1
1445 CONTINUE
IF (JJ.EQ.0.OR.DAMAGE(4).LT.0.) GO TO 1451
N=MAX0(5,IFIX(V5*X/2.5))
IF (ENERGY.LE.N) GO TO 1451
N=N+10
PFLAG=1
WRITE (NOUT,1450) N
1450 FORMAT('+AVERAGE ENERGY TO PHASERS = ',I5/)
1451 IF (DAMAGE(2).LT.0..OR.TORPS.EQ.0.OR.DAMAGE(5).LT.0.
$.OR.JJ.LT.2) GO TO 236
MAXKIL=0
MAXSTR=0
MAXTRP=0
FSTANG=0
DO 1455 I=1,9
IF (KLING2(I).LE.0.OR.HITVAL(I).EQ.0) GO TO 1455
DELTAX=SECTRW-KLING1(I,1)
DELTAY=KLING1(I,2)-SECTCL
CALL WIDTH(DELTAX,DELTAY,ANGMIN,ANGMAX)
DO 1467 ANG1=ANGMIN,ANGMAX
ANGLE=MOD(ANG1,360)
CALL CHECK(ANGLE,CNTKIL,KILTRP,STRKIL)
IF (CNTKIL.LT.MAXKIL) GO TO 1467
IF (CNTKIL.GT.MAXKIL) GO TO 1470
IF (KILTRP.GT.MAXTRP) GO TO 1467
IF (KILTRP.LT.MAXTRP) GO TO 1470
IF (STRKIL.LE.MAXSTR) GO TO 1467
1470 MAXKIL=CNTKIL
MAXSTR=STRKIL
MAXTRP=KILTRP
FSTANG=ANGLE
1490 CONTINUE
1467 CONTINUE
1455 CONTINUE
IF (MAXKIL.LT.2) GO TO 236
ANGLE=FSTANG
SFLAG=1
WRITE (NOUT,1475) MAXTRP, ANGLE, MAXKIL, MAXSTR
1475 FORMAT('+A SPREAD OF ',I1,' TORPEDOES FIRED AT ',I3,
$' DEGREES'/' WILL HIT ',I1,' KLINGONS AND ',I1,' STARS.'/)
IF (CURDAT.GT.BEGDAT+AVADAT) GO TO 619
GO TO 236
1480 COMAND=-1
GO TO 236
C
1441 FSTANG=-1
MINWRP=12.
DELTAY=R2-QUADCL+(4.-SECTCL)/8.
DELTAX=QUADRW-R1+(SECTRW-4.)/8.
IF (DELTAX.EQ.0..AND.DELTAY.EQ.0.) GO TO 1440
IF (DAMAGE(2).LT.0.) GO TO 1449
CALL WIDTH(DELTAX,DELTAY,ANGMIN,ANGMAX)
DELTAX=R2-QUADCL+(1.-2*SECTCL)/16.
DELTAY=R1-QUADRW+(1.-2*SECTRW)/16.
DO 1446 ANG1=ANGMIN,ANGMAX
COURSE=MOD(ANG1,360)
L=0
CALL TRACK(COURSE,0,N,L,M)
IF ((L.GE.1.AND.L.LE.8).AND.(M.GE.1.AND.M.LE.8)) GO TO 1446
YYY=COURSE*PIE/180.
X=SIN(YYY)
Y=-COS(YYY)
IF (X.NE.0.) GO TO 1460
IF (R2.NE.QUADCL) GO TO 1446
XWARP=0.
GO TO 1461
1460 XWARP=AMIN1(DELTAX/X,(DELTAX+15./16.)/X)
1461 IF (Y.NE.0.) GO TO 1462
IF (QUADRW.NE.R1) GO TO 1446
YWARP=0.
GO TO 1463
1462 YWARP=AMIN1(DELTAY/Y,(DELTAY+15./16.)/Y)
1463 WARP=AMAX1(XWARP,YWARP)
IF (.NOT.(((WARP*X.GE.DELTAX.AND.WARP*X.LT.(DELTAX+1))
$.OR.(WARP*X.GE.(DELTAX+1).AND.WARP*X.LT.DELTAX))
$.AND.((WARP*Y.GE.DELTAY.AND.WARP*Y.LT.(DELTAY+1))
$.OR.(WARP*Y.GE.(DELTAY+1).AND.WARP*Y.LT.DELTAY))))
$GO TO 1446
IF (WARP.GE.MINWRP) GO TO 1446
MINWRP=WARP
FSTANG=MOD(COURSE,360)
1446 CONTINUE
IF (FSTANG.GE.0) GO TO 1442
WRITE (NOUT,1448)
1448 FORMAT('+NO UNBLOCKED COURSE TO THAT QUADRANT')
GO TO 1480
1426 WRITE (NOUT,1427)
1427 FORMAT('+NO UNBLOCKED COURSE TO THAT SECTOR')
GO TO 1480
C
1449 FSTANG=180.*ATAN2(DELTAY,DELTAX)/PIE+SIGN(.5,DELTAY)
MINWRP=SQRT(DELTAX*DELTAX+DELTAY*DELTAY)
1442 WARP=MINWRP
ENGINE=FSTANG
WRITE (NOUT,1452) ENGINE, WARP
GO TO 236
END
C C
C COMPUTE DAMAGE DONE BY A KLINGON ATACK
C
SUBROUTINE SB585
IMPLICIT INTEGER(A-Z)
REAL SQRT,RAN,XXX,DAMAGE,FLOAT,ATAN2,PIE,SIGN,
$DELTAX,DELTAY,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),KNOWN(14,14),CLOAK(8,8),
$KLING2(9),LOCATE(8,14,14),HITVAL(9),CDOL(2),
$MESSGE(4,3,3),DAMSTR(3,11),FLAGSH(3)
COMMON DAMSTR
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA DOCKED/'DOCKE'/
DATA PIE/3.1415926/
DATA NIN,NOUT/5,5/
DATA MESSGE/'ENTER','PRISE',' WILL',' DIE.',
$'SURRE','NDER ','OR DI','E! ',
$'GOODB','YE EN','TERPR','ISE. ',
$'GOT Y','OU CO','RNERE','D. ',
$'HAVE ','YOU H','AD EN','OUGH?',
$'LAST ','CHANC','E!!!!',' ',
$'YOURE',' GOIN','G TO ','DIE! ',
$'SURRE','NDER!',' ',' ',
$'SWEET',' DREA','MS. ',' '/
EN=ENERGY
Q=1
IF (CDOL(1).NE.DOCKED) Q=0
VV5=0
DO 617 I=1,9
HITVAL(I)=0
IF (KLING2(I).LE.0) GO TO 617
DELTAX=SECTRW-KLING1(I,1)
DELTAY=KLING1(I,2)-SECTCL
COURSE=180.*ATAN2(DELTAY,DELTAX)/PIE+SIGN(.5,DELTAY)
IF (COURSE.LT.0) COURSE=COURSE+360
V5=1
L=0
CALL TRACK(COURSE,0,N,L,M)
IF (L.NE.KLING1(I,1).OR.M.NE.KLING1(I,2).OR.
$(N.NE.2.AND.N.NE.6)) V5=0
VV5=VV5+V5
LOSS=V5*KLING2(I)*(2.+RAN(XXX))/
$SQRT(FLOAT(L-SECTRW)**2+FLOAT(M-SECTCL)**2)
HITVAL(I)=V5
L=KLING1(I,1)
M=KLING1(I,2)
CLOAK(L,M)=CLOAK(L,M)*V5
IF (Q.EQ.1.OR.V5.EQ.0) GO TO 617
WRITE (NOUT,601) LOSS
601 FORMAT(1X,I4,
$' UNIT HIT ON ENTERPRISE FROM KLINGON AT SECTOR ',$)
IF (CLOAK(L,M).EQ.0) GO TO 605
WRITE (NOUT,604) L,M
604 FORMAT('+',I1,',',I1)
GO TO 608
605 WRITE (NOUT,607)
607 FORMAT('+UNKNOWN')
608 IF (DEFLCT.LE.0) GO TO 615
DEFLCT=DEFLCT-LOSS
IF (DEFLCT.LE.0) GO TO 618
WRITE (NOUT,610) DEFLCT
610 FORMAT(' POWER LEFT IN DEFLECTORS = ',I4)
GO TO 617
618 WRITE (NOUT,612)
612 FORMAT(' DEFLECTORS DESTROYED')
LOSS=500-DEFLCT
DEFLCT=0
DAMAGE(7)=-50.
615 ENERGY=ENERGY-LOSS
EUSED=EUSED-LOSS
WRITE (NOUT,616) ENERGY
616 FORMAT(' (',I4,' LEFT)')
617 CONTINUE
IF (RAN(XXX).GT..03) GO TO 2010
LOSS=300.*RAN(XXX)
WRITE (NOUT,2020) LOSS
2020 FORMAT(1X,I4,
$' UNIT HIT ON ENTERPRISE FROM KLINGON SPACE MINE')
IF (DEFLCT.LE.0) GO TO 2030
DEFLCT=DEFLCT-LOSS
WRITE (NOUT,610) DEFLCT
IF (DEFLCT.GE.0) GO TO 2010
WRITE (NOUT,612)
LOSS=500-DEFLCT
DEFLCT=0
DAMAGE(7)=-50.
2030 ENERGY=ENERGY-LOSS
EUSED=EUSED-LOSS
WRITE (NOUT,616) ENERGY
2010 IF (VV5.EQ.0) RETURN
IF (ENERGY.LE.100) GO TO 3025
IF (DAMAGE(4).LT.0) GO TO 3010
IF (ENERGY.GE.1000) GO TO 2040
3010 IF (DAMAGE(5).LT.0) GO TO 3020
IF (TORPS.GE.5) GO TO 2040
3020 IF (EN.EQ.ENERGY) GO TO 2040
3025 IF (Q.NE.0) GO TO 2040
IF (ENERGY.LE.0) GO TO 2040
IF (DAMAGE(1).LT.0.OR.DAMAGE(11).LT.0) GO TO 3030
IF (RAN(XXX).GE..6) GO TO 2050
3030 IMESS=IMESS+1
IF (IMESS.EQ.4) IMESS=3
TEMP=RAN(XXX)
K=1
IF (TEMP.GE..333) K=2
IF (TEMP.GE..666) K=3
WRITE (NOUT,2012)
2012 FORMAT(1X,' MESSAGE FROM KLINGON COMMANDER:')
WRITE (NOUT,2014) (MESSGE(J,IMESS,K),J=1,4)
2014 FORMAT (1X,4A5)
GO TO 2050
2040 IMESS=0
2050 IF (RAN(XXX).GT..07.OR.DEFLCT.GT.0.OR.Q.NE.0) GO TO 2060
IF (LOSS+LOSS*RAN(XXX).LT.100) GO TO 2060
R1=11.5*RAN(XXX)
L=(BEGDAT+AVADAT-CURDAT)*2
YYY=AMIN1(RAN(XXX)*L/(10.*TOTENE)+FLOAT(LOSS/300)+1.,6.)
DAMAGE(R1)=AMAX1(DAMAGE(R1)-YYY,-10.)
WRITE (NOUT,2055) (DAMSTR(I,R1),I=1,3)
2055 FORMAT (' *** ',3A5,' DAMAGED ***')
2060 IF (Q.EQ.0) RETURN
WRITE (NOUT,589)
589 FORMAT(' STARBASE SHIELDS PROTECT THE ENTERPRISE')
RETURN
END
C C
C DECLARE A TRUCE AND EFFECT REPAIRS
C
SUBROUTINE SB320
IMPLICIT INTEGER(A-Z)
REAL RAN,XXX,DAMAGE,AMIN1,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),KNOWN(14,14),CLOAK(8,8),DAMSTR(3,11),
$KLING2(9),LOCATE(8,14,14),HITVAL(9),CDOL(2),
$FLAGSH(3)
COMMON DAMSTR
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA NIN,NOUT/5,5/
DO 350 I=1,11
IF (DAMAGE(I).NE.0) GO TO 355
350 CONTINUE
GO TO 4500
355 WRITE (NOUT,320)
320 FORMAT(' *** EMERGENCY REPAIRS EFFECTED ***')
DO 323 I=1,11
IF (DAMAGE(I).EQ.0.) GO TO 323
DAMAGE(I)=AMIN1(DAMAGE(I)+RAN(XXX)*6.+1.,0.)
WRITE (NOUT,327) (DAMSTR(J,I),J=1,3)
327 FORMAT(1X,3A5,' STATE OF REPAIR IMPROVED ***')
323 CONTINUE
4500 DO 332 I=1,9
IF (KLING2(I).LE.0) GO TO 332
KLING2(I)=200
332 CONTINUE
IF (FLAGSH(1).NE.QUADRW.OR.FLAGSH(2).NE.QUADCL) RETURN
KLING2(FLAGSH(3))=400
RETURN
END
C C
C SET UP CONDITION OF ENTERPRISE
C
SUBROUTINE SB171(IFLAG)
IMPLICIT INTEGER(A-Z)
REAL RAN,XXX,DAMAGE,AMIN1,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),KNOWN(14,14),CLOAK(8,8),
$KLING2(9),LOCATE(8,14,14),HITVAL(9),CDOL(2),GREEN(2),
$AMBER(2),RED(2),DOCKED(2),FLAGSH(3)
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA DOCKED/'DOCKE','D'/
DATA GREEN/'GREEN',' '/
DATA AMBER/'AMBER',' '/
DATA RED/'RED',' '/
IIL=MAX0(SECTRW-1,1)
IIH=MIN0(SECTRW+1,8)
JJL=MAX0(SECTCL-1,1)
JJH=MIN0(SECTCL+1,8)
DO 179 I=IIL,IIH
DO 179 J=JJL,JJH
IF (QUADRT(I,J).NE.3) GO TO 179
CDOL(1)=DOCKED(1)
CDOL(2)=DOCKED(2)
EUSED=EUSED+STENEG-ENERGY
PUSED=PUSED+STTORP-TORPS
IF (COMAND.EQ.0) BUSED=BUSED+1
ENERGY=STENEG
TORPS=STTORP
IF (IFLAG.EQ.0) GO TO 187
DO 175 K=1,11
175 IF (DAMAGE(K).LT.0.) DAMAGE(K)=AMIN1(DAMAGE(K)+1.,0.)
GO TO 187
179 CONTINUE
IF (ENEMYS.GT.0) GO TO 184
IF (ENERGY.LT.IFIX(STENEG*.4)) GO TO 186
CDOL(1)=GREEN(1)
CDOL(2)=GREEN(2)
GO TO 187
184 CDOL(1)=RED(1)
CDOL(2)=RED(2)
GO TO 187
186 CDOL(1)=AMBER(1)
CDOL(2)=AMBER(2)
187 RETURN
END
C
C
C 0 IF X.GE.Y, 1 IF X.LT.Y
C
FUNCTION XLTY(X,Y)
INTEGER XLTY
REAL X,Y
XLTY=0
IF (X.LT.Y) XLTY=1
RETURN
END
C
C
C FIGURE MAXIMUM ACCEPTANCE ANGLE TO A SECTOR
C
SUBROUTINE WIDTH(DELTAX,DELTAY,ANGMIN,ANGMAX)
IMPLICIT INTEGER(A-Z)
REAL ATAN2,SIGN,PI,DELTAX,DELTAY,DELTA1,DELTA2,ROUND
DATA PI/3.1415926/
DELTA1=SIGN(.5,DELTAX)
DELTA2=SIGN(.5,DELTAY)
ANGMIN=ROUND(180.*ATAN2(DELTAY-DELTA1,DELTAX+DELTA2)/PI)
ANGMAX=ROUND(180.*ATAN2(DELTAY+DELTA1,DELTAX-DELTA2)/PI)
ANGMIN=MOD(ANGMIN,360)
ANGMAX=MOD(ANGMAX,360)
IF (ANGMAX.LT.ANGMIN) ANGMAX=ANGMAX+360
RETURN
END
C
C
C ROUND A REAL NUMBER
C
REAL FUNCTION ROUND(VAL)
ROUND=VAL+SIGN(.5,VAL)
RETURN
END
C
C
C DO A REAL "MOD"
C
INTEGER FUNCTION MOD(NUM,MDLS)
IMPLICIT INTEGER(A-Z)
MOD=NUM-(NUM/MDLS)*MDLS
IF (MOD.LT.0) MOD=MOD+MDLS
RETURN
END
C
C DO ALL THE WORK OF SAVING FILES
C
LOGICAL FUNCTION SAVRES(INOUT,NAME)
IMPLICIT INTEGER(A-Z)
REAL RAN,XXX,DAMAGE,AMIN1,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),KNOWN(14,14),CLOAK(8,8),
$KLING2(9),LOCATE(8,14,14),HITVAL(9),CDOL(2),GREEN(2),
$AMBER(2),RED(2),DOCKED(2),FLAGSH(3)
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
SAVRES=.FALSE.
IF (INOUT.EQ.1) GO TO 100
CALL OFILE(21,NAME)
WRITE (21) CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
ENDFILE 21
GO TO 999
100 CALL IFILE(21,NAME)
READ(21,ERR=1000) CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
999 SAVRES=.TRUE.
1000 RETURN
END
C C
C TRACE OUT A PATH
C
SUBROUTINE TRACK(COURSE,IFLAG,N,JJ,KK)
IMPLICIT INTEGER(A-Z)
REAL FLOAT,X,Y,COS,SIN,YYY,SQRT,AMIN1,ATAN2,PIE,
$DELTAX,DELTAY,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),
$KLING1(9,2),KNOWN(14,14),CLOAK(8,8),KLING2(9),
$LOCATE(8,14,14),HITVAL(9),CDOL(2),FLAGSH(3)
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA PIE/3.1415926/
DATA NIN,NOUT/5,5/
N=0
YYY=COURSE*PIE/180.
DELTAX=SIN(YYY)/2.
DELTAY=-COS(YYY)/2.
X=SECTRW
Y=SECTCL
IF (IFLAG.EQ.1) WRITE (NOUT,442)
442 FORMAT(' TORPEDO TRACK: ',$)
L=SECTRW
M=SECTCL
443 X=X+DELTAY
Y=Y+DELTAX
IF (L.EQ.IFIX(X+.5).AND.M.EQ.IFIX(Y+.5)) GO TO 443
L=X+.5
M=Y+.5
IF (L.LT.1.OR.L.GT.8.OR.M.LT.1.OR.M.GT.8) GO TO 474
IF (IFLAG.EQ.1) WRITE (NOUT,446) L,M
446 FORMAT('+',I1,',',I1,2X,$)
N=QUADRT(L,M)
IF (L.EQ.JJ.AND.M.EQ.KK) GO TO 474
IF (N.EQ.0) GO TO 443
JJ=L
KK=M
474 RETURN
END
C C
C SEE WHAT DAMAGE A SPRAY OF TORPS CAN DO
C
SUBROUTINE CHECK(ANGLE,CNTKIL,KILTRP,STRKIL)
IMPLICIT INTEGER(A-Z)
REAL RAN,XXX,DAMAGE,AMIN1,TT,RATING
DIMENSION GALAXY(14,14),QUADRT(8,8),DAMAGE(11),KLING1(9,2),
$KNOWN(14,14),CLOAK(8,8),KLING2(9),LOCATE(8,14,14),
$HITVAL(9),CDOL(2),FLAGSH(3)
COMMON/VARIAB/CDOL,XXX,QUADRW,QUADCL,SECTRW,SECTCL,
$ENERGY,STENEG,TORPS,ENEMYS,DEFLCT,DAMAGE,SHOMOD,KLING1,
$KLING2,QUADRT,CLOAK,GALAXY,GALSIZ,LONMOD,PRTY,
$BOARD,SHUSIG,BEGDAT,CURDAT,KNOWN,STTORP,
$KLGMAX,TOTBAS,TOTENE,BASES,STARS,STTOTE,AVADAT,LOCATE,
$PROBES,SENFST,SENFLG,TRNFLG,COMFLG,HITVAL,PTYROW,
$PTYCOL,LQUADR,LQUADC,GAMES,WINS,RATING,TT,IMESS,STAMOD,
$EUSED,PUSED,BUSED,FLAGSH
DATA NIN,NOUT/5,5/
CNTKIL=0
CNTSTR=0
C KILTRP IS A COUNT OF THE NUMBER OF TORPEDOES REQUIRED TO KILL
C CNTKIL KLINGONS.
KILTRP=0
C STRKIL COUNTS THE NUMBER OF STARS THAT WILL BE HIT BY KILTRP
C TORPEDOES.
STRKIL=0
C KILTRP=CNTKIL+STRKIL+MISSES
DO 60 J=1,8
IF (TORPS.LT.J) GO TO 59
K=MOD(ANGLE+45*(J-1),360)
IF (J.EQ.1) GO TO 65
LL=0
CALL TRACK(K,0,II,LL,MM)
IF (LL.EQ.L.AND.MM.EQ.M) GO TO 60
L=LL
M=MM
MM=II
GO TO 66
C
65 L=0
CALL TRACK(K,0,MM,L,M)
IF (MM.LE.0.AND.J.EQ.1) GO TO 59
66 IF (MM.LE.0) GO TO 60
IF (MM.EQ.2) GO TO 53
IF (MM.EQ.3) GO TO 59
IF (MM.GE.4) GO TO 56
WRITE (NOUT,57)MM
57 FORMAT(' PROGRAM ERROR 57. MM = ',I2//)
STOP
56 IF (MM.NE.6) CNTSTR=CNTSTR+1
GO TO 60
53 IF (J.NE.8) GO TO 54
LL=0
CALL TRACK(ANGLE,0,II,LL,MM)
IF (LL.EQ.L.AND.MM.EQ.M) GO TO 60
54 CNTKIL=CNTKIL+1
KILTRP=J
STRKIL=CNTSTR
60 CONTINUE
59 RETURN
END
C
Reference in New Issue View Git Blame Copy Permalink