SUBROUTINE SCOM 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,LOC COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM DIMENSION BDIST(5) EQUIVALENCE (CRACKS(5),LOCSUP),(LOC,LOCSUP) C--------COMPUTE DISTANCES TO STARBASES. IF(REMBASE .LE. 0) GO TO 60 BDMAX=0. SX=ISX SY=ISY DO 1 I=1,REMBASE BQX=BASEQX(I) BQY=BASEQY(I) 1 BDIST(I) = SQRT((BQX-SX)**2 +(BQY-SY)**2) C--------SORT INTO NEAREST FIRST ORDER. IF(REMBASE.LE.1) GO TO 4 MINUS1 = REMBASE -1 2 ISWITCH = 0 DO 3 I=1, MINUS1 IF(BDIST(I) .LE. BDIST(I+1)) GO TO 3 T=BDIST(I) BDIST(I)=BDIST(I+1) BDIST(I+1)=T ISWITCH = 1 3 CONTINUE IF(ISWITCH.NE.0) GO TO 2 C--------LOOK FOR NEAREST BASE WITHOUT A COMMANDER, NO ENTERPRISE, AND C--------WITHOUT TOO MANY KLINGONS, AND NOT ALREADY UNDER ATTACK. 4 IFINDIT=0 IWHICHB=0 DO 8 I=1, REMBASE IBQX=BASEQX(I) IBQY=BASEQY(I) IF((IBQX .EQ. QUADX) .AND. (IBQY .EQ. QUADY)) GO TO 8 IF((IBQX .EQ. BATX) .AND. (IBQY .EQ. BATY)) GO TO 8 NUM=GALAXY(IBQX,IBQY) IF(NUM .GT. 899) GO TO 8 IF(REMCOM .LE. 0) GO TO 6 DO 5 J=1, REMCOM 5 IF((IBQX .EQ. CX(J)) .AND. (IBQY .EQ. CY(J))) GO TO 7 6 IFINDIT=1 IWHICHB=I GO TO 10 7 IF (IFINDIT .EQ. 2) GO TO 8 IFINDIT=2 IWHICHB=I 8 CONTINUE IF(IFINDIT .EQ. 0) RETURN IBQX=BASEQX(IWHICHB) IBQY=BASEQY(IWHICHB) C--------DECIDE HOW TO MOVE TOWARD BASE. 10 IDELTX = IBQX -ISX IF(IDELTX .GT. 1) IDELTX = 1 IF(IDELTX .LT. -1) IDELTX=-1 IDELTY=IBQY-ISY IF(IDELTY .GT. 1) IDELTY = 1 IF(IDELTY .LT. -1) IDELTY=-1 C--------ATTEMPT FIRST TO MOVE IN BOTH X AND Y DIRECTION. IQX=ISX+IDELTX IQY=ISY+IDELTY ASSIGN 23 TO IWHERE C--------MAKE CHECKS ON POSSIBLE DESTINATION QUADRANT. 15 IF((IQX .EQ. QUADX) .AND. (IQY .EQ. QUADY)) GO TO IWHERE IF((IQX.LT.1).OR.(IQX.GT.8).OR.(IQY.LT.1).OR.(IQY.GT.8)) + GO TO IWHERE NUM = GALAXY(IQX,IQY) IF(NUM. GT. 899) GO TO IWHERE C--------GO AHEAD AND MOVE. GALAXY(ISX,ISY) = GALAXY(ISX,ISY) -100 ISX=IQX ISY=IQY GALAXY(ISX,ISY)=GALAXY(ISX,ISY)+100 IF(ISCATE .EQ. 0) GO TO 40 C--------S.C. HAS SCOOTED. REMOVE HIM FROM CURRENT QUADRANT. ISCATE=0 ISATB=0 ISHERE=0 IENTESC=0 FUTURE(7)=1E38 DO 21 I=1,NENHERE LOCSUP=I IX=KX(I) IY=KY(I) IF(QUAD(IX,IY) .EQ. IHS) GO TO 22 21 CONTINUE 22 CALL LEAVE QUAD(IX,IY)=IHDOT CALL SORTKL GO TO 40 C--------TRY SOME OTHER MANEUVERS 23 IF((IDELTX .EQ. 0) .OR. (IDELTY .EQ. 0)) GO TO 30 C--------TRY MOVING JUST IN X DIRECTION. IQY=ISY ASSIGN 25 TO IWHERE GO TO 15 C--------THEN TRY MOVING JUST IN Y DIRECTION. 25 IQY=ISY+IDELTY IQX=ISX ASSIGN 300 TO IWHERE GO TO 15 C--------ATTEMPT ANGLE MOVE. 30 IF(IDELTX.NE.0) GO TO 35 IQX=ISX+1 ASSIGN 32 TO IWHERE GO TO 15 32 IQX = ISX-1 ASSIGN 300 TO IWHERE GO TO 15 35 IQY = ISY+1 ASSIGN 36 TO IWHERE GO TO 15 36 IQY = ISY-1 ASSIGN 300 TO IWHERE GO TO 15 C--------SUPER-COMMANDER HAS MOVED. CHECK SITUATION. C--------CHECK FOR A HELPFUL PLANET. 40 DO 44 I=1,INPLAN IPLAN = I IF((PLNETS(I,1) .NE. ISX) .OR.(PLNETS(I,2) .NE. ISY)) GO TO 44 IF(PLNETS(I,4) .NE. 1) GO TO 45 C--------DESTROY PLANET. DO 43 J=1,5 43 PLNETS(IPLAN,J) = 0 NEWSTUF(ISX,ISY) = NEWSTUF(ISX,ISY)-1 IF(DAMAGE(9) .GT. 0) GO TO 45 CALL SKIP(1) CALL PROUT(47HLT. UHURA: "CAPTAIN, STARFLEET COMMAND REPORTS,47) CALL CRAM(13H A PLANET IN) CALL CRAMLOC(1,ISX,ISY) CALL CRAMDMP(19H HAS BEEN DESTROYED) CALL PROUT(26H BY THE SUPER-COMMANDER.",26) GO TO 45 44 CONTINUE C--------CHECK FOR A BASE. 45 IF(REMBASE .EQ. 0) GO TO 60 DO 46 I=1,REMBASE IBQX=BASEQX(I) IBQY=BASEQY(I) 46 IF(IBQX.EQ.ISX .AND. IBQY.EQ.ISY .AND. ISX.NE.BATX .AND. ISY.NE. + BATY) GO TO 80 C--------CHECK FOR INTELLIGENCE REPORT. IF(RANF(0) .GT. 0.2) RETURN IF(DAMAGE(9).GT.0. .OR. STARCH(ISX,ISY).GT.0) RETURN CALL SKIP(1) CALL PROUT(52HLT. UHURA: "CAPTAIN, STARFLEET INTELLIGENCE REPORTS +,52) CALL CRAM(27H THE SUPER-COMMANDER IS IN) CALL CRAMLOC(1,ISX,ISY) CALL CRAMDMP(2H.") C--------NOTHING ELSE TO DO. RETURN C--------NOTHING AVAILABLE. GO INTO HIBERNATION. 60 FUTURE(6)=1E38 RETURN C--------ATTACK A BASE. 80 ISATB=1 FUTURE(7)=DATE+1.0+2.0*RANF(0) IF(BATX.NE.0.0) FUTURE(7)=FUTURE(7)+FUTURE(5)-DATE LOC=IHS CALL SOS 300 RETURN END