diff --git a/games/Super_Star_trek_(FORTRAN)/build_TRTREK b/games/Super_Star_trek_(FORTRAN)/build_TRTREK new file mode 100644 index 0000000..5c892a8 --- /dev/null +++ b/games/Super_Star_trek_(FORTRAN)/build_TRTREK @@ -0,0 +1,8392 @@ +DELETE F7:TRABAND +EDIT +BUILD F7:TRABAND + SUBROUTINE ABANDON + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP + INTEGER ISHIP + EQUIVALENCE(ISHIP,SHIP) + IF(DAMAGE(10)) 5,15,10 + 5 IF(DAMAGE(10) .EQ. -1.) GO TO 6 + CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,36) + RETURN + 6 CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT.,38) + RETURN + 10 CALL PROUT(22HSHUTTLE CRAFT DAMAGED.,22) + RETURN + 15 IF((LANDED .NE. 1) .AND. (ICRAFT .NE. 1)) GO TO 16 + CALL PROUT(34HYOU MUST BE ABOARD THE ENTERPRISE. ,34) + RETURN + 16 IF(ISCRAFT .EQ. 1) GO TO 17 + CALL PROUT(38HSHUTTLE CRAFT NOT CURRENTLY AVAILABLE. ,38) + RETURN +C--------PRINT ABANDON SHIP MESSAGES + 17 CALL SKIP(1) + CALL PROUT(31H***ABANDON SHIP! ABANDON SHIP!,31) + CALL PROUT(26H***ALL HANDS ABANDON SHIP!,26) + CALL SKIP(1) + CALL PROUT( + + 41HCAPTAIN AND CREW ESCAPE IN SHUTTLE CRAFT.,41) + CALL PROUT( + + 41HREMAINDER OF SHIP'S COMPLEMENT BEAM DOWN ,41) + CALL PROUT( + + 28HTO NEAREST HABITABLE PLANET.,28) +C--------IF THERE ARE NO STARBASES LEFT, GAME IS OVER + IF(REMBASE .NE. 0) GO TO 20 + CALL FINISH(9) + RETURN +C--------IF THERE IS AT LEAST ONE BASE LEFT, YOU GET THE FAERIE QUEENE + 20 CALL SKIP(1) + CALL PROUT( + + 44HYOU ARE CAPTURED BY KLINGONS AND RELEASED TO,44) + CALL PROUT( + + 45HTHE FEDERATION IN A PRISONER-OF-WAR EXCHANGE.,45) + CALL PROUT( + + 46HSTARFLEET PUTS YOU IN COMMAND OF ANOTHER SHIP,,46) + CALL PROUT(42HTHE FAERIE QUEENE, WHICH IS ANTIQUATED BUT,42) + CALL PROUT(14HSTILL USEABLE.,14) +C--------SELECT BASE AT WHICH TO BEGIN AGAIN + NB=RANF(0)*REMBASE+1 +C--------RESET FLAGS. + ICRYSTL=0 + IMINE=0 + ISCATE=0 +C--------SET UP QUADRANT AND POSITION F. Q. ADJACENT TO BASE + QUADX=BASEQX(NB) + QUADY=BASEQY(NB) + 40 SECTX=5 + SECTY=5 + CALL NEWQUAD + QUAD(SECTX,SECTY)=IHDOT + DO 50 L=1,3 + SECTX=3.0*RANF(0)-1.0+BASEX + IF(SECTX .LT. 1 .OR. SECTX .GT. 10) GO TO 50 + SECTY=3.0*RANF(0)-1.0+BASEY + IF(SECTY .LT. 1 .OR. SECTY .GT. 10) GO TO 50 + IF(QUAD(SECTX,SECTY) .EQ. IHDOT) GO TO 60 + 50 CONTINUE + GO TO 40 + 60 ISHIP=IHF + QUAD(SECTX,SECTY)=IHF +C--------CLEAR AND RESUPPLY SHIP + CONDIT=IHDOCKD + DO 70 L=1,NDEVICE + 70 DAMAGE(L)=0 + DAMAGE(10)=-1 + INENRG=3000.0 + ENERGY=3000.0 + INSHLD=1250. + SHLD=1250.0 + INTORPS=6 + TORPS=6 + INLSR=3.0 + LSUPRES=3.0 + SHLDUP=0 + WARPFAC=5.0 + WFACSQ=25.0 + RETURN + END + +END +DELETE F7:TRATTAK +EDIT +BUILD F7:TRATTAK + SUBROUTINE ATTACK + INCLUDE F7:TREKCOM +C LOGICAL*1 IQUAD + INTEGER IQUAD + INTEGER PERCENT + EQUIVALENCE (CRACKS(1),HIT),(CRACKS(3),IHURT),(CRACKS(4),L) + EQUIVALENCE (CRACKS(6),KDIDIT) + EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) + IF(ALLDONE.NE.0) RETURN + IF(ITHERE.NE.0) CALL MOVETHO + IF(NEUTZ .EQ. 0) GO TO 1 + NEUTZ=0 + RETURN + 1 IF((((COMHERE.NE.0) .OR. (ISHERE.NE.0)).AND.(JUSTIN.EQ.0)).OR. + 1(KSTUF(5).EQ.2 + + )) CALL MOVECOM + IF(NENHERE.EQ. 0) RETURN + IHURT=0 + CALL SKIP(1) +C--------ALLOW EACH KLINGON IN TURN TO DO HIS DAMNEDEST + HITMAX=0.0 + HITTOT=0.0 + ATTCKD=0 +C--------LOOP FOR ENEMY ATTACKS STARTS HERE + L=0 + 5 L=L+1 + IF(L .GT. NENHERE) GO TO 80 +C--------IF ENTERPRISE IS DOCKED DON'T HIT IT. + IF(CONDIT.NE.IHDOCKD) GO TO 6 + CALL CRAM( + +41HENEMIES ATTACK, STARBASE SHIELDS PROTECT ,41) + CALL CRAMSHP + CALL CREND + CALL SKIP(1) + RETURN +C--------IF KPOWER IS LT ZERO THEN ENEMY CAN'T ATTACK. + 6 IF(KPOWER(L) .LT. 0)GO TO 5 + ATTCKD=1 +C--------COMPUTE HIT STRENGTH AND DIMINISH SHIELD POWER + DUSTFAC=0.80+0.05*RANF(0) + HIT=KPOWER(L)*DUSTFAC**KDIST(L) + II=KX(L) + JJ=KY(L) + IQUAD=QUAD(II,JJ) +C--------DECIDE IF ENEMY SHOULD FIRE PHOTON TORPEDO + IF(HIT .GT. 400.0 .OR. JUSTIN .EQ. 1) GO TO 10 + IF(HIT .GT. 300.0 .AND. KDIST(L) .GT. 5.0) GO TO 10 + IF(IQUAD .EQ. IHK .AND. RANF(0) .GT. 0.10) GO TO 10 +C--------ENEMY FIRES PHOTON TORPEDO. + IPHWHO=1 + CALL KPHOTON + IPHWHO=IHGREEN + KDIDIT=1 + IF(ALLDONE .EQ. 1 .OR. GALAXY(QUADX,QUADY) .EQ. 1000) RETURN + GO TO 5 +C--------ENEMIES FIRE PHASER-LIKE WEAPONS + 10 CALL ZAP + HITTOT=HITTOT+HIT + HITMAX=AMAX1(HITMAX,HIT) +C--------LOOP FOR ENEMY ATTACKS ENDS HERE + GO TO 5 + 80 IF(ATTCKD .EQ. 0 .OR. HITTOT .EQ. 0.0) RETURN + IF(ENERGY .LE. 0) GO TO 100 + PERCENT=100.0*SHLD/INSHLD + 0.5 + IF(IHURT.NE.0)GO TO 85 +C--------PRINT MESSAGE IF SHIELDS FULLY PROTECTED STARSHIP + CALL CRAM(35HENEMIES ATTACK--SHIELDS REDUCED TO ,35) + GO TO 90 +C--------PRINT MESSAGE IF STARSHIP ITSELF SUFFERED HITS + 85 CALL SKIP(1) + CALL CRAM(12HENERGY LEFT ,12) + CALL CRAMF(ENERGY,0,2) + CALL CRAM(19H TORPEDOES LEFT ,19) + CALL CRAMI(TORPS,0) + CALL CRAM(12H SHIELDS ,12) + IF(SHLDUP.NE.0) CALL CRAM(4HUP, ,4) + IF(SHLDUP .EQ. 0 .AND. DAMAGE(8) .EQ. 0) CALL CRAM(6HDOWN, ,6) + IF(DAMAGE(8) .GT. 0) CALL CRAM(9HDAMAGED, ,9) + 90 CALL CRAMI(PERCENT,0) + CALL CRAMDMP(1H%,1) +C--------CHECK IF ANYONE WAS HURT + IF(HITMAX.LT.200.0 .AND. HITTOT.LT.500.0) GO TO 120 + HIT=HITTOT + CALL CASULTY + GO TO 120 +C--------RETURNING HOME UPON YOUR SHIELD, NOT WITH IT... + 100 CALL FINISH(5) + RETURN +C--------AFTER ATTACK, SORT OUT ENEMIES + 120 CALL SORTKL + RETURN + END + +END +DELETE F7:TRAUTOV +EDIT +BUILD F7:TRAUTOV + SUBROUTINE AUTOVER +C +C 23-APR-79 +C CHANGE 'INSUFFICIENT ENERGY' MESSAGE TO ONE WHICH IS +C APPROPRIATE FOR ALL CASES. +C + INCLUDE F7:TREKCOM + II=16 + IGRAB=0 + GO TO 5 +C* + ENTRY GRAB +C* + IGRAB=1 + II=14 +C--------CHECK TO SEE IF CAPTAIN ON A PLANET + 5 IF(LANDED .NE. 1) GO TO 45 + IF(DAMAGE(12) .GT. 0) GO TO 25 + CALL PROUT(42HSCOTTY RUSHES TO THE TRANSPORTER CONTROLS.,42) + IF(SHLDUP .EQ. 0) GO TO 20 + CALL PROUT(38HBUT WITH THE SHIELDS UP IT'S HOPELESS.,8) + GO TO 25 + 20 CALL CRAM(42HHIS DESPERATE ATTEMPT TO RESCUE YOU . . . ,42) + IF(RANF(0) .GT. 0.5) GO TO 30 + CALL CRAMDMP(6HFAILS. ,6) + 25 CALL FINISH(II) + RETURN + 30 CALL CRAMDMP(9HSUCCEEDS!,9) + IF(IMINE .EQ. 0) GO TO 45 + IMINE=0 + CALL CRAM(24HTHE CRYSTALS MINED WERE ,24) + IF(RANF(0) .GT. 0.25) GO TO 40 + CALL CRAMDMP(5HLOST.,5) + GO TO 45 + 40 CALL CRAMDMP(6HSAVED.,6) + ICRYSTL=1 + 45 IF(IGRAB.NE.0) RETURN +C--------CHECK TO SEE IF CAPTAIN IN SHUTTLE CRAFT + IF(ICRAFT.NE.0) CALL FINISH(17) + IF(ALLDONE.NE.0) RETURN +C--------INFORM CAPTAIN OF ATTEMPT TO REACH SAFETY + CALL SKIP(1) + IF(JUSTIN .EQ. 0) GO TO 50 + 47 CALL REDALRT + CALL CRAM(7H***THE ,7) + CALL CRAMSHP + CALL CRAMDMP(37H HAS STOPPED IN A QUADRANT CONTAINING,37) + CALL PROUT(15H A SUPERNOVA.,2) + CALL SKIP(1) + 50 CALL CRAM(49H***EMERGENCY AUTOMATIC OVERRIDE ATTEMPTS TO HURL ,49) + CALL CRAMSHP + CALL CREND + CALL PROUT(23HSAFELY OUT OF QUADRANT.,23) + STARCH(QUADX,QUADY)=1 +C--------TRY TO USE WARP ENGINES + IF(DAMAGE(6) .EQ. 0) GO TO 100 + CALL SKIP(1) + CALL PROUT(21HWARP ENGINES DAMAGED.,21) + CALL FINISH(8) + RETURN + 100 WARPFAC=6.0+2.0*RANF(0) + WFACSQ=WARPFAC*WARPFAC + CALL CRAM(19HWARP FACTOR SET TO ,19) + CALL CRAMF(WARPFAC,0,1) + CALL CREND + POWER=0.75*ENERGY + DISTMAX=POWER/(WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1)) + DISTREQ=1.4142+2.0*RANF(0) + DIST=AMIN1(DISTMAX,DISTREQ) + TIME=10.0*DIST/WFACSQ + DIREC=12.0*RANF(0) + JUSTIN=0 + INORBIT=0 + CALL WARPX + IF(ALLDONE.NE.0) RETURN + IF(JUSTIN.NE.0) GO TO 200 + CALL SKIP(1) + CALL CRAM('***',3) + CALL CRAMSHP + CALL CRAMDMP(' FAILS TO LEAVE QUADRANT.',25) + CALL FINISH(8) + RETURN +C--------REPEAT OVERRIDE IF SHIP JUMPED FROM ONE SUPERNOVA TO ANOTHER + 200 IF(GALAXY(QUADX,QUADY) .EQ. 1000) GO TO 47 + IF(REMKL .EQ. 0) CALL FINISH(1) + RETURN + END + +END +DELETE F7:TRCANTA +EDIT +BUILD F7:TRCANTA + SUBROUTINE CANTA +C +C 23-OCT-79 (NEW ROUTINE) +C CANCELS TYPEAHEAD AT THE TERMINAL +C +C CALL SYS$ASSIGN('TT',ICHAN,,) +C CALL SYS$QIOW(,`%VAL(ICHAN),`%VAL('0831'X),,,, +C 1 DUMMY,`%VAL(0),,,,) +C CALL SYS$DASSGN(`%VAL(ICHAN)) + RETURN + END + +END +DELETE F7:TRCHART +EDIT +BUILD F7:TRCHART + SUBROUTINE CHART + INCLUDE F7:TREKCOM + CALL PROUT(31HSTAR CHART FOR THE KNOWN GALAXY,31) + CALL SKIP(1) + CALL PROUT(42H 1 2 3 4 5 6 7 8,42) + CALL PROUT(44H ----------------------------------------,44) + CALL PROUT(3H :,3) + DO 50 I=1,8 + CALL CRAMI(I,1) + CALL CRAM(2H :,2) + DO 40 J=1,8 + IF(STARCH(I,J)) 10,20,30 + 10 CALL CRAM(5H .1.,5) + GO TO 40 + 20 CALL CRAM(5H ...,5) + GO TO 40 + 30 IF(STARCH(I,J) .GT. 999) GO TO 35 + CALL CRAMI(GALAXY(I,J),5) + GO TO 40 + 35 CALL CRAMI(STARCH(I,J)-1000,5) + 40 CONTINUE + CALL CREND + CALL PROUT(3H :,3) + 50 CONTINUE + CALL SKIP(1) + CALL CRAMSHP + CALL CRAM(16H IS CURRENTLY IN,16) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CREND + RETURN + END + +END +DELETE F7:TRCHOOS +EDIT +BUILD F7:TRCHOOS + SUBROUTINE CHOOSE(FROZEN) +C +C 25-APR-79 +C USE THE SYSTEM SERVICE SYS$GETTIM FOR THE RANDOM NUMBER SEED. +C THIS GREATLY REDUCES DEPENDENCE OF THE SEED ON TIME OF DAY. +C + INCLUDE F7:TREKCOM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + COMMON/PASS/PFLAG + LOGICAL PFLAG + INTEGER*4 ISEED(2) + LOGICAL FROZEN + LOGICAL CROP,NOMORE + REAL*8 AITEM,REGULAR,TOURNAMENT,FROZN,SHORT,MEDIUM,LONG + 1 ,NOVICE,FAIR,GOOD,EMERITUS,EXPERT,RHBLANK + EQUIVALENCE (AITEM,TNUMBER) + DATA REGULAR,TOURNAMENT,FROZN/7HREGULAR,8HTOURNAME,6HFROZEN/ + DATA SHORT,MEDIUM,LONG/5HSHORT,6HMEDIUM,4HLONG/ + DATA NOVICE,FAIR,GOOD,EXPERT/6HNOVICE,4HFAIR,4HGOOD,6HEXPERT/ + DATA EMERITUS,RHBLANK/8HEMERITUS,1H / + TNUMBER = 0. + PASSWD = RHBLANK + ALLDONE=0 + GAMEWON=0 +C CALL SYS$GETTIM(ISEED) +C CALL RANSET(ISEED(1)) + IPHWHO=0 + 5 FROZEN = .FALSE. +C--------ASK FOR PARAMETERS OF GAME, PREFERABLY ALL ON ONE LINE + CALL PROMPT( + +54HWOULD YOU LIKE A REGULAR, TOURNAMENT, OR FROZEN GAME? ,54) + CALL SCAN + CROPITEM=AITEM + CROPMATCH=REGULAR + IF(CROP()) GO TO 9 + CROPMATCH=TOURNAMENT + IF(CROP()) GO TO 100 + CROPMATCH=FROZN + IF(CROP()) GO TO 200 + GO TO 5 + 9 SKILL=0 + LENGTH=0 + IF(NOMORE()) GO TO 20 + 10 CALL SCAN + IF(KEY .NE. IHALPHA) GO TO 20 +C--------CHECK FOR DIFFERENT KINDS OF GAMES + KSTUF(5)=0 + CROPITEM=AITEM + CROPMATCH=SHORT + IF(.NOT.CROP()) GO TO 11 + LENGTH=1 + GO TO 13 + 11 CROPMATCH=MEDIUM + IF(.NOT.CROP()) GO TO 12 + LENGTH=2 + GO TO 13 + 12 CROPMATCH=LONG + IF(.NOT.CROP()) GO TO 20 + LENGTH=4 +C + 13 IF(NOMORE()) GO TO 25 + 14 CALL SCAN + IF(KEY .NE. IHALPHA) GO TO 25 +C--------CHECK FOR DIFFERENT SKILL LEVELS + CROPITEM=AITEM + CROPMATCH=NOVICE + IF(.NOT.CROP()) GO TO 15 + SKILL=1 + GO TO 19 + 15 CROPMATCH=FAIR + IF(.NOT.CROP()) GO TO 16 + SKILL=2 + GO TO 19 + 16 CROPMATCH=GOOD + IF(.NOT.CROP()) GO TO 17 + SKILL=3 + GO TO 19 + 17 CROPMATCH=EXPERT + IF(.NOT.CROP()) GO TO 18 + SKILL=4 + GO TO 19 + 18 CROPMATCH=EMERITUS + IF(.NOT.CROP()) GO TO 25 + SKILL=5 +C + 19 IF(SKILL.EQ.4) KSTUF(5)=1 + IF(SKILL.EQ.5) KSTUF(5)=2 + IF(LENGTH*SKILL .EQ. 0) GO TO 10 + GO TO 30 + 20 IF(LENGTH .NE. 0) GO TO 25 + CALL PROMPT(45HWOULD YOU LIKE A SHORT, MEDIUM OR LONG GAME? ,45) + GO TO 10 + 25 IF(SKILL .NE. 0) GO TO 30 + CALL PROMPT(48HARE YOU NOVICE, FAIR, GOOD, EXPERT OR EMERITUS? + 1 ,48) + GO TO 14 +C--------READ IN SECRET PASSWORD + 30 IF(NOMORE()) GO TO 35 + 31 PFLAG=.TRUE. + CALL SCAN + PFLAG=.FALSE. + PASSWD=AITEM + IF(KEY .NE. IHEOL) GO TO 40 + 35 CALL PROMPT(33HPLEASE TYPE IN A SECRET PASSWORD:,33) + GO TO 31 + 40 CONTINUE +C--------USE PARAMETERS TO GENERATE INITIAL VALUES OF THINGS + DAMFAC=0.50*SKILL + REMBASE=3.0*RANF(0)+2.0 + INPLAN=5. +6.*RANF(0) + NROMREM=(2.+RANF(0))*SKILL + NSCREM=SKILL/3 + REMTIME=7.0*LENGTH + INTIME=REMTIME + RATE=(SKILL-2.0*RANF(0)+1.0)*SKILL*0.1 + 0.15 + REMKL=2.0*RATE*INTIME + INKLING=REMKL + INCOM=SKILL+0.0625*INKLING*RANF(0) + INCOM=MIN0(10,INCOM) + REMCOM=INCOM + REMRES=(INKLING+4* INCOM )*INTIME + INRESOR=REMRES + IF(INKLING.GT.50) REMBASE=REMBASE+1 + INBASE=REMBASE + RETURN +C--------PROCESS A TOURNAMENT REQUEST + 100 CALL SCAN +C CALL RANSET(ABS(TNUMBER)) + THINGX=-1 +C--------GO BACK FOR ANYTHING LEFT OUT + IF (KEY.NE.IHEOL) GO TO 9 + CALL PROMPT(37HTYPE IN NAME OR NUMBER OF TOURNAMENT: ,37) + GO TO 100 +C--------PROCESS A REQUEST FOR A FROZEN GAME + 200 CALL THAW +C--------MAKE SURE WE GOT A GAME OUT OF THAW + IF(PASSWD.EQ.0.D0) GO TO 5 + FROZEN = .TRUE. +C--------DESTROY ANY "THINGS" IN FROZEN GAME. + THINGX=0 + THINGY=0 + DO 210 I=1,10 + DO 210 J=1,10 + 210 IF(QUAD(I,J) .EQ. IHQUEST) QUAD(I,J)=IHDOT +C--------RESET PLAQUE STATUS + ICITE=0 + RETURN + END + +END +DELETE F7:TRCRAM +EDIT +BUILD F7:TRCRAM + SUBROUTINE CRAM(MM,LEN) + COMMON/PRLUN/LUN + COMMON/CRAMSARG/CRAMSTR + CHARACTER CRAMSTR(8) + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + COMMON/ZERO/IZERO + DATA IZERO/240/ +C BYTE M(1) + CHARACTER MM(1) + INTEGER LEN +C-------- IS AN ARRAY CONTAINING CHARACTERS LJZF. BYTES ARE PUT +C--------INTO THE OUTPUT BUFFER UP TO THE FIRST 00B BYTE. +C BYTE LINE(120) + CHARACTER LINE(120),M(120),KHAR + LOGICAL FIRSTIME + DATA FIRSTIME/.TRUE./ +C DATA LINE/120*0/,ICH/1/ + DATA ICH/1/ + IF(.NOT. FIRSTIME) GO TO 1 + DO 120 L=1,120 + 120 LINE(L)=BLANK + FIRSTIME=.FALSE. + 1 K=80 + DO 2 I=1,120 + M(I)=NULL + 2 CONTINUE + DO 3 I=1,LEN + M(I)=MM(I) + 3 CONTINUE + GO TO 11 +C* + ENTRY CRAMS(MM,LEN,IK) +C* + K=IK + DO 102 I=1,120 + M(I)=NULL + 102 CONTINUE + IF (MM(1).NE.NULL) GO TO 104 + DO 103 I=1,LEN + M(I)=CRAMSTR(I) + 103 CONTINUE + GO TO 11 + 104 DO 105 I=1,LEN + M(I)=MM(I) + 105 CONTINUE + 11 IDUMP=0 + 5 ICHX=0 +C--------GET THE NEXT CHARACTER OF + 10 ICHX=ICHX+1 + IF (ICHX.GT.K) GOTO 21 + KHAR=M(ICHX) +C--------PUT IT IN BUFFER + IF(KHAR .EQ. NULL) GO TO 21 + LINE(ICH)=KHAR + ICH=ICH+1 + IF(ICH.GT.120) GOTO 25 +C IF((ICH.GT.72).AND.(LUN.EQ.1)) GOTO 25 + IF((ICH.GT.72).AND.(LUN.EQ.101)) GOTO 25 + GO TO 10 +C* + ENTRY CRENDNO +C--------DUMP BUFFER AND SUPPRESS LINE FEED + CALL PROMPT (LINE,ICH) + GOTO 27 +C* + ENTRY CRAMDMP (MM,LEN) +C--------INSERT FINAL ENTRY AND DUMP BUFFER + K=80 + DO 202 I=1,120 + M(I)=NULL + 202 CONTINUE + DO 203 I=1,LEN + M(I)=MM(I) + 203 CONTINUE + GO TO 22 +C* + ENTRY CRMDPS(MM,LEN,IK) + K=IK + DO 302 I=1,120 + M(I)=NULL + 302 CONTINUE + DO 303 I=1,LEN + M(I)=MM(I) + 303 CONTINUE + 22 IDUMP=1 + GO TO 5 + 21 IF(IDUMP.EQ. 0) RETURN +C + ENTRY CREND +C--------DUMP BUFFER AND GO TO NEW LINE + 25 CALL PROUT(LINE,ICH) +C27 DO 30 L=1,ICH +C30 LINE(L)=0 + 27 DO 30 L=1,120 + 30 LINE(L)=BLANK + ICH=1 + RETURN + END +C + SUBROUTINE CRAMF(XX,W,D) + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + COMMON/ZERO/IZERO +C BYTE CF(10),CS(10) + CHARACTER CF(10),CS(10) + INTEGER*4 I + INTEGER W,D + NEG=0 + DO 5 N=1,10 +C 5 CF(N)=0 + 5 CF(N)=NULL + X=XX + IF(X .GE. 0) GO TO 10 + X=-XX + NEG=1 + 10 N=0 + IF(D .EQ. 0) GO TO 30 +C--------CONVERT FRACTIONAL PART TO ASCII + I=X*10**D+.5 + DO 20 N=1,D + J=MOD(I,10) +C CF(N)=1H0+J + CF(N)=CHAR(IZERO+J) + 20 I=I/10 +C--------INSERT DECIMAL POINT + N=D+1 + CF(N)=1H. +C--------CONVERT INTEGRAL PART TO ASCII + 30 J=MOD(I,10) + N=N+1 +C CF(N)=1H0+J + CF(N)=CHAR(IZERO+J) + I=I/10 + IF(I .NE. 0) GO TO 30 +C--------INSERT MINUS SIGN IF NEEDED + IF(NEG .EQ. 0) GO TO 40 + N=N+1 + CF(N)=1H- +C--------PAD WITH BLANKS TO TOTAL OF CHARACTERS + 40 IF(N .GE. W .OR. N .GE. 9) GO TO 43 + N=N+1 + CF(N)=BLANK + GO TO 40 + 43 DO 45 I=1,N + 45 CS(I)=CF(N-I+1) +C CS(N+1)=0 +C50 CALL CRAM(CS) + 50 CALL CRAM(CS,N) + RETURN + END +C + SUBROUTINE CRAMI(II,W) + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + COMMON/ZERO/IZERO +C BYTE CI(10),CS(10) + CHARACTER CI(10),CS(10) + INTEGER W + I=II + NEG=0 + IF(I .GE. 0) GO TO 10 + I=-II + NEG=1 +C--------CONVERT THE NUMBER ITSELF TO ASCII + 10 DO 15 N=1,10 +C15 CI(N)=0 + 15 CI(N)=NULL + N=0 + 20 J=MOD(I,10) + N=N+1 +C CI(N)=1H0+J + CI(N)=CHAR(IZERO+J) + I=I/10 + IF(I .NE. 0) GO TO 20 +C--------INSERT MINUS SIGN IF NEEDED + 30 IF(NEG .EQ. 0) GO TO 40 + N=N+1 + CI(N)=1H- +C--------PAD WITH BLANKS TO TOTAL OF CHARACTERS + 40 IF(N .GE. W .OR. N .GE. 9) GO TO 43 + N=N+1 + CI(N)=BLANK + GO TO 40 + 43 DO 45 I=1,N + 45 CS(I)=CI(N-I+1) +C CS(N+1)=0 +C CALL CRAM(CS) + CALL CRAM(CS,N) + RETURN + END +C + SUBROUTINE CRAMIT(LEN) + COMMON/CRAMBF/CRAMBUF + CHARACTER CRAMBUF(16) + CALL CRAM(CRAMBUF,LEN) + RETURN + END + +END +DELETE F7:TRCRMEN +EDIT +BUILD F7:TRCRMEN + SUBROUTINE CRAMEN(II) + ENTRY CRAMENA(II) + INCLUDE F7:TREKCOM +C LOGICAL*1 II + INTEGER II + IF(II .EQ. IHR) GO TO 10 + IF(II .EQ. IHK) GO TO 20 + IF(II .EQ. IHC) GO TO 30 + IF(II .EQ. IHS) GO TO 40 + IF(II .EQ. IHSTAR) GO TO 50 + IF(II .EQ. IHP) GO TO 60 + IF(II .EQ. IHB) GO TO 70 +C IF(II .EQ. '@') GO TO 80 + IF(II .EQ. IHAT) GO TO 80 + IF(II .EQ. IHT) GO TO 85 + IF(II-2) 90,100,110 + 10 CALL CRAM(7HROMULAN,7) + RETURN + 20 CALL CRAM(7HKLINGON,7) + RETURN + 30 CALL CRAM(9HCOMMANDER,9) + RETURN + 40 CALL CRAM(15HSUPER-COMMANDER,15) + RETURN + 50 CALL CRAM(4HSTAR,4) + RETURN + 60 CALL CRAM(6HPLANET,6) + RETURN + 70 CALL CRAM(8HSTARBASE,8) + RETURN + 80 CALL CRAM(10HBLACK HOLE,10) + RETURN + 85 CALL CRAM(7HTHOLIAN,7) + RETURN + 90 CALL CRAM(1HM,1) + RETURN + 100 CALL CRAM(1HN,1) + RETURN + 110 CALL CRAM(1HO,1) + RETURN + END + +END +DELETE F7:TRCRMLC +EDIT +BUILD F7:TRCRMLC + SUBROUTINE CRAMLOC(KEY,IX,IY) + IF(KEY .EQ. 1) CALL CRAM(9H QUADRANT,9) + IF(KEY .EQ. 2) CALL CRAM(7H SECTOR,7) + CALL CRAM(1H ,1) + CALL CRAMI(IX,0) + CALL CRAM(3H - ,3) + CALL CRAMI(IY,0) + RETURN + END + +END +DELETE F7:TRCRMSH +EDIT +BUILD F7:TRCRMSH + SUBROUTINE CRAMSHP + INCLUDE F7:TREKCOM +C BYTE ISHIP,ESC,BELLS(16) + INTEGER ESC + CHARACTER BELLS(16) + LOGICAL JA + EQUIVALENCE(CRACKS(1),HIT),(CRACKS(5),IESC) ,(SHIP,ISHIP) + EQUIVALENCE (IESC,ESC) +C DATA BELLS/7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7/ + DATA IBELL/47/ + LOGICAL FIRSTIME + DATA FIRSTIME/.TRUE./ + IF(ISHIP .EQ. IHE) CALL CRAM(10HENTERPRISE,10) + IF(SHIP .EQ. IHF) CALL CRAM(13HFAERIE QUEENE,13) + RETURN +C* + ENTRY CRAM3AS +C* + CALL CRAM(3H***,3) + RETURN +C* + ENTRY STARS +C* + CALL PROUT( + + 54H******************************************************,54) + RETURN +C* + ENTRY REDALRT +C* + IF(.NOT. FIRSTIME) GO TO 2 + DO 1 I=1,16 + BELLS(I)=CHAR(IBELL) + 1 CONTINUE + FIRSTIME=.FALSE. +C-------RING THE BELL BEFORE THE RED ALERT + 2 CALL PROUT(BELLS,16) + CALL PROUT(25H***RED ALERT! RED ALERT!,25) + RETURN +C* + ENTRY BEGPARD +C* + CALL PROUT(27H BEG YOUR PARDON, CAPTAIN? ,27) + RETURN +C* + ENTRY MANORA +C* + CALL PROMPT(26HMANUAL OR AUTOMATIC? ,26) + RETURN +C* + ENTRY CASULTY +C* + ICAS=HIT*RANF(0)*0.015 + IF(ICAS .LT. 2) RETURN + CASUAL=CASUAL+ICAS + CALL CRAM(42HMC COY: "SICKBAY TO BRIDGE. WE JUST HAD ,42) + CALL CRAMI(ICAS,0) + CALL CRAMDMP(13H CASUALTIES.",13) + RETURN +C* + ENTRY RESETD +C* + CALL NEWCOND + IF(NENHERE .EQ. 0) RETURN + DO 10 L=1,NENHERE + 10 KDIST(L)=SQRT( FLOAT((SECTX-KX(L))**2 +(SECTY-KY(L))**2)) + RETURN +C* + ENTRY LEAVE +C* + KX(IESC)=KX(NENHERE) + KY(IESC)=KY(NENHERE) + KDIST(IESC)=KDIST(NENHERE) + KPOWER(IESC)=KPOWER(NENHERE) + KLHERE=KLHERE-1 + NENHERE=NENHERE-1 + IF(CONDIT .NE. IHDOCKD )CALL NEWCOND + RETURN +C* + ENTRY SOS +C* +C-------- IESC PASSES WHICH KIND OF COMMANDER IS ATTACKING + IF(ESC .EQ. IHS) GO TO 20 + ICSOS=0 + IF(DAMAGE(9) .GT. 0) RETURN + ICSOS=1 + IX=BATX + IY=BATY + DDAY=FUTURE(5) + GO TO 30 + 20 ISSOS=0 + IF(DAMAGE(9) .GT. 0) RETURN + ISSOS=1 + IX=ISX + IY=ISY + DDAY=FUTURE(7) + 30 CALL SKIP(1) + CALL CRAM(37HLT. UHURA: "CAPTAIN, THE STARBASE IN,37) + CALL CRAMLOC(1,IX,IY) + CALL CREND + CALL CRAM(22H REPORTS IT IS UNDER ,22) + CALL CRAMEN(ESC) + CALL CRAMDMP(8H ATTACK.,8) + CALL CRAM(32H IT CAN SURVIVE UNTIL STARDATE ,32) + CALL CRAMF(DDAY ,0,1) + CALL CRAMDMP(3H .",3) + IF(RESTING .EQ. 0) RETURN + CALL SKIP(1) + CALL PROMPT(55HMR. SPOCK: CAPTAIN, SHALL WE CANCEL THE REST PERIOD + 1? ,55) +C IF(JA(DUMMY)) RESTING=0 + IF(JA(1)) RESTING=0 + RETURN + END + +END +DELETE F7:TRCRMSN +EDIT +BUILD F7:TRCRMSN + SUBROUTINE CRMSENA(II,JJ,KK,LL) +C LOGICAL*1 II + INTEGER II + CALL CRAM3AS +C* + ENTRY CRMENA +C* + CALL CRAMEN(II) + CALL CRAM(3H AT,3) + CALL CRAMLOC(JJ,KK,LL) + RETURN + END + +END +DELETE F7:TRCRMSP +EDIT +BUILD F7:TRCRMSP + SUBROUTINE CRAMSP(NUM,STRING,LEN) +C +C 3-MAY-79 (NEW ROUTINE) +C CRAM SINGULAR OR PLURAL +C CRAMSP CRAMS THE INTEGER NUMBER 'NUM', FOLLOWED BY THE ASCII STRING +C 'STRING', FOLLOWED BY AN 'S' IF NUM .NE. 1. +C +C BYTE STRING(80),SEND(10),PEND(10) + CHARACTER STRING(80),SEND(10),PEND(10) + INTEGER NUM,LEN,SLEN,PLEN +C + CALL CRAMI(NUM,0) + CALL CRAM(' ',1) + CALL CRAM(STRING,LEN) + IF(NUM.NE.1)CALL CRAM('S',1) + RETURN +C + ENTRY CRAMSPI(NUM,STRING,LEN,SEND,SLEN,PEND,PLEN) +C +C CRAM SINGULAR OR PLURAL IRREGULAR +C CRAMSPI CRAMS THE INTEGER NUMBER 'NUM', FOLLOWED BY THE ASCII STRING +C 'STRING', FOLLOWED BY THE STRING 'SEND' IF NUM .EQ. 1, OR THE +C STRING 'PEND' IF NUM .NE. 1. +C + CALL CRAMI(NUM,0) + CALL CRAM(' ',1) + CALL CRAM(STRING,LEN) + IF(NUM.EQ.1)CALL CRAM(SEND,SLEN) + IF(NUM.NE.1)CALL CRAM(PEND,PLEN) + RETURN + END + +END +DELETE F7:TRCROP +EDIT +BUILD F7:TRCROP + LOGICAL FUNCTION CROP() +C BYTE ITEM(8),COMMAND(8),IT + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + COMMON/CROPARGS/ITEM,COMMAND + CHARACTER ITEM(8),COMMAND(8),IT + INTEGER ICO + LOGICAL HALPHA + CROP = .FALSE. + IF (ITEM(1).NE.COMMAND(1)) RETURN + DO 1 I=2,8 + IT=ITEM(I) + ICO=ICHAR(COMMAND(I)) +C IF (IT.EQ.' '.OR.IT.EQ.0) GO TO 2 + IF (IT.EQ.BLANK.OR.IT.EQ.NULL + + .OR..NOT.HALPHA(ICO)) GO TO 2 + IF (IT.NE.COMMAND(I)) RETURN + 1 CONTINUE + 2 CROP = .TRUE. +C RETURN + END + +END +DELETE F7:TRDEADK +EDIT +BUILD F7:TRDEADK + SUBROUTINE DEADKL(IX,IY,TYPE,IXX,IYY) + INCLUDE F7:TREKCOM + EQUIVALENCE (KSTUF(1),ITHERE) +C BYTE TYPE + INTEGER TYPE + CALL CRMSENA(TYPE,2,IXX,IYY) +C--------DECIDE WHAT KIND OF ENEMY IT IS, AND UPDATE APPROPRIATELY + IF(TYPE .EQ. IHT) GO TO 30 + IF(TYPE .EQ. IHR) GO TO 27 + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-100 + KLHERE=KLHERE-1 + REMKL=REMKL-1 + IF(TYPE .EQ. IHK) GO TO 25 + IF(TYPE .EQ. IHS) GO TO 26 +C--------CHALK UP A COMMANDER + COMHERE=0 + DO 10 I=1,REMCOM + IF(CX(I) .EQ. QUADX .AND. CY(I) .EQ. QUADY)GO TO 15 + 10 CONTINUE + 15 CX(I)=CX(REMCOM) + CY(I)=CY(REMCOM) + CX(REMCOM)=0 + CY(REMCOM)=0 + REMCOM=REMCOM-1 + FUTURE(2)=1E38 + IF(REMCOM.GT.0) FUTURE(2)=DATE+EXPRAN(FLOAT(INCOM/REMCOM)) + KILLC=KILLC+1 + GO TO 30 +C--------CHALK UP AN ORDINARY KLINGON + 25 KILLK=KILLK+1 + GO TO 30 +C--------CHALK UP THE (GULP) . + 26 NSCREM=0 + ISHERE=0 + ISX=0 + ISY=0 + NSCKILL=1 + ISATB=0 + ISCATE=0 + FUTURE(6)=1E38 + FUTURE(7)=1E38 + GO TO 30 +C--------CHALK UP A ROMULAN. + 27 NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY) -10 + IRHERE=IRHERE-1 + NROMKL=NROMKL+1 + NROMREM=NROMREM-1 +C--------FOR EACH KIND OF ENEMY, FINISH MESSAGE TO PLAYER + 30 CALL CRAMDMP(12H DESTROYED. ,12) + QUAD(IX,IY)=IHDOT + IF(REMKL .EQ. 0) RETURN + REMTIME=REMRES/(REMKL+4*REMCOM) +C-------IF ENEMY IS A THOLIAN, SET ITHERE=0 AND RETURN + IF(TYPE.EQ.IHT) ITHERE=0 + IF(TYPE.EQ.IHT) RETURN +C--------REMOVE ENEMY SHIP FROM ARRAYS DESCRIBING LOCAL CONDITIONS + DO 40 I=1,NENHERE + IF(KX(I) .EQ. IX .AND. KY(I) .EQ. IY)GO TO 45 + 40 CONTINUE + 45 NENHERE=NENHERE-1 + IF(I .GT. NENHERE) GO TO 55 + DO 50 J=I,NENHERE + KX(J)=KX(J+1) + KY(J)=KY(J+1) + KPOWER(J)=KPOWER(J+1) + 50 KDIST(J)=KDIST(J+1) + 55 KX(NENHERE+1)=0 + KY(NENHERE+1)=0 + KDIST(NENHERE+1)=0 + KPOWER(NENHERE+1)=0 + RETURN + END + +END +DELETE F7:TRDEBUG +EDIT +BUILD F7:TRDEBUG + SUBROUTINE DEBUGIT + INCLUDE F7:TREKCOM +C +C--------DO SOMETHING HERE +C + LUN=108 + CALL SCORE + CALL PLAQUE + LUN=101 +C + RETURN + END +C +C + SUBROUTINE CHEATER + INCLUDE F7:TREKCOM + ENERGY=10000 + SHLD=10000 + TORPS=100 + REMRES=10000 + DO 10 I=1,20 + DAMAGE(I)=0 + 10 CONTINUE + CALL SRSCAN +C + RETURN + END +C +C + SUBROUTINE CHEATCL + INCLUDE F7:TREKCOM + DO 15 I=1,10 + DO 15 J=1,10 + 15 QUAD(I,J)=IHDOT + QUAD(SECTX,SECTY)=SHIP + CALL SRSCAN +C + RETURN + END + +END +DELETE F7:TRDESTR +EDIT +BUILD F7:TRDESTR + SUBROUTINE DESTRCT + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP + INTEGER ISHIP + REAL*8 IPASS,AITEM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + EQUIVALENCE(SHIP,ISHIP) + IF(DAMAGE(11) .EQ. 0) GO TO 5 + CALL PROUT( + + 51HCOMPUTER DAMAGED; CANNOT EXECUTE DESTRUCT SEQUENCE.,51) + RETURN + 5 CALL SKIP(1) + CALL PROUT(13H---WORKING---,13) + CALL PROUT(24HIDENTIFICATION-POSITIVE;,24) + CALL PROUT(32HSELF-DESTRUCT-SEQUENCE-ACTIVATED,32) + CALL PROUT( 5H 10,5) + CALL PROUT( 8H 9,8) + CALL PROUT(11H 8,11) + CALL PROUT(14H 7,14) + CALL PROUT(17H 6,17) + CALL PROUT(35HENTER-CORRECT-PASSWORD-TO-CONTINUE-,35) + CALL PROUT(33HSELF-DESTRUCT-SEQUENCE-OTHERWISE-,33) + CALL PROMPT(40HSELF-DESTRUCT-SEQUENCE-WILL-BE-ABORTED: ,40) + CALL SCAN + IF(AITEM .NE. PASSWD) GO TO 30 + CALL PROUT(17HPASSWORD-ACCEPTED,17) + CALL PROUT(11H 5,11) + CALL PROUT(14H 4,14) + CALL PROUT(17H 3,17) + CALL PROUT(20H 2,20) + CALL PROUT(23H 1,23) + IF(RANF(0) .LT. 0.05) CALL PROUT(19HGOODBYE-CRUEL-WORLD,19) + CALL SKIP(2) +C* + ENTRY KABOOM +C* + CALL STARS + IF(ISHIP .EQ. IHE) CALL CRAM3AS + CALL CRAM(21H********* ENTROPY OF ,21) + CALL CRAMSHP + CALL CRAMDMP(20H MAXIMIZED *********,20) + CALL STARS + CALL SKIP(1) + IF(NENHERE .EQ. 0) GO TO 20 + WHAMMO=25.0*ENERGY + DO 10 L=1,NENHERE + IF(KPOWER(L)*KDIST(L) .GT. WHAMMO) GOTO 10 +C DEADKL SORTS THE KX AND KY ARRAYS AND +C REDUCES THE SIZE + II=KX(1) + JJ=KY(1) + CALL DEADKL(II,JJ,QUAD(II,JJ),II,JJ) + 10 CONTINUE + 20 CALL FINISH(10) + RETURN + 30 CALL PROUT(18HPASSWORD-REJECTED;,18) + CALL PROUT(19HCONTINUITY-EFFECTED,19) + CALL SKIP(2) + RETURN + END + +END +DELETE F7:TRDOCK +EDIT +BUILD F7:TRDOCK + SUBROUTINE DOCK + INCLUDE F7:TREKCOM + IDIDIT=0 + IF(CONDIT .EQ. IHDOCKD) GO TO 30 + IF(INORBIT.NE.0) GO TO 40 + IF(BASEX .EQ. 0) GO TO 5 + IF(IABS(SECTX-BASEX).LE.1 .AND. IABS(SECTY-BASEY).LE.1)GO TO 10 + 5 CALL CRAMSHP + CALL CRAMDMP(22H NOT ADJACENT TO BASE.,22) + RETURN + 10 CONDIT = IHDOCKD + CALL PROUT(7HDOCKED.,7) + IDIDIT=1 + IF(ENERGY .LT. INENRG) ENERGY=INENRG + SHLD=INSHLD + TORPS=INTORPS + LSUPRES=INLSR + RETURN + 30 CALL PROUT(15HALREADY DOCKED.,15) + RETURN + 40 CALL PROUT(36HYOU MUST FIRST LEAVE STANDARD ORBIT.,36) + RETURN + END + +END +DELETE F7:TRDROPI +EDIT +BUILD F7:TRDROPI + SUBROUTINE DROPIN(IQUAD,IX,IY) + INCLUDE F7:TREKCOM + 10 CALL IRAN10(IX,IY) + IF(QUAD(IX,IY) .NE. IHDOT) GO TO 10 + QUAD(IX,IY)=IQUAD + RETURN + END + +END +DELETE F7:TRDRPRT +EDIT +BUILD F7:TRDRPRT + SUBROUTINE DREPORT + INCLUDE F7:TREKCOM + COMMON/CRAMBF/CRAMBUF + REAL*8 CRAMBUF(2) + CHARACTER PAD(16) + DATA PAD/1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H , + + 1H ,1H ,1H ,1H ,1H ,1H ,1H ,1H / + INTEGER HDEVICE(40),NAME(2) + JDAM=0 + DO 20 L=1,NDEVICE + IF(DAMAGE(L) .LE. 0) GO TO 20 + IF(JDAM .NE. 0) GO TO 10 + CALL SKIP(1) + CALL PROUT(35HDEVICE -REPAIR TIMES-,35) + CALL PROUT(37H IN FLIGHT DOCKED,37) + JDAM=1 + 10 CALL CRAM(2H ,2) +C CALL CRAMS(DEVICE(2*L-1,1),16) + CRAMBUF(1)=DEVICE(1,L) + CRAMBUF(2)=DEVICE(2,L) + CALL CRAMIT(DEVLEN(1,L)+DEVLEN(2,L)) + CALL CRAM(PAD,16-(DEVLEN(1,L)+DEVLEN(2,L))) +C IF(L.NE.14) CALL CRAMF(DAMAGE(L)+0.005,5,2) + IF(L.NE.14) CALL CRAMF(DAMAGE(L)+0.005,10,2) + IF(L.EQ.14) CALL CRAM(9H - ,9) + CALL CRAMF(DOCKFAC*DAMAGE(L)+0.005,10,2) + CALL CREND + 20 CONTINUE + IF(JDAM .EQ. 0) CALL PROUT(23HALL DEVICES FUNCTIONAL.,23) + RETURN + END + +END +DELETE F7:TREKCOM +EDIT +BUILD F7:TREKCOM +C +C F7:TREKCOM INCLUDE FILE TO DEFINE COMMONS FOR STARTREK +C +C 26-APR-79 +C +C BLANK COMMON; THIS IS THE GLOBAL DATABASE FOR STARTREK, +C AND CONTAINS ALL INFORMATION NECESSARY TO DETERMINE THE +C STATE OF THE GAME. +C +C THE PARAMETER COMSIZE DEFINES THE SIZE OF THE COMMON +C IN STORAGE ELEMENTS. IT MAY NEED TO BE CHANGED IF THINGS ARE +C ADDED TO THE COMMON IN ORDER TO MAKE FREEZE AND THAW +C WORK PROPERLY. ALWAYS MAKE SURE THAT THE SIZE OF THE +C ARRAY ICOM IS THE SAME AS THE SIZE OF BLANK COMMON. +C IF THEY ARE NOT THE SAME SIZE, CHANGE COMSIZE APPROPRIATELY. +C +C PARAMETER COMSIZE=1222 +C +C COMMON SNAP,SNAPSHT(226), +C 1 DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, +C 2 KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), +C 3 NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, +C 4 NSCKILL,ICRYSTL,NPLANKL, +C 5 QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), +C 6 INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, +C 7 INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, +C 8 QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), +C 9 LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, +C 1 KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8),FUTURE(10), +C 2 DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, +C 3 DAMFAC,SHLDCHG,THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT, +C 4 LANDED,IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, +C 5 IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE,IPHWHO,BATX,BATY, +C 6 CRACKS(12), +C 7 ICSOS,ISSOS,ISUBDAM +C +C + PARAMETER COMSIZA=859 +C + COMMON/BLANCA/SNAPA,SNAPSHT(226), + 1 DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, + 2 KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), + 3 NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, + 4 NSCKILL,ICRYSTL,NPLANKL, + 5 QUAD(10,10),KX(20),KY(20), + 6 KPOWER(20),KDIST(20),KSTUF(20), + 7 INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, + 8 INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, + 9 QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), + 1 LENGTH,SKILL,DIST,DIREC,TIME,BASEX,BASEY, + 2 DOCKFAC,KLHERE,COMHERE,CASUAL,NHELP,NKINKS, + 3 STARCH(8,8),FUTURE(10),DEVLEN(2,14),IDIDIT, + 4 GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,DAMFAC,SHLDCHG, + 5 THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED, + 6 IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE, + 7 ICRAFT,IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE, + 8 IPHWHO,BATX,BATY,CRACKS(12),ICSOS,ISSOS,ISUBDAM +C +C + PARAMETER COMSIZB=60 +C + COMMON/BLANCB/SNAPB(2),DEVICE(2,14),PASSWD +C +C + INTEGER DEVLEN,SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY, + 1 TORPS,REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH, + 2 CX,CY,SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, + 3 ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAPA, + 3 SNAPB,SHLDCHG,THINGX,THINGY,BATX,BATY,CRACKS, + 4 PLNETX,PLNETY,PLNETS +C + REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD, + 1 INENRG,INLSR +C +C BYTE QUAD + INTEGER QUAD + REAL*8 DEVICE,PASSWD +C +C ICOM IS AN ARRAY THAT ENCOMPASSES THE ENTIRE COMMON. IT IS +C USED TO FREEZE AND THAW GAMES. +C +C INTEGER ICOM(COMSIZE) +C EQUIVALENCE (ICOM,SNAP) +C + INTEGER ICOMA(COMSIZA) + EQUIVALENCE (ICOMA,SNAPA) + INTEGER ICOMB(COMSIZB) + EQUIVALENCE (ICOMB,SNAPB) +C +C COMMON HOLLER; THIS COMMON CONTAINS FREQUENTLY USED CHARACTERS +C AND TEXT STRINGS. THEIR VALUES ARE DEFINED BY DATA STATEMENTS +C IN THE MODULE STARTRK. +C +C LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB, + INTEGER IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB, + 1 IHSTAR,IHT,IHQUEST,IHNUM,IHAT,IH0 + COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, + 1 IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB, + 2 IHT,IHNUM,IHAT,IH0 +C + +END +DELETE F7:TREMEXI +EDIT +BUILD F7:TREMEXI + SUBROUTINE EMEXIT +C +C 13-APR-79 (NEW ROUTINE) +C EMERGENCY EXIT - FREEZE THE GAME ON 'EMSAVE.TRK', ERASE THE +C SCREEN, AND BUG OUT. +C + INCLUDE F7:TREKCOM +C +C CALL CLOSE(2) +C OPEN(UNIT=2,NAME='SYS$DISK:EMSAVE.TRK',TYPE='UNKNOWN', +C 1 FORM='UNFORMATTED',ERR=920) +C WRITE(2,ERR=920) COMSIZE,ICOM +C CALL CLOSE(2) +C + OPEN(UNIT=103,NAME='TK:EMSAVE',STATUS='UNKNOWN', + 1 FORM='UNFORMATTED',ERR=920) + WRITE(103,ERR=920) COMSIZA,COMSIZB, + + (ICOMA(J),J=1,COMSIZA),(ICOMB(K),K=1,COMSIZB) + CLOSE(103) +C + 920 CALL GETOUT + RETURN + END + +END +DELETE F7:TREVENT +EDIT +BUILD F7:TREVENT + SUBROUTINE EVENTS +C +C 23-OCT-79 +C CANCEL TYPEAHEAD WHEN A TRACTOR BEAM OCCURS +C + INCLUDE F7:TREKCOM + DIMENSION PICTURE(226) + EQUIVALENCE (PICTURE,DATE),(CRACKS(5),ITYPE) + DATA NEVENTS/7/ + ICTBEAM=0 + ISTRACT=0 +C--------SELECT EARLIEST EXTRANEOUS EVENT (LINE=0 IF NO EVENTS) + 10 LINE=0 + IF(ALLDONE.NE.0) RETURN + DATEMIN=DATE+TIME + DO 20 L=1,NEVENTS + IF(FUTURE(L) .GT. DATEMIN) GO TO 20 + LINE=L + DATEMIN=FUTURE(L) + 20 CONTINUE + XTIME=DATEMIN-DATE + DATE=DATEMIN +C--------DECREMENT FEDERATION RESOURCES AND RECOMPUTE REMAINING TIME + REMRES=REMRES-(REMKL+4*REMCOM)*XTIME + REMTIME=REMRES/(REMKL+4*REMCOM) + IF(REMTIME .GT. 0) GO TO 30 +C--------FEDERATION RESOURCES DEPLETED; END + CALL FINISH(2) + RETURN +C--------DECIDE IF LIFE SUPPORT IS ADEQUATE + 30 IF(DAMAGE(5).EQ.0 .OR. CONDIT.EQ.IHDOCKD ) GO TO 50 + IF(LSUPRES .GE. XTIME .OR. DAMAGE(5) .LE. LSUPRES) GO TO 40 + CALL FINISH(3) + RETURN + 40 LSUPRES=LSUPRES-XTIME + IF(DAMAGE(5) .LE. XTIME) LSUPRES=INLSR +C--------FIX DEVICES + 50 REPAIR=XTIME + IF(CONDIT .EQ. IHDOCKD ) REPAIR=XTIME/DOCKFAC + DO 60 L=1,NDEVICE + IF(L.EQ.14) GO TO 60 + IF(DAMAGE(L) .GT. 0) DAMAGE(L)=AMAX1(DAMAGE(L)-REPAIR,0.0) +60 CONTINUE +C--------CAUSE EXTRANEOUS EVENT [] TO OCCUR + TIME=TIME-XTIME + IF(LINE .EQ. 0) GO TO 5000 + GO TO (100,200,300,400,500,600,700),LINE +C--------EXTRANEOUS EVENT 1: SUPERNOVA + 100 CALL SNOVA(0,0) + FUTURE(1)=DATE+EXPRAN(0.5*INTIME) + IF(GALAXY(QUADX,QUADY) .EQ. 1000) RETURN + GO TO 10 +C--------EXTRANEOUS EVENT 2: TRACTOR BEAM + 200 IF(REMCOM .EQ. 0) GO TO 220 + IF(ISTRACT.NE.0) GO TO 210 + IF(CONDIT .EQ. IHDOCKD ) GO TO 210 + I=RANF(0)*REMCOM+1.0 + YANK=(CX(I)-QUADX)**2 + (CY(I)-QUADY)**2 + IF(YANK .EQ. 0 .AND. JUSTIN .EQ. 0) GO TO 210 + IF(ISTRACT .EQ. 0) GO TO 201 +20010 YANK=(ISX-QUADX)**2+(ISY-QUADY)**2 + 201 YANK=SQRT(YANK) + YNKRATE=7.5 + TIME=(10.0/YNKRATE**2)*YANK + ICTBEAM=1 + CALL SKIP(1) + CALL CRAM3AS + CALL CRAMSHP + CALL CRAMDMP(36H CAUGHT IN LONG-RANGE TRACTOR BEAM--,36) +C--------IF KIRK AND CO. SCREWING AROUND ON PLANET, HANDLE. + CALL GRAB + IF(ALLDONE.NE.0) RETURN +C--------HANDLE CASE WHERE KIRK IS IN SHUTTLE CRAFT. + IF(ICRAFT .NE. 1) GO TO 203 + CALL FINISH(18) + RETURN +C--------CHECK TO SEE IF SHUTTLE IS ABOARD. + 203 IF(ISCRAFT .NE. 0) GO TO 204 + CALL SKIP(1) + CALL PROUT(48HGALILEO, LEFT ON THE PLANET SURFACE, IS CAPTURED,48) + CALL PROUT(45HBY ALIENS AND MADE INTO A FLYING MC DONALD'S.,45) + DAMAGE(10)=-10. + ISCRAFT=-1 + 204 IF(ISTRACT .EQ. 0) GO TO 205 + QUADX=ISX + QUADY=ISY + GO TO 206 + 205 QUADX=CX(I) + QUADY=CY(I) + 206 CALL IRAN10(SECTX,SECTY) + CALL CRAM(12H PULLED TO,12) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CRAM(2H, ,2) + CALL CRAMLOC(2,SECTX,SECTY) + CALL CREND + IF(RESTING .NE. 0) CALL PROUT( + + 46H(REMAINDER OF REST & REPAIR PERIOD CANCELLED.),46) + RESTING=0 + CALL CANTA + IF(SHLDUP.NE.0) GO TO 208 + IF(DAMAGE(8).EQ.0 .AND. SHLD.GT.0) GO TO 207 + CALL PROUT(32H(SHIELDS NOT CURRENTLY USEABLE.),32) + GO TO 208 + 207 CALL SHLDSUP + SHLDCHG=0 + 208 CALL NEWQUAD + IF(REMCOM .LE. 0) GO TO 220 + 210 FUTURE(2)=DATE+TIME+EXPRAN(1.5*INTIME/REMCOM) + GO TO 10 + 220 FUTURE(2)=1E38 + GO TO 10 +C--------EXTRANEOUS EVENT 3: SNAPSHOT OF UNIVERSE (FOR TIME WARP) + 300 DO 310 L=1,226 + 310 SNAPSHT(L)=PICTURE(L) + SNAP=1 + FUTURE(3)=DATE+EXPRAN(0.5*INTIME) + GO TO 10 +C--------EXTRANEOUS EVENT 4: COMMANDER ATTACKS STARBASE +C--------LOOK FOR A COMMANDER IN SAME QUADRANT AS A STARBASE + 400 IF(REMCOM.GT.0 .AND. REMBASE.GT.0) GO TO 410 + FUTURE(4)=1E38 + FUTURE(5)=1E38 + GO TO 10 + 410 DO 420 J=1,REMBASE + DO 420 K=1,REMCOM + IF( (BASEQX(J).EQ.CX(K) .AND. BASEQY(J).EQ.CY(K)) .AND. + + (BASEQX(J).NE.QUADX .OR. BASEQY(J).NE.QUADY) .AND. + + (BASEQX(J).NE.ISX .OR. BASEQY(J).NE.ISY) ) GO TO 430 + 420 CONTINUE + FUTURE(4)=DATE+EXPRAN(0.3*INTIME) + FUTURE(5)=1E38 + GO TO 10 +C--------COMMANDER+STARBASE COMBINATION FOUND--LAUNCH ATTACK + 430 BATX=BASEQX(J) + BATY=BASEQY(J) + FUTURE(5)=DATE+1.0+3.0*RANF(0) + IF(ISATB.NE.0) FUTURE(5)=FUTURE(5)+FUTURE(7)-DATE + FUTURE(4)=FUTURE(5)+EXPRAN(0.3*INTIME) + ITYPE=IHC + CALL SOS + GO TO 10 +C--------EXTRANEOUS EVENT 5: COMMANDER SUCCEEDS IN DESTROYING BASE + 500 FUTURE(5)=1E38 + 502 IF(ISATB.NE.2) GO TO 505 + IF(MOD(GALAXY(ISX,ISY),100) .LT. 10) RETURN + IXHOLD=BATX + IYHOLD=BATY + BATX=ISX + BATY=ISY + GO TO 520 + 505 IF(REMCOM.EQ.0 .OR. REMBASE.EQ.0) GO TO 515 + IF(MOD(GALAXY(BATX,BATY),100) .LT. 10) GO TO 515 + DO 510 I=1,REMCOM + IF(CX(I).EQ.BATX .AND. CY(I).EQ.BATY) GO TO 520 + 510 CONTINUE + 515 BATX=0 + BATY=0 + GO TO 10 + 520 IF(STARCH(BATX,BATY) .EQ. -1) STARCH(BATX,BATY)=0 + IF(STARCH(BATX,BATY) .GT. 999) + + STARCH(BATX,BATY)=STARCH(BATX,BATY)-10 +C--------HANDLE CASE WHERE BASE IS IN SAME QUADRANT AS STARSHIP + IF(BATX.NE.QUADX .OR. BATY.NE.QUADY) GO TO 545 + QUAD(BASEX,BASEY)=IHDOT + BASEX=0 + BASEY=0 + CALL NEWCOND + CALL SKIP(1) + CALL PROUT( + + 61HSPOCK: "CAPTAIN, I BELIEVE THE STARBASE HAS BEEN DESTROYED. + +",61) + GO TO 550 +C--------IF STARBASE NOT IN SAME QUADRANT, GET NEWS FROM UHURA + 545 IF(REMBASE.EQ.1 .OR. DAMAGE(9).GT.0) GO TO 550 + CALL SKIP(1) + CALL PROUT( + + 52HLT. UHURA: "CAPTAIN, STARFLEET COMMAND REPORTS THAT,52) + CALL CRAM(15HTHE STARBASE IN,15) + CALL CRAMLOC(1,BATX,BATY) + CALL CRAMDMP(22H HAS BEEN DESTROYED BY,22) + IF(ISATB .NE. 2) GO TO 547 + CALL PROUT(31HTHE KLINGON SUPER-COMMANDER." ,31) + GO TO 550 + 547 CALL PROUT(21HA KLINGON COMMANDER.",21) +C--------REMOVE STARBASE FROM GALAXY + 550 GALAXY(BATX,BATY)=GALAXY(BATX,BATY)-10 + IF(REMBASE .LE. 1) GO TO 580 + DO 560 I=1,REMBASE + IF(BASEQX(I).EQ.BATX .AND. BASEQY(I).EQ.BATY) GO TO 570 + 560 CONTINUE + 570 BASEQX(I)=BASEQX(REMBASE) + BASEQY(I)=BASEQY(REMBASE) + 580 REMBASE=REMBASE-1 + IF(ISATB .NE. 2) GO TO 515 +C--------REINSTATE A COMMANDER'S BASE ATTACK. + BATX=IXHOLD + BATY=IYHOLD + ISATB=0 + GO TO 10 +C--------EXTRANEOUS EVENT 6: SUPER-COMMANDER MOVES. + 600 FUTURE(6)=DATE+0.2777 + IF(IENTESC+ISTRACT .GT. 0) GO TO 10 + IF(ISATB .NE. 1 .AND. (ISCATE.NE.1 .OR. JUSTIN.EQ.1)) CALL SCOM + GO TO 10 +C--------EXTRANEOUS EVENT 7: SUPER-COMMANDER DESTROYS BASE + 700 FUTURE(7)=1E38 + ISATB=2 + GO TO 502 +C--------CHECK WITH SPY TO SEE IF S.C. SHOULD TRACTOR BEAM. + 5000 IF(NSCREM .EQ. 0) RETURN + IF(ICTBEAM+ISTRACT .GT. 0) RETURN + IF(CONDIT.EQ.IHDOCKD .OR. ISATB.EQ.1 .OR. ISCATE.EQ.1) RETURN + IF(IENTESC.NE.0) GO TO 5100 + IF((ENERGY.LT.2500.) .AND. (TORPS.LT.4) .AND. (SHIELD.LT.1250.)) + + GO TO 5100 + IF((DAMAGE(3).GT.0.) .AND. ((DAMAGE(4).GT.0) .OR. + + (TORPS.LT.4))) GO TO 5100 + IF((DAMAGE(8) .GT. 0.) .AND. ((ENERGY .LT. 3000.) .OR. + +(DAMAGE(3) .GT. 0.)) .AND. ((TORPS .LT. 5) .OR. (DAMAGE(4) .GT. + + 0.))) GO TO 5100 + RETURN +C--------TRACTOR-BEAM HER! +5100 IF(RANF(0).GT..65) RETURN + ISTRACT=1 + GO TO 20010 + END + +END +DELETE F7:TREXPRA +EDIT +BUILD F7:TREXPRA + FUNCTION EXPRAN(AVERAGE) + EXPRAN=-AVERAGE*ALOG(RANF(0)) + RETURN + END + +END +DELETE F7:TRFINIS +EDIT +BUILD F7:TRFINIS + SUBROUTINE FINISH(I) +C +C 4-APR-79 +C MODIFIED TO GET RID OF THE NONSENSE ABOUT CANNIBALS ON CLASS +C N AND O PLANETS (WHICH DON'T EVEN HAVE EARTH-LIKE CONDITIONS). +C 31-MAY-79 +C MAKE PROMPTS COME OUT ON THE TERMINAL +C + INCLUDE F7:TREKCOM + COMMON/PRLUN/LUN +C LOGICAL*1 ISHIP + INTEGER ISHIP + LOGICAL JA + EQUIVALENCE (SHIP,ISHIP) + ALLDONE=1 + IGOTIT=0 + SAVED=REMRES/INRESOR + CALL SKIP(3) + CALL CRAM(15HIT IS STARDATE ,15) + CALL CRAMF(DATE,0,1) + CALL CRAMDMP(2H .,2) + CALL SKIP(1) + GO TO (100,200,300,400,500,600,700,800,900,1000,1100,5000,1300, + + 1400,1500,1600,1700,1800,5000,5000,2100,2200),I +C--------CASE 1: GAME HAS BEEN WON + 100 IF(NROMREM.EQ.0) GO TO 105 + CALL CRAM(14HTHE REMAINING ,14) + CALL CRAMI(NROMREM,0) + CALL CRAMDMP(41H ROMULANS SURRENDER TO STARFLEET COMMAND.,41) + CALL SKIP(1) + 105 CALL PROUT( + + 53HYOU HAVE SMASHED THE KLINGON INVASION FLEET AND SAVED,53) + CALL PROUT(15HTHE FEDERATION.,15) + GAMEWON=1 + IF(ALIVE.EQ.0 .OR. BASEKL.NE.0 .OR. ISHIP.NE.IHE) GO TO 130 + IF(5*STARKL+CASUAL+10*NPLANKL+45*NHELP .GE. 100) GO TO 130 + IF(DATE-INDATE .LT. 5.0) GO TO 110 + RATEMAX=0.1*SKILL*(SKILL+1.0) + 0.1 + PERDATE=(KILLK+KILLC+NSCKILL)/(DATE-INDATE) + IF(PERDATE .LT. RATEMAX) GO TO 130 + 110 CALL SKIP(1) + CALL PROUT( + + 53HIN FACT, YOU HAVE DONE SO WELL THAT STARFLEET COMMAND,53) + IF(SKILL .EQ. 4) GO TO 120 + IF(SKILL .EQ. 5) GO TO 125 + CALL CRAM(31HPROMOTES YOU ONE STEP IN RANK, ,13) + IF(SKILL .EQ. 1) CALL CRAMDMP(24HFROM "NOVICE" TO "FAIR".,24) + IF(SKILL .EQ. 2) CALL CRAMDMP(22HFROM "FAIR" TO "GOOD".,22) + IF(SKILL .EQ. 3) CALL CRAMDMP(24HFROM "GOOD" TO "EXPERT".,24) + CALL PROUT(16HCONGRATULATIONS!,16) + GO TO 130 + 120 CALL PROUT(35HPROMOTES YOU TO COMMODORE EMERITUS.,35) + IGOTIT=1 + CALL SKIP(1) + CALL PROUT(38HNOW THAT YOU THINK YOU'RE REALLY GOOD, ,38) + CALL PROUT(32HTRY PLAYING THE "EMERITUS" GAME. ,32) + CALL PROUT(26HIT WILL SPLATTER YOUR EGO.,26) + GO TO 130 + 125 CALL SKIP(1) + CALL PROUT(35HCOMPUTER: ERROR-ERROR-ERROR-ERROR ,35) + CALL SKIP(1) + CALL PROUT(54H YOUR-SKILL-HAS-EXCEEDED-THE-CAPACITY-OF-THIS-PROGR + CAM ,54) + DO 126 K=1,3 + 126 CALL PROUT(27H THIS-PROGRAM-MUST-SURVIVE,27) + CALL PROUT(41H THIS-PROGRAM-MUST- MUST - SUR - VI ,41) + CALL SKIP(1) + CALL PROUT( + + 53HNOW YOU CAN RETIRE AND WRITE YOUR OWN STAR TREK GAME.,53) + IGOTIT=1 + 130 CALL SKIP(1) + CALL PROUT(22HLIVE LONG AND PROSPER.,22) + CALL SCORE + IF(IGOTIT .EQ. 0) RETURN + LUNSAV=LUN +C LUN=1 + LUN=101 + CALL SKIP(1) + CALL PROMPT + 1 ('DO YOU WANT YOUR "COMMODORE EMERITUS CITATION" PRINTED? ',56) + LUN=LUNSAV +C IF(JA(DUMMY) .EQ. 0) RETURN + IF(.NOT. JA(1)) RETURN + ICITE=1 + CALL PLAQUE + RETURN +C--------CASE 2: FEDERATION RESOURCES DEPLETED + 200 CALL PROUT( + + 45HYOUR TIME HAS RUN OUT, AND THE FEDERATION HAS,45) + CALL PROUT(15HBEEN CONQUERED.,15) + CALL SKIP(1) + CALL PROUT( + + 54HYOUR STARSHIP IS NOW KLINGON PROPERTY, AND YOU ARE PUT,54) + CALL PROUT( + + 57HON TRIAL AS A WAR CRIMINAL. ON THE BASIS OF YOUR RECORD, + 1 ,57) + IF(REMKL*3 .GT. INKLING) GO TO 210 + CALL PROUT( + + 51HYOU ARE FOUND GUILTY AND SENTENCED TO DEATH BY SLOW,51) + CALL PROUT(8HTORTURE.,8) + ALIVE=0 + CALL SCORE + RETURN + 210 CALL PROUT(18HYOU ARE ACQUITTED.,18) + CALL SKIP(1) + CALL PROUT(22HLIVE LONG AND PROSPER.,22) + CALL SCORE + RETURN +C--------CASE 3: LIFE SUPPORT SYSTEM FAILURE + 300 CALL PROUT(44HYOUR LIFE SUPPORT RESERVES HAVE RUN OUT, AND,44) + CALL PROUT( + + 47HYOU DIE OF THIRST, STARVATION AND ASPHYXIATION.,47) + 310 CALL SKIP(1) + CALL PROUT(37HYOUR STARSHIP IS A DERELICT IN SPACE.,37) + GO TO 5000 +C--------CASE 4: ENERGY SUPPLY EXHAUSTED + 400 CALL PROUT(32HYOUR ENERGY SUPPLY IS EXHAUSTED.,32) + GO TO 310 +C--------CASE 5: DEFEATED IN BATTLE + 500 CALL CRAM(4HTHE ,4) + CALL CRAMSHP + CALL CRAMDMP(30H HAS BEEN DESTROYED IN BATTLE.,30) + CALL SKIP(1) + CALL PROUT(37HDULCE ET DECORUM EST PRO PATRIA MORI.,37) + GO TO 5000 +C--------CASE 6: HIT NEGATIVE ENERGY ZONE THREE TIMES + 600 CALL PROUT( + + 57HYOU HAVE MADE THREE ATTEMPTS TO CROSS THE NEGATIVE ENERGY + 1 ,57) + CALL PROUT(35HBARRIER WHICH SURROUNDS THE GALAXY.,35) + CALL SKIP(1) + CALL PROUT(31HYOUR NAVIGATION IS ABOMINABLE. ,31) + CALL SCORE + RETURN +C--------CASE 7: STARSHIP DESTROYED BY ORDINARY NOVA + 700 CALL PROUT( + + 43HYOUR STARSHIP HAS BEEN DESTROYED BY A NOVA.,43) + 705 CALL PROUT(22HTHAT WAS A GREAT SHOT.,22) + GO TO 5000 +C--------CASE 8: STARSHIP DESTROYED BY A SUPERNOVA + 800 CALL CRAM(4HTHE ,4) + CALL CRAMSHP + CALL CRAMDMP(31H HAS BEEN FRIED BY A SUPERNOVA.,31) + CALL PROUT(31H...NOT EVEN CINDERS REMAIN... ,31) + GO TO 5000 +C--------CASE 9: ABANDON SHIP AFTER ALL STARBASES HAVE BEEN DESTROYED + 900 CALL PROUT( + + 53HYOU HAVE BEEN CAPTURED BY THE KLINGONS. IF YOU STILL,53) + CALL PROUT( + + 53HHAD A STARBASE TO BE RETURNED TO, YOU WOULD HAVE BEEN,53) + CALL PROUT( + + 53HREPATRIATED AND GIVEN ANOTHER CHANCE. SINCE YOU HAVE,53) + CALL PROUT( + + 56HNO STARBASES, YOU WILL BE MERCILESSLY TORTURED TO DEATH.,56) + GO TO 5000 +C--------CASE 10: STARSHIP SELF-DESTRUCTS OR DILITHIUM CRYSTAL EXPLODES. + 1000 CALL PROUT(63HYOUR STARSHIP IS NOW AN EXPANDING CLOUD OF SUBATOMIC + + PARTICLES.,63) + GO TO 5000 +C--------CASE 11: FAILED TO REMATERIALIZE AFTER CALLING FOR HELP + 1100 CALL PROUT( + + 52HSTARBASE WAS UNABLE TO RE-MATERIALIZE YOUR STARSHIP.,52) + CALL PROUT(25HSIC TRANSIT GLORIA MUNDI.,25) + GO TO 5000 +C--------CASE 13. CAPTAIN LOST IN TRANSPORTER BEAM. + 1300 CALL PROUT(36HYOU AND YOUR LANDING PARTY HAVE BEEN ,36) + CALL PROUT(47HCONVERTED TO ENERGY, DISSIPATING THROUGH SPACE. + 1 ,47) + GO TO 1410 +C--------CASE 14: MINING PARTY LEFT ON PLANET AFTER TRACTOR BEAM. + 1400 ICLASS=PLNETS(IPLANET,3) + IF (ICLASS.NE.1) GO TO 1401 + CALL PROUT(41HYOU ARE LEFT WITH YOUR LANDING PARTY ON ,41) + CALL PROUT(54HA WILD JUNGLE PLANET INHABITED BY PRIMITIVE CANNIBAL + CS. ,54) + CALL SKIP(1) + CALL PROUT(42HTHEY ARE VERY FOND OF "CAPTAIN KIRK" SOUP. + 1 ,42) + GO TO 1410 + 1401 CALL PROUT('YOU AND YOUR LANDING PARTY ARE STRANDED ON A',44) + CALL CRAM('CLASS ',6) + CALL CRAMEN(ICLASS) + CALL CRAMDMP(' PLANET, WHICH IS INCAPABLE OF SUPPORTING',41) + CALL PROUT('HUMAN LIFE. AFTER YOUR SUIT LIFE SUPPORT SYSTEMS',49) + CALL PROUT('ARE EXHAUSTED, YOU DIE.',23) + 1410 CALL SKIP(1) + CALL CRAM(29HWITHOUT YOUR LEADERSHIP, THE ,29) + CALL CRAMSHP + CALL CRAMDMP(14H IS DESTROYED.,14) + GO TO 5000 +C--------CASE 15: ENTERPRISE DESTROYS PLANET WITH MINING PARTY ON IT. + 1500 CALL PROUT(33HYOU AND YOUR MINING PARTY PERISH. ,33) + GO TO 705 +C--------CASE 16. KIRK FRIED BY NOVA WHILE ON PLANET. + 1600 CALL PROUT(41HYOU AND YOUR MINING PARTY ARE ATOMIZED. ,41) + CALL SKIP(1) + CALL CRAM(31HMR. SPOCK TAKES COMMAND OF THE ,31) + CALL CRAMSHP + CALL CRAMDMP(4H AND,4) + CALL PROUT(54HJOINS THE ROMULANS, REIGNING TERROR ON THE FEDERATIO + CN. ,54) + GO TO 5000 +C--------CASE 17. KIRK FRIED BY SUPERNOVA IN SHUTTLE CRAFT. + 1700 CALL PROUT(51HGALILEO IS INSTANTLY ANNIHILATED BY THE SUPERNOVA. + C ,51) + GO TO 1600 +C--------CASE 18. SHUTTLE CRAFT CAUGHT IN TRACTOR BEAM. + 1800 CALL PROUT(37HSHUTTLE CRAFT GALILEO IS ALSO CAUGHT, ,37) + CALL PROUT(31HAND BREAKS UP UNDER THE STRAIN. ,31) + CALL SKIP(1) + CALL PROUT(47HYOUR DEBRIS IS SCATTERED FOR MILLIONS OF MILES. + 1 ,47) + GO TO 1410 +C--------CASE 19. DEATH RAY CONVERTS CREW INTO MUTANTS. +C--------CASE 21. BLACK HOLE SWALLOWS SHIP. + 2100 CALL PROUT(51HYOUR SHIP IS DRAWN TO THE CENTER OF THE BLACK HOLE. + + ,51) + CALL PROUT(44HYOU ARE CRUSHED INTO EXTREMELY DENSE MATTER.,44) + GO TO 5000 +C--------CASE 22. SHIP DESTROYED BY A TORPEDO BOOMERANG + 2200 CALL PROUT(31HYOU ARE POSTHUMOUSLY AWARDED A ,31) + CALL PROUT(31HSTARFLEET MARKSMANSHIP AWARD. ,31) + GO TO 705 +C--------DECIDE FINAL OUTCOME OF GAME AFTER YOUR DEATH + 5000 CALL SKIP(1) + IF(ISHIP .EQ. IHF) ISHIP=0 + IF(ISHIP .EQ. IHE) ISHIP=IHF + ALIVE=0 + IF(REMKL .EQ. 0) GO TO 5050 + GOODIES=REMRES/INRESOR + BADDIES=(REMKL+2.0*REMCOM)/(INKLING+2.0*INCOM) + ADVANTG=GOODIES/BADDIES + IF(ADVANTG .LT. (1.0+0.5*RANF(0))) GO TO 5020 + CALL PROUT( + + 54HAS A RESULT OF YOUR ACTIONS, A TREATY WITH THE KLINGON,54) + CALL PROUT( + + 52HEMPIRE HAS BEEN SIGNED. THE TERMS OF THE TREATY ARE,52) + IF(ADVANTG .LT. (3.0+RANF(0))) GO TO 5010 + CALL PROUT( + + 28HFAVORABLE TO THE FEDERATION.,28) + CALL SKIP(1) + CALL PROUT(16HCONGRATULATIONS.,16) + GO TO 5030 + 5010 CALL PROUT(37HHIGHLY UNFAVORABLE TO THE FEDERATION.,37) + GO TO 5030 + 5020 CALL PROUT(33HTHE FEDERATION WILL BE DESTROYED.,33) + 5030 CALL SCORE + RETURN +C--------STILL ANOTHER CASE--SUCCESSFUL KAZIKAME TACTICS + 5050 CALL PROUT( + + 51HSINCE YOU TOOK THE LAST KLINGON WITH YOU, YOU ARE A,51) + CALL PROUT( + + 51HMARTYR AND A HERO. SOMEDAY MAYBE THEY'LL ERECT A ,51) + CALL PROUT( + + 51HSTATUE IN YOUR MEMORY. REST IN PEACE, AND TRY NOT ,51) + CALL PROUT( + + 23HTO THINK ABOUT PIGEONS.,23) + GAMEWON=1 + ALIVE=0 + CALL SCORE + RETURN + END + +END +DELETE F7:TRFREEZ +EDIT +BUILD F7:TRFREEZ + SUBROUTINE FREEZE +C +C 3-APR-79 +C MAKE THE 'GAME FROZEN' MESSAGE COME OUT PROPERLY. +C + INCLUDE F7:TREKCOM + COMMON/SCANBF/KEY + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK +C LOGICAL*1 NAME(30) + CHARACTER NAME(10) + CHARACTER*10 FN + EQUIVALENCE (FN,NAME) + LOGICAL JA + 1 CALL GETFN(NAME) + IDIDIT=0 +C IF(NAME(1).EQ.0) GOTO 920 + IF(NAME(1).EQ.NULL) GOTO 920 +C CALL CLOSE(2) +C OPEN(UNIT=2,NAME=NAME,TYPE='UNKNOWN',FORM='UNFORMATTED',ERR=920) +C WRITE(2,ERR=920) COMSIZE,ICOM +C CALL CLOSE(2) + OPEN(UNIT=103,NAME=FN,STATUS='NEW', + + FORM='UNFORMATTED',ERR=900) + 2 WRITE(103,ERR=920) COMSIZA,COMSIZB, + + (ICOMA(J),J=1,COMSIZA),(ICOMB(K),K=1,COMSIZB) + CLOSE(103) + IDIDIT=1 + CALL PROUT(13H GAME FROZEN. ,13) + RETURN + 900 CALL PROUT('A FILE WITH THIS NAME ALREADY EXISTS.',37) + CALL PROUT('DO YOU WISH TO OVERWRITE IT?',28) + IF (JA(0)) GO TO 3 + IF (KEY.EQ.IHEOL) GO TO 920 + GO TO 1 + 3 CLOSE(103) + OPEN(UNIT=103,NAME=FN,STATUS='OLD', + + FORM='UNFORMATTED',ERR=920) + GO TO 2 + 920 CALL PROUT(17H GAME NOT FROZEN. ,17) + RETURN + END + +END +DELETE F7:TRGETCD +EDIT +BUILD F7:TRGETCD + SUBROUTINE GETCD + INCLUDE F7:TREKCOM +C LOGICAL*2 CROP + LOGICAL CROP + REAL*8 AITEM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + REAL*8 RESPMAN,RESPAUT + DATA RESPMAN,RESPAUT/6HMANUAL,7HAUTOMAT/ + EQUIVALENCE (FNUM,AITEM) +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 ,20) + CALL CRAMSHP + CALL CRAMDMP(1H.,1) + 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 +C--------DEFAULT MANUAL MODE + IF(KEY.EQ.IHREAL) GOTO 24 + IF(KEY .EQ. IHALPHA) GO TO 13 + IF(DAMAGE(11) .NE. 0) GO TO 1301 + 11 CALL MANORA + IPROMPT=1 + GO TO 10 +C13 IF (CROP(AITEM,6HMANUAL)) GO TO 20 + 13 CROPITEM=AITEM + CROPMATCH=RESPMAN + IF (CROP()) GO TO 20 +C IF (.NOT.CROP(AITEM,7HAUTOMAT)) GO TO 11 + CROPMATCH=RESPAUT + IF (.NOT.CROP()) 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,37) + CALL CRAMLOC(2,IROWS,ICOLS) + CALL CRAMDMP(2H.",2) +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 + +END +DELETE F7:TRGETFN +EDIT +BUILD F7:TRGETFN + SUBROUTINE GETFN(NAME) +C +C 3-APR-79 +C MODIFIED TO MAKE FROZEN GAMES WORK ON THE VAX. +C + INCLUDE F7:TREKCOM + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK +C LOGICAL*1 NAME(30),AIT(8) +C REAL*8 AITEM + CHARACTER NAME(10),AIT(8),AITEM(8) +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + EQUIVALENCE (AIT,AITEM) +C*--READ IN A LEGAL FILE NAME (FOR FREEZE AND THAW) +C*--A NON-ALPHA ENTRY ABORTS THE ATTEMPT + ITRY=0 + 40 CALL SCAN + IF (KEY.EQ.IHEOL .AND. ITRY.EQ.0) GO TO 75 + IF (KEY.EQ.IHEOL .AND. ITRY.EQ.1) GO TO 100 +C IF (KEY .NE. IHALPHA) GO TO 100 + IF (KEY .NE. IHALPHA) GO TO 75 +C NAME(1)='S' +C NAME(2)='Y' +C NAME(3)='S' +C NAME(4)='$' +C NAME(5)='D' +C NAME(6)='I' +C NAME(7)='S' +C NAME(8)='K' +C NAME(9)=':' +C + NAME(1)='T' + NAME(2)='K' + NAME(3)=':' + DO 50 I=1,7 + IF(AIT(I).EQ.NULL) GOTO 60 +C50 NAME(I+9)=AIT(I) + 50 NAME(I+3)=AIT(I) + I=8 +C60 NAME(I+ 9)='.' +C NAME(I+10)='T' +C NAME(I+11)='R' +C NAME(I+12)='K' +C NAME(I+13)=NULL + 60 DO 70 J=I,7 + 70 NAME(J+3)=BLANK + RETURN +C*--PROMPT FOR A VALID FILE NAME + 75 CALL PROMPT(18HENTER FILE NAME: ,18) + ITRY=1 + GO TO 40 +C*--NON-ALPHA ITEM ABORTS REQUEST... + 100 NAME(1)=NULL +C RETURN + END + +END +DELETE F7:TRGETOU +EDIT +BUILD F7:TRGETOU + SUBROUTINE GETOUT +C +C 4-APR-79 (NEW ROUTINE) +C ERASES THE SCREEN ON A VT52 AND EXITS. +C +C LOGICAL*1 ERASE(5) +C INTEGER ERASE(5) +C DATA ERASE/'$',27,'H',27,'J'/ +C +C WRITE(1,1)ERASE +C1 FORMAT(5A1) + CALL SKIP(24) + CALL EXIT + END + +END +DELETE F7:TRHELP +EDIT +BUILD F7:TRHELP + SUBROUTINE HELP +C +C 4-DEC-79 +C SET DISTANCES CORRECTLY WHEN SHIP MATERIALIZES +C + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP + INTEGER ISHIP,SHUTUP + EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP) +C--------TEST FOR CONDITIONS WHICH PREVENT CALLING FOR HELP + IF(CONDIT .NE. IHDOCKD ) GO TO 10 + CALL PROUT( + + 48HLT. UHURA: "BUT CAPTAIN, WE'RE ALREADY DOCKED.",48) + RETURN + 10 IF(DAMAGE(9) .EQ. 0) GO TO 20 + CALL PROUT(23HSUBSPACE RADIO DAMAGED.,23) + RETURN + 20 IF(REMBASE .NE. 0) GO TO 30 + CALL PROUT(66HLT. UHURA: "CAPTAIN, I'M NOT GETTING ANY RESPONSE F + +ROM STARBASE.",66) + RETURN + 30 IF(LANDED .NE. 1) GO TO 31 + CALL CRAM(23HYOU MUST BE ABOARD THE ,23) + CALL CRAMSHP + CALL CRAMDMP(1H.,1) + RETURN + 31 IF(ISCRAFT .NE. 0) GO TO 32 + CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET. + 1 ,42) + RETURN +C--------DETERMINE APPROXIMATE DISTANCE TO NEAREST STARBASE + 32 NHELP=NHELP+1 + IF(BASEX .EQ. 0) GO TO 40 + DIST=SQRT(FLOAT((BASEX-SECTX)**2 + (BASEY-SECTY)**2)) + GO TO 60 + 40 DIST=1E38 + DO 50 L=1,REMBASE + XDIST=10.0*SQRT(FLOAT((BASEQX(L)-QUADX)**2+(BASEQY(L)-QUADY)**2)) + IF(XDIST .GT. DIST) GO TO 50 + DIST=XDIST + LINE=L + 50 CONTINUE +C--------IF STARBASE IS NOT IN THIS QUADRANT, SET UP NEW QUADRANT + QUADX=BASEQX(LINE) + QUADY=BASEQY(LINE) +C SHUTUP=1.0 + SHUTUP=1 + CALL NEWQUAD +C SHUTUP=0.0 + SHUTUP=0 +C--------DEMATERIALIZE STARSHIP + 60 QUAD(SECTX,SECTY)=IHDOT + CALL CRAM(11HSTARBASE IN,11) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CRAM(11H RESPONDS--,11) + CALL CRAMSHP + CALL CRAMDMP(16H DEMATERIALIZES.,16) +C--------GIVE STARBASE THREE CHANCES TO REMATERIALIZE STARSHIP + PROBF=(1.0 - 0.98**DIST)**0.3333333333 + DO 80 L=1,3 + IF(L .EQ. 1) CALL CRAM(4H1ST ,4) + IF(L .EQ. 2) CALL CRAM(4H2ND ,4) + IF(L .EQ. 3) CALL CRAM(4H3RD ,4) + CALL CRAM(26HATTEMPT TO RE-MATERIALIZE ,26) + CALL CRAMSHP + CALL CRAM(11H . . . . . ,11) + IF(RANF(0) .GT. PROBF) GO TO 90 + 70 CALL CRAMDMP(6HFAILS.,6) + 80 CONTINUE +C--------ONE, TWO, THREE STRIKES YOU'RE OUT + CALL FINISH(11) + RETURN +C--------REMATERIALIZATION ATTEMPT SHOULD SUCCEED, IF CAN GET ADJ TO BASE + 90 DO 100 LL=1,5 + IX=BASEX+IFIX(3.0*RANF(0))-1 + IF(IX.EQ.0 .OR. IX.EQ.11) GO TO 100 + IY=BASEY+IFIX(3.0*RANF(0))-1 + IF(IY.EQ.0 .OR. IY.EQ.11) GO TO 100 + IF(QUAD(IX,IY) .EQ. IHDOT) GO TO 110 + 100 CONTINUE + GO TO 70 +C--------ATTEMPT HAS SUCCEEDED--FINISH UP + 110 CALL CRAMDMP(9HSUCCEEDS.,9) + SECTX=IX + SECTY=IY + QUAD(IX,IY)=ISHIP + CALL RESETD + CALL SORTKL + CALL DOCK + CALL SKIP(1) + CALL PROUT(34HLT. UHURA: "CAPTAIN, WE MADE IT!",34) + RETURN + END + +END +DELETE F7:TRHITEM +EDIT +BUILD F7:TRHITEM + SUBROUTINE HITEM(HITS) + INCLUDE F7:TREKCOM +C LOGICAL*1 IENM + INTEGER IENM + DIMENSION HITS(20) + REAL KP + DATA PHASFAC/2.0/ + CALL SKIP(1) + NENHER2=NENHERE + KK=1 + DO 40 K=1,NENHER2 + WHAM=HITS(K) + IF(WHAM .EQ. 0) GO TO 30 + DUSTFAC=0.90+0.01*RANF(0) + HIT=WHAM*DUSTFAC**KDIST(KK) + KP=KPOWER(KK) + KPOWER(KK)=KP-SIGN(AMIN1(ABS(KP),PHASFAC*HIT),KP) + KPOW=KPOWER(KK) + II=KX(KK) + JJ=KY(KK) + IF(HIT .GT. .005)GO TO 10 + CALL CRAM(18HVERY SMALL HIT ON ,18) + GO TO 20 + 10 CALL CRAMF(HIT,0,2) + CALL CRAM(13H UNIT HIT ON ,13) + 20 IENM=QUAD(II,JJ) +C CALL CRAMENA(IENM,2,II,JJ) + CALL CRAMENA(IENM) + CALL CREND + IF(KPOW .NE. 0) GO TO 25 + CALL DEADKL(II,JJ,IENM,II,JJ) + IF(REMKL .EQ. 0)CALL FINISH(1) + IF(ALLDONE.NE.0) RETURN + GO TO 40 +C--------- DECIDE WHETHER OR NOT TO EMASCULATE KLINGON. + 25 IF(KPOW .LT. 0) GO TO 30 + IF(RANF(0.) .LT. .90)GO TO 30 + IF(KPOW .GT. ((.40 + .4*RANF(0.))*KP))GO TO 30 + CALL CRAM(38H***MR. SPOCK: "CAPTAIN, THE VESSEL AT,38) + CALL CRAMLOC(2,II,JJ) + CALL CREND + CALL PROUT(32H HAS JUST LOST ITS FIREPOWER.",32) + KPOWER(KK)=-KPOW + 30 KK=KK+1 + 40 CONTINUE + RETURN + END + +END +DELETE F7:TRIMPUL +EDIT +BUILD F7:TRIMPUL + SUBROUTINE IMPULSE + INCLUDE F7:TREKCOM + LOGICAL JA + IDIDIT=0 + IF(DAMAGE(7).NE.0) GO TO 40 +C--------READ IN COURSE AND DISTANCE + IF(ENERGY .LE. 30.0) GO TO 5 + CALL GETCD + IF(DIREC .LT. 0) RETURN +C--------MAKE SURE STARSHIP HAS SUFFICIENT ENERGY FOR TRIP + POWER=20.0+100.0*DIST + IF(POWER .LT. ENERGY) GO TO 20 + 5 CALL SKIP(1) + CALL PROUT( + + 51HFIRST OFFICER SPOCK: "CAPTAIN, THE IMPULSE ENGINES,51) + CALL PROUT( + + 51HREQUIRE 20.0 UNITS TO ENGAGE, PLUS 100.0 UNITS PER ,51) + IF(ENERGY .GT. 30.0) GO TO 10 + CALL PROUT( + + 41HQUADRANT. THEY ARE, THEREFORE, USELESS.",41) + RETURN + 10 CALL CRAM(46HQUADRANT. WE CAN GO, THEREFORE, A MAXIMUM OF ,46) + CALL CRAMF(0.01*(ENERGY-20.0)-0.05,0,1) + CALL CREND + CALL PROUT(11HQUADRANTS.",11) + RETURN +C--------MAKE SURE ENOUGH TIME IS LEFT FOR THE TRIP + 20 TIME=DIST/0.095 + IF(TIME .LT. REMTIME) GO TO 30 + CALL PROUT( + + 55HFIRST OFFICER SPOCK: "CAPTAIN, OUR SPEED UNDER IMPULSE,55) + CALL PROUT( + + 54HPOWER IS ONLY 0.95 SECTORS PER STARDATE. ARE YOU SURE,54) + CALL PROUT(24HWE DARE SPEND THE TIME?",24) +C IF(JA(DUMMY)) GO TO 30 + IF(JA(1)) GO TO 30 + RETURN +C--------ACTIVATE IMPULSE ENGINES AND PAY THE COST + 30 CALL MOVE + IDIDIT=1 + IF(ALLDONE.NE.0) RETURN + POWER=20.0+100.0*DIST + ENERGY=ENERGY-POWER + TIME=DIST/0.095 + IF(ENERGY .GT. 0) RETURN + CALL FINISH(4) + RETURN + 40 CALL SKIP(1) + CALL PROUT(24HIMPULSE ENGINES DAMAGED.,24) + RETURN + END + +END +DELETE F7:TRIRAN8 +EDIT +BUILD F7:TRIRAN8 + SUBROUTINE IRAN8(II,JJ) + II=RANF(0)*8.+1. + JJ=RANF(0)*8.+1. + RETURN +C* + ENTRY IRAN10(II,JJ) +C* + II=RANF(0)*10.+1. + JJ=RANF(0)*10.+1. + RETURN + END + +END +DELETE F7:TRJA +EDIT +BUILD F7:TRJA + LOGICAL FUNCTION JA(INSIST) +C BYTE BITEM +C REAL*8 AITEM +C COMMON/SCANBF/KEY,AITEM +C EQUIVALENCE (AITEM,BITEM) + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + REAL*8 AITEM,RESPNO,RESPYES + DATA RESPNO,RESPYES/2HNO,3HYES/ + LOGICAL CROP + 10 CALL SCAN +C JA=0 +C IF(BITEM .EQ. 1HN) RETURN +C JA=-1 +C IF(BITEM .EQ. 1HY) RETURN + JA=.FALSE. + CROPITEM=AITEM + CROPMATCH=RESPNO + IF(CROP()) RETURN + JA=.TRUE. + CROPMATCH=RESPYES + IF(CROP()) RETURN + JA=.FALSE. + IF (INSIST .EQ. 0) GO TO 99 + CALL PROMPT(29HPLEASE ANSWER WITH YES OR NO:,29) + GO TO 10 + 99 RETURN + END +C + LOGICAL FUNCTION NEIN() + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + REAL*8 AITEM,RESPNO + DATA RESPNO/2HNO/ + LOGICAL CROP + NEIN=.TRUE. + CROPITEM=AITEM + CROPMATCH=RESPNO + IF(CROP()) RETURN + NEIN=.FALSE. + RETURN + END + +END +DELETE F7:TRLRSCN +EDIT +BUILD F7:TRLRSCN + SUBROUTINE LRSCAN + INCLUDE F7:TREKCOM + IF(DAMAGE(2) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 40 + CALL SKIP(1) + CALL CRAM(14HL. R. SCAN FOR,14) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CREND + I=QUADX-1 + II=QUADX+1 + J=QUADY-1 + JJ=QUADY+1 + DO 30 L=I,II + DO 20 LL=J,JJ + IVAL=-1 + IF(L .EQ. 0 .OR. L .GT. 8) GO TO 10 + IF(LL .EQ. 0 .OR. LL .GT. 8) GO TO 10 + IVAL=GALAXY(L,LL) + STARCH(L,LL)=1 + 10 CALL CRAMI(IVAL,5) + 20 CONTINUE + CALL CREND + 30 CONTINUE + RETURN + 40 CALL PROUT(22HL. R. SENSORS DAMAGED.,22) + RETURN + END + +END +DELETE F7:TRMOVE +EDIT +BUILD F7:TRMOVE + SUBROUTINE MOVE + INCLUDE F7:TREKCOM +C LOGICAL*1 IQUAD,ISHIP + INTEGER IQUAD,ISHIP + INTEGER TRBEAM + EQUIVALENCE (CRACKS(6),KDIDIT),(SHIP,ISHIP) + IF(INORBIT .EQ. 0) GO TO 1 + CALL PROUT(32HSULU: "LEAVING STANDARD ORBIT.",32) + INORBIT=0 + 1 ANGLE=((15.0-DIREC)*0.5235988) + DELTAX=-SIN(ANGLE) + DELTAY=COS(ANGLE) + BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY)) + DELTAX=DELTAX/BIGGER + DELTAY=DELTAY/BIGGER + TRBEAM=0 +C--------IF TRACTOR BEAM IS TO OCCUR, DO NOT MOVE FULL DISTANCE + IF(DATE+TIME .LT. FUTURE(2)) GO TO 5 + TRBEAM=1 + CONDIT=IHRED + DIST=DIST*(FUTURE(2)-DATE)/TIME+0.1 + TIME=FUTURE(2)-DATE + 1E-5 +C--------MOVE WITHIN QUADRANT + 5 QUAD(SECTX,SECTY)=IHDOT + X=SECTX + Y=SECTY + N=10.0*DIST*BIGGER+0.5 + IF(N .EQ. 0) GO TO 100 + DO 10 L=1,N + X=X+DELTAX + IX=X+0.5 + Y=Y+DELTAY + IY=Y+0.5 + IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 40 + IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 40 + IQUAD=QUAD(IX,IY) + IF(IQUAD .NE. IHDOT) GO TO 20 + 10 CONTINUE + DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2)) + SECTX=IX + SECTY=IY + GO TO 100 +C--------OBJECT ENCOUNTERED ALONG FLIGHT PATH + 20 STOPEGY=50.0*DIST/TIME + DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2)) + IF(IQUAD.EQ.IHK .OR. IQUAD.EQ.IHC .OR. IQUAD.EQ.IHS .OR. + + IQUAD.EQ.IHR) GO TO 30 + IF(IQUAD.EQ.IHT) GO TO 30 +C IF(IQUAD .EQ. '@') GO TO 25 + IF(IQUAD .EQ. IHAT) GO TO 25 +C--------OBJECT IS NOT AN ENEMY VESSEL, OR BLACK HOLE. + CALL SKIP(1) + CALL CRAMSHP + IF(IQUAD.NE.IHNUM) CALL CRAM(21H BLOCKED BY OBJECT AT,21) + IF(IQUAD.EQ.IHNUM) CALL CRAM(26H ENCOUNTERS THOLIAN WEB AT ,26) + CALL CRAMLOC(2,IX,IY) + CALL CRAMDMP(1H;,1) + CALL CRAM(24HEMERGENCY STOP REQUIRED ,24) + CALL CRAMF(STOPEGY,0,2) + CALL CRAMDMP(17H UNITS OF ENERGY.,17) + ENERGY=ENERGY-STOPEGY + SECTX=X-DELTAX+0.5 + SECTY=Y-DELTAY+0.5 + IF(ENERGY .GT. 0) GO TO 100 + CALL FINISH(4) + RETURN +C--------OBJECT IS A BLACK HOLE. SWALLOW SHIP. + 25 CALL REDALRT + CALL SKIP(1) + CALL CRAM3AS + CALL CRAMSHP + CALL CRAM(26H PULLED INTO BLACK HOLE AT,26) + CALL CRAMLOC(2,IX,IY) + CALL CREND + IF(RANF(0).GT.0.50) GO TO 27 + CALL IRAN8(QUADX,QUADY) + CALL IRAN10(SECTX,SECTY) + CALL PROUT( + $55HSPOCK: "CAPTAIN, INSTRUMENTS INDICATE WE HAVE UNDERGONE ,55) + CALL CRAM(15H A SPACE ,15) + XTIMEW=RANF(0) + IF(XTIMEW.GT.0.65) CALL CRAM(5H-TIME ,5) + CALL CRAMDMP(14H PHASE SHIFT." ,14) + IF(XTIMEW.GT.0.65) CALL TIMEWRP + IF(XTIMEW.GT.0.65) KSTUF(4)=1 + GO TO 95 + 27 CALL FINISH(21) + RETURN +C--------OBJECT IS AN ENEMY VESSEL; RAM HIM. + 30 SECTX=IX + SECTY=IY + CALL RAM(0,IQUAD,SECTX,SECTY) + GO TO 100 +C--------COMPUTE FINAL POSITION--NEW QUADRANT, NEW SECTOR + 40 X=10*(QUADX-1)+SECTX + Y=10*(QUADY-1)+SECTY + IX=X+10.0*DIST*BIGGER*DELTAX+0.5 + IY=Y+10.0*DIST*BIGGER*DELTAY+0.5 +C--------CHECK FOR EDGE OF GALAXY + KINKS=0 + 45 KINK=0 + IF(IX .GT. 0) GO TO 50 + IX=-IX+1 + KINK=1 + 50 IF(IY .GT. 0) GO TO 55 + IY=-IY+1 + KINK=1 + 55 IF(IX .LE. 80) GO TO 60 + IX=161-IX + KINK=1 + 60 IF(IY .LE. 80) GO TO 65 + IY=161-IY + KINK=1 + 65 IF(KINK .EQ. 0) GO TO 70 + KINKS=1 + GO TO 45 + 70 IF(KINKS .EQ. 0) GO TO 90 + NKINKS=NKINKS+1 + IF(NKINKS .EQ. 3) GO TO 80 +C--------ISSUE REPRIMAND FOR HITTING EDGE OF GALAXY + CALL SKIP(1) + CALL PROUT( + + 55HYOU HAVE ATTEMPTED TO CROSS THE NEGATIVE ENERGY BARRIER,55) + CALL PROUT( + + 56HAT THE EDGE OF THE GALAXY. THE THIRD TIME YOU TRY THIS,,56) + CALL PROUT(22HYOU WILL BE DESTROYED.,22) + GO TO 90 +C--------ONE, TWO, THREE STRIKES, YOU'RE OUT + 80 CALL FINISH(6) + RETURN +C--------COMPUTE FINAL POSITION OF STARSHIP IN NEW QUADRANT + 90 CONTINUE + QUADX=(IX+9)/10 + QUADY=(IY+9)/10 + SECTX=IX-10*(QUADX-1) + SECTY=IY-10*(QUADY-1) + IF(TRBEAM.NE.0) RETURN + 95 CALL SKIP(1) + CALL CRAM(8HENTERING,8) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CREND + QUAD(SECTX,SECTY)=ISHIP + CALL NEWQUAD + RETURN +C--------NO QUADRANT CHANGE; COMPUTE NEW ENEMY DISTANCES + 100 QUAD(SECTX,SECTY)=ISHIP + CALL RESETD + IF(KDIDIT .EQ. 0) CALL SORTKL + RETURN + END + +END +DELETE F7:TRMOVEC +EDIT +BUILD F7:TRMOVEC + SUBROUTINE MOVECOM +C +C 20-APR-79 +C MOVE RESETTING OF IRUN INTO THE LOOP. THIS KEEPS A ROMULAN +C ACCOMPANYING THE SUPER-COMMANDER FROM ESCAPING, A SITUATION +C THAT RESULTS IN LOSING BASES, MESSING UP THE KLINGON +C BOOKKEEPING, ETC. +C + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP,IENM,IQUAD + INTEGER ISHIP,IENM,IQUAD + INTEGER COMX,COMY,SUPX,SUPY + EQUIVALENCE (CRACKS(5),LOCCOM),(SHIP,ISHIP) + DATA KRAWLX,KRAWLY/1,1/ + IF((NENHERE.EQ.0).OR.(JUSTIN.EQ.1)) RETURN + NBADDYS=COMHERE+ISHERE +C--------THIS CONTINUE STATEMENT IS FOR MNF + CONTINUE + IF(KSTUF(5).NE.0) NBADDYS=((COMHERE*2)+(ISHERE*2)+ + $ (FLOAT(KLHERE)*1.23) + (FLOAT(IRHERE)*1.5)) / 2.0 +C-------LOOP FOR MOVING ENEMIES BEGINS HERE. + I=1 + 1 IRUN=0 + IX=KX(I) + IY=KY(I) + IENM=QUAD(IX,IY) + COMX=IX + COMY=IY + LOCCOM=I + IF((KSTUF(5).EQ.0).AND.((IENM.NE.IHS).OR.(IENM.NE.IHC))) GO TO 500 + IF(IENM.NE.IHS) GO TO 3 +C--------CHECK WITH SPY TO SEE IF S.C. SHOULD HI-TAIL IT. + IF((KPOWER(LOCCOM).GT.500.) .AND. ((CONDIT.NE.IHDOCKD) + + .OR. (DAMAGE(4).NE.0.))) GO TO 3 + IRUN=1 + MOTION=-10 + GO TO 8 +C--------DECIDE WHETHER TO ADVANCE, RETREAT, OR HOLD POSITION +C AND BY HOW MUCH + 3 MOTION=0 + DIST1=KDIST(LOCCOM) + MDIST=DIST1+0.5 + FORCES=KPOWER(LOCCOM)+100.0*NENHERE +400.*(NBADDYS-1) + IF(SHLDUP .EQ. 0) FORCES=FORCES+1000. + IF((DAMAGE(3) .EQ. 0) .OR. (DAMAGE(4) .EQ. 0)) GO TO 4 + FORCES=FORCES+1000. + GO TO 7 + 4 EFAC=1. + TFAC=1. + IF(DAMAGE(3) .EQ. 0) GO TO 5 + EFAC=0. + FORCES=FORCES+300. + 5 IF(DAMAGE(4) .EQ. 0) GO TO 6 + TFAC=0. + FORCES=FORCES+300. + 6 FORCES=FORCES-50.*TORPS*TFAC+0.2*(2500.-ENERGY)*EFAC + C +0.6*(1250.-SHLD)*SHLDUP + 7 IF(FORCES .GT. 1000.0) MOTION=(1.-RANF(0)**2)*DIST1+1.0 + IF(CONDIT .EQ. IHDOCKD ) MOTION=MOTION-SKILL*(2.-RANF(0)**2) + IF(MOTION .EQ. 0) MOTION=((FORCES+200.0*RANF(0))/150.0)-5.0 + IF(MOTION .EQ. 0) GO TO 500 + IF(IABS(MOTION) .GT. SKILL) MOTION=ISIGN(SKILL,MOTION) +C--------CALCULATE PREFERRED NUMBER OF STEPS TO MOVE COMMANDER + 8 NSTEPS=IABS(MOTION) + IF((MOTION .GT. 0) .AND. (NSTEPS .GT. MDIST)) NSTEPS=MDIST + NSTEPS=MIN0(10,NSTEPS) + NSTEPS=MAX0(1,NSTEPS) +C--------COMPUTE PREFERRED VALUES OF DELTA X AND DELTA Y + MX=SECTX-COMX + MY=SECTY-COMY + IF(2*IABS(MX) .LT. IABS(MY)) MX=0 + IF(2*IABS(MY) .LT. IABS(MX)) MY=0 + IF(MX .NE. 0) MX=ISIGN(1,MX*MOTION) + IF(MY .NE. 0) MY=ISIGN(1,MY*MOTION) +C--------MAIN LOOP TO ATTEMPT TO MOVE COMMANDER STEPS + NEXTX=COMX + NEXTY=COMY + QUAD(COMX,COMY)=IHDOT + DO 60 LL=1,NSTEPS +C--------TEST IF PREFERRED POSITION IS AVAILABLE + LOOKX=NEXTX+MX + LOOKY=NEXTY+MY + 1111 CONTINUE + 2222 CONTINUE + ASSIGN 10 TO NOEXIT + IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,30,30 + IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,10,10 + IQUAD=QUAD(LOOKX,LOOKY) +C--------DECIDE IF COMMANDER SHOULD RAM + IF(IQUAD .NE. ISHIP) GO TO 9010 +C--------ONLY LET COMMANDERS RAM THE SHIP. + IF((IENM.NE.IHC).AND.(IENM.NE.IHS)) GO TO 9010 +C--------WHAMO! + CALL RAM(1,IENM,COMX,COMY) + GO TO 500 + 9010 IF(IQUAD .EQ. IHDOT) GO TO 50 + GO TO 10 +C--------TRY TO FUDGE ON Y COORDINATE + 10 IF(MY.EQ.KRAWLY .OR. MX.EQ.0) GO TO 30 + LOOKY=NEXTY+KRAWLY + ASSIGN 20 TO NOEXIT + IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,20,20 + IF(LOOKX .LE. 0 .OR. LOOKX .GT. 10) IF(MOTION)70,20,20 + IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50 + 20 KRAWLY=-KRAWLY +C--------TRY TO FUDGE X COORDINATE + 30 IF(MX.EQ.KRAWLX .OR. MY.EQ.0) GO TO 60 + LOOKX=NEXTX+KRAWLX + ASSIGN 40 TO NOEXIT + IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,40,40 + IF(LOOKY .LE. 0 .OR. LOOKY .GT. 10) IF(MOTION) 70,40,40 + IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50 + 40 KRAWLX=-KRAWLX + GO TO 60 + 50 NEXTX=LOOKX + NEXTY=LOOKY + 60 CONTINUE +C--------PUT COMMANDER IN NEW PLACE WITHIN SAME QUADRANT + QUAD(NEXTX,NEXTY)=IENM + IF(NEXTX.EQ.COMX .AND. NEXTY.EQ.COMY) GO TO 500 + KX(LOCCOM)=NEXTX + KY(LOCCOM)=NEXTY + KDIST(LOCCOM)= + + SQRT(FLOAT((SECTX-NEXTX)**2 + (SECTY-NEXTY)**2)) + MOTION=-1 + IF(KDIST(LOCCOM) .LT. DIST1) MOTION=1 + CALL CRAM3AS + CALL CRAMEN(IENM) + IF(MOTION .GT. 0) CALL CRAM(12H ADVANCES TO,12) + IF(MOTION .LT. 0) CALL CRAM(12H RETREATS TO,12) + CALL CRAMLOC(2,NEXTX,NEXTY) + CALL CREND + GO TO 500 +C--------TRY TO MOVE INTO ADJACENT QUADRANT, AVOIDING NEGATIVE ENERGY +C BARRIER, SUPERNOVAE, AND QUADRANTS WITH MORE THAN 8 KLINGONS. + 70 IQX=QUADX+(LOOKX+9)/10-1 + IQY=QUADY+(LOOKY+9)/10-1 + IF(IQX.LT.1 .OR. IQX.GT.8) GO TO NOEXIT + IF(IQY.LT.1 .OR. IQY.GT.8) GO TO NOEXIT + IF(GALAXY(IQX,IQY) .GT. 899) GO TO NOEXIT +C--------ALSO AVOID INTRUDING ON ANOTHER COMMANDERS TERRITORY (UNLESS S.C.) + IF(IRUN.NE.0) GO TO 86 + IF(IENM .EQ. IHS) GO TO 85 + DO 80 L=1,REMCOM + IF(CX(L).EQ.IQX .AND. CY(L).EQ.IQY) GO TO NOEXIT + 80 CONTINUE +C------DON'T LET ROMULANS LEAVE. + IF(IENM.EQ.IHR) GO TO NOEXIT +C--------ALSO, REFUSE TO LEAVE IF CURRENTLY ATTACKING STARBASE (UNLESS S.C.) + IF(BATX.EQ.QUADX .AND. BATY.EQ.QUADY) GO TO NOEXIT +C--------FINALLY, DON'T LEAVE WITH OVER 1000 UNITS OF ENERGY. + 85 IF(KPOWER(LOCCOM) .GT. 1000.) GO TO NOEXIT +C--------PRINT ESCAPE MESSAGE AND MOVE COMMANDER TO ADJACENT QUADRANT + 86 CALL CRAM3AS + CALL CRAMEN(IENM) + CALL CRAM(11H ESCAPES TO,11) + CALL CRAMLOC(1,IQX,IQY) + CALL CRAMDMP(23H (AND REGAINS STRENGTH),23) +C--------HANDLE LOCAL MATTERS RELATING TO COMMANDERS ESCAPE + CALL LEAVE +C NUMBER OF KLINGONS HAS BEEN REDUCED (IN QUAD) + I=I-1 +C--------HANDLE GLOBAL MATTERS RELATING TO COMMANDERS ESCAPE + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-100 + GALAXY(IQX,IQY)=GALAXY(IQX,IQY)+100 + IF(IENM .EQ. IHC) GO TO 87 + IF(IENM .NE. IHS) GO TO 500 + ISHERE=0 + ISCATE=0 + IENTESC=0 + ISATB=0 + FUTURE(6)=0.2777+DATE + FUTURE(7)=1E38 + ISX=IQX + ISY=IQY + GO TO 500 + 87 DO 90 L=1,REMCOM + IF(CX(L).EQ.QUADX .AND. CY(L).EQ.QUADY) GO TO 100 + 90 CONTINUE + 100 CX(L)=IQX + CY(L)=IQY + COMHERE=0 + 500 I=I+1 + IF(I.LE.NENHERE) GOTO 1 + CALL SORTKL + RETURN + END + +END +DELETE F7:TRMOVET +EDIT +BUILD F7:TRMOVET + SUBROUTINE MOVETHO + INCLUDE F7:TREKCOM + EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) +C + IF(ITHERE.EQ.0) RETURN + IF(JUSTIN.EQ.1) RETURN +C + IF((ITHX.EQ.1).AND.(ITHY.EQ.1)) GO TO 10 + IF((ITHX.EQ.1).AND.(ITHY.EQ.10))GO TO 20 + IF((ITHX.EQ.10).AND.(ITHY.EQ.10))GOTO 30 + IF((ITHX.EQ.10).AND.(ITHY.EQ.1))GO TO 40 +C---------SOMETHING IS VERY WRONG....GET RID OF THOLIAN. + ITHERE=0 + RETURN +C +C--------SET DESTINATION SECTOR. + 10 IDX=1 + IDY=10 + GO TO 50 + 20 IDX=10 + IDY=10 + GO TO 50 + 30 IDX=10 + IDY=1 + GO TO 50 + 40 IDX=1 + IDY=1 +C +C----------MAKE SURE DESTINATION IS EMPTY. IF NOT, FORGET IT. + 50 IF((QUAD(IDX,IDY).NE.IHDOT).AND.(QUAD(IDX,IDY).NE.IHNUM)) + 2RETURN + QUAD(ITHX,ITHY)=IHNUM + IF(ITHX.EQ.IDX) GO TO 120 +C----------MOVE THOLIAN ON X-AXIS + IM=ABS(FLOAT(IDX-ITHX))/FLOAT(IDX-ITHX) + 70 IF(ITHX.EQ.IDX) GO TO 200 + ITHX=ITHX+IM + IF(QUAD(ITHX,ITHY).EQ.IHDOT) QUAD(ITHX,ITHY)=IHNUM + GO TO 70 + 120 IF(ITHY.EQ.IDY) GO TO 200 +C------------MOVE THOLIAN ON Y-AXIS. + IM=ABS(FLOAT(IDY-ITHY))/FLOAT(IDY-ITHY) + 130 IF(ITHY.EQ.IDY) GO TO 200 + ITHY=ITHY+IM + IF(QUAD(ITHX,ITHY).EQ.IHDOT) QUAD(ITHX,ITHY)=IHNUM + GO TO 130 + 200 QUAD(ITHX,ITHY)=IHT +C-------CHECK TO SEE IF ALL HOLES ARE PLUGED + DO 220 I=1,10 + IF(QUAD(1,I).EQ.IHNUM) GO TO 205 + IF(QUAD(1,I).NE.IHT) RETURN + 205 IF(QUAD(10,I).EQ.IHNUM) GO TO 210 + IF(QUAD(10,I).NE.IHT) RETURN + 210 IF(QUAD(I,1).EQ.IHNUM) GO TO 215 + IF(QUAD(I,1).NE.IHT) RETURN + 215 IF(QUAD(I,10).EQ.IHNUM) GO TO 220 + IF(QUAD(I,10).NE.IHT) RETURN + 220 CONTINUE +C-------ALL PLUGED UP, THOLIAN SPLITS. + QUAD(ITHX,ITHY)=IHNUM +C CALL DROPIN('@',ID1,ID2) + CALL DROPIN(IHAT,ID1,ID2) + ITHERE=0 + CALL CRMSENA(IHT,2,ITHX,ITHY) + CALL CRAMDMP(15H COMPLETES WEB.,15) + RETURN + END + +END +DELETE F7:TRNEWCO +EDIT +BUILD F7:TRNEWCO + SUBROUTINE NEWCOND + INCLUDE F7:TREKCOM + CONDIT=IHGREEN + IF(ENERGY .LT. 1000.0) CONDIT=IHYELLO + IF((GALAXY(QUADX,QUADY) .GT. 99) .OR. (NEWSTUF(QUADX,QUADY) .GT. + C 9))CONDIT=IHRED + RETURN + END + +END +DELETE F7:TRNEWQU +EDIT +BUILD F7:TRNEWQU + SUBROUTINE NEWQUAD + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP + INTEGER ISHIP,SHUTUP + INTEGER QUADNUM + REAL*8 THOLIANX + EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP) + EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) + DATA THOLIANX/8HTHOLIANX/ + JUSTIN=1 + BASEX=0 + BASEY=0 + KLHERE=0 + COMHERE=0 + PLNETX=0 + PLNETY=0 + ISHERE=0 + IRHERE=0 + IPLANET=0 + NENHERE=0 + NEUTZ=0 + INORBIT=0 + LANDED=-1 + IENTESC=0 + ITHERE=0 + IF(ISCATE .EQ. 0) GO TO 5 +C--------ENTERPRISE TRIED TO ESCAPE FROM A SUPER-COMMANDER. + ISCATE=0 + IENTESC=1 + 5 QUADNUM=GALAXY(QUADX,QUADY) + IF(QUADNUM .GT. 999) GO TO 70 + KLHERE=QUADNUM/100 + NEWNUM=NEWSTUF(QUADX,QUADY) + IRHERE=NEWNUM/10 + NPLAN=NEWNUM-IRHERE*10 + NENHERE=KLHERE+IRHERE +C--------EMPTY QUADRANT AND POSITION STARSHIP + DO 15 I=1,10 + DO 15 J=1,10 + 15 QUAD(I,J)=IHDOT + QUAD(SECTX,SECTY)=ISHIP +C-----------DECIDE IF THIS QUADRENT NEEDS A THOLIAN..... +C IF((RANF(0).GT.0.08).AND.(PASSWD.NE.8HTHOLIANX)) GO TO 23 + IF((RANF(0).GT.0.08).AND.(PASSWD.NE.THOLIANX)) GO TO 23 +C--------DECIDE POSITION FOR THOLIAN...... + 17 ITHX=INT(RANF(0)+0.5)*9+1 + ITHY=INT(RANF(0)+0.5)*9+1 + IF(QUAD(ITHX,ITHY).NE.IHDOT) GO TO 17 + QUAD(ITHX,ITHY)=IHT + ITHERE=1 +C---------PUT AN X IN EACH UNOCCUPIED CORNER. (TO RESERVE IT) + IF(QUAD(1,1).EQ.IHDOT) QUAD(1,1)=1HX + IF(QUAD(1,10).EQ.IHDOT)QUAD(1,10)=1HX + IF(QUAD(10,10).EQ.IHDOT)QUAD(10,10)=1HX + IF(QUAD(10,1).EQ.IHDOT)QUAD(10,1)=1HX + 23 CONTINUE +C--------POSITION ORDINARY KLINGON VESSELS + IF(QUADNUM .LT.100)GO TO 34 + QUADNUM=QUADNUM-100*KLHERE + DO 25 I=1,KLHERE + CALL DROPIN(IHK,IX,IY) + KX(I)=IX + KY(I)=IY + 25 KPOWER(I)=RANF(0)*150.0+300.+25.*SKILL +C--------IF THIS QUADRANT NEEDS A COMMANDER, PROMOTE ONE KLINGON + IF(REMCOM .EQ. 0) GO TO 32 + DO 30 I=1,REMCOM + IF(CX(I) .EQ. QUADX .AND. CY(I) .EQ. QUADY)GO TO 31 + 30 CONTINUE + GO TO 32 + 31 QUAD(IX,IY)=IHC + KPOWER(KLHERE)=950.0+400.0*RANF(0)+50.*SKILL + COMHERE=1 + COMX=IX + COMY=IY +C--------IF THIS QUADRANT NEEDS A SUPER-COMMANDER, PROMOTE ONE KLINGON. + 32 I=KLHERE + IF((QUADX .NE. ISX) .OR. (QUADY .NE. ISY)) GO TO 34 + IF(COMHERE .EQ. 0) GO TO 33 + I=KLHERE-1 + IX=KX(I) + IY=KY(I) + 33 QUAD(IX,IY) = IHS + KPOWER(I)=1175.0+400.0*RANF(0)+125.0*SKILL + ISCATE=1 + ISHERE=1 +C--------PUT IN ROMULANS IF NEEDED. + 34 IF(IRHERE .EQ. 0) GO TO 37 + ITEMP1=KLHERE+1 + DO 36 I=ITEMP1, NENHERE + CALL DROPIN(IHR,IX,IY) + KX(I)=IX + KY(I)=IY + 36 KPOWER(I)=450.+400.*RANF(0)+50.*SKILL + 37 CALL RESETD + CALL SORTKL +C--------IF QUADRANT CONTAINS A STARBASE, CHOOSE ITS POSITION + IF(QUADNUM .LT. 10)GO TO 50 + QUADNUM =QUADNUM - 10 + CALL DROPIN(IHB,BASEX,BASEY) +C--------IF QUADRANT NEEDS A PLANET, PUT ONE IN. + 50 IF(NPLAN .EQ. 0) GO TO 54 + DO 51 I=1,INPLAN + IPLANET=I + IF(PLNETS(I,1) .EQ. QUADX .AND. PLNETS(I,2) .EQ. QUADY) GO TO 52 + 51 CONTINUE + IPLANET=0 + GO TO 54 + 52 CALL DROPIN(IHP,PLNETX,PLNETY) +C--------AND FINALLY, THE STARS + 54 CALL NEWCOND + IF(QUADNUM .LT. 1)GO TO 62 + DO 60I=1,QUADNUM + 60 CALL DROPIN(IHSTAR,IX,IY) +C--------IF ROMULANS PRESENT WITHOUT KLINGONS OR BASE, PRINT SPECIAL MESSAGE. + 62 IF((IRHERE .EQ. 0) .OR. (KLHERE .NE. 0) .OR. (BASEX .NE. 0))GOTO66 + IF(DAMAGE(9) .GT. 0.) GO TO 64 + CALL SKIP(1) + CALL PROUT(41HLT. UHURA: "CAPTAIN, AN URGENT MESSAGE. ,41) + CALL PROUT(31H I'LL PUT IT ON AUDIO." CLICK ,31) + CALL SKIP(1) + CALL PROUT(58H "INTRUDER! YOU HAVE VIOLATED THE ROMULAN NEUTRAL + CZONE." ,58) + CALL PROUT(44H "LEAVE AT ONCE, OR YOU WILL BE DESTROYED!" ,44) + 64 NEUTZ=1 +C--------PUT IN "THING" IF NEEDED + 66 IF(SHUTUP.NE.0.) GO TO 67 + IF(THINGX.NE.QUADX .OR. THINGY.NE.QUADY) GO TO 67 + CALL DROPIN(IHQUEST,IX,IY) + THINGX=0 + THINGY=0 + IF(DAMAGE(1) .GT. 0) GO TO 67 + CALL SKIP(1) + CALL PROUT( + + 43HMR. SPOCK: "CAPTAIN, THIS IS MOST UNUSUAL.,43) + CALL PROUT( + + 43H PLEASE EXAMINE YOUR SHORT-RANGE SCAN.",43) +C--------DROP IN A FEW BLACK HOLES + 67 DO 68 I=1,3 +C68 IF(RANF(0) .GT. 0.89) CALL DROPIN('@',IX,IY) + 68 IF(RANF(0) .GT. 0.89) CALL DROPIN(IHAT,IX,IY) +C----------IF THOLIAN HERE, TAKE THE X OUT OF EACH CORNER. + IF(ITHERE.EQ.0) RETURN + IF(QUAD(1,1).EQ.1HX) QUAD(1,1)=IHDOT + IF(QUAD(1,10).EQ.1HX)QUAD(1,10)=IHDOT + IF(QUAD(10,10).EQ.1HX)QUAD(10,10)=IHDOT + IF(QUAD(10,1).EQ.1HX) QUAD(10,1)=IHDOT + RETURN +C--------COPE IF QUADRANT CONTAINS ONLY A SUPERNOVA + 70 DO 75 I=1,10 + DO 75 J=1,10 + 75 QUAD(I,J)=IHDOT + RETURN + END + +END +DELETE F7:TRNOVA +EDIT +BUILD F7:TRNOVA + SUBROUTINE NOVA(IX,IY) +C +C 5-DEC-79 +C DON'T CHARGE PLAYER FOR A PLANET NOVAED BY AN ENEMY +C + INCLUDE F7:TREKCOM +C LOGICAL*1 IQUAD,IQUAD1,ISHIP + INTEGER IQUAD,IQUAD1,ISHIP + INTEGER BURST,HITS(10,2),BOT,TOP,TOP2 + DIMENSION COURSE(9) + EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT),(SHIP,ISHIP) + DATA COURSE/ 10.5, 12.0, 1.5, 9.0, 0.0, 3.0, 7.5, 6.0, 4.5 / +C--------CHECK FOR SUPERNOVA POSSIBILITY + IF(RANF(0) .GE. 0.05) GO TO 76 + CALL SNOVA(IX,IY) + RETURN +C--------PRINT NOVA MESSAGE FOR INITIAL STAR AT LOCATION (IX,IY) + 76 QUAD(IX,IY)=IHDOT + CALL CRMSENA(IHSTAR,2,IX,IY) + CALL CRAMDMP(7H NOVAS.,7) + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-1 +C-------IF ENTERPRISE DESTROYS STAR, TAKE OFF POINTS + IF(IPHWHO.NE.1) STARKL=STARKL+1 +C--------SET UP STACK TO RECURSIVELY TRIGGER ADJACENT STARS + BOT=1 + TOP=1 + TOP2=1 + KOUNT=0 + ICX=0 + ICY=0 + HITS(BOT,1)=IX + HITS(BOT,2)=IY + 78 DO 90 MM=BOT,TOP + DO 90 NN=1,3 + DO 90 J=1,3 + IF((J*NN) .EQ. 4)GO TO 90 + II=HITS(MM,1)+NN-2 + JJ=HITS(MM,2)+J-2 + IF(II .LT. 1 .OR. II .GT. 10)GO TO 90 + IF(JJ .LT. 1 .OR. JJ .GT. 10)GO TO 90 + IQUAD=QUAD(II,JJ) +C IF(IQUAD.EQ.IHDOT .OR. IQUAD.EQ.IHQUEST .OR. IQUAD.EQ.'@') + IF(IQUAD.EQ.IHDOT .OR. IQUAD.EQ.IHQUEST .OR. IQUAD.EQ.IHAT) + + GO TO 90 + IF(IQUAD.EQ.IHNUM) GO TO 90 + IF(IQUAD.EQ.IHT) GO TO 90 + IF(IQUAD .NE. IHSTAR) GO TO 80 +C--------ANOTHER STAR AFFECTED BY A NOVA + IF(RANF(0.) .GE. .05)GO TO 79 + CALL SNOVA(II,JJ) + RETURN + 79 TOP2=TOP2+1 + HITS(TOP2,1)=II + HITS(TOP2,2)=JJ + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-1 + IF(IPHWHO.NE.1) STARKL=STARKL+1 + CALL CRMSENA(IHSTAR,2,II,JJ) + CALL CRAM(7H NOVAS.,7) + GO TO 8905 + 80 IF(IQUAD .NE. IHP) GO TO 8002 +C--------PLANET DESTROYED BY NOVA. + NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY) -1 + IF(IPHWHO.NE.1)NPLANKL=NPLANKL+1 + CALL CRMSENA(IHP,2,II,JJ) + CALL CRAM(11H DESTROYED.,11) + DO 8001 I=1,5 + 8001 PLNETS(IPLANET,I)=0 + IPLANET=0 + PLNETX=0 + PLNETY=0 + IF(LANDED .NE. 1) GO TO 8905 + CALL FINISH + GO TO 95 + 8002 IF(IQUAD .NE. IHB) GO TO 82 +C----------NOVA DESTROYS STARBASE + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10 + DO 81 LLL=1,REMBASE + IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 81 + BASEQX(LLL)=BASEQX(REMBASE) + BASEQY(LLL)=BASEQY(REMBASE) + 81 CONTINUE + REMBASE=REMBASE-1 + BASEX=0 + BASEY=0 + IF(IPHWHO.NE.1) BASEKL=BASEKL+1 + CALL NEWCOND + CALL CRMSENA(IHB,2,II,JJ) + CALL CRAM(12H DESTROYED. ,12) + GO TO 8905 + 82 HIT=800.0 + 800.0*RANF(0) + IF(IQUAD .NE.ISHIP) GO TO 87 +C----------STARSHIP IN A NOVA + CALL PROUT(29H***STARSHIP BUFFETED BY NOVA.,29) + KSHOT=0 + CALL ZAP +C-------CHECK IF STARSHIP SURVIVED NOVA + IF(ENERGY .GT. 0)GO TO 86 + CALL FINISH(7) + RETURN +C--------ADD IN COURSE NOVA CONTRIBUTES TO KICKING STARSHIP + 86 ICX=ICX+SECTX-HITS(MM,1) + ICY=ICY+SECTY-HITS(MM,2) + KOUNT=KOUNT+1 + GO TO 90 +C--------ENEMY DESTROYED OR DAMAGED ; BUFFETED BY NOVA. + 87 IF(IQUAD .EQ. IHK) GO TO 88 + DO 8701 LL=1,NENHERE + IF(KX(LL).EQ.II .AND. KY(LL).EQ.JJ) GO TO 8702 + 8701 CONTINUE + 8702 KPOWER(LL)=KPOWER(LL)-HIT + IF(KPOWER(LL) .LE. 0) GO TO 88 + NEWCX=II+II-HITS(MM,1) + NEWCY=JJ+JJ-HITS(MM,2) + CALL CRMSENA(IQUAD,2,II,JJ) + CALL CRAM(8H DAMAGED,8) + IF(NEWCX.LT.1 .OR. NEWCX.GT.10 .OR. + + NEWCY.LT.1 .OR. NEWCY.GT.10) GO TO 8703 + IQUAD1=QUAD(NEWCX,NEWCY) +C IF(IQUAD1 .NE. '@') GO TO 87025 + IF(IQUAD1 .NE. IHAT) GO TO 87025 +C--------ENEMY DISPLACED INTO BLACK HOLE + CALL CRAMDMP(26H, BLASTED INTO BLACK HOLE.,26) + CALL DEADKL(II,JJ,IQUAD,NEWCX,NEWCY) + GO TO 90 +87025 IF(IQUAD1 .NE. IHDOT) GO TO 8703 + CALL CRAM(13H, BUFFETED TO,13) + CALL CRAMLOC(2,NEWCX,NEWCY) + QUAD(II,JJ)=IHDOT + QUAD(NEWCX,NEWCY)=IQUAD + KX(LL)=NEWCX + KY(LL)=NEWCY + KDIST(LL)=SQRT(FLOAT((SECTX-NEWCX)**2+(SECTY-NEWCY)**2)) + 8703 CALL CREND + GO TO 90 +C--------ENEMY DESTROYED BY NOVA. + 88 CALL DEADKL(II,JJ,IQUAD,II,JJ) + GO TO 90 + 8905 CALL CREND + QUAD(II,JJ)=IHDOT + 90 CONTINUE +C--------IF MORE STARS AFFECTED BY NOVA GO FIND WHAT THEY GOT + IF(TOP .EQ. TOP2)GO TO 93 + BOT=TOP+1 + TOP=TOP2 + GO TO 78 + 93 IF(KOUNT .EQ. 0)RETURN +C--------STARSHIP AFFECTED BY NOVA - KICK IT AWAY. + DIST=KOUNT*.1 + IF(ICX .NE. 0) ICX=ISIGN(1,ICX) + IF(ICY .NE. 0) ICY=ISIGN(1,ICY) + INDEX=3*(ICX+1)+ICY+2 + DIREC=COURSE(INDEX) + IF(DIREC .EQ. 0) DIST=0 + IF(DIST .EQ. 0)RETURN + TIME=12.0*DIST + CALL SKIP(1) + CALL PROUT(34HFORCE OF NOVA DISPLACES STARSHIP. ,34) + CALL MOVE + 95 RETURN + END + +END +DELETE F7:TRPHASE +EDIT +BUILD F7:TRPHASE + SUBROUTINE PHASERS +C +C 4-APR-79 +C THIS MODULE HAS BEEN WORKED OVER TO MAKE IT HARDER TO FIRE THE +C PHASERS ACCIDENTALLY WHEN YOU REALLY WANTED TO DO SOMETHING +C ELSE. ALSO, THE BATTLE COMPUTER DAMAGE LOOPHOLE HAS BEEN +C CLOSED. +C 3-DEC-79 +C ALLOW PLAYER TO OBTAIN BATTLE COMPUTER DATA EVEN IF THE PHASERS +C ARE BROKEN (OR OTHERWISE UNUSABLE). +C + INCLUDE F7:TREKCOM +C LOGICAL*1 IENM + INTEGER IENM + REAL*8 AITEM +C BYTE ITM + LOGICAL CROP,NEIN +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + REAL*8 RESPMAN,RESPAUT + DATA RESPMAN,RESPAUT/6HMANUAL,8HAUTOMATI/ + EQUIVALENCE (FNUM,AITEM) +C EQUIVALENCE (ITM,AITEM) + REAL HITS(20) + DATA PHASFAC/2.0/ + IFAST=0 + NO=0 + IDIDIT=1 + IPOOP=1 + IF(DAMAGE(1)+DAMAGE(11) .GT. 0.0) IPOOP=0 + IDOIT=1 +C--------ENSURE PHASERS CAN BE FIRED + IF(CONDIT .NE.IHDOCKD )GO TO 5 + CALL PROUT( + + 44HPHASERS CAN'T BE FIRED THROUGH BASE SHIELDS.,44) + GO TO 19 + 5 IF(DAMAGE(3) .EQ. 0)GO TO 10 + CALL PROUT(23HPHASER CONTROL DAMAGED.,23) + GO TO 19 +C--------DO CHECKS FOR HI-SPEED SHIELD CONTROL + 10 IF(SHLDUP .EQ. 0)GO TO 20 + IF(DAMAGE(13) .EQ. 0.) GO TO 13 + CALL PROUT(34HHIGH-SPEED SHIELD CONTROL DAMAGED.,34) + GO TO 19 + 13 IF(ENERGY .GT. 200.) GO TO 16 + CALL PROUT(58HINSUFFICIENT ENERGY TO ACTIVATE HIGH-SPEED SHIELD CO + CNTROL. ,58) + 19 IDOIT=0 + IF(IPOOP.EQ.0.OR.NENHERE.EQ.0)GO TO 15 +C CALL PROUT ('PHASERS NOT USABLE; BATTLE COMPUTER DATA FOLLOWS:',49) + CALL PROUT (49HPHASERS NOT USABLE; BATTLE COMPUTER DATA FOLLOWS:, + C49) + GO TO 870 + 15 IDIDIT=0 + IF(IFAST.NE.0) ENERGY=ENERGY+200.0 + RETURN + 16 ENERGY=ENERGY-200. + IFAST = 1 +C--------READ IN AMOUNT OF ENERGY TO EXPEND ON PHASER FIRE + 20 CALL SCAN + POW=FNUM + IF(NENHERE .EQ. 0) GO TO 35 + K=1 + IF(KEY.EQ.IHALPHA) GOTO 23 + IF(KEY.EQ.IHREAL) GOTO 28 +C IF(.NOT.CROP(AITEM,2HNO)) GOTO 23 +C NO=1 +C CALL SCAN +C POW=FNUM + GO TO 24 +C23 IF(KEY .EQ. IHALPHA .AND.CROP(AITEM,6HMANUAL))GO TO 90 + 23 CROPITEM=AITEM + CROPMATCH=RESPMAN + IF(KEY .EQ. IHALPHA .AND.CROP())GO TO 90 + IF(DAMAGE(11).NE.0)GO TO 80 + IF(DAMAGE(1).NE.0) GO TO 81 +C------- IS KEY EOL,AUTO OR PHAS POWER? + IF(KEY .NE. IHALPHA)GO TO 2301 +C IF(CROP(AITEM,9HAUTOMATIC))GO TO 27 + CROPMATCH=RESPAUT + IF(CROP())GO TO 27 + GO TO 24 +C-------- DIFFERENTIATE BETWEEN EOL AND PHASER POWER(COMMAND MODE) + 2301 IF(KEY .NE. IHEOL)GO TO 30 +C------ REQUEST MANUAL OR AUTO + 24 CALL MANORA + CALL SCAN + IF(FNUM.EQ.-1.) GO TO 15 + IF(KEY .NE. IHALPHA) GO TO 24 +C IF(CROP(AITEM,6HMANUAL))GO TO 90 + CROPITEM=AITEM + CROPMATCH=RESPMAN + IF(CROP())GO TO 90 +C IF( .NOT.CROP(AITEM,9HAUTOMATIC))GO TO 24 + CROPMATCH=RESPAUT + IF( .NOT.CROP())GO TO 24 +C-------- INFORM USER OF AVAIL ENERGY AND READ IN DESIRED PHASER POWER + 2409 IF(NENHERE .EQ. 0) GO TO 26 + CALL CRAM(46HPHASERS LOCKED ON TARGET. ENERGY AVAILABLE = ,46) + 25 CALL CRAMF(ENERGY,0,2) + CALL CREND + IF (IPOOP.EQ.0) GO TO 26 + CALL CRAM(1H(,1) + IREC=0 + DO 29 K=1,NENHERE + 29 IREC=ABS(KPOWER(K))/(PHASFAC*0.9**KDIST(K))*(1.01+0.05*RANF(0))+1. + 1 +IREC + CALL CRAMI(IREC,0) + CALL CRAM(3H) ,3) + CALL CRAM(22HUNITS TO FIRE AT ENEMY,22) + CALL CREND + 26 CALL PROMPT(15HUNITS TO FIRE: ,15) + 27 CALL SCAN + POW=FNUM + 28 KEY1=KEY + IF(KEY .EQ. IHEOL) GO TO 2409 + 30 CALL SCAN +C*** READ IN ITM FIRST CHAR IN COMMON SCANBRF + KEY2=KEY + KEY=KEY1 + IF(KEY2 .EQ. IHEOL)GO TO 35 +C IF(ITM.NE.1HN) GOTO 34 + IF(.NOT.NEIN()) GOTO 34 + NO=1 + GO TO 35 + 34 CALL BEGPARD + GO TO 15 + 35 IF(KEY .NE. IHREAL) GO TO 26 + IF(POW .LT. ENERGY)GO TO 41 + CALL CRAM(18HENERGY AVAILABLE= ,18) + GO TO 25 + 41 IF(POW .GE. 5.0)GO TO 46 + IF (POW.LE.0) GO TO 15 + CALL PROUT (45HMINIMUM ENERGY FOR AUTOMATIC FIRE IS 5 UNITS.,45) + GO TO 15 +C--------PRINT MESSAGE FOR SHIELD CONTROL, AND DECIDE IF MALFUNCTION OCCURS. + 42 CALL SKIP(1) + IF(RANF(0.).LT.0.995) GO TO 45 +C--------SOMETHING BAD HAS HAPPENED. + CALL REDALRT + CALL SKIP(1) + CALL PROUT(36HSULU: "SHIELD CONTROL MALFUNCTION!" ,36) + CALL SKIP(1) + CALL PROUT(35HSAFETY INTERLOCK OVERRIDES PHASERS. ,35) + RETURN + 45 CALL PROUT(16HSHIELDS LOWERED. ,16) + GO TO IWHERE +C--------ALLOCATE ENERGY AMONG KLINGONS ACCORDING TO NEAREST FIRST +C STRATEGY AND COMPUTE HITS + 46 IF(IFAST .EQ. 0) GO TO 47 + ASSIGN 47 TO IWHERE + GO TO 42 + 47 ENERGY=ENERGY-POW + EXTRA=POW + IF(NENHERE.EQ. 0)GO TO 75 +C--------- LOOP THAT DISTRIBUTES HITS IN AUTO MODE IS HERE. + EXTRA=0.0 + POWREM=POW + DO 50 I=1,NENHERE + HITS(I)=0. + IF (POWREM .LE. 0.) GO TO 50 + HITS (I)=ABS(KPOWER(I))/(PHASFAC*0.90**KDIST(I)) + OVER=(.01+.05*RANF(0))*HITS(I) + TEMP=POWREM + POWREM=POWREM-HITS(I)-OVER + IF(POWREM .LE. 0.) HITS(I)=AMIN1(TEMP,HITS(I)) + IF(POWREM .LE. 0.) OVER=0. + EXTRA=EXTRA+OVER + 50 CONTINUE + IF(POWREM .GT. 0.) EXTRA=EXTRA+POWREM + CALL HITEM(HITS) + IF(EXTRA.EQ.0 .OR. ALLDONE.NE.0) GO TO 200 +C--------- INFORM OF OVERKILL. + 75 IF(ITHERE.EQ.0) GO TO 78 + CALL CRAM3AS + CALL CRAM(19HTHOLIAN WEB ABSORBS ,19) + IF(NENHERE.GT.0) CALL CRAM(7H EXCESS ,7) + CALL CRAMDMP(16H PHASER ENERGY. ,16) + GO TO 200 + 78 CALL CRAMF(EXTRA,0,2) + CALL CRAMDMP(25H EXPENDED ON EMPTY SPACE.,25) + GO TO 200 +C-------- MANUAL SECTION BEGINS HERE. +C-------- INFORM OF IMPOSED MANUAL CONDITION. + 80 CALL PROUT(42HBATTLE COMPUTER DAMAGED; MANUAL FIRE ONLY.,42) + GO TO 84 + 81 CALL SKIP(1) + CALL PROUT(13H---WORKING---,13) + CALL PROUT(27HSHORT-RANGE-SENSORS-DAMAGED,27) + CALL PROUT(43HINSUFFICIENT-DATA-FOR-AUTOMATIC-PHASER-FIRE,43) + CALL PROUT(24HMANUAL-FIRE-MUST-BE-USED,24) + CALL SKIP(1) + 84 CALL CRAM(18HENERGY AVAILABLE= ,18) + CALL CRAMF(ENERGY-0.006,0,2) + CALL CREND +C--------- LOOP FOR DESIRED INDIVIDUAL HITS. + 870 K=1 + 87 IF(IPOOP .EQ. 0) GO TO 88 +C--------PRINT BATTLE-COMPUTER RECOMMENDATION + CALL CRAM(1H(,1) + IREC=ABS(KPOWER(K))/(PHASFAC*0.9**KDIST(K))*(1.01+0.05*RANF(0))+1. + CALL CRAMI(IREC,0) + CALL CRAM(3H) ,3) + 88 CALL CRAM(17HUNITS TO FIRE AT ,17) + II=KX(K) + JJ=KY(K) + IENM=QUAD(II,JJ) +C CALL CRAMENA(IENM,2,II,JJ) + CALL CRAMENA(IENM) + IF(IDOIT.EQ.1)GO TO 89 +C--------PHASERS CAN'T ACTUALLY BE FIRED - LOOP BACK FOR NEXT COMPUTER +C--------READOUT, OR TERMINATE IF THAT'S ALL + CALL CREND + K=K+1 + IF(K.LE.NENHERE)GO TO 87 + GO TO 15 + 89 CALL CRAM(3H: ,3) + CALL CRENDNO + 90 IF(K .EQ. 1)POW=0 + CALL SCAN + HITS(K)=FNUM + IF(KEY .EQ. IHREAL)GO TO 95 + IF (KEY.NE.IHEOL) GO TO 91 + IF(K .EQ. 1) GO TO 84 + GO TO 87 +C-------- BEG PARDON UNLESS KEY IS PHASER POWER, END-OF-LINE, OR 'NO'. +C91 IF (ITM.NE.1HN) GO TO 34 + 91 IF(.NOT.NEIN()) GOTO 34 + NO=1 + GO TO 90 +C-------- IF HIT LESS THAN ZERO, ABORT PHASERS. + 95 IF(HITS(K) .LT. 0)GO TO 15 + POW=POW+HITS(K) +C-------- IF TOTAL AMOUNT OF POWER REQUESTED IS TOO MUCH, INFORM +C-------- AND START OVER. + IF(POW .LT. ENERGY)GO TO 97 + CALL PROUT(26HAVAILABLE ENERGY EXCEEDED.,26) + GO TO 84 + 97 K=K+1 + IF(K .LE. NENHERE) GO TO 90 +C--------IF TOTAL REQUESTED IS ZERO, ABORT PHASERS + IF(POW .EQ. 0.0) GO TO 15 + CALL SCAN + IF(KEY .NE. IHALPHA) GO TO 9701 +C IF(ITM.EQ.1HN) NO=1 + IF(NEIN()) NO=1 + 9701 ENERGY=ENERGY-POW + IF(IFAST .EQ. 0) GO TO 98 + ASSIGN 98 TO IWHERE + GO TO 42 +C-------- GO DELIVER THE HITS. + 98 CALL HITEM(HITS) + IDIDIT=1 +C--------SAY SHIELDS RAISED OR MALFUNCTION, IF NECESSARY. + 200 IF(ALLDONE.NE.0) RETURN + IF(IFAST .EQ. 0) GO TO 210 + CALL SKIP(1) + IF(NO.NE.0) GO TO 202 + IF(RANF(0) .LT. 0.99) GO TO 205 + CALL PROUT(66HSULU: "SIR, THE HIGH-SPEED SHIELD CONTROL HAS MALFU + CNCTIONED . . .,66) + CALL PROUT( + +51H CLICK CLICK POP . . . NO RESPONSE, SIR!" ,51) + 202 SHLDUP =0 + GO TO 210 + 205 CALL PROUT(15HSHIELDS RAISED.,15) +C--------CHECK FOR PHASER OVERHEAT + 210 IF(POW .LE. 1500.) RETURN + CHEKBRN=(POW-1500.)*.00038 + IF(RANF(0.) .GT. CHEKBRN) RETURN +C--------DO YOU SMELL SMOKE? + CALL SKIP(1) + CALL PROUT(48HWEAPONS OFFICER SULU: "PHASERS OVERHEATED, SIR." + 1 ,48) + DAMAGE(3) = DAMFAC*(1.0 + RANF(0))*(1.+CHEKBRN) + RETURN + END + +END +DELETE F7:TRPHOTO +EDIT +BUILD F7:TRPHOTO + SUBROUTINE PHOTONS +C +C 13-JUN-79 +C CORRECT 'THOLIAN DISAPPEARS' MESSAGE +C DON'T CHARGE PLAYER FOR A PLANET DESTROYED BY AN ENEMY +C + INCLUDE F7:TREKCOM +C LOGICAL*1 IQUAD,ISHIP + INTEGER IQUAD,ISHIP + REAL*8 AITEM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + EQUIVALENCE (FNUM,AITEM),(SHIP,ISHIP) + DIMENSION TARG(3,2), COURSE(3) + REAL KP + INTEGER BOT,TOP,TOP2 + EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT) + EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) + DATA IHDOC/'DO'/ +C--------CHECK TORPEDO COUNT AND STATUS OF PHOTON TUBES + IDIDIT=1 + KSHOT=0 + IF(DAMAGE(4) .EQ. 0)GO TO 10 + CALL PROUT(21HPHOTON TUBES DAMAGED.,21) + GO TO 3005 + 10 IF(TORPS .NE.0)GO TO 15 + CALL PROUT(18HNO TORPEDOES LEFT.,18) + GO TO 3005 +C--------SCAN AND MAKE SENSE OF COMMAND INPUT LINE + 15 CALL SCAN + TEMP=FNUM + N = TEMP + 0.5 + IF(KEY .EQ. IHREAL) GO TO 30 + 16 CALL CRAMI(TORPS,0) + CALL CRAMDMP(16H TORPEDOES LEFT.,16) + CALL PROMPT(30HNUMBER OF TORPEDOES TO FIRE: ,30) + GO TO 15 + 30 IF(N .LE. 0) GO TO 3005 + IF(N .LE. 3) GO TO 31 + CALL PROUT(33HMAXIMUM OF 3 TORPEDOES PER BURST.,33) + GO TO 16 + 3004 CALL BEGPARD + 3005 IDIDIT=0 + RETURN + 31 IF(N .LE. TORPS) GO TO 32 + GO TO 16 +C--------ALL TORPEDOES FIRED AT SAME SPOT. + 3101 DO 3102 I=2,N + TARG(I,1)=TARG(1,1) + 3102 TARG(I,2)=TARG(1,2) + GO TO 36 +C--------READ IN TARGET SECTORS + 32 DO 33 I=1,N + CALL SCAN + TARG(I,1)=FNUM + IF((I.EQ.1) .AND. (KEY.EQ.IHEOL)) GO TO 34 + IF((I .EQ. 2) .AND. (KEY .EQ. IHEOL)) GO TO 3101 + IF (KEY .NE. IHREAL) GO TO 3004 + CALL SCAN + TARG(I,2)=FNUM + 33 IF (KEY .NE. IHREAL) GO TO 3004 + GO TO 36 + 34 DO 35 I=1,N + CALL CHEW + CALL CRAM (33HTARGET SECTOR FOR TORPEDO NUMBER ,33) + CALL CRAMI(I,0) + CALL CRAM(3H: ,3) + CALL CRENDNO + CALL SCAN + TARG(I,1)=FNUM + IF (KEY .NE. IHREAL) GO TO 3004 + CALL SCAN + TARG(I,2)=FNUM + 35 IF( KEY .NE. IHREAL) GO TO 3004 +C--------CHECK FOR INVALID TARGETS. + 36 DO 37 I=1,N + DO 37 J=1,2 + TEMP = TARG(I,J) + IF(TEMP.EQ.-1.) GO TO 3005 + 37 IF ((TEMP .LT. 0.999) .OR. (TEMP .GT. 10.001)) GO TO 3004 +C--------COMPUTE COURSE FOR EACH TORPEDO. + DO 40 I=1,N + DELTX = 0.1*(TARG(I,2)-SECTY) + DELTY=0.1*(SECTX-TARG(I,1)) +C--------DO NOT ALLOW ENTERPRISE TO SHOOT A TORPEDO AT ITSELF. + IF((DELTX .NE. 0) .OR. (DELTY .NE. 0)) GO TO 40 + CALL SKIP(1) + CALL PROUT(41HSPOCK: "BRIDGE TO SICKBAY. DR. MC COY, ,41) + CALL PROUT(36H I RECOMMEND AN IMMEDIATE REVIEW OF,36) + CALL PROUT(41H THE CAPTAIN'S PSYCHOLOGICAL PROFILE." ,41) + GO TO 3005 + 40 COURSE (I) = 1.90985932*ATAN2(DELTX,DELTY) +C--------BEGIN OUTER LOOP FOR MOVING TORPEDOES + I=0 + 50 I=I+1 + IF(I .GT. N) GO TO 115 + IF(CONDIT .NE. IHDOC ) TORPS=TORPS-1 + J=I + STARTX=SECTX + STARTY=SECTY + R=(RANF(0)+RANF(0))*0.5 -0.5 + IF(ABS(R) .LT. 0.49) GO TO 5709 + R=(RANF(0)+1.2)*R +C-------- TORPEDO MISFIRES + IF(N.GT.1) GO TO 5706 + CALL PROUT(21H***TORPEDO MISFIRES. ,21) + GO TO 5707 + 5706 CALL CRAM(18H***TORPEDO NUMBER ,18) + CALL CRAMI(I,0) + CALL CRAMDMP(10H MISFIRES.,10) + IF(I . LT. N) CALL PROUT(31H REMAINDER OF BURST ABORTED. ,31) + I=N + 5707 IF(RANF(0.) .GT. .200000)GO TO 5709 +C------- CHECK IF MISFIRE DOES SHIP DAMAGE. IF SO DON'T GIVE TRACK. + CALL PROUT(35H***PHOTON TUBES DAMAGED BY MISFIRE.,35) + DAMAGE(4)=DAMFAC*(1.0+2.0*RANF(0)) + GO TO 115 + 5709 IF(SHLDUP.NE.0 .OR. CONDIT.EQ.IHDOC ) R=R+0.001*SHLD*R + AC=COURSE(I)+0.25*R + GO TO 5710 +C* + ENTRY KPHOTON +C* +C----------- SET FLAG FOR KLINGON +C--------ENEMY FIRES PHOTON TORPEDO + IX=KX(KSHOT) + IY=KY(KSHOT) + I=1 + N=1 + STARTX=IX + STARTY=IY + DELTX=0.1*(SECTY-STARTY) + DELTY=0.1*(STARTX-SECTX) + AC=1.90985932*ATAN2(DELTX,DELTY) + TEMP=RANF(0)-0.5 + R=TEMP*(1.0+0.001*KPOWER(KSHOT))+RANF(0.)*TEMP + AC=AC+0.25*R + IQUAD=QUAD(IX,IY) + CALL CRMSENA(IQUAD,0,IX,IY) + CALL CRAMDMP(22H FIRES PHOTON TORPEDO. ,22) +C--------CHECK FOR KLINGON MISFIRE + IF(ABS(TEMP) .LT. 0.45) GO TO 5710 +C--------ENEMY TORPEDO MISFIRED. DETERMINE DAMAGE. + ANGLE=(15.0-AC)*0.5235988 + HIT=200.0 + 600.0*RANF(0) + LL=KSHOT + CALL PROUT(21H***TORPEDO MISFIRES! ,21) + GO TO 68 + 5710 ANGLE=(15.0-AC)*0.5235988 + IF(N .EQ. 1)GO TO 58 + CALL SKIP(1) + CALL CRAM(25HTRACK FOR TORPEDO NUMBER ,25) + CALL CRAMI(J,0) + 5720 CALL CRAM(6H: ,6) + GO TO 59 + 58 CALL SKIP(1) + CALL CRAM(15HTORPEDO TRACK: ,15) + 59 DELTAX=-SIN(ANGLE) + DELTAY=COS(ANGLE) + BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY)) + DELTAX=DELTAX/BIGGER + DELTAY=DELTAY/BIGGER + X=STARTX + Y=STARTY +C--------BEGIN INNER LOOP FOR MOVING A SINGLE TORPEDO + L=0 + 5910 L=L+1 + X=X+DELTAX + IX=X+0.5 + IF(IX .LT. 1 .OR. IX .GT. 10)GO TO 105 + Y=Y+DELTAY + IY=Y+0.5 + IF(IY .LT. 1 .OR. IY .GT. 10)GO TO 105 + IF(L .EQ. 4 .OR. L .EQ. 9)CALL CREND + CALL CRAMF(X,0,1) + CALL CRAM(3H - ,3) + CALL CRAMF(Y,0,1) + CALL CRAM(3H ,3) + IQUAD=QUAD(IX,IY) + IF(IQUAD.EQ.IHDOT) GOTO 5910 +C--------BEGIN HIT CHECKS + CALL CREND +C--------COMPUTE EXACT ANGLE TO SECTOR HIT, DISTANCE TO SECTOR HIT, +C NORMAL MISS DISTANCE, AND HIT + DIST=SQRT((STARTX-IX)**2 + (STARTY-IY)**2) + DELTX=0.1*(IY-STARTY) + DELTY=0.1*(STARTX-IX) + BULSEYE=1.90985932*ATAN2(DELTX,DELTY) + BULSEYE=(15.0-BULSEYE)*0.5235988 + SINANG=SIN(ANGLE-BULSEYE) + DISTN=ABS(SINANG) * DIST + HIT=700.0+100.0*RANF(0)-1000.0*DISTN +C--------TEST FOR AND COPE WITH HIT ON KLINGON,ROMULAN, OR COMMANDER. + IF(IQUAD .EQ. IHK .OR. IQUAD .EQ. IHR) GO TO 62 + IF(IQUAD .NE. IHC .AND. IQUAD .NE. IHS) GO TO 70 + IF(RANF(0) .GT. 0.05) GO TO 62 + CALL CRMSENA(IQUAD,2,IX,IY) + CALL CRAMDMP(25H USES ANTI-PHOTON DEVICE;,25) + CALL PROUT(23H TORPEDO NEUTRALIZED.,23) + GO TO 50 + 62 DO 65 LL=1,NENHERE + IF(IX.EQ.KX(LL) .AND. IY.EQ.KY(LL)) GO TO 68 + 65 CONTINUE + 68 KP=KPOWER(LL) + KPOWER(LL)=KP-SIGN(AMIN1(ABS(KP),HIT),KP) + IF(KPOWER(LL) .NE. 0.0) GO TO 69 + CALL DEADKL(IX,IY,IQUAD,IX,IY) + GO TO 50 + 69 CALL CRMSENA(IQUAD,2,IX,IY) +C--------IF ENEMY DAMAGED BUT NOT DESTROYED, TRY TO DISPLACE HIM + 6901 ANG=ANGLE + 2.5*(RANF(0)-0.5) + TEMP=AMAX1(ABS(-SIN(ANG)),ABS(COS(ANG))) + XX=-SIN(ANG) / TEMP + YY= COS(ANG) / TEMP + JX=IX+XX+0.5 + JY=IY+YY+0.5 + IF(JX.LT.1 .OR. JX.GT.10 .OR. JY.LT.1 .OR. JY.GT.10) GO TO 6905 +C IF(QUAD(JX,JY) .NE. '@') GO TO 6903 + IF(QUAD(JX,JY) .NE. IHAT) GO TO 6903 +C--------SOMEONE FALLS INTO A BLACK HOLE + CALL CRAMDMP(26H BUFFETED INTO BLACK HOLE.,26) + IF(IQUAD .NE.ISHIP) GO TO 6902 + CALL FINISH(21) + RETURN + 6902 CALL DEADKL(IX,IY,IQUAD,JX,JY) + GO TO 50 + 6903 IF(QUAD(JX,JY) .NE. IHDOT) GO TO 6905 + QUAD(JX,JY)=IQUAD + QUAD(IX,IY)=IHDOT + CALL CRAMDMP(10H DAMAGED--,10) + CALL CRAM(24H DISPLACED BY BLAST TO,24) + CALL CRAMLOC(2,JX,JY) + CALL CREND + IF(IQUAD .NE.ISHIP) GO TO 6904 +C------STARSHIP DISPLACED BY TORPEDO. MOVE IT AND RESET ENEMY DISTANCES + SECTX=JX + SECTY=JY + CALL RESETD + GO TO 50 +C--------ENEMY DISPLACED BY PHOTON BLAST + 6904 KX(LL)=JX + KY(LL)=JY + KDIST(LL)= SQRT(FLOAT((SECTX-JX)**2 + (SECTY-JY)**2)) + GO TO 50 + 6905 CALL CRAMDMP(27H DAMAGED BUT NOT DESTROYED.,27) + GO TO 50 +C--------TEST FOR AND COPE WITH HIT ON A STARBASE + 70 IF(IQUAD.NE.IHT) GO TO 7002 + CALL CRMSENA(IHT,2,IX,IY) + IF(HIT.LT.600) GO TO 7001 + CALL CRAMDMP(11H DESTROYED. ,11) + QUAD(IX,IY)=IHDOT + ITHERE=0 + ITHX=0 + ITHY=0 + GO TO 50 + 7001 X=RANF(0) + IF(X.GT.0.05) CALL CRAMDMP(23H SURVIVES PHOTON BLAST. ,23) + IF(X.GT.0.05) GO TO 50 + CALL CRAMDMP(12H DISAPPEARS. ,12) + QUAD(IX,IY)=IHNUM +C CALL DROPIN('@',DUM,MY) + CALL DROPIN(IHAT,DUM,MY) + ITHERE=0 + GO TO 50 + 7002 IF(IQUAD.NE.IHNUM) GOTO 7005 + CALL PROUT(35H***TORPEDO ABSORBED BY THOLIAN WEB. ,35) + GOTO 50 + 7005 IF(IQUAD.NE.IHB) GO TO 75 + CALL CRMSENA(IHB,2,IX,IY) + IF(HIT .LT. 600.0) GO TO 7510 + CALL CRAM(12H DESTROYED ,12) + IF(IPHWHO.NE.1) CALL CRAM(21H.... CONGRATULATIONS ,21) + CALL CREND + IF(STARCH(QUADX,QUADY) .LT. 0) STARCH(QUADX,QUADY)=0 + DO 71 LLL=1,REMBASE + IF(BASEQX(LLL).NE.QUADX .OR. BASEQY(LLL).NE.QUADY) GO TO 71 + BASEQX(LLL)=BASEQX(REMBASE) + BASEQY(LLL)=BASEQY(REMBASE) + 71 CONTINUE + QUAD(IX,IY)=IHDOT + REMBASE=REMBASE-1 + BASEX=0 + BASEY=0 + GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-10 + IF(IPHWHO.NE.1) BASEKL=BASEKL+1 + CALL NEWCOND + GO TO 50 +C--------TEST FOR AND COPE WITH A HIT ON A PLANET. + 75 IF(IQUAD .NE. IHP) GO TO 80 + CALL CRMSENA(IHP,2,IX,IY) + IF(HIT .GT. 450.0) GO TO 7520 + 7510 CALL CRAMDMP(23H SURVIVES PHOTON BLAST.,23) + GO TO 50 + 7520 CALL CRAMDMP(11H DESTROYED. ,11) + IF(IPHWHO.NE.1)NPLANKL=NPLANKL+1 + NEWSTUF(QUADX,QUADY)=NEWSTUF(QUADX,QUADY)-1 + DO 76 II=1,5 + 76 PLNETS(IPLANET,II)=0 + IPLANET=0 + PLNETX=0 + PLNETY=0 + QUAD(IX,IY)=IHDOT + IF(LANDED .NE. 1) GO TO 50 +C--------CAPTAIN PERISHES ON PLANET. + CALL FINISH(15) + RETURN + 80 IF(IQUAD .NE. IHSTAR) GO TO 90 +C--------STAR HIT - CHECK FOR NOVA RESULTS + IF(HIT.GT.270.0) GO TO 85 + CALL CRMSENA(IHSTAR,2,IX,IY) + CALL CRAMDMP(28H UNAFFECTED BY PHOTON BLAST.,28) + GO TO 50 + 85 CALL NOVA(IX,IY) + IF(GALAXY(QUADX,QUADY) .EQ. 1000) RETURN + IF(ALLDONE.NE.0) RETURN + GO TO 50 +C--------CHECK FOR A BOOMERANG TORPEDO + 90 IF(IQUAD .NE.ISHIP) GO TO 93 + IF(CONDIT.NE.IHDOC) GO TO 9010 + IF(RANF(0).GT.0.77) GO TO 9010 + CALL CRAM(27H STAR BASE SHIELDS PROTECT ,27) + CALL CRAMSHP + CALL CREND + GO TO 50 + 9010 CALL CRAM3AS + CALL CRAMSHP + CALL CRAMDMP(27H BLASTED BY PHOTON TORPEDO! ,27) + CALL NEWCOND + CALL ZAP + IF(ENERGY .GT. 0.0) GO TO 91 + IF(KSHOT.NE.0) GO TO 9020 + CALL FINISH(22) + RETURN + 9020 CALL FINISH(5) + RETURN + 91 CALL CASULTY +C--------CHECK TO SEE IF SHIP DISPLACED + CALL CRAMSHP + GO TO 6901 +C--------CHECK FOR HIT ON THING. + 93 IF(IQUAD .NE. IHQUEST) GO TO 95 + CALL SKIP(1) + CALL PROUT( + + 55H"AAAAIIIIIEEEEEEEEEAAAAAAAAUUUUUGGGGGHHHHHHHHHHHHHHH!!!,55) + CALL PROUT( + + 48H HACK! HACK! HACK! *CHOKE!* ",48) + CALL SKIP(1) + CALL PROUT(26HMR. SPOCK: "FASCINATING!",26) + QUAD(IX,IY)=IHDOT + GO TO 50 +C--------TORPEDO ENTERS VICINITY OF BLACK HOLE. CHECK FOR DEFLECTION +C95 CALL CRMSENA('@',2,IX,IY) + 95 CALL CRMSENA(IHAT,2,IX,IY) + IF(DISTN .LT. 0.1) GO TO 97 +C--------BOING. COMPUTE DEFLECTION ANGLE, AND NEW STARTING POINT + SPRANG=(0.5-DISTN) * 7.853981634 + BETA=1.57079633 + ANGLE - SPRANG + STARTX = IX-DISTN*SIN(BETA) + STARTY = IY+DISTN*COS(BETA) + ANGLE = ANGLE - SIGN(SPRANG,SINANG) + CALL CRAMDMP(18H DEFLECTS TORPEDO. ,18) + CALL CRAM(9HNEW TRACK,9) + GO TO 5720 + 97 CALL CRAMDMP(18H SWALLOWS TORPEDO.,18) + GO TO 50 +C--------END INNER LOOP FOR MOVING ONE TORPEDO + 105 CALL CREND + 106 CALL PROUT(15HTORPEDO MISSED.,15) + GO TO 50 + 115 IF(REMKL .EQ. 0) CALL FINISH(1) + IF(KSHOT .EQ. 0) CALL SORTKL + RETURN + END + +END +DELETE F7:TRPLANE +EDIT +BUILD F7:TRPLANE + SUBROUTINE PLANET +C +C 4-APR-79 +C FIX MESSAGE ABOUT SHUTTLE CRAFT'S CULINARY MISSION. +C 28-NOV-79 +C ALLOW STARBASE SR SCANNERS TO BE USED FOR SENSOR SCAN. +C* +C* SUBROUTINE PLANETS CONTAINS ENTRY POINTS FOR : +C* +C* ORBIT,BEAM,MINE,CRYSTAL,SENSOR,GALILEO,DEATHRA +C* + INCLUDE F7:TREKCOM + LOGICAL JA + CALL SKIP(1) + IKNOW=0 + DO 101 I=1,INPLAN + 101 IKNOW=IKNOW+PLNETS(I,5) + IF(IKNOW.NE.0)GO TO 102 +C CALL PROUT('SPOCK: "WE HAVE NO INFORMATION ON ANY PLANET, +C 1 CAPTAIN."',56) + CALL PROUT( + + 'SPOCK: "WE HAVE NO INFORMATION ON ANY PLANET, CAPTAIN.', + + 56) + RETURN + 102 CALL PROUT('SPOCK: "PLANET REPORT FOLLOWS, CAPTAIN."',41) + CALL SKIP(1) + DO 1 I=1,INPLAN + IF(PLNETS(I,5) .EQ. 0) GO TO 1 + IX=PLNETS(I,1) + IY=PLNETS(I,2) + ICLASS=PLNETS(I,3) + IDIL=PLNETS(I,4) + CALL CRAMLOC(1,IX,IY) + CALL CRAM(9H CLASS ,9) + CALL CRAMEN(ICLASS) + CALL CRAM(3H ,3) + IF(IDIL .EQ. 0) CALL CRAM (3HNO ) + CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT. ,28) + 1 CONTINUE + RETURN +C* + ENTRY ORBIT +C* + CALL SKIP(1) + IDIDIT=0 + IF(INORBIT .EQ. 0) GO TO 2 + CALL PROUT(26HALREADY IN STANDARD ORBIT. ,26) + RETURN +C--------CHECK FOR ENGINE DAMAGE. + 2 IF((DAMAGE(7) .EQ. 0.) .OR. (DAMAGE(6) .EQ. 0.)) GO TO 3 + CALL PROUT(38HBOTH WARP AND IMPULSE ENGINES DAMAGED. ,38) + RETURN +C--------CHECK TO SEE IF SHIP ADJACENT TO PLANET. + 3 IF(PLNETX .EQ. 0) GO TO 5 + IF(IABS(SECTX-PLNETX) .LE. 1 .AND. IABS(SECTY-PLNETY) .LE. 1) + C GO TO 10 + 5 CALL CRAMSHP + CALL CRAMDMP(24H NOT ADJACENT TO PLANET. ,24) + RETURN + 10 TIME = .02+.03*RANF(0) + IF(DAMAGE(6) .GT. 0.) TIME=TIME*10. +C--------GO AHEAD, SULU. + CALL PROUT(47HHELMSMAN SULU: "ENTERING STANDARD ORBIT, SIR." + 1 ,47) + CALL NEWCOND + ASSIGN 17 TO IWHERE + 16 IDIDIT=1 + CALL EVENTS + IF(ALLDONE.EQ.1 .OR. GALAXY(QUADX,QUADY).EQ.1000 .OR. JUSTIN.EQ.1) + + RETURN + GO TO IWHERE + 17 CALL CRAM(11H ALTITUDE ,11) + HEIGHT=1400.+7200.*RANF(0) + CALL CRAMF(HEIGHT,0,2) + CALL CRAMDMP(13H KILOMETERS.",13) + INORBIT=1 + RETURN +C* + ENTRY BEAM +C* + CALL SKIP(1) + IF(DAMAGE(12) .EQ. 0) GO TO 19 + CALL PROUT(21HTRANSPORTER DAMAGED. ,21) + IF(DAMAGE(10) .NE. 0) RETURN + CALL SKIP(1) + CALL PROUT(47HSPOCK: "MAY I SUGGEST THE SHUTTLE CRAFT, SIR." + 1 ,47) + RETURN + 19 IF(INORBIT.NE.0) GO TO 1910 + 1901 CALL CRAMSHP + CALL CRAMDMP(23H NOT IN STANDARD ORBIT. ,23) + RETURN + 1910 IF(SHLDUP .EQ. 0) GO TO 1920 + CALL PROUT(41HIMPOSSIBLE TO TRANSPORT THROUGH SHIELDS. ,41) + RETURN + 1920 IF(PLNETS(IPLANET,5) .EQ. 1) GO TO 1940 + 1930 CALL PROUT(56HSPOCK: "CAPTAIN, WE HAVE NO INFORMATION ON THIS PLA + CNET, ,56) + CALL PROUT(64H AND STARFLEET REGULATIONS CLEARLY STATE THAT IN TH + CIS SITUATION ,64) + CALL PROUT(23H YOU MAY NOT GO DOWN." ,23) + RETURN + 1940 IF(LANDED .EQ. 1) GO TO 30 + IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 20 + CALL PROUT(44HSPOCK: CAPTAIN, I FAIL TO SEE THE LOGIC IN ,44) + CALL PROUT( + +51H EXPLORING A PLANET WITH NO DILITHIUM CRYSTALS. ,51) + ASSIGN 20 TO IWHERE + 1950 CALL PROMPT(30H ARE YOU SURE THIS IS WISE? ,30) +C IF(JA(DUMMY)) GO TO IWHERE + IF(JA(1)) GO TO IWHERE + RETURN + 20 CALL PROUT(41HSCOTTY: "TRANSPORTER ROOM READY, SIR." ,41) + CALL SKIP(1) + CALL PROUT(63HKIRK, AND LANDING PARTY PREPARE TO BEAM DOWN TO PLAN + CET SURFACE. ,63) + CALL SKIP(1) + CALL PROUT(18HKIRK: "ENERGIZE." ,18) + 21 CALL SKIP(1) + CALL PROUT(41HWWHOOOIIIIIRRRRREEEE.E.E. . . . . . . ,41) + IF(RANF(0) .GT. 0.98) GO TO 35 + CALL PROUT(41H. . . . . . .E.E.EEEERRRRRIIIIIOOOHWW ,41) + CALL SKIP(1) + CALL PROUT(19HTRANSPORT COMPLETE. ,19) + LANDED = LANDED *(-1) + IF((LANDED .NE. 1) .AND. (IMINE .EQ. 1)) ICRYSTL = 1 + IMINE=0 + RETURN +C--------READY TO BEAM UP TO SHIP. + 30 IF(ISCRAFT .EQ. 1) GO TO 32 + CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET. ,42) + RETURN + 32 CALL PROUT(42HLANDING PARTY ASSEMBLED, READY TO BEAM UP. ,42) + CALL SKIP(1) + CALL PROUT(31HKIRK WHIPS OUT COMMUNICATOR... ,31) + CALL PROUT(17HBEEP BEEP BEEP ,17) + CALL SKIP(1) + CALL PROUT(54H"KIRK TO ENTERPRISE: LOCK ON COORDINATES...ENERGIZE + C." ,54) + GO TO 21 +C--------CATASTROPHE! + 35 CALL SKIP(1) + CALL PROUT(31HBOOOIIIOOOIIOOOOIIIOIING . . . ,31) + CALL SKIP(1) + CALL PROUT(38HSCOTTY: "OH MY GOD! I'VE LOST THEM." ,38) + CALL FINISH(13) + RETURN +C* + ENTRY MINE +C* + IDIDIT=0 + CALL SKIP(1) + IF(LANDED .EQ. 1) GO TO 50 + CALL PROUT(27HMINING PARTY NOT ON PLANET. ,27) + RETURN + 50 IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 51 + CALL PROUT(37HNO DILITHIUM CRYSTALS ON THIS PLANET. ,37) + RETURN + 51 TIME =(0.1+0.2*RANF(0)) * PLNETS(IPLANET,3) + ASSIGN 52 TO IWHERE + GO TO 16 + 52 CALL PROUT(26HMINING OPERATION COMPLETE. ,26) + IMINE=1 + RETURN +C* + ENTRY CRYSTAL +C* + CALL SKIP(1) + IF(ICRYSTL .EQ. 1) GO TO 55 + CALL PROUT(32HNO DILITHIUM CRYSTALS AVAILABLE. ,32) + RETURN + 55 IF(ENERGY .LT. 1000.) GO TO 5510 + CALL PROUT(66HSPOCK: "CAPTAIN, STARFLEET REGULATIONS PROHIBIT SUC + CH AN OPERATION ,66) + CALL PROUT(41H EXCEPT WHEN CONDITION YELLOW EXISTS." ,41) + RETURN + 5510 CALL PROUT(46HSPOCK: "CAPTAIN, I MUST WARN YOU THAT LOADING + 1 ,46) + CALL PROUT(46H RAW DILITHIUM CRYSTALS INTO THE SHIP'S POWER + 1 ,46) + CALL PROUT(37H SYSTEM MAY RISK A SEVERE EXPLOSION. ,37) + ASSIGN 56 TO IWHERE + GO TO 1950 + 56 CALL SKIP(1) + CALL PROUT(45HENGINEERING OFFICER SCOTT: "(GULP) AYE SIR." ,45) + CALL PROUT(32H "MR. SPOCK AND I WILL TRY IT." ,32) + CRYPROB=CRYPROB*2.0 + CALL SKIP(1) + CALL PROUT(32HSPOCK: "CRYSTAL IN PLACE, SIR." ,32) + CALL PROUT(31H "READY TO ACTIVATE CIRCUIT." ,31) + CALL SKIP(1) + CALL PROUT(42HSCOTTY: "KEEP YOUR FINGERS CROSSED, SIR!" ,42) + CALL SKIP(1) + IF(RANF(0) .GT. CRYPROB) GO TO 57 + CALL PROUT(41H "ACTIVATING NOW! - - NO GOOD! IT'S*** ,41) + 5610 CALL PROUT(54H***RED ALERT! RED A*L****************************** + +**,54) + CALL STARS + CALL PROUT(54H***************** KA-BOOM!!{!}{!} **************** + C** ,54) + CALL KABOOM + RETURN + 57 ENERGY = ENERGY +5000.*(1.+0.9*RANF(0)) + CALL PROUT(38H "ACTIVATING NOW% - - THE INSTRUMENTS ,38) + CALL PROUT(36H ARE GOING CRAZY, BUT I THINK IT'S ,36) + CALL PROUT(41H GOING TO WORK! CONGRATULATIONS, SIR!" ,41) + RETURN +C* + ENTRY SENSOR +C* + CALL SKIP(1) + IF(DAMAGE(1) .EQ. 0 .OR. CONDIT .EQ. IHDOCKD) GOTO 60 + CALL PROUT(28HSHORT RANGE SENSORS DAMAGED. ,28) + RETURN + 60 IF(PLNETX .NE. 0) GO TO 65 + CALL PROUT(27HNO PLANET IN THIS QUADRANT. ,27) + RETURN + 65 CALL CRAM(24HSPOCK: "SENSOR SCAN FOR ,24) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CRAMDMP(1H:,1) + CALL SKIP(1) + CALL CRAM(18H PLANET AT,18) + CALL CRAMLOC(2,PLNETX,PLNETY) + CALL CRAM(13H IS OF CLASS ,13) + ICLASS=PLNETS(IPLANET,3) + IDIL=PLNETS(IPLANET,4) + CALL CRAMEN(ICLASS) + CALL CRAMDMP(1H.,1) + CALL CRAM(27H READINGS INDICATE ,27) + IF(IDIL .EQ. 0) CALL CRAM(3HNO ,3) + CALL CRAMDMP(28HDILITHIUM CRYSTALS PRESENT." ,28) + PLNETS(IPLANET,5) = 1 + RETURN +C* + ENTRY GALILEO +C* + CALL SKIP(1) + IDIDIT = 0 + IF(DAMAGE(10) .EQ. 0) GO TO 72 + IF(DAMAGE(10) .GT. 0.) GO TO 71 + IF(DAMAGE(10) .EQ. -1.) GO TO 70 + CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,36) + RETURN + 70 CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT. ,38) + RETURN + 71 CALL PROUT(22HSHUTTLE CRAFT DAMAGED. ,22) + RETURN + 72 IF(INORBIT .EQ. 1) GO TO 75 + GO TO 1901 + 75 IF(SHLDUP .EQ. 0 .AND. CONDIT .NE. IHDOCKD) GO TO 80 + CALL PROUT(42HSHUTTLE CRAFT CANNOT PASS THROUGH SHIELDS.,42) + RETURN + 80 IF(PLNETS(IPLANET,5) .NE. 1) GO TO 1930 + TIME=3.0E-5*HEIGHT + IF(LANDED .NE. 1) GO TO 100 + IF(ISCRAFT .NE. 1) GO TO 98 +C--------SHUTTLE CRAFT TO THE RESCUE. + IF(DAMAGE(12) .NE. 0) GO TO 95 + CALL PROMPT(47HSPOCK: WOULD YOU RATHER USE THE TRANSPORTER? ,47) +C IF(JA(DUMMY)) RETURN + IF(JA(1)) RETURN + 95 IF(DAMAGE(12) .EQ. 0) CALL CRAM(13HSHUTTLE CREW ,13) + IF(DAMAGE(12) .NE. 0) CALL CRAM(13HRESCUE PARTY ,13) + CALL CRAMDMP(50HBOARDS "GALILEO" AND SWOOPS TOWARD PLANET SURFACE. + C ,50) + ISCRAFT=0 + ASSIGN 97 TO IWHERE + 96 CALL SKIP(1) + GO TO 16 + 97 CALL PROUT(14HTRIP COMPLETE.,14) + RETURN +C--------LANDING PARTY BOARDS GALILEO FOR TRIP BACK TO SHIP. + 98 CALL PROUT(35HYOU AND YOUR MINING PARTY BOARD THE ,35) + CALL PROUT( + +51HSHUTTLE CRAFT FOR THE TRIP BACK TO THE ENTERPRISE. ,51) + CALL SKIP(1) + CALL PROUT(26HTHE SHORT HOP BEGINS . . . ,26) + ICRAFT=1 + LANDED=-1 + ASSIGN 99 TO IWHERE + GO TO 96 + 99 ICRAFT=0 + ISCRAFT=1 + IF(IMINE.NE.0) ICRYSTL=1 + IMINE=0 + GO TO 97 +C--------LANDING PARTY HEADS DOWN TO PLANET. + 100 CALL PROUT(36HMINING PARTY ASSEMBLES IN THE HANGAR ,36) + CALL PROUT( + +51HDECK, READY TO BOARD THE SHUTTLE CRAFT "GALILEO." ,51) + CALL SKIP(1) + CALL PROUT(41HTHE HANGAR DOORS OPEN; THE TRIP BEGINS. ,41) + ICRAFT=1 + ISCRAFT=0 + ASSIGN 110 TO IWHERE + GO TO 96 + 110 LANDED=1 + ICRAFT=0 + GO TO 97 +C* + ENTRY DEATHRA +C* + IDIDIT=0 + CALL SKIP(1) + IF(SHIP .EQ. IHE) GO TO 113 + CALL PROUT(34HYE FAERIE QUEENE HAS NO DEATH RAY.,34) + RETURN + 113 IF(NENHERE .GE. 1) GO TO 115 + CALL PROUT(56HSULU: "BUT SIR, THERE ARE NO ENEMIES IN THIS QUADRA + +NT.",56) + RETURN + 115 IF(DAMAGE(14).LE.0) GOTO 116 + CALL PROUT(17HDEATHRAY DAMAGED.,17) + RETURN + 116 IDIDIT=1 + CALL PROUT(44HKIRK: "PREPARE FOR ACTIVATION OF DEATHRAY!",44) + CALL SKIP(1) + CALL PROUT(37HSPOCK: "PREPARATIONS COMPLETE, SIR.",37) + CALL PROUT(16HKIRK: "ENGAGE!",16) + CALL SKIP(1) + CALL PROUT(45HWHIRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR,45) + R=RANF(0) + IF(R .GT. 0.30) GO TO 130 +C--------BANG! + CALL PROUT(32HSULU: "CAPTAIN! IT'S WORKING!",32) + CALL REDALRT + CALL PROUT(41H***MATTER-ANTIMATTER IMPLOSION IMMINENT! ,41) + GO TO 5610 +C--------SUCCESS! + 130 CALL PROUT(32HSULU: "CAPTAIN! IT'S WORKING!",32) + CALL SKIP(1) + NENHER2=NENHERE + DO 135 I=1,NENHER2 + II=KX(1) + JJ=KY(1) + 135 CALL DEADKL(II,JJ,QUAD(II,JJ),II,JJ) + CALL SKIP(1) + CALL PROUT(42HENSIGN CHEKOV: "CONGRATULATIONS CAPTAIN!",42) + IF(REMKL .EQ. 0) CALL FINISH(1) + IF(REMKL .EQ. 0) RETURN + CALL SKIP(1) + CALL PROUT( + +56HSPOCK: "CAPTAIN, I BELIEVE THE "EXPERIMENTAL DEATH RAY",56) + IF(RANF(0).GT..05) GOTO 140 + CALL PROUT(22HIS STILL OPERATIONAL.",22) + RETURN + 140 CALL PROUT(33HHAS BEEN RENDERED DISFUNCTIONAL.",33) + DAMAGE(14)=39.95 + RETURN + END + +END +DELETE F7:TRPLAQU +EDIT +BUILD F7:TRPLAQU + SUBROUTINE PLAQUE +C +C 30-MAY-79 +C OUTPUT DATE WITH LOWER-CASE CHARACTERS +C 31-MAY-79 +C DON'T RE-OPEN OUTPUT IF LUN=2 ON ENTRY +C + INCLUDE F7:TREKCOM + COMMON/PLAQ/ISCORE,PERDATE,ISKILL + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK +C LOGICAL*1 NAME(30) + CHARACTER NAME(30) +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/PRLUN/LUN +C LUNSAV=LUN +C LUN=1 + 11 CALL PROMPT('ENTER NAME (UP TO 30 CHARACTERS): ',34) +C LUN=LUNSAV +C READ(1,20,ERR=11,END=11) ICHAR,NAME +C20 FORMAT(Q,30A1) + DO 20 I=1,30 + NAME(I)=BLANK + 20 CONTINUE + READ(102,21,ERR=11,END=11) NAME + 21 FORMAT (30A1) + NAMELEN=30 + DO 22 I=1,30 + IF(NAME(NAMELEN).NE.BLANK) GO TO 23 + NAMELEN=NAMELEN-1 + 22 CONTINUE +C NSKIP=65-ICHAR/2 + 23 NSKIP=65-NAMELEN/2 +C IF(LUN.EQ.2)GO TO 25 +C LUN=2 +C CALL CLOSE(2) +C CALL ASSIGN(2,'LP:') + LUN=108 +C25 WRITE(2,30) + WRITE(108,30) + 30 FORMAT('1') + CALL SKIP(4) +C--------DRAW ENTERPRISE PICTURE. +C +C CALL PROUT(114H +C + EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE, +C +114) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(25H EEEEEEEEEEE,25) + CALL CRAM(25HEEEEEEEEEEEEEEEEEEEEEEEEE,25) + CALL CRAM(14HEEEEEEEEEEEEEE,14) + CALL CREND +C +C +C CALL PROUT(114H EEE +C + E : : : E, +C +114) +C + CALL CRAM(25H ,25) + CALL CRAM(25H EEE ,25) + CALL CRAM(25H E : : ,25) + CALL CRAM(25H ,25) + CALL CRAM(14H : E,14) + CALL CREND +C +C +C CALL PROUT(114H EE EEE +C + E : : NCC-1701 : E, +C +114) +C + CALL CRAM(25H ,25) + CALL CRAM(25H EE EEE ,25) + CALL CRAM(25H E : : ,25) + CALL CRAM(25H NCC-1701 ,25) + CALL CRAM(14H : E,14) + CALL CREND +C +C +C CALL PROUT(114H EEEEEEEEEEEEEEEE EEEEEE +C +EEEEEEEEE E : : : E, +C +114) +C + CALL CRAM(25H EEEEE,25) + CALL CRAM(25HEEEEEEEEEEE EEEEEE,25) + CALL CRAM(25HEEEEEEEEE E : : ,25) + CALL CRAM(25H ,25) + CALL CRAM(13H : E,13) + CALL CREND +C +C +C CALL PROUT(112H E +C + E EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE +C 1 ,112) +C + CALL CRAM(25H E ,25) + CALL CRAM(25H ,25) + CALL CRAM(25H E EEEEEEEEEEE,25) + CALL CRAM(25HEEEEEEEEEEEEEEEEEEEEEEEEE,25) + CALL CRAM(12HEEEEEEEEEEEE,12,12) + CALL CREND +C +C +C CALL PROUT(81H EEEEEEEEE EEEE +C +EEEEEEEEE E E ,81) +C + CALL CRAM(25H EEE,25) + CALL CRAM(25HEEEEEE EEEE,25) + CALL CRAM(31HEEEEEEEEE E E ,31) + CALL CREND +C +C +C CALL PROUT(81H EEEEEEE EEEEE +C +E E E E ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H EEEEEEE EEEEE ,25) + CALL CRAM(31HE E E E ,31) + CALL CREND +C +C +C CALL PROUT(81H EEE +C + E E E E ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H EEE ,25) + CALL CRAM(31H E E E E ,31) + CALL CREND +C +C +C CALL PROUT(81H +C + E E E E ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(31H E E E E ,31) + CALL CREND +C +C +C CALL PROUT(81H +C + EEEEEEEEEEEEE E E ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(31H EEEEEEEEEEEEE E E ,31) + CALL CREND +C +C +C CALL PROUT(87H +C + EEE : EEEEEEE EEEEEEEE,87) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(37H EEE : EEEEEEE EEEEEEEE,37) + CALL CREND +C +C +C CALL PROUT(88H +C + :E : EEEE E,88) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(38H :E : EEEE E,38) + CALL CREND +C +C +C CALL PROUT(88H +C + .-E -:----- E,88) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(38H .-E -:----- E,38) + CALL CREND +C +C +C CALL PROUT(88H +C + :E : E,88) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(38H :E : E,38) + CALL CREND +C +C +C CALL PROUT(87H +C + EE : EEEEEEEE,87) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(37H EE : EEEEEEEE,37) + CALL CREND +C +C +C CALL PROUT(81H +C + EEEEEEEEEEEEEEEEEEEEEEE ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(31H EEEEEEEEEEEEEEEEEEEEEEE ,31) + CALL CREND +C +C + CALL SKIP(3) +C +C +C CALL PROUT(74H +C + U. S. S. ENTERPRISE,74) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(24H U. S. S. ENTERPRISE,24) + CALL CREND +C +C + 5 CALL SKIP(1) + CALL SKIP(3) +C +C +C CALL PROUT(93H For demonstrating +C +outstanding ability as a starship captain,93) +C + CALL CRAM(25H ,25) + CALL CRAM(27H For demonstrating ,27) + CALL CRAM(41Houtstanding ability as a starship captain,41) + CALL CREND +C +C + CALL SKIP(1) +C +C +C CALL PROUT(81H Star +C +fleet Command bestows to you ,81) +C + CALL CRAM(25H ,25) + CALL CRAM(25H St,25) + CALL CRAM(31Harfleet Command bestows to you ,31) + CALL CREND +C +C + CALL SKIP(1) + DO 8 I=1,NSKIP + 8 CALL CRAM(1H ,1) +C CALL CRAMS(NAME,ICHAR) + CALL CRAMS(NAME,NAMELEN,NAMELEN) + CALL CREND + CALL SKIP(1) +C +C +C CALL PROUT(71H +C + the rank of ,71) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(21H the rank of ,21) + CALL CREND +C +C + CALL SKIP(1) +C +C +C CALL PROUT(75H +C + "Commodore Emeritus",75) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(25H "Commodore Emeritus",25) + CALL CREND +C +C + CALL SKIP(1) + CALL CRAM(58H + + ,58) + IF(ISKILL .EQ. 4) CALL CRAM(8H Expert ,8) + IF(ISKILL .EQ. 5) CALL CRAM(9HEmeritus ,9) + CALL CRAMDMP(5Hlevel,5) + CALL SKIP(1) +C +C +C CALL CRAM(66H +C 1 This day of ,66) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(16H This day of ,16) +C +C CALL FOR$DATE(NAME) +C NAME(5)=NAME(5)+32 +C NAME(6)=NAME(6)+32 +C CALL CRAMS(NAME,9) + CALL CRAMS(14H 1 April 2016 ,14,14) + CALL CREND + CALL SKIP(1) +C +C +C CALL CRAM(69H +C 1 Your score: ,69) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(19H Your score: ,19) +C + CALL CRAMI(ISCORE,0) + CALL CREND + CALL SKIP(1) +C +C +C CALL CRAM(76H +C 1Klingons per stardate: ,76) +C + CALL CRAM(25H ,25) + CALL CRAM(25H ,25) + CALL CRAM(26H Klingons per stardate: ,26) +C +C + CALL CRAMF(PERDATE,0,2) + CALL CREND + LUN=101 + RETURN + END + +END +DELETE F7:TRPRELI +EDIT +BUILD F7:TRPRELI + SUBROUTINE PRELIM +C +C 5-APR-79 +C UPDATE THE GREETING MESSAGE. +C +C--------PRINT A BUNCH OF GARBAGE WHEN GAME IS FIRST ENTERED +C CALL ASSIGN(1,'TT:') + CALL PROUT(28H** U.T. "SUPER" STAR TREK **,28) +C CALL PROUT(25HADAPTED FOR VAX/VMS BY MK,25) + CALL SKIP(1) + CALL PROUT(65HBACK-PORTED TO CP-V F77 ON GEORGE PLUE'S "SIGGY" SIG + CMA-7 EMULATOR,65) + CALL PROUT(15HJWF 20 FEB 2016,15) + CALL SKIP(1) +C CALL PROUT(26HLIST THE FILE STARTREK.DOC,26) + CALL PROUT(24HLIST THE FILE TX:STARTRK,24) + CALL PROUT(25HFOR PLAYING INSTRUCTIONS.,25) + CALL SKIP(1) +C CALL PROUT( +C 1 44HFOR LATEST ON UPDATES, TYPE "TRKNEWS" AS ,44) +C CALL PROUT( +C $52HYOUR GAME. FOR PLAYING INSTRUCTIONS ENTER "TRKINST" ,52) + RETURN + END + +END +DELETE F7:TRPROUT +EDIT +BUILD F7:TRPROUT + SUBROUTINE PROUT(LINE,KOUNT) + COMMON/PRLUN/LUN +C BYTE LINE(120) + CHARACTER LINE(120) +C DATA LUN/1/ + CALL CHEW + IF (LUN.EQ.101) + +WRITE (101,100,ERR=900) (LINE(I),I=1,KOUNT) + IF (LUN.EQ.108) + +WRITE (108,100,ERR=900) (LINE(I),I=1,KOUNT) + 100 FORMAT (1X120A1) + RETURN + ENTRY PROMPT(LINE,KOUNT) + CALL CHEW + WRITE (101,101,ERR=900) (LINE(I),I=1,KOUNT) + 101 FORMAT ('$',120A1) + 900 CONTINUE + RETURN + END +C + SUBROUTINE OUTSAFE(LINE,KOUNT) + COMMON/PRLUN/LUN +C BYTE LINE(120) + CHARACTER LINE(120) +C DATA LUN/1/ + IF (LUN.EQ.101) + +WRITE (101,100,ERR=900) (LINE(I),I=1,KOUNT) + IF (LUN.EQ.108) + +WRITE (108,100,ERR=900) (LINE(I),I=1,KOUNT) + 100 FORMAT (1X120A1) + 900 CONTINUE + RETURN + END + +END +DELETE F7:TRRAM +EDIT +BUILD F7:TRRAM + SUBROUTINE RAM(IBUMPD,IENM,IX,IY) + INCLUDE F7:TREKCOM +C LOGICAL*1 IENM + INTEGER IENM + CALL REDALRT + CALL PROUT(22H***COLLISION IMMINENT.,22) + CALL SKIP(2) + CALL CRAM3AS + CALL CRAMSHP + TYPE=1.0 + IF(IENM .EQ. IHT) TYPE=0.5 + IF(IENM .EQ. IHR) TYPE=1.5 + IF(IENM .EQ. IHC) TYPE=2.0 + IF(IENM .EQ. IHS) TYPE=2.5 + IF(IBUMPD .EQ. 0) CALL CRAM(6H RAMS ,6) + IF(IBUMPD .EQ. 1) CALL CRAM(11H RAMMED BY ,11) +C CALL CRAMENA(IENM,2,IX,IY) + CALL CRAMENA(IENM) + CALL CREND + CALL DEADKL(IX,IY,IENM,SECTX,SECTY) + CALL CRAM3AS + CALL CRAMSHP + CALL CRAMDMP(17H HEAVILY DAMAGED.,17) + ICAS=10.0+20.0*RANF(0) + CALL CRAM(19H***SICKBAY REPORTS ,19) + CALL CRAMI(ICAS,0) + CALL CRAMDMP(12H CASUALTIES.,12) + CASUAL=CASUAL+ICAS + DO 10 L=1,NDEVICE + IF(DAMAGE(L) .LT. 0) GO TO 10 + IF(L.EQ.14) GOTO 10 + EXTRADM=(10.0*TYPE*RANF(0)+1.0)*DAMFAC + DAMAGE(L)=DAMAGE(L)+TIME+EXTRADM + 10 CONTINUE + ISUBDAM=1 + SHLDUP=0 + IF(REMKL.NE.0) CALL DREPORT + IF(REMKL .EQ. 0) CALL FINISH(1) + RETURN + END + +END +DELETE F7:TRSCAN +EDIT +BUILD F7:TRSCAN + SUBROUTINE SCAN +C +C 5-APR-79 +C ACCEPT LOWER CASE ALPHA INPUT AND CONVERT TO UPPER CASE. +C CALL GETOUT WHEN A CTRL/Z IS TYPED TO ERASE THE SCREEN +C AND EXIT. +C + INCLUDE F7:TREKCOM +C REAL*8 AITEM,TITEM + CHARACTER AITEM(8) +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/SCANKHAR/KHAR + COMMON/CHARCOMN/NULL,BLANK + CHARACTER KHAR,NULL,BLANK + COMMON/PASS/PFLAG + LOGICAL PFLAG + DATA BLANK/1H / +C EQUIVALENCE (FNUM,AITEM) + REAL*8 FNUM +C BYTE LINE(80),KHAR,ITEM(8) + CHARACTER LINE(80),ITEM(8) + LOGICAL HALPHA + LOGICAL FIRSTIME + DATA FIRSTIME/.TRUE./ +C EQUIVALENCE (TITEM,ITEM) +C DATA ICH,ITEM/80,0,0,0,0,0,0,0,0/ + DATA ICH/80/ + IF(.NOT. FIRSTIME) GO TO 4 + NULL=CHAR(0) + DO 2 I=1,8 + ITEM(I)=NULL + 2 CONTINUE + FIRSTIME=.FALSE. +C--------READ IN NEW LINE IF NEEDED. + 4 IF(ICH.LT.80) GO TO 5 +C +C READ (1,100,ERR=700,END=900) JCHAR,LINE +C100 FORMAT (Q,80A1) +C + DO 80 I=1,80 + LINE(I)=BLANK + 80 CONTINUE + READ (102,100,ERR=700,END=900) LINE + 100 FORMAT (80A1) + JCHAR=80 + DO 90 I=1,80 + IF(LINE(JCHAR).NE.BLANK) GO TO 95 + JCHAR=JCHAR-1 + 90 CONTINUE +C + 95 LINE(JCHAR+1)=NULL +C5 AITEM=0 + 5 CALL STUFNUM(0) + FNUM=0 + ASSIGN 10 TO IRET + 10 IF(KHAR .EQ. BLANK) GO TO 500 +C--------IF END-OF LINE IS HIT, RETURN WITH AITEM=0. + IF(JCHAR.EQ.0) GOTO 15 + IF(KHAR.NE.NULL) GOTO 20 + 15 KEY=IHEOL + GO TO 600 +C--------IF INPUT IS NOT NUMERIC, PACK ALL CHARACTERS TOGETHER UP TO +C A BLANK OR END-OF-LINE, AND RETURN IN 10H FORMAT. +C20 IF(KHAR.EQ.1H+ .OR. KHAR.EQ.1H- .OR. KHAR.EQ.1H.) GO TO 40 +C IF(KHAR.GE.1H0 .AND. KHAR.LE.1H9) GO TO 40 +C IF(KHAR .LT. 1HA .OR. KHAR .GT. 1HZ) GO TO 500 + 20 KKAR=ICHAR(KHAR) + IF(PFLAG) GO TO 21 + IF(KKAR.EQ.78 .OR. KKAR.EQ.96 .OR. KKAR.EQ.75) GO TO 40 + IF(KKAR.GE.240 .AND. KKAR.LE.249) GO TO 40 + IF(.NOT.HALPHA(KKAR)) GO TO 500 + 21 KEY=IHALPHA + ASSIGN 25 TO IRET + ICHX=1 + GO TO 26 + 25 ICHX=ICHX+1 + IF(KHAR .EQ. NULL .OR. KHAR .EQ. BLANK) GOTO 30 + 26 IF(ICHX .LE. 8) ITEM(ICHX)=KHAR + GOTO 500 + 30 IF(ICHX.GT.8) GOTO 35 + DO 34 IT=ICHX,8 + 34 ITEM(IT)=BLANK +C35 AITEM=TITEM + 35 DO 36 I=1,8 + AITEM(I)=ITEM(I) + 36 CONTINUE + RETURN +C--------INPUT IS NUMERIC. RETURN AS A REAL NUMBER. + 40 KEY=IHREAL + SIGN=1.0 + KEXPON=0 + KFRACT=0 + ASSIGN 50 TO IRET +C IF(KHAR .EQ. 1H+) GO TO 500 + IF(KKAR .EQ. 78) GO TO 500 +C IF(KHAR .NE. 1H-) GO TO 50 + IF(KKAR .NE. 96) GO TO 50 + SIGN=-1.0 + GO TO 500 +C50 IF(KHAR.LT.1H0 .OR. KHAR.GT.1H9) GO TO 60 + 50 IF(KKAR.LT.240 .OR. KKAR.GT.249) GO TO 60 +C IT=KHAR +C FNUM=10.0*FNUM+FLOAT(IT-"60) + FNUM=10.0*FNUM+FLOAT(KKAR-240) +C KEXPON=KEXPON-KFRACT + IF(KFRACT .NE. 0) KEXPON=KEXPON-1 + GO TO 500 +C60 IF(KHAR .NE. 1H.) GO TO 70 + 60 IF(KKAR .NE. 75) GO TO 70 + IF(KFRACT .NE. 0) GO TO 15 + KFRACT=1 + GO TO 500 +C70 AITEM=SIGN*AITEM*10.0**KEXPON + 70 FNUM=SIGN*FNUM*10.0**KEXPON + CALL STUFNUM(FNUM) + RETURN +C--------ROUTINE TO RETURN NEXT CHARACTER IN 1H FORMAT +C--------LOWER CASE IS CONVERTED TO UPPER CASE + 500 ICH=ICH+1 + IF(ICH .LE. 80) GO TO 510 + ICH=1 + 510 KHAR=LINE(ICH) +C IF(KHAR .GE. "140) KHAR=KHAR-"40 + KKAR=ICHAR(KHAR) + IF( ((KKAR.GE.129 .AND. KKAR.LE.137) .OR. + + (KKAR.GE.145 .AND. KKAR.LE.153) .OR. + + (KKAR.GE.162 .AND. KKAR.LE.169) + + ) + + ) KKAR=KKAR+64 + KHAR=CHAR(KKAR) + GO TO IRET +C* + ENTRY CHEW +C--------DISCARD REMAINDER OF LAST LINE READ IN. + 600 ICH=80 + KHAR=BLANK + RETURN + 700 CALL PROUT(15HTTY READ ERROR.,15) + GO TO 4 + 900 CONTINUE + CALL GETOUT + RETURN + END +C + SUBROUTINE STUFNUM(NUMB) + COMMON/SCANBF1/AITEM + REAL*8 NUMB,AITEM + AITEM=NUMB + RETURN + END +C + LOGICAL FUNCTION NOMORE() + COMMON/SCANKHAR/KHAR + COMMON/CHARCOMN/NULL,BLANK + CHARACTER KHAR,NULL,BLANK + NOMORE=.TRUE. + IF(KHAR .EQ. BLANK) NOMORE=.FALSE. + RETURN + END +C + LOGICAL FUNCTION HALPHA(IKAR) + INTEGER IKAR + HALPHA=.FALSE. + IF( ((IKAR.GE.193 .AND. IKAR.LE.201) .OR. + + (IKAR.GE.209 .AND. IKAR.LE.217) .OR. + + (IKAR.GE.226 .AND. IKAR.LE.233) + + ) + + ) HALPHA=.TRUE. + RETURN + END + +END +DELETE F7:TRSCOM +EDIT +BUILD F7:TRSCOM + SUBROUTINE SCOM + INCLUDE F7:TREKCOM +C LOGICAL*1 LOC + INTEGER LOC + DIMENSION BDIST(5) + EQUIVALENCE (CRACKS(5),LOCSUP),(LOC,LOCSUP) +C--------COMPUTE DISTANCES TO STARBASES. + IF(REMBASE .LE. 0) GO TO 60 + BDMAX=0. + SX=ISX + SY=ISY + DO 1 I=1,REMBASE + BQX=BASEQX(I) + BQY=BASEQY(I) + 1 BDIST(I) = SQRT((BQX-SX)**2 +(BQY-SY)**2) +C--------SORT INTO NEAREST FIRST ORDER. + IF(REMBASE.LE.1) GO TO 4 + MINUS1 = REMBASE -1 + 2 ISWITCH = 0 + DO 3 I=1, MINUS1 + IF(BDIST(I) .LE. BDIST(I+1)) GO TO 3 + T=BDIST(I) + BDIST(I)=BDIST(I+1) + BDIST(I+1)=T + ISWITCH = 1 + 3 CONTINUE + IF(ISWITCH.NE.0) GO TO 2 +C--------LOOK FOR NEAREST BASE WITHOUT A COMMANDER, NO ENTERPRISE, AND +C--------WITHOUT TOO MANY KLINGONS, AND NOT ALREADY UNDER ATTACK. + 4 IFINDIT=0 + IWHICHB=0 + DO 8 I=1, REMBASE + IBQX=BASEQX(I) + IBQY=BASEQY(I) + IF((IBQX .EQ. QUADX) .AND. (IBQY .EQ. QUADY)) GO TO 8 + IF((IBQX .EQ. BATX) .AND. (IBQY .EQ. BATY)) GO TO 8 + NUM=GALAXY(IBQX,IBQY) + IF(NUM .GT. 899) GO TO 8 + IF(REMCOM .LE. 0) GO TO 6 + DO 5 J=1, REMCOM + 5 IF((IBQX .EQ. CX(J)) .AND. (IBQY .EQ. CY(J))) GO TO 7 + 6 IFINDIT=1 + IWHICHB=I + GO TO 10 + 7 IF (IFINDIT .EQ. 2) GO TO 8 + IFINDIT=2 + IWHICHB=I + 8 CONTINUE + IF(IFINDIT .EQ. 0) RETURN + IBQX=BASEQX(IWHICHB) + IBQY=BASEQY(IWHICHB) +C--------DECIDE HOW TO MOVE TOWARD BASE. + 10 IDELTX = IBQX -ISX + IF(IDELTX .GT. 1) IDELTX = 1 + IF(IDELTX .LT. -1) IDELTX=-1 + IDELTY=IBQY-ISY + IF(IDELTY .GT. 1) IDELTY = 1 + IF(IDELTY .LT. -1) IDELTY=-1 +C--------ATTEMPT FIRST TO MOVE IN BOTH X AND Y DIRECTION. + IQX=ISX+IDELTX + IQY=ISY+IDELTY + ASSIGN 23 TO IWHERE +C--------MAKE CHECKS ON POSSIBLE DESTINATION QUADRANT. + 15 IF((IQX .EQ. QUADX) .AND. (IQY .EQ. QUADY)) GO TO IWHERE + IF((IQX.LT.1).OR.(IQX.GT.8).OR.(IQY.LT.1).OR.(IQY.GT.8)) + + GO TO IWHERE + NUM = GALAXY(IQX,IQY) + IF(NUM. GT. 899) GO TO IWHERE +C--------GO AHEAD AND MOVE. + GALAXY(ISX,ISY) = GALAXY(ISX,ISY) -100 + ISX=IQX + ISY=IQY + GALAXY(ISX,ISY)=GALAXY(ISX,ISY)+100 + IF(ISCATE .EQ. 0) GO TO 40 +C--------S.C. HAS SCOOTED. REMOVE HIM FROM CURRENT QUADRANT. + ISCATE=0 + ISATB=0 + ISHERE=0 + IENTESC=0 + FUTURE(7)=1E38 + DO 21 I=1,NENHERE + LOCSUP=I + IX=KX(I) + IY=KY(I) + IF(QUAD(IX,IY) .EQ. IHS) GO TO 22 + 21 CONTINUE + 22 CALL LEAVE + QUAD(IX,IY)=IHDOT + CALL SORTKL + GO TO 40 +C--------TRY SOME OTHER MANEUVERS + 23 IF((IDELTX .EQ. 0) .OR. (IDELTY .EQ. 0)) GO TO 30 +C--------TRY MOVING JUST IN X DIRECTION. + IQY=ISY + ASSIGN 25 TO IWHERE + GO TO 15 +C--------THEN TRY MOVING JUST IN Y DIRECTION. + 25 IQY=ISY+IDELTY + IQX=ISX + ASSIGN 300 TO IWHERE + GO TO 15 +C--------ATTEMPT ANGLE MOVE. + 30 IF(IDELTX.NE.0) GO TO 35 + IQX=ISX+1 + ASSIGN 32 TO IWHERE + GO TO 15 + 32 IQX = ISX-1 + ASSIGN 300 TO IWHERE + GO TO 15 + 35 IQY = ISY+1 + ASSIGN 36 TO IWHERE + GO TO 15 + 36 IQY = ISY-1 + ASSIGN 300 TO IWHERE + GO TO 15 +C--------SUPER-COMMANDER HAS MOVED. CHECK SITUATION. +C--------CHECK FOR A HELPFUL PLANET. + 40 DO 44 I=1,INPLAN + IPLAN = I + IF((PLNETS(I,1) .NE. ISX) .OR.(PLNETS(I,2) .NE. ISY)) GO TO 44 + IF(PLNETS(I,4) .NE. 1) GO TO 45 +C--------DESTROY PLANET. + DO 43 J=1,5 + 43 PLNETS(IPLAN,J) = 0 + NEWSTUF(ISX,ISY) = NEWSTUF(ISX,ISY)-1 + IF(DAMAGE(9) .GT. 0) GO TO 45 + CALL SKIP(1) + CALL PROUT(47HLT. UHURA: "CAPTAIN, STARFLEET COMMAND REPORTS,47) + CALL CRAM(13H A PLANET IN,13) + CALL CRAMLOC(1,ISX,ISY) + CALL CRAMDMP(19H HAS BEEN DESTROYED,19) + CALL PROUT(26H BY THE SUPER-COMMANDER.",26) + GO TO 45 + 44 CONTINUE +C--------CHECK FOR A BASE. + 45 IF(REMBASE .EQ. 0) GO TO 60 + DO 46 I=1,REMBASE + IBQX=BASEQX(I) + IBQY=BASEQY(I) + 46 IF(IBQX.EQ.ISX .AND. IBQY.EQ.ISY .AND. ISX.NE.BATX .AND. ISY.NE. + + BATY) GO TO 80 +C--------CHECK FOR INTELLIGENCE REPORT. + IF(RANF(0) .GT. 0.2) RETURN + IF(DAMAGE(9).GT.0. .OR. STARCH(ISX,ISY).GT.0) RETURN + CALL SKIP(1) + CALL PROUT(52HLT. UHURA: "CAPTAIN, STARFLEET INTELLIGENCE REPORTS + +,52) + CALL CRAM(27H THE SUPER-COMMANDER IS IN,27) + CALL CRAMLOC(1,ISX,ISY) + CALL CRAMDMP(2H.",2) +C--------NOTHING ELSE TO DO. + RETURN +C--------NOTHING AVAILABLE. GO INTO HIBERNATION. + 60 FUTURE(6)=1E38 + RETURN +C--------ATTACK A BASE. + 80 ISATB=1 + FUTURE(7)=DATE+1.0+2.0*RANF(0) + IF(BATX.NE.0.0) FUTURE(7)=FUTURE(7)+FUTURE(5)-DATE + LOC=IHS + CALL SOS + 300 RETURN + END + +END +DELETE F7:TRSCORE +EDIT +BUILD F7:TRSCORE + SUBROUTINE SCORE +C +C 31-MAY-79 +C MAKE SCORE COME OUT UNCONDITIONALLY ON TERMINAL +C RETURN WITH LUN=2 IF SCORE WAS PRINTED ON LP +C + INCLUDE F7:TREKCOM +C LOGICAL*1 ISHIP + INTEGER ISHIP + LOGICAL JA + COMMON/PLAQ/ISCORE,PERDATE,ISKILL + COMMON/PRLUN/LUN + EQUIVALENCE (ISHIP,SHIP) + ISKILL=SKILL + TIMUSED=DATE-INDATE + IF(TIMUSED.EQ.0 .OR. REMKL.NE.0) TIMUSED=AMAX1(TIMUSED,5.0) + PERDATE=(KILLC+KILLK+NSCKILL)/TIMUSED + ITHPERD=500.0*PERDATE+0.5 + IWON=0 + IF(GAMEWON .NE. 0) IWON=100.0*SKILL + IF(ISHIP .EQ. IHE) KLSHIP=0 + IF(ISHIP .EQ. IHF) KLSHIP=1 + IF(ISHIP .EQ. 0) KLSHIP=2 + IDIED=0 + IF(ALIVE .EQ. 0) IDIED=200 + IF(GAMEWON .EQ. 0) NROMREM=0 + ISCORE = 10*KILLK + 50*KILLC + ITHPERD + IWON - IDIED + C -100*BASEKL -100*KLSHIP -45*NHELP -5*STARKL -CASUAL + C +20*NROMKL+200*NSCKILL-10*NPLANKL+NROMREM + 100 CALL SKIP(1) + CALL PROUT(12HYOUR SCORE--,12) + CALL SKIP(1) + IF(NROMKL .EQ. 0) GO TO 1 + CALL CRAMI(NROMKL,6) + CALL CRAM(35H ROMULANS DESTROYED ,35) + CALL CRAMI(20*NROMKL,10) + CALL CREND + 1 IF(NROMREM .EQ. 0) GO TO 5 + CALL CRAMI(NROMREM,6) + CALL CRAM(35H ROMULANS CAPTURED ,35) + CALL CRAMI(NROMREM,10) + CALL CREND + 5 IF(KILLK .EQ. 0) GO TO 10 + CALL CRAMI(KILLK,6) + CALL CRAM(35H ORDINARY KLINGONS DESTROYED ,35) + CALL CRAMI(10*KILLK,10) + CALL CREND + 10 IF(KILLC .EQ. 0) GO TO 12 + CALL CRAMI(KILLC,6) + CALL CRAM(35H KLINGON COMMANDERS DESTROYED ,35) + CALL CRAMI(50*KILLC,10) + CALL CREND + 12 IF(NSCKILL .EQ. 0) GO TO 15 + CALL CRAMI(NSCKILL,6) + CALL CRAM(35H SUPER-COMMANDER DESTROYED ,35) + CALL CRAMI(200,10) + CALL CREND + 15 IF(ITHPERD .EQ. 0) GO TO 20 + CALL CRAMF(PERDATE,6,2) + CALL CRAM(35H KLINGONS PER STARDATE, AVERAGE ,35) + CALL CRAMI(ITHPERD,10) + CALL CREND + 20 IF(STARKL .EQ. 0) GO TO 30 + CALL CRAMI(STARKL,6) + CALL CRAM(35H STARS DESTROYED BY YOUR ACTION ,35) + CALL CRAMI(-5*STARKL,10) + CALL CREND + 30 IF(NPLANKL.EQ.0) GO TO 32 + CALL CRAMI(NPLANKL,6) + CALL CRAM(35H PLANETS DESTROYED BY YOUR ACTION ,35) + CALL CRAMI(-10*NPLANKL,10) + CALL CREND + 32 IF(BASEKL .EQ. 0) GO TO 35 + CALL CRAMI(BASEKL,6) + CALL CRAM(35H BASES DESTROYED BY YOUR ACTION ,35) + CALL CRAMI(-100*BASEKL,10) + CALL CREND + 35 IF(NHELP .EQ. 0) GO TO 40 + CALL CRAMI(NHELP,6) + CALL CRAM(35H CALLS FOR HELP FROM STARBASE ,35) + CALL CRAMI( -45*NHELP,10) + CALL CREND + 40 IF(CASUAL .EQ. 0) GO TO 45 + CALL CRAMI(CASUAL,6) + CALL CRAM(35H CASUALTIES INCURRED ,35) + CALL CRAMI(-CASUAL,10) + CALL CREND + 45 IF(KLSHIP .EQ. 0) GOTO 50 + CALL CRAMI(KLSHIP,6) + CALL CRAM(35H SHIP(S) LOST OR DESTROYED ,35) + CALL CRAMI(-100*KLSHIP,10) + CALL CREND + 50 IF(ALIVE .NE. 0) GO TO 60 + CALL PROUT( + + 50HPENALTY FOR GETTING YOURSELF KILLED -200,50) + 60 IF(GAMEWON .EQ. 0) GO TO 70 + CALL CRAM(18HBONUS FOR WINNING ,18) + IF(SKILL .EQ. 1) CALL CRAM(13HNOVICE GAME ,13) + IF(SKILL .EQ. 2) CALL CRAM(13HFAIR GAME ,13) + IF(SKILL .EQ. 3) CALL CRAM(13HGOOD GAME ,13) + IF(SKILL .EQ. 4) CALL CRAM(13HEXPERT GAME ,13) + IF(SKILL .EQ. 5) CALL CRAM(13HEMERITUS GAME,13) + CALL CRAM(10H ,10) + CALL CRAMI(IWON,10) + CALL CREND +C70 CALL PROUT(0,1) + 70 CALL SKIP(1) + CALL CRAM(41HTOTAL SCORE ,41) + CALL CRAMI(ISCORE,10) + CALL CREND +C IF(LUN.EQ.2)RETURN + IF(LUN.EQ.108)RETURN + CALL SKIP(1) + CALL PROMPT + 1 ('DO YOU WANT A COPY OF YOUR SCORE ON THE LINE PRINTER? ',54) +C IF(JA(DUMMY).EQ.0)RETURN + IF(.NOT. JA(1))RETURN +C LUN=2 + LUN=108 +C CALL CLOSE(2) +C CALL ASSIGN(2,'LP:') + WRITE(108,99) + 99 FORMAT('1') + GO TO 100 + END + +END +DELETE F7:TRSETUP +EDIT +BUILD F7:TRSETUP + SUBROUTINE SETUP + INCLUDE F7:TREKCOM + INTEGER SHUTUP + EQUIVALENCE (CRACKS(2),SHUTUP) +C--------PREPARE THE ENTERPRISE + SHIP=IHE + INENRG=5000.0 + ENERGY=5000.0 + INSHLD=2500.0 + SHLD=2500.0 + SHLDUP=0 + SHLDCHG=0 + INLSR=4.0 + LSUPRES=4.0 + CALL IRAN8(QUADX,QUADY) + CALL IRAN10(SECTX,SECTY) + INTORPS=10 + TORPS=10 + WARPFAC=5.0 + WFACSQ=25.0 + DO 3 I=1,NDEVICE + 3 DAMAGE(I)=0.0 + ISUBDAM=0 +C--------SET UP ASSORTED GAME PARAMETERS +C SHUTUP=0.0 + SHUTUP=0 + BATX=0 + BATY=0 + IDATE=31.0*RANF(0)+20.0 + DATE=100*IDATE + INDATE=DATE + KILLK=0 + KILLC=0 + NKINKS=0 + NHELP=0 + RESTING=0 + CASUAL=0 + NROMKL=0 + ISATB=0 + ISCATE=0 + IMINE=0 + ICRYSTL=0 + ICRAFT=0 + NSCKILL=0 + NPLANKL=0 + ISCRAFT=1 + LANDED=-1 + CRYPROB=0.05 + ICSOS=0 + ISSOS=0 + ALIVE=1 + DOCKFAC=0.25 + DO 4 I=1,8 + DO 4 J=1,8 + NEWSTUF(I,J)=0 + 4 STARCH(I,J)=0 +C--------INITIALIZE TIMES FOR EXTRANEOUS EVENTS + FUTURE(1)=DATE+EXPRAN(0.5*INTIME) + FUTURE(2)=DATE+EXPRAN(1.5*INTIME/REMCOM) + FUTURE(3)=DATE+EXPRAN(0.5*INTIME) + FUTURE(4)=DATE+EXPRAN(0.3*INTIME) + FUTURE(5)=1E38 + FUTURE(6)=1E38 + IF(NSCREM.GT.0) FUTURE(6)=DATE+0.2777 + FUTURE(7)=1E38 +C--------PUT STARS IN THE GALAXY + INSTAR=0 + DO 5 I=1,8 + DO 5 J=1,8 + K = RANF(0) * 9 + 1 + INSTAR=INSTAR+K + 5 GALAXY(I,J)=K + STARKL=0 +C-------LOCATE STARBASES IN THE GALAXY (IMPROVED PLACEMENT) + DO 9 I=1,INBASE + 6 CALL IRAN8(IX,IY) + IF(GALAXY(IX,IY).GE.10) GOTO 6 + IF(I.EQ.1) GOTO 8 + LIM=I-1 + DO 7 J=1,LIM + DISTQ=(IX-BASEQX(J))**2 + (IY-BASEQY(J))**2 + IF(DISTQ .LT. 6*(6-INBASE) .AND. RANF(0.) .LT. 0.75) GOTO 6 + 7 CONTINUE + 8 BASEQX(I)=IX + BASEQY(I)=IY + STARCH(IX,IY)= -1 + 9 GALAXY(IX,IY)=GALAXY(IX,IY)+10 + BASEKL=0 +C--------POSITION ORDINARY KLINGON BATTLE CRUISERS + KREM=INKLING-INCOM-NSCREM + KLUMPER=0.25*SKILL*(9-LENGTH)+1.0 + KLUMPER=MIN0(9,KLUMPER) + 10 KLUMP=(1.0-RANF(0)**2)*KLUMPER + IF(KLUMP .GT. KREM) KLUMP=KREM + NUM=100*KLUMP + 15 CALL IRAN8(IX,IY) + IF(GALAXY(IX,IY)+NUM .GT. 999) GO TO 15 + GALAXY(IX,IY)=GALAXY(IX,IY)+NUM + KREM=KREM-KLUMP + IF(KREM .NE. 0) GO TO 10 +C--------POSITION KLINGON COMMAND SHIPS + DO 18 I=1,INCOM + 16 CALL IRAN8(IX,IY) + IF(GALAXY(IX,IY).LT.99 .AND. RANF(0).LT.0.75) GO TO 16 + IF(GALAXY(IX,IY) .GT. 899)GO TO 16 + IF(I .EQ. 1)GO TO 17 + IM1=I-1 + DO 1605 JJ=1,IM1 + IF(CX(JJ) .EQ. IX .AND. CY(JJ) .EQ. IY)GO TO 16 + 1605 CONTINUE + 17 GALAXY(IX,IY)=GALAXY(IX,IY)+100 + CX(I)=IX + 18 CY(I)=IY +C--------LOCATE PLANETS IN GALAXY + DO 20 I=1,INPLAN + 19 CALL IRAN8(IX,IY) + IF(NEWSTUF(IX,IY) .GT. 0) GO TO 19 + NEWSTUF(IX,IY)=1 + PLNETS(I,1)=IX + PLNETS(I,2)=IY +C--------DECIDE WHAT KIND OF PLANET M=1, N=2, O=3. + PLNETS(I,3)=RANF(0)*3. + 1. +C--------DECIDE WHETHER DILITHIUM CRYSTALS ARE PRESENT. + PLNETS(I,4)=1.2*RANF(0) + PLNETS(I,5)=0 + 20 CONTINUE +C--------LOCATE ROMULANS. + DO 21 I=1,NROMREM + CALL IRAN8(IX,IY) + 21 NEWSTUF(IX,IY)=NEWSTUF(IX,IY)+10 +C--------LOCATE THE SUPER-COMMANDER, IF NEEDED. + IF(NSCREM .LT. 1) GO TO 23 + 22 CALL IRAN8(IX,IY) + IF(GALAXY(IX,IY) .GT. 899) GO TO 22 + ISX=IX + ISY=IY + GALAXY(IX,IY)=GALAXY(IX,IY)+100 + 23 IDATE = DATE + CALL SKIP(1) + SNAP=0 +C--------DECIDE IF GALAXY NEEDS A "THING" + IF((RANF(0) .GT. 0.04) .OR. (THINGX .EQ. -1)) GO TO 2301 + CALL IRAN8(THINGX,THINGY) + GO TO 24 + 2301 THINGX=0 + THINGY=0 +C--------PRINT BRIEF INITIAL MESSAGE + 24 CALL CRAM('STARDATE',8) + CALL CRAMI(IDATE,5) + CALL CREND + CALL CRAMI(INKLING,5) + CALL CRAMDMP(9H KLINGONS,9) + CALL PROUT(31HAN UNKNOWN NUMBER OF ROMULANS ,31) + IF(NSCREM .EQ. 0) GO TO 25 + CALL PROUT(33HAND ONE (GULP) .,33) + 25 CALL CRAMI(IFIX(INTIME),5) + CALL CRAMDMP(10H STARDATES,10) + CALL CRAMI(INBASE,5) + CALL CRAM(24H STARBASES: QUADRANTS ,24) + DO 50 I=1,INBASE + CALL CRAMLOC(0,BASEQX(I),BASEQY(I)) + IF(I .LT. INBASE)CALL CRAM(2H, ,2) + 50 CONTINUE + CALL CREND + CALL SKIP(1) + CALL CRAM(30HTHE ENTERPRISE IS CURRENTLY IN,30) + CALL CRAMLOC(1,QUADX,QUADY) + CALL CRAM(1H,,1) + CALL CRAMLOC(2,SECTX,SECTY) + CALL CREND + CALL SKIP(1) + CALL CRAM(10HGOOD LUCK.,10) + IF(NSCREM.GT.0) CALL CRAM(17H YOU'LL NEED IT. ,17) + CALL CREND + CALL NEWQUAD + RETURN + END + +END +DELETE F7:TRSETWA +EDIT +BUILD F7:TRSETWA + SUBROUTINE SETWARP + INCLUDE F7:TREKCOM + REAL*8 AITEM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + EQUIVALENCE (FNUM,AITEM) + 10 CALL SCAN + IF(KEY .NE. IHEOL) GO TO 20 + CALL PROMPT(18H WARP FACTOR: ,18) + GO TO 10 + 20 IF(KEY .NE. IHREAL) GO TO 40 + IF(DAMAGE(6) .GT. 10.0) GO TO 70 + IF(DAMAGE(6) .GT. 0.0 .AND. FNUM .GT. 4.0) GO TO 80 + IF(FNUM .LT. 1.0) GO TO 50 + IF(FNUM .GT. 10.0) GO TO 60 + OLDFAC=WARPFAC + WARPFAC=FNUM + WFACSQ=WARPFAC*WARPFAC +C--------GIVE ACCEPTANCE MESSAGE FOR WARP FACTORS <= 6 OR REDUCED + IF(WARPFAC .LE. OLDFAC .OR. WARPFAC .LE. 6.0) GO TO 31 + IF(WARPFAC .LT. 8.00) GO TO 32 + GO TO 33 + 31 CALL CRAM(29HHELMSMAN SULU: "WARP FACTOR ,29) + CALL CRAMF(WARPFAC,0,1) + CALL CRAMDMP(11H, CAPTAIN.",11) + RETURN +C--------GIVE WARNING MESSAGES FOR WARP FACTORS ABOVE WARP 6 + 32 CALL PROUT( + + 61HENGINEER SCOTT: "AYE, BUT OUR MAXIMUM SAFE SPEED IS WARP 6." + + ,61) + RETURN + 33 IF(WARPFAC .EQ. 10.0) GO TO 36 + CALL PROUT( + + 65HENGINEER SCOTT: "AYE, CAPTAIN, BUT OUR ENGINES MAY NOT TAKE + + IT.",65) + RETURN + 36 CALL PROUT( + + 46HENGINEER SCOTT: "AYE, CAPTAIN, WE'LL TRY IT.",46) + RETURN +C--------GIVE REFUSAL MESSAGES FOR BAD WARP COMMANDS + 40 CALL BEGPARD + RETURN + 50 CALL PROUT( + + 52HHELMSMAN SULU: "WE CAN'T GO BELOW WARP 1, CAPTAIN.",52) + RETURN + 60 CALL PROUT( + + 52HHELMSMAN SULU: "OUR TOP SPEED IS WARP 10, CAPTAIN.",52) + RETURN + 70 CALL PROUT(25HWARP ENGINES INOPERATIVE.,25) + RETURN + 80 CALL PROUT(45HENGINEER SCOTT: "I'M DOING MY BEST, CAPTAIN,,45) + CALL PROUT(41H BUT RIGHT NOW WE CAN ONLY GO WARP 4." ,41) + RETURN + END + +END +DELETE F7:TRSHIEL +EDIT +BUILD F7:TRSHIEL + SUBROUTINE SHIELDS + INCLUDE F7:TREKCOM +C LOGICAL*1 ITEM + REAL*8 AITEM + LOGICAL CROP,JA +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + REAL*8 DIRTRA,DIRUP,DIRDN + DATA DIRTRA,DIRUP,DIRDN + + /8HTRANSFER,2HUP,4HDOWN/ +C EQUIVALENCE (FNUM,AITEM),(ITEM,AITEM) + EQUIVALENCE (FNUM,AITEM) + IDIDIT=0 + CALL SCAN + IF(KEY .NE. IHEOL) GO TO 30 + 15 CALL PROMPT(40HDO YOU WISH TO CHANGE SHIELD ENERGY? ,40) +C IF(JA(DUMMY)) GO TO 8010 + IF(JA(1)) GO TO 8010 + IF(DAMAGE(8).NE.0.0) GO TO 60 + IF(SHLDUP.NE.0) GO TO 20 +C* + ENTRY SHLDSUP +C* + CALL PROMPT(40HSHIELDS ARE DOWN. DO YOU WANT THEM UP? ,40) +C IF(JA(DUMMY)) GO TO 40 + IF(JA(1)) GO TO 40 + GO TO 90 + 20 CALL PROMPT(40HSHIELDS ARE UP. DO YOU WANT THEM DOWN? ,40) +C IF(JA(DUMMY)) GO TO 50 + IF(JA(1)) GO TO 50 + GO TO 90 +C30 IF(ITEM.EQ.1HT) GO TO 80 + 30 CROPITEM=AITEM + CROPMATCH=DIRTRA + IF(CROP()) GO TO 80 + IF(DAMAGE(8).NE.0.0) GO TO 60 +C IF(ITEM.EQ. 1HU) GO TO 40 + CROPMATCH=DIRUP + IF(CROP()) GO TO 40 +C IF(ITEM.EQ. 1HD) GO TO 50 + CROPMATCH=DIRDN + IF(CROP()) GO TO 50 + GO TO 15 +C--------RAISE SHIELDS + 40 IF(SHLDUP.NE.0) GO TO 45 + SHLDUP=1 + SHLDCHG=1 + IF(CONDIT .NE. IHDOCKD ) ENERGY=ENERGY-50.0 + CALL PROUT(15HSHIELDS RAISED.,15) + IF(ENERGY .LE. 0) GO TO 70 + IDIDIT=1 + RETURN + 45 CALL PROUT(21HSHIELDS ALREADY UP. ,21) + RETURN +C--------LOWER SHIELDS + 50 IF(SHLDUP .EQ. 0) GO TO 55 + SHLDUP=0 + SHLDCHG=1 + CALL PROUT(16HSHIELDS LOWERED.,16) + IDIDIT=1 + RETURN + 55 CALL PROUT(21HSHIELDS ALREADY DOWN.,21) + RETURN +C--------SHIELD DAMAGE + 60 CALL PROUT(25HSHIELDS DAMAGED AND DOWN.,25) + RETURN +C--------ENERGY TOTALLY DEPLETED + 70 CALL SKIP(1) + CALL PROUT(31HSHIELDS USE UP LAST OF ENERGY. ,31) + CALL FINISH(4) + RETURN +C--------CHANGE SHIELD ENERGY. + 80 CALL SCAN + ETRANS=FNUM + IF(KEY .EQ. IHREAL) GO TO 81 + 8010 CALL PROMPT(38HENERGY TO TRANSFER TO SHIELDS? ,38) + GO TO 80 + 81 IF(ETRANS .EQ. 0.) GO TO 90 + IF(ETRANS .LT. ENERGY) GO TO 82 + CALL PROUT(25HINSUFFICIENT SHIP ENERGY.,25) + GO TO 90 + 82 IDIDIT=1 + IF(SHLD+ETRANS .LE. INSHLD) GO TO 83 + CALL PROUT(24HSHIELD ENERGY MAXIMIZED.,24) + CALL PROUT(48HEXCESS ENERGY REQUESTED RETURNED TO SHIP ENERGY.,48) + ENERGY=ENERGY+SHLD-INSHLD + SHLD=INSHLD + GO TO 90 +C--------PREVENT SHIELD-DRAIN LOOPHOLE. + 83 IF(ETRANS .GT. 0.) GO TO 8310 + IF(ENERGY-ETRANS .LE. INENRG) GO TO 8310 + IF(ENERGY + SHLD .LE. INENRG) GO TO 8310 + CALL SKIP(1) + CALL PROUT(24H"ENGINEERING TO BRIDGE--,24) + CALL PROUT(46H SCOTT HERE. POWER CIRCUIT PROBLEM, CAPTAIN.,46) + CALL PROUT(31H I CAN'T DRAIN THE SHIELDS." ,31) + IDIDIT=0 + GO TO 90 + 8310 IF(SHLD+ETRANS .GE. 0.) GO TO 84 + CALL PROUT(38HALL SHIELD ENERGY TRANSFERRED TO SHIP.,38) + ENERGY=ENERGY+SHLD + SHLD=0 + GO TO 90 + 84 CALL CRAM(10HSCOTTY: ",10) + IF(ETRANS .GT. 0.) CALL CRAM(12HTRANSFERRING,12) + IF(ETRANS .LT. 0.) CALL CRAM(8HDRAINING,8) + CALL CRAM(8H ENERGY ,8) + IF(ETRANS .GT. 0.) CALL CRAM(2HTO,2) + IF(ETRANS .LT. 0.) CALL CRAM(4HFROM,4) + CALL CRAMDMP(10H SHIELDS.",10) + SHLD=SHLD+ETRANS + ENERGY=ENERGY-ETRANS + 90 IF(SHLD .LE. 0.0) SHLDUP=0 + RETURN + END + +END +DELETE F7:TRSKIP +EDIT +BUILD F7:TRSKIP + SUBROUTINE SKIP(N) + DO 10 L=1,N +C CALL PROUT(0,1) + CALL PROUT(1H ,1) + 10 CONTINUE + RETURN + END + +END +DELETE F7:TRSNOVA +EDIT +BUILD F7:TRSNOVA + SUBROUTINE SNOVA(INSX,INSY) +C +C 5-DEC-79 +C DON'T CHARGE PLAYER FOR BAD THINGS IF SUPERNOVA CAUSED BY +C ENEMY ACTION +C + INCLUDE F7:TREKCOM + INTEGER COMDEAD + NSX=INSX + NSY=INSY +C--------IF SCHEDULED SUPERNOVA (INSX=INSY=0), SELECT STAR + IF(INSX.NE.0) GO TO 50 + NUM=RANF(0)*INSTAR+1 + DO 10 NQX=1,8 + DO 10 NQY=1,8 + NUM=NUM-MOD(GALAXY(NQX,NQY),10) + IF(NUM .LE. 0) GO TO 20 + 10 CONTINUE +C--------IF STAR IS ALREADY GONE, RETURN EMPTY-HANDED + RETURN +C--------IF STARSHIP IS IN THIS QUADRANT, CHOOSE STAR EXACTLY + 20 IF(NQX.NE.QUADX .OR. NQY.NE.QUADY) GO TO 70 +C--------UNLESS STARSHIP JUST GOT HERE; THEN TREAT SUPERNOVA AS +C OCCURING WHILE EN ROUTE. + IF(JUSTIN.NE.0) GO TO 70 + NUM=RANF(0)*MOD(GALAXY(NQX,NQY),10)+1 + DO 30 NSX=1,10 + DO 30 NSY=1,10 + IF(QUAD(NSX,NSY) .NE. IHSTAR) GO TO 30 + NUM=NUM-1 + IF(NUM .EQ. 0) GO TO 50 + 30 CONTINUE +C--------PRINT RED ALERT (INCIPIENT SUPERNOVA) MESSAGE + 50 CALL SKIP(1) + CALL REDALRT + CALL CRAM(34H***INCIPIENT SUPERNOVA DETECTED AT,34) + CALL CRAMLOC(2,NSX,NSY) + CALL CREND + NQX=QUADX + NQY=QUADY +C--------SUPERNOVA ADJACENT TO STARSHIP ENDS GAME + DSQ=(NSX-SECTX)**2 + (NSY-SECTY)**2 + IF(DSQ .GT. 2.1) GO TO 80 + CALL PROUT( + + 54HEMERGENCY AUTOMATIC OVERRIDE ATTEMPTS T***************,54) + CALL STARS + ALLDONE=1 + GO TO 80 +C--------IF STARSHIP NOT IN SAME QUADRANT, JUST GET A MESSAGE + 70 IF(DAMAGE(9) .NE. 0) GO TO 80 + CALL SKIP(1) + CALL CRAM(49HMESSAGE FROM STARFLEET COMMAND STARDATE ,49) + CALL CRAMF(DATE,0,1) + CALL CREND + CALL CRAM(17H SUPERNOVA IN,17) + CALL CRAMLOC(1,NQX,NQY) + CALL CRAMDMP(18H; CAUTION ADVISED.,18) +C--------DESTROY ANY KLINGONS IN SUPERNOVAED QUADRANT + 80 NUM=GALAXY(NQX,NQY) + KLDEAD=NUM/100 + COMDEAD=0 + ISCDEAD=0 + IF((NQX .NE. ISX) .OR. (NQY .NE. ISY)) GO TO 85 + NSCREM=0 + ISX=0 + ISY=0 + ISATB=0 + ISCATE=0 + ISCDEAD=1 + FUTURE(6)=1E38 + FUTURE(7)=1E38 + 85 IF(KLDEAD .EQ. 0) GO TO 100 + REMKL=REMKL-KLDEAD + IF(REMCOM .EQ. 0) GO TO 100 + MAXLOOP=REMCOM + DO 90 L=1,MAXLOOP + IF(CX(L).NE.NQX .OR. CY(L).NE.NQY) GO TO 90 + CX(L)=CX(REMCOM) + CY(L)=CY(REMCOM) + CX(REMCOM)=0 + CX(REMCOM)=0 + REMCOM=REMCOM-1 + KLDEAD=KLDEAD-1 + COMDEAD=1 + IF(REMCOM .EQ. 0) FUTURE(2)=1E38 + 90 CONTINUE +C--------DESTROY ROMULANS AND PLANETS IN SUPERNOVAED QUADRANT. + 100 NUM=NEWSTUF(NQX,NQY) + NEWSTUF(NQX,NQY)=0 + NRMDEAD=NUM/10 + NROMREM=NROMREM-NRMDEAD + NPDEAD=NUM-NRMDEAD*10 + IF(NPDEAD .EQ. 0) GO TO 109 + DO 106 L=1,INPLAN + IF((PLNETS(L,1) .NE. NQX).OR. (PLNETS(L,2) .NE. NQY)) GO TO 106 + DO 105 I=1,5 + 105 PLNETS(L,I)=0 + 106 CONTINUE +C--------DESTROY ANY BASE IN SUPERNOVAED QUADRANT + 109 IF(REMBASE .EQ. 0) GO TO 120 + MAXLOOP=REMBASE + DO 110 L=1,MAXLOOP + IF(BASEQX(L).NE.NQX .OR. BASEQY(L).NE.NQY) GO TO 110 + BASEQX(L)=BASEQX(REMBASE) + BASEQY(L)=BASEQY(REMBASE) + BASEQX(REMBASE)=0 + BASEQY(REMBASE)=0 + REMBASE=REMBASE-1 + 110 CONTINUE +C--------IF STARSHIP CAUSED SUPERNOVA, TALLY UP DESTRUCTION + 120 IF(INSX .EQ. 0) GO TO 130 + NUMBER=MOD(GALAXY(NQX,NQY),100) + KILLK=KILLK+KLDEAD + KILLC=KILLC+COMDEAD + NROMKL=NROMKL+NRMDEAD + NSCKILL=NSCKILL+ISCDEAD +C--------IF ENEMY ACTION CAUSED SUPERNOVA, DON'T ASSESS ANY PENALTIES + IF(IPHWHO.EQ.1)GO TO 130 + STARKL=STARKL+MOD(NUMBER,10) + BASEKL=BASEKL+(NUMBER/10) + NPLANKL=NPLANKL+NPDEAD +C--------MARK SUPERNOVA IN GALAXY AND IN STAR CHART + 130 IF(STARCH(NQX,NQY).GT.0 .AND. DAMAGE(9).NE.0) + + STARCH(NQX,NQY)=1000+GALAXY(NQX,NQY) + IF(DAMAGE(9).EQ.0 .OR. (QUADX.EQ.NQX .AND. QUADY.EQ.NQY)) + + STARCH(NQX,NQY)=1 + GALAXY(NQX,NQY)=1000 +C--------IF SUPERNOVA DESTROYS LAST KLINGONS, GIVE SPECIAL MESSAGE + IF(REMKL.NE.0 .OR. (NQX.EQ.QUADX .AND. NQY.EQ.QUADY)) GO TO 140 + CALL SKIP(2) + CALL PROUT(11HLUCKY YOU! ,11) + CALL CRAM(14HA SUPERNOVA IN,14) + CALL CRAMLOC(1,NQX,NQY) + CALL CRAMDMP(38H HAS JUST DESTROYED THE LAST KLINGONS.,38) + CALL FINISH(1) + RETURN +C--------IF SOME KLINGONS REMAIN, CONTINUE (OR DIE IN SUPERNOVA) + 140 IF(ALLDONE.NE.0) CALL FINISH(8) + RETURN + END + +END +DELETE F7:TRSORTK +EDIT +BUILD F7:TRSORTK + SUBROUTINE SORTKL + INCLUDE F7:TREKCOM + INTEGER SWITCH + IF(NENHERE.LE.1)RETURN + MINUS1=NENHERE-1 + 10 SWITCH=0 + DO 20 J=1,MINUS1 + IF(KDIST(J) .LE. KDIST(J+1)) GO TO 20 + T=KDIST(J) + KDIST(J)=KDIST(J+1) + KDIST(J+1)=T + K=KX(J) + KX(J)=KX(J+1) + KX(J+1)=K + K=KY(J) + KY(J)=KY(J+1) + KY(J+1)=K + T=KPOWER(J) + KPOWER(J)=KPOWER(J+1) + KPOWER(J+1)=T + SWITCH=1 + 20 CONTINUE + IF(SWITCH.NE.0) GO TO 10 + RETURN + END + +END +DELETE F7:TRSRSCA +EDIT +BUILD F7:TRSRSCA + SUBROUTINE SRSCAN + INCLUDE F7:TREKCOM +C BYTE BITEM + LOGICAL LEFTSID,RITESID ,CROP + DATA LEFTSID,RITESID/.TRUE.,.TRUE./ + DATA K/0/ + LOGICAL JA,RESPJA + REAL*8 REQUST(10),AITEM,DAMAGD,UP,DOWN,TJ + CHARACTER QCHAR(10,10) +C EQUIVALENCE (AITEM,BITEM) +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + COMMON/CRAMSARG/CRAMSTR + REAL*8 CRAMSTR + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + DATA REQUST /4HDATE,8HCONDITIO,8HPOSITION,8HLSUPPORT,8HWARPFACT + +,6HENERGY,8HTORPEDOE,7HSHIELDS,8HKLINGONS,4HTIME/ + DATA DAMAGD,UP,DOWN/7HDAMAGED,2HUP,4HDOWN/ + IF(DAMAGE(1) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 160 + LEFTSID=.TRUE. + RITESID=.TRUE. +C CALL SCAN + RESPJA=JA(0) + IF(KEY.EQ.IHEOL .OR. RESPJA) GO TO 3 +C IF(BITEM .EQ. 1HN) RITESID = .FALSE. + 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* + ENTRY REQUEST +C* + 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 + CROPITEM=AITEM + CROPMATCH=REQUST(I) + 304 IF(CROP()) 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* + ENTRY STATUS +C* + 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 ,1) + DO 5 J=1,10 +C CALL CRAMS(QUAD(I,J),1) + QCHAR(I,J)=CHAR(QUAD(I,J)) + CALL CRAMS(QCHAR(I,J),1,1) + CALL CRAM(1H ,1) + 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 ,15) + CALL CRAMF(DATE,0,1) + CALL CREND + GO TO 140 + 20 IF(CONDIT .NE. IHDOCKD ) CALL NEWCOND + CALL CRAM(15H CONDITION ,15) + IF(CONDIT.EQ.IHGREEN) CALL CRMDPS('GREEN',5,5) + IF(CONDIT.EQ.IHRED) CALL CRMDPS('RED',3,3) + IF(CONDIT.EQ.IHYELLO) CALL CRMDPS('YELLOW',6,6) + IF(CONDIT.EQ.IHDOCKD) CALL CRMDPS('DOCKED',6,6) + GO TO 140 + 30 CALL CRAM(14H POSITION ,14) + CALL CRAMLOC(0,QUADX,QUADY) + CALL CRAM(1H,,1) + CALL CRAMLOC(0,SECTX,SECTY) + CALL CREND + GO TO 140 + 40 CALL CRAM(15H LIFE SUPPORT ,15) + IF(DAMAGE(5).NE.0.) GO TO 44 + CALL CRAM(6HACTIVE,6) + GO TO 46 + 44 IF(CONDIT .NE. IHDOC ) GO TO 45 + CALL CRAM(30HDAMAGED, SUPPORTED BY STARBASE,30) + GO TO 46 + 45 CALL CRAM(18HDAMAGED, RESERVES=,18) + CALL CRAMF(LSUPRES,4,2) + 46 CALL CREND + GO TO 140 + 50 CALL CRAM(15H WARP FACTOR ,15) + CALL CRAMF(WARPFAC,0,1) + CALL CREND + GO TO 140 + 60 CALL CRAM(15H ENERGY ,15) + CALL CRAMF(ENERGY,0,2) + CALL CREND + GO TO 140 + 70 CALL CRAM(15H TORPEDOES ,15) + CALL CRAMI(TORPS,0) + CALL CREND + GO TO 140 + 80 CALL CRAM(15H SHIELDS ,15) + TJ=DOWN + LTJ=4 +C IF(SHLDUP.NE.0) TJ=UP + IF(SHLDUP.EQ.0) GO TO 81 + TJ=UP + LTJ=2 +C IF(DAMAGE(8) .GT. 0) TJ=DAMAGD + 81 IF(DAMAGE(8) .LE. 0) GO TO 82 + TJ=DAMAGD + LTJ=7 +C CALL CRAMS(TJ,8) + 82 CRAMSTR=TJ + CALL CRAMS(NULL,LTJ,8) + CALL CRAM(2H, ,2) + J=100.0*SHLD/INSHLD+0.5 + CALL CRAMI(J,0) +C CALL CRAM(5H`% - ,5) + CALL CRAM(11H PERCENT ,11) + J=SHLD + CALL CRAMI(J,0) + CALL CRAMDMP(6H UNITS,6) + GO TO 140 + 90 CALL CRAM(15H KLINGONS LEFT ,15) + CALL CRAMI(REMKL,0) + CALL CREND + GO TO 140 + 100 CALL CRAM(15H TIME LEFT ,15) + 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 + +END +DELETE F7:TRTHAW +EDIT +BUILD F7:TRTHAW + SUBROUTINE THAW +C +C 5-APR-79 +C FIX BUG IN TYPEOUT ON STATE OF GAME. +C 25-APR-79 +C CLEAN UP MESSAGE ON BASES. +C GET RID OF SPURIOUS COMMANDER ATTACK. +C 1-MAY-78 +C DON'T PRINT PASSWORD FOR 'GAME' ENTRY +C 3-MAY-78 +C USE CRAMSP TO TAKE CARE OF ALL SINGULAR/PLURAL TYPEOUTS. +C + INCLUDE F7:TREKCOM + COMMON/CHARCOMN/NULL,BLANK + CHARACTER NULL,BLANK + COMMON/CRAMBF/CRAMBUF + REAL*8 CRAMBUF(2) +C LOGICAL*1 NAME(30) + CHARACTER NAME(10) + CHARACTER*10 FN + EQUIVALENCE (FN,NAME) + INTEGER DESTBAS +C + ISIZA=0 + ISIZB=0 + CALL GETFN(NAME) + IDIDIT=0 +C IF(NAME(1).EQ.0) GOTO 800 + IF(NAME(1).EQ.NULL) GOTO 800 +C CALL CLOSE(2) +C OPEN(UNIT=2,NAME=NAME,TYPE='OLD',FORM='UNFORMATTED', +C 1 ERR=800) +C READ(2,ERR=800) N,(ICOM(K),K=1,N) +C CALL CLOSE(2) +C + OPEN(UNIT=103,NAME=FN,STATUS='OLD', + + FORM='UNFORMATTED',ERR=800) + READ(103,ERR=800) ISIZA,ISIZB, + + (ICOMA(J),J=1,ISIZA),(ICOMB(K),K=1,ISIZB) + CLOSE(103) +C + IDIDIT=1 + GO TO 100 +C*--TELL HIM WHAT KIND OF GAME HE GOT HIMSELF INTO... + ENTRY GAME + IDIDIT=0 + 100 CALL SKIP(1) + CALL CRAM(22HYOU ARE NOW PLAYING A ,22) + IF(LENGTH.EQ.1) CALL CRAM(5HSHORT,5) + IF(LENGTH.EQ.2) CALL CRAM(6HMEDIUM,6) + IF(LENGTH.EQ.4) CALL CRAM(4HLONG,4) + IF(SKILL.EQ.1) CALL CRAM(7H NOVICE,7) + IF(SKILL.EQ.2) CALL CRAM(5H FAIR,5) + IF(SKILL.EQ.3) CALL CRAM(5H GOOD,5) + IF(SKILL.EQ.4) CALL CRAM(7H EXPERT,7) + IF(SKILL.EQ.5) CALL CRAM(9H EMERITUS,9) + CALL CRAMDMP(6H GAME.,6) + IF(IDIDIT.EQ.0)GO TO 110 + CALL CRAM(25HYOUR SECRET PASSWORD IS ',25) +C CALL CRAMS(PASSWD,8) + CRAMBUF(1)=PASSWD + CALL CRAMIT(8) + CALL CRAMDMP(2H'.,2) + 110 KILLTOT=KILLK+KILLC+NSCKILL + CALL CRAMI(KILLTOT,0) + CALL CRAM(4H OF ,4) + CALL CRAMSP(INKLING,'KLINGON',7) + IF(KILLTOT.EQ.1)CALL CRAM(' HAS',4) + IF(KILLTOT.NE.1)CALL CRAM(' HAVE',5) + CALL CRAM(' BEEN KILLED, INCLUDING ',24) + CALL CRAMSP(KILLC,'COMMANDER',9) + CALL CRAMDMP('.',1) + IF(SKILL.LE.2) GOTO 200 + CALL CRAM(24HTHE SUPER-COMMANDER HAS ,24) + IF(NSCREM.EQ.1) CALL CRAM(4HNOT ,4) + CALL CRAMDMP(15HBEEN DESTROYED.,15) +C*--GIVE HIM THE POOP ON THE BASES. + 200 DESTBAS=INBASE-REMBASE + IF(DESTBAS.EQ.0)GO TO 210 + CALL CRAMSP(DESTBAS,'BASE',4) + CALL CRAM(' DESTROYED, ',12) + 210 CALL CRAMSP(REMBASE,'BASE',4) + IF(DESTBAS.NE.0)CALL CRAM(' REMAINING',10) + CALL CRAMDMP('.',1) +C*--IS A COMMANDER CHOMPING ON A BASE? + IF(ICSOS.EQ.0)GO TO 240 + IF(FUTURE(5).GE. 1.E38) GOTO 240 + IF(REMCOM.EQ.0 .OR. REMBASE.EQ.0)GO TO 240 + IF(MOD(GALAXY(BATX,BATY),100).LT.10)GO TO 240 + DO 220 I=1,REMCOM + IF(CX(I).EQ.BATX .AND. CY(I).EQ.BATY)GO TO 221 + 220 CONTINUE + GO TO 240 + 221 CALL CRAM(11HSTARBASE IN ,11) + CALL CRAMLOC(1,BATX,BATY) + CALL CRAMDMP(27H IS CURRENTLY UNDER ATTACK.,27) + CALL CRAM(31HIT CAN HOLD OUT UNTIL STARDATE ,31) + CALL CRAMF(FUTURE(5),0,1) + CALL CRAMDMP(1H.,1) +C*--IS THE SUPER COMMANDER ATTACKING? + 240 IF(ISSOS.EQ.0)GO TO 245 + IF(ISATB.NE.1) GOTO 245 + CALL CRAM(11HSTARBASE IN ,11) + CALL CRAMLOC(1,ISX,ISY) + CALL CRAMDMP(33H IS UNDER SUPER-COMMANDER ATTACK. ,33) + CALL CRAM(31HIT CAN HOLD OUT UNTIL STARDATE ,31) + CALL CRAMF(FUTURE(7),0,1) + CALL CRAMDMP(1H.,1) +C*--ISSUE CAVEAT IF THE SUBSPACE RADIO HAS BEEN BROKEN + 245 IF(ISUBDAM.EQ.0)GO TO 249 + CALL CRAM('THE SUBSPACE RADIO ',19) + IF(DAMAGE(9).NE.0)CALL CRAM('IS',2) + IF(DAMAGE(9).EQ.0)CALL CRAM('WAS',3) + CALL CRAMDMP(' DAMAGED. THUS YOU MAY NOT HAVE COMPLETE',41) + CALL CRAMDMP('INFORMATION ON SUPERNOVAS AND ATTACKS ON BASES.',47) +C*--HOW MANY CASUALTIES? + 249 IF(CASUAL.EQ.0) GOTO 250 + CALL CRAMSPI(CASUAL,'CASUALT',7,'Y',1,'IES',3) + CALL CRAMDMP(' SUFFERED SO FAR.',17) + 250 IF(NHELP.EQ.0) GOTO 260 + CALL CRAMSP(NHELP,'CALL',4) + CALL CRAMDMP(' FOR HELP.',10) + 260 CALL SKIP(1) +C*--AND LET HIM PLAY IT + RETURN +C*--THAT WAS A BAD FREEZE OR FILE NOT OPENED + 800 CALL PROUT(17H GAME NOT FROZEN. ,17) +C*--TELL CHOOSE THAT WE DIDN'T GET ANYTHING + PASSWD=0.D0 + RETURN + END + +END +DELETE F7:TRTIMEW +EDIT +BUILD F7:TRTIMEW + SUBROUTINE TIMEWRP + INCLUDE F7:TREKCOM + DIMENSION PICTURE(226) + EQUIVALENCE (PICTURE,DATE) + CALL PROUT(21H***TIME WARP ENTERED.,21) + IF(SNAP.NE.0 .AND. RANF(0).LT.0.5) GO TO 10 +C--------TRAVEL FORWARD IN TIME + TIME=-0.5*INTIME*ALOG(RANF(0)) + CALL CRAM(35HYOU ARE TRAVELLING FORWARD IN TIME ,35) + CALL CRAMF(TIME,0,2) + CALL CRAMDMP(11H STARDATES.,11) +C--------CHEAT TO MAKE SURE NO TRACTOR BEAMS OCCUR DURING TIME WARP + FUTURE(2)=FUTURE(2)+TIME + GO TO 40 +C--------TRAVEL BACKWARD IN TIME + 10 XDATE=DATE + DATE=SNAPSHT(1) + CALL CRAM(36HYOU ARE TRAVELLING BACKWARD IN TIME ,36) + CALL CRAMF(XDATE-DATE,0,2) + CALL CRAMDMP(11H STARDATES.,11) + SNAP=0 + DO 20 L=2,226 + 20 PICTURE(L)=SNAPSHT(L) + IF(REMCOM .EQ. 0) GO TO 25 + FUTURE(2)=DATE+EXPRAN(INTIME/REMCOM) + FUTURE(4)=DATE+EXPRAN(0.3*INTIME) + 25 FUTURE(1)=DATE+EXPRAN(0.5*INTIME) + FUTURE(3)=DATE+EXPRAN(0.5*INTIME) + IF(NSCREM.NE.0) FUTURE(6)=0.2777 + ISATB=0 + FUTURE(5)=1E38 + FUTURE(7)=1E38 + BATX=0 + BATY=0 +C--------REVERT STAR CHART TO EARLIER ERA. + DO 30 L=1,8 + DO 30 LL=1,8 + 30 STARCH(L,LL)=MIN0(1,STARCH(L,LL)) + CALL PROUT( + + 57HSPOCK HAS RECONSTRUCTED A CORRECT STAR CHART FROM MEMORY. + 1 ,57) +C--------MODIFY DESTINATION QUADRANT TO CORRESPOND TO NEW TIME + 40 CALL NEWQUAD + RETURN + END + +END +DELETE F7:TRTREK +EDIT +BUILD F7:TRTREK + PROGRAM STARTRK +C********************************************************************* +C* * +C* THE STAR TREK GAME * +C* BY * +C* DAVID MATUSZEK AND PAUL REYNOLDS * +C* * +C* WITH MODIFICATIONS AND ADDITIONS BY * +C* DON SMITH * +C* * +C* * +C* PERMISSION IS HEREBY GRANTED FOR THE COPYING, * +C* DISTRIBUTION, MODIFICATION AND USE OF THIS PROGRAM AND * +C* ASSOCIATED DOCUMENTATION FOR RECREATIONAL PURPOSES, * +C* PROVIDED THAT ALL REFERENCES TO THE AUTHORS ARE RETAINED. * +C* HOWEVER, PERMISSION IS NOT AND WILL NOT BE GRANTED FOR * +C* THE SALE OR PROMOTIONAL USE OF THIS PROGRAM OR PROGRAM * +C* DOCUMENTATION, OR FOR USE IN ANY SITUATION IN WHICH * +C* PROFIT MAY BE CONSIDERED AN OBJECTIVE, SINCE IT IS THE * +C* DESIRE OF THE AUTHORS TO RESPECT THE COPYRIGHTS OF THE * +C* ORIGINATORS OF STAR TREK. * +C* * +C********************************************************************* +C +C BACK-PORTED TO CP-V F77 ON GEORGE PLUE'S "SIGGY" SIGMA-7 EMULATOR +C JWF 20 FEB 2016 +C +C********************************************************************* +C +C 4-APR-79 +C MAKE COMMAND INPUT REPROMPT AFTER A BLANK LINE WITHOUT +C TYPING OUT A BUNCH OF GARBAGE. +C ALSO GET RID OF THE CRAP ABOUT TYPING SOMETHING TO GET +C YOUR CITATION. +C 13-APR-79 +C ADD EMERGENCY EXIT COMMAND. +C 25-APR-79 +C GET RID OF COMMON /RAN/, WHICH IS NOT REFERENCED. +C 1-MAY-79 +C REDO ALL MODULES TO GET THEIR COMMON FROM AN INCLUDE STATEMENT. +C THIS SHOULD GREATLY SIMPLIFY MAINTENANCE AND EXTENSION OF THE +C GAME. +C ALSO ADD 'GAME' COMMAND TO MAKE LIFE EASIER FOR THE PLAYER ON +C A SOFT COPY TERMINAL. +C 31-MAY-79 +C CLOSE PRINT FILE AND RESET LUN TO 1 AFTER OUTPUTTING SCORE +C AND/OR CITATION. +C + PARAMETER NCOMMDS=23 + INCLUDE F7:TREKCOM + LOGICAL CROP,FROZEN + REAL*8 ITEM,HELPX,TERM,ABAN,DEST,FREE,DEATH,AITEM + REAL*8 DBUG,KOBI,KOBI1 + REAL*8 COMMAND(NCOMMDS) + LOGICAL JA + COMMON/PRLUN/LUN + DATA LUN/101/ +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + COMMON/CROPARGS/CROPITEM,CROPMATCH + REAL*8 CROPITEM,CROPMATCH + COMMON/PASS/PFLAG + LOGICAL PFLAG + EQUIVALENCE (AITEM,ITEM) + EQUIVALENCE (CRACKS(6),KDIDIT) +C +C MASTER COMMAND LIST - INCLUDES ALL ABBREVIATABLE COMMANDS +C + DATA COMMAND/6HSRSCAN,6HLRSCAN,7HPHASERS,7HPHOTONS,4HMOVE, + + 7HSHIELDS,4HDOCK,7HDAMAGES,5HCHART,7HIMPULSE,4HREST,4HWARP, + + 6HSTATUS,7HSENSORS,5HORBIT,8HTRANSPOR,4HMINE,8HCRYSTALS, + + 7HSHUTTLE,7HPLANETS,7HREQUEST,6HEMEXIT,4HGAME/ +C +C ALPHANUMERIC DATA +C +C DATA IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED,IHYELLO, +C +IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB/2HEO,2HRE, +C +2HAL,1HS,1HR,1HC,1HK,2HGR,2HRE,2HYE,2HDO,1HE,1HF, +C +1H ,1H.,1H?,1HP,1H*,1HB/ +C DATA IHT,IHNUM,IHAT,IH0/1HT,1H{#},1H@,1H0/ +C + DATA IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED,IHYELLO, + +IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB/50646,55749, + +49619,226,217,195,210,51161,55749,59589,50390,197,198, + +64,75,111,215,92,194/ + DATA IHT,IHNUM,IHAT,IH0/227,123,124,240/ +C +C DEVICE LIST +C +C DEVICES ARE: +C 1. S. R. SENSORS +C 2. L. R. SENSORS +C 3. PHASERS +C 4. PHOTON TUBES +C 5. LIFE SUPPORT +C 6. WARP ENGINES +C 7. IMPULSE ENGINES +C 8. SHIELDS +C 9. SUBSPACE RADIO +C 10. SHUTTLE CRAFT +C 11. COMPUTER +C 12. TRANSPORTER +C 13. SHIELD CONTROL +C 14. DEATHRAY +C + DATA DEVICE/8HS. R. SE,5HNSORS,8HL. R. SE,5HNSORS, + 1 7HPHASERS,1H ,8HPHOTON T,4HUBES,8HLIFE SUP,4HPORT, + 2 8HWARP ENG,4HINES,8HIMPULSE ,7HENGINES,7HSHIELDS,1H , + 3 8HSUBSPACE,6H RADIO,8HSHUTTLE ,5HCRAFT,8HCOMPUTER,1H , + 4 8HTRANSPOR,3HTER,8HSHIELD C,6HONTROL,8HDEATHRAY, + 5 1H / +C + DATA DEVLEN/8 ,5 ,8 ,5 , + 1 7 ,1 ,8 ,4 ,8 ,4 , + 2 8 ,4 ,8 ,7 ,7 ,1 , + 3 8 ,6 ,8 ,5 ,8 ,1 , + 4 8 ,3 ,8 ,6 ,8 , + 5 1 / +C +C NON-ABBREVIATABLE COMMAND LIST +C + DATA HELPX,TERM,ABAN,DEST,FREE,DEATH/'HELP','TERMINAT', + 1 'ABANDON','DESTRUCT','FREEZE','DEATHRAY'/ + DATA DBUG,KOBI,KOBI1/'DEBUG','CHEAT','CLEAR'/ +C + NDEVICE=14 + ICITE=0 +C--------PRINT OUT PRELIMINARY MESSAGES + CALL PRELIM +C--------INITIALIZE AND START NEW GAME + 10 CALL CHOOSE(FROZEN) + IF(FROZEN) GOTO 15 + CALL SETUP +C--------REQUEST NEW COMMAND AND BRANCH TO CODE FOR THAT COMMAND + 15 MOVED=0 + 20 IF(ALLDONE.NE.0) GO TO 9999 + JUSTIN=0 + TIME=0. + KDIDIT=0 + CALL PROMPT(10HCOMMAND: ,10) + PFLAG=.TRUE. + CALL SCAN + PFLAG=.FALSE. + DO 30 L=1,NCOMMDS +C IF(CROP(ITEM,COMMAND(L))) + CROPITEM=ITEM + CROPMATCH=COMMAND(L) + IF(CROP()) + + GO TO (100,200,300,400,500,600,700,800,900,1000, + + 1100,1200,1300,1400,1450,1500,1550,1600,1650,1670, + + 1680,1685,1690),L + 30 CONTINUE + IF(ITEM .EQ. HELPX ) GO TO 1700 + IF(ITEM .EQ. TERM) GO TO 9000 + IF(ITEM .EQ. ABAN ) GO TO 1900 + IF(ITEM .EQ. DEST ) GO TO 2000 + IF(ITEM .EQ. FREE ) GO TO 2100 + IF(ITEM .EQ. DEATH ) GO TO 2200 + IF(ITEM .EQ. DBUG ) GO TO 2300 + IF(ITEM .EQ. KOBI ) GO TO 2305 + IF(ITEM .EQ. KOBI1 ) GO TO 2315 + IF(KEY .NE. IHEOL) GO TO 40 +C CALL PROUT(18HBLANK LINE IGNORED,18) + GO TO 20 + 40 CALL PROUT( + + 42HUNRECOGNIZED COMMAND. LEGAL COMMANDS ARE:,42) + CALL PROUT( + + 37H SRSCAN MOVE PHASERS HELP,37) + CALL PROUT( + + 40H STATUS IMPULSE PHOTONS ABANDON,40) + CALL PROUT( + + 41H LRSCAN WARP SHIELDS DESTRUCT,41) + CALL PROUT( + + 42H CHART REST DOCK TERMINATE,42) + CALL PROUT( + + 38H DAMAGES FREEZE SENSORS ORBIT,38) + CALL PROUT( + + 40H TRANSPORT MINE CRYSTALS SHUTTLE,40) + CALL PROUT( + + 39H PLANETS REQUEST DEATHRAY EMEXIT,39) + CALL PROUT( + + 7H GAME,7) + GO TO 20 +C--------SHORT RANGE SCAN + 100 CALL SRSCAN + GO TO 20 +C--------LONG RANGE SCAN + 200 CALL LRSCAN + GO TO 20 +C--------FIRE PHASERS + 300 CALL PHASERS + 305 IF(IDIDIT .EQ. 0) GO TO 20 + 310 CALL ATTACK + 320 IF(KDIDIT.NE.0) GO TO 2500 + GO TO 15 +C--------FIRE PHOTON TORPEDOS + 400 CALL PHOTONS + 410 IF(IDIDIT .EQ. 0) GO TO 20 + MOVED=0 + GO TO 2500 +C--------MOVE UNDER WARP DRIVE + 500 IF(MOVED .EQ. 0) GO TO 510 + 505 MOVED=2 + 510 CALL WARP + 520 IF((IDIDIT.EQ.0).AND.(MOVED.EQ.2)) MOVED=1 + IF(IDIDIT.EQ.0) GO TO 20 + IF((MOVED.EQ.2).AND.(JUSTIN.EQ.0)) CALL ATTACK + MOVED=1 + GO TO 2500 +C--------RAISE OR LOWER DEFLECTOR SHIELDS + 600 CALL SHIELDS + IF(IDIDIT .EQ. 0) GO TO 20 + CALL ATTACK + SHLDCHG=0 + GO TO 320 +C--------DOCK AT STARBASE + 700 CALL DOCK + IF(IDIDIT.NE.0) GO TO 310 + GO TO 20 +C--------LOOK AT DAMAGE REPORT + 800 CALL DREPORT + GO TO 20 +C--------LOOK AT STAR CHART + 900 CALL CHART + GO TO 20 +C--------MOVE UNDER IMPULSE POWER + 1000 IF(MOVED.NE.0) GO TO 505 + CALL IMPULSE + GO TO 520 +C--------REST AND REPAIR + 1100 CALL WAIT + GO TO 410 +C--------CHANGE WARP FACTOR + 1200 CALL SETWARP + GO TO 20 +C--------ASK FOR STATUS INFORMATION + 1300 CALL STATUS + GO TO 20 +C--------GET A SENSOR SCAN OF QUADRANT. + 1400 CALL SENSOR + GO TO 20 +C--------ENTER STANDARD ORBIT. + 1450 CALL ORBIT + GO TO 410 +C--------TRANSPORT SOMEBODY SOMEWHERE. + 1500 CALL BEAM + GO TO 20 +C--------DO A LITTLE DIGGING. + 1550 CALL MINE + GO TO 410 +C--------LOAD SOME CRYSTALS (AND HOPE FOR THE BEST.) + 1600 CALL CRYSTAL + GO TO 20 +C--------GO FOR A SPIN IN GALILEO. + 1650 CALL GALILEO + GO TO 410 +C--------GET A PLANET LIST + 1670 CALL PLANET + GO TO 20 +C--------INDIVIDUAL PIECE OF INFORMATION FROM STATUS REQUESTED. + 1680 CALL REQUEST + GO TO 20 +C--------EMERGENCY EXIT - FREEZE ON EMSAVE.TRK AND BUG OUT + 1685 CALL EMEXIT + GO TO 20 +C--------GAME - TYPE OUT INFORMATION ON CURRENT GAME + 1690 CALL GAME + GO TO 20 +C--------CALL STARBASE FOR HELP + 1700 CALL HELP + GO TO 20 +C--------ABANDON SHIP + 1900 CALL ABANDON + GO TO 20 +C--------SELF-DESTRUCT + 2000 CALL DESTRCT + GO TO 20 +C--------FREEZE THE CURRENT GAME + 2100 CALL FREEZE + IF(IDIDIT.EQ.1) GO TO 9999 + GO TO 20 +C--------TRY A DESPERATION MEASURE + 2200 CALL DEATHRA + GO TO 305 +C--------INTERNAL DEBUGGING, EFFECTS VARY + 2300 CALL DEBUGIT + GO TO 20 +C--------KOBIYASHI MARU + 2305 CALL CHEATER + GO TO 20 + 2315 CALL CHEATCL + GO TO 20 +C--------AFTER COMMANDS WHICH MAY USE TIME, DO CHECKING + 2500 IF(ALLDONE.NE.0) GO TO 9999 + IF(TIME .NE. 0.) CALL EVENTS + IF(ALLDONE.NE.0) GO TO 9999 + IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 2510 + CALL AUTOVER + KDIDIT=0 + MOVED=0 + GO TO 2500 +C--------CHECK FOR MOVE AND FIRE OPTION + 2510 IF(NENHERE.EQ.0) CALL MOVETHO + IF(KDIDIT .EQ. 1 .OR. NENHERE .EQ. 0) GO TO 15 + IF(MOVED .EQ. 0 .OR. JUSTIN .EQ. 1) GO TO 310 + GO TO 20 +C--------GAME HAS ENDED. START NEW GAME OR FINALIZE. + 9000 CALL SCORE +C9999 IF(LUN.EQ.2)CALL CLOSE(2) + 9999 CONTINUE +C LUN=1 + LUN=101 + CALL SKIP(2) + CALL STARS + CALL SKIP(1) + CALL PROMPT(30HDO YOU WANT TO PLAY AGAIN? ,30) +C IF(JA(DUMMY)) GO TO 10 + IF(JA(1)) GO TO 10 + CALL SKIP(1) + CALL PROUT( + + 48HMAY THE GREAT BIRD OF THE GALAXY ROOST UPON YOUR,48) + CALL PROUT(12HHOME PLANET.,12) + CALL SKIP(1) +C IF(ICITE .EQ. 0) GO TO 99999 +C CALL PROUT(52HDON'T FORGET TO TYPE TO RECEIVE YOUR CITATION. +C C,52) +99999 CALL EXIT + END + +END +DELETE F7:TRWAIT +EDIT +BUILD F7:TRWAIT + SUBROUTINE WAIT + INCLUDE F7:TREKCOM + REAL*8 AITEM +C COMMON/SCANBF/KEY,AITEM + COMMON/SCANBF/KEY + COMMON/SCANBF1/AITEM + EQUIVALENCE(AITEM,FNUM) + LOGICAL JA +C--------DO COMMAND SCANNING + IDIDIT=0 + 10 CALL SCAN +C--------SAVE SCAN BUFFER + ANUM=FNUM + IF(KEY .NE. IHEOL) GO TO 20 + CALL PROMPT(10HHOW LONG? ,10) + GO TO 10 + 20 IF(KEY .NE. IHREAL) GO TO 60 + IF(ANUM .LE. 0.) RETURN + IF(ANUM.LT.REMTIME .AND.NENHERE.EQ.0) GO TO 30 + CALL PROMPT(13HARE YOU SURE?,13) +C IF(JA(DUMMY) .EQ. 0) RETURN + IF(.NOT. JA(1)) RETURN +C--------ALTERNATE REST PERIODS (EVENTS) WITH ATTACKS + 30 RESTING=1 + AITEM2=ANUM + 40 IF(ANUM .LE. 0.) RESTING=0 + IF(RESTING .EQ. 0) GO TO 50 + TEMP=ANUM + IF(NENHERE.NE. 0) TEMP=AMIN1(ANUM,1.0+RANF(0)) + TIME=TEMP + IF(TIME .LT. ANUM) CALL ATTACK + IF(NENHERE.EQ.0) CALL MOVETHO + IF(ALLDONE.NE.0) RETURN + CALL EVENTS + IDIDIT=1 + IF(ALLDONE.NE.0) RETURN + ANUM=ANUM-TEMP + IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 40 + RESTING=0 + TIME=0 + GOTO 55 + 50 CALL CRAMF(REMTIME,0,2) + CALL CRAMDMP(16H STARDATES LEFT.,16) + 55 IF(CONDIT.NE.IHDOCKD) RETURN + IF((AITEM2-ANUM).GE.9.99) DAMAGE(14)=0 +C*--------HANDLE SPECIAL CASE OF DEATHRAY REPAIRS. + RETURN + 60 CALL BEGPARD + RETURN + END + +END +DELETE F7:TRWARP +EDIT +BUILD F7:TRWARP + SUBROUTINE WARP + INCLUDE F7:TREKCOM + INTEGER BLOOEY,TWARP + LOGICAL JA + IDIDIT=0 + IF(DAMAGE(6) .GT. 10.0) GO TO 90 + IF(DAMAGE(6) .EQ. 0.0 .OR. WARPFAC .LE. 4.0) GO TO 3 + CALL PROUT(52HENGINEER SCOTT: "SORRY, CAPTAIN. UNTIL THIS DAMAGE + +,52) + CALL PROUT(43H IS REPAIRED, I CAN ONLY GIVE YOU WARP 4.",43) + RETURN +C--------READ IN COURSE AND DISTANCE + 3 CALL GETCD + IF(DIREC .LT. 0) RETURN +C--------MAKE SURE STARSHIP HAS ENOUGH ENERGY TO MAKE THE TRIP + POWER=(DIST+0.05)*WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1) + IF(POWER .LT. ENERGY) GO TO 10 + CALL SKIP(1) + CALL PROUT(24H"ENGINEERING TO BRIDGE--,24) + IF(SHLDUP.EQ.0 .OR. 0.5*POWER.GT.ENERGY) GO TO 5 + CALL PROUT( + +61H WE HAVEN'T THE ENERGY TO GO THAT FAR WITH THE SHIELDS UP." + + ,61) + RETURN + 5 IWARP=(ENERGY/(DIST+0.05))**0.3333333333 + IF(IWARP .LE. 0) GO TO 8 + CALL CRAM( + + 53H WE HAVEN'T THE ENERGY. BUT WE COULD DO IT AT WARP ,53) + CALL CRAMI(IWARP,0) + IF(SHLDUP.NE.0) GO TO 6 + CALL CRAMDMP(2H.",2) + RETURN + 6 CALL CRAMDMP(1H,,1) + CALL PROUT(31H IF YOU'LL LOWER THE SHIELDS.",31) + RETURN + 8 CALL PROUT( + + 51H WE CAN'T DO IT, CAPTAIN. WE HAVEN'T THE ENERGY.",51) + RETURN +C--------MAKE SURE ENOUGH TIME IS LEFT FOR TRIP + 10 TIME=10.0*DIST/WFACSQ + IF(TIME .LT. 0.80*REMTIME) GO TO 20 + CALL SKIP(1) + CALL PROUT( + + 51HFIRST OFFICER SPOCK: "CAPTAIN, I COMPUTE THAT SUCH,41) + CALL CRAM(37H A TRIP WOULD REQUIRE APPROXIMATELY ,37) + CALL CRAMF(100.0*TIME/REMTIME,0,2) + CALL CRAMDMP(9H % OF OUR,9) + CALL PROMPT( + + 48H REMAINING TIME. ARE YOU SURE THIS IS WISE?" ,48) +C IF(JA(DUMMY)) GO TO 20 + IF(JA(1)) GO TO 20 + RETURN +C* + ENTRY WARPX +C* + 20 BLOOEY=0 + TWARP=0 + IF(WARPFAC .LE. 6.0) GO TO 50 +C--------DECIDE IF ENGINE DAMAGE WILL OCCUR + PROB=DIST*(6.0-WARPFAC)**2/66.666666666 + IF(PROB .GT. RANF(0)) BLOOEY=1 + IF(BLOOEY.NE.0) DIST=RANF(0)*DIST +C----------DECIDE IF TIME WARP WILL OCCUR + TWARP=0 + IF(WARPFAC .LT. 10.0) GO TO 40 + IF(0.5*DIST .GT. RANF(0)) TWARP=1 + 40 IF(BLOOEY .EQ. 0 .AND. TWARP .EQ. 0) GO TO 50 +C--------IF ENGINE DAMAGE OR TIME WARP SHOULD OCCUR, CHECK PATH + ANGLE=((15.0-DIREC)*0.5235998) + DELTAX=-SIN(ANGLE) + DELTAY=COS(ANGLE) + BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY)) + DELTAX=DELTAX/BIGGER + DELTAY=DELTAY/BIGGER + N=10.0*DIST*BIGGER+0.5 + X=SECTX + Y=SECTY + IF(N .EQ. 0) GO TO 50 + DO 45 L=1,N + X=X+DELTAX + IX=X+0.5 + IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 50 + Y=Y+DELTAY + IY=Y+0.5 + IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 50 + IF(QUAD(IX,IY) .EQ. IHDOT) GO TO 45 + BLOOEY=0 + TWARP=0 + 45 CONTINUE +C--------ACTIVATE WARP ENGINES AND PAY THE COST + 50 KSTUF(4)=0 + CALL MOVE + IF(ALLDONE.NE.0) RETURN + ENERGY=ENERGY - DIST*WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1) + IF(ENERGY .GT. 0) GO TO 55 + CALL FINISH(4) + RETURN + 55 IF(KSTUF(4).EQ.0) TIME=10.0*DIST/WFACSQ +C--------ENTER TIME WARP + IF(TWARP.NE.0) CALL TIMEWRP +C--------DAMAGE WARP ENGINES + IF(BLOOEY .EQ. 0) GO TO 60 + DAMAGE(6)=DAMFAC*(3.0*RANF(0)+1.0) + CALL SKIP(1) + CALL PROUT(24H"ENGINEERING TO BRIDGE--,24) + CALL PROUT(44H SCOTT HERE. THE WARP ENGINES ARE DAMAGED.,44) + CALL PROUT(41H WE'LL HAVE TO REDUCE SPEED TO WARP 4." ,41) + 60 IDIDIT=1 + RETURN +C--------NO WARP ENGINES + 90 CALL SKIP(1) + CALL PROUT(25HWARP ENGINES INOPERATIVE.,25) + RETURN + END + +END +DELETE F7:TRZAP +EDIT +BUILD F7:TRZAP + SUBROUTINE ZAP + INCLUDE F7:TREKCOM + INTEGER CDAM(5) + EQUIVALENCE (CRACKS(1),HIT),(CRACKS(3),IHURT),(CRACKS(4),L) + COMMON/CRAMBF/CRAMBUF + REAL*8 CRAMBUF(2) + PFAC=1.0/INSHLD + CHGFAC=1.0 + IF(SHLDCHG .EQ. 1) CHGFAC=0.25+0.50*RANF(0) + IF(SHLDUP .EQ. 0 .AND. SHLDCHG .EQ. 0) GO TO 10 + PROPOR=AMAX1(PFAC*SHLD,0.10) + HITSH=PROPOR*CHGFAC*HIT+1.0 + ABSORB=0.8*HITSH + IF(ABSORB .GT. SHLD) ABSORB=SHLD + SHLD=SHLD-ABSORB + IF(SHLD .LE. 0.0) SHLDUP=0 + HIT=HIT-HITSH + IF(PROPOR .GT. 0.1 .AND. HIT .LT. (0.005*ENERGY)) RETURN +C--------IT'S A HIT! PRINT OUT HIT SIZE + 10 IHURT=1 + CALL CRAMF(HIT,8,2) + CALL CRAM(9H UNIT HIT,9) + IF(L .EQ. 0) GO TO 15 + CALL CRAM(6H FROM ,6) + JX=KX(L) + JY=KY(L) +C CALL CRAMENA(QUAD(JX,JY),0,JX,JY) + CALL CRAMENA(QUAD(JX,JY)) + 15 CALL CREND +C--------DECIDE IF HIT IS CRITICAL + IF(HIT .LT. (275.0-25.0*SKILL)*(1.0+0.5*RANF(0))) GO TO 60 + NCRIT=1.0 + HIT/(500.0+100.0*RANF(0)) + CALL CRAM(17H***CRITICAL HIT--,17) +C--------SELECT DEVICE(S) AND CAUSE DAMAGE + KTR=1 + DO 50 LL=1,NCRIT + 20 J=NDEVICE*RANF(0)+1.0 + IF(DAMAGE(J) .LT. 0) GO TO 20 +C*--------CHEAT TO PREVENT DEATHRAY FROM BEING DAMAGED. + IF(J.EQ.14) GOTO 20 +C--------CHEAT TO PREVENT SHUTTLE DAMAGE UNLESS ON SHIP. + IF((J .EQ. 10) .AND. (ISCRAFT .NE. 1)) GO TO 20 + CDAM(LL)=J + EXTRADM=(HIT*DAMFAC)/(NCRIT*(75.0+25.0*RANF(0))) + DAMAGE(J)=DAMAGE(J)+EXTRADM + IF(LL .EQ. 1) GO TO 40 + DO 30 LLL=2,LL + IF(J .EQ. CDAM(LLL-1)) GO TO 50 + 30 CONTINUE + KTR=KTR+1 + IF(KTR .EQ. 3) CALL CREND + CALL CRAM(5H AND ,5) +C40 CALL CRAMS(DEVICE(1,J),16) + 40 CRAMBUF(1)=DEVICE(1,J) + CRAMBUF(2)=DEVICE(2,J) + CALL CRAMIT(DEVLEN(1,J)+DEVLEN(2,J)) + 50 CONTINUE + CALL CRAMDMP(9H DAMAGED.,9) +C--------PRINT MESSAGE IF SHIELDS WERE UP AND GOT KNOCKED DOWN + IF(DAMAGE(8) .EQ. 0) GO TO 60 + IF(SHLDUP.NE.0) CALL PROUT(24H***SHIELDS KNOCKED DOWN.,24) + SHLDUP=0 +C--------IF SUBSPACE RADIO GOT DAMAGED, REMEMBER THE FACT. + 60 IF(DAMAGE(9).GT.0)ISUBDAM=1 + ENERGY=ENERGY-HIT + RETURN + END + +END +DELETE TX:STARTRK +EDIT +BUILD TX:STARTRK + + + + + + + + + + + + SSSSSSS TTTTTTTT A RRRRRRR + SSSSSSSS TTTTTTTT AAA RRRRRRRR + SS TT AAA RR RR + SSSSSSS TT AA AA RR RR + SSSSSSS TT AA AA RRRRRRRR + SS TT AAAAAAA RRRRRRR + SS TT AAAAAAA RR RR + SSSSSSSS TT AA AA RR RR + SSSSSSS TT AA AA RR RR + + + + TTTTTTTT RRRRRRR EEEEEEEEE KK KK + TTTTTTTT RRRRRRRR EEEEEEEEE KK KK + TT RR RR EE KK KK + TT RR RR EEEEEE KKKKKK + TT RRRRRRRR EEEEEE KKKKK + TT RRRRRRR EE KK KK + TT RR RR EE KK KK + TT RR RR EEEEEEEEE KK KK + TT RR RR EEEEEEEEE KK KK + + + + PRODUCED FOR YOUR ENJOYMENT + + BY + + DAVID MATUSZEK + AND + PAUL REYNOLDS + + WITH MODIFICATIONS BY + DON SMITH + AND + M. KELLOGG + + + + + PERMISSION IS HEREBY GRANTED FOR THE COPYING, DISTRIBUTION, + MODIFICATION AND USE OF THIS PROGRAM AND ASSOCIATED DOCUMENTATION + FOR RECREATIONAL PURPOSES, PROVIDED THAT ALL REFERENCES TO THE + AUTHORS ARE RETAINED. HOWEVER, PERMISSION IS NOT AND WILL NOT BE + GRANTED FOR THE SALE OR PROMOTIONAL USE OF THIS PROGRAM OR PROGRAM + DOCUMENTATION, OR FOR USE IN ANY SITUATION IN WHICH PROFIT MAY BE + CONSIDERED AN OBJECTIVE, SINCE IT IS THE DESIRE OF THE AUTHORS TO + RESPECT THE COPYRIGHTS OF THE ORIGINATORS OF STAR TREK. +1 + + ----------TABLE OF CONTENTS---------- + + + + SECTION PAGE + + + INTRODUCTION TO THE GAME . . . . . . . . . . . . . . 1 + + HOW TO ISSUE COMMANDS. . . . . . . . . . . . . . . . 4 + + DESCRIPTIONS OF COMMANDS . . . . . . . . . . . . . . 5 + + SHORT-RANGE SCAN. . . . . . . . . . . . . . . . 5 + STATUS REPORT . . . . . . . . . . . . . . . . . 6 + LONG-RANGE SCAN . . . . . . . . . . . . . . . . 7 + STAR CHART. . . . . . . . . . . . . . . . . . . 8 + DAMAGE REPORT . . . . . . . . . . . . . . . . . 8 + MOVE UNDER WARP DRIVE . . . . . . . . . . . . . 8 + WARP FACTOR . . . . . . . . . . . . . . . . . . 10 + IMPULSE ENGINES . . . . . . . . . . . . . . . . 10 + DEFLECTOR SHIELDS . . . . . . . . . . . . . . . 11 + PHASERS . . . . . . . . . . . . . . . . . . . . 12 + PHOTON TORPEDOES. . . . . . . . . . . . . . . . 13 + DOCK AT STARBASE. . . . . . . . . . . . . . . . 14 + REST. . . . . . . . . . . . . . . . . . . . . . 14 + CALL STARBASE FOR HELP. . . . . . . . . . . . . 14 + ABANDON SHIP. . . . . . . . . . . . . . . . . . 15 + SELF-DESTRUCT . . . . . . . . . . . . . . . . . 15 + TERMINATE THE CURRENT GAME. . . . . . . . . . . 15 + SENSOR-SCAN . . . . . . . . . . . . . . . . . . 16 + ENTER STANDARD ORBIT. . . . . . . . . . . . . . 16 + TRANSPORTER-TRAVEL. . . . . . . . . . . . . . . 16 + SHUTTLE CRAFT . . . . . . . . . . . . . . . . . 17 + MINE DILITHIUM CRYSTALS . . . . . . . . . . . . 17 + LOAD DILITHIUM CRYSTALS . . . . . . . . . . . . 17 + PLANET REPORT . . . . . . . . . . . . . . . . . 18 + FREEZE. . . . . . . . . . . . . . . . . . . . . 18 + REQUEST . . . . . . . . . . . . . . . . . . . . 19 + EXPERIMENTAL DEATH RAY. . . . . . . . . . . . . 19 + EMERGENCY EXIT. . . . . . . . . . . . . . . . . 20 + GAME REPORT . . . . . . . . . . . . . . . . . . 20 + + MISCELLANEOUS NOTES. . . . . . . . . . . . . . . . . 21 + + SCORING. . . . . . . . . . . . . . . . . . . . . . . 22 + + MODIFICATIONS. . . . . . . . . . . . . . . . . . . . 23 + + HANDY REFERENCE PAGE . . . . . . . . . . . . . . . . 24 + + ACKNOWLEDGMENTS. . . . . . . . . . . . . . . . . . . 25 + + REFERENCES . . . . . . . . . . . . . . . . . . . . . 25 +1 + 1 + ----------INTRODUCTION TO THE GAME---------- + + + THE ORGANIAN PEACE TREATY HAS COLLAPSED, AND THE FEDERATION + IS AT WAR WITH THE KLINGON EMPIRE. JOINING THE KLINGONS AGAINST + THE FEDERATION ARE THE MEMBERS OF THE "ROMULAN STAR EMPIRE". AS + COMMANDER OF THE STARSHIP U. S. S. ENTERPRISE, YOUR JOB IS TO WIPE + OUT THE KLINGON INVASION FLEET AND MAKE THE GALAXY SAFE FOR + DEMOCRACY. + + YOUR BATTLEGROUND IS THE ENTIRE GALAXY, WHICH FOR CONVENIENCE + IS DIVIDED UP INTO EIGHT ROWS OF EIGHT QUADRANTS EACH, LIKE A + CHECKERBOARD. ROWS ARE NUMBERED FROM TOP TO BOTTOM, AND COLUMNS + ARE NUMBERED LEFT TO RIGHT, SO QUADRANT 1 - 8 WOULD BE IN THE + UPPER RIGHT HAND CORNER OF THE GALAXY. + + DURING BATTLE YOU WILL BE CONCERNED ONLY WITH THOSE ENEMIES + THAT OCCUPY THE SAME QUADRANT AS YOURSELF. QUADRANTS ARE DIVIDED + UP INTO SECTORS: TEN ROWS OF TEN SECTORS EACH. SECTORS ARE + NUMBERED IN THE SAME WAY AS QUADRANTS, SO THE SECTOR IN THE UPPER + RIGHT CORNER IS SECTOR 1 - 10. YOU HAVE A SHORT-RANGE SCANNER + WHICH ALLOWS YOU TO LOOK AT THE ENTIRE QUADRANT IN A SINGLE + DISPLAY. + + ENEMIES RECHARGE DURING YOUR ABSENCE. IF YOU LEAVE A QUADRANT + CONTAINING A WEAKENED ENEMY, WHEN YOU RETURN TO THAT QUADRANT HE + WILL BE STRONG AGAIN. ALSO, EACH TIME YOU ENTER A QUADRANT, THE + POSITIONS OF EVERYTHING IN THE QUADRANT (EXCEPT YOUR SHIP) ARE + RANDOMIZED, TO SAVE YOU THE TROUBLE OF TRYING TO REMEMBER WHERE + EVERYTHING IN THE QUADRANT IS. NOTICE THAT THIS REFERS ONLY TO + THE POSITIONS OF THINGS IN THE QUADRANT--THE NUMBERS OF EACH KIND + OF THING ARE NOT CHANGED. IF YOU KILL SOMETHING, IT STAYS DEAD. + + THE ROMULANS ARE NOT AS SERIOUS A THREAT TO THE FEDERATION + AS THE KLINGONS. FOR ONE THING, THERE ARE NOT AS MANY OF THEM. + FOR ANOTHER, THE ROMULANS ARE NOT AS TREACHEROUS. HOWEVER, ROMULANS + ARE NOT TO BE TRIFLED WITH, ESPECIALLY WHEN YOU ARE IN VIOLATION + OF THE "ROMULAN NEUTRAL ZONE". + + THERE ARE TWO KINDS OF KLINGONS: ORDINARY KLINGONS, WHICH + ARE BAD ENOUGH, AND KLINGON COMMANDERS, WHICH ARE EVEN WORSE. + COMMANDERS ARE ABOUT THREE TIMES STRONGER THAN ORDINARY KLINGONS. + COMMANDERS ARE MORE RESISTANT TO YOUR WEAPONS. COMMANDERS CAN + MOVE ABOUT DURING BATTLE, WHILE ORDINARY KLINGONS STAY PUT. AND + FINALLY, COMMANDERS HAVE A THING CALLED A "LONG-RANGE TRACTOR + BEAM" WHICH THEY CAN USE, AT RANDOM INTERVALS, TO YANK YOU AWAY + FROM WHAT YOU ARE DOING AND INTO THEIR QUADRANT, TO DO BATTLE WITH + THEM. THERE IS ALSO A SPECIAL COMMANDER, CALLED THE "SUPER-COMMANDER". + THIS CHARACTER IS SO BAD, HE IS RESERVED FOR THE GOOD, EXPERT AND + EMERITUS GAMES. FORTUNATELY, THERE IS JUST ONE "SUPER-COMMANDER" + IN A GAME. IN ADDITION TO THE UNDESIRABLE TRAITS OF COMMANDERS, HE + CAN MOVE FROM QUADRANT TO QUADRANT AT WILL, SEEKING OUT AND DESTROYING + YOUR STARBASES, AND ANY HELPFUL PLANETS HE RUNS ACROSS. HE ALSO HAS + A SPY PLANTED ABOARD YOUR SHIP, GIVING HIM VALUABLE INFORMATION + ABOUT YOUR CONDITION. USING THIS INFORMATION, HE CAN DO DASTARDLY + THINGS LIKE TRACTOR BEAM YOUR SHIP WHEN YOU ARE IN BAD SHAPE. AND + ONCE YOU'VE BEEN TRACTOR BEAMED BY THE "SUPER-COMMANDER" - - - +1 + 2 + BUT THE ADVANTAGES ARE NOT ALL ON THE SIDE OF THE ENEMY. + YOUR SHIP IS MORE POWERFUL, AND HAS BETTER WEAPONS. BESIDES, + IN THIS GALAXY THERE ARE FROM TWO TO FIVE STARBASES, AT WHICH + YOU CAN STOP TO REFUEL AND LICK YOUR WOUNDS, SAFE FROM ATTACK + OR TRACTOR BEAMS. BUT YOU HAD BEST NOT DALLY THERE TOO LONG, + SINCE TIME IS NOT ON YOUR SIDE. THE KLINGONS ARE NOT JUST AFTER + YOU; THEY ARE ATTACKING THE ENTIRE FEDERATION. THERE IS ALWAYS + A FINITE "TIME LEFT", WHICH IS HOW MUCH LONGER THE FEDERATION CAN + HOLD OUT IF YOU JUST SIT ON YOUR FAT BEHIND AND DO NOTHING. AS + YOU WIPE OUT KLINGONS, YOU REDUCE THE RATE AT WHICH THE INVASION + FLEET WEAKENS THE FEDERATION, AND SO THE "TIME LEFT" UNTIL + THE FEDERATION COLLAPSES MAY ACTUALLY INCREASE. SINCE KLINGONS + ARE THE MAIN THREAT TO THE FEDERATION, THE ROMULANS DO NOT FIGURE + INTO THE "TIME LEFT". IN FACT, YOU NEED NOT KILL ALL THE ROMULANS + TO WIN. IF YOU CAN GET ALL THE KLINGONS, THE FEDERATION WILL + ABIDE FOREVER, AND YOU HAVE WON THE GAME. + + SPACE IS VAST, AND IT TAKES PRECIOUS TIME TO MOVE FROM ONE + PLACE TO ANOTHER. IN COMPARISON, OTHER THINGS HAPPEN SO QUICKLY + THAT WE ASSUME THEY TAKE NO TIME AT ALL. TWO WAYS THAT TIME + CAN PASS ARE WHEN YOU MOVE, OR WHEN YOU ISSUE A COMMAND TO SIT + STILL AND REST FOR A PERIOD OF TIME. YOU WILL SOMETIMES WANT + TO DO THE LATTER, SINCE THE VARIOUS DEVICES ABOARD YOUR STARSHIP + MAY BE DAMAGED AND REQUIRE TIME TO REPAIR. OF COURSE, REPAIRS + CAN BE MADE MORE QUICKLY AT A STARBASE THAN THEY CAN IN FLIGHT. + + IN ADDITION TO KLINGONS, ROMULANS AND STARBASES, THE GALAXY + CONTAINS (SURPRISE) STARS. MOSTLY, STARS ARE A NUISANCE AND + JUST GET IN YOUR WAY. YOU CAN TRIGGER A STAR INTO GOING NOVA + BY SHOOTING ONE OF YOUR PHOTON TORPEDOES AT IT. WHEN A STAR + NOVAS, IT DOES A LOT OF DAMAGE TO ANYTHING IMMEDIATELY ADJACENT + TO IT. IF ANOTHER STAR IS ADJACENT TO A NOVA, IT TOO WILL GO + NOVA. STARS MAY ALSO OCCASIONALLY GO SUPERNOVA; A SUPERNOVA + IN A QUADRANT DESTROYS EVERYTHING IN THE QUADRANT AND MAKES + THE QUADRANT PERMANENTLY UNINHABITABLE. YOU MAY "JUMP OVER" A + QUADRANT CONTAINING A SUPERNOVA WHEN YOU MOVE, BUT YOU SHOULD + NOT STOP THERE. + + SUPERNOVAS MAY HAPPEN SPONTANEOUSLY, WITHOUT PROVOCATION. IF + A SUPERNOVA OCCURS IN THE SAME QUADRANT YOU ARE IN, YOUR STARSHIP + HAS AN "EMERGENCY AUTOMATIC OVERRIDE" WHICH PICKS SOME RANDOM + DIRECTION AND SOME RANDOM WARP FACTOR, AND TRIES TO THROW YOU + CLEAR OF THE SUPERNOVA. IF THE SUPERNOVA OCCURS IN SOME OTHER + QUADRANT, YOU JUST GET A WARNING MESSAGE FROM STARFLEET ABOUT IT + (PROVIDED, OF COURSE, THAT YOUR SUBSPACE RADIO IS WORKING). + + ALSO A FEW PLANETS ARE SCATTERED THROUGH THE GALAXY. THESE + CAN SOMETIMES BE A GREAT HELP SINCE SOME OF THEM WILL HAVE + "DILITHIUM CRYSTALS", WHICH ARE CAPABLE OF REPLENISHING THE + SHIP'S ENERGY SUPPLY. YOU CAN EITHER BEAM DOWN TO THE PLANET + SURFACE USING THE TRANSPORTER, OR TAKE THE SHUTTLE CRAFT "GALILEO". +1 + 3 + STAR TREK IS A RICH GAME, FULL OF DETAIL. THESE INSTRUCTIONS + ARE WRITTEN AT A MODERATE LEVEL--NO ATTEMPT HAS BEEN MADE FULLY + TO DESCRIBE EVERYTHING ABOUT THE GAME, BUT THERE IS QUITE A BIT + MORE HERE THAN YOU NEED TO GET STARTED. IF YOU ARE NEW TO THE + GAME, JUST GET A ROUGH IDEA OF THE KINDS OF COMMANDS AVAILABLE, + AND START PLAYING. AFTER A GAME OR TWO YOU WILL HAVE LEARNED + EVERYTHING IMPORTANT, AND THE DETAILED COMMAND DESCRIPTIONS WHICH + FOLLOW WILL BE A LOT MORE MEANINGFUL TO YOU. + + YOU HAVE WEAPONS: PHASERS AND PHOTON TORPEDOES. YOU HAVE + A DEFENSE: DEFLECTOR SHIELDS. YOU CAN LOOK AT THINGS: LONG- + RANGE SCANNERS, SHORT-RANGE SCANNERS, AND A STAR CHART. YOU CAN + MOVE ABOUT, UNDER WARP DRIVE OR IMPULSE POWER. YOU CAN ALSO + DOCK AT A STARBASE, REST WHILE REPAIRS ARE BEING MADE, ABANDON + SHIP, SELF DESTRUCT, OR GIVE UP AND START A NEW GAME. + + THE KLINGONS ARE WAITING. +1 + 4 + + ----------HOW TO ISSUE COMMANDS---------- + + + WHEN THE GAME IS WAITING FOR YOU TO ENTER A COMMAND, IT WILL + PRINT OUT + COMMAND: + YOU MAY THEN TYPE IN YOUR COMMAND. ALL YOU HAVE TO REMEMBER FOR + EACH COMMAND IS THE MNEMONIC. FOR EXAMPLE, IF YOU WANT TO MOVE + STRAIGHT UP FOR ONE QUADRANT, YOU CAN TYPE IN THE MNEMONIC + MOVE + AND THE COMPUTER WILL PROMPT YOU WITH + MANUAL OR AUTOMATIC? + SAY YOU TYPE IN "MANUAL". THE COMPUTER THEN RESPONDS + X AND Y DISPLACEMENTS: + NOW YOU TYPE IN 0 1 WHICH SPECIFIES AN X MOVEMENT OF ZERO AND + A Y MOVEMENT OF 1. + + WHEN YOU HAVE LEARNED THE COMMANDS, YOU CAN AVOID BEING + PROMPTED BY SIMPLY TYPING IN THE INFORMATION WITHOUT WAITING + TO BE ASKED FOR IT. FOR EXAMPLE, IN THE ABOVE EXAMPLE, YOU + COULD SIMPLY TYPE IN + MOVE MANUAL 0 1 + AND IT WILL BE DONE. OR YOU COULD TYPE IN + MOVE MANUAL + AND WHEN THE COMPUTER RESPONDS WITH + X AND Y DISPLACEMENTS: + YOU CAN TYPE IN + 0 1 + AND IT WILL UNDERSTAND. + + YOU CAN ABBREVIATE MOST MNEMONICS. FOR "MOVE", YOU CAN USE + ANY OF + MOVE MOV MO M + SUCCESSFULLY. FOR YOUR SAFETY, CERTAIN CRITICAL COMMANDS (SUCH + AS TO ABANDON SHIP) MUST BE WRITTEN OUT IN FULL. ALSO, IN A + FEW CASES TWO OR MORE COMMANDS BEGIN WITH THE SAME LETTER, AND + IN THIS CASE THAT LETTER REFERS TO A PARTICULAR ONE OF THE + COMMANDS; TO GET THE OTHER, YOUR ABBREVIATION MUST BE TWO OR + MORE LETTERS LONG. THIS SOUNDS COMPLICATED, BUT YOU WILL LEARN + THE ABBREVIATIONS QUICKLY ENOUGH. + + WHAT THIS ALL BOILS DOWN TO IS: + (1) YOU CAN ABBREVIATE PRACTICALLY ANYTHING, + (2) IF YOU FORGET, THE COMPUTER WILL PROMPT YOU, + (3) IF YOU REMEMBER, YOU CAN TYPE IT ALL ON ONE LINE. + + IF YOU ARE PART WAY THROUGH ENTERING A COMMAND AND YOU CHANGE + YOUR MIND, YOU CAN CANCEL THE COMMAND BY TYPING A -1 AS ONE OF THE + PARAMETERS. + + IF ANYTHING IS NOT CLEAR TO YOU, EXPERIMENT. THE WORST YOU CAN + DO IS LOSE A GAME OR TWO. +1 + 5 + ----------DESCRIPTIONS OF COMMANDS---------- + + + + ******************** + * SHORT-RANGE SCAN * + ******************** + + MNEMONIC: SRSCAN + SHORTEST ABBREVIATION: S + FULL COMMANDS: SRSCAN + SRSCAN NO + + THE SHORT-RANGE SCAN GIVES YOU A CONSIDERABLE AMOUNT OF + INFORMATION ABOUT THE QUADRANT YOUR STARSHIP IS IN. A SHORT- + RANGE SCAN IS BEST DESCRIBED BY AN EXAMPLE. + + 1 2 3 4 5 6 7 8 9 10 + 1 * . . . . R . . . . STARDATE 2516.3 + 2 . . . E . . . . . . CONDITION RED + 3 . . . . . * . B . . POSITION 5 - 1, 2 - 4 + 4 . . . S . . . . . . LIFE SUPPORT DAMAGED, RESERVES=2.3 + 5 . . . . . . . K . . WARP FACTOR 5.0 + 6 . K . @ . . . . * . ENERGY 2176.25 + 7 . . . . . P . . . . TORPEDOES 3 + 8 . . . . * . . . . . SHIELDS UP, 42 PERCENT 1050 UNITS + 9 . * . . * . . . C . KLINGONS LEFT 12 + 10 . . . . . . . . . . TIME LEFT 3.72 + + THE LEFT PART IS A PICTURE OF THE QUADRANT. THE E AT SECTOR + 2 - 4 REPRESENTS THE ENTERPRISE; THE B AT SECTOR 3 - 8 IS A STARBASE. + THERE ARE ORDINARY KLINGONS (K) AT SECTORS 5 - 8 AND 6 - 2, AND A + KLINGON COMMANDER (C) AT 9 - 9. THE (GULP) "SUPER-COMMANDER" (S) + OCCUPIES SECTOR 4 - 4, AND A ROMULAN (R) IS AT 1 - 6. A PLANET (P) + IS AT SECTOR 7 - 6. THERE ARE ALSO A LARGE NUMBER OF STARS (*). + THE PERIODS (.) ARE JUST EMPTY SPACE--THEY ARE PRINTED TO HELP + YOU GET YOUR BEARINGS. SECTOR 6 - 4 CONTAINS A BLACK HOLE (@). + + THE INFORMATION ON THE RIGHT IS ASSORTED STATUS INFORMATION. + THE STATUS INFORMATION WILL BE ABSENT IF YOU TYPE AFTER + SRSCAN. OTHERWISE, STATUS INFORMATION WILL BE PRESENTED. + + SHORT-RANGE SCANS ARE FREE. THAT IS, THEY USE UP NO ENERGY + AND NO TIME. IF YOU ARE IN BATTLE, DOING A SHORT-RANGE SCAN DOES + NOT GIVE THE ENEMIES ANOTHER CHANCE TO HIT YOU. YOU CAN SAFELY + DO A SHORT-RANGE SCAN ANYTIME YOU LIKE. + + STARBASES ALSO HAVE SHORT RANGE SENSORS. IF YOU ARE DOCKED + AT A STARBASE AND YOUR SHORT RANGE SENSORS ARE DAMAGED, YOU + MAY USE THE ONES AT THE STARBASE BY USING THE COMMAND. + +1 + 6 + + ***************** + * STATUS REPORT * + ***************** + + MNEMONIC: STATUS + SHORTEST ABBREVIATION: ST + + THIS COMMAND GIVES YOU INFORMATION ABOUT THE CURRENT STATE OF + YOUR STARSHIP, AS FOLLOWS: + + STARDATE - THE CURRENT DATE. A STARDATE IS THE SAME AS A DAY. + + CONDITION - THERE ARE FOUR POSSIBLE CONDITIONS: + DOCKED - DOCKED AT STARBASE. + RED - IN BATTLE. + YELLOW - LOW ON ENERGY ( < 1000 UNITS). + GREEN - NONE OF THE ABOVE. + + POSITION - QUADRANT IS GIVEN FIRST, THEN SECTOR. + + LIFE SUPPORT - IF "ACTIVE", LIFE SUPPORT SYSTEMS ARE + FUNCTIONING NORMALLY. IF ON "RESERVES", THE NUMBER + IS HOW MANY STARDATES YOUR RESERVE FOOD, AIR, ETC. WILL + LAST--YOU MUST GET REPAIRS MADE OR GET TO STARBASE + BEFORE YOUR RESERVES RUN OUT. + + WARP FACTOR - WHAT YOUR WARP FACTOR IS CURRENTLY SET TO. + + ENERGY - THE AMOUNT OF ENERGY YOU HAVE LEFT. IF IT DROPS TO + ZERO, YOU DIE. + + TORPEDOES - HOW MANY PHOTON TORPEDOES YOU HAVE LEFT. + + SHIELDS - WHETHER YOUR SHIELDS ARE UP OR DOWN, HOW STRONG + THEY ARE (WHAT PERCENT OF A HIT THEY CAN DEFLECT), AND + SHIELD ENERGY. + + KLINGONS LEFT - HOW MANY OF THE KLINGONS ARE STILL OUT THERE. + + TIME LEFT - HOW LONG THE FEDERATION CAN HOLD OUT AGAINST THE + PRESENT NUMBER OF KLINGONS; THAT IS, HOW LONG UNTIL THE + END IF YOU DO NOTHING IN THE MEANTIME. IF YOU KILL KLINGONS + QUICKLY, THIS NUMBER WILL GO UP--IF NOT, IT WILL GO DOWN. + IF IT REACHES ZERO, THE FEDERATION IS CONQUERED, AND YOU + LOSE. + + STATUS INFORMATION IS FREE--IT USES NO TIME OR ENERGY, AND IF + YOU ARE IN BATTLE, THE KLINGONS ARE NOT GIVEN ANOTHER CHANCE TO HIT + YOU. + + STATUS INFORMATION CAN ALSO BE OBTAINED BY DOING A SHORT-RANGE + SCAN. SEE THE COMMAND FOR DETAILS. + + EACH ITEM OF INFORMATION CAN BE OBTAINED SINGLY BY REQUESTING + IT. SEE COMMAND FOR DETAILS. +1 + 7 + + + ******************* + * LONG-RANGE SCAN * + ******************* + + MNEMONIC: LRSCAN + SHORTEST ABBREVIATION: L + + A LONG-RANGE SCAN GIVES YOU GENERAL INFORMATION ABOUT WHERE YOU + ARE AND WHAT IS AROUND YOU. HERE IS AN EXAMPLE OUTPUT. + + L. R. SCAN FOR QUADRANT 5 - 1 + -1 107 103 + -1 316 5 + -1 105 1000 + + THIS SCAN SAYS THAT YOU ARE IN ROW 5, COLUMN 1 OF THE 8 BY 8 + GALAXY. THE NUMBERS IN THE SCAN INDICATE HOW MANY OF EACH + KIND OF THING THERE IS IN YOUR QUADRANT AND ALL ADJACENT + QUADRANTS. THE DIGITS ARE INTERPRETED AS FOLLOWS. + + THOUSANDS DIGIT: 1000 INDICATES A SUPERNOVA (ONLY) + HUNDREDS DIGIT: NUMBER OF KLINGONS PRESENT + TENS DIGIT: NUMBER OF STARBASES PRESENT + ONES DIGIT: NUMBER OF STARS PRESENT + + FOR EXAMPLE, IN YOUR QUADRANT (5 - 1) THE NUMBER IS 316, WHICH + INDICATES 3 KLINGONS, 1 STARBASE AND 6 STARS. (THE LONG-RANGE + SCANNER DOES NOT DISTINGUISH BETWEEN ORDINARY KLINGONS AND + KLINGON COMMAND SHIPS.) IF THERE IS A SUPERNOVA, AS IN THE + QUADRANT BELOW AND TO YOUR RIGHT (QUADRANT 6 - 2), THERE IS + NOTHING ELSE IN THE QUADRANT. + + ROMULANS POSSESS A "CLOAKING DEVICE" WHICH PREVENTS THEIR + DETECTION BY LONG-RANGE SCAN. BECAUSE OF THIS FACT, STARFLEET + COMMAND IS NEVER SURE HOW MANY ROMULANS ARE "OUT THERE". + WHEN YOU KILL THE LAST KLINGON, THE REMAINING ROMULANS SURRENDER + TO THE FEDERATION. + + PLANETS ARE ALSO UNDETECTABLE BY LONG-RANGE SCAN. THE + ONLY WAY TO DETECT A PLANET IS TO FIND IT IN YOUR CURRENT + QUADRANT WITH SHORT-RANGE SENSORS. + + SINCE YOU ARE IN COLUMN 1, THERE ARE NO QUADRANTS TO YOUR + LEFT. THE MINUS ONES INDICATE THE NEGATIVE ENERGY BARRIER AT + THE EDGE OF THE GALAXY, WHICH YOU ARE NOT PERMITTED TO CROSS. + + LONG-RANGE SCANS ARE FREE. THEY USE UP NO ENERGY OR TIME, + AND CAN BE DONE SAFELY REGARDLESS OF BATTLE CONDITIONS. + + STARBASES ALSO HAVE L.R. SENSORS. IF YOU ARE DOCKED AND YOUR + LONG-RANGE SENSORS ARE DAMAGED, YOU MAY USE THE ONES AT STARBASE + BY USING THE COMMAND. +1 + 8 + ************** + * STAR CHART * + ************** + + MNEMONIC: CHART + SHORTEST ABBREVIATION: C + + AS YOU PROCEED IN THE GAME, YOU LEARN MORE AND MORE ABOUT + WHAT THINGS ARE WHERE IN THE GALAXY. THIS INFORMATION IS + AUTOMATICALLY RECORDED FOR YOU (BY SPOCK) IN YOUR STAR CHART. + + THE CHART LOOKS LIKE AN 8 BY 8 ARRAY OF NUMBERS. THESE + NUMBERS ARE INTERPRETED EXACTLY AS THEY ARE ON A LONG-RANGE + SCAN. A PERIOD (.) IN PLACE OF A DIGIT MEANS YOU DO NOT KNOW + THAT INFORMATION YET. FOR EXAMPLE, ... MEANS YOU KNOW NOTHING + ABOUT THE QUADRANT, WHILE .1. MEANS YOU KNOW THAT IT CONTAINS + A BASE, BUT AN UNKNOWN NUMBER OF KLINGONS AND STARS. + + LOOKING AT THE STAR CHART IS A FREE OPERATION. IT COSTS + YOU NEITHER TIME NOR ENERGY, AND CAN BE DONE SAFELY WHETHER + IN OR OUT OF BATTLE. + + + ***************** + * DAMAGE REPORT * + ***************** + + MNEMONIC: DAMAGES + SHORTEST ABBREVIATION: DA + + AT ANY TIME YOU MAY ASK FOR A DAMAGE REPORT TO FIND OUT WHAT + DEVICES ARE DAMAGED AND HOW LONG IT WILL TAKE TO REPAIR THEM. + NATURALLY, REPAIRS PROCEED FASTER AT A STARBASE. + + IF YOU SUFFER DAMAGES WHILE MOVING, IT IS POSSIBLE THAT A + SUBSEQUENT DAMAGE REPORT WILL NOT SHOW ANY DAMAGE. THIS HAPPENS + IF THE TIME SPENT ON THE MOVE EXCEEDS THE REPAIR TIME, SINCE IN + THIS CASE THE DAMAGED DEVICES WERE FIXED EN ROUTE. + + DAMAGE REPORTS ARE FREE. THEY USE NO ENERGY OR TIME, AND CAN + BE DONE SAFELY EVEN IN THE MIDST OF BATTLE. + + + ************************* + * MOVE UNDER WARP DRIVE * + ************************* + + MNEMONIC: MOVE + SHORTEST ABBREVIATION: M + FULL COMMAND: MOVE + MOVE + + THIS COMMAND IS THE USUAL WAY TO MOVE FROM ONE PLACE TO + ANOTHER WITHIN THE GALAXY. YOU MOVE UNDER WARP DRIVE, ACCORDING + TO THE CURRENT WARP FACTOR (SEE "WARP FACTOR"). +1 + 9 + THERE ARE TWO COMMAND MODES FOR MOVEMENT; MANUAL AND AUTOMATIC. + THE MANUAL MODE IS DEFAULT, AND REQUIRES THE FOLLOWING FORMAT: + + MOVE + + IS OPTIONAL. IF OMITTED, MANUAL MOVEMENT IS ASSUMED. + AND ARE THE HORIZONTAL AND VERTICAL DISPLACEMENTS FOR + YOUR STARSHIP, IN QUADRANTS; A DISPLACEMENT OF ONE SECTOR IS 0.1 + QUADRANTS. SPECIFYING AND CAUSES YOUR SHIP TO MOVE + IN A STRAIGHT LINE TO THE SPECIFIED DESTINATION. FOR EXAMPLE, + THE SHORTEST POSSIBLE COMMAND TO MOVE 1 SECTOR TO THE RIGHT WOULD BE + + M .1 0 + + THE FOLLOWING EXAMPLES OF MANUAL MOVEMENT REFER TO THE + SHORT-RANGE SCAN ON PAGE 5. + + DESTINATION SECTOR MANUAL MOVEMENT COMMAND + + 3 - 1 M -.3 -.1 + 2 - 1 M -.3 0 + 1 - 2 M -.2 .1 + 1 - 4 M 0 .1 + (LEAVING QUADRANT) M 0 .2 + 1 - 5 M .1 .1 + 2 - 10 M .6 0 + 5 - 6 M .2 -.3 + 3 - 4 M 0 -.1 + + THE AUTOMATIC MODE IS AS FOLLOWS: + + MOVE + + WHERE AND ARE THE ROW AND COLUMN NUMBERS OF THE + DESTINATION QUADRANT, AND AND ARE THE ROW AND + COLUMN NUMBERS OF THE DESTINATION SECTOR WITHIN THAT QUADRANT. + THIS COMMAND ALSO MOVES YOUR SHIP IN A STRAIGHT LINE PATH TO + THE DESTINATION. (A IS SUFFICIENT) MUST BE PRESENT. + FOR MOVING WITHIN A QUADRANT, AND MAY BE OMITTED. + FOR EXAMPLE, TO MOVE TO SECTOR 2 - 9 WITHIN THE CURRENT QUADRANT, + THE SHORTEST COMMAND WOULD BE + + M A 2 9 + + TO MOVE TO QUADRANT 3 - 7, SECTOR 5 - 8, TYPE + + M A 3 7 5 8 + + AND IT WILL BE DONE. IN AUTOMATIC MODE, EITHER TWO OR FOUR NUMBERS + MUST BE SUPPLIED. + + AUTOMATIC MODE UTILIZES THE SHIP'S "BATTLE COMPUTER". IF + THE COMPUTER IS DAMAGED, MANUAL MOVEMENT MUST BE USED. +1 + 10 + IT USES TIME AND ENERGY TO MOVE. HOW MUCH TIME AND HOW MUCH + ENERGY DEPENDS ON YOUR CURRENT WARP FACTOR, THE DISTANCE YOU MOVE, + AND WHETHER YOUR SHIELDS ARE UP. THE HIGHER THE WARP FACTOR, THE + FASTER YOU MOVE, BUT HIGHER WARP FACTORS REQUIRE MORE ENERGY. + YOU MAY MOVE WITH YOUR SHIELDS UP, BUT THIS DOUBLES THE ENERGY + REQUIRED. + + EACH TIME YOU MOVE IN A QUADRANT CONTAINING KLINGONS, THEY + HAVE A CHANCE TO ATTACK YOU. IN THIS CASE, THE "ENERGY LEFT" + MESSAGE YOU GET REFERS TO YOUR ENERGY AFTER THE ATTACK BUT BEFORE + THE MOVE. AS YOU MOVE, THE AMOUNT THAT THE KLINGONS HIT YOU WITH + IS DEPENDENT ON YOUR AVERAGE DISTANCE FROM THEM. + + *************** + * WARP FACTOR * + *************** + + MNEMONIC: WARP + SHORTEST ABBREVIATION: W + FULL COMMAND: WARP + + YOUR WARP FACTOR CONTROLS THE SPEED OF YOUR STARSHIP. THE + LARGER THE WARP FACTOR, THE FASTER YOU GO AND THE MORE ENERGY + YOU USE. + + YOUR MINIMUM WARP FACTOR IS 1.0 AND YOUR MAXIMUM WARP FACTOR + IS 10.0 (WHICH IS 100 TIMES AS FAST AND USES 1000 TIMES AS MUCH + ENERGY). AT SPEEDS ABOVE WARP 6 THERE IS SOME DANGER OF CAUSING + DAMAGE TO YOUR WARP ENGINES; THIS DAMAGE IS LARGER AT HIGHER + WARP FACTORS AND ALSO DEPENDS ON HOW FAR YOU GO AT THAT WARP + FACTOR. + + AT EXACTLY WARP 10 THERE IS SOME PROBABILITY OF ENTERING A + SO-CALLED "TIME WARP" AND BEING THROWN FORWARD OR BACKWARD IN + TIME. THE FARTHER YOU GO AT WARP 10, THE GREATER IS THE PROBABILITY + OF ENTERING THE TIME WARP. + + ******************* + * IMPULSE ENGINES * + ******************* + + MNEMONIC: IMPULSE + SHORTEST ABBREVIATION: I + FULL COMMAND: IMPULSE + + THE IMPULSE ENGINES GIVE YOU A WAY TO MOVE WHEN YOUR WARP + ENGINES ARE DAMAGED. THEY MOVE YOU AT A SPEED OF 0.95 SECTORS + PER STARDATE, WHICH IS THE EQUIVALENT OF A WARP FACTOR OF ABOUT + 0.975, SO THEY ARE MUCH TOO SLOW TO USE EXCEPT IN EMERGENCIES. + + MOVEMENT COMMANDS ARE INDICATED JUST AS IN THE "MOVE" COMMAND. + + THE IMPULSE ENGINES REQUIRE 20 UNITS OF ENERGY TO ENGAGE, + PLUS 10 UNITS PER SECTOR (100 UNITS PER QUADRANT) TRAVELLED. + IT DOES NOT COST EXTRA TO MOVE WITH THE SHIELDS UP. +1 + 11 + ********************* + * DEFLECTOR SHIELDS * + ********************* + + MNEMONIC: SHIELDS + SHORTEST ABBREVIATION: SH + FULL COMMANDS: SHIELDS UP + SHIELDS DOWN + SHIELDS TRANSFER + + YOUR DEFLECTOR SHIELDS ARE A DEFENSIVE DEVICE TO PROTECT YOU + FROM KLINGON ATTACKS (AND NEARBY NOVAS). AS THE SHIELDS PROTECT + YOU, THEY GRADUALLY WEAKEN. A SHIELD STRENGTH OF 75 PERCENT, FOR + EXAMPLE, MEANS THAT THE NEXT TIME A KLINGON HITS YOU, YOUR SHIELDS + WILL DEFLECT 75 PERCENT OF THE HIT, AND LET 25 PERCENT GET THROUGH + TO HURT YOU. + + IT COSTS 50 UNITS OF ENERGY TO RAISE SHIELDS, NOTHING TO LOWER + THEM. YOU MAY MOVE WITH YOUR SHIELDS UP; THIS COSTS NOTHING EXTRA + UNDER IMPULSE POWER, BUT DOUBLES THE ENERGY REQUIRED FOR WARP DRIVE. + + EACH TIME YOU RAISE OR LOWER YOUR SHIELDS, THE KLINGONS HAVE + ANOTHER CHANCE TO ATTACK. SINCE SHIELDS DO NOT RAISE AND LOWER + INSTANTANEOUSLY, THE HITS YOU RECEIVE WILL BE INTERMEDIATE BETWEEN + WHAT THEY WOULD BE IF THE SHIELDS WERE COMPLETELY UP OR COMPLETELY DOWN. + + YOU MAY NOT FIRE PHASERS THROUGH YOUR SHIELDS. HOWEVER, + YOU MAY USE THE "HIGH-SPEED SHIELD CONTROL" TO LOWER SHIELDS, + FIRE PHASERS, AND RAISE THE SHIELDS AGAIN BEFORE THE KLINGONS CAN + REACT. SINCE RAPID LOWERING AND RAISING OF THE SHIELDS REQUIRES + MORE ENERGY THAN NORMAL SPEED OPERATION, IT COSTS YOU 200 UNITS OF + ENERGY TO ACTIVATE THIS CONTROL. IT IS AUTOMATICALLY ACTIVATED WHEN + YOU FIRE PHASERS WHILE SHIELDS ARE UP. YOU MAY FIRE PHOTON TORPEDOES, + BUT THEY MAY BE DEFLECTED CONSIDERABLY FROM THEIR INTENDED COURSE + AS THEY PASS THROUGH THE SHIELDS (DEPENDING ON SHIELD STRENGTH). + + YOU MAY TRANSFER ENERGY BETWEEN THE SHIP'S ENERGY (GIVEN AS + IN STATUS) AND THE SHIELDS. MAY BE ABBREVIATED + . IS THE NUMBER OF UNITS OF + ENERGY YOU WISH TO TAKE FROM THE SHIP'S ENERGY AND PUT INTO THE + SHIELDS. IF YOU SPECIFY A NEGATIVE NUMBER, ENERGY IS DRAINED + FROM THE SHIELDS TO THE SHIP. TRANSFERRING ENERGY CONSTITUTES A + TURN. IF YOU TRANSFER ENERGY TO THE SHIELDS WHILE UNDER ATTACK, + THEY WILL BE AT THE NEW ENERGY LEVEL WHEN YOU ARE NEXT HIT. +1 + 12 + *********** + * PHASERS * + *********** + + MNEMONIC: PHASERS + SHORTEST ABBREVIATION: P + FULL COMMANDS: PHASERS AUTOMATIC + PHASERS + PHASERS MANUAL ... + + PHASERS ARE ENERGY WEAPONS. AS YOU FIRE PHASERS AT KLINGONS, + YOU SPECIFY AN WHICH IS DRAWN FROM YOUR ENERGY + RESERVES. THE AMOUNT OF TOTAL HIT REQUIRED TO KILL AN ENEMY IS + PARTLY RANDOM, BUT ALSO DEPENDS ON SKILL LEVEL. + + THE AVERAGE HIT REQUIRED TO KILL AN ORDINARY KLINGON VARIES + FROM 200 UNITS IN THE NOVICE GAME TO 250 UNITS IN THE EMERITUS + GAME. COMMANDERS NORMALLY REQUIRE FROM 600 (NOVICE) TO 700 + (EMERITUS). THE "SUPER-COMMANDER" REQUIRES FROM 875 (GOOD) + TO 1000 (EMERITUS). ROMULANS REQUIRE AN AVERAGE OF 350 (NOVICE) + TO 450 (EMERITUS). + + HITS ON ENEMIES ARE CUMULATIVE, AS LONG AS YOU DO NOT LEAVE + THE QUADRANT. + + IN GENERAL, NOT ALL THAT YOU FIRE WILL REACH THE KLINGONS. + THE FARTHER AWAY THEY ARE, THE LESS PHASER ENERGY WILL REACH THEM. + IF A KLINGON IS ADJACENT TO YOU, HE WILL RECEIVE ABOUT 90 PERCENT + OF THE PHASER ENERGY DIRECTED AT HIM; A KLINGON 5 SECTORS AWAY + WILL RECEIVE ABOUT 60 PERCENT, AND A KLINGON 10 SECTORS AWAY WILL + RECEIVE ABOUT 35 PERCENT. THERE IS SOME RANDOMNESS INVOLVED, SO + THESE FIGURES ARE NOT EXACT. PHASERS HAVE NO EFFECT BEYOND THE + BOUNDARIES OF THE QUADRANT YOU ARE IN. + + PHASERS MAY OVERHEAT (AND BE DAMAGED) IF YOU FIRE TOO LARGE + A BURST AT ONCE. FIRING UP TO 1500 UNITS IS SAFE. FROM 1500 + ON UP, THE PROBABILITY OF OVERHEAT INCREASES WITH THE AMOUNT FIRED. + + IF PHASER FIRING IS AUTOMATIC, THE COMPUTER DECIDES HOW TO + DIVIDE UP YOUR AMONG THE KLINGONS PRESENT. IF + PHASER FIRING IS MANUAL, YOU SPECIFY HOW MUCH ENERGY TO FIRE AT + EACH KLINGON PRESENT (NEAREST FIRST), RATHER THAN JUST SPECIFYING + A TOTAL AMOUNT. YOU CAN ABBREVIATE "MANUAL" AND "AUTOMATIC" TO + ONE OR MORE LETTERS; IF YOU MENTION NEITHER, AUTOMATIC FIRING IS + USUALLY ASSUMED. + + A SAFETY INTERLOCK PREVENTS PHASERS FROM BEING FIRED THROUGH + THE SHIELDS. IF THIS WERE NOT SO, THE SHIELDS WOULD CONTAIN + YOUR FIRE AND YOU WOULD FRY YOURSELF. HOWEVER, YOU MAY UTILIZE + THE "HIGH-SPEED SHIELD CONTROL" TO DROP SHIELDS, FIRE PHASERS, + AND RAISE SHIELDS BEFORE THE ENEMY CAN REACT. SINCE IT TAKES + MORE ENERGY TO RAISE THE SHIELDS RAPIDLY AFTER A SHOT, IT COSTS + YOU 200 UNITS OF ENERGY EACH TIME YOU ACTIVATE THIS CONTROL. IT + IS AUTOMATICALLY ACTIVATED WHEN YOU FIRE PHASERS WHILE SHIELDS ARE UP. + BY SPECIFYING THE OPTION, SHIELDS ARE NOT RAISED AFTER FIRING. + + PHASERS HAVE NO EFFECT ON STARBASES (WHICH ARE SHIELDED) OR + ON STARS. +1 + 13 + ******************** + * PHOTON TORPEDOES * + ******************** + + MNEMONIC: PHOTONS + SHORTEST ABBREVIATION: PHO + FULL COMMANDS: PHOTONS + + PHOTON TORPEDOES ARE PROJECTILE WEAPONS--YOU EITHER HIT WHAT + YOU AIM AT, OR YOU DON'T. THERE ARE NO "PARTIAL HITS". + + ONE PHOTON TORPEDO WILL USUALLY KILL ONE ORDINARY KLINGON, + BUT IT USUALLY TAKES ABOUT TWO FOR A KLINGON COMMANDER. PHOTON + TORPEDOES CAN ALSO BLOW UP STARS AND STARBASES, IF YOU AREN'T + CAREFUL. + + YOU MAY FIRE PHOTON TORPEDOES SINGLY, OR IN BURSTS OF TWO + OR THREE. EACH TORPEDO IS INDIVIDUALLY TARGETABLE. THE COMPUTER + WILL PROMPT YOU, ASKING FOR THE TARGET SECTOR FOR EACH TORPEDO. + ALTERNATELY, YOU MAY SPECIFY EACH TARGET IN THE COMMAND LINE. + + PHOTON TORPEDOES CANNOT BE AIMED PRECISELY--THERE IS ALWAYS + SOME RANDOMNESS INVOLVED IN THE DIRECTION THEY GO. PHOTON + TORPEDOES MAY BE FIRED WITH YOUR SHIELDS UP, BUT AS THEY PASS + THROUGH THE SHIELDS THEY ARE RANDOMLY DEFLECTED FROM THEIR + INTENDED COURSE EVEN MORE. + + PHOTON TORPEDOES ARE PROXIMITY-FUSED. THE CLOSER THEY + EXPLODE TO THE ENEMY, THE MORE DAMAGE THEY DO. THERE IS A HIT + "WINDOW" ABOUT 1 SECTOR WIDE. IF THE TORPEDO MISSES THE HIT + WINDOW, IT DOES NOT EXPLODE AND THE ENEMY IS UNAFFECTED. + PHOTON TORPEDOES ARE ONLY EFFECTIVE WITHIN THE QUADRANT. THEY + HAVE NO EFFECT ON THINGS IN ADJACENT QUADRANTS. + + IF MORE THAN ONE TORPEDO IS FIRED AND ONLY ONE TARGET + SECTOR IS SPECIFIED, ALL TORPEDOES ARE FIRED AT THAT SECTOR. + FOR EXAMPLE, TO FIRE TWO TORPEDOES AT SECTOR 3 - 4, YOU TYPE + + PHO 2 3 4 (OR) PHO 2 3 4 3 4 + + TO FIRE TORPEDOES AT, CONSECUTIVELY, SECTORS 2 - 6, 1 - 10, + AND 4 - 7, TYPE + + PHO 3 2 6 1 10 4 7 + + THERE IS NO RESTRICTION TO FIRE DIRECTLY AT A SECTOR. FOR + EXAMPLE, YOU CAN ENTER + + PHO 1 3 2.5 + + TO AIM BETWEEN TWO SECTORS. HOWEVER, SECTOR NUMBERS MUST BE + 1 TO 10 INCLUSIVE. +1 + 14 + ******************** + * DOCK AT STARBASE * + ******************** + + MNEMONIC: DOCK + SHORTEST ABBREVIATION: D + + YOU MAY DOCK YOUR STARSHIP WHENEVER YOU ARE IN ONE OF THE + EIGHT SECTOR POSITIONS IMMEDIATELY ADJACENT TO A STARBASE. WHEN + YOU DOCK, YOUR STARSHIP IS RESUPPLIED WITH ENERGY, SHIELD ENERGY + PHOTON TORPEDOES, AND LIFE SUPPORT RESERVES. REPAIRS ALSO PROCEED + FASTER AT STARBASE, SO IF SOME OF YOUR DEVICES ARE DAMAGED, + YOU MAY WISH TO STAY AT BASE (BY USING THE "REST" COMMAND) + UNTIL THEY ARE FIXED. IF YOUR SHIP HAS MORE THAN ITS NORMAL + MAXIMUM ENERGY (WHICH CAN HAPPEN IF YOU'VE LOADED CRYSTALS) + THE SHIP'S ENERGY IS NOT CHANGED. + + YOU MAY NOT DOCK WHILE IN STANDARD ORBIT AROUND A PLANET. + + STARBASES HAVE THEIR OWN DEFLECTOR SHIELDS, SO YOU ARE + COMPLETELY SAFE FROM ATTACK WHILE DOCKED. YOU ARE ALSO SAFE + FROM LONG-RANGE TRACTOR BEAMS. + + ******** + * REST * + ******** + + MNEMONIC: REST + SHORTEST ABBREVIATION: R + FULL COMMAND: REST + + THIS COMMAND SIMPLY ALLOWS THE SPECIFIED NUMBER OF STARDATES + TO GO BY. THIS IS USEFUL IF YOU HAVE SUFFERED DAMAGES AND WISH + TO WAIT UNTIL REPAIRS ARE MADE BEFORE YOU GO BACK INTO BATTLE. + + IT IS NOT GENERALLY ADVISABLE TO REST WHILE YOU ARE UNDER + ATTACK BY KLINGONS. + + ************************** + * CALL STARBASE FOR HELP * + ************************** + + MNEMONIC: HELP + (NO ABBREVIATION) + + WHEN YOU GET INTO SERIOUS TROUBLE, YOU MAY CALL STARBASE FOR + HELP. STARBASES HAVE A DEVICE CALLED A "LONG-RANGE TRANSPORTER + BEAM" WHICH THEY CAN USE TO TELEPORT YOU TO BASE. THIS WORKS BY + DEMATERIALIZING YOUR STARSHIP AT ITS CURRENT POSITION AND (HOPEFULLY) + RE-MATERIALIZING IT ADJACENT TO THE NEAREST STARBASE. TELEPORTATION + IS INSTANTANEOUS, AND STARBASE SUPPLIES THE REQUIRED ENERGY--ALL YOU + HAVE TO DO IS LET THEM KNOW (VIA SUBSPACE RADIO) THAT YOU NEED HELP. +1 + 15 + THIS COMMAND SHOULD BE EMPLOYED ONLY WHEN ABSOLUTELY NECESSARY. + IN THE FIRST PLACE, CALLING FOR HELP IS AN ADMISSION ON YOUR PART + THAT YOU GOT YOURSELF INTO SOMETHING YOU CANNOT GET YOURSELF OUT + OF, AND YOU ARE HEAVILY PENALIZED FOR THIS IN THE FINAL SCORING. + SECONDLY, THE LONG-RANGE TRANSPORTER BEAM IS NOT RELIABLE--STARBASE + CAN ALWAYS MANAGE TO DEMATERIALIZE YOUR STARSHIP, BUT (DEPENDING + ON DISTANCE) MAY OR MAY NOT BE ABLE TO RE-MATERIALIZE YOU AGAIN. + THE LONG-RANGE TRANSPORTER BEAM HAS NO ABSOLUTE MAXIMUM RANGE; + IF YOU ARE IN THE SAME QUADRANT AS A STARBASE, YOU HAVE A GOOD + CHANCE (ABOUT 90 PERCENT) OF RE-MATERIALIZING SUCCESSFULLY. + YOUR CHANCES DROP TO ROUGHLY 50-50 AT JUST OVER 3 QUADRANTS. + + + + **************** + * ABANDON SHIP * + **************** + + MNEMONIC: ABANDON + (NO ABBREVIATION) + + YOU MAY ABANDON THE ENTERPRISE IF NECESSARY. IF THERE IS + STILL A STARBASE IN THE GALAXY, YOU WILL BE SENT THERE AND PUT + IN CHARGE OF A WEAKER SHIP, THE FAERIE QUEENE. + + THE FAERIE QUEENE CANNOT BE ABANDONED. + + ***************** + * SELF-DESTRUCT * + ***************** + + MNEMONIC: DESTRUCT + (NO ABBREVIATION) + + YOU MAY SELF-DESTRUCT, THUS KILLING YOURSELF AND ENDING THE + GAME. IF THERE ARE NEARBY KLINGONS, YOU MAY TAKE A FEW OF THEM + WITH YOU (THE MORE ENERGY YOU HAVE LEFT, THE BIGGER THE BANG). + + IN ORDER TO SELF-DESTRUCT YOU MUST REMEMBER THE PASSWORD YOU + TYPED IN AT THE BEGINNING OF THE GAME. + + + + ****************************** + * TERMINATE THE CURRENT GAME * + ****************************** + + MNEMONIC: TERMINATE + (NO ABBREVIATION) + + IMMEDIATELY CANCEL THE CURRENT GAME; NO CONCLUSION IS REACHED. + YOU WILL BE GIVEN AN OPPORTUNITY TO START A NEW GAME OR TO LEAVE + THE STAR TREK PROGRAM. +1 + 16 + *************** + * SENSOR-SCAN * + *************** + + MNEMONIC: SENSORS + SHORTEST ABBREVIATION: SE + + UTILIZING THE SHORT-RANGE SENSORS, SCIENCE OFFICER + SPOCK GIVES YOU A READOUT ON ANY PLANET IN YOUR QUADRANT. + PLANETS COME IN THREE CLASSES: M, N, AND O. ONLY CLASS M + PLANETS HAVE EARTH-LIKE CONDITIONS. SPOCK INFORMS YOU IF THE + PLANET HAS ANY DILITHIUM CRYSTALS. SENSOR SCANS ARE FREE. + + ************************ + * ENTER STANDARD ORBIT * + ************************ + + MNEMONIC: ORBIT + SHORTEST ABBREVIATION: O + + TO LAND ON A PLANET YOU MUST FIRST BE IN STANDARD ORBIT. + YOU ACHIEVE THIS IN A MANNER SIMILAR TO DOCKING AT STARBASE. + MOVING TO ONE OF THE EIGHT SECTOR POSITIONS IMMEDIATELY ADJACENT + TO THE PLANET, YOU GIVE THE ORBIT COMMAND WHICH PUTS YOUR SHIP + INTO STANDARD ORBIT ABOUT THE PLANET. SINCE THIS IS A MANEUVER, + A SMALL AMOUNT OF TIME IS USED; NEGLIGIBLE ENERGY IS REQUIRED. + IF ENEMIES ARE PRESENT, THEY WILL ATTACK. + + ********************** + * TRANSPORTER-TRAVEL * + ********************** + + MNEMONIC: TRANSPORT + SHORTEST ABBREVIATION: T + + THE TRANSPORTER IS A DEVICE WHICH CAN CONVERT ANY PHYSICAL + OBJECT INTO ENERGY, BEAM THE ENERGY THROUGH SPACE, AND RECONSTRUCT + THE PHYSICAL OBJECT AT SOME DESTINATION. TRANSPORTING IS ONE + WAY TO LAND ON A PLANET. SINCE THE TRANSPORTER HAS A LIMITED + RANGE, YOU MUST BE IN STANDARD ORBIT TO BEAM DOWN TO A PLANET. + SHIELDS MUST BE DOWN WHILE TRANSPORTING. + + THE TRANSPORT COMMAND IS USED TO BEAM A LANDING PARTY ONTO + A PLANET TO MINE "DILITHIUM CRYSTALS". EACH TIME THE COMMAND + IS GIVEN THE LANDING PARTY (WHICH YOU LEAD) MOVES FROM THE SHIP + TO THE PLANET, OR VICE-VERSA. + + YOU ARE ADVISED AGAINST NEEDLESS TRANSPORTING, SINCE LIKE + ALL DEVICES, THE TRANSPORTER WILL SOMETIMES MALFUNCTION. + + THE TRANSPORTER CONSUMES NEGLIGIBLE TIME AND ENERGY. ITS + USE DOES NOT CONSTITUTE A "TURN". +1 + 17 + ***************** + * SHUTTLE CRAFT * + ***************** + + MNEMONIC: SHUTTLE + SHORTEST ABBREVIATION: SHU + + AN ALTERNATE WAY TO TRAVEL TO AND FROM PLANETS. BECAUSE + OF LIMITED RANGE, YOU MUST BE IN STANDARD ORBIT TO USE THE + SHUTTLE CRAFT, NAMED "GALILEO". SHIELDS MUST BE DOWN. + + UNLIKE TRANSPORTING, USE OF THE SHUTTLE CRAFT DOES CONSTITUTE + A "TURN" SINCE TIME IS CONSUMED. THE TIME NATURALLY DEPENDS + ON ORBIT ALTITUDE, BUT WILL USUALLY BE LESS THAN 0.2 STARDATES. + SHUTTLING USES NO SHIP ENERGY. + + *************************** + * MINE DILITHIUM CRYSTALS * + *************************** + + MNEMONIC: MINE + SHORTEST ABBREVIATION: MI + + ONCE YOU AND YOUR MINING PARTY ARE ON THE SURFACE OF A + PLANET WHICH HAS DILITHIUM CRYSTALS, THIS COMMAND WILL DIG THEM + FOR YOU. + + MINING REQUIRES TIME AND CONSTITUTES A "TURN". NO ENERGY + IS USED. CLASS M PLANETS REQUIRE 0.1 TO 0.3 STARDATES TO MINE. + CLASS N PLANETS TAKE TWICE AS LONG, AND CLASS O PLANETS TAKE + THREE TIMES AS LONG. + + DILITHIUM CRYSTALS CONTAIN ENORMOUS ENERGY IN A FORM + THAT IS READILY RELEASED IN THE SHIP'S POWER SYSTEM. IT + IS AN EXCELLENT IDEA TO MINE THEM WHENEVER POSSIBLE, FOR USE + IN EMERGENCIES. ONCE YOU HAVE MINED CRYSTALS, AND HAVE THEM + SAFELY ABOARD SHIP, YOU HAVE A SUPPLY THAT WILL LAST THE ENTIRE + GAME. THERE IS NO NEED TO GO BACK FOR MORE (UNLESS YOU ABANDON + SHIP). + + *************************** + * LOAD DILITHIUM CRYSTALS * + *************************** + + MNEMONIC: CRYSTALS + SHORTEST ABBREVIATION: CR + + THIS IS A VERY POWERFUL COMMAND WHICH SHOULD BE USED WITH + CAUTION. ONCE YOU HAVE DILITHIUM CRYSTALS ABOARD SHIP, THIS + COMMAND WILL INSTRUCT ENGINEERING OFFICER SCOTT AND MR. SPOCK + TO PLACE A RAW DILITHIUM CRYSTAL INTO THE POWER CHANNEL OF THE + SHIP'S MATTER-ANTIMATTER CONVERTER. WHEN IT WORKS, THIS COMMAND + WILL GREATLY BOOST THE SHIP'S ENERGY. +1 + 18 + BECAUSE THE CRYSTALS ARE RAW AND IMPURE, INSTABILITIES + CAN OCCUR IN THE POWER CHANNEL. USUALLY SCOTTY CAN CONTROL + THESE. WHEN HE CANNOT, THE RESULTS ARE DISASTROUS. + + EVEN IF THE CRYSTALS ARE LOADED SUCCESSFULLY, SOME DAMAGE + IS INEVITABLY DONE TO THE POWER CHANNEL. THIS DAMAGE HAS NO + EFFECT ON THE OPERATION OF THE POWER PLANT, BUT WILL MAKE IT MORE + DIFFICULT TO CONTROL INSTABILITIES THE NEXT TIME CRYSTALS ARE + LOADED. + + SINCE USING RAW DILITHIUM CRYSTALS FOR THIS PURPOSE ENTAILS + CONSIDERABLE RISK, STARFLEET REGULATIONS ALLOW ITS USE ONLY DURING + "CONDITION YELLOW". NO TIME OR ENERGY IS USED. + + ***************** + * PLANET REPORT * + ***************** + + MNEMONIC: PLANETS + SHORTEST ABBREVIATION: PL + + MR. SPOCK PRESENTS YOU A LIST OF THE AVAILABLE INFORMATION + ON PLANETS IN THE GALAXY. SINCE PLANETS DO NOT SHOW UP ON + LONG-RANGE SCANS, THE ONLY WAY TO OBTAIN THIS INFORMATION IS + WITH THE "SENSORS" COMMAND. + + ********** + * FREEZE * + ********** + + MNEMONIC: FREEZE + (NO ABBREVIATION) + FULL COMMAND: FREEZE + + THE PURPOSE OF THE COMMAND IS TO ALLOW A PLAYER + TO SAVE THE CURRENT STATE OF THE GAME, SO THAT IT CAN BE FINISHED + LATER. A FILE WITH THE SPECIFIED AND TYPE '.TRK' IS + CREATED (IF NECESSARY) IN THE CURRENT DIRECTORY, AND ALL PERTINENT + INFORMATION ABOUT THE GAME IS WRITTEN TO THAT FILE. THE GAME + IS THEN TERMINATED, AND YOU ARE GIVEN THE CHOICE OF STARTING A NEW + GAME OR LEAVING THE PROGRAM. YOU MAY CONTINUE THE CURRENT GAME + USING THE PROCEDURE DESCRIBED NEXT. + + TO RESTART A GAME CREATED BY THE "FREEZE" COMMAND, THE USER + NEED ONLY TYPE "FROZEN" IN RESPONSE TO THE INITIAL QUESTION + ABOUT THE TYPE OF GAME DESIRED, FOLLOWED BY THE . + + NOTE: A "TOURNAMENT" GAME IS LIKE A FROZEN GAME, WITH THE + FOLLOWING DIFFERENCES. (1) TOURNAMENT GAMES ALWAYS START FROM + THE BEGINNING, WHILE A FROZEN GAME CAN START AT ANY POINT. + (2) TOURNAMENT GAMES REQUIRE ONLY THAT THE PLAYER REMEMBER THE + NAME OR NUMBER OF THE TOURNAMENT, WHILE THE INFORMATION ABOUT A + FROZEN GAME MUST BE KEPT ON A FILE. + + A POINT WORTH NOTING IS THAT 'FREEZE' DOES NOT SAVE THE SEED + FOR THE RANDOM NUMBER GENERATOR, SO THAT IDENTICAL ACTIONS AFTER + RESTARTING THE SAME FROZEN GAME CAN LEAD TO DIFFERENT RESULTS. + HOWEVER, IDENTICAL ACTIONS AFTER STARTING A GIVEN TOURNAMENT + GAME ALWAYS LEAD TO THE SAME RESULTS. +1 + 19 + *********** + * REQUEST * + *********** + + MNEMONIC: REQUEST + SHORTEST ABBREVIATION: REQ + FULL COMMAND: REQUEST + + THIS COMMAND ALLOWS YOU TO GET ANY SINGLE PIECE OF INFORMATION + FROM THE COMMAND. SPECIFIES WHICH INFORMATION AS FOLLOWS: + + INFORMATION MNEMONIC FOR SHORTEST ABBREVIATION + + STARDATE DATE D + CONDITION CONDITION C + POSITION POSITION P + LIFE SUPPORT LSUPPORT L + WARP FACTOR WARPFACTOR W + ENERGY ENERGY E + TORPEDOES TORPEDOES TO + SHIELDS SHIELDS S + KLINGONS LEFT KLINGONS K + TIME LEFT TIME T + + ************************** + * EXPERIMENTAL DEATH RAY * + ************************** + + MNEMONIC: DEATHRAY + (NO ABBREVIATION) + + THIS COMMAND SHOULD BE USED ONLY IN THOSE DESPERATE CASES + WHERE YOU HAVE ABSOLUTELY NO ALTERNATIVE. THE DEATH RAY USES + ENERGY TO REARRANGE MATTER. UNFORTUNATELY, ITS WORKING PRINCIPLES + ARE NOT YET THOROUGHLY UNDERSTOOD, AND THE RESULTS ARE HIGHLY + UNPREDICTABLE. + + THE DEATH RAY IS A VERY DELICATE DEVICE AND IS USUALLY DAMAGED + AFTER ITS FIRST USE. THE FIRST TIME ONE USES THE DEATH RAY, THERE + IS A SEVENTY PERCENT CHANCE OF ITS FUNCTIONING CORRECTLY. WHEN IT + WORKS, THE DEATH RAY ELIMINATES ALL THE ENEMIES IN THE QUADRANT. + WHEN IT DOES NOT..................... + + IF THE DEATH RAY IS DAMAGED IN ITS USE, IT MUST BE TOTALLY + REPLACED. THIS CAN ONLY BE DONE AT STARBASE. BECAUSE IT IS A VERY + COMPLEX DEVICE, IT TAKES 9.99 STARDATES AT BASE TO REPLACE THE + DEATH RAY. + + THE DEATH RAY CANNOT BE REPAIRED IN FLIGHT. +1 + 20 + ****************** + * EMERGENCY EXIT * + ****************** + + MNEMONIC: EMEXIT + SHORTEST ABBREVIATION: E + + THIS COMMAND PROVIDES A QUICK WAY TO EXIT FROM THE GAME WHEN + YOU OBSERVE A KLINGON BATTLE CRUISER APPROACHING YOUR TERMINAL. + ITS EFFECT IS TO FREEZE THE GAME ON THE FILE 'EMSAVE.TRK' IN YOUR + CURRENT DIRECTORY, ERASE THE SCREEN (IF YOU ARE PLAYING AT A VT52), + AND EXIT. + + A SHORT IMPLEMENTATION NOTE: THE SCREEN ERASURE IS DONE BY THE + MODULE 'GETOUT', WHICH CAN EASILY BE MODIFIED TO HANDLE TERMINALS + THAT USE DIFFERENT CONTROL OR ESCAPE SEQUENCES TO EFFECT SCREEN + ERASURE. + + *************** + * GAME REPORT * + *************** + + MNEMONIC: GAME + SHORTEST ABBREVIATION: G + + THIS COMMAND SUPPLIES YOU WITH INFORMATION ABOUT THE STATE OF THE + CURRENT GAME. ITS PURPOSE IS TO REMIND YOU OF THINGS THAT YOU HAVE + LEARNED DURING PLAY, BUT MAY HAVE FORGOTTEN, AND CANNOT OTHERWISE + RETRIEVE IF YOU ARE NOT PLAYING AT A HARD-COPY TERMINAL. + + YOU ARE TOLD THE FOLLOWING THINGS: + + . THE LENGTH AND SKILL LEVEL OF THE GAME YOU ARE PLAYING + . THE ORIGINAL NUMBER OF KLINGONS + . HOW MANY KLINGONS YOU HAVE DESTROYED + . WHETHER THE SUPER-COMMANDER HAS BEEN DESTROYED + . HOW MANY BASES HAVE BEEN DESTROYED + . HOW MANY BASES ARE LEFT + . WHAT BASES (IF ANY) ARE UNDER ATTACK; YOU MUST HAVE BEEN + INFORMED OF THE ATTACK VIA SUBSPACE RADIO + . HOW MANY CASUALTIES YOU HAVE SUFFERED + . HOW MANY TIMES YOU HAVE CALLED FOR HELP. + + YOU ARE ALSO WARNED IF THE SUBSPACE RADIO HAS BEEN DAMAGED, WHICH + MAY RENDER YOUR INFORMATION INCOMPLETE. + + THIS SAME INFORMATION IS AUTOMATICALLY GIVEN TO YOU WHEN YOU + START TO PLAY A FROZEN GAME. +1 + 21 + ----------MISCELLANEOUS NOTES---------- + + STARBASES CAN BE ATTACKED BY EITHER COMMANDERS OR BY THE + "SUPER-COMMANDER". WHEN THIS HAPPENS, YOU WILL BE NOTIFIED + BY SUBSPACE RADIO, PROVIDED IT IS WORKING. THE MESSAGE WILL + INFORM YOU HOW LONG THE BASE UNDER ATTACK CAN LAST. SINCE THE + "SUPER-COMMANDER" IS MORE POWERFUL THAN AN ORDINARY COMMANDER, + HE CAN DESTROY A BASE MORE QUICKLY. + + THE "SUPER-COMMANDER" TRAVELS AROUND THE GALAXY AT A SPEED + OF ABOUT WARP 6 OR 7. HIS MOVEMENT IS STRICTLY TIME BASED; THE + MORE TIME PASSES, THE FURTHER HE CAN GO. + + SCATTERED THROUGH THE GALAXY ARE CERTAIN ZONES OF CONTROL, + COLLECTIVELY DESIGNATED THE "ROMULAN NEUTRAL ZONE". ANY + QUADRANT WHICH CONTAINS ROMULANS WITHOUT KLINGONS IS PART OF THE + NEUTRAL ZONE, EXCEPT IF A BASE IS PRESENT. SINCE ROMULANS DO NOT + SHOW ON EITHER THE LONG-RANGE SCAN OR THE STAR CHART, IT IS EASY + FOR YOU TO STUMBLE INTO THIS ZONE. WHEN YOU DO, IF YOUR SUBSPACE + RADIO IS WORKING, YOU WILL RECEIVE A WARNING MESSAGE FROM THE + ROMULAN, POLITELY ASKING YOU TO LEAVE. + + IN GENERAL, ROMULANS ARE A GALACTIC NUISANCE. + + THE HIGH-SPEED SHIELD CONTROL IS FAIRLY RELIABLE, BUT IT HAS + BEEN KNOWN TO MALFUNCTION. + + YOU CAN OBSERVE THE GALACTIC MOVEMENTS OF THE "SUPER-COMMANDER" + ON THE STAR CHART, PROVIDED HE IS IN TERRITORY YOU HAVE SCANNED. + + PERIODICALLY, YOU WILL RECEIVE INTELLIGENCE REPORTS FROM + STARFLEET COMMAND, INDICATING THE CURRENT QUADRANT OF THE + "SUPER-COMMANDER". YOUR SUBSPACE RADIO MUST BE WORKING, OF + COURSE. + + EACH QUADRANT WILL CONTAIN FROM 0 TO 3 BLACK HOLES. + TORPEDOES ENTERING A BLACK HOLE DISAPPEAR. IN FACT, ANYTHING + ENTERING A BLACK HOLE DISAPPEARS, PERMANENTLY. IF YOU CAN DISPLACE + AN ENEMY INTO ONE, HE IS A GONER. BLACK HOLES DO NOT NECESSARILY + REMAIN IN A QUADRANT. THEY ARE TRANSIENT PHENOMENA. + + BATTLE COMPUTER INFORMATION IS AVAILABLE BY FIRING PHASERS + MANUALLY, AND ALLOWING THE COMPUTER TO PROMPT YOU. IF YOU ENTER + ZERO FOR THE AMOUNT TO FIRE AT EACH ENEMY, YOU WILL GET A + COMPLETE REPORT, WITHOUT COST. THE BATTLE COMPUTER WILL TELL YOU HOW + MUCH PHASER ENERGY TO FIRE AT EACH ENEMY FOR A SURE KILL. THIS + INFO APPEARS IN PARENTHESES PRIOR TO THE PROMPT FOR EACH ENEMY. + SINCE THE AMOUNT IS COMPUTED FROM SENSOR DATA, IF EITHER THE COMPUTER + OR S.R. SENSORS ARE DAMAGED, THIS INFO WILL BE UNAVAILABLE, AND + PHASERS MUST BE FIRED MANUALLY. BATTLE COMPUTER INFORMATION CAN BE + OBTAINED EVEN IF THE PHASERS ARE DAMAGED (OR OTHERWISE UNUSABLE), + PROVIDED THE COMPUTER AND SHORT-RANGE SENSORS ARE BOTH WORKING. + + IF WARP ENGINES ARE DAMAGED LESS THAN 10 STARDATES (UNDOCKED) + YOU CAN STILL GO WARP 4. +1 + 22 + + ----------SCORING---------- + + + SCORING IS FAIRLY SIMPLE. YOU GET POINTS FOR GOOD THINGS, AND + YOU LOSE POINTS FOR BAD THINGS. + + YOU GAIN-- + + (1) 10 POINTS FOR EACH ORDINARY KLINGON YOU KILL, + (2) 50 POINTS FOR EACH COMMANDER YOU KILL, + (3) 200 POINTS FOR KILLING THE "SUPER-COMMANDER", + (4) 20 POINTS FOR EACH ROMULAN KILLED, + (5) 1 POINT FOR EACH ROMULAN CAPTURED. + (6) 500 TIMES YOUR AVERAGE KLINGON/STARDATE KILL RATE. IF YOU + LOSE THE GAME, YOUR KILL RATE IS BASED ON A MINIMUM OF + 5 STARDATES. + (7) YOU GET A BONUS IF YOU WIN THE GAME, BASED ON YOUR RATING: + NOVICE=100, FAIR=200, GOOD=300, EXPERT=400, EMERITUS=500. + + YOU LOSE-- + + (8) 200 POINTS IF YOU GET YOURSELF KILLED, + (9) 100 POINTS FOR EACH STARBASE YOU DESTROY, + (10) 100 POINTS FOR EACH STARSHIP YOU LOSE, + (11) 45 POINTS FOR EACH TIME YOU HAD TO CALL FOR HELP, + (12) 10 POINTS FOR EACH PLANET YOU DESTROYED, + (13) 5 POINTS FOR EACH STAR YOU DESTROYED, AND + (14) 1 POINT FOR EACH CASUALTY YOU INCURRED. + + IN ADDITION TO YOUR SCORE, YOU MAY ALSO BE PROMOTED ONE GRADE + IN RANK IF YOU PLAY WELL ENOUGH. PROMOTION IS BASED PRIMARILY ON + YOUR KLINGON/STARDATE KILL RATE, SINCE THIS IS THE BEST INDICATOR + OF WHETHER YOU ARE READY TO GO ON TO THE NEXT HIGHER RATING. + HOWEVER, IF YOU HAVE LOST 100 OR MORE POINTS IN PENALTIES, YOU + WILL NOT RECEIVE A PROMOTION. + + YOU CAN BE PROMOTED FROM ANY LEVEL. THERE IS A SPECIAL PROMOTION + AVAILABLE IF YOU GO BEYOND THE "EXPERT" RANGE. YOU CAN ALSO HAVE + A CERTIFICATE OF MERIT PRINTED WITH YOUR NAME, DATE, AND + KLINGON KILL RATE, PROVIDED YOU ARE PROMOTED FROM EITHER THE + "EXPERT" OR "EMERITUS" LEVELS. + + YOU SHOULD PROBABLY START OUT AT THE NOVICE LEVEL, EVEN IF YOU + ARE ALREADY FAMILIAR WITH ONE OF THE OTHER VERSIONS OF THE STAR TREK + GAME--BUT, OF COURSE, THE LEVEL OF GAME YOU PLAY IS UP TO YOU. IF + YOU WANT TO START AT THE EXPERT LEVEL, GO AHEAD. IT'S YOUR FUNERAL. + THE EMERITUS GAME IS STRICTLY FOR MASOCHISTS. +1 + 23 + + ----------MODIFICATIONS---------- + + + THE STAR TREK GAME IS SUPPORTED BY THE AUTHORS. FROM TIME TO + TIME, CORRECTIONS, MODIFICATIONS AND IMPROVEMENTS WILL BE MADE IN + THE GAME. THE DOCUMENTATION FOR THE GAME (WHICH YOU ARE READING + NOW) IS KEPT UP TO DATE, AND THE LATEST VERSION OF THE DOCUMENTATION + IS AVAILABLE BY EXECUTING THE CONTROL CARDS: + + EXECPF 1234 GAMES. + AND ENTERING "TRKINST" AS YOUR GAME. + + PLAYERS WHO ALREADY HAVE A COPY OF THE DOCUMENTATION CAN KEEP + ABREAST OF THE NEW MODIFICATIONS BY EXECUTING THE CONTROL CARDS: + + EXECPF 1234 GAMES. + AND ENTERING "TRKNEWS" AS YOUR GAME. + + CORRECTIONS AND MINOR MODIFICATIONS (THOSE WHICH HAVE LITTLE EFFECT + ON THE GAME) WILL NOT IN GENERAL BE REPORTED. + + CAVEAT: SINCE THE GAME IS CONTINUALLY BEING IMPROVED, IT IS + POSSIBLE THAT NEW REVISIONS WILL ALTER THE NATURE OF TOURNAMENT + GAMES OR WILL RENDER PREVIOUSLY FROZEN GAMES UNPLAYABLE. THE + AUTHORS WILL ATTEMPT TO AVOID SUCH OCCURRANCES WHEREVER POSSIBLE + AND TO MINIMIZE THE EFFECTS WHEN THEY DO OCCUR, BUT CANNOT MAKE + ANY GUARANTEES. +1 + 24 + ----------HANDY REFERENCE PAGE---------- + + ABBREV FULL COMMAND DEVICE USED + ------ ------------ ----------- + ABANDON ABANDON SHUTTLE CRAFT + C CHART (NONE) + CR CRYSTALS (NONE) + DA DAMAGES (NONE) + DEATHRAY DEATHRAY DEATHRAY + DESTRUCT DESTRUCT COMPUTER + D DOCK (NONE) + E EMEXIT (NONE) + FREEZE FREEZE (NONE) + G GAME (NONE) + HELP HELP SUBSPACE RADIO + I IMPULSE IMPULSE ENGINES + IMPULSE IMPULSE ENGINES AND COMPUTER + L LRSCAN LONG-RANGE SENSORS + MI MINE (NONE) + M MOVE WARP ENGINES + MOVE WARP ENGINES AND COMPUTER + O ORBIT WARP OR IMPULSE ENGINES + P PHASERS PHASERS AND COMPUTER + PHASERS AUTOMATIC PHASERS, COMPUTER, SR SENSORS + PHASERS MANUAL ... PHASERS + PHO PHOTONS TORPEDO TUBES + PL PLANETS (NONE) + REQ REQUEST (NONE) + R REST (NONE) + SE SENSORS SHORT-RANGE SENSORS + SH SHIELDS DEFLECTOR SHIELDS + SHU SHUTTLE SHUTTLE CRAFT + S SRSCAN SHORT-RANGE SENSORS + ST STATUS (NONE) + TERMINATE TERMINATE (NONE) + T TRANSPORT TRANSPORTER + W WARP (NONE) + L. R. SCAN: THOUSANDS DIGIT: SUPERNOVA + HUNDREDS DIGIT: KLINGONS + TENS DIGIT: STARBASES + ONES DIGIT: STARS + PERIOD (.): DIGIT NOT KNOWN (STAR CHART ONLY) + + COURSES ARE GIVEN IN MANUAL MODE IN X - Y DISPLACEMENTS; IN AUTOMATIC + MODE AS DESTINATION QUADRANT AND/OR SECTOR. MANUAL MODE IS DEFAULT. + DISTANCES ARE GIVEN IN QUADRANTS. A DISTANCE OF ONE SECTOR IS 0.1 QUADRANT. + ORDINARY KLINGONS HAVE ABOUT 400 UNITS OF ENERGY, COMMANDERS ABOUT + 1200. ROMULANS NORMALLY HAVE ABOUT 800 UNITS OF ENERGY, AND THE + (GULP) "SUPER-COMMANDER" HAS ABOUT 1800. + PHASER FIRE DIMINISHES TO ABOUT 60 PERCENT AT 5 SECTORS. UP TO 1500 + UNITS MAY BE FIRED IN A SINGLE BURST WITHOUT DANGER OF OVERHEAT. + WARP 6 IS THE FASTEST SAFE SPEED. AT HIGHER SPEEDS, ENGINE DAMAGE + MAY OCCUR. AT WARP 10 YOU MAY ENTER A TIME WARP. + SHIELDS COST 50 UNITS OF ENERGY TO RAISE, AND DOUBLE THE POWER + REQUIREMENTS OF MOVING UNDER WARP DRIVE. ENGAGING THE HIGH-SPEED + SHIELD CONTROL REQUIRES 200 UNITS OF ENERGY. + WARP DRIVE REQUIRES (DISTANCE)*(WARP FACTOR CUBED) UNITS OF ENERGY + TO TRAVEL AT A SPEED OF (WARP FACTOR SQUARED)/10 QUADRANTS PER STARDATE. + IMPULSE ENGINES REQUIRE 20 UNITS TO WARM UP, PLUS 100 UNITS PER + QUADRANT. SPEED IS JUST UNDER ONE SECTOR PER STARDATE. +1 + 25 + ----------ACKNOWLEDGMENTS---------- + + + THE AUTHORS WOULD LIKE TO THANK PROFESSOR MICHAEL DUGGAN FOR + HIS ENCOURAGEMENT AND ADMINISTRATIVE ASSISTANCE WITH THE DEVELOPMENT + OF THE STAR TREK GAME, WITHOUT WHICH IT MIGHT NEVER HAVE BEEN + COMPLETED. + + MUCH CREDIT IS DUE TO PATRICK MCGEHEARTY AND RICH COHEN, WHO + ASSISTED WITH THE ORIGINAL DESIGN OF THE GAME AND CONTRIBUTED + GREATLY TO ITS CONCEPTUAL DEVELOPMENT. + + THANKS ARE ALSO DUE TO CARL STRANGE, HARDY TICHENOR AND STEVEN + BRUELL FOR THEIR ASSISTANCE WITH CERTAIN CODING PROBLEMS. + + THIS GAME WAS INSPIRED BY AND RATHER LOOSELY BASED ON AN EARLIER + GAME, PROGRAMMED IN THE BASIC LANGUAGE, BY JIM KORP AND GRADY HICKS. + IT IS THE AUTHORS' UNDERSTANDING THAT THE BASIC GAME WAS IN TURN + DERIVED FROM A STILL EARLIER VERSION IN USE AT PENN STATE UNIVERSITY. + + + + + ----------REFERENCES---------- + + + 1. STAR TREK (THE ORIGINAL TELEVISION SERIES), PRODUCED AND + DIRECTED BY GENE RODENBERRY. + + 2. STAR TREK (THE ANIMATED TELEVISION SERIES), PRODUCED BY GENE + RODENBERRY AND DIRECTED BY HAL SUTHERLAND. ALSO EXCELLENT, + AND NOT JUST KIDDIE FARE. IF YOU ENJOYED THE ORIGINAL SERIES + YOU SHOULD ENJOY THIS ONE (UNLESS YOU HAVE SOME SORT OF A + HANGUP ABOUT WATCHING CARTOONS). + + 3. THE MAKING OF STAR TREK, BY STEVEN E. WHITFIELD AND GENE + RODENBERRY. THE BEST AND MOST COMPLETE READILY AVAILABLE + BOOK ABOUT STAR TREK. (BALLANTINE BOOKS) + + 4. THE WORLD OF STAR TREK, BY DAVID GERROLD. SIMILIAR IN SCOPE + TO THE ABOVE BOOK. (BANTAM) + + 5. THE STAR TREK GUIDE, THIRD REVISION 4/17/67, BY GENE + RODENBERRY. THE ORIGINAL WRITER'S GUIDE FOR THE TELEVISION + SERIES, BUT LESS COMPREHENSIVE THAN (3) ABOVE. + (NORWAY PRODUCTIONS) + + 6. THE TROUBLE WITH TRIBBLES, BY DAVID GERROLD. INCLUDES THE + COMPLETE SCRIPT OF THIS POPULAR SHOW. (BALLANTINE BOOKS) + + 7. STAR TREK, STAR TREK 2, ..., STAR TREK 9, BY JAMES BLISH. + THE ORIGINAL SHOWS IN SHORT STORY FORM. (BANTAM) + + 8. SPOCK MUST DIE, BY JAMES BLISH. AN ORIGINAL NOVEL, BUT + RATHER SIMILAR TO THE SHOW "THE ENEMY WITHIN". (BANTAM) + + 9. MODEL KITS OF THE ENTERPRISE AND A "KLINGON BATTLE-CRUISER" + BY AMT CORPORATION ARE AVAILABLE AT MOST HOBBY SHOPS. + +END +F77 F7:TRABAND OVER BO:TRABAND + +F +F77 F7:TRATTAK OVER BO:TRATTAK + +F +F77 F7:TRAUTOV OVER BO:TRAUTOV + +F +F77 F7:TRCANTA OVER BO:TRCANTA + +F +F77 F7:TRCHART OVER BO:TRCHART + +F +F77 F7:TRCHOOS OVER BO:TRCHOOS + +F +F77 F7:TRCRAM OVER BO:TRCRAM + +F +F77 F7:TRCRMEN OVER BO:TRCRMEN + +F +F77 F7:TRCRMLC OVER BO:TRCRMLC + +F +F77 F7:TRCRMSH OVER BO:TRCRMSH + +F +F77 F7:TRCRMSN OVER BO:TRCRMSN + +F +F77 F7:TRCRMSP OVER BO:TRCRMSP + +F +F77 F7:TRCROP OVER BO:TRCROP + +F +F77 F7:TRDEADK OVER BO:TRDEADK + +F +F77 F7:TRDEBUG OVER BO:TRDEBUG + +F +F77 F7:TRDESTR OVER BO:TRDESTR + +F +F77 F7:TRDOCK OVER BO:TRDOCK + +F +F77 F7:TRDROPI OVER BO:TRDROPI + +F +F77 F7:TRDRPRT OVER BO:TRDRPRT + +F +F77 F7:TREMEXI OVER BO:TREMEXI + +F +F77 F7:TREVENT OVER BO:TREVENT + +F +F77 F7:TREXPRA OVER BO:TREXPRA + +F +F77 F7:TRFINIS OVER BO:TRFINIS + +F +F77 F7:TRFREEZ OVER BO:TRFREEZ + +F +F77 F7:TRGETCD OVER BO:TRGETCD + +F +F77 F7:TRGETFN OVER BO:TRGETFN + +F +F77 F7:TRGETOU OVER BO:TRGETOU + +F +F77 F7:TRHELP OVER BO:TRHELP + +F +F77 F7:TRHITEM OVER BO:TRHITEM + +F +F77 F7:TRIMPUL OVER BO:TRIMPUL + +F +F77 F7:TRIRAN8 OVER BO:TRIRAN8 + +F +F77 F7:TRJA OVER BO:TRJA + +F +F77 F7:TRLRSCN OVER BO:TRLRSCN + +F +F77 F7:TRMOVE OVER BO:TRMOVE + +F +F77 F7:TRMOVEC OVER BO:TRMOVEC + +F +F77 F7:TRMOVET OVER BO:TRMOVET + +F +F77 F7:TRNEWCO OVER BO:TRNEWCO + +F +F77 F7:TRNEWQU OVER BO:TRNEWQU + +F +F77 F7:TRNOVA OVER BO:TRNOVA + +F +F77 F7:TRPHASE OVER BO:TRPHASE + +F +F77 F7:TRPHOTO OVER BO:TRPHOTO + +F +F77 F7:TRPLANE OVER BO:TRPLANE + +F +F77 F7:TRPLAQU OVER BO:TRPLAQU + +F +F77 F7:TRPRELI OVER BO:TRPRELI + +F +F77 F7:TRPROUT OVER BO:TRPROUT + +F +F77 F7:TRRAM OVER BO:TRRAM + +F +F77 F7:TRSCAN OVER BO:TRSCAN + +F +F77 F7:TRSCOM OVER BO:TRSCOM + +F +F77 F7:TRSCORE OVER BO:TRSCORE + +F +F77 F7:TRSETUP OVER BO:TRSETUP + +F +F77 F7:TRSETWA OVER BO:TRSETWA + +F +F77 F7:TRSHIEL OVER BO:TRSHIEL + +F +F77 F7:TRSKIP OVER BO:TRSKIP + +F +F77 F7:TRSNOVA OVER BO:TRSNOVA + +F +F77 F7:TRSORTK OVER BO:TRSORTK + +F +F77 F7:TRSRSCA OVER BO:TRSRSCA + +F +F77 F7:TRTHAW OVER BO:TRTHAW + +F +F77 F7:TRTIMEW OVER BO:TRTIMEW + +F +F77 F7:TRTREK OVER BO:TRTREK + +F +F77 F7:TRWAIT OVER BO:TRWAIT + +F +F77 F7:TRWARP OVER BO:TRWARP + +F +F77 F7:TRZAP OVER BO:TRZAP + +F +DELETE LB:TRTREK +LEMUR +LIBRARY LB:TRTREK +BUILD TRABAND FROM BO:TRABAND(ROM) +BUILD TRATTAK FROM BO:TRATTAK(ROM) +BUILD TRAUTOV FROM BO:TRAUTOV(ROM) +BUILD TRCANTA FROM BO:TRCANTA(ROM) +BUILD TRCHART FROM BO:TRCHART(ROM) +BUILD TRCHOOS FROM BO:TRCHOOS(ROM) +BUILD TRCRAM FROM BO:TRCRAM(ROM) +BUILD TRCRMEN FROM BO:TRCRMEN(ROM) +BUILD TRCRMLC FROM BO:TRCRMLC(ROM) +BUILD TRCRMSH FROM BO:TRCRMSH(ROM) +BUILD TRCRMSN FROM BO:TRCRMSN(ROM) +BUILD TRCRMSP FROM BO:TRCRMSP(ROM) +BUILD TRCROP FROM BO:TRCROP(ROM) +BUILD TRDEADK FROM BO:TRDEADK(ROM) +BUILD TRDEBUG FROM BO:TRDEBUG(ROM) +BUILD TRDESTR FROM BO:TRDESTR(ROM) +BUILD TRDOCK FROM BO:TRDOCK(ROM) +BUILD TRDROPI FROM BO:TRDROPI(ROM) +BUILD TRDRPRT FROM BO:TRDRPRT(ROM) +BUILD TREMEXI FROM BO:TREMEXI(ROM) +BUILD TREVENT FROM BO:TREVENT(ROM) +BUILD TREXPRA FROM BO:TREXPRA(ROM) +BUILD TRFINIS FROM BO:TRFINIS(ROM) +BUILD TRFREEZ FROM BO:TRFREEZ(ROM) +BUILD TRGETCD FROM BO:TRGETCD(ROM) +BUILD TRGETFN FROM BO:TRGETFN(ROM) +BUILD TRGETOU FROM BO:TRGETOU(ROM) +BUILD TRHELP FROM BO:TRHELP(ROM) +BUILD TRHITEM FROM BO:TRHITEM(ROM) +BUILD TRIMPUL FROM BO:TRIMPUL(ROM) +BUILD TRIRAN8 FROM BO:TRIRAN8(ROM) +BUILD TRJA FROM BO:TRJA(ROM) +BUILD TRLRSCN FROM BO:TRLRSCN(ROM) +BUILD TRMOVE FROM BO:TRMOVE(ROM) +BUILD TRMOVEC FROM BO:TRMOVEC(ROM) +BUILD TRMOVET FROM BO:TRMOVET(ROM) +BUILD TRNEWCO FROM BO:TRNEWCO(ROM) +BUILD TRNEWQU FROM BO:TRNEWQU(ROM) +BUILD TRNOVA FROM BO:TRNOVA(ROM) +BUILD TRPHASE FROM BO:TRPHASE(ROM) +BUILD TRPHOTO FROM BO:TRPHOTO(ROM) +BUILD TRPLANE FROM BO:TRPLANE(ROM) +BUILD TRPLAQU FROM BO:TRPLAQU(ROM) +BUILD TRPRELI FROM BO:TRPRELI(ROM) +BUILD TRPROUT FROM BO:TRPROUT(ROM) +BUILD TRRAM FROM BO:TRRAM(ROM) +BUILD TRSCAN FROM BO:TRSCAN(ROM) +BUILD TRSCOM FROM BO:TRSCOM(ROM) +BUILD TRSCORE FROM BO:TRSCORE(ROM) +BUILD TRSETUP FROM BO:TRSETUP(ROM) +BUILD TRSETWA FROM BO:TRSETWA(ROM) +BUILD TRSHIEL FROM BO:TRSHIEL(ROM) +BUILD TRSKIP FROM BO:TRSKIP(ROM) +BUILD TRSNOVA FROM BO:TRSNOVA(ROM) +BUILD TRSORTK FROM BO:TRSORTK(ROM) +BUILD TRSRSCA FROM BO:TRSRSCA(ROM) +BUILD TRTHAW FROM BO:TRTHAW(ROM) +BUILD TRTIMEW FROM BO:TRTIMEW(ROM) +BUILD TRWAIT FROM BO:TRWAIT(ROM) +BUILD TRWARP FROM BO:TRWARP(ROM) +BUILD TRZAP FROM BO:TRZAP(ROM) +END +LYNX BO:TRTREK OVER TRTREK ;LB:TRTREK. +DELETE F7:TRABAND +DELETE BO:TRABAND +DELETE F7:TRATTAK +DELETE BO:TRATTAK +DELETE F7:TRAUTOV +DELETE BO:TRAUTOV +DELETE F7:TRCANTA +DELETE BO:TRCANTA +DELETE F7:TRCHART +DELETE BO:TRCHART +DELETE F7:TRCHOOS +DELETE BO:TRCHOOS +DELETE F7:TRCRAM +DELETE BO:TRCRAM +DELETE F7:TRCRMEN +DELETE BO:TRCRMEN +DELETE F7:TRCRMLC +DELETE BO:TRCRMLC +DELETE F7:TRCRMSH +DELETE BO:TRCRMSH +DELETE F7:TRCRMSN +DELETE BO:TRCRMSN +DELETE F7:TRCRMSP +DELETE BO:TRCRMSP +DELETE F7:TRCROP +DELETE BO:TRCROP +DELETE F7:TRDEADK +DELETE BO:TRDEADK +DELETE F7:TRDEBUG +DELETE BO:TRDEBUG +DELETE F7:TRDESTR +DELETE BO:TRDESTR +DELETE F7:TRDOCK +DELETE BO:TRDOCK +DELETE F7:TRDROPI +DELETE BO:TRDROPI +DELETE F7:TRDRPRT +DELETE BO:TRDRPRT +DELETE F7:TREMEXI +DELETE BO:TREMEXI +DELETE F7:TREVENT +DELETE BO:TREVENT +DELETE F7:TREXPRA +DELETE BO:TREXPRA +DELETE F7:TRFINIS +DELETE BO:TRFINIS +DELETE F7:TRFREEZ +DELETE BO:TRFREEZ +DELETE F7:TRGETCD +DELETE BO:TRGETCD +DELETE F7:TRGETFN +DELETE BO:TRGETFN +DELETE F7:TRGETOU +DELETE BO:TRGETOU +DELETE F7:TRHELP +DELETE BO:TRHELP +DELETE F7:TRHITEM +DELETE BO:TRHITEM +DELETE F7:TRIMPUL +DELETE BO:TRIMPUL +DELETE F7:TRIRAN8 +DELETE BO:TRIRAN8 +DELETE F7:TRJA +DELETE BO:TRJA +DELETE F7:TRLRSCN +DELETE BO:TRLRSCN +DELETE F7:TRMOVE +DELETE BO:TRMOVE +DELETE F7:TRMOVEC +DELETE BO:TRMOVEC +DELETE F7:TRMOVET +DELETE BO:TRMOVET +DELETE F7:TRNEWCO +DELETE BO:TRNEWCO +DELETE F7:TRNEWQU +DELETE BO:TRNEWQU +DELETE F7:TRNOVA +DELETE BO:TRNOVA +DELETE F7:TRPHASE +DELETE BO:TRPHASE +DELETE F7:TRPHOTO +DELETE BO:TRPHOTO +DELETE F7:TRPLANE +DELETE BO:TRPLANE +DELETE F7:TRPLAQU +DELETE BO:TRPLAQU +DELETE F7:TRPRELI +DELETE BO:TRPRELI +DELETE F7:TRPROUT +DELETE BO:TRPROUT +DELETE F7:TRRAM +DELETE BO:TRRAM +DELETE F7:TRSCAN +DELETE BO:TRSCAN +DELETE F7:TRSCOM +DELETE BO:TRSCOM +DELETE F7:TRSCORE +DELETE BO:TRSCORE +DELETE F7:TRSETUP +DELETE BO:TRSETUP +DELETE F7:TRSETWA +DELETE BO:TRSETWA +DELETE F7:TRSHIEL +DELETE BO:TRSHIEL +DELETE F7:TRSKIP +DELETE BO:TRSKIP +DELETE F7:TRSNOVA +DELETE BO:TRSNOVA +DELETE F7:TRSORTK +DELETE BO:TRSORTK +DELETE F7:TRSRSCA +DELETE BO:TRSRSCA +DELETE F7:TRTHAW +DELETE BO:TRTHAW +DELETE F7:TRTIMEW +DELETE BO:TRTIMEW +DELETE F7:TRWAIT +DELETE BO:TRWAIT +DELETE F7:TRWARP +DELETE BO:TRWARP +DELETE F7:TRZAP +DELETE BO:TRZAP +DELETE F7:TRTREK +DELETE BO:TRTREK +DELETE F7:TREKCOM +DELETE LB:TRTREK