PROGRAM TRDEMO C C PROGRAM TO SPY ON MTREK C INCLUDE 'TRKCOMMON.FTN' REAL LAUNCH INTEGER SCAN,WHOM,CREW,HYPER,TORPS,WHO,IPRM(6) LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE BYTE SETUP(2),SETBCK(2),MESSAG,INITLS,A,CLEAR(10) LOGICAL*1 FLG DATA CLEAR/"33,'[','0',';','0','H',"33,'[','0','J'/ DATA SETUP/1,255/, SETBCK/1,80/ C C IU=1 CALL ATTUNI(I) CALL GETADR(IPRM(1),SETUP) IPRM(2)=2 CALL WTQIO("2440,5,1,,,IPRM) CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,15) OPEN (UNIT=5,NAME='TI:',RECL=512,TYPE='UNKNOWN') D WRITE (5,10001) D10001 FORMAT('$Enter ID number >> ') D READ (5,10002,ERR=32000) IDNUM D10002 FORMAT(I5) D IF (IDNUM.NE.7153) GOTO 32000 C C GET THE OPTION DESIRED (IF NOT FIRST TIME THROUGH) C 10000 CALL WTQIO ("2000,1,1) ! DETACH THE TERMINAL WRITE (5,10016) CLEAR 10016 FORMAT(' ',10A1) WRITE (5,10017) 10017 FORMAT(/,' The following options are available:',//, 1 ' F - display full screen',/, 2 ' S - display individual ship',/, 3 ' H - display individual black hole',/, 4 ' C - reconfigure program options',/, 5 ' D - change data for a ship',/, 5 ' P - display system parameters',/, 5 ' U - display ship/universe info',/, 5 ' X - exit',//, 5 ' Enter selection > ',$) READ (5,10018,END=32500) A 10018 FORMAT(A1) IF (A.EQ."106) GOTO 20000 IF (A.EQ."104.OR.A.EQ."123.OR.A.EQ."110) GOTO 30000 IF (A.EQ."130) GOTO 32500 IF (A.EQ."120) CALL SYSPAR(IU) IF (A.EQ."125) CALL UNIPAG IF (A.NE."103) GOTO 10000 WRITE (5,10016) CLEAR CALL CONFIG(IU) GOTO 10000 C C DISPLAY FULL SCREEN C 20000 CALL GETCHR ! REENABLE AST'S CALL DISALL(ICHAR,IU) IF (ICHAR.EQ."130) GOTO 32500 IF (ICHAR.NE."123.OR.ICHAR.NE."110) GOTO 10000 CALL WTQIO ("2000,1,1) ! DETACH THE TERMINAL WRITE (5,10016) CLEAR A=INCHAR C C DISPLAY DESIRED SHIP C 30000 WRITE (5,30001) 30001 FORMAT (' Enter ship number > ',$) READ (5,30002) WHO 30002 FORMAT (I1) IF (A.EQ."123.AND.WHO.LT.1.OR.WHO.GT.8) GOTO 10000 IF (A.EQ."104) GOTO 31000 FLG = .FALSE. IF (A.EQ."110.AND.WHO.EQ.0) FLG=.TRUE. IF (FLG) GOTO 30003 C IF (A.EQ."110.AND.(WHO.LT.1.OR.WHO.GT.IHOLE)) GOTO 10000 30003 CALL GETCHR ! REENABLE AST'S CALL DISSHP(WHO,ICHAR,A,FLG,IU) IF (ICHAR.EQ."130) GOTO 32500 IF (ICHAR.EQ."106) GOTO 20000 GOTO 10000 31000 CALL CNGSHP(WHO) GOTO 10000 C C D32000 TYPE *, '** Invalid ID number, access denied **' D GOTO 32767 32500 WRITE (5,32501) CLEAR 32501 FORMAT (' ',10A1) 32767 CALL GETADR(IPRM(1),SETBCK) IPRM(2)=2 CALL WTQIO("2440,5,1,,,IPRM) STOP END