SUBROUTINE DESTRCT 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,ISHIP COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM REAL*8 AITEM COMMON/SCANBF/KEY,AITEM EQUIVALENCE(SHIP,ISHIP) IF(DAMAGE(11) .EQ. 0) GO TO 5 CALL PROUT( + 51HCOMPUTER DAMAGED; CANNOT EXECUTE DESTRUCT SEQUENCE.,51) RETURN 5 CALL SKIP(1) CALL PROUT(13H---WORKING---,13) CALL PROUT(24HIDENTIFICATION-POSITIVE;,24) CALL PROUT(32HSELF-DESTRUCT-SEQUENCE-ACTIVATED,32) CALL PROUT( 5H 10,5) CALL PROUT( 8H 9,8) CALL PROUT(11H 8,11) CALL PROUT(14H 7,14) CALL PROUT(17H 6,17) CALL PROUT(35HENTER-CORRECT-PASSWORD-TO-CONTINUE-,35) CALL PROUT(33HSELF-DESTRUCT-SEQUENCE-OTHERWISE-,33) CALL PROMPT(40HSELF-DESTRUCT-SEQUENCE-WILL-BE-ABORTED: ,40) CALL SCAN IF(AITEM .NE. PASSWD) GO TO 30 CALL PROUT(17HPASSWORD-ACCEPTED,17) CALL PROUT(11H 5,11) CALL PROUT(14H 4,14) CALL PROUT(17H 3,17) CALL PROUT(20H 2,20) CALL PROUT(23H 1,23) IF(RANF(0) .LT. 0.05) CALL PROUT(19HGOODBYE-CRUEL-WORLD,19) CALL SKIP(2) CALL KABOOM RETURN 30 CALL PROUT(18HPASSWORD-REJECTED;,18) CALL PROUT(19HCONTINUITY-EFFECTED,19) CALL SKIP(2) RETURN END