SUBROUTINE PLANET C* C* SUBROUTINE PLANETS CONTAINS ENTRY POINTS FOR : C* C* ORBIT,BEAM,MONE,CRYSTAL,SENSOR,GALILEO,DEATHRA C* 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 CALL SKIP(1) CALL PROUT(41HSPOCK: "PLANET REPORT FOLLOWS, CAPTAIN." ,41) CALL SKIP(1) IKNOW=0 DO 1 I=1,INPLAN IF(PLNETS(I,5) .EQ. 0) GO TO 1 IKNOW=1 IX=PLNETS(I,1) IY=PLNETS(I,2) ICLASS=PLNETS(I,3) IDIL=PLNETS(I,4) CALL CRAMLOC(1,IX,IY) CALL CRAM(9H CLASS ) CALL CRAMEN(ICLASS) CALL CRAM(3H ) IF(IDIL .EQ. 0) CALL CRAM (3HNO ) CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT. ) 1 CONTINUE IF(IKNOW .EQ. 1) RETURN CALL PROUT(26HNO INFORMATION AVAILABLE." ,26) RETURN C* ENTRY ORBIT C* CALL SKIP(1) IDIDIT=0 IF(INORBIT .EQ. 0) GO TO 2 CALL PROUT(26HALREADY IN STANDARD ORBIT. ,26) RETURN C--------CHECK FOR ENGINE DAMAGE. 2 IF((DAMAGE(7) .EQ. 0.) .OR. (DAMAGE(6) .EQ. 0.)) GO TO 3 CALL PROUT(38HBOTH WARP AND IMPULSE ENGINES DAMAGED. ,38) RETURN C--------CHECK TO SEE IF SHIP ADJACENT TO PLANET. 3 IF(PLNETX .EQ. 0) GO TO 5 IF(IABS(SECTX-PLNETX) .LE. 1 .AND. IABS(SECTY-PLNETY) .LE. 1) C GO TO 10 5 CALL CRAMSHP CALL CRAMDMP(24H NOT ADJACENT TO PLANET. ) RETURN 10 TIME = .02+.03*RANF(0) IF(DAMAGE(6) .GT. 0.) TIME=TIME*10. C--------GO AHEAD, SULU. CALL PROUT(46HHELMSMAN SULU: "ENTERING STANDARD ORBIT, SIR. 1 ,46) CALL NEWCOND ASSIGN 17 TO IWHERE 16 IDIDIT=1 CALL EVENTS IF(ALLDONE.EQ.1 .OR. GALAXY(QUADX,QUADY).EQ.1000 .OR. JUSTIN.EQ.1) + RETURN GO TO IWHERE 17 CALL CRAM(11H ALTITUDE ) HEIGHT=1400.+7200.*RANF(0) CALL CRAMF(HEIGHT,0,2) CALL CRAMDMP(13H KILOMETERS.") INORBIT=1 RETURN C* ENTRY BEAM C* CALL SKIP(1) IF(DAMAGE(12) .EQ. 0) GO TO 19 CALL PROUT(21HTRANSPORTER DAMAGED. ,21) IF(DAMAGE(10) .NE. 0) RETURN CALL SKIP(1) CALL PROUT(47HSPOCK: "MAY I SUGGEST THE SHUTTLE CRAFT, SIR." 1 ,47) RETURN 19 IF(INORBIT.NE.0) GO TO 1910 1901 CALL CRAMSHP CALL CRAMDMP(23H NOT IN STANDARD ORBIT. ) RETURN 1910 IF(SHLDUP .EQ. 0) GO TO 1920 CALL PROUT(41HIMPOSSIBLE TO TRANSPORT THROUGH SHIELDS. ,41) RETURN 1920 IF(PLNETS(IPLANET,5) .EQ. 1) GO TO 1940 1930 CALL PROUT(56HSPOCK: "CAPTAIN, WE HAVE NO INFORMATION ON THIS PLA CNET, ,56) CALL PROUT(64H AND STARFLEET REGULATIONS CLEARLY STATE THAT IN TH CIS SITUATION ,64) CALL PROUT(23H YOU MAY NOT GO DOWN." ,23) RETURN 1940 IF(LANDED .EQ. 1) GO TO 30 IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 20 CALL PROUT(44HSPOCK: CAPTAIN, I FAIL TO SEE THE LOGIC IN ,44) CALL PROUT( +51H EXPLORING A PLANET WITH NO DILITHIUM CRYSTALS. ,51) ASSIGN 20 TO IWHERE 1950 CALL PROMPT(30H ARE YOU SURE THIS IS WISE? ,30) IF(JA(DUMMY)) GO TO IWHERE RETURN 20 CALL PROUT(41HSCOTTY: "TRANSPORTER ROOM READY, SIR." ,41) CALL SKIP(1) CALL PROUT(63HKIRK, AND LANDING PARTY PREPARE TO BEAM DOWN TO PLAN CET SURFACE. ,63) CALL SKIP(1) CALL PROUT(18HKIRK: "ENERGIZE." ,18) 21 CALL SKIP(1) CALL PROUT(41HWWHOOOIIIIIRRRRREEEE.E.E. . . . . . . ,41) IF(RANF(0) .GT. 0.98) GO TO 35 CALL PROUT(41H. . . . . . .E.E.EEEERRRRRIIIIIOOOHWW ,41) CALL SKIP(1) CALL PROUT(19HTRANSPORT COMPLETE. ,19) LANDED = LANDED *(-1) IF((LANDED .NE. 1) .AND. (IMINE .EQ. 1)) ICRYSTL = 1 IMINE=0 RETURN C--------READY TO BEAM UP TO SHIP. 30 IF(ISCRAFT .EQ. 1) GO TO 32 CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET. ,42) RETURN 32 CALL PROUT(42HLANDING PARTY ASSEMBLED, READY TO BEAM UP. ,42) CALL SKIP(1) CALL PROUT(31HKIRK WHIPS OUT COMMUNICATOR... ,31) CALL PROUT(17HBEEP BEEP BEEP ,17) CALL SKIP(1) CALL PROUT(54H"KIRK TO ENTERPRISE: LOCK ON COORDINATES...ENERGIZE C." ,54) GO TO 21 C--------CATASTROPHE! 35 CALL SKIP(1) CALL PROUT(31HBOOOIIIOOOIIOOOOIIIOIING . . . ,31) CALL SKIP(1) CALL PROUT(38HSCOTTY: "OH MY GOD! I'VE LOST THEM." ,38) CALL FINISH(13) RETURN C* ENTRY MINE C* IDIDIT=0 CALL SKIP(1) IF(LANDED .EQ. 1) GO TO 50 CALL PROUT(27HMINING PARTY NOT ON PLANET. ,27) RETURN 50 IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 51 CALL PROUT(37HNO DILITHIUM CRYSTALS ON THIS PLANET. ,37) RETURN 51 TIME =(0.1+0.2*RANF(0)) * PLNETS(IPLANET,3) ASSIGN 52 TO IWHERE GO TO 16 52 CALL PROUT(26HMINING OPERATION COMPLETE. ,26) IMINE=1 RETURN C* ENTRY CRYSTAL C* CALL SKIP(1) IF(ICRYSTL .EQ. 1) GO TO 55 CALL PROUT(32HNO DILITHIUM CRYSTALS AVAILABLE. ,32) RETURN 55 IF(ENERGY .LT. 1000.) GO TO 5510 CALL PROUT(66HSPOCK: "CAPTAIN, STARFLEET REGULATIONS PROHIBIT SUC CH AN OPERATION ,66) CALL PROUT(41H EXCEPT WHEN CONDITION YELLOW EXISTS." ,41) RETURN 5510 CALL PROUT(46HSPOCK: "CAPTAIN, I MUST WARN YOU THAT LOADING 1 ,46) CALL PROUT(46H RAW DILITHIUM CRYSTALS INTO THE SHIP'S POWER 1 ,46) CALL PROUT(37H SYSTEM MAY RISK A SEVERE EXPLOSION. ,37) ASSIGN 56 TO IWHERE GO TO 1950 56 CALL SKIP(1) CALL PROUT(45HENGINEERING OFFICER SCOTT: "(GULP) AYE SIR." ,45) CALL PROUT(32H "MR. SPOCK AND I WILL TRY IT." ,32) CRYPROB=CRYPROB*2.0 CALL SKIP(1) CALL PROUT(32HSPOCK: "CRYSTAL IN PLACE, SIR." ,32) CALL PROUT(31H "READY TO ACTIVATE CIRCUIT." ,31) CALL SKIP(1) CALL PROUT(42HSCOTTY: "KEEP YOUR FINGERS CROSSED, SIR!" ,42) CALL SKIP(1) IF(RANF(0) .GT. CRYPROB) GO TO 57 CALL PROUT(41H "ACTIVATING NOW! - - NO GOOD! IT'S*** ,41) 5610 CALL PROUT(54H***RED ALERT! RED A*L****************************** +**,54) CALL STARS CALL PROUT(54H***************** KA-BOOM!!!! **************** C** ,54) CALL KABOOM RETURN 57 ENERGY = ENERGY +5000.*(1.+0.9*RANF(0)) CALL PROUT(38H "ACTIVATING NOW% - - THE INSTRUMENTS ,38) CALL PROUT(36H ARE GOING CRAZY, BUT I THINK IT'S ,36) CALL PROUT(41H GOING TO WORK! CONGRATULATIONS, SIR!" ,41) RETURN C* ENTRY SENSOR C* CALL SKIP(1) IF(DAMAGE(1) .EQ. 0) GO TO 60 CALL PROUT(28HSHORT RANGE SENSORS DAMAGED. ,28) RETURN 60 IF(PLNETX .NE. 0) GO TO 65 CALL PROUT(27HNO PLANET IN THIS QUADRANT. ,27) RETURN 65 CALL CRAM(24HSPOCK: "SENSOR SCAN FOR ) CALL CRAMLOC(1,QUADX,QUADY) CALL CRAMDMP(1H:) CALL SKIP(1) CALL CRAM(18H PLANET AT) CALL CRAMLOC(2,PLNETX,PLNETY) CALL CRAM(13H IS OF CLASS ) ICLASS=PLNETS(IPLANET,3) IDIL=PLNETS(IPLANET,4) CALL CRAMEN(ICLASS) CALL CRAMDMP(1H.) CALL CRAM(27H READINGS INDICATE ) IF(IDIL .EQ. 0) CALL CRAM(3HNO ) CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT." ) PLNETS(IPLANET,5) = 1 RETURN C* ENTRY GALILEO C* CALL SKIP(1) IDIDIT = 0 IF(DAMAGE(10) .EQ. 0) GO TO 72 IF(DAMAGE(10) .GT. 0.) GO TO 71 IF(DAMAGE(10) .EQ. -1.) GO TO 70 CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,4) RETURN 70 CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT. ,38) RETURN 71 CALL PROUT(22HSHUTTLE CRAFT DAMAGED. ,22) RETURN 72 IF(INORBIT .EQ. 1) GO TO 75 GO TO 1901 75 IF(SHLDUP .EQ. 0 .AND. CONDIT .NE. IHDOCKD) GO TO 80 CALL PROUT(42HSHUTTLE CRAFT CANNOT PASS THROUGH SHIELDS.,42) RETURN 80 IF(PLNETS(IPLNET,5) .NE. 1) GO TO 1930 TIME=3.0E-5*HEIGHT IF(LANDED .NE. 1) GO TO 100 IF(ISCRAFT .NE. 1) GO TO 98 C--------SHUTTLE CRAFT TO THE RESCUE. IF(DAMAGE(12) .NE. 0) GO TO 95 CALL PROMPT(47HSPOCK: WOULD YOU RATHER USE THE TRANSPORTER? ,47) IF(JA(DUMMY)) RETURN 95 IF(DAMAGE(12) .EQ. 0) CALL CRAM(13HSHUTTLE CREW ) IF(DAMAGE(12) .NE. 0) CALL CRAM(13HRESCUE PARTY ) CALL CRAMDMP(50HBOARDS "GALILEO" AND SWOOPS TOWARD PLANET SURFACE. C ) ISCRAFT=0 ASSIGN 97 TO IWHERE 96 CALL SKIP(1) GO TO 16 97 CALL PROUT(14HTRIP COMPLETE.,14) RETURN C--------LANDING PARTY BOARDS GALILEO FOR TRIP BACK TO SHIP. 98 CALL PROUT(35HYOU AND YOUR MINING PARTY BOARD THE ,35) CALL PROUT( +51HSHUTTLE CRAFT FOR THE TRIP BACK TO THE ENTERPRISE. ,51) CALL SKIP(1) CALL PROUT(26HTHE SHORT HOP BEGINS . . . ,26) ICRAFT=1 LANDED=-1 ASSIGN 99 TO IWHERE GO TO 96 99 ICRAFT=0 ISCRAFT=1 IF(IMINE.NE.0) ICRYSTL=1 IMINE=0 GO TO 97 C--------LANDING PARTY HEADS DOWN TO PLANET. 100 CALL PROUT(36HMINING PARTY ASSEMBLES IN THE HANGAR ,36) CALL PROUT( +51HDECK, READY TO BOARD THE SHUTTLE CRAFT "GALILEO." ,51) CALL SKIP(1) CALL PROUT(41HTHE HANGAR DOORS OPEN; THE TRIP BEGINS. ,41) ICRAFT=1 ISCRAFT=0 ASSIGN 110 TO IWHERE GO TO 96 110 LANDED=1 ICRAFT=0 GO TO 97 C* ENTRY DEATHRA C* IDIDIT=0 CALL SKIP(1) IF(SHIP .EQ. IHE) GO TO 113 CALL PROUT(34HYE FAERIE QUEENE HAS NO DEATH RAY.,34) RETURN 113 IF(NENHERE .GE. 1) GO TO 115 CALL PROUT(56HSULU: "BUT SIR, THERE ARE NO ENEMIES IN THIS QUADRA +NT.",56) RETURN 115 IF(DAMAGE(14).LE.0) GOTO 116 CALL PROUT(17HDEATHRAY DAMAGED.,17) RETURN 116 IDIDIT=1 CALL PROUT(44HKIRK: "PREPARE FOR ACTIVATION OF DEATHRAY!",44) CALL SKIP(1) CALL PROUT(37HSPOCK: "PREPARATIONS COMPLETE, SIR.",37) CALL PROUT(16HKIRK: "ENGAGE!",16) CALL SKIP(1) CALL PROUT(45HWHIRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR,45) R=RANF(0) IF(R .GT. 0.30) GO TO 130 C--------BANG! CALL PROUT(32HSULU: "CAPTAIN! IT'S WORKING!",32) CALL REDALRT CALL PROUT(41H***MATTER-ANTIMATTER IMPLOSION IMMINENT! ,41) GO TO 5610 C--------SUCCESS! 130 CALL PROUT(32HSULU: "CAPTAIN! IT'S WORKING!",32) CALL SKIP(1) NENHER2=NENHERE DO 135 I=1,NENHER2 II=KX(1) JJ=KY(1) 135 CALL DEADKL(II,JJ,QUAD(II,JJ),II,JJ) CALL SKIP(1) CALL PROUT(42HENSIGN CHEKOV: "CONGRATULATIONS CAPTAIN!",42) IF(REMKL .EQ. 0) CALL FINISH(1) IF(REMKL .EQ. 0) RETURN CALL SKIP(1) CALL PROUT( +56HSPOCK: "CAPTAIN, I BELIEVE THE "EXPERIMENTAL DEATH RAY",56) IF(RANF(0).GT..05) GOTO 140 CALL PROUT(22HIS STILL OPERATIONAL.",22) RETURN 140 CALL PROUT(33HHAS BEEN RENDERED DISFUNCTIONAL.",33) DAMAGE(14)=39.95 RETURN END