SUBROUTINE PHOTON CALL PHOTNT(1) RETURN END SUBROUTINE KPHOTN CALL PHOTNT(2) RETURN END SUBROUTINE PHOTNT(IZ) INCLUDE 'TREK.COM/-LI' INCLUDE 'TREK2.COM/-LI' REAL*8 AITEM COMMON/SCANBF/KEY,AITEM EQUIVALENCE (FNUM,AITEM),(SHIP,ISHIP) DIMENSION TARG(3,2), COURSE(3) REAL KP INTEGER BOT,TOP,TOP2 EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT) EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) DATA IHDOC/'DO'/ C--------CHECK TORPEDO COUNT AND STATUS OF PHOTON TUBES GOTO (1001,1002),IZ 1001 IDIDIT=1 KSHOT=0 IF(DAMAGE(4) .EQ. 0)GO TO 10 CALL PROUT(21HPHOTON TUBES DAMAGED.,21) GO TO 3005 10 IF(TORPS .NE.0)GO TO 15 CALL PROUT(18HNO TORPEDOES LEFT.,18) GO TO 3005 C--------SCAN AND MAKE SENSE OF COMMAND INPUT LINE 15 CALL SCAN TEMP=FNUM N = TEMP + 0.5 IF(KEY .EQ. IHREAL) GO TO 30 16 CALL CRAMI(TORPS,0) CALL CRMDMP(16H TORPEDOES LEFT.) CALL PROMPT(30HNUMBER OF TORPEDOES TO FIRE: ,30) GO TO 15 30 IF(N .LE. 0) GO TO 3005 IF(N .LE. 3) GO TO 31 CALL PROUT(33HMAXIMUM OF 3 TORPEDOES PER BURST.,33) GO TO 16 3004 CALL BEGPRD 3005 IDIDIT=0 RETURN 31 IF(N .LE. TORPS) GO TO 32 GO TO 16 C--------ALL TORPEDOES FIRED AT SAME SPOT. 3101 DO 3102 I=2,N TARG(I,1)=TARG(1,1) 3102 TARG(I,2)=TARG(1,2) GO TO 36 C--------READ IN TARGET SECTORS 32 DO 33 I=1,N CALL SCAN TARG(I,1)=FNUM IF((I.EQ.1) .AND. (KEY.EQ.IHEOL)) GO TO 34 IF((I .EQ. 2) .AND. (KEY .EQ. IHEOL)) GO TO 3101 IF (KEY .NE. IHREAL) GO TO 3004 CALL SCAN TARG(I,2)=FNUM 33 IF (KEY .NE. IHREAL) GO TO 3004 GO TO 36 34 DO 35 I=1,N CALL CHEW CALL CRAM (33HTARGET SECTOR FOR TORPEDO NUMBER ) CALL CRAMI(I,0) CALL CRAM(3H: ) CALL CRNDNO CALL SCAN TARG(I,1)=FNUM IF (KEY .NE. IHREAL) GO TO 3004 CALL SCAN TARG(I,2)=FNUM 35 IF( KEY .NE. IHREAL) GO TO 3004 C--------CHECK FOR INVALID TARGETS. 36 DO 37 I=1,N DO 37 J=1,2 TEMP = TARG(I,J) IF(TEMP.EQ.-1.) GO TO 3005 37 IF ((TEMP .LT. 0.999) .OR. (TEMP .GT. 10.001)) GO TO 3004 C--------COMPUTE COURSE FOR EACH TORPEDO. DO 40 I=1,N DELTX = 0.1*(TARG(I,2)-SECTY) DELTY=0.1*(SECTX-TARG(I,1)) C--------DO NOT ALLOW ENTERPRISE TO SHOOT A TORPEDO AT ITSELF. IF((DELTX .NE. 0) .OR. (DELTY .NE. 0)) GO TO 40 CALL SKIP(1) CALL PROUT(41HSPOCK: "BRIDGE TO SICKBAY. DR. MC COY, ,41) CALL PROUT(36H I RECOMMEND AN IMMEDIATE REVIEW OF,36) CALL PROUT(41H THE CAPTAIN'S PSYCHOLOGICAL PROFILE." ,41) GO TO 3005 40 COURSE (I) = 1.90985932*ATAN2(DELTX,DELTY) C--------BEGIN OUTER LOOP FOR MOVING TORPEDOES I=0 50 I=I+1 IF(I .GT. N) GO TO 115 IF(CONDIT .NE. IHDOC ) TORPS=TORPS-1 J=I STARTX=SECTX STARTY=SECTY R=(RANF(0)+RANF(0))*0.5 -0.5 IF(ABS(R) .LT. 0.49) GO TO 5709 R=(RANF(0)+1.2)*R C-------- TORPEDO MISFIRES IF(N.GT.1) GO TO 5706 CALL PROUT(21H***TORPEDO MISFIRES. ,21) GO TO 5707 5706 CALL CRAM(18H***TORPEDO NUMBER ) CALL CRAMI(I,0) CALL CRMDMP(10H MISFIRES.) IF(I . LT. N) CALL PROUT(31H REMAINDER OF BURST ABORTED. ,31) I=N 5707 IF(RANF(0.) .GT. .200000)GO TO 5709 C------- CHECK IF MISFIRE DOES SHIP DAMAGE. IF SO DON'T GIVE TRACK. CALL PROUT(35H***PHOTON TUBES DAMAGED BY MISFIRE.,35) DAMAGE(4)=DAMFAC*(1.0+2.0*RANF(0)) GO TO 115 5709 IF(SHLDUP.NE.0 .OR. CONDIT.EQ.IHDOC ) R=R+0.001*SHLD*R AC=COURSE(I)+0.25*R GO TO 5710 C* C ENTRY KPHOTON C* C----------- SET FLAG FOR KLINGON C--------ENEMY FIRES PHOTON TORPEDO 1002 IX=KX(KSHOT) IY=KY(KSHOT) I=1 N=1 STARTX=IX STARTY=IY DELTX=0.1*(SECTY-STARTY) DELTY=0.1*(STARTX-SECTX) AC=1.90985932*ATAN2(DELTX,DELTY) TEMP=RANF(0)-0.5 R=TEMP*(1.0+0.001*KPOWER(KSHOT))+RANF(0.)*TEMP AC=AC+0.25*R IQUAD=QUAD(IX,IY) CALL CRMSNA(IQUAD,0,IX,IY) CALL CRMDMP(22H FIRES PHOTON TORPEDO. ) C--------CHECK FOR KLINGON MISFIRE IF(ABS(TEMP) .LT. 0.45) GO TO 5710 C--------ENEMY TORPEDO MISFIRED. DETERMINE DAMAGE. ANGLE=(15.0-AC)*0.5235988 HIT=200.0 + 600.0*RANF(0) LL=KSHOT CALL PROUT(21H***TORPEDO MISFIRES! ,21) GO TO 68 5710 ANGLE=(15.0-AC)*0.5235988 IF(N .EQ. 1)GO TO 58 CALL SKIP(1) CALL CRAM(25HTRACK FOR TORPEDO NUMBER ) CALL CRAMI(J,0) 5720 CALL CRAM(6H: ) GO TO 59 58 CALL SKIP(1) CALL CRAM(15HTORPEDO TRACK: ) 59 DELTAX=-SIN(ANGLE) DELTAY=COS(ANGLE) BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY)) DELTAX=DELTAX/BIGGER DELTAY=DELTAY/BIGGER X=STARTX Y=STARTY C--------BEGIN INNER LOOP FOR MOVING A SINGLE TORPEDO L=0 5910 L=L+1 X=X+DELTAX IX=X+0.5 IF(IX .LT. 1 .OR. IX .GT. 10)GO TO 105 Y=Y+DELTAY IY=Y+0.5 IF(IY .LT. 1 .OR. IY .GT. 10)GO TO 105 IF(L .EQ. 4 .OR. L .EQ. 9)CALL CREND CALL CRAMF(X,0,1) CALL CRAM(3H - ) CALL CRAMF(Y,0,1) CALL CRAM(3H ) IQUAD=QUAD(IX,IY) IF(IQUAD.EQ.IHDOT) GOTO 5910 C--------BEGIN HIT CHECKS CALL CREND C--------COMPUTE EXACT ANGLE TO SECTOR HIT, DISTANCE TO SECTOR HIT, C NORMAL MISS DISTANCE, AND HIT DIST=SQRT((STARTX-IX)**2 + (STARTY-IY)**2) DELTX=0.1*(IY-STARTY) DELTY=0.1*(STARTX-IX) BULLSI=1.90985932*ATAN2(DELTX,DELTY) BULLSI=(15.0-BULLSI)*0.5235988 SINANG=SIN(ANGLE-BULLSI) DISTN=ABS(SINANG) * DIST HIT=700.0+100.0*RANF(0)-1000.0*DISTN C--------TEST FOR AND COPE WITH HIT ON KLINGON,ROMULAN, OR COMMANDER. IF(IQUAD .EQ. IHK .OR. IQUAD .EQ. IHR) GO TO 62 IF(IQUAD .NE. IHC .AND. IQUAD .NE. IHS) GO TO 70 IF(RANF(0) .GT. 0.05) GO TO 62 CALL CRMSNA(IQUAD,2,IX,IY) CALL CRMDMP(25H USES ANTI-PHOTON DEVICE;) CALL PROUT(23H TORPEDO NEUTRALIZED.,3) GO TO 50 62 DO 65 LL=1,NENHER IF(IX.EQ.KX(LL) .AND. IY.EQ.KY(LL)) GO TO 68 65 CONTINUE 68 KP=KPOWER(LL) KPOWER(LL)=KP-SIGN(AMIN1(ABS(KP),HIT),KP) IF(KPOWER(LL) .NE. 0.0) GO TO 69 CALL DEADKL(IX,IY,IQUAD,IX,IY) GO TO 50 69 CALL CRMSNA(IQUAD,2,IX,IY) C--------IF ENEMY DAMAGED BUT NOT DESTROYED, TRY TO DISPLACE HIM 6901 ANG=ANGLE + 2.5*(RANF(0)-0.5) TEMP=AMAX1(ABS(-SIN(ANG)),ABS(COS(ANG))) XX=-SIN(ANG) / TEMP YY= COS(ANG) / TEMP JX=IX+XX+0.5 JY=IY+YY+0.5 IF(JX.LT.1 .OR. JX.GT.10 .OR. JY.LT.1 .OR. JY.GT.10) GO TO 6905 IF(QUAD(JX,JY) .NE. IHBLNK) GO TO 6903 C--------SOMEONE FALLS INTO A BLACK HOLE CALL CRMDMP(26H BUFFETED INTO BLACK HOLE.) IF(IQUAD .NE.ISHIP) GO TO 6902 CALL FINISH(21) RETURN 6902 CALL DEADKL(IX,IY,IQUAD,JX,JY) GO TO 50 6903 IF(QUAD(JX,JY) .NE. IHDOT) GO TO 6905 QUAD(JX,JY)=IQUAD QUAD(IX,IY)=IHDOT CALL CRMDMP(10H DAMAGED--) CALL CRAM(24H DISPLACED BY BLAST TO) CALL CRMLOC(2,JX,JY) CALL CREND IF(IQUAD .NE.ISHIP) GO TO 6904 C------STARSHIP DISPLACED BY TORPEDO. MOVE IT AND RESET ENEMY DISTANCES SECTX=JX SECTY=JY CALL RESETD GO TO 50 C--------ENEMY DISPLACED BY PHOTON BLAST 6904 KX(LL)=JX KY(LL)=JY KDIST(LL)= SQRT(FLOAT((SECTX-JX)**2 + (SECTY-JY)**2)) GO TO 50 6905 CALL CRMDMP(27H DAMAGED BUT NOT DESTROYED.) GO TO 50 C--------TEST FOR AND COPE WITH HIT ON A STARBASE 70 IF(IQUAD.NE.IHT) GO TO 7002 CALL CRMSNA(IHT,2,IX,IY) IF(HIT.LT.600) GO TO 7001 CALL CRAM(11H DESTROYED. ) CALL CREND QUAD(IX,IY)=IHDOT ITHERE=0 ITHX=0 ITHY=0 GO TO 50 7001 X=RANF(0) IF(X.GT.0.05) CALL CRMDMP(25H SURVIVES PHOTON BLAST. ) IF(X.GT.0.05) GO TO 50 CALL CRAM(12H DISAPEARS. ) QUAD(IX,IY)=IHNUM CALL DROPIN(IHBLNK,DUM,MY) ITHERE=0 GO TO 50 7002 IF(IQUAD.NE.IHNUM) GOTO 7005 CALL PROUT(35H***TORPEDO ABSORBED BY THOLIAN WEB. ,35) GOTO 50 7005 IF(IQUAD.NE.IHB) GO TO 75 CALL CRMSNA(IHB,2,IX,IY) IF(HIT .LT. 600.0) GO TO 7510 CALL CRAM(12H DESTROYED ) IF(IPHWHO.NE.1) CALL CRAM(21H.... CONGRATULATIONS ) CALL CREND IF(STARCH(QUADX,QUADY) .LT. 0) STARCH(QUADX,QUADY)=0 DO 71 LLL=1,RMBASE IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 71 BASEQX(LLL)=BASEQX(RMBASE) BASEQY(LLL)=BASEQY(RMBASE) 71 CONTINUE QUAD(IX,IY)=IHDOT RMBASE=RMBASE-1 BASEX=0 BASEY=0 GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10 IF(IPHWHO.NE.1) BASEKL=BASEKL+1 CALL NUCOND GO TO 50 C--------TEST FOR AND COPE WITH A HIT ON A PLANET. 75 IF(IQUAD .NE. IHP) GO TO 80 CALL CRMSNA(IHP,2,IX,IY) IF(HIT .GT. 450.0) GO TO 7520 7510 CALL CRMDMP(23H SURVIVES PHOTON BLAST.) GO TO 50 7520 CALL CRMDMP(11H DESTROYED. ) NPLNKL=NPLNKL+1 NUSTUF(QUADX,QUADY)=NUSTUF(QUADX,QUADY)-1 DO 76 II=1,5 76 PLNETS(IPLNET,II)=0 IPLNET=0 PLNETX=0 PLNETY=0 QUAD(IX,IY)=IHDOT IF(LANDED .NE. 1) GO TO 50 C--------CAPTAIN PERISHES ON PLANET. CALL FINISH(15) RETURN 80 IF(IQUAD .NE. IHSTAR) GO TO 90 C--------STAR HIT - CHECK FOR NOVA RESULTS IF(HIT.GT.270.0) GO TO 85 CALL CRMSNA(IHSTAR,2,IX,IY) CALL CRMDMP(28H UNAFFECTED BY PHOTON BLAST.) GO TO 50 85 CALL NOVA(IX,IY) IF(GALAXY(QUADX,QUADY) .EQ. 1000) RETURN IF(ALLDON.NE.0) RETURN GO TO 50 C--------CHECK FOR A BOOMERANG TORPEDO 90 IF(IQUAD .NE.ISHIP) GO TO 93 IF(CONDIT.NE.IHDOC) GO TO 9010 IF(RANF(0).GT.0.77) GO TO 9010 CALL CRAM(27H STAR BASE SHIELDS PROTECT ) CALL CRMSHP CALL CREND GO TO 50 9010 CALL CRM3AS CALL CRMSHP CALL CRMDMP(27H BLASTED BY PHOTON TORPEDO! ) CALL NUCOND CALL ZAP IF(ENERGY .GT. 0.0) GO TO 91 IF(KSHOT.NE.0) GO TO 9020 CALL FINISH(22) RETURN 9020 CALL FINISH(5) RETURN 91 CALL CASULT C--------CHECK TO SEE IF SHIP DISPLACED CALL CRMSHP GO TO 6901 C--------CHECK FOR HIT ON THING. 93 IF(IQUAD .NE. IHQUST) GO TO 95 CALL SKIP(1) CALL PROUT( + 55H"AAAAIIIIIEEEEEEEEEAAAAAAAAUUUUUGGGGGHHHHHHHHHHHHHHH!!!,55) CALL PROUT( + 48H HACK! HACK! HACK! *CHOKE!* ",48) CALL SKIP(1) CALL PROUT(26HMR. SPOCK: "FASCINATING!",26) QUAD(IX,IY)=IHDOT GO TO 50 C--------TORPEDO ENTERS VICINITY OF BLACK HOLE. CHECK FOR DEFLECTION 95 CALL CRMSNA(IHBLNK,2,IX,IY) IF(DISTN .LT. 0.1) GO TO 97 C--------BOING. COMPUTE DEFLECTION ANGLE, AND NEW STARTING POINT SPRANG=(0.5-DISTN) * 7.853981634 BETA=1.57079633 + ANGLE - SPRANG STARTX = IX-DISTN*SIN(BETA) STARTY = IY+DISTN*COS(BETA) ANGLE = ANGLE - SIGN(SPRANG,SINANG) CALL CRMDMP(18H DEFLECTS TORPEDO. ) CALL CRAM(9HNEW TRACK) GO TO 5720 97 CALL CRMDMP(18H SWALLOWS TORPEDO.) GO TO 50 C--------END INNER LOOP FOR MOVING ONE TORPEDO 105 CALL CREND 106 CALL PROUT(15HTORPEDO MISSED.,15) GO TO 50 115 IF(REMKL .EQ. 0) CALL FINISH(1) IF(KSHOT .EQ. 0) CALL SORTKL RETURN END