SUBROUTINE HELP 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,ISHIP COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP) C--------TEST FOR CONDITIONS WHICH PREVENT CALLING FOR HELP IF(CONDIT .NE. IHDOCKD ) GO TO 10 CALL PROUT( + 48HLT. UHURA: "BUT CAPTAIN, WE'RE ALREADY DOCKED.",48) RETURN 10 IF(DAMAGE(9) .EQ. 0) GO TO 20 CALL PROUT(23HSUBSPACE RADIO DAMAGED.,23) RETURN 20 IF(REMBASE .NE. 0) GO TO 30 CALL PROUT(66HLT. UHURA: "CAPTAIN, I'M NOT GETTING ANY RESPONSE F +ROM STARBASE.",66) RETURN 30 IF(LANDED .NE. 1) GO TO 31 CALL CRAM(23HYOU MUST BE ABOARD THE ) CALL CRAMSHP CALL CRAMDMP(1H.) RETURN 31 IF(ISCRAFT .NE. 0) GO TO 32 CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET. 1 ,42) RETURN C--------DETERMINE APPROXIMATE DISTANCE TO NEAREST STARBASE 32 NHELP=NHELP+1 IF(BASEX .EQ. 0) GO TO 40 DIST=SQRT(FLOAT((BASEX-SECTX)**2 + (BASEY-SECTY)**2)) GO TO 60 40 DIST=1E38 DO 50 L=1,REMBASE XDIST=10.0*SQRT(FLOAT((BASEQX(L)-QUADX)**2+(BASEQY(L)-QUADY)**2)) IF(XDIST .GT. DIST) GO TO 50 DIST=XDIST LINE=L 50 CONTINUE C--------IF STARBASE IS NOT IN THIS QUADRANT, SET UP NEW QUADRANT QUADX=BASEQX(LINE) QUADY=BASEQY(LINE) SHUTUP=1.0 CALL NEWQUAD SHUTUP=0.0 C--------DEMATERIALIZE STARSHIP 60 QUAD(SECTX,SECTY)=IHDOT CALL CRAM(11HSTARBASE IN) CALL CRAMLOC(1,QUADX,QUADY) CALL CRAM(11H RESPONDS--) CALL CRAMSHP CALL CRAMDMP(16H DEMATERIALIZES.) C--------GIVE STARBASE THREE CHANCES TO REMATERIALIZE STARSHIP PROBF=(1.0 - 0.98**DIST)**0.3333333333 DO 80 L=1,3 IF(L .EQ. 1) CALL CRAM(4H1ST ) IF(L .EQ. 2) CALL CRAM(4H2ND ) IF(L .EQ. 3) CALL CRAM(4H3RD ) CALL CRAM(26HATTEMPT TO RE-MATERIALIZE ) CALL CRAMSHP CALL CRAM(11H . . . . . ) IF(RANF(0) .GT. PROBF) GO TO 90 70 CALL CRAMDMP(6HFAILS.) 80 CONTINUE C--------ONE, TWO, THREE STRIKES YOU'RE OUT CALL FINISH(11) RETURN C--------REMATERIALIZATION ATTEMPT SHOULD SUCCEED, IF CAN GET ADJ TO BASE 90 DO 100 LL=1,5 IX=BASEX+IFIX(3.0*RANF(0))-1 IF(IX.EQ.0 .OR. IX.EQ.11) GO TO 100 IY=BASEY+IFIX(3.0*RANF(0))-1 IF(IY.EQ.0 .OR. IY.EQ.11) GO TO 100 IF(QUAD(IX,IY) .EQ. IHDOT) GO TO 110 100 CONTINUE GO TO 70 C--------ATTEMPT HAS SUCCEEDED--FINISH UP 110 CALL CRAMDMP(9HSUCCEEDS.) SECTX=IX SECTY=IY QUAD(IX,IY)=ISHIP CALL DOCK CALL SKIP(1) CALL PROUT(34HLT. UHURA: "CAPTAIN, WE MADE IT!",34) RETURN END