SUBROUTINE EVENTS C*BEGIN COMMON COMMON SNAP,SNAPSHT(226), + 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,ICRYSTL,NPLANKL, + QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), + 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),FUTURE(10), + DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, + DAMFAC,SHLDCHG,THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT, + LANDED,IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, + IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE,IPHWHO,BATX,BATY, + CRACKS(12) INTEGER CF,CI,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 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(226) EQUIVALENCE (PICTURE,DATE),(CRACKS(5),ITYPE) 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)=AMAX1(DAMAGE(L)-REPAIR,0.0) 60 CONTINUE C--------CAUSE EXTRANEOUS EVENT [] TO OCCUR TIME=TIME-XTIME 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 I=RANF(0)*REMCOM+1.0 YANK=(CX(I)-QUADX)**2 + (CY(I)-QUADY)**2 IF(YANK .EQ. 0 .AND. JUSTIN .EQ. 0) GO TO 210 IF(ISTRACT .EQ. 0) GO TO 201 20010 YANK=(ISX-QUADX)**2+(ISY-QUADY)**2 201 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 C--------HANDLE CASE WHERE KIRK IS IN SHUTTLE CRAFT. IF(ICRAFT .NE. 1) GO TO 203 CALL FINISH(18) RETURN C--------CHECK TO SEE IF SHUTTLE IS ABOARD. 203 IF(ISCRAFT .NE. 0) GO TO 204 CALL SKIP(1) CALL PROUT(48HGALILEO, LEFT ON THE PLANET SURFACE, IS CAPTURED,48) CALL PROUT(45HBY ALIENS AND MADE INTO A FLYING MC DONALD'S.,45) DAMAGE(10)=-10. ISCRAFT=-1 204 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,226 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 502 ICOM=IHC IF(ISATB.NE.2) GO TO 505 IF(MOD(GALAXY(ISX,ISY),100) .LT. 10) RETURN IXHOLD=BATX IYHOLD=BATY BATX=ISX BATY=ISY ICOM=IHS GO TO 520 505 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 520 IF(STARCH(BATX,BATY) .EQ. -1) STARCH(BATX,BATY)=0 IF(STARCH(BATX,BATY) .GT. 999) + STARCH(BATX,BATY)=STARCH(BATX,BATY)-10 C--------HANDLE CASE WHERE BASE IS IN SAME QUADRANT AS STARSHIP 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 550 C--------IF STARBASE NOT IN SAME QUADRANT, GET NEWS FROM UHURA 545 IF(REMBASE.EQ.1 .OR. DAMAGE(9).GT.0) GO TO 550 CALL SKIP(1) CALL PROUT( + 52HLT. UHURA: "CAPTAIN, STARFLEET COMMAND REPORTS THAT,52) CALL CRAM(15HTHE STARBASE IN) CALL CRAMLOC(1,BATX,BATY) CALL CRAMDMP(22H HAS BEEN DESTROYED BY) IF(ISATB .NE. 2) GO TO 547 CALL PROUT(31HTHE KLINGON SUPER-COMMANDER." ,31) GO TO 550 547 CALL PROUT(21HA KLINGON COMMANDER.",21) C--------REMOVE STARBASE FROM GALAXY 550 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 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 GO TO 502 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. (SHIELD.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 GO TO 20010 END