From afa7471fe5c4b4db1f5bc9c5a503a531a6ea9da9 Mon Sep 17 00:00:00 2001 From: ken rector Date: Sun, 22 Jun 2025 11:39:34 -0700 Subject: [PATCH] Delete games/Super_Star_trek_(FORTRAN)/build_TRTREK --- games/Super_Star_trek_(FORTRAN)/build_TRTREK | 8432 ------------------ 1 file changed, 8432 deletions(-) delete mode 100644 games/Super_Star_trek_(FORTRAN)/build_TRTREK diff --git a/games/Super_Star_trek_(FORTRAN)/build_TRTREK b/games/Super_Star_trek_(FORTRAN)/build_TRTREK deleted file mode 100644 index 603c878..0000000 --- a/games/Super_Star_trek_(FORTRAN)/build_TRTREK +++ /dev/null @@ -1,8432 +0,0 @@ -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=RAND()*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*RAND()-1.0+BASEX - IF(SECTX .LT. 1 .OR. SECTX .GT. 10) GO TO 50 - SECTY=3.0*RAND()-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*RAND() - 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. RAND() .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(RAND() .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(RAND() .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*RAND() - 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*RAND() - DIST=AMIN1(DISTMAX,DISTREQ) - TIME=10.0*DIST/WFACSQ - DIREC=12.0*RAND() - 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) - EQUIVALENCE (AITEM,ISEED) - 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)) - CALL RANSET(0) - 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*RAND()+2.0 - INPLAN=5. +6.*RAND() - NROMREM=(2.+RAND())*SKILL - NSCREM=SKILL/3 - REMTIME=7.0*LENGTH - INTIME=REMTIME - RATE=(SKILL-2.0*RAND()+1.0)*SKILL*0.1 + 0.15 - REMKL=2.0*RATE*INTIME - INKLING=REMKL - INCOM=SKILL+0.0625*INKLING*RAND() - 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)) - IF (KEY.EQ.IHREAL) ISEED(1)=ABS(TNUMBER) - IF (KEY.EQ.IHALPHA) ISEED(1)=ABS(ISEED(1)) - CALL RANSET(ISEED(1)) - 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*RAND()*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(RAND() .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=RAND()*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*RAND() - 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(RAND().GT..65) RETURN - ISTRACT=1 - GO TO 20010 - END - -END -DELETE F7:TREXPRA -EDIT -BUILD F7:TREXPRA - FUNCTION EXPRAN(AVERAGE) - EXPRAN=-AVERAGE*ALOG(RAND()) - 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*RAND())) 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+RAND())) 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(RAND() .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*RAND())-1 - IF(IX.EQ.0 .OR. IX.EQ.11) GO TO 100 - IY=BASEY+IFIX(3.0*RAND())-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*RAND() - 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(RAND() .LT. .90)GO TO 30 - IF(KPOW .GT. ((.40 + .4*RAND())*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=RAND()*8.+1. - JJ=RAND()*8.+1. - RETURN -C* - ENTRY IRAN10(II,JJ) -C* - II=RAND()*10.+1. - JJ=RAND()*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(RAND().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=RAND() - 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.-RAND()**2)*DIST1+1.0 - IF(CONDIT .EQ. IHDOCKD ) MOTION=MOTION-SKILL*(2.-RAND()**2) - IF(MOTION .EQ. 0) MOTION=((FORCES+200.0*RAND())/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 QUADRANT NEEDS A THOLIAN..... -C IF((RAND().GT.0.08).AND.(PASSWD.NE.8HTHOLIANX)) GO TO 23 - IF((RAND().GT.0.08).AND.(PASSWD.NE.THOLIANX)) GO TO 23 -C--------DECIDE POSITION FOR THOLIAN...... - 17 ITHX=INT(RAND()+0.5)*9+1 - ITHY=INT(RAND()+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)=RAND()*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*RAND()+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*RAND()+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.*RAND()+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(RAND() .GT. 0.89) CALL DROPIN('@',IX,IY) - 68 IF(RAND() .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(RAND() .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(RAND() .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*RAND() - 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*RAND())+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(RAND().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*RAND())*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*RAND())+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(RAND() .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(RAND() .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 + RAND())*(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=(RAND()+RAND())*0.5 -0.5 - IF(ABS(R) .LT. 0.49) GO TO 5709 - R=(RAND()+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(RAND() .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*RAND()) - 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=RAND()-0.5 - R=TEMP*(1.0+0.001*KPOWER(KSHOT))+RAND()*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*RAND() - 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*RAND()-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(RAND() .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*(RAND()-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=RAND() - 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(RAND().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*RAND() - 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.*RAND() - 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(RAND() .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*RAND()) * 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(RAND() .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*RAND()) - 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=RAND() - 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(RAND().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*RAND() - 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*RAND()+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:TRRANF -EDIT -BUILD F7:TRRANF -C REAL FUNCTION RANF(DUMMY) - REAL FUNCTION RAND() -C -C 25-APR-79 -C CHANGED TO USE THE ONE-ARGUMENT VERSION OF THE RAN FUNCTION, -C AND TO USE AN INTEGER*4 SEED. -C -C INTEGER*4 IRAN,ISEED - INTEGER NXSEED -C - IF (NXSEED.NE.0) GO TO 10 - RAND=RANF() - RETURN - 10 NXSEED=NXSEED * 1103515243 + 12345 - IDIV=NXSEED/65536 - IMOD=IDIV-((IDIV/32768)*32768) - RAND=ABS(IMOD/32768.) - RETURN -C - ENTRY RANSET(ISEED) -C - NXSEED=ISEED - 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(RAND() .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*RAND() - 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*RAND()+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 = RAND() * 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. RAND() .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-RAND()**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. RAND().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)=RAND()*3. + 1. -C--------DECIDE WHETHER DILITHIUM CRYSTALS ARE PRESENT. - PLNETS(I,4)=1.2*RAND() - 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((RAND() .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=RAND()*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=RAND()*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. RAND().LT.0.5) GO TO 10 -C--------TRAVEL FORWARD IN TIME - TIME=-0.5*INTIME*ALOG(RAND()) - 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+RAND()) - 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. RAND()) BLOOEY=1 - IF(BLOOEY.NE.0) DIST=RAND()*DIST -C----------DECIDE IF TIME WARP WILL OCCUR - TWARP=0 - IF(WARPFAC .LT. 10.0) GO TO 40 - IF(0.5*DIST .GT. RAND()) 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*RAND()+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*RAND() - 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*RAND())) GO TO 60 - NCRIT=1.0 + HIT/(500.0+100.0*RAND()) - CALL CRAM(17H***CRITICAL HIT--,17) -C--------SELECT DEVICE(S) AND CAUSE DAMAGE - KTR=1 - DO 50 LL=1,NCRIT - 20 J=NDEVICE*RAND()+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*RAND())) - 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 RODDENBERRY. - - 2. STAR TREK (THE ANIMATED TELEVISION SERIES), PRODUCED BY GENE - RODDENBERRY 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 - RODDENBERRY. THE BEST AND MOST COMPLETE READILY AVAILABLE - BOOK ABOUT STAR TREK. (BALLANTINE BOOKS) - - 4. THE WORLD OF STAR TREK, BY DAVID GERROLD. SIMILAR IN SCOPE - TO THE ABOVE BOOK. (BANTAM) - - 5. THE STAR TREK GUIDE, THIRD REVISION 4/17/67, BY GENE - RODDENBERRY. 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:TRRANF OVER BO:TRRANF - -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 TRRANF FROM BO:TRRANF(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:TRRANF -DELETE BO:TRRANF -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