SUBROUTINE MOVE 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,IQUAD,ISHIP COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM INTEGER TRBEAM EQUIVALENCE (CRACKS(6),KDIDIT),(SHIP,ISHIP) IF(INORBIT .EQ. 0) GO TO 1 CALL PROUT(32HSULU: "LEAVING STANDARD ORBIT.",32) INORBIT=0 1 ANGLE=((15.0-DIREC)*0.5235988) DELTAX=-SIN(ANGLE) DELTAY=COS(ANGLE) BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY)) DELTAX=DELTAX/BIGGER DELTAY=DELTAY/BIGGER TRBEAM=0 C--------IF TRACTOR BEAM IS TO OCCUR, DO NOT MOVE FULL DISTANCE IF(DATE+TIME .LT. FUTURE(2)) GO TO 5 TRBEAM=1 CONDIT=IHRED DIST=DIST*(FUTURE(2)-DATE)/TIME+0.1 TIME=FUTURE(2)-DATE + 1E-5 C--------MOVE WITHIN QUADRANT 5 QUAD(SECTX,SECTY)=IHDOT X=SECTX Y=SECTY N=10.0*DIST*BIGGER+0.5 IF(N .EQ. 0) GO TO 100 DO 10 L=1,N X=X+DELTAX IX=X+0.5 Y=Y+DELTAY IY=Y+0.5 IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 40 IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 40 IQUAD=QUAD(IX,IY) IF(IQUAD .NE. IHDOT) GO TO 20 10 CONTINUE DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2)) SECTX=IX SECTY=IY GO TO 100 C--------OBJECT ENCOUNTERED ALONG FLIGHT PATH 20 STOPEGY=50.0*DIST/TIME DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2)) IF(IQUAD.EQ.IHK .OR. IQUAD.EQ.IHC .OR. IQUAD.EQ.IHS .OR. + IQUAD.EQ.IHR) GO TO 30 IF(IQUAD.EQ.IHT) GO TO 30 IF(IQUAD .EQ. IHBLANK) GO TO 25 C--------OBJECT IS NOT AN ENEMY VESSEL, OR BLACK HOLE. CALL SKIP(1) CALL CRAMSHP IF(IQUAD.NE.IHNUM) CALL CRAM(21H BLOCKED BY OBJECT AT) IF(IQUAD.EQ.IHNUM) CALL CRAM(26H ENCOUNTERS THOLIAN WEB AT ) CALL CRAMLOC(2,IX,IY) CALL CRAMDMP(1H;) CALL CRAM(24HEMERGENCY STOP REQUIRED ) CALL CRAMF(STOPEGY,0,2) CALL CRAMDMP(17H UNITS OF ENERGY.) ENERGY=ENERGY-STOPEGY SECTX=X-DELTAX+0.5 SECTY=Y-DELTAY+0.5 IF(ENERGY .GT. 0) GO TO 100 CALL FINISH(4) RETURN C--------OBJECT IS A BLACK HOLE. SWALLOW SHIP. 25 CALL HOLE(IX,IY) RETURN C--------OBJECT IS AN ENEMY VESSEL; RAM HIM. 30 SECTX=IX SECTY=IY CALL RAM(0,IQUAD,SECTX,SECTY) GO TO 100 C--------COMPUTE FINAL POSITION--NEW QUADRANT, NEW SECTOR 40 X=10*(QUADX-1)+SECTX Y=10*(QUADY-1)+SECTY IX=X+10.0*DIST*BIGGER*DELTAX+0.5 IY=Y+10.0*DIST*BIGGER*DELTAY+0.5 C--------CHECK FOR EDGE OF GALAXY KINKS=0 45 KINK=0 IF(IX .GT. 0) GO TO 50 IX=-IX+1 KINK=1 50 IF(IY .GT. 0) GO TO 55 IY=-IY+1 KINK=1 55 IF(IX .LE. 80) GO TO 60 IX=161-IX KINK=1 60 IF(IY .LE. 80) GO TO 65 IY=161-IY KINK=1 65 IF(KINK .EQ. 0) GO TO 70 KINKS=1 GO TO 45 70 IF(KINKS .EQ. 0) GO TO 90 NKINKS=NKINKS+1 IF(NKINKS .EQ. 3) GO TO 80 C--------ISSUE REPRIMAND FOR HITTING EDGE OF GALAXY CALL SKIP(1) CALL PROUT( + 55HYOU HAVE ATTEMPTED TO CROSS THE NEGATIVE ENERGY BARRIER,55) CALL PROUT( + 56HAT THE EDGE OF THE GALAXY. THE THIRD TIME YOU TRY THIS,,56) CALL PROUT(22HYOU WILL BE DESTROYED.,22) GO TO 90 C--------ONE, TWO, THREE STRIKES, YOU'RE OUT 80 CALL FINISH(6) RETURN C--------COMPUTE FINAL POSITION OF STARSHIP IN NEW QUADRANT 90 CONTINUE QUADX=(IX+9)/10 QUADY=(IY+9)/10 SECTX=IX-10*(QUADX-1) SECTY=IY-10*(QUADY-1) IF(TRBEAM.NE.0) RETURN CALL SKIP(1) CALL CRAM(8HENTERING) CALL CRAMLOC(1,QUADX,QUADY) CALL CREND CALL NEWQUAD RETURN C--------NO QUADRANT CHANGE; COMPUTE NEW ENEMY DISTANCES 100 QUAD(SECTX,SECTY)=ISHIP CALL RESETD IF(KDIDIT .EQ. 0) CALL SORTKL RETURN END