Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part07 < prev next >

Wrap

Internet Message Format | 1993-04-06 | 14.5 KB

Path: uunet!haven.umd.edu!darwin.sura.net!zaphod.mps.ohio-state.edu!usc!elroy.jpl.nasa.gov!decwrl!concert!lester.appstate.edu!pembvax1.pembroke.edu!rennie From: rennie@pembvax1.pembroke.edu Newsgroups: vmsnet.sources.games Subject: Star Trek - Part [07/18] Date: 7 Apr 93 10:51:10 EDT Organization: Pembroke State University Lines: 469 Message-ID: <1993Apr7.105110.1@pembvax1.pembroke.edu> NNTP-Posting-Host: papa.pembroke.edu Xref: uunet vmsnet.sources.games:649 -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ XC`09CRAMSPI CRAMS THE INTEGER NUMBER 'NUM', FOLLOWED BY THE ASCII STRING XC`09'STRING', FOLLOWED BY THE STRING 'SEND' IF NUM .EQ. 1, OR THE XC`09STRING 'PEND' IF NUM .NE. 1. XC X`09CALL CRAMI(NUM,0) X`09CALL CRAM(' ') X`09CALL CRAM(STRING) X`09IF(NUM.EQ.1)CALL CRAM(SEND) X`09IF(NUM.NE.1)CALL CRAM(PEND) X`09RETURN X`09END $ CALL UNPACK TRCRAMSP.FOR;1 375922015 $ create 'f' X SUBROUTINE CRMSENA(II,JJ,KK,LL)`20 X`09LOGICAL*1 II X CALL CRAM3AS XC*`20 X ENTRY CRMENA`20 XC*`20 X CALL CRAMEN(II)`20 X CALL CRAM(3H AT) X CALL CRAMLOC(JJ,KK,LL) X RETURN X END`20 $ CALL UNPACK TRCRMSENA.FOR;1 2082150202 $ create 'f' X`09INTEGER FUNCTION CROP(ITEM,COMMAND) X`09BYTE ITEM(8),COMMAND(8),IT X`09CROP = .FALSE. X`09IF (ITEM(1).NE.COMMAND(1)) RETURN X`09DO 1 I=2,8 X`09IT=ITEM(I) X`09IF (IT.EQ.' '.OR.IT.EQ.0) GO TO 2 X`09IF (IT.NE.COMMAND(I)) RETURN X1`09CONTINUE X2`09CROP = .TRUE. X`09RETURN X`09END $ CALL UNPACK TRCROP.FOR;1 91554704 $ create 'f' X SUBROUTINE DEADKL(IX,IY,TYPE,IXX,IYY)`20 X`09INCLUDE 'TREKCOM/NOLIST' X EQUIVALENCE (KSTUF(1),ITHERE) `20 X BYTE TYPE X CALL CRMSENA(TYPE,2,IXX,IYY) XC--------DECIDE WHAT KIND OF ENEMY IT IS, AND UPDATE APPROPRIATELY X IF(TYPE .EQ. IHT) GO TO 30 X IF(TYPE .EQ. IHR) GO TO 27 X GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-100`20 X KLHERE=KLHERE-1`20 X REMKL=REMKL-1`20 X IF(TYPE .EQ. IHK) GO TO 25 X IF(TYPE .EQ. IHS) GO TO 26 XC--------CHALK UP A COMMANDER`20 X COMHERE=0`20 X DO 10 I=1,REMCOM X IF(CX(I) .EQ. QUADX .AND. CY(I) .EQ. QUADY)GO TO 15`20 X10 CONTINUE X15 CX(I)=CX(REMCOM) X CY(I)=CY(REMCOM) X CX(REMCOM)=0`20 X`09CY(REMCOM)=0 X REMCOM=REMCOM-1`20 X FUTURE(2)=1E38`20 X IF(REMCOM.GT.0) FUTURE(2)=DATE+EXPRAN(FLOAT(INCOM/REMCOM)) `20 X KILLC=KILLC+1`20 X GO TO 30 XC--------CHALK UP AN ORDINARY KLINGON`20 X 25 KILLK=KILLK+1`20 X GO TO 30 XC--------CHALK UP THE (GULP) <SUPER-COMMANDER>.`20 X26`09NSCREM=0 X`09ISHERE=0 X`09ISX=0 X`09ISY=0 X`09NSCKILL=1 X ISATB=0 X`09ISCATE=0 X FUTURE(6)=1E38`20 X`09FUTURE(7)=1E38 X GO TO 30 XC--------CHALK UP A ROMULAN. X 27 NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY) -10`20 X IRHERE=IRHERE-1`20 X`09NROMKL=NROMKL+1 X`09NROMREM=NROMREM-1 XC--------FOR EACH KIND OF ENEMY, FINISH MESSAGE TO PLAYER`20 X 30 CALL CRAMDMP(12H DESTROYED. )`20 X QUAD(IX,IY)=IHDOT`20 X IF(REMKL .EQ. 0) RETURN`20 X REMTIME=REMRES/(REMKL+4*REMCOM)`20 XC-------IF ENEMY IS A THOLIAN, SET ITHERE=0 AND RETURN `20 X IF(TYPE.EQ.IHT) ITHERE=0 X IF(TYPE.EQ.IHT) RETURN X `20 XC--------REMOVE ENEMY SHIP FROM ARRAYS DESCRIBING LOCAL CONDITIONS X DO 40 I=1,NENHERE`20 X IF(KX(I) .EQ. IX .AND. KY(I) .EQ. IY)GO TO 45`20 X40 CONTINUE X 45 NENHERE=NENHERE-1`20 X IF(I .GT. NENHERE) GO TO 55`20 X DO 50 J=I,NENHERE`20 X KX(J)=KX(J+1)`20 X KY(J)=KY(J+1)`20 X KPOWER(J)=KPOWER(J+1)`20 X 50 KDIST(J)=KDIST(J+1)`20 X55`09KX(NENHERE+1)=0 X`09KY(NENHERE+1)=0 X`09KDIST(NENHERE+1)=0 X`09KPOWER(NENHERE+1)=0 X RETURN X END`20 $ CALL UNPACK TRDEADKL.FOR;1 1728122431 $ create 'f' X SUBROUTINE DESTRCT X`09INCLUDE 'TREKCOM/NOLIST' X`09LOGICAL*1 ISHIP X`09REAL*8 IPASS,AITEM X`09COMMON/SCANBF/KEY,AITEM X`09EQUIVALENCE(SHIP,ISHIP) X IF(DAMAGE(11) .EQ. 0) GO TO 5`20 X CALL PROUT(`20 X + 51HCOMPUTER DAMAGED; CANNOT EXECUTE DESTRUCT SEQUENCE.,51) X RETURN X 5 CALL SKIP(1) X CALL PROUT(13H---WORKING---,13) X CALL PROUT(24HIDENTIFICATION-POSITIVE;,24)`20 X CALL PROUT(32HSELF-DESTRUCT-SEQUENCE-ACTIVATED,32)`20 X CALL PROUT( 5H 10,5) X CALL PROUT( 8H 9,8)`20 X CALL PROUT(11H 8,11) X CALL PROUT(14H 7,14)`20 X CALL PROUT(17H 6,17) X CALL PROUT(35HENTER-CORRECT-PASSWORD-TO-CONTINUE-,35) X CALL PROUT(33HSELF-DESTRUCT-SEQUENCE-OTHERWISE-,33) X CALL PROMPT(40HSELF-DESTRUCT-SEQUENCE-WILL-BE-ABORTED: ,40)`20 X CALL SCAN X IF(AITEM .NE. PASSWD) GO TO 30 X CALL PROUT(17HPASSWORD-ACCEPTED,17) X CALL PROUT(11H 5,11) X CALL PROUT(14H 4,14)`20 X CALL PROUT(17H 3,17) X CALL PROUT(20H 2,20)`20 X CALL PROUT(23H 1,23) X IF(RANF(0) .LT. 0.05) CALL PROUT(19HGOODBYE-CRUEL-WORLD,19) X CALL SKIP(2) XC*`20 X ENTRY KABOOM XC*`20 X CALL STARS X IF(ISHIP .EQ. IHE) CALL CRAM3AS X CALL CRAM(21H********* ENTROPY OF )`20 X CALL CRAMSHP X CALL CRAMDMP(20H MAXIMIZED *********)`20 X CALL STARS X CALL SKIP(1) X IF(NENHERE .EQ. 0) GO TO 20`20 X WHAMMO=25.0*ENERGY X DO 10 L=1,NENHERE`20 X IF(KPOWER(L)*KDIST(L) .GT. WHAMMO) GOTO 10`20 X II=KX(1)`09`09!DEADKL SORTS THE KX AND KY ARRAYS AND X JJ=KY(1)`09`09!REDUCES THE SIZE X CALL DEADKL(II,JJ,QUAD(II,JJ),II,JJ) X 10 CONTINUE X 20 CALL FINISH(10)`20 X RETURN X 30 CALL PROUT(18HPASSWORD-REJECTED;,18)`20 X CALL PROUT(19HCONTINUITY-EFFECTED,19) `20 X CALL SKIP(2) X RETURN X END`20 $ CALL UNPACK TRDESTRCT.FOR;1 841308314 $ create 'f' X SUBROUTINE DOCK`20 X`09INCLUDE 'TREKCOM/NOLIST' X IDIDIT=0 X IF(CONDIT .EQ. IHDOCKD) GO TO 30`20 X IF(INORBIT.NE.0) GO TO 40 `20 X IF(BASEX .EQ. 0) GO TO 5 X IF(IABS(SECTX-BASEX).LE.1 .AND. IABS(SECTY-BASEY).LE.1)GO TO 10`20 X5 CALL CRAMSHP X CALL CRAMDMP(22H NOT ADJACENT TO BASE.)`20 X RETURN X10 CONDIT = IHDOCKD X CALL PROUT(7HDOCKED.,7)`20 X IDIDIT=1 X IF(ENERGY .LT. INENRG) ENERGY=INENRG X SHLD=INSHLD`20 X TORPS=INTORPS`20 X LSUPRES=INLSR`20 X RETURN X 30 CALL PROUT(15HALREADY DOCKED.,15) X RETURN X 40 CALL PROUT(36HYOU MUST FIRST LEAVE STANDARD ORBIT.,36)`20 X RETURN X END`20 $ CALL UNPACK TRDOCK.FOR;1 759313056 $ create 'f' X SUBROUTINE DREPORT X`09INCLUDE 'TREKCOM/NOLIST' X INTEGER HDEVICE(40),NAME(2)`20 X JDAM=0 X DO 20 L=1,NDEVICE`20 X IF(DAMAGE(L) .LE. 0) GO TO 20`20 X IF(JDAM .NE. 0) GO TO 10 X CALL SKIP(1) X CALL PROUT(35HDEVICE -REPAIR TIMES-,35) X CALL PROUT(37H IN FLIGHT DOCKED,37) X JDAM=1 X10 CALL CRAM(2H )`20 X CALL CRAMS(DEVICE(2*L-1,1),16)`20 X IF(L.NE.14) CALL CRAMF(DAMAGE(L)+0.005,5,2)`20 X IF(L.EQ.14) CALL CRAM(5H - ) `20 X CALL CRAMF(DOCKFAC*DAMAGE(L)+0.005,10,2) X CALL CREND X 20 CONTINUE X IF(JDAM .EQ. 0) CALL PROUT(23HALL DEVICES FUNCTIONAL.,23) X RETURN X END`20 $ CALL UNPACK TRDREPORT.FOR;1 1970078264 $ create 'f' X SUBROUTINE DROPIN(IQUAD,IX,IY) X`09INCLUDE 'TREKCOM/NOLIST' X 10 CALL IRAN10(IX,IY) X IF(QUAD(IX,IY) .NE. IHDOT) GO TO 10`20 X QUAD(IX,IY)=IQUAD`20 X RETURN `20 X END`20 $ CALL UNPACK TRDROPIN.FOR;1 1213092084 $ create 'f' X$! TREKBLD.COM X$! X$! COMMAND PROCEDURE TO BUILD STARTREK X$! X$ SET NOON X$ INQ D "DO YOU WANT TO BUILD A DEBUGGING VERSION?" X$ DEBUGC :== "" X$ DEBUGL :== "" X$ IF D THEN DEBUGC := "/DEBUG=ALL" X$ IF D THEN DEBUGL := "/DEBUG" X$ INQ C "DO YOU WANT A CROSS-REFERENCE?" X$ CREF := "" X$ IF C THEN CREF := "/CROSS" X$ COMPOK == 1 X$ BLAB == 1 X$ INQ C "DO YOU WANT TO COMPILE ANYTHING?" X$ IF .NOT.C THEN GOTO LINK X$ INQ C "DO YOU WANT TO COMPILE EVERYTHING?" X$ IF .NOT.C THEN GOTO COMPSOME X$! X$ @TREKCOM TRABANDON X$ @TREKCOM TRATTACK X$ @TREKCOM TRAUTOVER X$ @TREKCOM TRCANTA X$ @TREKCOM TRCHART X$ @TREKCOM TRCHOOSE X$ @TREKCOM TRCRAM X$ @TREKCOM TRCRAMEN X$ @TREKCOM TRCRAMLOC X$ @TREKCOM TRCRAMSHP X$ @TREKCOM TRCRAMSP X$ @TREKCOM TRCRMSENA X$ @TREKCOM TRCROP X$ @TREKCOM TRDEADKL X$ @TREKCOM TRDESTRCT X$ @TREKCOM TRDOCK X$ @TREKCOM TRDREPORT X$ @TREKCOM TRDROPIN X$ @TREKCOM TREMEXIT X$ @TREKCOM TREVENTS X$ @TREKCOM TREXPRAN X$ @TREKCOM TRFINISH X$ @TREKCOM TRFREEZE X$ @TREKCOM TRGETCD X$ @TREKCOM TRGETFN X$ @TREKCOM TRGETOUT X$ @TREKCOM TRHELP X$ @TREKCOM TRHITEM X$ @TREKCOM TRIMPULSE X$ @TREKCOM TRIRAN8 X$ @TREKCOM TRJA X$ @TREKCOM TRLRSCAN X$ @TREKCOM TRMOVE X$ @TREKCOM TRMOVECOM X$ @TREKCOM TRMOVETHO X$ @TREKCOM TRNEWCOND X$ @TREKCOM TRNEWQUAD X$ @TREKCOM TRNOVA X$ @TREKCOM TRPHASERS X$ @TREKCOM TRPHOTONS X$ @TREKCOM TRPLANET X$ @TREKCOM TRPLAQUE X$ @TREKCOM TRPRELIM X$ @TREKCOM TRPROUT X$ @TREKCOM TRRAM X$ @TREKCOM TRRANF X$ @TREKCOM TRSCAN X$ @TREKCOM TRSCOM X$ @TREKCOM TRSCORE X$ @TREKCOM TRSETUP X$ @TREKCOM TRSETWARP X$ @TREKCOM TRSHIELDS X$ @TREKCOM TRSKIP X$ @TREKCOM TRSNOVA X$ @TREKCOM TRSORTKL X$ @TREKCOM TRSRSCAN X$ @TREKCOM TRTREK X$ @TREKCOM TRTHAW X$ @TREKCOM TRTIMEWRP X$ @TREKCOM TRWAIT X$ @TREKCOM TRWARP X$ @TREKCOM TRZAP X$ GOTO LINK X$! X$COMPSOME: X$ BLAB==0 X$ INQ M "TYPE MODULE TO COMPILE, OR RETURN TO LINK" X$ IF M .EQS. "" THEN GOTO LINK X$ @TREKCOM TR'M' X$ GOTO COMPSOME X$!`20 X$LINK: X$ IF .NOT.COMPOK THEN GOTO QUIT X$ IF BLAB THEN WRITE SYS$OUTPUT "Linking..." X$ FILE = F$SEARCH("*.EXE;*") X$ IF FILE .NES. "" THEN DELETE/NOCONFIRM TREK.EXE;* X$ FILE = F$SEARCH("*.MAP;*") X$ IF FILE .NES. "" THEN DELETE/NOCONFIRM TREK.MAP;* X$ LINK/EXEC=TREK'DEBUGL''CREF' - X`09TRABANDON+`09TRATTACK+`09TRAUTOVER+`09TRCANTA+- X`09TRCHART+`09TRCHOOSE+`09TRCRAM+`09`09TRCRAMEN+- X`09TRCRAMLOC+`09TRCRAMSHP+`09TRCRAMSP+`09TRCRMSENA+- X`09TRCROP+`09`09TRDEADKL+`09TRDESTRCT+`09TRDOCK+- X`09TRDREPORT+`09TRDROPIN+`09TREMEXIT+`09TREVENTS+- X`09TREXPRAN+`09TRFINISH+`09TRFREEZE+`09TRGETCD+- X`09TRGETFN+`09TRGETOUT+`09TRHELP+`09`09TRHITEM+- X`09TRIMPULSE+`09TRIRAN8+`09TRJA+`09`09TRLRSCAN+- X`09TRMOVE+`09`09TRMOVECOM+`09TRMOVETHO+`09TRNEWCOND+- X`09TRNEWQUAD+`09TRNOVA+`09`09TRPHASERS+`09TRPHOTONS+- X`09TRPLANET+`09TRPLAQUE+`09TRPRELIM+`09TRPROUT+- X`09TRRAM+`09`09TRRANF+`09`09TRSCAN+`09`09TRSCOM+- X`09TRSCORE+`09TRSETUP+`09TRSETWARP+`09TRSHIELDS+- X`09TRSKIP+`09`09TRSNOVA+`09TRSORTKL+`09TRSRSCAN+- X`09TRTREK+`09`09TRTHAW+`09`09TRTIMEWRP+`09TRWAIT+- X`09TRWARP+`09`09TRZAP X$! X$QUIT: X$ DELETE/NOCONFIRM *.OBJ;* X$ EXIT $ CALL UNPACK TREKBLD.COM;1 1299317161 $ create 'f' X$! TREKCOM.COM X$! X$! COMPILE A STARTREK MODULE (OR ANY MODULE, FOR THAT MATTER) X$! X$ SET NOON X$ WRITE SYS$OUTPUT "Compiling ''P1'" X$ ASSIGN/USER NL: SYS$OUTPUT X$ ASSIGN/USER NL: SYS$ERROR X$ DELETE/NOCONFIRM 'P1'.OBJ;* X$ ASSIGN/USER NL: SYS$OUTPUT X$ ASSIGN/USER NL: SYS$ERROR X$ DELETE/NOCONFIRM 'P1'.LIS;* X$ FORTRAN/NOCHECK'DEBUGC' 'P1' X$ COMPOK == COMPOK .AND. $STATUS $ CALL UNPACK TREKCOM.COM;1 1611039306 $ create 'f' XC XC`09TREKCOM.FOR`09INCLUDE FILE TO DEFINE COMMONS FOR STARTREK XC XC`0926-APR-79 XC XC`09BLANK COMMON; THIS IS THE GLOBAL DATABASE FOR STARTREK, XC`09AND CONTAINS ALL INFORMATION NECESSARY TO DETERMINE THE XC`09STATE OF THE GAME. XC XC`09THE PARAMETER COMSIZE DEFINES THE SIZE OF THE COMMON XC`09IN STORAGE ELEMENTS. IT MAY NEED TO BE CHANGED IF THINGS ARE XC`09ADDED TO THE COMMON IN ORDER TO MAKE FREEZE AND THAW XC`09WORK PROPERLY. ALWAYS MAKE SURE THAT THE SIZE OF THE XC`09ARRAY ICOM IS THE SAME AS THE SIZE OF BLANK COMMON. XC`09IF THEY ARE NOT THE SAME SIZE, CHANGE COMSIZE APPROPRIATELY. XC X`09PARAMETER COMSIZE=1222 XC X`09COMMON SNAP,SNAPSHT(226),`20 X`091 DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, X`092 KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5),`20 X`093 NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, X`094 NSCKILL,ICRYSTL,NPLANKL,`20 X`095 QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), `20 X`096 INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, X`097 INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP,`20 X`098 QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20),`20 X`099 LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC,`20 X`091 KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8),FUTURE(10),`20 X`092 DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, X`093 DAMFAC,SHLDCHG,THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT, X`094 LANDED,IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, X`095 IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE,IPHWHO,BATX,BATY,`20 X`096 CRACKS(12), X`097 ICSOS,ISSOS,ISUBDAM X`09INTEGER SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS, X`091 REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY,`20 X`092 SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON,`20 X`093 ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG,`20 X`094 THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS X`09REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD, `20 X`091 INENRG,INLSR`20 X`09BYTE QUAD X`09REAL*8 DEVICE,PASSWD XC XC`09ICOM IS AN ARRAY THAT ENCOMPASSES THE ENTIRE COMMON. IT IS XC`09USED TO FREEZE AND THAW GAMES. XC X`09INTEGER ICOM(COMSIZE) X`09EQUIVALENCE (ICOM,SNAP) XC XC`09COMMON HOLLER; THIS COMMON CONTAINS FREQUENTLY USED CHARACTERS XC`09AND TEXT STRINGS. THEIR VALUES ARE DEFINED BY DATA STATEMENTS XC`09IN THE MODULE STARTRK. XC X`09LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB, X`091 IHSTAR,IHT,IHQUEST,IHNUM X`09COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED,`20 X`091 IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB, X`092 IHT,IHNUM `20 XC $ CALL UNPACK TREKCOM.FOR;1 1112500640 $ create 'f' X`09SUBROUTINE EMEXIT XC XC`0913-APR-79 (NEW ROUTINE) XC`09EMERGENCY EXIT - FREEZE THE GAME ON 'EMSAVE.TRK', ERASE THE XC`09SCREEN, AND BUG OUT. XC X`09INCLUDE 'TREKCOM/NOLIST' X`09CALL CLOSE(2) X`09OPEN(UNIT=2,NAME='SYS$DISK:EMSAVE.TRK',TYPE='UNKNOWN', X`091 FORM='UNFORMATTED',ERR=920) X`09WRITE(2,ERR=920) COMSIZE,ICOM X`09CALL CLOSE(2) X920`09CALL GETOUT X RETURN X END`20 $ CALL UNPACK TREMEXIT.FOR;1 1182078798 $ create 'f' X SUBROUTINE EVENTS`20 XC XC`0923-OCT-79 XC`09CANCEL TYPEAHEAD WHEN A TRACTOR BEAM OCCURS XC X`09INCLUDE 'TREKCOM/NOLIST' X DIMENSION PICTURE(226) X EQUIVALENCE (PICTURE,DATE),(CRACKS(5),ITYPE) X DATA NEVENTS/7/`20 X ICTBEAM=0`20 X`09ISTRACT=0 XC--------SELECT EARLIEST EXTRANEOUS EVENT (LINE=0 IF NO EVENTS)`20 X 10 LINE=0 X IF(ALLDONE.NE.0) RETURN`20 X DATEMIN=DATE+TIME`20 X DO 20 L=1,NEVENTS`20 X IF(FUTURE(L) .GT. DATEMIN) GO TO 20`20 X LINE=L X DATEMIN=FUTURE(L)`20 X 20 CONTINUE +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+-