SUBROUTINE PHOTNT(KMISF, INITX, INITY, AC) C*BEGIN COMMON COMMON SNAP,SNAPSHT(247), + DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, + KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), + NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, + NSCKILL,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY, + QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), + FUTURE(10),MESSAGE(5,10), + INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, + INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, + QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), + LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, + KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8), + DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, + DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET, + IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, + IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO, + CRACKS(12) INTEGER SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS, + REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, + SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, + ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, + THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD, + INENRG,INLSR BYTE QUAD REAL*8 DEVICE,PASSWD C*END COMMON LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB + ,IHSTAR,IHT,IHQUEST,IHNUM,IQUAD,ISHIP COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM REAL*8 AITEM COMMON/SCANBF/KEY,AITEM EQUIVALENCE (FNUM,AITEM),(SHIP,ISHIP) DIMENSION TARG(3,2), COURSE(3) REAL KP EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT) EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) IX=INITX IY=INITY IQUAD=QUAD(IX,IY) STARTX=IX STARTY=IY C--------ENEMY TORPEDO MISFIRED. DETERMINE DAMAGE. ANGLE=(15.0-AC)*0.5235988 IF(KMISF .EQ. 0) GO TO 58 HIT=200.0 + 600.0*RANF(0) LL=KSHOT CALL PROUT(21H***TORPEDO MISFIRES! ,21) GO TO 68 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(MOD(L,5) .EQ. 4)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) BULSEYE=1.90985932*ATAN2(DELTX,DELTY) BULSEYE=(15.0-BULSEYE)*0.5235988 SINANG=SIN(ANGLE-BULSEYE) 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 CRMSENA(IQUAD,2,IX,IY) CALL CRAMDMP(25H USES ANTI-PHOTON DEVICE;) CALL PROUT(23H TORPEDO NEUTRALIZED.,23) RETURN 62 DO 65 LL=1,NENHERE 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) RETURN 69 CALL CRMSENA(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. IHBLANK) GO TO 6903 C--------SOMEONE FALLS INTO A BLACK HOLE CALL CRAMDMP(26H BUFFETED INTO BLACK HOLE.) IF(IQUAD .NE.ISHIP) GO TO 6902 CALL HOLE(JX,JY) RETURN 6902 CALL DEADKL(IX,IY,IQUAD,JX,JY) RETURN 6903 IF(QUAD(JX,JY) .NE. IHDOT) GO TO 6905 QUAD(JX,JY)=IQUAD QUAD(IX,IY)=IHDOT CALL CRAMDMP(10H DAMAGED--) CALL CRAM(24H DISPLACED BY BLAST TO) CALL CRAMLOC(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 RETURN C--------ENEMY DISPLACED BY PHOTON BLAST 6904 KX(LL)=JX KY(LL)=JY KDIST(LL)=SQRT(FLOAT((SECTX-JX)**2 + (SECTY-JY)**2)) RETURN 6905 CALL CRAMDMP(27H DAMAGED BUT NOT DESTROYED.) RETURN C--------TEST FOR AND COPE WITH HIT ON A STARBASE 70 IF(IQUAD.NE.IHT) GO TO 7002 CALL CRMSENA(IHT,2,IX,IY) IF(HIT.LT.600) GO TO 7001 CALL CRAMDMP(11H DESTROYED.) QUAD(IX,IY)=IHDOT ITHERE=0 ITHX=0 ITHY=0 RETURN 7001 IF(RANF(0).GT.0.05) GO TO 7510 CALL CRAM(12H DISAPPEARS. ) QUAD(IX,IY)=IHNUM CALL DROPIN(IHBLANK,JX,JY) ITHERE=0 RETURN 7002 IF(IQUAD.NE.IHNUM) GOTO 7005 CALL PROUT(35H***TORPEDO ABSORBED BY THOLIAN WEB. ,35) RETURN 7005 IF(IQUAD.NE.IHB) GO TO 75 CALL CRMSENA(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)=-2 DO 71 LLL=1,REMBASE IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 71 BASEQX(LLL)=BASEQX(REMBASE) BASEQY(LLL)=BASEQY(REMBASE) 71 CONTINUE QUAD(IX,IY)=IHDOT REMBASE=REMBASE-1 BASEX=0 BASEY=0 GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10 IF(IPHWHO.NE.1) BASEKL=BASEKL+1 CALL NEWCOND RETURN C--------TEST FOR AND COPE WITH A HIT ON A PLANET. 75 IF(IQUAD .NE. IHP) GO TO 80 CALL CRMSENA(IHP,2,IX,IY) IF(HIT .GT. 450.0) GO TO 7520 7510 CALL CRAMDMP(23H SURVIVES PHOTON BLAST.) RETURN 7520 CALL CRAMDMP(11H DESTROYED. ) IF(IPHWHO.NE.1) NPLANKL=NPLANKL+1 NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY)-1 DO 76 II=1,5 76 PLNETS(IPLANET,II)=0 IPLANET=0 PLNETX=0 PLNETY=0 QUAD(IX,IY)=IHDOT C--------CAPTAIN PERISHES ON PLANET. IF(LANDED .EQ. 1) 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 CRMSENA(IHSTAR,2,IX,IY) CALL CRAMDMP(28H UNAFFECTED BY PHOTON BLAST.) RETURN 85 CALL NOVA(IX,IY) RETURN C--------CHECK FOR A BOOMERANG TORPEDO 90 IF(IQUAD .NE.ISHIP) GO TO 93 IF(CONDIT.NE.IHDOCKD .OR. RANF(0).GT.0.77) GO TO 9010 CALL CRAM(26H STARBASE SHIELDS PROTECT ) CALL CRAMSHP CALL CREND RETURN 9010 CALL CRAM3AS CALL CRAMSHP CALL CRAMDMP(27H BLASTED BY PHOTON TORPEDO! ) CALL NEWCOND 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 CASULTY C--------CHECK TO SEE IF SHIP DISPLACED CALL CRAMSHP GO TO 6901 C--------CHECK FOR HIT ON THING. 93 IF(IQUAD .NE. IHQUEST) 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 RETURN C--------TORPEDO ENTERS VICINITY OF BLACK HOLE. CHECK FOR DEFLECTION 95 CALL CRMSENA(IHBLANK,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 CRAMDMP(18H DEFLECTS TORPEDO. ) CALL CRAM(11HNEW TRACK: ) GO TO 58 97 CALL CRAMDMP(18H SWALLOWS TORPEDO.) RETURN C--------END INNER LOOP FOR MOVING ONE TORPEDO 105 CALL CREND 106 CALL PROUT(15HTORPEDO MISSED.,15) RETURN END