SUBROUTINE SRSCAN CALL SCANIN(1) RETURN END SUBROUTINE REQUST CALL SCANIN(2) RETURN END SUBROUTINE STATUS CALL SCANIN(3) RETURN END SUBROUTINE SCANIN(IZ) INCLUDE 'TREK.COM/-LI' INCLUDE 'TREK2.COM/-LI' BYTE BITEM LOGICAL LFTSID,RITSID ,CROP REAL*8 REQUST(10),AITEM,DAMAGD,UP,DOWN,TJ EQUIVALENCE (AITEM,BITEM) COMMON/SCANBF/KEY,AITEM DATA REQUST /4HDATE,8HCONDITIO,8HPOSITION,8HLSUPPORT,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. IHDCKD) GOTO 160 LFTSID=.TRUE. RITSID=.TRUE. CALL SCAN IF(KEY .EQ. IHEOL) GO TO 3 IF(BITEM .EQ. 78) RITSID = .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. IHALPH) 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 LFTSID=.FALSE. 4 DO 150 I=1,10 JJ=I IF(K.NE.0) JJ=K IF(.NOT. LFTSID) 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(RITSID)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. IHDCKD ) CALL NUCOND CALL CRAM(15H CONDITION ) IF(CONDIT.EQ.IHGRN) CALL CRMDPS('GREEN',5) IF(CONDIT.EQ.IHRED) CALL CRMDPS('RED',3) IF(CONDIT.EQ.IHYELO) CALL CRMDPS('YELLOW',6) IF(CONDIT.EQ.IHDCKD) CALL CRMDPS('DOCKED',6) GO TO 140 30 CALL CRAM(14H POSITION ) CALL CRMLOC(0,QUADX,QUADY) CALL CRAM(1H,) CALL CRMLOC(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(LSUPRS,4,2) 46 CALL CREND GO TO 140 50 CALL CRAM(15H WARP FACTOR ) CALL CRAMF(WRPFAC,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 CRMDMP(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(RMTIME,0,2) CALL CREND IF(LFTSID) 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