SUBROUTINE GETCD 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 COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM LOGICAL CROP REAL*8 AITEM COMMON/SCANBF/KEY,AITEM EQUIVALENCE (FNUM,AITEM) REAL*8 MANUAL,AUTOMAT DATA MANUAL,AUTOMAT/6HMANUAL,7HAUTOMAT/ C GET COURSE AND DISTANCE . IF USER TYPES C BAD VALUES, RETURN WITH =-1.0 . C--------CHECK TO MAKE SURE NO ONE IS LEFT ON A PLANET. IF(LANDED .NE. 1) GO TO 1 CALL PROUT(41H YOU CAN'T LEAVE STANDARD ORBIT UNTIL YOU ,41) CALL CRAM(20HARE BACK ABOARD THE ) CALL CRAMSHP CALL CRAMDMP(1H.) GO TO 71 1 IROWQ=QUADX ICOLQ=QUADY DELTX=0. DELTY=0. ITEMP=0 IPROMPT=0 C--------CHECK FOR MANUAL OR AUTOMATIC. 10 CALL SCAN IF(KEY.EQ.IHREAL) GOTO 24 !DEFAULT MANUAL MODE IF(KEY .EQ. IHALPHA) GO TO 13 IF(DAMAGE(11) .NE. 0) GO TO 1301 11 CALL PROMPT(26HMANUAL OR AUTOMATIC ? ,26) IPROMPT=1 GO TO 10 13 IF (CROP(AITEM,MANUAL)) GO TO 20 IF (.NOT.CROP(AITEM,AUTOMAT)) GO TO 11 C--------AUTOMATIC MOVEMENT REQUESTED. CHECK FOR COMPUTER DAMAGE. IF(DAMAGE(11).EQ.0) GO TO 14 1301 CALL PROUT(41HCOMPUTER DAMAGED; MANUAL MOVEMENT ONLY. ,41) GO TO 2001 C--------GET QUADRANT AND SECTOR. 14 CALL SCAN XI=FNUM IF(KEY.NE.IHEOL) GO TO 15 1410 CALL PROMPT(40HDESTINATION QUADRANT AND/OR SECTOR: ,40) IPROMPT=1 GO TO 14 15 IF (KEY .NE. IHREAL) GO TO 1410 IF(FNUM.EQ.-1.) GO TO 71 CALL SCAN XJ=FNUM IF(KEY.NE.IHREAL) GO TO 1410 CALL SCAN XK=FNUM IF (KEY .NE. IHREAL) GO TO 16 CALL SCAN XL=FNUM IF (KEY .NE. IHREAL) GO TO 1410 C--------QUADRANT AND SECTOR SPECIFIED. IROWQ=XI+.5 ICOLQ=XJ+.5 IROWS=XK+.5 ICOLS=XL+.5 GO TO 30 C--------ONLY SECTOR SPECIFIED. 16 IROWS=XI+.5 ICOLS=XJ+.5 ITEMP=1 GO TO 30 C--------MANUAL (DELTX, DELTY) MOVEMENT. 20 CALL SCAN IF(KEY .EQ. IHREAL) GO TO 24 2001 CALL PROMPT(30HX AND Y DISPLACEMENTS: ,30) IPROMPT=1 GO TO 20 24 DELTX=FNUM CALL SCAN IF(DELTX.EQ.-1..AND.KEY.EQ.IHEOL) GO TO 71 IF(KEY .NE. IHREAL) GO TO 70 DELTY=FNUM GO TO 40 C--------CHECK FOR INVALID INPUT FOR AUTOMATIC CASE. 30 IF((IROWQ.LT.1) .OR. (IROWQ.GT.8) .OR. (ICOLQ.LT.1) .OR. C(ICOLQ.GT.8) .OR. (IROWS.LT.1) .OR. (IROWS.GT.10) .OR. C(ICOLS.LT.1) .OR. (ICOLS.GT.10) ) GO TO 70 C--------PRINT MESSAGE FROM APPROPRIATE OFFICER. IF(ITEMP .EQ. 1) GO TO 31 CALL PROUT(42HENSIGN CHEKOV: "COURSE LAID IN, CAPTAIN." ,42) GO TO 32 31 IF(IPROMPT .NE. 1) GO TO 32 CALL CRAM(37HHELMSMAN SULU: "COURSE LOCKED IN FOR) CALL CRAMLOC(2,IROWS,ICOLS) CALL CRAMDMP(2H.") C--------CONVERT TO DELTX, DELTY FORM. 32 DELTX = ICOLQ -QUADY +0.1*(ICOLS-SECTY) DELTY = QUADX -IROWQ + 0.1*(SECTX -IROWS) C--------CHECK FOR A ZERO MOVEMENT. 40 IF((DELTX .NE. 0.) .OR. (DELTY .NE. 0.)) GO TO 42 GO TO 71 42 IF(IPROMPT .EQ. 0) GO TO 43 CALL PROUT(27HHELMSMAN SULU: "AYE, SIR." ,27) C--------CONVERT INTO COURSE AND DISTANCE. 43 DIST = SQRT(DELTX*DELTX+DELTY*DELTY) DIREC = ATAN2(DELTX,DELTY)*1.90985932 IF(DIREC .LT. 0.) DIREC=12.+DIREC RETURN C--------GARBAGE IN, GARBAGE OUT 70 CALL SKIP(1) CALL BEGPARD 71 DIREC=-1.0 RETURN END