SUBROUTINE ABANDON 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,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(ISHIP,SHIP) IF(DAMAGE(10)) 5,15,10 5 IF(DAMAGE(10) .EQ. -1.) GO TO 6 CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,36) RETURN 6 CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT.,38) RETURN 10 CALL PROUT(22HSHUTTLE CRAFT DAMAGED.,22) RETURN 15 IF((LANDED .NE. 1) .AND. (ICRAFT .NE. 1)) GO TO 16 CALL PROUT(34HYOU MUST BE ABOARD THE ENTERPRISE. ,34) RETURN 16 IF(ISCRAFT .EQ. 1) GO TO 17 CALL PROUT(38HSHUTTLE CRAFT NOT CURRENTLY AVAILABLE. ,38) RETURN C--------PRINT ABANDON SHIP MESSAGES 17 CALL SKIP(1) CALL PROUT(31H***ABANDON SHIP! ABANDON SHIP!,31) CALL PROUT(26H***ALL HANDS ABANDON SHIP!,26) CALL SKIP(1) CALL PROUT(41HCAPTAIN AND CREW ESCAPE IN SHUTTLE CRAFT.,41) CALL PROUT(41HREMAINDER OF SHIP'S COMPLEMENT BEAM DOWN ,41) CALL PROUT(28HTO NEAREST HABITABLE PLANET.,28) C--------IF THERE ARE NO STARBASES LEFT, GAME IS OVER IF(REMBASE .NE. 0) GO TO 20 CALL FINISH(9) RETURN C--------IF THERE IS AT LEAST ONE BASE LEFT, YOU GET THE FAERIE QUEENE 20 CALL SKIP(1) CALL PROUT(44HYOU ARE CAPTURED BY KLINGONS AND RELEASED TO,44) CALL PROUT(45HTHE FEDERATION IN A PRISONER-OF-WAR EXCHANGE.,45) CALL PROUT(46HSTARFLEET PUTS YOU IN COMMAND OF ANOTHER SHIP,,46) CALL PROUT(42HTHE FAERIE QUEENE, WHICH IS ANTIQUATED BUT,42) CALL PROUT(14HSTILL USEABLE.,14) C--------SELECT BASE AT WHICH TO BEGIN AGAIN NB=RANF(0)*REMBASE+1 C--------RESET FLAGS. ICRYSTL=0 IMINE=0 ISCATE=0 C--------SET UP QUADRANT AND POSITION F. Q. ADJACENT TO BASE QUADX=BASEQX(NB) QUADY=BASEQY(NB) 40 CALL IRAN10(SECTX,SECTY) ISHIP=IHF CALL NEWQUAD 50 IF(IABS(SECTX-BASEX).LE.1 .AND. IABS(SECTY-BASEY).LE.1) GO TO 60 QUAD(SECTX,SECTY)=IHDOT CALL DROPIN(IHF,SECTX,SECTY) GO TO 50 C--------CLEAR AND RESUPPLY SHIP 60 CONDIT=IHDOCKD DO 70 L=1,NDEVICE 70 DAMAGE(L)=0 DAMAGE(10)=-1 INENRG=3000.0 ENERGY=3000.0 INSHLD=1250. SHLD=1250.0 INTORPS=6 TORPS=6 INLSR=3.0 LSUPRES=3.0 SHLDUP=0 WARPFAC=5.0 WFACSQ=25.0 RETURN END