SUBROUTINE SRSCAN CALL SCANIN(1) RETURN END SUBROUTINE REQUEST CALL SCANIN(2) RETURN END SUBROUTINE STATUS CALL SCANIN(3) RETURN END SUBROUTINE SCANIN(IZ) 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 COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM BYTE BITEM LOGICAL LEFTSID,RITESID ,CROP REAL*8 REQUST(10),AITEM,DAMAGD,UP,DOWN,TJ EQUIVALENCE (AITEM,BITEM) COMMON/SCANBF/KEY,AITEM DATA REQUST /4HDATE,8HCONDITIO,8HPOSITION,7HSUPPORT,8HWARPFACT +,6HENERGY,8HTORPEDOE,7HSHIELDS,8HKLINGONS,4HTIME/ DATA DAMAGD,UP,DOWN/7HDAMAGED,2HUP,4HDOWN/ GOTO (1001,1002,1003),IZ 1001 IF(DAMAGE(1) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 160 LEFTSID=.TRUE. RITESID=.TRUE. CALL SCAN IF(KEY .EQ. IHEOL) GO TO 3 IF(BITEM .EQ. 78) RITESID = .FALSE. 3 STARCH(QUADX,QUADY)=1 K=0 CALL PROUT(23H 1 2 3 4 5 6 7 8 9 10,23) GO TO 4 C* C ENTRY REQUEST C* 1002 CONTINUE 301 CALL SCAN IF(KEY .EQ. IHALPHA) GO TO 303 302 CALL PROMPT(24HINFORMATION DESIRED? ,24) GO TO 301 303 DO 304 I=1,10 304 IF(CROP(AITEM,REQUST(I))) K=I IF(K.NE.0) GO TO 305 CALL PROUT(42HUNRECOGNIZED REQUEST. LEGAL REQUESTS ARE:,42) CALL PROUT( +51H DATE, CONDITION, POSITION, LSUPPORT, WARPFACTOR, ,51) CALL PROUT(45H ENERGY, TORPEDOES, SHIELDS, KLINGONS, TIME.,45) CALL SKIP(1) GO TO 302 C* C ENTRY STATUS C* 1003 CONTINUE 305 LEFTSID=.FALSE. 4 DO 150 I=1,10 JJ=I IF(K.NE.0) JJ=K IF(.NOT. LEFTSID) GO TO 8 CALL CRAMI(I,2) CALL CRAM(1H ) DO 5 J=1,10 CALL CRAMS(QUAD(I,J),1) CALL CRAM(1H ) 5 CONTINUE IF(RITESID)GO TO 8 CALL CREND GO TO 150 8 GO TO (10,20,30,40,50,60,70,80,90,100), JJ 10 CALL CRAM(15H STARDATE ) CALL CRAMF(DATE,0,1) CALL CREND GO TO 140 20 IF(CONDIT .NE. IHDOCKD ) CALL NEWCOND CALL CRAM(15H CONDITION ) IF(CONDIT.EQ.IHGREEN) CALL CRMDPS('GREEN',5) IF(CONDIT.EQ.IHRED) CALL CRMDPS('RED',3) IF(CONDIT.EQ.IHYELLO) CALL CRMDPS('YELLOW',6) IF(CONDIT.EQ.IHDOCKD) CALL CRMDPS('DOCKED',6) GO TO 140 30 CALL CRAM(14H POSITION ) CALL CRAMLOC(0,QUADX,QUADY) CALL CRAM(1H,) CALL CRAMLOC(0,SECTX,SECTY) CALL CREND GO TO 140 40 CALL CRAM(15H LIFE SUPPORT ) IF(DAMAGE(5).NE.0.) GO TO 44 CALL CRAM(6HACTIVE) GO TO 46 44 IF(CONDIT .NE. IHDOC ) GO TO 45 CALL CRAM(30HDAMAGED, SUPPORTED BY STARBASE) GO TO 46 45 CALL CRAM(18HDAMAGED, RESERVES=) CALL CRAMF(LSUPRES,4,2) 46 CALL CREND GO TO 140 50 CALL CRAM(15H WARP FACTOR ) CALL CRAMF(WARPFAC,0,1) CALL CREND GO TO 140 60 CALL CRAM(15H ENERGY ) CALL CRAMF(ENERGY,0,2) CALL CREND GO TO 140 70 CALL CRAM(15H TORPEDOES ) CALL CRAMI(TORPS,0) CALL CREND GO TO 140 80 CALL CRAM(15H SHIELDS ) TJ=DOWN IF(SHLDUP.NE.0) TJ=UP IF(DAMAGE(8) .GT. 0) TJ=DAMAGD CALL CRAMS(TJ,8) J=100.0*SHLD/INSHLD+0.5 CALL CRAMI(J,0) CALL CRAM(5H% - ) J=SHLD CALL CRAMI(J,0) CALL CRAMDMP(6H UNITS) GO TO 140 90 CALL CRAM(15H KLINGONS LEFT ) CALL CRAMI(REMKL,0) CALL CREND GO TO 140 100 CALL CRAM(15H TIME LEFT ) CALL CRAMF(REMTIME,0,2) CALL CREND IF(LEFTSID) CALL PROUT(23H 1 2 3 4 5 6 7 8 9 10,23) 140 IF(K .EQ. 0) GO TO 150 K=0 RETURN 150 CONTINUE RETURN 160 CALL PROUT(22HS. R. SENSORS DAMAGED.,22) RETURN END