SUBROUTINE EVENTS 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 1 ,IHSTAR,IHT,IHQUEST,IHNUM,ITYPE COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM DIMENSION PICTURE(247) INTEGER SENT EQUIVALENCE (PICTURE,DATE),(CRACKS(5),ITYPE),(CRACKS(8),SENT) DATA NEVENTS/7/ ICTBEAM=0 ISTRACT=0 C--------SELECT EARLIEST EXTRANEOUS EVENT (LINE=0 IF NO EVENTS) 10 LINE=0 IF(ALLDONE.NE.0) RETURN DATEMIN=DATE+TIME DO 20 L=1,NEVENTS IF(FUTURE(L) .GT. DATEMIN) GO TO 20 LINE=L DATEMIN=FUTURE(L) 20 CONTINUE XTIME=DATEMIN-DATE DATE=DATEMIN C--------DECREMENT FEDERATION RESOURCES AND RECOMPUTE REMAINING TIME REMRES=REMRES-(REMKL+4*REMCOM)*XTIME REMTIME=REMRES/(REMKL+4*REMCOM) IF(REMTIME .GT. 0) GO TO 30 C--------FEDERATION RESOURCES DEPLETED; END CALL FINISH(2) RETURN C--------DECIDE IF LIFE SUPPORT IS ADEQUATE 30 IF(DAMAGE(5).EQ.0 .OR. CONDIT.EQ.IHDOCKD ) GO TO 50 IF(LSUPRES .GE. XTIME .OR. DAMAGE(5) .LE. LSUPRES) GO TO 40 CALL FINISH(3) RETURN 40 LSUPRES=LSUPRES-XTIME IF(DAMAGE(5) .LE. XTIME) LSUPRES=INLSR C--------FIX DEVICES 50 REPAIR=XTIME IF(CONDIT .EQ. IHDOCKD ) REPAIR=XTIME/DOCKFAC DO 60 L=1,NDEVICE IF(L.EQ.14) GO TO 60 IF(DAMAGE(L) .GT. 0) DAMAGE(L)=DIM(DAMAGE(L),REPAIR) 60 CONTINUE C--------CAUSE EXTRANEOUS EVENT [] TO OCCUR TIME=TIME-XTIME CALL SEND(0,0,0) IF(LINE .EQ. 0) GO TO 5000 GO TO (100,200,300,400,500,600,700),LINE C--------EXTRANEOUS EVENT 1: SUPERNOVA 100 CALL SNOVA(0,0) FUTURE(1)=DATE+EXPRAN(0.5*INTIME) IF(GALAXY(QUADX,QUADY) .EQ. 1000) RETURN GO TO 10 C--------EXTRANEOUS EVENT 2: TRACTOR BEAM 200 IF(REMCOM .EQ. 0) GO TO 220 IF(ISTRACT.NE.0) GO TO 210 IF(CONDIT .EQ. IHDOCKD ) GO TO 210 202 I=RANF(0)*REMCOM+1.0 IF(FUTURE(5).GE.1E38 .OR. CX(I).NE.BATX .OR. CY(I).NE.BATY) + GO TO 203 IF (REMCOM .GT. 1) GO TO 202 GO TO 210 203 YANK=(CX(I)-QUADX)**2 + (CY(I)-QUADY)**2 IF(YANK .EQ. 0 .AND. JUSTIN .EQ. 0) GO TO 210 204 YANK=SQRT(YANK) YNKRATE=7.5 TIME=(10.0/YNKRATE**2)*YANK ICTBEAM=1 CALL SKIP(1) CALL CRAM3AS CALL CRAMSHP CALL CRAMDMP(36H CAUGHT IN LONG-RANGE TRACTOR BEAM--) C--------IF KIRK AND CO. SCREWING AROUND ON PLANET, HANDLE. CALL GRAB IF(ALLDONE.NE.0) RETURN IF(ISTRACT .EQ. 0) GO TO 205 QUADX=ISX QUADY=ISY GO TO 206 205 QUADX=CX(I) QUADY=CY(I) 206 CALL IRAN10(SECTX,SECTY) CALL CRAM(12H PULLED TO) CALL CRAMLOC(1,QUADX,QUADY) CALL CRAM(2H, ) CALL CRAMLOC(2,SECTX,SECTY) CALL CREND IF(RESTING .NE. 0) CALL PROUT( + 46H(REMAINDER OF REST & REPAIR PERIOD CANCELLED.),46) RESTING=0 IF(SHLDUP.NE.0) GO TO 208 IF(DAMAGE(8).EQ.0 .AND. SHLD.GT.0) GO TO 207 CALL PROUT(32H(SHIELDS NOT CURRENTLY USEABLE.),32) GO TO 208 207 CALL SHLDSUP SHLDCHG=0 208 CALL NEWQUAD IF(REMCOM .LE. 0) GO TO 220 210 FUTURE(2)=DATE+TIME+EXPRAN(1.5*INTIME/REMCOM) GO TO 10 220 FUTURE(2)=1E38 GO TO 10 C--------EXTRANEOUS EVENT 3: SNAPSHOT OF UNIVERSE (FOR TIME WARP) 300 DO 310 L=1,247 310 SNAPSHT(L)=PICTURE(L) SNAP=1 FUTURE(3)=DATE+EXPRAN(0.5*INTIME) GO TO 10 C--------EXTRANEOUS EVENT 4: COMMANDER ATTACKS STARBASE C--------LOOK FOR A COMMANDER IN SAME QUADRANT AS A STARBASE 400 IF(REMCOM.GT.0 .AND. REMBASE.GT.0) GO TO 410 FUTURE(4)=1E38 FUTURE(5)=1E38 GO TO 10 410 DO 420 J=1,REMBASE DO 420 K=1,REMCOM IF( (BASEQX(J).EQ.CX(K) .AND. BASEQY(J).EQ.CY(K)) .AND. + (BASEQX(J).NE.QUADX .OR. BASEQY(J).NE.QUADY) .AND. + (BASEQX(J).NE.ISX .OR. BASEQY(J).NE.ISY) ) GO TO 430 420 CONTINUE FUTURE(4)=DATE+EXPRAN(0.3*INTIME) FUTURE(5)=1E38 GO TO 10 C--------COMMANDER+STARBASE COMBINATION FOUND--LAUNCH ATTACK 430 BATX=BASEQX(J) BATY=BASEQY(J) FUTURE(5)=DATE+1.0+3.0*RANF(0) IF(ISATB.NE.0) FUTURE(5)=FUTURE(5)+FUTURE(7)-DATE FUTURE(4)=FUTURE(5)+EXPRAN(0.3*INTIME) ITYPE=IHC CALL SOS GO TO 10 C--------EXTRANEOUS EVENT 5: COMMANDER SUCCEEDS IN DESTROYING BASE 500 FUTURE(5)=1E38 IF(REMCOM.EQ.0 .OR. REMBASE.EQ.0) GO TO 515 IF(MOD(GALAXY(BATX,BATY),100) .LT. 10) GO TO 515 DO 510 I=1,REMCOM IF(CX(I).EQ.BATX .AND. CY(I).EQ.BATY) GO TO 520 510 CONTINUE 515 BATX=0 BATY=0 GO TO 10 C--------HANDLE CASE WHERE BASE IS IN SAME QUADRANT AS STARSHIP 520 IF(BATX.NE.QUADX .OR. BATY.NE.QUADY) GO TO 545 QUAD(BASEX,BASEY)=IHDOT BASEX=0 BASEY=0 CALL NEWCOND CALL SKIP(1) CALL PROUT( + 61HSPOCK: "CAPTAIN, I BELIEVE THE STARBASE HAS BEEN DESTROYED. +",61) GO TO 555 C--------IF STARBASE NOT IN SAME QUADRANT, GET NEWS FROM UHURA 545 IF(REMBASE.EQ.1) GO TO 554 MTYPE=5 IF(ISATB.EQ.2) MTYPE=7 CALL SEND(MTYPE,BATX,BATY) C--------REMOVE STARBASE FROM GALAXY 551 IF(SENT .EQ. 0) GO TO 554 IF(STARCH(BATX,BATY) .EQ. -1) STARCH(BATX,BATY)=-2 IF(STARCH(BATX,BATY) .GT. 999) + STARCH(BATX,BATY)=STARCH(BATX,BATY)-10 GO TO 555 554 IF(STARCH(BATX,BATY).EQ.1) STARCH(BATX,BATY)=GALAXY(BATX,BATY)+1000 555 GALAXY(BATX,BATY)=GALAXY(BATX,BATY)-10 IF(REMBASE .LE. 1) GO TO 580 DO 560 I=1,REMBASE IF(BASEQX(I).EQ.BATX .AND. BASEQY(I).EQ.BATY) GO TO 570 560 CONTINUE 570 BASEQX(I)=BASEQX(REMBASE) BASEQY(I)=BASEQY(REMBASE) 580 REMBASE=REMBASE-1 IF(ISATB .NE. 2) GO TO 515 C--------REINSTATE A COMMANDER'S BASE ATTACK. BATX=IXHOLD BATY=IYHOLD 590 ISATB=0 GO TO 10 C--------EXTRANEOUS EVENT 6: SUPER-COMMANDER MOVES. 600 FUTURE(6)=DATE+0.2777 IF(IENTESC+ISTRACT .GT. 0) GO TO 10 IF(ISATB .NE. 1 .AND. (ISCATE.NE.1 .OR. JUSTIN.EQ.1)) CALL SCOM GO TO 10 C--------EXTRANEOUS EVENT 7: SUPER-COMMANDER DESTROYS BASE 700 FUTURE(7)=1E38 ISATB=2 IF(MOD(GALAXY(ISX,ISY),100) .LT. 10) GO TO 590 IXHOLD=BATX IYHOLD=BATY BATX=ISX BATY=ISY GO TO 520 C--------CHECK WITH SPY TO SEE IF S.C. SHOULD TRACTOR BEAM. 5000 IF(NSCREM .EQ. 0) RETURN IF(ICTBEAM+ISTRACT .GT. 0) RETURN IF(CONDIT.EQ.IHDOCKD .OR. ISATB.EQ.1 .OR. ISCATE.EQ.1) RETURN IF(IENTESC.NE.0) GO TO 5100 IF((ENERGY.LT.2500.) .AND. (TORPS.LT.4) .AND. (SHLD.LT.1250.)) + GO TO 5100 IF((DAMAGE(3).GT.0.) .AND. ((DAMAGE(4).GT.0) .OR. + (TORPS.LT.4))) GO TO 5100 IF((DAMAGE(8) .GT. 0.) .AND. ((ENERGY .LT. 3000.) .OR. +(DAMAGE(3) .GT. 0.)) .AND. ((TORPS .LT. 5) .OR. (DAMAGE(4) .GT. + 0.))) GO TO 5100 RETURN C--------TRACTOR-BEAM HER! 5100 IF(RANF(0).GT..65) RETURN ISTRACT=1 YANK=(ISX-QUADX)**2+(ISY-QUADY)**2 GO TO 204 END