SUBROUTINE SNOVA(INSX,INSY) 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 COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM INTEGER COMDEAD,SENT EQUIVALENCE (CRACKS(8),SENT) NSX=INSX NSY=INSY C--------IF SCHEDULED SUPERNOVA (INSX=INSY=0), SELECT STAR IF(INSX.NE.0) GO TO 50 NUM=RANF(0)*INSTAR+1 DO 10 NQX=1,8 DO 10 NQY=1,8 NUM=NUM-MOD(GALAXY(NQX,NQY),10) IF(NUM .LE. 0) GO TO 20 10 CONTINUE C--------IF STAR IS ALREADY GONE, RETURN EMPTY-HANDED RETURN C--------IF STARSHIP IS IN THIS QUADRANT, CHOOSE STAR EXACTLY, UNLESS STARSHIP C--------JUST ARRIVED; THEN TREAT AS OCCURRING WHILE EN ROUTE. 20 IF(NQX.NE.QUADX .OR. NQY.NE.QUADY .OR. JUSTIN.NE.0) GO TO 70 NUM=RANF(0)*MOD(GALAXY(NQX,NQY),10)+1 DO 30 NSX=1,10 DO 30 NSY=1,10 IF(QUAD(NSX,NSY) .NE. IHSTAR) GO TO 30 NUM=NUM-1 IF(NUM .EQ. 0) GO TO 50 30 CONTINUE C--------PRINT RED ALERT (INCIPIENT SUPERNOVA) MESSAGE 50 CALL SKIP(1) CALL REDALRT CALL CRAM(34H***INCIPIENT SUPERNOVA DETECTED AT) CALL CRAMLOC(2,NSX,NSY) CALL CREND NQX=QUADX NQY=QUADY C--------SUPERNOVA ADJACENT TO STARSHIP ENDS GAME DSQ=(NSX-SECTX)**2 + (NSY-SECTY)**2 IF(DSQ .GT. 2.1) GO TO 80 CALL PROUT( + 54HEMERGENCY AUTOMATIC OVERRIDE ATTEMPTS T***************,54) CALL STARS ALLDONE=1 GO TO 80 C--------IF STARSHIP NOT IN SAME QUADRANT, JUST GET A MESSAGE 70 CALL SEND(1,NQX,NQY) C--------DESTROY ANY KLINGONS IN SUPERNOVAED QUADRANT 80 NUM=GALAXY(NQX,NQY) KLDEAD=NUM/100 COMDEAD=0 ISCDEAD=0 IF((NQX .NE. ISX) .OR. (NQY .NE. ISY)) GO TO 85 NSCREM=0 ISX=0 ISY=0 ISATB=0 ISCATE=0 ISCDEAD=1 FUTURE(6)=1E38 FUTURE(7)=1E38 85 IF(KLDEAD .EQ. 0) GO TO 100 REMKL=REMKL-KLDEAD IF(REMCOM .EQ. 0) GO TO 100 MAXLOOP=REMCOM DO 90 L=1,MAXLOOP IF(CX(L).NE.NQX .OR. CY(L).NE.NQY) GO TO 90 CX(L)=CX(REMCOM) CY(L)=CY(REMCOM) CX(REMCOM)=0 CX(REMCOM)=0 REMCOM=REMCOM-1 KLDEAD=KLDEAD-1 COMDEAD=1 IF(REMCOM .EQ. 0) FUTURE(2)=1E38 90 CONTINUE C--------DESTROY ROMULANS AND PLANETS IN SUPERNOVAED QUADRANT. 100 NUM=NEWSTUF(NQX,NQY) NEWSTUF(NQX,NQY)=0 NRMDEAD=NUM/10 NROMREM=NROMREM-NRMDEAD NPDEAD=NUM-NRMDEAD*10 IF(NPDEAD .EQ. 0) GO TO 109 DO 106 L=1,INPLAN IF((PLNETS(L,1) .NE. NQX).OR. (PLNETS(L,2) .NE. NQY)) GO TO 106 DO 105 I=1,5 105 PLNETS(L,I)=0 106 CONTINUE C--------DESTROY ANY BASE IN SUPERNOVAED QUADRANT 109 IF(REMBASE .EQ. 0) GO TO 120 MAXLOOP=REMBASE DO 110 L=1,MAXLOOP IF(BASEQX(L).NE.NQX .OR. BASEQY(L).NE.NQY) GO TO 110 BASEQX(L)=BASEQX(REMBASE) BASEQY(L)=BASEQY(REMBASE) BASEQX(REMBASE)=0 BASEQY(REMBASE)=0 REMBASE=REMBASE-1 110 CONTINUE C--------IF STARSHIP CAUSED SUPERNOVA, TALLY UP DESTRUCTION 120 IF(INSX.EQ.0 .OR. IPHWHO.EQ.1) GO TO 130 NUMBER=MOD(GALAXY(NQX,NQY),100) STARKL=STARKL+MOD(NUMBER,10) BASEKL=BASEKL+(NUMBER/10) KILLK=KILLK+KLDEAD KILLC=KILLC+COMDEAD NROMKL=NROMKL+NRMDEAD NPLANKL=NPLANKL+NPDEAD NSCKILL=NSCKILL+ISCDEAD C--------MARK SUPERNOVA IN GALAXY AND IN STAR CHART 130 IF(SENT.EQ.0 .AND. STARCH(NQX,NQY).EQ.1) + STARCH(NQX,NQY)=1000+GALAXY(NQX,NQY) IF(QUADX.EQ.NQX.AND.QUADY.EQ.NQY) STARCH(NQX,NQY)=1 GALAXY(NQX,NQY)=1000 C--------IF SUPERNOVA DESTROYS LAST KLINGONS, GIVE SPECIAL MESSAGE IF(REMKL.NE.0 .OR. (NQX.EQ.QUADX .AND. NQY.EQ.QUADY)) GO TO 140 CALL SKIP(2) CALL PROUT(11HLUCKY YOU! ,11) CALL CRAM(14HA SUPERNOVA IN) CALL CRAMLOC(1,NQX,NQY) CALL CRAMDMP(38H HAS JUST DESTROYED THE LAST KLINGONS.) CALL FINISH(1) RETURN C--------IF SOME KLINGONS REMAIN, CONTINUE (OR DIE IN SUPERNOVA) 140 IF(ALLDONE.NE.0) CALL FINISH(8) RETURN END